# HG changeset patch # User Heiko Schlittermann (JUMPER) # Date 1325682939 -3600 # Node ID e65ad1481966348945cfd6d49b249d86385e858b # Parent 3996e5b8789f3e2a4267ffbcbf7741fc5eebbf1f# Parent 4f50e6aa028b0d7f3bd9cd128f74830951078a61 [merged] diff -r 3996e5b8789f -r e65ad1481966 arnold/gpgate.pl --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arnold/gpgate.pl Wed Jan 04 14:15:39 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 3996e5b8789f -r e65ad1481966 scratch/decrypt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scratch/decrypt Wed Jan 04 14:15:39 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 3996e5b8789f -r e65ad1481966 scratch/sign diff -r 3996e5b8789f -r e65ad1481966 scratch/verify --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/scratch/verify Wed Jan 04 14:15:39 2012 +0100 @@ -0,0 +1,82 @@ +#! /usr/bin/perl + +use 5.010; +use strict; +use warnings; +use File::Temp; +use GnuPG; +use autodie qw(:all); + +use blib; +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;