xlog/bin/record

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