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 =~ /^Date:/i );
274 return 1 if( $header =~ /^Expires:/i );
275 return 1 if( $header =~ /^Distribution:/i );
276 return 1 if( $header =~ /^Path:/i );
277 return 1 if( $header =~ /^NNTP-Posting-Host:/i );
278 return 1 if( $header =~ /^Xref:/i );
279 return 1 if( $header =~ /^Status:/i );
280 return 1 if( $header =~ /^Lines:/i );
281 return 1 if( $header =~ /^Apparently-To:/i );
282 return 1 if( $header =~ /^Cc:/i );
283 return 1 if( $header =~ /^Sender:/i );
284 return 1 if( $header =~ /^In-Reply-To:/i );
285 return 1 if( $header =~ /^Originator:/i );
291 ######################################################################
294 # reads message, sets variables describing header fields
296 # it also tries to "fix" the problem with old newsservers (B-News I think)
297 # when they try to "wrap" a submission in one more layer of meaningless
298 # headers. It is recognized by STUPID presense of TWO identical To:
304 #open IWJL, ">>/home/webstump/t.log";
305 #print IWJL "=========== SUBMISSION READMESSAGE\n";
307 open( TMPFILE, "> $TmpFile" ) or die $!;
312 #print IWJL "SbRm $_\n";
315 if( !$IsBody && &ignoreHeader( $_ ) ) {
319 print TMPFILE or die $!;
324 if( !$Subject && $From =~ /news\@/) {
328 if( $BadNewsserver ) { # just ignore the outer layer of headers
337 if( /^Newsgroups: / ) { # set Newsgroups, remove spaces
339 $Newsgroups =~ s/^Newsgroups: //i;
340 $Newsgroups =~ s/ //g; # some fools put spaces in list of newsgroups
341 } elsif( /^Subject: / ) {
343 } elsif( /^From: / ) {
346 if( $To && ($To eq $_)) {
347 # Old & crappy news servers that wrap submissions with one more
348 # layer of headers. For them, I simply ignore the outer
349 # headers. These (at least I think) submissions may be
350 # recognized by TWO idiotic To: header fields.
351 print STDERR "BAD NEWSSERVER\n";
355 } elsif( /^Path: / ) {
357 } elsif( /^Keywords: / ) {
359 } elsif( /^Summary: / ) {
361 } elsif( /^Control: / ) {
363 } elsif( /^Message-ID: / ) {
365 } elsif ( /^Content-Transfer-Encoding: / ) {
367 $Encoding =~ s/^Content-Transfer-Encoding: //;
373 # print IWJL "SbRmE $!\n";
374 die "read message $! !" if STDIN->error;
379 ###################################################################### work
380 # all main work is done here
382 ######################################################################
387 $Newsgroups = $Newsgroup;
390 ######################################################################
393 $Command_Suspicious .= " $needAck";
395 ######################################################################
399 ######################################################################
404 ######################################################################
406 print STDERR "command = $command\n";
408 #open IWJL, ">>/home/webstump/t.log";
409 #print IWJL "=========== SUBMISSION MAIN\n";
411 open( COMMAND, "| $command" ) or die $!;
412 open( TMPFILE, "$TmpFile" ) || die "cant open tmpfile";
418 if( $BadNewsserver && !(/^$/) ) {
422 if( $BadNewsserver && /^$/ ) {
432 print COMMAND or die $!;
433 print COMMAND "X-Origin: $X_Origin, $_" or die $! if $X_Origin;
434 print STDERR "Subject =`$Subject'\n";
435 print COMMAND "Subject: No subject given\n" or die $! if !$Subject;
437 } elsif( /^From: / && !$IsBody) {
438 next if $FromWasUsed;
440 $FromWasUsed = 1; # note that some crappy remailers have several
441 # "From: " fields. We really do NOT want two
442 # "From: " to go to headers!
445 print COMMAND "$From\n" or die $!;
448 print COMMAND or die $!;
450 } elsif( /^Newsgroups: / && !$IsBody ) {
451 print COMMAND "Newsgroups: $Newsgroups\n" or die $!;
453 print COMMAND or die $!;
457 close( TMPFILE ) or die $!;
458 close( COMMAND ) or die "$? $!";
460 ################################################################## Archiving
463 #open( COMMAND, "| procmail -f- $MNG_ROOT/etc/procmail/save-incoming" );
464 #print COMMAND $Body;