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.
7 # A decision is essentially a choice of the program that will be
8 # fed with preprocessed article.
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.
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.
22 # For an automatic rejection, it gives a main "reason" for rejection
24 #Currently supported list of reasons:
31 # get the directory where robomod is residing
32 $MNG_ROOT = $ENV{'MNG_ROOT'} || die "Root dir for moderation not specified";
35 require "$MNG_ROOT/bin/robomod.pl";
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;
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";
46 # So, what newsgroup I am moderating?
47 $Newsgroup = $ENV{'NEWSGROUP'};
49 # as the name implies. ATTENTION: $TMP must be mode 700!!!
50 $TmpFile = "$ENV{'TMP'}/submission.$$";
52 # how do we treat suspicious articles?
53 $Command_Suspicious = "formail -a \"Newsgroups: $Newsgroup\" " .
54 "| stump.pl suspicious.pl";
57 $Command_Approve = "processApproved robomod";
59 $Command_Reject = "processRejected robomod";
61 # location of blacklist
62 $badGuys = "bad.guys.list";
64 # location of preapproved list
65 $goodGuys = "good.guys.list";
67 # words that trigger robomod to mark messages suspicious, even
68 # when the message comes from a preapproved person.
69 $badWords = "bad.words.list";
71 # list of people who want all their submissions to be signed
72 $PGPMustList = "pgp.must.list";
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'};
79 ######################################################################
81 # checks if all is OK with newsgroups.
84 # 2. Crossposts to other moderated groups
85 # 3. Control messages (currently)
89 # We have not implemented Control: yet...
91 print STDERR "CONTROL message - rejected\n";
92 return "$Command_Reject crosspost You posted a Control message which " .
96 if( $#newsgroups >= $maxNewsgroups ) {
97 print STDERR "Too many newsgroups\n";
98 return "$Command_Reject crosspost Too many newsgroups, " .
99 "$maxNewsgroups is maximum.";
104 for( $i = 0; $i <= $#newsgroups; $i++ ) {
106 if( $newsgroups[$i] eq $Newsgroup ) {
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.";
120 if( !$good ) { # Some fool forgot to list the moderated newsgroup
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.";
132 ###################################################################### checkAck
133 # checks if poster needs acknowledgment of receipt
136 #ULM mods want to disable this, so just return "no"
140 ################################################################### checkPGP
141 # checks PGP sig IF REQUIRED
143 # we can reject a post if
145 # 1. A post must be signed accordinng to rules OR
146 # 2. A post is signed but verification fails.
148 # Note that we set From: to the user ID in the PGP signature
149 # if a signature is present. It allows for identification of trolls
150 # and for preventing subtle forgeries.
154 local( $FromSig ) = `verifySignature < $TmpFile`; chop( $FromSig );
155 local( $good ) = $? == 0;
157 print STDERR "FromSig = $FromSig, good = $good\n" if $FromSig;
160 return "$Command_Reject signature Your PGP signature does NOT match, or is not in our keyring";
163 if( &nameIsInListRegexp( $From, $PGPMustList ) ||
164 ($PGPCheckPreapproved && &nameIsInListExactly($From, $goodGuys) ) ) {
165 if( $FromSig eq "" ) {
166 return "$Command_Reject signature You are REQUIRED to sign your posts.";
172 $From = "From: $FromSig";
180 ################################################################ checkCharter
181 # checks charter calling conforms_charter
184 open( VERIFY, "|conforms_charter" ) or die $!;
185 print VERIFY $Body or die $!;
191 ################################################################### Filter
192 # contains all filtering rules. calls subroutines above.
198 @newsgroups = split( /,/, $Newsgroups );
200 return "Command_Reject charter We do not allow any control and " .
201 "cancel messages. contact newsgroup administrator"
204 if( $response = &checkNewsgroups() ) {
208 if( $paranoid_pgp ) {
209 if( $response = &checkPGP() ) {
214 if( &nameIsInListRegexp( $From, $badGuys ) ) {
215 return "$Command_Reject blocklist";
218 # note that if even a preapproved person uses "BAD words" (that is
219 # words from a special list), his/her message will be marked
220 # "suspicious" and will be forwarded to a humen mod for review.
221 # As an example of a bad word may be "MAKE MONEY FAST - IT REALLY WORKS!!!"
223 if( $badWord = &nameIsInListRegexp( $Body, $badWords ) ) {
224 print STDERR "BAD WORD $badWord FOUND!!!\n";
225 return $Command_Suspicious; # messages from approved guys MAY be
226 # suspicious if they write about
230 # checking for charter-specific restrictions
231 if( !&checkCharter || ($Encoding =~ "base64") ) {
232 return "$Command_Reject charter you sent a " .
233 "binary encoded file which is not allowed.";
236 # Checking preapproved list
237 if( &nameIsInListExactly( $From, $goodGuys ) ) {
238 local( $from ) = $From; $from =~ s/^From: //i;
239 print STDERR "$from is a PREAPPROVED person\n";
240 return $Command_Approve;
243 # Here I may put some more rules...
245 return $Command_Suspicious;
248 ######################################################################
252 $Newsgroups = $ENV{ "NEWSGROUP" } || die "No default newsgroup";
256 ################################################################# ignoreHeader
257 # some of the header fields present in emails must be ignored.
260 local( $header ) = pop( @_ );
262 # return 1 if( $header =~ /^Control:/i );
263 return 1 if( $header =~ /^Expires:/i );
264 return 1 if( $header =~ /^Supersedes:/i );
265 return 1 if( $header =~ /^Precedence:/i );
266 return 1 if( $header =~ /^Apparently-To:/i );
267 return 1 if( $header =~ /^Expires:/i );
268 return 1 if( $header =~ /^Distribution:/i );
269 return 1 if( $header =~ /^Path:/i );
270 return 1 if( $header =~ /^NNTP-Posting-Host:/i );
271 return 1 if( $header =~ /^Xref:/i );
272 return 1 if( $header =~ /^Status:/i );
273 return 1 if( $header =~ /^Lines:/i );
274 return 1 if( $header =~ /^Apparently-To:/i );
275 return 1 if( $header =~ /^Cc:/i );
276 return 1 if( $header =~ /^Sender:/i );
277 return 1 if( $header =~ /^In-Reply-To:/i );
278 return 1 if( $header =~ /^Originator:/i );
279 return 1 if( $header =~ /^X-Trace:/i );
280 return 1 if( $header =~ /^X-Complaints-To:/i );
281 return 1 if( $header =~ /^NNTP-Posting-Date:/i );
287 ######################################################################
290 # reads message, sets variables describing header fields
292 # it also tries to "fix" the problem with old newsservers (B-News I think)
293 # when they try to "wrap" a submission in one more layer of meaningless
294 # headers. It is recognized by STUPID presense of TWO identical To:
300 #open IWJL, ">>/home/webstump/t.log";
301 #print IWJL "=========== SUBMISSION READMESSAGE\n";
303 open( TMPFILE, "> $TmpFile" ) or die $!;
312 sprintf "X-STUMP-Warning-%d: %s\n", $warnings++, $_[0];
315 #open TTY, ">/home/webstump/t";
317 #print TTY "=| $IsBody | $readahead ...\n";
318 if (!defined $readahead) {
319 # we got EOF earlier;
322 if (length $readahead) {
330 # right now there is no readahead, since we just consumed it into $_
331 if ($_ !~ m/^\r?\n$/) { # blank line ? no...
333 if (defined $readahead && $readahead =~ m/^[ \t]/) {
334 # this is a continuation, keep stashing
335 $readahead = $_.$readahead;
338 # OK, $readahead is perhaps:
339 # - undef: we got eof
340 # - empty line: signalling end of (these) headers
341 # - start of next header
342 # In these cases, keep that in $readahead for now,
343 # and process the previous header, which is in $_.
344 # But, first, a wrinkle ...
345 if (!m/^(?:References):/i) {
346 push @unfolded, (m/^[^:]+:/ ? $& : '????')
348 if (length $_ > 505) { #wtf
349 $_ = substr($_, 0, 500);
353 $_ = $warning->("Next header ($&) truncated!");
357 # $_ is empty line at end of headers
358 # (and, there is no $readahead)
360 # insert this warning into the right set of headers
362 $_ = $warning->("Unfolded headers @unfolded");
366 # Now we have in $_ either a complete header, unfolded,
367 # or the empty line at the end of headers
369 #print TTY "=> $IsBody | $readahead | $_ ...\n";
373 if( !$IsBody && &ignoreHeader( $_ ) ) {
377 print TMPFILE or die $!;
382 if( !$Subject && $From =~ /news\@/) {
386 if( $BadNewsserver ) { # just ignore the outer layer of headers
395 if( /^Newsgroups: / ) { # set Newsgroups, remove spaces
397 $Newsgroups =~ s/^Newsgroups: //i;
398 $Newsgroups =~ s/ //g; # some fools put spaces in list of newsgroups
399 } elsif( /^Subject: / ) {
401 } elsif( /^From: / ) {
404 if( $To && ($To eq $_)) {
405 # Old & crappy news servers that wrap submissions with one more
406 # layer of headers. For them, I simply ignore the outer
407 # headers. These (at least I think) submissions may be
408 # recognized by TWO idiotic To: header fields.
409 print STDERR "BAD NEWSSERVER\n";
413 } elsif( /^Path: / ) {
415 } elsif( /^Keywords: / ) {
417 } elsif( /^Summary: / ) {
419 } elsif( /^Control: / ) {
421 } elsif( /^Message-ID: / ) {
423 } elsif ( /^Content-Transfer-Encoding: / ) {
425 $Encoding =~ s/^Content-Transfer-Encoding: //;
431 # print IWJL "SbRmE $!\n";
432 die "read message $! !" if STDIN->error;
437 ###################################################################### work
438 # all main work is done here
440 ######################################################################
445 $Newsgroups = $Newsgroup;
448 ######################################################################
451 $Command_Suspicious .= " $needAck";
453 ######################################################################
457 ######################################################################
462 ######################################################################
464 print STDERR "command = $command\n";
466 #open IWJL, ">>/home/webstump/t.log";
467 #print IWJL "=========== SUBMISSION MAIN\n";
469 open( COMMAND, "| $command" ) or die $!;
470 open( TMPFILE, "$TmpFile" ) || die "cant open tmpfile";
476 if( $BadNewsserver && !(/^$/) ) {
480 if( $BadNewsserver && /^$/ ) {
490 print COMMAND or die $!;
491 print COMMAND "X-Origin: $X_Origin, $_" or die $! if $X_Origin;
492 print STDERR "Subject =`$Subject'\n";
493 print COMMAND "Subject: No subject given\n" or die $! if !$Subject;
495 } elsif( /^From: / && !$IsBody) {
496 next if $FromWasUsed;
498 $FromWasUsed = 1; # note that some crappy remailers have several
499 # "From: " fields. We really do NOT want two
500 # "From: " to go to headers!
503 print COMMAND "$From\n" or die $!;
506 print COMMAND or die $!;
508 } elsif( /^Newsgroups: / && !$IsBody ) {
509 print COMMAND "Newsgroups: $Newsgroups\n" or die $!;
511 print COMMAND or die $!;
515 close( TMPFILE ) or die $!;
516 close( COMMAND ) or die "$? $!";
518 ################################################################## Archiving
521 #open( COMMAND, "| procmail -f- $MNG_ROOT/etc/procmail/save-incoming" );
522 #print COMMAND $Body;