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 # readoldconfig
  18 #
  19 # Read an old pksd-style config file. Currently if both old and new style
  20 # files are present the old style will be preferred in order to ensure smooth
  21 # upgrades.
  22 #
  23 sub readoldconfig {
  24         open(CONFIG, "@CMAKE_INSTALL_FULL_SYSCONFDIR@/onak.conf") 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 # readconfig
  54 #
  55 # Reads in our config file. Ignores any command it doesn't understand rather
  56 # than having to list all the ones that are of no interest to us.
  57 #
  58 sub readconfig {
  59         # Prefer the old style config if it exists.
  60         if (-e "@CMAKE_INSTALL_FULL_SYSCONFDIR@/onak.conf") {
  61                 &readoldconfig;
  62                 return;
  63         }
  64
  65         open(CONFIG, "@CMAKE_INSTALL_FULL_SYSCONFDIR@/onak.ini") or
  66                 die "Can't read config file: $!";
  67
  68         my $section = "";
  69         while (<CONFIG>) {
  70                 if (/^#/ or /^$/) {
  71                         # Ignore; comment line.
  72                 } elsif (/^\[(\w+)\]/) {
  73                         $section = $1;
  74                 } elsif ($section eq "main") {
  75                         if (/^logfile\s*=\s*(.*)/) {
  76                                 $config{'logfile'} = $1;
  77                         }
  78                 } elsif ($section eq "mail") {
  79                         if (/^this_site\s*=\s*(.*)/) {
  80                                 $config{'thissite'} = $1;
  81                         } elsif (/^maintainer_email\s*=\s*(.*)/) {
  82                                 $config{'adminemail'} = $1;
  83                         } elsif (/^mta\s*=\s*(.*)/) {
  84                                 $config{'mta'} = $1;
  85                         } elsif (/^bin_dir\s*=\s*(.*)/) {
  86                                 $config{'pks_bin_dir'} = $1;
  87                         } elsif (/^mail_dir\s*=\s*(.*)/) {
  88                                 $config{'mail_dir'} = $1;
  89                         } elsif (/^syncsite\s*=\s*(.*)/) {
  90                                 push @{$config{'syncsites'}}, $1;
  91                         }
  92                 }
  93         }
  94
  95         close(CONFIG);
  96
  97         return;
  98 }
  99
 100 #
 101 # submitupdate
 102 #
 103 # Takes an armored OpenPGP stream and submits it to the keyserver. Returns the
 104 # difference between what we just added and what we had before (ie the least
 105 # data need to get from what we had to what we have).
 106 #
 107 sub submitupdate($) {
 108         my $data = shift;
 109         my (@errors, @mergedata);
 110
 111         my $pid = open3(\*MERGEIN, \*MERGEOUT, \*MERGEERR,
 112                 $config{'pks_bin_dir'}."/onak", "-u", "add");
 113
 114         print MERGEIN @$data;
 115         close MERGEIN;
 116         @mergedata = <MERGEOUT>;
 117         close MERGEOUT;
 118         @errors = <MERGEERR>;
 119         close MERGEERR;
 120         waitpid $pid, 0;
 121
 122         return @mergedata;
 123 }
 124
 125
 126 sub processmail($$$$$) {
 127         my $subject = shift;
 128         my $from = shift;
 129         my $replyto = shift;
 130         my $seenby = shift;
 131         my $body = shift;
 132
 133         # HELP, ADD, INCREMENTAL, VERBOSE INDEX <keyid>, INDEX <keyid>,
 134         # GET <keyid>, LAST <days>
 135
 136         if ($subject =~ /^(INCREMENTAL|ADD)$/i) {
 137                 my $site;
 138                 my $count;
 139                 my $i;
 140                 my @newupdate = submitupdate($body);
 141                 my @time;
 142
 143                 $count = 0;
 144                 foreach $i (@{$config{'syncsites'}}) {
 145                         if (! defined($seenby->{$i})) {
 146                                 $count++;
 147                         }
 148                 }
 149
 150                 open (LOG, ">>$config{'logfile'}");
 151                 @time = localtime(time);
 152                 print LOG "[";
 153                 print LOG sprintf "%02d/%02d/%04d %02d:%02d:%02d",
 154                         $time[3], $time[4] + 1, $time[5] + 1900,
 155                         $time[2], $time[1], $time[0];
 156                 print LOG "] onak-mail[$$]: Syncing with $count sites.\n";
 157                 close LOG;
 158
 159                 if ($subject =~ /ADD/i) {
 160                         open(MAIL, "|$config{mta}");
 161                         print MAIL "From: $config{adminemail}\n";
 162                         print MAIL "To: $replyto\n";
 163                         print MAIL "Subject: Reply to ADD\n";
 164                         print MAIL "Precedence: list\n";
 165                         print MAIL "MIME-Version: 1.0\n";
 166                         print MAIL "Content-Type: text/plain\n";
 167                         print MAIL "\n";
 168                         print MAIL "Thank you for your recent key submission.",
 169                                 " It has been processed and synced\n",
 170                                 "with ", $count, " other keyservers.\n";
 171                         close MAIL;
 172                 }
 173
 174                 if ((! defined($newupdate[0])) || $newupdate[0] eq '') {
 175                         open (LOG, ">>$config{'logfile'}");
 176                         print LOG "[";
 177                         print LOG sprintf "%02d/%02d/%04d %02d:%02d:%02d",
 178                                 $time[3], $time[4] + 1, $time[5] + 1900,
 179                                 $time[2], $time[1], $time[0];
 180                         print LOG "] onak-mail[$$]: Nothing to sync.\n";
 181                         close LOG;
 182                         $count = 0;
 183                 }
 184
 185                 if ($count > 0) {
 186                         open(MAIL, "|$config{mta}");
 187                         print MAIL "From: $config{adminemail}\n";
 188                         print MAIL "To: ";
 189                         foreach $i (@{$config{'syncsites'}}) {
 190                                 if (! defined($seenby->{$i})) {
 191                                         print MAIL "$i";
 192                                         $count--;
 193                                         if ($count > 0) {
 194                                                 print MAIL ", ";
 195                                         }
 196                                 }
 197                         }
 198                         print MAIL "\n";
 199                         print MAIL "Subject: incremental\n";
 200                         foreach $site (keys %$seenby) {
 201                                 print MAIL "X-KeyServer-Sent: $site\n";
 202                         }
 203                         print MAIL "X-KeyServer-Sent: $config{thissite}\n";
 204                         print MAIL "Precedence: list\n";
 205                         print MAIL "MIME-Version: 1.0\n";
 206                         print MAIL "Content-Type: application/pgp-keys\n";
 207                         print MAIL "\n";
 208                         print MAIL @newupdate;
 209                         close MAIL;
 210                 }
 211         } elsif ($subject =~ /^(VERBOSE )?INDEX (.*)$/i) {
 212                 my (@indexdata, $command);
 213
 214                 $command = "index";
 215                 if (defined($1)) {
 216                         $command = "vindex";
 217                 }
 218
 219                 my $pid = open3(\*INDEXIN, \*INDEXOUT, \*INDEXERR,
 220                         $config{'pks_bin_dir'}."/onak", $command, "$2");
 221                 close INDEXIN;
 222                 @indexdata = <INDEXOUT>;
 223                 close INDEXOUT;
 224                 close INDEXERR;
 225                 waitpid $pid, 0;
 226
 227                 open(MAIL, "|$config{mta}");
 228                 print MAIL "From: $config{adminemail}\n";
 229                 print MAIL "To: $replyto\n";
 230                 print MAIL "Subject: Reply to INDEX $2\n";
 231                 print MAIL "Precedence: list\n";
 232                 print MAIL "MIME-Version: 1.0\n";
 233                 print MAIL "Content-Type: text/plain\n";
 234                 print MAIL "\n";
 235                 print MAIL "Below follows the reply to your recent keyserver query:\n";
 236                 print MAIL "\n";
 237                 print MAIL @indexdata;
 238                 close MAIL;
 239         }
 240 }
 241
 242 my ($inheader, %seenby, $subject, $from, $replyto, @body, @syncmail);
 243
 244 &readconfig;
 245
 246 #
 247 # First dump the incoming mail to a file; this means that if we're receiving
 248 # loads of updates we don't spawn lots of processes but instead leave the
 249 # mails on disk to be dealt with sequentially.
 250 #
 251 my @time = localtime;
 252 my $tmpfile = sprintf "%s/%04d%02d%02d-%02d%02d%02d-%d.onak",
 253                         $config{'mail_dir'},
 254                         $time[5] + 1900,
 255                         $time[4],
 256                         $time[3],
 257                         $time[2],
 258                         $time[1],
 259                         $time[0],
 260                         $$;
 261 open(MAILFILE, '>'.$tmpfile.'.tmp');
 262 while (<>) {
 263         print MAILFILE $_;
 264 }
 265 close(MAILFILE);
 266 rename $tmpfile.".tmp", $tmpfile;
 267
 268 #
 269 # Lock here to ensure that only one copy of us is processing the incoming
 270 # mail queue at any point in time.
 271 #
 272 sysopen(LOCKFILE, $config{'mail_dir'}.'/onak-mail.lck',
 273                 O_WRONLY|O_CREAT|O_EXCL) or exit;
 274 print LOCKFILE "$$";
 275 close(LOCKFILE);
 276
 277 my $file;
 278 opendir(MAILDIR, $config{'mail_dir'});
 279 while ($file = readdir(MAILDIR)) {
 280         next if $file !~ /\.onak$/;
 281
 282         $inheader = 1;
 283         $subject = $from = $replyto = "";
 284         undef %seenby;
 285         @body = ();
 286
 287         open(FILE, '<'.$config{'mail_dir'}.'/'.$file);
 288         while (<FILE>) {
 289                 if ($inheader) {
 290                         if (/^Subject:\s*(.*)\s*$/i) {
 291                                 $subject = $1;
 292                         } elsif (/^X-KeyServer-Sent:\s*(.*)\s*$/i) {
 293                                 $seenby{$1} = 1;
 294                         } elsif (/^From:\s*(.*)\s*$/i) {
 295                                 $from = $1;
 296                         } elsif (/^Reply-To:\s*(.*)\s*$/i) {
 297                                 $replyto = $1;
 298                         } elsif (/^$/) {
 299                                 $inheader = 0;
 300                         }
 301                 }
 302                 if (!$inheader) {
 303                         push @body, $_;
 304                 }
 305         }
 306         if ($replyto eq '') {
 307                 $replyto = $from;
 308         }
 309         close(FILE);
 310         unlink $config{'mail_dir'}.'/'.$file;
 311
 312         processmail($subject, $from, $replyto, \%seenby, \@body);
 313 }
 314 closedir(MAILDIR);
 315 unlink $config{'mail_dir'}.'/onak-mail.lck';