--- a/Build.PL Wed Jan 04 16:41:56 2012 +0100
+++ b/Build.PL Wed Jan 04 16:49:38 2012 +0100
@@ -7,7 +7,9 @@
dist_version => "0",
requires => {
"perl" => "5.10.0",
+ "GnuPG" => "0.17",
},
+ script_files => [ glob "bin/*" ],
build_requires => {
"Test::More" => "0.92",
"Test::Pod::Coverage" => "1.08",
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/arnold/gpgate.pl Wed Jan 04 16:49:38 2012 +0100
@@ -0,0 +1,441 @@
+#! /usr/bin/perl
+
+use 5.010;
+use strict;
+use warnings;
+use File::Temp qw( tempfile tempdir );
+use GnuPG;
+use Digest::MD5 qw(md5_hex);
+use File::Basename;
+use Getopt::Long;
+use Pod::Usage;
+use Smart::Comments;
+
+sub read_msg();
+sub orig_msg($$);
+sub split_msg($);
+sub get_header($);
+sub get_content_type($);
+sub get_boundary($);
+sub verify_msg($$$);
+sub decrypt_msg($$);
+sub sign_msg($$);
+sub output_msg($);
+sub version($$);
+
+my $ME = basename $0;
+my $VERSION = "0.1";
+
+my $opt = {
+ incoming => 0,
+ outgoing => 0,
+ gpgdir => "$ENV{HOME}/.gnupg"
+};
+
+MAIN: {
+ GetOptions(
+ "i|incoming" => \$opt->{incoming},
+ "o|outgoing" => \$opt->{outgoing},
+ "g|gpgdir=s" => \$opt->{gpgdir},
+ "h|help" => sub { pod2usage(-verbose => 1, -exitval => 0) },
+ "m|man" => sub { pod2usage(-verbose => 2, -exitval => 0) },
+ "V|version" => sub { version($ME, $VERSION); exit 0; }
+ ) or pod2usage(-verbose => 1, -exitval => 1);
+
+ # checking options
+ if (not $opt->{incoming} and not $opt->{outgoing}) {
+ pod2usage(-verbose => 1, -exitval => 0);
+ }
+ elsif ($opt->{incoming} and $opt->{outgoing}) {
+ pod2usage(-verbose => 1, -exitval => 0);
+ }
+
+ my $msg = read_msg();
+ my $data = split_msg($msg);
+ my $header = get_header($data);
+ my $ctype = get_content_type($header);
+
+ if ($opt->{incoming}) {
+ given ($ctype) {
+ when (/multipart\/signed/i) {
+ my $boundary = get_boundary($header);
+ verify_msg($msg, $data, $boundary);
+ }
+ when (/multipart\/encrypted/i) {
+ decrypt_msg($msg, $data);
+ }
+ orig_msg($msg, $data);
+ };
+ }
+ elsif ($opt->{outgoing}) {
+ sign_msg($msg, $data);
+ }
+ else {
+ orig_msg($msg, $data);
+ }
+}
+
+sub read_msg() {
+ my $dir = tempdir(CLEANUP => 1);
+ my $fh = tempfile(DIR => $dir, UNLINK => 1);
+
+ local $/ = \102400;
+ print {$fh} $_ while <>;
+ return $fh;
+}
+
+sub split_msg($) {
+ my $fh = shift;
+ my %data = (
+ header => {},
+ body_pos => {}
+ );
+
+ seek($fh, 0, 0);
+ local $/ = "";
+ while (<$fh>) {
+ $data{header} = $_;
+ $data{body_pos} = tell($fh);
+ last;
+ }
+
+ return \%data;
+}
+
+sub get_header($) {
+ my $data = shift;
+ my @header;
+ my @tmp = split(/(^\S+?[: ]\s*.*?\n)(?=^\S|\Z)/ims, $data->{header});
+ foreach (@tmp) { s/\s*?\n\s+/ /mg; }
+ foreach (@tmp) {
+ next if ($_ eq "");
+ next if ($_ =~ /^\n/);
+ s/\n$//;
+ push @header, $_;
+ }
+
+ return \@header;
+}
+
+sub get_content_type($) {
+ my $header = shift;
+ my @ctype = grep(/^Content-Type:/i, @$header);
+ $ctype[0] =~ /Content-Type:\s+(?<ctype>\S+)/;
+ my $ctype = $+{ctype};
+
+ return $ctype;
+}
+
+sub get_boundary($) {
+ my $header = shift;
+ my @ctype = grep(/^Content-Type:/i, @$header);
+ my ($boundary) = ($ctype[0] =~ /boundary=['"](.*?)['"]/);
+
+ return $boundary;
+}
+
+sub verify_msg($$$) {
+ my ($fh, $data, $boundary) = @_;
+ my $dir = tempdir(CLEANUP => 1);
+ my ($fh_head, $fn_head) = tempfile(DIR => $dir, UNLINK => 1);
+ my ($fh_body, $fn_body) = tempfile(DIR => $dir, UNLINK => 1);
+ my ($fh_msg, $fn_msg) = tempfile(DIR => $dir, UNLINK => 1);
+ my ($fh_sign, $fn_sign) = tempfile(DIR => $dir, UNLINK => 1);
+
+ # save the original message body
+ seek($fh, $data->{body_pos}, 0);
+ print {$fh_body} <$fh>;
+
+ # cut the body
+ my $last_line = "";
+ seek($fh, $data->{body_pos}, 0);
+ while (<$fh>) {
+ last if ($last_line =~ /^\s+$/ and /^--\Q$boundary\E/);
+ next if (/^--\Q$boundary\E/);
+ s/\r?\n/\r\n/g;
+ print {$fh_msg} $last_line;
+ $last_line = $_;
+ }
+
+ # cut the signature
+ my $in_sign = 0;
+ while (<$fh>) {
+ if (/^-----BEGIN\s+PGP\s+SIGNATURE-----$/ or $in_sign) {
+ if (/^-----END\s+PGP\s+SIGNATURE-----$/) {
+ $in_sign = 0;
+ print {$fh_sign} $_;
+ }
+ else {
+ $in_sign = 1;
+ print {$fh_sign} $_;
+ }
+ }
+ }
+
+ seek($fh_msg, 0, 0);
+ seek($fh_sign, 0, 0);
+ seek($fh_body, 0, 0);
+
+ my @header = split("\n", $data->{header});
+ print {$fh_head} join("\n", @header);
+
+ my $gpg = new GnuPG(homedir => $opt->{gpgdir});
+ my $sign;
+ eval { $sign = ($gpg->verify(signature => $fn_sign, file => $fn_msg)); };
+ if ($@) {
+ print {$fh_head} "\nX-GPGate-Sign: bad signature\n\n";
+ seek($fh_head, 0, 0);
+ print <$fh_head>;
+ print <$fh_body>;
+ return 0;
+ }
+
+ print {$fh_head} "\nX-GPGate-Sign: good signature\n";
+ print {$fh_head} "X-GPGate-SignUser: $sign->{user}\n";
+ print {$fh_head} "X-GPGate-KeyId: $sign->{keyid}\n\n";
+ seek($fh_head, 0, 0);
+
+ print <$fh_head>;
+ print <$fh_body>;
+}
+
+sub decrypt_msg($$) {
+ my ($fh, $data) = @_;
+ my $dir = tempdir(CLEANUP => 1);
+ my ($fh_body, $fn_body) = tempfile(DIR => $dir, UNLINK => 1);
+ my ($fh_decrypt_body, $fn_decrypt_body) =
+ tempfile(DIR => $dir, UNLINK => 1);
+ my $boundary = md5_hex(time);
+ my $orig_header = get_header($data);
+ my @new_header;
+
+ # cut the clear body
+ seek($fh, $data->{body_pos}, 0);
+ while (<$fh>) {
+ print $fh_body $_;
+ }
+
+ seek($fh_body, 0, 0);
+
+ my $gpg = new GnuPG(homedir => $opt->{gpgdir});
+ my $sign;
+ eval {
+ $sign =
+ ($gpg->decrypt(ciphertext => $fn_body, output => $fn_decrypt_body));
+ };
+ if ($@) {
+ push @$orig_header, "X-GPGate-decrypted: not\n\n";
+ print join("\n", @$orig_header);
+ print <$fh_body>;
+ return 0;
+ }
+
+ # remove old content header lines
+ foreach (@$orig_header) {
+ next if /^content.*?(?=^\S|\Z)/imsg;
+ push @new_header, $_;
+ }
+
+ # insert the new header lines
+ push @new_header,
+ "Content-Type: multipart/mixed; boundary=\"$boundary\"",
+ "Content-Disposition: inline",
+ "X-GPGate-Decrypted: yes",
+ "X-GPGate-SignUser: $sign->{user}",
+ "X-GPGate-KeyId: $sign->{keyid}\n\n";
+
+ # prepare decrypt message for inline disposition
+ seek($fh_decrypt_body, 0, 0);
+ print join("\n", @new_header);
+ say "--${boundary}";
+ print <$fh_decrypt_body>;
+ say "--${boundary}--";
+}
+
+sub sign_msg($$) {
+ my ($fh, $data) = @_;
+ my $dir = tempdir(CLEANUP => 1);
+ my ($fh_body, $fn_body) = tempfile(DIR => $dir, UNLINK => 1);
+ my ($fh_sign, $fn_sign) = tempfile(DIR => $dir, UNLINK => 1);
+ my $boundary = md5_hex(time);
+ my $orig_header = get_header($data);
+ my @new_header;
+
+ # prepare the body for signing
+ foreach (@$orig_header) {
+ next if /^content-length.*/i;
+ print {$fh_body} "$_\r\n" if /^content.*/i;
+ }
+
+ print {$fh_body} "\r\n";
+
+ seek($fh, $data->{body_pos}, 0);
+ local $/ = \102400;
+ while (<$fh>) {
+ s/\r?\n/\r\n/g;
+ print {$fh_body} $_;
+ }
+
+ my $gpg = new GnuPG(homedir => $opt->{gpgdir});
+
+ seek($fh_body, 0, 0);
+ eval {
+ $gpg->sign(
+ plaintext => $fh_body,
+ 'detach-sign' => 1,
+ armor => 1,
+ output => $fn_sign
+ );
+ };
+
+ if ($@) {
+ push @$orig_header, "X-GPGate-signed: not\n\n";
+ print join("\n", @$orig_header);
+ seek($fh, $data->{body_pos}, 0);
+ print <$fh>;
+ return 0;
+ }
+
+ # remove old content header lines
+ foreach (@$orig_header) {
+ next if /^lines.*/i;
+ next if /^content.*/i;
+ push @new_header, $_;
+ }
+
+ # insert the new header lines
+ push @new_header,
+ "Content-Type: "
+ . "multipart/signed; micalg=pgp-sha1;\n"
+ . "\tprotocol=\"application/pgp-signature\"; boundary=\"$boundary\"";
+ push @new_header, "Content-Disposition: inline";
+ push @new_header, "X-GPGate-signed: yes\n\n";
+
+ # return the signed message
+ print join("\n", @new_header);
+ print "--${boundary}\n";
+ seek($fh_body, 0, 0);
+ print <$fh_body>;
+ seek($fh_sign, 0, 0);
+ print "\n--${boundary}\n";
+ print "Content-Type: application/pgp-signature; name=\"signature.asc\"\n"
+ . "Content-Description: Digital Signature\n"
+ . "Content-Disposition: inline\n\n";
+ print <$fh_sign>;
+ print "--${boundary}--\n";
+}
+
+sub orig_msg($$) {
+ my ($fh, $data) = @_;
+ print $data->{header};
+ seek($fh, $data->{body_pos}, 0);
+ print <$fh>;
+}
+
+sub version($$) {
+ my $progname = shift;
+ my $version = shift;
+
+ print <<_VERSION
+$progname version $version
+
+Copyright (C) 2011 by Christian Arnold and Schlittermann internet & unix support.
+$progname comes with ABSOLUTELY NO WARRANTY. This is free software,
+and you are welcome to redistribute it under certain conditions.
+See the GNU General Public Licence for details.
+_VERSION
+}
+
+__END__
+
+=head1 NAME
+
+gpgate - filter to verify/sign and decrypt/encrypt B<MIME> mails
+with B<gpg> from STDIN or from FILES
+
+=head1 SYNOPSIS
+
+B<gpgate> --incoming|--outgoing [STDIN] or [FILE]
+
+=head1 OPTIONS
+
+=over
+
+=item B<-i>, B<--incoming> I<STDIN> or I<FILE>
+
+Is used to decrypt and verify the signature for incoming B<MIME> mails.
+Read the message from STDIN or FILE, output is STDOUT.
+(default: read from STDIN)
+
+=item B<-o>, B<--outgoing> I<STDIN> or I<FILE>
+
+Is used to encrypt and sign mails.
+Read the message from STDIN or FILE, output is STDOUT.
+(default: read from STDIN)
+
+=item B<g>, B<--gpgdir> I<PATH>
+
+Path to the B<gpg> home directory. This is the directory that contains
+the default options file, the public and private key rings as well as
+the trust database. (default: $HOME/.gpg)
+
+=item B<-h>, B<--help>
+
+Print detailed help screen.
+
+=item B<-m>, B<--man>
+
+Print manual page.
+
+=item B<-V>, B<--version>
+
+Print version information.
+
+=back
+
+=head1 DESCRIPTION
+
+B<gpgate> can be used to verify B<gpg> signed and decrypted B<MIME> mails
+from STDIN or from FILES.
+If the B<MIME> mail is signed or decrypted, B<gpgate> trys to verify or
+decrypt this mail and add B<X-GPGate> header lines.
+
+ X-GPGate-Sign: good signature|bad signature
+ X-GPGate-decrypted: yes|not
+ X-GPGate-SignUser: ...
+ X-GPGate-KeyId: ...
+
+B<gpgate> can be used also to sign and encrypt mails with B<gpg> for
+send out whit your favorit B<MTA>.
+
+=head1 EXAMPLES
+
+=over
+
+=item B<gpgate --incoming>
+
+Read mail from STDIN to verify B<gpg> signed and decrypted
+B<MIME> mails.
+
+=item B<gpgate --incoming < example.mail>
+
+Read mail from FILE to verify B<gpg> signed and decrypted
+B<MIME> mails.
+
+=back
+
+=head1 VERSION
+
+This man page is current for version 0.1 of B<gpgate>.
+
+=head1 AUTHOR
+
+Written by Christian Arnold L<arnold@schlittermann.de>
+
+=head1 COPYRIGHT
+
+Copyright (C) 2011 by Christian Arnold and Schlittermann internet & unix support.
+This is free software, and you are welcome to redistribute it under certain conditions.
+See the GNU General Public Licence for details.
+
+=cut
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/bin/decrypt Wed Jan 04 16:49:38 2012 +0100
@@ -0,0 +1,64 @@
+#! /usr/bin/perl
+
+use 5.010;
+use strict;
+use warnings;
+use File::Temp;
+use Digest::MD5 qw(md5_hex);
+use GnuPG;
+use autodie qw(:all);
+
+use blib;
+use Message::2822;
+
+umask(077);
+my $dir = File::Temp->newdir();
+
+my $encrypted =
+ Message::2822->new(file => shift // "ex/mails/signed-encrypted");
+
+# output the original message if not 'multipart/encrypted'
+my ($content_type) =
+ ($encrypted->header_lines(qr/^content-type/i) =~ /\s+(\S+)/i);
+unless ($content_type =~ /multipart\/encrypted/i) {
+ print $encrypted->header_lines, "\n";
+ print $encrypted->orig_body;
+ exit 0;
+}
+
+my $boundary = md5_hex(time);
+
+open(my $body, "+>$dir/body");
+print {$body} $encrypted->orig_body;
+seek($body, 0, 0);
+
+# ask GPG to decrypt it…
+my $gpg = new GnuPG(homedir => "ex/gpg");
+my $sign;
+eval {
+ $sign =
+ ($gpg->decrypt(ciphertext => "$dir/body", output => "$dir/message"));
+};
+if ($@) {
+ $encrypted->add_header_line("\nX-GPGate-decrypted: not\n");
+ print $encrypted->header_lines, "\n";
+ print $encrypted->orig_body;
+ exit 0;
+}
+
+# now remove the unwanted content- header lines and add new ones
+$encrypted->remove_header_lines(qr/^content-.*?:/im);
+
+$encrypted->add_header_line(
+ "Content-Type: multipart/mixed; boundary=\"$boundary\"");
+$encrypted->add_header_line("Content-Disposition: inline\n");
+$encrypted->add_header_line("X-GPGate-Sign: good signature\n");
+$encrypted->add_header_line("X-GPGate-SignUser: $sign->{user}\n");
+$encrypted->add_header_line("X-GPGate-KeyId: $sign->{keyid}\n");
+$encrypted->add_header_line("X-GPGate-Decrypted: yes\n");
+print $encrypted->header_lines, "\n";
+
+open(my $message, "<$dir/message");
+say "--${boundary}";
+print <$message>;
+say "--${boundary}--";
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/bin/sign Wed Jan 04 16:49:38 2012 +0100
@@ -0,0 +1,86 @@
+#! /usr/bin/perl
+
+use 5.010;
+use strict;
+use warnings;
+use File::Temp;
+use GnuPG;
+use autodie qw(:all);
+
+use Digest::MD5 qw(md5_hex);
+
+use blib;
+use Message::2822;
+
+umask(077);
+my $boundary = md5_hex(time);
+my $dir = File::Temp->newdir();
+
+my $unsigned = Message::2822->new(file => shift // "ex/mails/unsigned");
+
+# copy the changed body into a tmp file and copy there the
+# changed content-header lines
+open(my $message, "+>$dir/message");
+
+open(my $header, "+>$dir/header");
+print {$header} $unsigned->header_lines(qr/^content-/i);
+seek($header, 0, 0);
+while (<$header>) {
+ s/\r?\n/\r\n/g;
+ print {$message} $_;
+}
+print {$message} "\r\n";
+
+open(my $body, "+>$dir/body");
+print {$body} $unsigned->orig_body;
+seek($body, 0, 0);
+while (<$body>) {
+ s/\r?\n/\r\n/g;
+ print {$message} $_;
+}
+
+$message->flush();
+
+# ask GPG to sign it…
+open(my $sig, "+>$dir/signature.asc");
+my $gpg = new GnuPG(homedir => "ex/gpg");
+seek($message, 0, 0);
+eval {
+ $gpg->sign(
+ plaintext => $message,
+ 'detach-sign' => 1,
+ armor => 1,
+ output => $sig
+ );
+};
+
+if ($@) {
+ $unsigned->add_header_line("X-GPGate-signed: not\n");
+ print $unsigned->header_lines, "\n";
+ print $unsigned->orig_body;
+ exit 0;
+}
+
+# now remove the unwanted content- header lines and add new ones
+$unsigned->remove_header_lines(qr/^content-.*?:/im);
+
+$unsigned->add_header_line("Content-Type: "
+ . "multipart/signed; micalg=pgp-sha1;\n"
+ . "\tprotocol=\"application/pgp-signature\"; boundary=\"$boundary\"");
+$unsigned->add_header_line("Content-Disposition: inline");
+
+$unsigned->add_header_line("X-GPGate-signed: yes\n");
+print $unsigned->header_lines, "\n";
+
+seek($message, 0, 0);
+seek($sig, 0, 0);
+
+print "--${boundary}\n",
+ <$message>, "\n",
+ "--${boundary}\n",
+ <<___, <$sig>, "--${boundary}--\n";
+Content-Type: application/pgp-signature; name="signature.asc"
+Content-Description: Digital Signature
+Content-Disposition: inline
+
+___
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/bin/verify Wed Jan 04 16:49:38 2012 +0100
@@ -0,0 +1,80 @@
+#! /usr/bin/perl
+
+use 5.010;
+use strict;
+use warnings;
+use File::Temp;
+use GnuPG;
+use autodie qw(:all);
+use Message::2822;
+
+umask(077);
+my $dir = File::Temp->newdir();
+
+my $signed = Message::2822->new(file => shift // "ex/mails/signed");
+
+# output the original message if not 'multipart/sign'
+my ($content_type) = ($signed->header_lines(qr/^content-type/i) =~ /\s+(\S+)/i);
+unless ($content_type =~ /multipart\/signed/i) {
+ print $signed->header_lines, "\n";
+ print $signed->orig_body;
+ exit 0;
+}
+
+my ($boundary) =
+ ($signed->header_lines(qr/^content-type/i) =~ /boundary=['"](.*?)['"]/);
+
+open(my $body, "+>$dir/body");
+print {$body} $signed->orig_body;
+seek($body, 0, 0);
+
+# cut the message
+open(my $message, "+>$dir/message");
+my $last_line = "";
+while (<$body>) {
+ last if ($last_line =~ /^\s+$/ and /^--\Q$boundary\E/);
+ next if (/^--\Q$boundary\E/);
+ s/\r?\n/\r\n/g;
+ print {$message} $last_line;
+ $last_line = $_;
+}
+
+# cut the signature
+open(my $signature, "+>$dir/message.sig");
+my $in_sign = 0;
+while (<$body>) {
+ if (/^-----BEGIN\s+PGP\s+SIGNATURE-----$/ or $in_sign) {
+ if (/^-----END\s+PGP\s+SIGNATURE-----$/) {
+ $in_sign = 0;
+ print {$signature} $_;
+ }
+ else {
+ $in_sign = 1;
+ print {$signature} $_;
+ }
+ }
+}
+
+seek($message, 0, 0);
+seek($signature, 0, 0);
+
+# ask GPG to verify it…
+my $gpg = new GnuPG(homedir => "ex/gpg");
+my $sign;
+eval {
+ $sign =
+ ($gpg->verify(signature => "$dir/message.sig", file => "$dir/message"));
+};
+if ($@) {
+ $signed->add_header_line("\nX-GPGate-Sign: bad signature\n");
+ print $signed->header_lines, "\n";
+ print $signed->orig_body;
+ exit 0;
+}
+
+$signed->add_header_line("\nX-GPGate-Sign: good signature\n");
+$signed->add_header_line("X-GPGate-SignUser: $sign->{user}\n");
+$signed->add_header_line("X-GPGate-KeyId: $sign->{keyid}\n");
+
+print $signed->header_lines, "\n";
+print $signed->orig_body;
--- a/lib/Message/2822.pm Wed Jan 04 16:41:56 2012 +0100
+++ b/lib/Message/2822.pm Wed Jan 04 16:49:38 2012 +0100
@@ -26,7 +26,7 @@
or die "Can't open $DATA{fn}{$self}: $!\n";
local $/ = "";
- chomp($DATA{header}{$self} = <$fh>);
+ chomp($DATA{header}{$self} = <$fh>);
$DATA{body_pos}{$self} = tell($fh);
return $self;
@@ -41,7 +41,9 @@
sub header_lines {
my $self = shift;
my $field = shift // qr/.*/;
- my @r = grep /$field/i => $DATA{header}{$self} =~ /(^\S+?[: ]\s*.*?\n)(?=^\S|\Z)/imsg;
+ my @r =
+ grep /$field/i => $DATA{header}{$self} =~
+ /(^\S+?[: ]\s*.*?\n)(?=^\S|\Z)/imsg;
return @r if wantarray;
foreach (@r) { s/\s*?\n\s+/ /mg; }
@@ -62,7 +64,7 @@
}
sub header_contents {
- my $self = shift;
+ my $self = shift;
my $field = shift // qr/.*/;
my @r = map { (split /[: ]/, $_, 2)[1] } $self->header_lines($field);
@@ -72,7 +74,6 @@
return join "" => @r;
}
-
sub orig_header {
my $self = shift;
my $fh = $DATA{fh}{$self};
@@ -121,6 +122,11 @@
=head1 METHODS
+B<Note:> Whenever we mention a I<pattern>, you may pass the pattern
+as "qr/pattern/", giving you any freedom in choosing modifiers and so on, or
+you may pass the pattern simply as a string "pattern", this well then
+silently converted to "qr/pattern/i".
+
=over
=item B<new>(file => I<file>)
--- a/scratch/sign Wed Jan 04 16:41:56 2012 +0100
+++ /dev/null Thu Jan 01 00:00:00 1970 +0000
@@ -1,59 +0,0 @@
-#! /usr/bin/perl
-
-use 5.010;
-use strict;
-use warnings;
-use File::Temp;
-use autodie qw(:all);
-
-use Digest::MD5 qw(md5_hex);
-
-use blib;
-use Message::2822;
-
-umask(077);
-my $boundary = md5_hex(time);
-my $dir = File::Temp->newdir();
-
-my $unsigned = Message::2822->new(file => shift//"ex/mails/unsigned");
-
-die join " ", $unsigned->header_contents("Subject");
-
-# copy the body into a tmp file and copy there the content-
-# header lines
-open(my $message, "+>$dir/message");
-print {$message}
- $unsigned->header_lines("content-"), "\n",
- $unsigned->orig_body;
-$message->flush();
-
-# now remove the unwanted content- header lines and add new ones
-$unsigned->remove_header_lines(qr/^content-.*?:/im);
-
-$unsigned->add_header_line("Content-Type: "
- . "multipart/signed; micalg=pgp-sha1;\n"
- . "\tprotocol=\"application/pgp-signature\"; boundary=\"$boundary\"");
-$unsigned->add_header_line("Content-Disposition: inline");
-
-
-# ask GPG to sign it…
-system("gpg",
- "--detach-sign",
- "--homedir" => "ex/gpg",
- "--armor" => "$dir/message");
-
-open(my $sig, "$dir/message.asc");
-
-print $unsigned->header_lines, "\n";
-
-seek($message, 0, 0);
-
-print "--${boundary}\n",
- <$message>,
- "--${boundary}\n",
- <<___, <$sig>, "\n--${boundary}--\n";
-Content-Type: application/pgp-signature; name="signature.asc"
-Content-Description: Digital Signature
-Content-Disposition: inline
-
-___
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/t/.perltidyrc Wed Jan 04 16:49:38 2012 +0100
@@ -0,0 +1,2 @@
+--paren-tightness=2
+--square-bracket-tightness=2
--- a/t/000-message.t Wed Jan 04 16:41:56 2012 +0100
+++ b/t/000-message.t Wed Jan 04 16:49:38 2012 +0100
@@ -3,9 +3,46 @@
use Test::More;
use_ok "Message::2822"
- or BAIL_OUT "Can't load the Message::2822 module";
+ or BAIL_OUT "Can't load the Message::2822 module";
+
+my @files = glob("ex/mails/*");
+cmp_ok(@files, ">", 1, "more then 1 test message");
+can_ok("Message::2822", qw(new));
+
+my %message;
+foreach my $file (@files) {
+ my $msg = Message::2822->new(file => $file);
+ isa_ok($msg, "Message::2822", "object is Message::2822 ($file)");
+ $message{$file} = $msg;
+}
+
+# check if we really get all header fields
+foreach my $file (keys %message) {
-my $file = "ex/mails/unsigned";
+ # get a sorted list of header fields
+ open(my $f, $file) or die "Can't open $file: $!\n";
+ $/ = "";
+ $_ = <$f>;
+ my @h = sort /^(\S+?[ :])/mg;
+
+ is_deeply([sort $message{$file}->header_fields()], \@h,
+ "all header fields");
+
+ is_deeply(
+ [sort $message{$file}->header_fields('^f')],
+ [grep /^f/i => @h],
+ "partial header fields '^f'"
+ );
+
+ is_deeply(
+ [sort $message{$file}->header_fields(qr/^f/i)],
+ [grep /^f/i => @h],
+ "partial header fields qr/^f/i"
+ );
+}
+
+done_testing;
+__END__
# the object itself
my $message = Message::2822->new(file => $file);