onak-mail.pl.in

   1 #!/usr/bin/perl -w
   2 #
   3 # onak-mail.pl - Mail processing interface for onak, an OpenPGP Keyserver.
   4 #
   5 # Copyright 2002-2005 Jonathan McDowell <noodles@earth.li>
   6 # Released under the GPL.
   7 #
   8
   9 use strict;
  10 use Fcntl;
  11 use IO::Handle;
  12 use IPC::Open3;
  13
  14 my %config;
  15
  16 #
  17 # readconfig
  18 #
  19 # Reads in our config file. Ignores any command it doesn't understand rather
  20 # than having to list all the ones that are of no interest to us.
  21 #
  22 sub readconfig {
  23
  24         open(CONFIG, "@CONFIG@") or
  25                 die "Can't read config file: $!";
  26
  27         while (<CONFIG>) {
  28                 if (/^#/ or /^$/) {
  29                         # Ignore; comment line.
  30                 } elsif (/^this_site (.*)/) {
  31                         $config{'thissite'} = $1;
  32                 } elsif (/^logfile (.*)/) {
  33                         $config{'logfile'} = $1;
  34                 } elsif (/^maintainer_email (.*)/) {
  35                         $config{'adminemail'} = $1;
  36                 } elsif (/^mail_delivery_client (.*)/) {
  37                         $config{'mta'} = $1;
  38                 } elsif (/^pks_bin_dir (.*)/) {
  39                         $config{'pks_bin_dir'} = $1;
  40                 } elsif (/^mail_dir (.*)/) {
  41                         $config{'mail_dir'} = $1;
  42                 } elsif (/^syncsite (.*)/) {
  43                         push @{$config{'syncsites'}}, $1;
  44                 }
  45         }
  46
  47         close(CONFIG);
  48
  49         return;
  50 }
  51
  52 #
  53 # submitupdate
  54 #
  55 # Takes an armored OpenPGP stream and submits it to the keyserver. Returns the
  56 # difference between what we just added and what we had before (ie the least
  57 # data need to get from what we had to what we have).
  58 #
  59 sub submitupdate($) {
  60         my $data = shift;
  61         my (@errors, @mergedata);
  62
  63         my $pid = open3(\*MERGEIN, \*MERGEOUT, \*MERGEERR,
  64                 $config{'pks_bin_dir'}."/onak", "-u", "add");
  65
  66         print MERGEIN @$data;
  67         close MERGEIN;
  68         @mergedata = <MERGEOUT>;
  69         close MERGEOUT;
  70         @errors = <MERGEERR>;
  71         close MERGEERR;
  72         waitpid $pid, 0;
  73
  74         return @mergedata;
  75 }
  76
  77
  78 sub processmail($$$$$) {
  79         my $subject = shift;
  80         my $from = shift;
  81         my $replyto = shift;
  82         my $seenby = shift;
  83         my $body = shift;
  84
  85         # HELP, ADD, INCREMENTAL, VERBOSE INDEX <keyid>, INDEX <keyid>,
  86         # GET <keyid>, LAST <days>
  87
  88         if ($subject =~ /^(INCREMENTAL|ADD)$/i) {
  89                 my $site;
  90                 my $count;
  91                 my $i;
  92                 my @newupdate = submitupdate($body);
  93                 my @time;
  94
  95                 $count = 0;
  96                 foreach $i (@{$config{'syncsites'}}) {
  97                         if (! defined($seenby->{$i})) {
  98                                 $count++;
  99                         }
 100                 }
 101
 102                 open (LOG, ">>$config{'logfile'}");
 103                 @time = localtime(time);
 104                 print LOG "[";
 105                 print LOG sprintf "%02d/%02d/%04d %02d:%02d:%02d",
 106                         $time[3], $time[4] + 1, $time[5] + 1900,
 107                         $time[2], $time[1], $time[0];
 108                 print LOG "] onak-mail[$$]: Syncing with $count sites.\n";
 109                 close LOG;
 110
 111                 if ($subject =~ /ADD/i) {
 112                         open(MAIL, "|$config{mta}");
 113                         print MAIL "From: $config{adminemail}\n";
 114                         print MAIL "To: $replyto\n";
 115                         print MAIL "Subject: Reply to ADD\n";
 116                         print MAIL "Precedence: list\n";
 117                         print MAIL "MIME-Version: 1.0\n";
 118                         print MAIL "Content-Type: text/plain\n";
 119                         print MAIL "\n";
 120                         print MAIL "Thank you for your recent key submission.",
 121                                 " It has been processed and synced\n",
 122                                 "with ", $count, " other keyservers.\n";
 123                         close MAIL;
 124                 }
 125
 126                 if ((! defined($newupdate[0])) || $newupdate[0] eq '') {
 127                         open (LOG, ">>$config{'logfile'}");
 128                         print LOG "[";
 129                         print LOG sprintf "%02d/%02d/%04d %02d:%02d:%02d",
 130                                 $time[3], $time[4] + 1, $time[5] + 1900,
 131                                 $time[2], $time[1], $time[0];
 132                         print LOG "] onak-mail[$$]: Nothing to sync.\n";
 133                         close LOG;
 134                         $count = 0;
 135                 }
 136
 137                 if ($count > 0) {
 138                         open(MAIL, "|$config{mta}");
 139                         print MAIL "From: $config{adminemail}\n";
 140                         print MAIL "To: ";
 141                         foreach $i (@{$config{'syncsites'}}) {
 142                                 if (! defined($seenby->{$i})) {
 143                                         print MAIL "$i";
 144                                         $count--;
 145                                         if ($count > 0) {
 146                                                 print MAIL ", ";
 147                                         }
 148                                 }
 149                         }
 150                         print MAIL "\n";
 151                         print MAIL "Subject: incremental\n";
 152                         foreach $site (keys %$seenby) {
 153                                 print MAIL "X-KeyServer-Sent: $site\n";
 154                         }
 155                         print MAIL "X-KeyServer-Sent: $config{thissite}\n";
 156                         print MAIL "Precedence: list\n";
 157                         print MAIL "MIME-Version: 1.0\n";
 158                         print MAIL "Content-Type: application/pgp-keys\n";
 159                         print MAIL "\n";
 160                         print MAIL @newupdate;
 161                         close MAIL;
 162                 }
 163         } elsif ($subject =~ /^(VERBOSE )?INDEX (.*)$/i) {
 164                 my (@indexdata, $command);
 165
 166                 $command = "index";
 167                 if (defined($1)) {
 168                         $command = "vindex";
 169                 }
 170
 171                 my $pid = open3(\*INDEXIN, \*INDEXOUT, \*INDEXERR,
 172                         $config{'pks_bin_dir'}."/onak", $command, "$2");
 173                 close INDEXIN;
 174                 @indexdata = <INDEXOUT>;
 175                 close INDEXOUT;
 176                 close INDEXERR;
 177                 waitpid $pid, 0;
 178
 179                 open(MAIL, "|$config{mta}");
 180                 print MAIL "From: $config{adminemail}\n";
 181                 print MAIL "To: $replyto\n";
 182                 print MAIL "Subject: Reply to INDEX $2\n";
 183                 print MAIL "Precedence: list\n";
 184                 print MAIL "MIME-Version: 1.0\n";
 185                 print MAIL "Content-Type: text/plain\n";
 186                 print MAIL "\n";
 187                 print MAIL "Below follows the reply to your recent keyserver query:\n";
 188                 print MAIL "\n";
 189                 print MAIL @indexdata;
 190                 close MAIL;
 191         }
 192 }
 193
 194 my ($inheader, %seenby, $subject, $from, $replyto, @body, @syncmail);
 195
 196 &readconfig;
 197
 198 #
 199 # First dump the incoming mail to a file; this means that if we're receiving
 200 # loads of updates we don't spawn lots of processes but instead leave the
 201 # mails on disk to be dealt with sequentially.
 202 #
 203 my @time = localtime;
 204 my $tmpfile = sprintf "%s/%04d%02d%02d-%02d%02d%02d-%d.onak",
 205                         $config{'mail_dir'},
 206                         $time[5] + 1900,
 207                         $time[4],
 208                         $time[3],
 209                         $time[2],
 210                         $time[1],
 211                         $time[0],
 212                         $$;
 213 open(MAILFILE, '>'.$tmpfile.'.tmp');
 214 while (<>) {
 215         print MAILFILE $_;
 216 }
 217 close(MAILFILE);
 218 rename $tmpfile.".tmp", $tmpfile;
 219
 220 #
 221 # Lock here to ensure that only one copy of us is processing the incoming
 222 # mail queue at any point in time.
 223 #
 224 sysopen(LOCKFILE, $config{'mail_dir'}.'/onak-mail.lck',
 225                 O_WRONLY|O_CREAT|O_EXCL) or exit;
 226 print LOCKFILE "$$";
 227 close(LOCKFILE);
 228
 229 my $file;
 230 opendir(MAILDIR, $config{'mail_dir'});
 231 while ($file = readdir(MAILDIR)) {
 232         next if $file !~ /\.onak$/;
 233
 234         $inheader = 1;
 235         $subject = $from = $replyto = "";
 236         undef %seenby;
 237         @body = ();
 238
 239         open(FILE, '<'.$config{'mail_dir'}.'/'.$file);
 240         while (<FILE>) {
 241                 if ($inheader) {
 242                         if (/^Subject:\s*(.*)\s*$/i) {
 243                                 $subject = $1;
 244                         } elsif (/^X-KeyServer-Sent:\s*(.*)\s*$/i) {
 245                                 $seenby{$1} = 1;
 246                         } elsif (/^From:\s*(.*)\s*$/i) {
 247                                 $from = $1;
 248                         } elsif (/^Reply-To:\s*(.*)\s*$/i) {
 249                                 $replyto = $1;
 250                         } elsif (/^$/) {
 251                                 $inheader = 0;
 252                         }
 253                 }
 254                 if (!$inheader) {
 255                         push @body, $_;
 256                 }
 257         }
 258         if ($replyto eq '') {
 259                 $replyto = $from;
 260         }
 261         close(FILE);
 262         unlink $config{'mail_dir'}.'/'.$file;
 263
 264         processmail($subject, $from, $replyto, \%seenby, \@body);
 265 }
 266 closedir(MAILDIR);
 267 unlink $config{'mail_dir'}.'/onak-mail.lck';