# HG changeset patch
# User Christian Arnold <arnold@schlittermann.de>
# Date 1323693004 -3600
# Node ID 236696558ccbd2fb100e6cd984f94d57ee2490d2
# Parent  9f127fcfdf6d49e3d67ec70b83f4a4a40a27d76f
version 0.1

diff -r 9f127fcfdf6d -r 236696558ccb arnold/gpgate.pl
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/arnold/gpgate.pl	Mon Dec 12 13:30:04 2011 +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