#! /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
