# HG changeset patch # User Heiko Schlittermann (JUMPER) # Date 1325692178 -3600 # Node ID c1810f067e5dd1055560dc20cbab71ee012ba18a # Parent 4ba3303aae86edd3b2325762b38d984f8538cc92# Parent 13a91c6153319f91d30e14fb026ba7c9711a91a3 merged the backed-out changes in 2822.pm diff -r 13a91c615331 -r c1810f067e5d Build.PL --- 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", diff -r 13a91c615331 -r c1810f067e5d arnold/gpgate.pl --- /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+(?\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 mails +with B from STDIN or from FILES + +=head1 SYNOPSIS + +B --incoming|--outgoing [STDIN] or [FILE] + +=head1 OPTIONS + +=over + +=item B<-i>, B<--incoming> I or I + +Is used to decrypt and verify the signature for incoming B mails. +Read the message from STDIN or FILE, output is STDOUT. +(default: read from STDIN) + +=item B<-o>, B<--outgoing> I or I + +Is used to encrypt and sign mails. +Read the message from STDIN or FILE, output is STDOUT. +(default: read from STDIN) + +=item B, B<--gpgdir> I + +Path to the B 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 can be used to verify B signed and decrypted B mails +from STDIN or from FILES. +If the B mail is signed or decrypted, B trys to verify or +decrypt this mail and add B header lines. + + X-GPGate-Sign: good signature|bad signature + X-GPGate-decrypted: yes|not + X-GPGate-SignUser: ... + X-GPGate-KeyId: ... + +B can be used also to sign and encrypt mails with B for +send out whit your favorit B. + +=head1 EXAMPLES + +=over + +=item B + +Read mail from STDIN to verify B signed and decrypted +B mails. + +=item B + +Read mail from FILE to verify B signed and decrypted +B mails. + +=back + +=head1 VERSION + +This man page is current for version 0.1 of B. + +=head1 AUTHOR + +Written by Christian Arnold L + +=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 diff -r 13a91c615331 -r c1810f067e5d bin/decrypt --- /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}--"; diff -r 13a91c615331 -r c1810f067e5d bin/sign --- /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 + +___ diff -r 13a91c615331 -r c1810f067e5d bin/verify --- /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; diff -r 13a91c615331 -r c1810f067e5d lib/Message/2822.pm --- 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 Whenever we mention a I, 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(file => I) diff -r 13a91c615331 -r c1810f067e5d scratch/sign --- 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 - -___ diff -r 13a91c615331 -r c1810f067e5d t/.perltidyrc --- /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 diff -r 13a91c615331 -r c1810f067e5d t/000-message.t --- 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);