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 if( &nameIsInList( $From, "noack.list" ) ) {
143 ################################################################### checkPGP
144 # checks PGP sig IF REQUIRED
146 # we can reject a post if
148 # 1. A post must be signed accordinng to rules OR
149 # 2. A post is signed but verification fails.
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.
157 local( $FromSig ) = `verifySignature < $TmpFile`; chop( $FromSig );
158 local( $good ) = $? == 0;
160 print STDERR "FromSig = $FromSig, good = $good\n" if $FromSig;
163 return "$Command_Reject signature Your PGP signature does NOT match, or is not in our keyring";
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.";
175 $From = "From: $FromSig";
183 ################################################################ checkCharter
184 # checks charter calling conforms_charter
187 open( VERIFY, "|conforms_charter" ) or die $!;
188 print VERIFY $Body or die $!;
194 ################################################################### Filter
195 # contains all filtering rules. calls subroutines above.
201 @newsgroups = split( /,/, $Newsgroups );
203 return "Command_Reject charter We do not allow any control and " .
204 "cancel messages. contact newsgroup administrator"
207 if( $response = &checkNewsgroups() ) {
211 if( $paranoid_pgp ) {
212 if( $response = &checkPGP() ) {
217 if( &nameIsInList( $From, $badGuys ) ) {
218 return "$Command_Reject abuse";
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!!!"
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
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.";
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;
246 # Here I may put some more rules...
248 return $Command_Suspicious;
251 ######################################################################
255 $Newsgroups = $ENV{ "NEWSGROUP" } || die "No default newsgroup";
259 ################################################################# ignoreHeader
260 # some of the header fields present in emails must be ignored.
263 local( $header ) = pop( @_ );
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 );
288 ######################################################################
291 # reads message, sets variables describing header fields
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:
301 #open IWJL, ">>/home/webstump/t.log";
302 #print IWJL "=========== SUBMISSION READMESSAGE\n";
304 open( TMPFILE, "> $TmpFile" ) or die $!;
309 #print IWJL "SbRm $_\n";
312 if( !$IsBody && &ignoreHeader( $_ ) ) {
316 print TMPFILE or die $!;
321 if( !$Subject && $From =~ /news\@/) {
325 if( $BadNewsserver ) { # just ignore the outer layer of headers
334 if( /^Newsgroups: / ) { # set Newsgroups, remove spaces
336 $Newsgroups =~ s/^Newsgroups: //i;
337 $Newsgroups =~ s/ //g; # some fools put spaces in list of newsgroups
338 } elsif( /^Subject: / ) {
340 } elsif( /^From: / ) {
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";
352 } elsif( /^Path: / ) {
354 } elsif( /^Keywords: / ) {
356 } elsif( /^Summary: / ) {
358 } elsif( /^Control: / ) {
360 } elsif( /^Message-ID: / ) {
362 } elsif ( /^Content-Transfer-Encoding: / ) {
364 $Encoding =~ s/^Content-Transfer-Encoding: //;
370 # print IWJL "SbRmE $!\n";
371 die "read message $! !" if STDIN->error;
376 ###################################################################### work
377 # all main work is done here
379 ######################################################################
384 $Newsgroups = $Newsgroup;
387 ######################################################################
390 $Command_Suspicious .= " $needAck";
392 ######################################################################
396 ######################################################################
401 ######################################################################
403 print STDERR "command = $command\n";
405 #open IWJL, ">>/home/webstump/t.log";
406 #print IWJL "=========== SUBMISSION MAIN\n";
408 open( COMMAND, "| $command" ) or die $!;
409 open( TMPFILE, "$TmpFile" ) || die "cant open tmpfile";
415 if( $BadNewsserver && !(/^$/) ) {
419 if( $BadNewsserver && /^$/ ) {
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;
434 } elsif( /^From: / && !$IsBody) {
435 next if $FromWasUsed;
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!
442 print COMMAND "$From\n" or die $!;
445 print COMMAND or die $!;
447 } elsif( /^Newsgroups: / && !$IsBody ) {
448 print COMMAND "Newsgroups: $Newsgroups\n" or die $!;
450 print COMMAND or die $!;
454 close( TMPFILE ) or die $!;
455 close( COMMAND ) or die "$? $!";
457 ################################################################## Archiving
460 #open( COMMAND, "| procmail -f- $MNG_ROOT/etc/procmail/save-incoming" );
461 #print COMMAND $Body;