#!/usr/bin/perl -wT

# This is unsupported software -- use at your own risk!

use strict;
use Mail::Message;
use IPC::Open3;

# How many hashcash bits do I want to use
my $bits = 20;

# For safety we're running in Taint mode, which demands a safe $ENV{PATH}
$ENV{'PATH'} = '';

# hardcoded paths to our binaries
my $HASHCASH = '/usr/bin/hashcash';
my $MTA = '/usr/sbin/sendmail';

# ----------------------------------------------------------------------
# SUBROUTINES

# Subroutine to do a tiny bit of sanity checking on arguments and untaint
# them.  Basically watches out for shell metachars and whitespace.
sub check {
	for my $a (@_) { $a = $1 if $a =~ m#^([^\s;&`'\\]+)$#; }
	return wantarray ? @_ : $_[0];
}

# Subroutine to mint a hashcash token given a resource name (e-mail address)
sub hashcash_mint {
	my $res = shift;
	return undef unless $res =~ m#^([^\s;&`'\\]+)$#;
	my $addr = $1;	# now untainted
	my $hashcash = `$HASHCASH -mqXb$bits '$addr'`;
	return $hashcash;
}

# Subroutine to deliver a message to the MTA (e.g. sendmail)
sub deliver {
	my ($head, $body, $mt_args, $rcpt) = @_;
	my $wr;
	my $pid =
	    open3($wr, '>&STDOUT', '>&STDERR', $MTA, @$mt_args, '--', @$rcpt);
	$head->print($wr);
	$body->print($wr);
	$wr->close;
	waitpid $pid, 0;
	if ($?) {
		printf STDERR "errors in deliver (%#x)\n", $?;
		exit($? >> 8);
	}
}

# ----------------------------------------------------------------------
# BODY OF SCRIPT

# Split the MTA args from the list of recipients
my (@mt_args, %rcpt);
while ($_ = shift @ARGV) { last if $_ eq '--'; push @mt_args, check($_) }
for (@ARGV) { ++$rcpt{check($_)} }

# Read the message from the MUA on stdin
my $msg = Mail::Message->read(\*STDIN);

# Figure out who the message is being sent to.  Assemble the list of visible
# (To and Cc) recipients into the %vis hash, and the list of blind-copy
# (Bcc) recipients into the %bcc hash.  For obvious reasons, an MUA doesn't
# include the Bcc recipients in the message header, so we have to figure it
# out by subtracting the %vis list from the %rcpt list (from above).
my $head = $msg->head;
my (%vis, %bcc);
for (map {$_->address} $msg->to, $msg->cc)
    { ++$vis{$_} unless m/^undisclosed.recipients.*/i }
for (keys %rcpt) { ++$bcc{$_} unless $vis{$_} }

# Build one message for the visible recipients
if (scalar keys %vis) {
	my $vhead = $head->clone;
	for my $addr (sort keys %vis) {
		my $token = hashcash_mint($addr);
		$vhead->add($token) if $token;
	}
	deliver($vhead, $msg->body, \@mt_args, [keys %vis]);
}

# And a separate message for each of the blind-copy recipients
for my $addr (keys %bcc) {
	my $bhead = $head->clone;
	my $token = hashcash_mint($addr);
	$bhead->add($token) if $token;
	deliver($bhead, $msg->body, \@mt_args, [$addr]);
}