chiark / gitweb /
Merge branch 'master' of ../live-urcm
authorIan Jackson <ijackson@chiark.greenend.org.uk>
Tue, 20 Apr 2010 17:00:38 +0000 (18:00 +0100)
committerIan Jackson <ijackson@chiark.greenend.org.uk>
Tue, 20 Apr 2010 17:00:38 +0000 (18:00 +0100)
get-settings
stump/bin/acceptFromMod.pl
stump/bin/processApproved
stump/bin/processRejected
webstump/scripts/filter.lib.pl
webstump/scripts/html_output.pl
webstump/scripts/webstump.lib.pl
webstump/scripts/webstump.pl
xlog/bin/record

index 5c71c460d44f6ad1a8fbaa54e71ca5446b34f626..746a2e1c5c5ecd894c18b031682958e7ec145108 100644 (file)
@@ -5,10 +5,12 @@ pas="$paskeys"
 for k in $pas; do eval "$k=''"; export $k; done
 
 DIVERTPOSTINGS=''
+MODLOGSEARCH=false
+MODLOGDOWNLOAD=false
 
 . settings
 export GROUP ABBREV INFOHEADER MODEMAIL GROUPURL REJECTIONSLIST
-export DIVERTPOSTINGS
+export DIVERTPOSTINGS MODLOGSEARCH MODLOGDOWNLOAD
 
 . ../global-settings
 export ROOTBASEDIR CGIBASEURL DOMAIN SLIMYDOMAIN OURUSER ADMIN
