Update Debian Vcs-* fields to point to git repository
[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 # 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 (/^db_dir (.*)/) {
41                         $config{'db_dir'} = $1;
42                 } elsif (/^mail_dir (.*)/) {
43                         $config{'mail_dir'} = $1;
44                 } elsif (/^syncsite (.*)/) {
45                         push @{$config{'syncsites'}}, $1;
46                 }
47         }
48
49         close(CONFIG);
50
51         return;
52 }
53
54 #
55 # submitupdate
56 #
57 # Takes an armored OpenPGP stream and submits it to the keyserver. Returns the
58 # difference between what we just added and what we had before (ie the least
59 # data need to get from what we had to what we have).
60 #
61 sub submitupdate($) {
62         my $data = shift;
63         my (@errors, @mergedata);
64
65         my $pid = open3(\*MERGEIN, \*MERGEOUT, \*MERGEERR,
66                 $config{'pks_bin_dir'}."/onak", "-u", "add");
67
68         print MERGEIN @$data;
69         close MERGEIN;
70         @mergedata = <MERGEOUT>;
71         close MERGEOUT;
72         @errors = <MERGEERR>;
73         close MERGEERR;
74         waitpid $pid, 0;
75
76         return @mergedata;
77 }
78
79
80 sub processmail($$$$$) {
81         my $subject = shift;
82         my $from = shift;
83         my $replyto = shift;
84         my $seenby = shift;
85         my $body = shift;
86         
87         # HELP, ADD, INCREMENTAL, VERBOSE INDEX <keyid>, INDEX <keyid>,
88         # GET <keyid>, LAST <days>
89         
90         if ($subject =~ /^(INCREMENTAL|ADD)$/i) {
91                 my $site;
92                 my $count;
93                 my $i;
94                 my @newupdate = submitupdate($body);
95                 my @time;
96         
97                 $count = 0;
98                 foreach $i (@{$config{'syncsites'}}) {
99                         if (! defined($seenby->{$i})) {
100                                 $count++;
101                         }
102                 }
103         
104                 open (LOG, ">>$config{'logfile'}");
105                 @time = localtime(time);
106                 print LOG "[";
107                 print LOG sprintf "%02d/%02d/%04d %02d:%02d:%02d",
108                         $time[3], $time[4] + 1, $time[5] + 1900,
109                         $time[2], $time[1], $time[0];
110                 print LOG "] onak-mail[$$]: Syncing with $count sites.\n";
111                 close LOG;
112
113                 if ($subject =~ /ADD/i) {
114                         open(MAIL, "|$config{mta}");
115                         print MAIL "From: $config{adminemail}\n";
116                         print MAIL "To: $replyto\n";
117                         print MAIL "Subject: Reply to ADD\n";
118                         print MAIL "Precedence: list\n";
119                         print MAIL "MIME-Version: 1.0\n";
120                         print MAIL "Content-Type: text/plain\n";
121                         print MAIL "\n";
122                         print MAIL "Thank you for your recent key submission.",
123                                 " It has been processed and synced\n",
124                                 "with ", $count, " other keyservers.\n";
125                         close MAIL;
126                 }
127         
128                 if ((! defined($newupdate[0])) || $newupdate[0] eq '') {
129                         open (LOG, ">>$config{'logfile'}");
130                         print LOG "[";
131                         print LOG sprintf "%02d/%02d/%04d %02d:%02d:%02d",
132                                 $time[3], $time[4] + 1, $time[5] + 1900,
133                                 $time[2], $time[1], $time[0];
134                         print LOG "] onak-mail[$$]: Nothing to sync.\n";
135                         close LOG;
136                         $count = 0;
137                 }
138         
139                 if ($count > 0) {
140                         open(MAIL, "|$config{mta}");
141                         print MAIL "From: $config{adminemail}\n";
142                         print MAIL "To: ";
143                         foreach $i (@{$config{'syncsites'}}) {
144                                 if (! defined($seenby->{$i})) {
145                                         print MAIL "$i";
146                                         $count--;
147                                         if ($count > 0) {
148                                                 print MAIL ", ";
149                                         }
150                                 }
151                         }
152                         print MAIL "\n";
153                         print MAIL "Subject: incremental\n";
154                         foreach $site (keys %$seenby) {
155                                 print MAIL "X-KeyServer-Sent: $site\n";
156                         }
157                         print MAIL "X-KeyServer-Sent: $config{thissite}\n";
158                         print MAIL "Precedence: list\n";
159                         print MAIL "MIME-Version: 1.0\n";
160                         print MAIL "Content-Type: application/pgp-keys\n";
161                         print MAIL "\n";
162                         print MAIL @newupdate;
163                         close MAIL;
164                 }
165         } elsif ($subject =~ /^(VERBOSE )?INDEX (.*)$/i) {
166                 my (@indexdata, $command);
167         
168                 $command = "index";
169                 if (defined($1)) {
170                         $command = "vindex";
171                 }
172         
173                 my $pid = open3(\*INDEXIN, \*INDEXOUT, \*INDEXERR,
174                         $config{'pks_bin_dir'}."/onak", $command, "$2");
175                 close INDEXIN;
176                 @indexdata = <INDEXOUT>;
177                 close INDEXOUT;
178                 close INDEXERR;
179                 waitpid $pid, 0;
180         
181                 open(MAIL, "|$config{mta}");
182                 print MAIL "From: $config{adminemail}\n";
183                 print MAIL "To: $replyto\n";
184                 print MAIL "Subject: Reply to INDEX $2\n";
185                 print MAIL "Precedence: list\n";
186                 print MAIL "MIME-Version: 1.0\n";
187                 print MAIL "Content-Type: text/plain\n";
188                 print MAIL "\n";
189                 print MAIL "Below follows the reply to your recent keyserver query:\n";
190                 print MAIL "\n";
191                 print MAIL @indexdata;
192                 close MAIL;
193         }
194 }
195
196 my ($inheader, %seenby, $subject, $from, $replyto, @body, @syncmail);
197
198 &readconfig;
199
200 #
201 # First dump the incoming mail to a file; this means that if we're receiving
202 # loads of updates we don't spawn lots of processes but instead leave the
203 # mails on disk to be dealt with sequentially.
204 #
205 my @time = localtime;
206 my $tmpfile = sprintf "%s/%04d%02d%02d-%02d%02d%02d-%d.onak",
207                         $config{'mail_dir'},
208                         $time[5] + 1900,
209                         $time[4],
210                         $time[3],
211                         $time[2],
212                         $time[1],
213                         $time[0],
214                         $$;
215 open(MAILFILE, '>'.$tmpfile.'.tmp');
216 while (<>) {
217         print MAILFILE $_;
218 }
219 close(MAILFILE);
220 rename $tmpfile.".tmp", $tmpfile;
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';