chiark / gitweb /
8a7331a88a58044f5f8e7e74710a9f4a76fb759c
[modbot-mtm.git] / stump / bin / submission.pl
1 #
2 # this script accepts submissions that come to the robomoderator by
3 # email. It make s a decision whether the submission deserves
4 # rejection, automatic approval, or is suspicious and should be
5 # forwarded to human moderators for review.
6 #
7 # A decision is essentially a choice of the program that will be
8 # fed with preprocessed article.
9 #
10 # Also note that this script fixes common problems and mistakes in
11 # newsreaders, newsservers, and users. Even though we have no
12 # obligation to fix these problems, people get really disappointed
13 # if we outright reject their bogus messages, because these
14 # people often have no control over how the posts get delivered to us.
15 #
16 # This script supports notion of blacklisting and list of
17 # preapproved persons. As the names imply, we reject all submissions
18 # from blacklisted posters and automatically approve all messages submitted
19 # by preapproved posters (provided that their posts meet other criteria
20 # imposed by the robomoderator.
21 #
22 # For an automatic rejection, it gives a main "reason" for rejection
23 #
24 #Currently supported list of reasons: 
25 #
26 #       - crosspost
27 #       - abuse
28 #       - harassing
29 #       - offtopic
30
31 # get the directory where robomod is residing
32 $MNG_ROOT = $ENV{'MNG_ROOT'} || die "Root dir for moderation not specified";
33
34 # common library
35 require "$MNG_ROOT/bin/robomod.pl";
36
37 # max allowed number of newsgroups in crossposts
38 # change it if you want, but 5 is really good.
39 $maxNewsgroups = $ENV{'MAX_CROSSPOSTS'} || 5; 
40
41 # should we ALWAYS require preapproved posters to sign their submissions
42 # with PGP? Turn it on in the `etc/modenv' if you suffer from numerous
43 # forgeries in the names of preapproved posters.
44 $PGPCheckPreapproved = $ENV{ "WHITELIST_MUST_SIGN" } eq "YES";
45
46 # So, what newsgroup I am moderating?
47 $Newsgroup = $ENV{'NEWSGROUP'};
48
49 # as the name implies. ATTENTION: $TMP must be mode 700!!!
50 $TmpFile = "$ENV{'TMP'}/submission.$$";
51
52 # how do we treat suspicious articles?
53 $Command_Suspicious = "formail -a \"Newsgroups: $Newsgroup\" " .
54                       "| stump.pl suspicious.pl";
55
56 # approved
57 $Command_Approve = "processApproved robomod";
58 # rejected
59 $Command_Reject  = "processRejected robomod";
60
61 # location of blacklist
62 $badGuys = "bad.guys.list";
63
64 # location of preapproved list
65 $goodGuys = "good.guys.list";
66
67 # words that trigger robomod to mark messages suspicious, even 
68 # when the message comes from a preapproved person.
69 $badWords = "bad.words.list";
70
71 # list of people who want all their submissions to be signed
72 $PGPMustList = "pgp.must.list";
73
74 # set PMUSER and ROBOMOD to Internal. Will be used by `suspicious' script.
75 $ENV{'PMUSER'} = $ENV{'PMUSER_INTERNAL'};
76 $ENV{'ROBOMOD'} = $ENV{'ROBOMOD_INTERNAL'};
77
78
79 ######################################################################
80 # Filter rules
81 # checks if all is OK with newsgroups.
82 # what's not OK: 
83 #   1. Megacrossposts
84 #   2. Crossposts to other moderated groups
85 #   3. Control messages (currently)
86 #
87 sub checkNewsgroups {
88
89   # We have not implemented Control: yet...
90   if( $Control ) {
91 print STDERR "CONTROL message - rejected\n";
92     return "$Command_Reject crosspost You posted a Control message which " .
93            "is not allowed.";
94   }
95
96   if( $#newsgroups >= $maxNewsgroups ) {
97 print STDERR "Too many newsgroups\n";
98     return "$Command_Reject crosspost Too many newsgroups, " .
99            "$maxNewsgroups is maximum.";
100   }
101
102   local( $good ) = 0;
103
104   for( $i = 0; $i <= $#newsgroups; $i++ ) {
105
106     if( $newsgroups[$i] eq $Newsgroup ) {
107       $good = 1;
108       next;
109     }
110
111     if( $NewsgroupsDB{$newsgroups[$i]} eq 'm' && 
112         $newsgroups[$i] ne $Newsgroup) {
113 print STDERR "posting to ANOTHER moderated newsgroups\n";
114       return "$Command_Reject crosspost You crossposted to another " .
115              "moderated newsgroup.";
116     }
117
118   }
119
120   if( !$good ) { # Some fool forgot to list the moderated newsgroup
121                  # in the Newsgroups
122     $Newsgroups .= ",$Newsgroup";
123     if( $#newsgroups + 1 >= $maxNewsgroups ) {
124 print STDERR "Too many newsgroups\n";
125       return "$Command_Reject crosspost Too many newsgroups, FIVE is maximum.";
126     }
127   }
128
129   return 0;
130 }
131
132 ###################################################################### checkAck
133 # checks if poster needs acknowledgment of receipt
134 #
135 sub checkAck {
136   if( &nameIsInList( $From, "noack.list" ) ) {
137     $needAck = "no";
138   } else {
139     $needAck = "yes";
140   }
141 }
142
143 ################################################################### checkPGP
144 # checks PGP sig IF REQUIRED
145 #
146 # we can reject a post if
147 #
148 #   1. A post must be signed accordinng to rules OR
149 #   2. A post is signed but verification fails.
150 #
151 # Note that we set From: to the user ID in the PGP signature
152 # if a signature is present. It allows for identification of trolls
153 # and for preventing subtle forgeries.
154 #
155 sub checkPGP {
156
157   local( $FromSig ) = `verifySignature < $TmpFile`; chop( $FromSig );
158   local( $good ) = $? == 0;
159
160 print STDERR "FromSig = $FromSig, good = $good\n" if $FromSig;
161
162   if( !$good ) {
163     return "$Command_Reject signature Your PGP signature does NOT match, or is not in our keyring";
164   }
165
166   if( &nameIsInList( $From, $PGPMustList ) ||
167       ($PGPCheckPreapproved && &nameIsInList($From, $goodGuys) ) ) {
168     if( $FromSig eq "" ) {
169       return "$Command_Reject signature You are REQUIRED to sign your posts.";
170     } 
171   }
172
173   if( $FromSig ) {
174     $X_Origin = $From;
175     $From = "From: $FromSig";
176     $ReplyTo = $From;
177   }
178
179   # else nothing to do
180   return 0;
181 }
182
183 ################################################################ checkCharter
184 # checks charter calling conforms_charter
185 #
186 sub checkCharter {
187   open( VERIFY, "|conforms_charter" ) or die $!;
188   print VERIFY $Body or die $!;
189   close( VERIFY );
190
191   return $? == 0;
192 }
193
194 ################################################################### Filter
195 # contains all filtering rules. calls subroutines above.
196 sub Filter {
197
198
199   local( $response );
200
201   @newsgroups = split( /,/, $Newsgroups );
202
203   return "Command_Reject charter We do not allow any control and " .
204          "cancel messages. contact newsgroup administrator" 
205     if( $Control );
206
207   if( $response = &checkNewsgroups() ) {
208       return $response;
209   }
210
211   if( $paranoid_pgp ) {
212     if( $response = &checkPGP() ) {
213         return $response;
214     }
215   }
216
217   if( &nameIsInList( $From, $badGuys ) ) {
218     return "$Command_Reject blocklist";
219   }
220
221   # note that if even a preapproved person uses "BAD words" (that is
222   # words from a special list), his/her message will be marked
223   # "suspicious" and will be forwarded to a humen mod for review.
224   # As an example of a bad word may be "MAKE MONEY FAST - IT REALLY WORKS!!!"
225   #
226   if( $badWord = &nameIsInList( $Body, $badWords ) ) {
227 print STDERR "BAD WORD $badWord FOUND!!!\n";
228     return $Command_Suspicious; # messages from approved guys MAY be 
229                          # suspicious if they write about
230                          # homosexual forgers
231   }
232
233   # checking for charter-specific restrictions
234   if( !&checkCharter || ($Encoding =~ "base64") ) {
235     return "$Command_Reject charter you sent a " .
236            "binary encoded file which is not allowed.";
237   }
238
239   # Checking preapproved list
240   if( &nameIsInList( $From, $goodGuys ) ) {
241   local( $from ) = $From; $from =~ s/^From: //i;
242 print STDERR "$from is a PREAPPROVED person\n";
243     return $Command_Approve;
244   }
245
246   # Here I may put some more rules...
247
248   return $Command_Suspicious;
249 }
250
251 ######################################################################
252 # set defaults
253 sub setDefaults {
254   if( !$Newsgroups ) {
255     $Newsgroups = $ENV{ "NEWSGROUP" } || die "No default newsgroup";
256   }
257 }
258
259 ################################################################# ignoreHeader
260 # some of the header fields present in emails must be ignored.
261 #
262 sub ignoreHeader {
263   local( $header ) = pop( @_ );
264
265 #  return 1 if( $header =~ /^Control:/i );
266   return 1 if( $header =~ /^Expires:/i );
267   return 1 if( $header =~ /^Supersedes:/i );
268   return 1 if( $header =~ /^Precedence:/i );
269   return 1 if( $header =~ /^Apparently-To:/i );
270   return 1 if( $header =~ /^Date:/i );
271   return 1 if( $header =~ /^Expires:/i );
272   return 1 if( $header =~ /^Distribution:/i );
273   return 1 if( $header =~ /^Path:/i );
274   return 1 if( $header =~ /^NNTP-Posting-Host:/i );
275   return 1 if( $header =~ /^Xref:/i );
276   return 1 if( $header =~ /^Status:/i );
277   return 1 if( $header =~ /^Lines:/i );
278   return 1 if( $header =~ /^Apparently-To:/i );
279   return 1 if( $header =~ /^Cc:/i );
280   return 1 if( $header =~ /^Sender:/i );
281   return 1 if( $header =~ /^In-Reply-To:/i );
282   return 1 if( $header =~ /^Originator:/i );
283
284   return 0;
285 }
286
287
288 ######################################################################
289 # Getting data
290
291 # reads message, sets variables describing header fields
292 #
293 # it also tries to "fix" the problem with old newsservers (B-News I think)
294 # when they try to "wrap" a submission in one more layer of meaningless
295 # headers. It is recognized by STUPID presense of TWO identical To: 
296 # fields.
297 #
298
299 sub readMessage {
300
301 #open IWJL, ">>/home/webstump/t.log";
302 #print IWJL "=========== SUBMISSION READMESSAGE\n";
303
304   open( TMPFILE, "> $TmpFile" ) or die $!;
305
306   $IsBody = 0;
307   
308   while( <> ) {
309 #print IWJL "SbRm $_\n";
310     $Body .= $_;
311
312     if( !$IsBody && &ignoreHeader( $_ ) ) {
313       next;
314     }
315
316     print TMPFILE or die $!;
317   
318     chop;
319   
320     if( /^$/ ) {
321       if( !$Subject && $From =~ /news\@/) {
322         $BadNewsserver = 1;
323       }
324
325       if( $BadNewsserver ) { # just ignore the outer layer of headers
326         $To = 0;
327       } else {
328         $IsBody = 1;
329       }
330     }
331   
332     if( !$IsBody ) {
333   
334       if( /^Newsgroups: / ) { # set Newsgroups, remove spaces
335         $Newsgroups = $_;
336         $Newsgroups =~ s/^Newsgroups: //i;
337         $Newsgroups =~ s/ //g; # some fools put spaces in list of newsgroups
338       } elsif( /^Subject: / ) {
339         $Subject = $_;
340       } elsif( /^From: / ) {
341         $From = $_;
342       } elsif( /^To: / ) {
343         if( $To && ($To eq $_)) { 
344           # Old & crappy news servers that wrap submissions with one more
345           # layer of headers. For them, I simply ignore the outer
346           # headers. These (at least I think) submissions may be
347           # recognized by TWO idiotic To: header fields.
348 print STDERR "BAD NEWSSERVER\n";
349           $BadNewsserver = 1;
350         }
351         $To = $_;
352       } elsif( /^Path: / ) {
353         $Path = $_;
354       } elsif( /^Keywords: / ) {
355         $Keywords = $_;
356       } elsif( /^Summary: / ) {
357         $Summary = $_;
358       } elsif( /^Control: / ) {
359         $Control = $_;
360       } elsif( /^Message-ID: / ) {
361         $Message_ID = $_;
362       } elsif ( /^Content-Transfer-Encoding: / ) {
363         $Encoding = $_;
364         $Encoding =~ s/^Content-Transfer-Encoding: //;
365       }
366   
367     }
368   }
369 use IO::Handle;
370 #  print IWJL "SbRmE $!\n";
371   die "read message $! !" if STDIN->error;
372
373   close( TMPFILE );
374 }
375
376 ###################################################################### work
377 # all main work is done here
378
379 ######################################################################
380 # read the thing
381 &readMessage();
382
383 if( !$Newsgroups ) {
384   $Newsgroups = $Newsgroup;
385 }
386
387 ######################################################################
388 # process acks
389 &checkAck;
390 $Command_Suspicious .= " $needAck";
391
392 ######################################################################
393 # set defaults
394 &setDefaults();
395
396 ######################################################################
397 # Check
398
399 $command = &Filter;
400
401 ######################################################################
402 # process
403 print STDERR "command = $command\n";
404
405 #open IWJL, ">>/home/webstump/t.log";
406 #print IWJL "=========== SUBMISSION MAIN\n";
407
408 open( COMMAND, "| $command" ) or die $!;
409 open( TMPFILE, "$TmpFile" ) || die "cant open tmpfile";
410
411   $IsBody = 0;
412
413   while( <TMPFILE> ) {
414
415     if( $BadNewsserver && !(/^$/) ) {
416       next;
417     }
418
419     if( $BadNewsserver && /^$/ ) {
420       $BadNewsserver = 0;
421       next;
422     }
423
424     if( /^$/ ) {
425       $IsBody = 1;
426     }
427
428     if( /^From / ) {
429       print COMMAND or die $!;
430       print COMMAND "X-Origin: $X_Origin, $_" or die $! if $X_Origin;
431       print STDERR "Subject =`$Subject'\n";
432       print COMMAND "Subject: No subject given\n" or die $! if !$Subject;
433       # nothing
434     } elsif( /^From: / && !$IsBody) {
435       next if $FromWasUsed;
436
437       $FromWasUsed = 1; # note that some crappy remailers have several
438                         # "From: " fields. We really do NOT want two
439                         # "From: " to go to headers!
440
441       if( $From ) {
442         print COMMAND "$From\n" or die $!;
443         $From = "";
444       } else {
445         print COMMAND or die $!;
446       }
447     } elsif( /^Newsgroups: / && !$IsBody ) {
448       print COMMAND "Newsgroups: $Newsgroups\n" or die $!;
449     } else {
450       print COMMAND or die $!;
451     }
452   }
453
454 close( TMPFILE ) or die $!;
455 close( COMMAND ) or die "$? $!";
456
457 ################################################################## Archiving
458 # archive
459
460 #open( COMMAND, "| procmail -f- $MNG_ROOT/etc/procmail/save-incoming" );
461 #print COMMAND $Body;
462 #close( COMMAND );
463
464 unlink( $TmpFile );