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         $f{Event}= "notify $'" if m/^X-Webstump-Event:\s*/i; #';
 116         last if m/^$/;
 117     }
 118     while (<STDIN>) {
 119         $message .= $_;
 120         chomp;
 121         next unless s/^\> //;
 122         last if m/^$/;
 123         parse__headerline();
 124     }
 125 }
 126
 127 $f{Event}= '?';
 128 &{"parse_$ARGV[0]"};
 129 while (<STDIN>) { $message .= $_; }
 130 STDIN->error and die $!;
 131
 132 $f{Now}= time;
 133
 134 if ($publish_rejections &&
 135     $f{Event} =~ m/^notify reject /) {
 136     $f{CopyRef}= $f{MessageID};
 137     $f{CopyRef} =~ s/\W/ sprintf '-%02x', ord($&) /ge;
 138     open I, ">$dir/public/nr-$f{CopyRef}.txt" or die $!;
 139     print I $message or die $!;
 140     close I or die $!;
 141 }
 142
 143 open L, ">>$dir/event.log" or die $!;
 144
 145 my @s= map {
 146     my $v= $f{$_};
 147     $v= '' unless defined $v;
 148     $v =~ s/\t/  /g;
 149     $v =~ s/[\r\n]/?/g;
 150     $v;
 151 } qw(Now MessageNum MessageID From Subject Event CopyRef);
 152
 153 print L join("\t",@s)."\n" or die $!;
 154 close L or die $!;