xlog/bin/record

   1 #!/usr/bin/perl -w
   2
   3 use strict (qw(vars));
   4 use IO::Handle;
   5 use POSIX;
   6
   7 our %f;
   8
   9 my $publish_rejections_patfile= '/dev/null';
  10 my $publish_rejections= 0;
  11 if ($ARGV[0] eq '-P') {
  12     $publish_rejections= 1;
  13     shift @ARGV;
  14 } elsif ($ARGV[0] =~ s/^\-P//) {
  15     $publish_rejections= 1;
  16     $publish_rejections_patfile= shift @ARGV;
  17 }
  18
  19 our ($how) = @_;
  20
  21 my $dir= $0;
  22 $dir =~ s,/[^/]+$,,;
  23 $dir =~ s,/bin$,/log,;
  24 $dir .= "/$ARGV[1]";
  25
  26 my $message;
  27
  28 sub parse__headerline () {
  29     $f{Subject}= $' if m/^Subject:\s*/i; #';
  30     $f{MessageID}= $' if m/^Message\-ID:\s*/i; #';
  31     $f{From}= $' if m/^From:\s*/i; #';
  32 }
  33 sub parse__stumpsubject () {
  34     $f{MessageNum}=$1 if m/^Subject:.*\:\:\w+\/(\d+)$/i;
  35 }
  36
  37 sub parse_posted () {
  38     while (<STDIN>) {
  39         chomp;
  40         parse__headerline();
  41         last if m/^$/;
  42     }
  43     $f{Event}= 'post';
  44 }
  45 sub parse_submission () {
  46     my $hadng=0;
  47     my %oldf;
  48     my $had2=0;
  49     while (<STDIN>) {
  50         chomp;
  51 print STDERR "$hadng $had2|$_|\n";
  52         $hadng++ if m/^Newsgroups:/i;
  53         if (m/^$/) {
  54             last if $hadng;
  55             last if $had2++;
  56             %oldf= %f;
  57             undef %f;
  58         }
  59         last unless m/^\S+\:|^\s|^$|^From /;
  60         parse__headerline();
  61     }
  62     if ($hadng) {
  63         $f{Event}= $had2 ? 'receive newstyle' : 'receive';
  64     } else {
  65         %f= %oldf if $had2;
  66         $f{Subject}= '[suppressed]';
  67         $f{Event}= 'receive junk';
  68     }
  69 }
  70
  71 sub parse_stump2webstump () {
  72     while (<STDIN>) {
  73         chomp;
  74         parse__stumpsubject() unless exists $f{'MessageNum'};
  75         last if m/^\@{40,}$/;
  76     }
  77     while (<STDIN>) {
  78         chomp;
  79         last if m/^$/;
  80         parse__headerline();
  81     }
  82     $f{Event}= 'enqueue';
  83 }
  84
  85 sub parse_webstump2stump () {
  86     while (<STDIN>) {
  87         chomp;
  88         parse__stumpsubject();
  89         last if m/^$/;
  90     }
  91     while (<STDIN>) {
  92         chomp;
  93         next unless m/^reject|^approve|^preapprove/;
  94         $f{Event}= $_;
  95         last;
  96     }
  97 }
  98
  99 sub parse_mailout () {
 100     my $keepheader= 1;
 101     while (<STDIN>) {
 102         $keepheader= 1 unless m/^[ \t]/;
 103         $keepheader= 0
 104             if m/^(?: received
 105                    | envelope-to
 106                    )/ix;
 107         $keepheader= 'mangle'
 108             if m/^(?: to
 109                    | from
 110                    | return-path
 111                    | reply-to
 112                    | errors-to
 113                    )/ix;
 114         if ($keepheader) {
 115             my $line= $_;
 116             $line =~ s/\@.{0,2}/ at ../g if $keepheader eq 'mangle';
 117             $message .= $line;
 118         }
 119         chomp;
 120         if (m/^X-Webstump-Event:\s*(?:\[(\d+)\])?\s*/i) { #';
 121             $f{Event}= "notify $'";
 122             $f{MessageNum}= $1 if defined $1;
 123         }
 124         last if m/^$/;
 125     }
 126     while (<STDIN>) {
 127         $message .= $_;
 128         chomp;
 129         next unless s/^\> //;
 130         last if m/^$/;
 131         parse__headerline();
 132     }
 133 }
 134
 135 $f{Event}= '?';
 136 &{"parse_$ARGV[0]"};
 137 while (<STDIN>) { $message .= $_; }
 138 STDIN->error and die $!;
 139
 140 $f{Now}= time;
 141
 142 sub want_publish_rejection_kind ($) {
 143     my ($kind) = @_;
 144     return 1 if $publish_rejections_patfile eq '';
 145     if (!open PF, '<', $publish_rejections_patfile) {
 146         return 1 if $!==&ENOENT;
 147         die "$publish_rejections_patfile: $!";
 148     }
 149     while (<PF>) {
 150         s/^\s+//;
 151         s/\s+$//;
 152         next if m/^\#/;
 153         next unless m/\S/;
 154         my $yn = !s/^\!//;
 155         s/[^0-9a-zA-Z*?]/\\$&/g;
 156         s/\*/.*/g;
 157         s/\?/./g;
 158         return $yn if $kind =~ m/^$_$/;
 159     }
 160     close PF or die $!;
 161     return 1;
 162 }
 163
 164 if ($publish_rejections &&
 165     $f{Event} =~ m/^notify reject (\S+)/ &&
 166     want_publish_rejection_kind($1))
 167 {
 168     $f{CopyRef}= $f{MessageNum} || $f{MessageID};
 169     $f{CopyRef} =~ s/\W/ sprintf '-%02x', ord($&) /ge;
 170     open I, ">$dir/public/nr-$f{CopyRef}.txt" or die $!;
 171     print I $message or die $!;
 172     close I or die $!;
 173 }
 174
 175 open L, ">>$dir/event.log" or die $!;
 176
 177 my @s= map {
 178     my $v= $f{$_};
 179     $v= '' unless defined $v;
 180     $v =~ s/\t/  /g;
 181     $v =~ s/[\r\n]/?/g;
 182     $v;
 183 } qw(Now MessageNum MessageID From Subject Event CopyRef);
 184
 185 print L join("\t",@s)."\n" or die $!;
 186 close L or die $!;