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