index fde6b3d5f8e19bc8adb8cb5d8fe36ac8da11047d..cfc937199d473fddba11448c14331f248b79c725 100755 (executable)
@@ -50,6 +50,7 @@ while( <STDIN> ) {
       $MessageNumber =~ s/^.*::$Prefix\///;
       $MessageNumber =~ /(\d+)/;
       $MessageNumber = $1;
+      $ENV{'WEBSTUMP_MESSAGENUM'}= $MessageNumber;
 
       $MessageFile = "$MNG_ROOT/tmp/messages/$MessageNumber";
  
index 1b2f17642ae80b0eeee4629dfb2e2bdc1222ce18..a62333ecd60c78160bccb07f5c239c2ebe745ee3 100755 (executable)
@@ -31,7 +31,12 @@ post() {
   (
     echo Path: "$PATH_SUFFIX"
 
-    cat $MNG_ROOT/etc/added-headers | grep ': ' 
+    perl <$MNG_ROOT/etc/added-headers -ne '
+        next unless m/\:/;
+        s/\[REFERENCE\]/[$ENV{"WEBSTUMP_MESSAGENUM"}]/g
+            if defined $ENV{"WEBSTUMP_MESSAGENUM"};
+        print or die $!;
+    '
     # I do grep above because a lot of users inserts empty
     # lines in the added headers.
 
index 460c25adf13888e3539c26e191760a401b14748d..694d8e9195b1c5ca4314382e758ad6a70f786cdd 100755 (executable)
@@ -25,9 +25,13 @@ reply() {
 
   if [ "x$REASON" = xdiscard ]; then return; fi
   (
+    eventheader="reject $REASON"
+    if [ "x$WEBSTUMP_MESSAGENUM" != x ]; then
+        eventheader="[$WEBSTUMP_MESSAGENUM] $eventheader"
+    fi
     cat $MESSAGE | formail -rt -I "Reply-To: $BOARD"   \
                               -I "Errors-To: $MUNGED_ADDRESS"   \
-        -I "X-Webstump-Event: reject $REASON" \
+        -I "X-Webstump-Event: $eventheader" \
        $MAILOUT_REJECT_FORMAIL_ARGS
     (
       echo "$EXPLANATION"
index b98b22d731bde5d8039484dff7f4426fb0792d5b..700920da9912f470263da152820513ee29291ca6 100644 (file)
@@ -11,7 +11,7 @@
 # Subject, newsgroup, ShortDirectoryName, decision, comment
 
 sub process_approval_decision {
-
+  my $cathow = @_>=6 ? pop(@_) : "UNKNOWN";
   my $comment = pop( @_ );
   my $decision = pop( @_ );
   my $ShortDirectoryName = pop( @_ );
@@ -28,7 +28,10 @@ sub process_approval_decision {
   $message .= "comment $comment\n" if $comment;
   &email_message( $message, $address );
 
-print STDERR "DECISION: $decision for $ShortDirectoryName sent to $address, for $newsgroup\n";
+  my $sanisubj= $Subject;
+  $sanisubj =~ s/.*\:\://;
+
+print STDERR "DECISION: $newsgroup | $ShortDirectoryName | $decision | $cathow | $sanisubj\n";
 
   &rmdir_rf( &article_file_name( $ShortDirectoryName ) );
 
@@ -86,12 +89,12 @@ sub review_incoming_message { # Newsgroup, From, Subject, RealSubject, Message,
   my $newsgroup = pop( @_ );
 
   if( &name_is_in_list( $from, "bad.posters.list" ) ) {
-    &process_approval_decision( $subject, $newsgroup, $dir, "reject abuse", "" );
+    &process_approval_decision( $subject, $newsgroup, $dir, "reject abuse", "", "auto bad poster" );
     return;
   }
 
   if( &name_is_in_list( $real_subject, "bad.subjects.list" ) ) {
-    &process_approval_decision( $subject, $newsgroup, $dir, "reject thread", "" );
+    &process_approval_decision( $subject, $newsgroup, $dir, "reject thread", "", "auto bad subject" );
     return;
   }
 
@@ -99,7 +102,8 @@ sub review_incoming_message { # Newsgroup, From, Subject, RealSubject, Message,
     &process_approval_decision( $subject, $newsgroup, $dir, "reject charter", 
     "Your message has been autorejected because it appears to be off topic
     based on our filtering criteria. Like everything, filters do not
-    always work perfectly and you can always appeal this decision." );
+    always work perfectly and you can always appeal this decision.",
+                                "auto bad word" );
     return;
   }
 
@@ -127,12 +131,14 @@ print STDERR "Filing Article for review because article matches '$match'\n";
   }
 
   if( &name_is_in_list( $from, "good.posters.list" ) ) {
-    &process_approval_decision( $subject, $newsgroup, $dir, "approve", "" );
+    &process_approval_decision( $subject, $newsgroup, $dir, "approve", "",
+                                "auto good poster" );
     return;
   }
 
   if( &name_is_in_list( $real_subject, "good.subjects.list" ) ) {
-    &process_approval_decision( $subject, $newsgroup, $dir, "approve", "" );
+    &process_approval_decision( $subject, $newsgroup, $dir, "approve", "",
+                                "auto good subject" );
     return;
   }
 
index 59a6423de6674f7aca397a73b28a386225296980..d5c225ec81cd40aa71b23a487a5f3b3b86237c7f 100644 (file)
@@ -7,6 +7,7 @@
 #
 
 use POSIX;
+use CGI qw/escapeHTML/;
 
 sub begin_html {
   my $title = pop( @_ );
@@ -612,7 +613,7 @@ No articles present in the queue
   print "<FORM METHOD=$request_method action=$base_address>";
   &html_print_credentials;
   print "<INPUT NAME=action VALUE=moderator_admin TYPE=hidden>
-         <INPUT TYPE=submit VALUE=\"Manage pass/grey/block-lists\">
+         <INPUT TYPE=submit VALUE=\"Management\">
          </FORM>";
 
   &end_html;
@@ -630,6 +631,98 @@ sub html_print_credentials {
  <INPUT NAME=password VALUE=\"$password\" TYPE=hidden>\n";
 }
 
+# logs
+
+sub scanlogs ($$$) {
+    my ($forwards, $gotr, $callback) = @_;
+    my $dir= "$webstump_home/..";
+    opendir LOGSDIR, "$dir" or die "$dir $!";
+    my $num= sub {
+        local ($_) = @_;
+        return $forwards * (
+            m/^errs$/ ? -1 :
+            m/^errs\.(\d+)(?:\.gz$)$/ ? $1 :
+            undef
+                           );
+    };
+    foreach my $leaf (
+                      sort { $num->($a) <=> $num->($b) }
+                      grep { defined $num->($_) }
+                      readdir LOGSDIR
+                      ) {
+        my $file= "$dir/$leaf";
+        if ($file =~ m/\.gz$/) {
+            open LOGFILE, "zcat $file |" or die "zcat $file $!";
+        } else {
+            open LOGFILE, "< $file" or die "$file $!";
+        }
+        while (<LOGFILE>) {
+            my $tgot= $callback->();
+            next unless $tgot;
+            $$gotr= $tgot if $tgot > $$gotr;
+            last if $tgot > 1;
+        }
+        $!=0; $?=0; close LOGFILE or die "$file $? $!";
+        last if $$gotr > 1;
+    }
+    closedir LOGSDIR or die "$dir $!";
+}        
+
+sub html_search_logs {
+  &begin_html("Search logs for $request{'newsgroup'}");
+  my $reqnum;
+  my $forwards=1;
+  my $min= 9;
+  if ($request{'download_logs'}) {
+      print "<h2>Complete log download</h2>\n";
+      $min= 2;
+  } elsif ($request{'messagenum'} =~ m/^\s*(\d+)\s*$/) {
+      $reqnum= $1;
+      $forwards= -1;
+      $min= 1;
+      print "<h2>Log entry for single message $reqnum</h2>\n";
+  } else {
+      print "<h2>Log lookup - bad reference</h2>
+Please supply the numerical reference as found in the \"recent activity\"
+log or message headers.  Reference numbers consist entirely of digits,
+and are often quoted in message headers in [square brackets].<p>
+        ";
+      &end_html;
+      return;
+  }
+  if ($mod_log_access < $min) {
+      print "Not permitted [$mod_log_access<$min].  Consult administrator.\n";
+      &end_html;
+      return;
+  }
+
+  my $sofar= 0;
+  &scanlogs($forwards, \$sofar, sub {
+      return 0 unless chomp;
+      return 0 unless m/^DECISION: /;
+      my @vals = split / \| /, $';
+      return 0 unless @vals >= 5;
+      my $subj= pop @vals;
+      my ($group,$dir,$act,$reason) = @vals;
+      return 0 unless $group eq $request{'newsgroup'};
+      return 0 unless $subj =~ m,/(\d+)$,;
+      my $treqnum= $1;
+      return 0 if defined($reqnum) and $treqnum ne $reqnum;
+      print "<table rules=all><tr><th>Reference<th>Disposal<th>Reason</tr>\n"
+          unless $sofar;
+      print "<tr>", (map { "<td>".escapeHTML($_) } $treqnum,$act,$reason);
+      print "</tr>\n";
+      return defined($reqnum) ? 2 : 1;
+  });
+  if ($sofar) {
+      print "</table>" if $sofar;
+      print "\n";
+  } else {
+      print "Reference not found.";
+  }
+  &end_html;
+}
+
 # newsgroup admin page
 sub html_newsgroup_management {
   &begin_html( "Administer $request{'newsgroup'}" );
@@ -681,8 +774,29 @@ sub html_newsgroup_management {
 
   &link_to_help( "filter-lists", "filtering lists" );
 
+  print "</FORM><HR>";
+
+  if ($mod_log_access) {
+      print "<form>
+        Use this form to search logs of past moderation decisions:
+        <br>
+        <form method=$request_method action=$base_address>
+        <input name=action value=search_logs type=hidden>";
+
+      &html_print_credentials;
+
+      print "
+        Reference number: <input name=messagenum size=30>
+        <input type=submit value=\"Lookup\">";
+
+      print "
+        <input type=submit value=\"Download all logs\" name=\"download_logs\">"
+        if $mod_log_access >= 2;
+
+      print "</form><hr>\n";
+  }
+
   print "
-  </FORM><HR>
 
   List of current moderators:<P>
 
index 3baa41faba1602042c1930d96be2ec65a51045fd..3e9e0efc9af711dd18ee4cebe2897e6a6513e8a3 100644 (file)
@@ -628,7 +628,7 @@ sub approval_decision {
                if $thread_decision eq "watch";
 
 # Subject, newsgroup, ShortDirectoryName, decision, comment
-        &process_approval_decision( $Subject, $newsgroup, $file, $decision, $comment );
+        &process_approval_decision( $Subject, $newsgroup, $file, $decision, $comment, "moderator \U$request{'moderator'}" );
 
       }
     }
@@ -712,6 +712,9 @@ sub processWebRequest {
   } elsif( $action eq "change_password" ) {
     &authenticate( $newsgroup, $moderator, $password );
     &html_change_password;
+  } elsif( $action eq "search_logs" ) {
+    &authenticate( $newsgroup, $moderator, $password );
+    &html_search_logs;
   } elsif( $action eq "validate_change_password" ) {
     &authenticate( $newsgroup, $moderator, $password );
     &validate_change_password;
index 97b09ed557d195f0cd4a71447e60ddae3c48a02d..3da004bc3842cf07dc112bb3e249b6e6b5a5a8ec 100755 (executable)
@@ -12,6 +12,9 @@ if( !($0 =~ /\/scripts\/webstump\.pl$/) ) {
 $webstump_home = $0;
 $webstump_home =~ s/\/scripts\/webstump\.pl$//;
 
+my $logfile= "$webstump_home/../errs";
+open STDERR, ">> $logfile" or die "$logfile $!";
+
 $webstump_home =~ /(^.*$)/;
 $webstump_home = $1;
 
index 1ba50b70ae543452a6e303297dbc9fcb0225a0e6..7b6cf6035f796b2ca0fed0f17c08fc08db55a623 100755 (executable)
@@ -112,7 +112,10 @@ sub parse_mailout () {
            $message .= $line;
        }
        chomp;
-       $f{Event}= "notify $'" if m/^X-Webstump-Event:\s*/i; #';
+        if (m/^X-Webstump-Event:\s*(?:\[(\d+)\])?\s*/i) { #';
+            $f{Event}= "notify $'";
+            $f{MessageNum}= $1 if defined $1;
+        }
        last if m/^$/;
     }
     while (<STDIN>) {
@@ -133,7 +136,7 @@ $f{Now}= time;
 
 if ($publish_rejections &&
     $f{Event} =~ m/^notify reject /) {
-    $f{CopyRef}= $f{MessageID};
+    $f{CopyRef}= $f{MessageNum} || $f{MessageID};
     $f{CopyRef} =~ s/\W/ sprintf '-%02x', ord($&) /ge;
     open I, ">$dir/public/nr-$f{CopyRef}.txt" or die $!;
     print I $message or die $!;