# checks if poster needs acknowledgment of receipt
#
sub checkAck {
- if( &nameIsInList( $From, "noack.list" ) ) {
+ my $fromaddr = $From;
+ $fromaddr =~ s/^[-A-Za-z]+\s*\:\s*//;
+ print STDERR "checking noack.list for \"$From|$fromaddr\"\n";
+ if( &nameIsInListExactly( $fromaddr, "noack.list" ) ) {
$needAck = "no";
} else {
$needAck = "yes";
return "$Command_Reject signature Your PGP signature does NOT match, or is not in our keyring";
}
- if( &nameIsInList( $From, $PGPMustList ) ||
- ($PGPCheckPreapproved && &nameIsInList($From, $goodGuys) ) ) {
+ if( &nameIsInListRegexp( $From, $PGPMustList ) ||
+ ($PGPCheckPreapproved && &nameIsInListExactly($From, $goodGuys) ) ) {
if( $FromSig eq "" ) {
return "$Command_Reject signature You are REQUIRED to sign your posts.";
}
# checks charter calling conforms_charter
#
sub checkCharter {
- open( VERIFY, "|conforms_charter" );
- print VERIFY $Body;
+ open( VERIFY, "|conforms_charter" ) or die $!;
+ print VERIFY $Body or die $!;
close( VERIFY );
return $? == 0;
}
}
- if( &nameIsInList( $From, $badGuys ) ) {
- return "$Command_Reject abuse";
+ if( &nameIsInListRegexp( $From, $badGuys ) ) {
+ return "$Command_Reject blocklist";
}
# note that if even a preapproved person uses "BAD words" (that is
# "suspicious" and will be forwarded to a humen mod for review.
# As an example of a bad word may be "MAKE MONEY FAST - IT REALLY WORKS!!!"
#
- if( $badWord = &nameIsInList( $Body, $badWords ) ) {
+ if( $badWord = &nameIsInListRegexp( $Body, $badWords ) ) {
print STDERR "BAD WORD $badWord FOUND!!!\n";
return $Command_Suspicious; # messages from approved guys MAY be
# suspicious if they write about
}
# Checking preapproved list
- if( &nameIsInList( $From, $goodGuys ) ) {
+ if( &nameIsInListExactly( $From, $goodGuys ) ) {
local( $from ) = $From; $from =~ s/^From: //i;
print STDERR "$from is a PREAPPROVED person\n";
return $Command_Approve;
return 1 if( $header =~ /^Supersedes:/i );
return 1 if( $header =~ /^Precedence:/i );
return 1 if( $header =~ /^Apparently-To:/i );
- return 1 if( $header =~ /^Date:/i );
return 1 if( $header =~ /^Expires:/i );
return 1 if( $header =~ /^Distribution:/i );
return 1 if( $header =~ /^Path:/i );
sub readMessage {
-open IWJL, ">>/home/webstump/t.log";
-print IWJL "=========== SUBMISSION READMESSAGE\n";
+#open IWJL, ">>/home/webstump/t.log";
+#print IWJL "=========== SUBMISSION READMESSAGE\n";
- open( TMPFILE, "> $TmpFile" );
+ open( TMPFILE, "> $TmpFile" ) or die $!;
$IsBody = 0;
-
- while( <> ) {
-print IWJL "SbRm $_\n";
+
+ my @unfolded;
+ my $readahead = '';
+
+ our $warnings=0;
+ my $warning = sub {
+ sprintf "X-STUMP-Warning-%d: %s\n", $warnings++, $_[0];
+ };
+
+#open TTY, ">/home/webstump/t";
+ for (;;) {
+#print TTY "=| $IsBody | $readahead ...\n";
+ if (!defined $readahead) {
+ # we got EOF earlier;
+ last;
+ }
+ if (length $readahead) {
+ $_ = $readahead;
+ $readahead = '';
+ } else {
+ $_ = <>;
+ last unless defined;
+ }
+ if (!$IsBody) {
+ # right now there is no readahead, since we just consumed it into $_
+ if ($_ !~ m/^\r?\n$/) { # blank line ? no...
+ $readahead = <>;
+ if (defined $readahead && $readahead =~ m/^[ \t]/) {
+ # this is a continuation, keep stashing
+ $readahead = $_.$readahead;
+ next;
+ }
+ # OK, $readahead is perhaps:
+ # - undef: we got eof
+ # - empty line: signalling end of (these) headers
+ # - start of next header
+ # In these cases, keep that in $readahead for now,
+ # and process the previous header, which is in $_.
+ # But, first, a wrinkle ...
+ push @unfolded, (m/^[^:]+:/ ? $& : '????')
+ if s/\n(?=.)/ /g;
+ if (length $_ > 505) { #wtf
+ $_ = substr($_, 0, 500);
+ $_ =~ s/\n?$/\n/;
+ $readahead = $_;
+ $_ = $warning->("Next header truncated!");
+ }
+ } else {
+ # $_ is empty line at end of headers
+ # (and, there is no $readahead)
+ if (@unfolded) {
+ # insert this warning into the right set of headers
+ $readahead = $_;
+ $_ = $warning->("Unfolded headers @unfolded");
+ @unfolded = ();
+ }
+ }
+ # Now we have in $_ either a complete header, unfolded,
+ # or the empty line at the end of headers
+ }
+#print TTY "=> $IsBody | $readahead | $_ ...\n";
+
$Body .= $_;
if( !$IsBody && &ignoreHeader( $_ ) ) {
next;
}
- print TMPFILE;
+ print TMPFILE or die $!;
chop;
}
}
use IO::Handle;
- print IWJL "SbRmE $!\n";
+# print IWJL "SbRmE $!\n";
die "read message $! !" if STDIN->error;
close( TMPFILE );
# process
print STDERR "command = $command\n";
-open IWJL, ">>/home/webstump/t.log";
-print IWJL "=========== SUBMISSION MAIN\n";
+#open IWJL, ">>/home/webstump/t.log";
+#print IWJL "=========== SUBMISSION MAIN\n";
-open( COMMAND, "| $command" );
+open( COMMAND, "| $command" ) or die $!;
open( TMPFILE, "$TmpFile" ) || die "cant open tmpfile";
$IsBody = 0;
while( <TMPFILE> ) {
-print IWJL "SbRt $_\n";
if( $BadNewsserver && !(/^$/) ) {
next;
}
if( /^From / ) {
- print COMMAND;
- print COMMAND "X-Origin: $X_Origin, $_" if $X_Origin;
+ print COMMAND or die $!;
+ print COMMAND "X-Origin: $X_Origin, $_" or die $! if $X_Origin;
print STDERR "Subject =`$Subject'\n";
- print COMMAND "Subject: No subject given\n" if !$Subject;
+ print COMMAND "Subject: No subject given\n" or die $! if !$Subject;
# nothing
} elsif( /^From: / && !$IsBody) {
next if $FromWasUsed;
# "From: " to go to headers!
if( $From ) {
- print COMMAND "$From\n";
+ print COMMAND "$From\n" or die $!;
$From = "";
} else {
- print COMMAND;
+ print COMMAND or die $!;
}
} elsif( /^Newsgroups: / && !$IsBody ) {
- print COMMAND "Newsgroups: $Newsgroups\n";
+ print COMMAND "Newsgroups: $Newsgroups\n" or die $!;
} else {
- print COMMAND;
+ print COMMAND or die $!;
}
}
-close( TMPFILE );
-close( COMMAND );
+close( TMPFILE ) or die $!;
+close( COMMAND ) or die "$? $!";
################################################################## Archiving
# archive