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 my $fromaddr = $From;
137 $fromaddr =~ s/^[-A-Za-z]+\s*\:\s*//;
138 print STDERR "checking noack.list for \"$From|$fromaddr\"\n";
139 if( &nameIsInListExactly( $fromaddr, "noack.list" ) ) {
146 ################################################################### checkPGP
147 # checks PGP sig IF REQUIRED
149 # we can reject a post if
151 # 1. A post must be signed accordinng to rules OR
152 # 2. A post is signed but verification fails.
154 # Note that we set From: to the user ID in the PGP signature
155 # if a signature is present. It allows for identification of trolls
156 # and for preventing subtle forgeries.
160 local( $FromSig ) = `verifySignature < $TmpFile`; chop( $FromSig );
161 local( $good ) = $? == 0;
163 print STDERR "FromSig = $FromSig, good = $good\n" if $FromSig;
166 return "$Command_Reject signature Your PGP signature does NOT match, or is not in our keyring";
169 if( &nameIsInListRegexp( $From, $PGPMustList ) ||
170 ($PGPCheckPreapproved && &nameIsInListExactly($From, $goodGuys) ) ) {
171 if( $FromSig eq "" ) {
172 return "$Command_Reject signature You are REQUIRED to sign your posts.";
178 $From = "From: $FromSig";
186 ################################################################ checkCharter
187 # checks charter calling conforms_charter
190 open( VERIFY, "|conforms_charter" ) or die $!;
191 print VERIFY $Body or die $!;
197 ################################################################### Filter
198 # contains all filtering rules. calls subroutines above.
204 @newsgroups = split( /,/, $Newsgroups );
206 return "Command_Reject charter We do not allow any control and " .
207 "cancel messages. contact newsgroup administrator"
210 if( $response = &checkNewsgroups() ) {
214 if( $paranoid_pgp ) {
215 if( $response = &checkPGP() ) {
220 if( &nameIsInListRegexp( $From, $badGuys ) ) {
221 return "$Command_Reject blocklist";
224 # note that if even a preapproved person uses "BAD words" (that is
225 # words from a special list), his/her message will be marked
226 # "suspicious" and will be forwarded to a humen mod for review.
227 # As an example of a bad word may be "MAKE MONEY FAST - IT REALLY WORKS!!!"
229 if( $badWord = &nameIsInListRegexp( $Body, $badWords ) ) {
230 print STDERR "BAD WORD $badWord FOUND!!!\n";
231 return $Command_Suspicious; # messages from approved guys MAY be
232 # suspicious if they write about
236 # checking for charter-specific restrictions
237 if( !&checkCharter || ($Encoding =~ "base64") ) {
238 return "$Command_Reject charter you sent a " .
239 "binary encoded file which is not allowed.";
242 # Checking preapproved list
243 if( &nameIsInListExactly( $From, $goodGuys ) ) {
244 local( $from ) = $From; $from =~ s/^From: //i;
245 print STDERR "$from is a PREAPPROVED person\n";
246 return $Command_Approve;
249 # Here I may put some more rules...
251 return $Command_Suspicious;
254 ######################################################################
258 $Newsgroups = $ENV{ "NEWSGROUP" } || die "No default newsgroup";
262 ################################################################# ignoreHeader
263 # some of the header fields present in emails must be ignored.
266 local( $header ) = pop( @_ );
268 # return 1 if( $header =~ /^Control:/i );
269 return 1 if( $header =~ /^Expires:/i );
270 return 1 if( $header =~ /^Supersedes:/i );
271 return 1 if( $header =~ /^Precedence:/i );
272 return 1 if( $header =~ /^Apparently-To:/i );
273 return 1 if( $header =~ /^Expires:/i );
274 return 1 if( $header =~ /^Distribution:/i );
275 return 1 if( $header =~ /^Path:/i );
276 return 1 if( $header =~ /^NNTP-Posting-Host:/i );
277 return 1 if( $header =~ /^Xref:/i );
278 return 1 if( $header =~ /^Status:/i );
279 return 1 if( $header =~ /^Lines:/i );
280 return 1 if( $header =~ /^Apparently-To:/i );
281 return 1 if( $header =~ /^Cc:/i );
282 return 1 if( $header =~ /^Sender:/i );
283 return 1 if( $header =~ /^In-Reply-To:/i );
284 return 1 if( $header =~ /^Originator:/i );
285 return 1 if( $header =~ /^X-Trace:/i );
286 return 1 if( $header =~ /^X-Complaints-To:/i );
287 return 1 if( $header =~ /^NNTP-Posting-Date:/i );
293 ######################################################################
296 # reads message, sets variables describing header fields
298 # it also tries to "fix" the problem with old newsservers (B-News I think)
299 # when they try to "wrap" a submission in one more layer of meaningless
300 # headers. It is recognized by STUPID presense of TWO identical To:
306 #open IWJL, ">>/home/webstump/t.log";
307 #print IWJL "=========== SUBMISSION READMESSAGE\n";
309 open( TMPFILE, "> $TmpFile" ) or die $!;
318 sprintf "X-STUMP-Warning-%d: %s\n", $warnings++, $_[0];
321 #open TTY, ">/home/webstump/t";
323 #print TTY "=| $IsBody | $readahead ...\n";
324 if (!defined $readahead) {
325 # we got EOF earlier;
328 if (length $readahead) {
336 # right now there is no readahead, since we just consumed it into $_
337 if ($_ !~ m/^\r?\n$/) { # blank line ? no...
339 if (defined $readahead && $readahead =~ m/^[ \t]/) {
340 # this is a continuation, keep stashing
341 $readahead = $_.$readahead;
344 # OK, $readahead is perhaps:
345 # - undef: we got eof
346 # - empty line: signalling end of (these) headers
347 # - start of next header
348 # In these cases, keep that in $readahead for now,
349 # and process the previous header, which is in $_.
350 # But, first, a wrinkle ...
351 push @unfolded, (m/^[^:]+:/ ? $& : '????')
353 if (length $_ > 505) { #wtf
354 $_ = substr($_, 0, 500);
357 $_ = $warning->("Next header truncated!");
360 # $_ is empty line at end of headers
361 # (and, there is no $readahead)
363 # insert this warning into the right set of headers
365 $_ = $warning->("Unfolded headers @unfolded");
369 # Now we have in $_ either a complete header, unfolded,
370 # or the empty line at the end of headers
372 #print TTY "=> $IsBody | $readahead | $_ ...\n";
376 if( !$IsBody && &ignoreHeader( $_ ) ) {
380 print TMPFILE or die $!;
385 if( !$Subject && $From =~ /news\@/) {
389 if( $BadNewsserver ) { # just ignore the outer layer of headers
398 if( /^Newsgroups: / ) { # set Newsgroups, remove spaces
400 $Newsgroups =~ s/^Newsgroups: //i;
401 $Newsgroups =~ s/ //g; # some fools put spaces in list of newsgroups
402 } elsif( /^Subject: / ) {
404 } elsif( /^From: / ) {
407 if( $To && ($To eq $_)) {
408 # Old & crappy news servers that wrap submissions with one more
409 # layer of headers. For them, I simply ignore the outer
410 # headers. These (at least I think) submissions may be
411 # recognized by TWO idiotic To: header fields.
412 print STDERR "BAD NEWSSERVER\n";
416 } elsif( /^Path: / ) {
418 } elsif( /^Keywords: / ) {
420 } elsif( /^Summary: / ) {
422 } elsif( /^Control: / ) {
424 } elsif( /^Message-ID: / ) {
426 } elsif ( /^Content-Transfer-Encoding: / ) {
428 $Encoding =~ s/^Content-Transfer-Encoding: //;
434 # print IWJL "SbRmE $!\n";
435 die "read message $! !" if STDIN->error;
440 ###################################################################### work
441 # all main work is done here
443 ######################################################################
448 $Newsgroups = $Newsgroup;
451 ######################################################################
454 $Command_Suspicious .= " $needAck";
456 ######################################################################
460 ######################################################################
465 ######################################################################
467 print STDERR "command = $command\n";
469 #open IWJL, ">>/home/webstump/t.log";
470 #print IWJL "=========== SUBMISSION MAIN\n";
472 open( COMMAND, "| $command" ) or die $!;
473 open( TMPFILE, "$TmpFile" ) || die "cant open tmpfile";
479 if( $BadNewsserver && !(/^$/) ) {
483 if( $BadNewsserver && /^$/ ) {
493 print COMMAND or die $!;
494 print COMMAND "X-Origin: $X_Origin, $_" or die $! if $X_Origin;
495 print STDERR "Subject =`$Subject'\n";
496 print COMMAND "Subject: No subject given\n" or die $! if !$Subject;
498 } elsif( /^From: / && !$IsBody) {
499 next if $FromWasUsed;
501 $FromWasUsed = 1; # note that some crappy remailers have several
502 # "From: " fields. We really do NOT want two
503 # "From: " to go to headers!
506 print COMMAND "$From\n" or die $!;
509 print COMMAND or die $!;
511 } elsif( /^Newsgroups: / && !$IsBody ) {
512 print COMMAND "Newsgroups: $Newsgroups\n" or die $!;
514 print COMMAND or die $!;
518 close( TMPFILE ) or die $!;
519 close( COMMAND ) or die "$? $!";
521 ################################################################## Archiving
524 #open( COMMAND, "| procmail -f- $MNG_ROOT/etc/procmail/save-incoming" );
525 #print COMMAND $Body;