onak-mail.pl.in

#!/usr/bin/perl -w
#
# onak-mail.pl - Mail processing interface for onak, an OpenPGP Keyserver.
#
# Copyright 2002-2005 Jonathan McDowell <noodles@earth.li>
# Released under the GPL.
#

use strict;
use Fcntl;
use IO::Handle;
use IPC::Open3;

my %config;

#
# readoldconfig
#
# Read an old pksd-style config file. Currently if both old and new style
# files are present the old style will be preferred in order to ensure smooth
# upgrades.
#
sub readoldconfig {
	open(CONFIG, "@CMAKE_INSTALL_FULL_SYSCONFDIR@/onak.conf") or
		die "Can't read config file: $!";
	
	while (<CONFIG>) {
		if (/^#/ or /^$/) {
			# Ignore; comment line.
		} elsif (/^this_site (.*)/) {
			$config{'thissite'} = $1;
		} elsif (/^logfile (.*)/) {
			$config{'logfile'} = $1;
		} elsif (/^maintainer_email (.*)/) {
			$config{'adminemail'} = $1;
		} elsif (/^mail_delivery_client (.*)/) {
			$config{'mta'} = $1;
		} elsif (/^pks_bin_dir (.*)/) {
			$config{'pks_bin_dir'} = $1;
		} elsif (/^mail_dir (.*)/) {
			$config{'mail_dir'} = $1;
		} elsif (/^syncsite (.*)/) {
			push @{$config{'syncsites'}}, $1;
		}
	}

	close(CONFIG);

	return;
}

#
# readconfig
#
# Reads in our config file. Ignores any command it doesn't understand rather
# than having to list all the ones that are of no interest to us.
#
sub readconfig {
	# Prefer the old style config if it exists.
	if (-e "@CMAKE_INSTALL_FULL_SYSCONFDIR@/onak.conf") {
		&readoldconfig;
		return;
	}

	open(CONFIG, "@CMAKE_INSTALL_FULL_SYSCONFDIR@/onak.ini") or
		die "Can't read config file: $!";

	my $section = "";
	while (<CONFIG>) {
		if (/^#/ or /^$/) {
			# Ignore; comment line.
		} elsif (/^\[(\w+)\]/) {
			$section = $1;
		} elsif ($section eq "main") {
			if (/^logfile\s*=\s*(.*)/) {
				$config{'logfile'} = $1;
			}
		} elsif ($section eq "mail") {
			if (/^this_site\s*=\s*(.*)/) {
				$config{'thissite'} = $1;
			} elsif (/^maintainer_email\s*=\s*(.*)/) {
				$config{'adminemail'} = $1;
			} elsif (/^mta\s*=\s*(.*)/) {
				$config{'mta'} = $1;
			} elsif (/^bin_dir\s*=\s*(.*)/) {
				$config{'pks_bin_dir'} = $1;
			} elsif (/^mail_dir\s*=\s*(.*)/) {
				$config{'mail_dir'} = $1;
			} elsif (/^syncsite\s*=\s*(.*)/) {
				push @{$config{'syncsites'}}, $1;
			}
		}
	}

	close(CONFIG);

	return;
}

#
# submitupdate
#
# Takes an armored OpenPGP stream and submits it to the keyserver. Returns the
# difference between what we just added and what we had before (ie the least
# data need to get from what we had to what we have).
#
sub submitupdate($) {
	my $data = shift;
	my (@errors, @mergedata);

	my $pid = open3(\*MERGEIN, \*MERGEOUT, \*MERGEERR,
		$config{'pks_bin_dir'}."/onak", "-u", "add");

	print MERGEIN @$data;
	close MERGEIN;
	@mergedata = <MERGEOUT>;
	close MERGEOUT;
	@errors = <MERGEERR>;
	close MERGEERR;
	waitpid $pid, 0;

	return @mergedata;
}


