--- /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+(?<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