#!/usr/bin/perl -w

#
# mail-gnupg-encrypt.pl - encrypt received mail with
#                         your GnuPG/PGP key. Use with
#                         procmail.
#
# Developed by Lubomir Host 'rajo' <rajo AT platon.sk>
# Copyright (c) 2005 Platon SDG, http://platon.sk/
# Licensed under terms of GNU General Public License.
# All rights reserved.
#
# Changelog:
# 2005-01-13 - created
#
#
# Keywords: mail, email, protected email, encryted email,
#           GnuPG, GPG, PGP, encryption, procmail,
#           mail filter, procmailrc, formail, security
#
# http://www.faqs.org/rfcs/rfc2015.html
# http://www.faqs.org/rfcs/rfc3156.html
#

#
# Usage: add following lines into your ~/.procmailrc
#
# :0fw:
# | /path/to/mail-gnupg-encrypt.pl -r your@email.address.com
#

# $Platon: scripts/perl/mail-gnupg/mail-gnupg-encrypt.pl,v 1.4 2010-10-05 23:03:09 rajo Exp $

use strict;
use warnings;

use English;
use AppConfig qw/:expand :argcount/;
use GnuPG::Tie::Encrypt;

use vars qw (
	$VERSION
	%conf $conf
	$recipient
	$cfgfile
	$boundary $new_content_type $old_content_type
	$header_line $curr_header_key
	$new_content_type_is_set
);

sub help($;);

$| = 1;

$VERSION	= do { my @r = (q$Revision: 1.5 $=~/\d+/g); sprintf "%d." . "%02d" x $#r, @r };

my @char=("A".."Z", "a".."z", 0..9);
$boundary = join("", @char[map{rand @char} (1..16)]);

$new_content_type = "Content-Type: multipart/encrypted; protocol=\"application/pgp-encrypted\";\n\tboundary=\"$boundary\"\n";
$old_content_type = '';
$header_line = '';
$curr_header_key = '';
$new_content_type_is_set = 0;

$conf = AppConfig->new( # {{{
	{
		CASE => 1,
		DEBUG => 0,
		CREATE => 0,
		GLOBAL => {
			ARGCOUNT => ARGCOUNT_NONE,
		}
	},
	# ALIAS =>, so imperfect and universe-breaking, and we still need it.
	"config|cfg=s",		{ },
	"recipient|r=s",	{ },
	"version",			{
		ACTION => sub { print "$0 version $VERSION"; exit 0 }
	},
) or die "Can't initialize the AppConfig object\n";

$conf->getopt; # parse command line

$cfgfile	= $conf->cfg();
if (defined($cfgfile) and $cfgfile ne '') {
	unless (-r $cfgfile) {
		help("Config file '$cfgfile' not found\n");
	}
	else {
		$conf->file($conf->cfg)
	}
}

$recipient	= $conf->recipient();

if (!defined($recipient) or $recipient eq '') {
	help("You need specify at least recipient parameter\n");
	exit 1;
}
# }}}

tie *CIPHER, 'GnuPG::Tie::Encrypt', armor => 1, recipient => $recipient;
pipe(PARENT_RDR, CHILD_WTR) or die "Can't create pipe: $!\n";

if (my $pid = fork()) { # parent
	close (STDOUT);
	close (PARENT_RDR);
	while (my $line = <STDIN>) {
		if ($line =~ m/^$/o) { # end of header, print PGP header {{{
			print CHILD_WTR $header_line;
			if ($new_content_type_is_set == 0) {
				#warn "NO CONTENT-TYPE-YET";
				print CHILD_WTR $new_content_type;
			}
			print CHILD_WTR "\n\n--$boundary\n",
			"Content-Type: application/pgp-encrypted\n",
			"Content-Disposition: attachment\n\n",
			"Version: 1\n\n",
			"--$boundary\n",
			"Content-Type: application/octet-stream\n",
			"Content-Disposition: inline; filename=\"msg.asc\"\n\n";
			last;
		} # }}}
		if ($line =~ m/^([a-zA-Z0-9-]+):\s+/o) { # {{{
			if ($curr_header_key eq 'content-type') { # na predchadzajucom riadku bol content-type
				$header_line .= $line;
				$line = $new_content_type;
				$new_content_type_is_set = 1;
			}
			$curr_header_key = lc($1);
			if ($curr_header_key eq 'content-type') {
				$old_content_type = $line;
			}
			else {
				print CHILD_WTR $header_line, $line; # one header line completes, ship it out
				$header_line = "";
			}
		} # }}}
		else { # {{{
			if ($curr_header_key eq 'content-type') {
				$old_content_type .= $line;
				#print "OLD = '$old_content_type'\n";
			}
			else {
				#print "XXX line ='$line'\n";
				$header_line .= $line;
			}
		} # }}}
	}
	close (CHILD_WTR);
	
	#
	# rest goes to the GnuPG
	#
	print CIPHER $old_content_type;
	print CIPHER "Content-Disposition: inline\n\n";
	# mail content goes to GnuPG withouth temporary file
	while (my $line = <STDIN>) {
		print CIPHER $line;
	}
}
else { # child
	die("Fork failed!: $!") unless defined $pid;
	close (STDIN);
	close (CHILD_WTR);
	while (<PARENT_RDR>) { # first read header (unencrypted data from parent)
		print;
	}
	while (<CIPHER>) { # read encrypted output from GnuPG
		print;
	}
	# print terminator
	print "\n--$boundary--\n";
}

close CIPHER;
untie *CIPHER;

sub help($;)
{ # {{{
	my ($err) = @_;

	print STDERR "\nError: $err\n";

	print STDERR <<EOF;
Usage:

	-r
	--recipient		Define encrypted message recipient

	--cfg
	--config		Read options from config file

	--version		Print version and exit

EOF

	exit 1;
	
} # }}}

# vim: ts=4
# vim600: fdm=marker fdl=0 fdc=3