sub processmail($$$$$) {
	my $subject = shift;
	my $from = shift;
	my $replyto = shift;
	my $seenby = shift;
	my $body = shift;
	
	# HELP, ADD, INCREMENTAL, VERBOSE INDEX <keyid>, INDEX <keyid>,
	# GET <keyid>, LAST <days>
	
	if ($subject =~ /^(INCREMENTAL|ADD)$/i) {
		my $site;
		my $count;
		my $i;
		my @newupdate = submitupdate($body);
		my @time;
	
		$count = 0;
		foreach $i (@{$config{'syncsites'}}) {
			if (! defined($seenby->{$i})) {
				$count++;
			}
		}
	
		open (LOG, ">>$config{'logfile'}");
		@time = localtime(time);
		print LOG "[";
		print LOG sprintf "%02d/%02d/%04d %02d:%02d:%02d",
			$time[3], $time[4] + 1, $time[5] + 1900,
			$time[2], $time[1], $time[0];
		print LOG "] onak-mail[$$]: Syncing with $count sites.\n";
		close LOG;

		if ($subject =~ /ADD/i) {
			open(MAIL, "|$config{mta}");
			print MAIL "From: $config{adminemail}\n";
			print MAIL "To: $replyto\n";
			print MAIL "Subject: Reply to ADD\n";
			print MAIL "Precedence: list\n";
			print MAIL "MIME-Version: 1.0\n";
			print MAIL "Content-Type: text/plain\n";
			print MAIL "\n";
			print MAIL "Thank you for your recent key submission.",
				" It has been processed and synced\n",
				"with ", $count, " other keyservers.\n";
			close MAIL;
		}
	
		if ((! defined($newupdate[0])) || $newupdate[0] eq '') {
			open (LOG, ">>$config{'logfile'}");
			print LOG "[";
			print LOG sprintf "%02d/%02d/%04d %02d:%02d:%02d",
				$time[3], $time[4] + 1, $time[5] + 1900,
				$time[2], $time[1], $time[0];
			print LOG "] onak-mail[$$]: Nothing to sync.\n";
			close LOG;
			$count = 0;
		}
	
		if ($count > 0) {
			open(MAIL, "|$config{mta}");
			print MAIL "From: $config{adminemail}\n";
			print MAIL "To: ";
			foreach $i (@{$config{'syncsites'}}) {
				if (! defined($seenby->{$i})) {
					print MAIL "$i";
					$count--;
					if ($count > 0) {
						print MAIL ", ";
					}
				}
			}
			print MAIL "\n";
			print MAIL "Subject: incremental\n";
			foreach $site (keys %$seenby) {
				print MAIL "X-KeyServer-Sent: $site\n";
			}
			print MAIL "X-KeyServer-Sent: $config{thissite}\n";
			print MAIL "Precedence: list\n";
			print MAIL "MIME-Version: 1.0\n";
			print MAIL "Content-Type: application/pgp-keys\n";
			print MAIL "\n";
			print MAIL @newupdate;
			close MAIL;
		}
	} elsif ($subject =~ /^(VERBOSE )?INDEX (.*)$/i) {
		my (@indexdata, $command);
	
		$command = "index";
		if (defined($1)) {
			$command = "vindex";
		}
	
		my $pid = open3(\*INDEXIN, \*INDEXOUT, \*INDEXERR,
			$config{'pks_bin_dir'}."/onak", $command, "$2");
		close INDEXIN;
		@indexdata = <INDEXOUT>;
		close INDEXOUT;
		close INDEXERR;
		waitpid $pid, 0;
	
		open(MAIL, "|$config{mta}");
		print MAIL "From: $config{adminemail}\n";
		print MAIL "To: $replyto\n";
		print MAIL "Subject: Reply to INDEX $2\n";
		print MAIL "Precedence: list\n";
		print MAIL "MIME-Version: 1.0\n";
		print MAIL "Content-Type: text/plain\n";
		print MAIL "\n";
		print MAIL "Below follows the reply to your recent keyserver query:\n";
		print MAIL "\n";
		print MAIL @indexdata;
		close MAIL;
	}
}

my ($inheader, %seenby, $subject, $from, $replyto, @body, @syncmail);

&readconfig;

#
# First dump the incoming mail to a file; this means that if we're receiving
# loads of updates we don't spawn lots of processes but instead leave the
# mails on disk to be dealt with sequentially.
#
my @time = localtime;
my $tmpfile = sprintf "%s/%04d%02d%02d-%02d%02d%02d-%d.onak",
			$config{'mail_dir'},
			$time[5] + 1900,
			$time[4],
			$time[3],
			$time[2],
			$time[1],
			$time[0],
			$$;
open(MAILFILE, '>'.$tmpfile.'.tmp');
while (<>) {
	print MAILFILE $_;
}
close(MAILFILE);
rename $tmpfile.".tmp", $tmpfile;

#
# Lock here to ensure that only one copy of us is processing the incoming
# mail queue at any point in time.
#
sysopen(LOCKFILE, $config{'mail_dir'}.'/onak-mail.lck',
		O_WRONLY|O_CREAT|O_EXCL) or exit;
print LOCKFILE "$$";
close(LOCKFILE);

my $file;
opendir(MAILDIR, $config{'mail_dir'});
while ($file = readdir(MAILDIR)) {
	next if $file !~ /\.onak$/;

	$inheader = 1;
	$subject = $from = $replyto = "";
	undef %seenby;
	@body = ();

	open(FILE, '<'.$config{'mail_dir'}.'/'.$file);
	while (<FILE>) {
		if ($inheader) {
			if (/^Subject:\s*(.*)\s*$/i) {
				$subject = $1;
			} elsif (/^X-KeyServer-Sent:\s*(.*)\s*$/i) {
				$seenby{$1} = 1;
			} elsif (/^From:\s*(.*)\s*$/i) {
				$from = $1;
			} elsif (/^Reply-To:\s*(.*)\s*$/i) {
				$replyto = $1;
			} elsif (/^$/) {
				$inheader = 0;
			}
		}
		if (!$inheader) {
			push @body, $_;
		}
	}
	if ($replyto eq '') {
		$replyto = $from;
	}
	close(FILE);
	unlink $config{'mail_dir'}.'/'.$file;

	processmail($subject, $from, $replyto, \%seenby, \@body);
}
closedir(MAILDIR);
unlink $config{'mail_dir'}.'/onak-mail.lck';