onak-mail.pl.in

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