Make onak-mail.pl queue requests.
[onak.git] / 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$/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 ((! defined($newupdate[0])) || $newupdate[0] eq '') {
115                         open (LOG, ">>$config{'logfile'}");
116                         print LOG "[";
117                         print LOG sprintf "%02d/%02d/%04d %02d:%02d:%02d",
118                                 $time[3], $time[4] + 1, $time[5] + 1900,
119                                 $time[2], $time[1], $time[0];
120                         print LOG "] onak-mail[$$]: Nothing to sync.\n";
121                         close LOG;
122                         $count = 0;
123                 }
124         
125                 if ($count > 0) {
126                         open(MAIL, "|$config{mta}");
127                         print MAIL "From: $config{adminemail}\n";
128                         print MAIL "To: ";
129                         foreach $i (@{$config{'syncsites'}}) {
130                                 if (! defined($seenby->{$i})) {
131                                         print MAIL "$i";
132                                         $count--;
133                                         if ($count > 0) {
134                                                 print MAIL ", ";
135                                         }
136                                 }
137                         }
138                         print MAIL "\n";
139                         print MAIL "Subject: incremental\n";
140                         foreach $site (keys %$seenby) {
141                                 print MAIL "X-KeyServer-Sent: $site\n";
142                         }
143                         print MAIL "X-KeyServer-Sent: $config{thissite}\n";
144                         print MAIL "Precedence: list\n";
145                         print MAIL "MIME-Version: 1.0\n";
146                         print MAIL "Content-Type: application/pgp-keys\n";
147                         print MAIL "\n";
148                         print MAIL @newupdate;
149                         close MAIL;
150                 }
151         } elsif ($subject =~ /^(VERBOSE )?INDEX (.*)$/i) {
152                 my (@indexdata, $command);
153         
154                 $command = "index";
155                 if (defined($1)) {
156                         $command = "vindex";
157                 }
158         
159                 my $pid = open3(\*INDEXIN, \*INDEXOUT, \*INDEXERR,
160                         $config{'pks_bin_dir'}."/onak", $command, "$2");
161                 close INDEXIN;
162                 @indexdata = <INDEXOUT>;
163                 close INDEXOUT;
164                 close INDEXERR;
165                 waitpid $pid, 0;
166         
167                 open(MAIL, "|$config{mta}");
168                 print MAIL "From: $config{adminemail}\n";
169                 print MAIL "To: $replyto\n";
170                 print MAIL "Subject: Reply to INDEX $2\n";
171                 print MAIL "Precedence: list\n";
172                 print MAIL "MIME-Version: 1.0\n";
173                 print MAIL "Content-Type: text/plain\n";
174                 print MAIL "\n";
175                 print MAIL "Below follows the reply to your recent keyserver query:\n";
176                 print MAIL "\n";
177                 print MAIL @indexdata;
178                 close MAIL;
179         }
180 }
181
182 my ($inheader, %seenby, $subject, $from, $replyto, @body, @syncmail);
183
184 &readconfig;
185
186 #
187 # First dump the incoming mail to a file; this means that if we're receiving
188 # loads of updates we don't spawn lots of processes but instead leave the
189 # mails on disk to be dealt with sequentially.
190 #
191 my @time = localtime;
192 my $tmpfile = sprintf "%s/%04d%02d%02d-%02d%02d%02d-%d.onak",
193                         $config{'mail_dir'},
194                         $time[5] + 1900,
195                         $time[4],
196                         $time[3],
197                         $time[2],
198                         $time[1],
199                         $time[0],
200                         $$;
201 open(MAILFILE, '>'.$tmpfile);
202 while (<>) {
203         print MAILFILE $_;
204 }
205 close(MAILFILE);
206
207 #
208 # Lock here to ensure that only one copy of us is processing the incoming
209 # mail queue at any point in time.
210 #
211 sysopen(LOCKFILE, $config{'db_dir'}.'/onak-mail.lck',
212                 O_WRONLY|O_CREAT|O_EXCL) or exit;
213 print LOCKFILE "$$";
214 close(LOCKFILE);
215
216 my $file;
217 opendir(MAILDIR, $config{'mail_dir'});
218 while ($file = readdir(MAILDIR)) {
219         next if $file !~ /\.onak$/;
220
221         $inheader = 1;
222         $subject = $from = $replyto = "";
223         undef %seenby;
224         @body = ();
225
226         open(FILE, '<'.$config{'mail_dir'}.'/'.$file);
227         while (<FILE>) {
228                 if ($inheader) {
229                         if (/^Subject:\s*(.*)\s*$/i) {
230                                 $subject = $1;
231                         } elsif (/^X-KeyServer-Sent:\s*(.*)\s*$/i) {
232                                 $seenby{$1} = 1;
233                         } elsif (/^From:\s*(.*)\s*$/i) {
234                                 $from = $1;
235                         } elsif (/^Reply-To:\s*(.*)\s*$/i) {
236                                 $replyto = $1;
237                         } elsif (/^$/) {
238                                 $inheader = 0;
239                         }
240                 }
241                 if (!$inheader) {
242                         push @body, $_;
243                 }
244         }
245         if (! defined($replyto)) {
246                 $replyto = $from;
247         }
248         close(FILE);
249         unlink $config{'mail_dir'}.'/'.$file;
250
251         processmail($subject, $from, $replyto, \%seenby, \@body);
252 }
253 closedir(MAILDIR);
254 unlink $config{'db_dir'}.'/onak-mail.lck';