xlog/bin/report

   1 #!/usr/bin/perl -w
   2
   3 use strict (qw(vars));
   4 use IO::Handle;
   5 use POSIX;
   6 use CGI qw/:standard *table end_* -no_xhtml/;
   7
   8 our $timesquash = 3;
   9 # no. of digits at end of time to replace with x, 0..4
  10
  11 for (;;) {
  12     last unless @ARGV;
  13     last unless $ARGV[0] =~ m/^-/;
  14     $_ = shift @ARGV;
  15     last if m/^--?$/;
  16     while (m/^-./) {
  17         if (s/^-t([0-4])/-/) {
  18             $timesquash= $1;
  19         } else {
  20             die "bad option $_ ?";
  21         }
  22     }
  23 }
  24
  25 our ($ng,$staticfiles,@ARGV) = @ARGV;
  26 chdir $ng or die $!;
  27
  28 our @lines= ();
  29 our @s;
  30 our $oddeven = "o";
  31
  32 our ($processline,$needmap);
  33 our ($selectmid,$selectnum);
  34
  35 sub processlog ($$) {
  36     my ($taccat, $fn)= @_;
  37     open F, "$taccat $fn |" or die $!;
  38     while (<F>) {
  39         chomp;
  40         @s= split /\t/;
  41         push @s, '' if @s<=6;
  42         $s[0]= strftime "%Y-%m-%d %H:%M:%S %Z", localtime $s[0];
  43         for (my $i=0; $i<$timesquash; $i++) {
  44             $s[0] =~ s/(\d\d:[\d:]*)\d/$1x/;
  45         }
  46         $s[0] =~ s/:xx / /;
  47         &$processline();
  48         $oddeven =~ y/oe/eo/;
  49     }
  50 }
  51 sub processlogs ($) {
  52     my ($taccat) = @_;
  53     my (@logs) = qw(event.log.0 event.log);
  54     @logs= reverse @logs if $taccat eq 'tac';
  55     processlog($taccat, $_) foreach @logs;
  56 }
  57
  58 sub processline_print () {
  59     my @sp= @s;
  60     $sp[3] =~ s/\@\w{0,2}/ at .. /;
  61     @sp= map { escapeHTML($_) } @sp[0..5];
  62     $sp[3] =~ s/&lt;/\<br>&lt;/;
  63     $sp[2]=~s/\@/\@<span class='hole'><\/span>/;
  64     my @spu= map {
  65         s/\W/ sprintf "%%%02x", ord $& /ge;
  66         $_;
  67     } @s;
  68     if (length $s[1] && length $s[2]) {
  69         my $url= url().'/message/'.$spu[1].'/'.$spu[2];
  70         foreach my $i (qw(1 2)) {
  71             $sp[$i]= a({ href=>$url }, $sp[$i]."<br>" );
  72         }
  73     }
  74     if (length $s[6]) {
  75         $sp[5]= a({ href=>"$staticfiles/nr-$s[6].txt" }, $sp[5] );
  76     }
  77
  78     print "<tr class='$oddeven'><td>$sp[0]</td>";
  79     print "<td class='ref'>$sp[1] $sp[2]</td>";
  80     print td([@sp[3..5]]),"</tr>\n";
  81 }
  82
  83 sub processline_print_ifsingle () {
  84     return unless $s[1] eq $selectnum
  85                or $s[2] eq $selectmid;
  86     processline_print();
  87 }
  88
  89 our (%done_num,%done_id,%num2id,%id2num);
  90 sub processline_queue_prescan () {
  91     my ($num,$id,$e) = @s[1..2,5];
  92     if (length $id and length $num) {
  93         $id2num{$id}= $num;
  94         $num2id{$num}= $id;
  95     }
  96     return unless $e =~ m/^decide reject discard|^notify reject|^post/;
  97 #print STDERR "finishing $e $s[1] $s[2]\n";
  98     $num= $id2num{$id} if !length $num;
  99     $id= $num2id{$num} if !length $id;
 100 #print STDERR "finishing $e $num $id\n";
 101     $done_num{$num}++ if defined $num;
 102     $done_id{$id}++ if defined $id;
 103 }
 104 sub processline_queue () {
 105     return if $done_num{$s[1]};
 106     return if $done_id{$s[2]};
 107     processline_print();
 108 }
 109
 110 my $pi= path_info();
 111 our $title;
 112
 113 $needmap= 0;
 114 $processline= \&processline_print;
 115
 116 if ($pi =~ m,^/message/(\d+)/(.*)$,) {
 117     ($selectnum, $selectmid) = ($1,$2);
 118     $title= "Single message ".escapeHTML($selectmid);
 119     $processline= \&processline_print_ifsingle;
 120 } elsif ($pi =~ m/^$/) {
 121     $title= "Recent activity - $ng";
 122 } elsif ($pi =~ m,^/queue,) {
 123     $title= "Activity regarding still-queued messages";
 124     $processline= \&processline_queue_prescan;
 125     processlogs('cat');
 126     $processline= \&processline_queue;
 127 }
 128
 129 my $css=<<EOJ;
 130 span.hole:before { content: " "; }
 131 td.ref { font-size: 0.75em; }
 132 tr.o { background: #ddddff; }
 133 EOJ
 134
 135 print header(),
 136   start_html(-title=>$title, -style=>{'-code'=>$css}),
 137   h1($title), start_table();
 138
 139 print Tr(td([map { strong($_) } (qw(
 140                                 Date
 141                                 Reference/Message-ID
 142                                 From
 143                                 Subject
 144                                 Event
 145                             ))]));
 146
 147 processlogs('tac');
 148
 149 print end_table();
 150 print p();
 151
 152 print a({ href=>url() }, "All recent activity"), '; ';
 153 print a({ href=>url().'/queue' }, "Unfinished business");
 154
 155 print end_html();