]> the.earth.li Git - onak.git/blob - onak-mail.pl.in
Obey binary flag for "onak get"
[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|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';