bin/logwatch

   1 #!/usr/bin/perl -w
   2
   3 use File::Basename;
   4 use Cwd 'abs_path';
   5 use I18N::Langinfo qw'langinfo CODESET';
   6
   7 # add fex lib
   8 unless ($FEXLIB = $ENV{FEXLIB}) {
   9   if ($ENV{FEXHOME}) {
  10     $FEXLIB = $ENV{FEXHOME}.'/lib';
  11   } elsif (-f '/usr/share/fex/lib/fex.ph') {
  12     $FEXLIB = '/usr/share/fex/lib';
  13   } else {
  14     $FEXLIB = dirname(dirname(abs_path($0))).'/lib';
  15   }
  16   $ENV{FEXLIB} = $FEXLIB;
  17 }
  18 die "$0: no $FEXLIB\n" unless -d $FEXLIB;
  19
  20 # import from fex.pp
  21 our (@logdir,$spooldir,$debug);
  22
  23 # load common code, local config : $HOME/lib/fex.ph
  24 require "$FEXLIB/fex.pp" or die "$0: cannot load $FEXLIB/fex.pp - $!\n";
  25
  26 $CTYPE = langinfo(CODESET());
  27 binmode(STDOUT,":encoding($CTYPE)");
  28
  29 $log = shift || $logdir[0].'/fexsrv.log';
  30
  31 $ignore = join('|',qw(
  32   (CONNECT|CONTINUE).*(crawl|msnbot|obertux)
  33   DISCONNECT:.no.HTTP.request
  34   GET.*(favicon|robots\.txt)
  35   GET./organization\.gif
  36   GET./small_logo\.jpg
  37   GET./logo\.jpg
  38   GET./action-fex-camel\.gif
  39   GET./fup\?showstatus
  40   GET./FAQ/faq\.css
  41   GET./FAQ/jquery\.js
  42   GET.*Arrow\.gif
  43   GET./apple-touch
  44   GET./browserconfig\.xml
  45   User-Agent:.*(Webnote|FeedFetcher|\w+bot|bot/|Website.Watcher|crawler|spider|searchme|Yandex|Slurp|ScoutJet|findlinks|urlmon|nagios)
  46   User-Agent:.fnb.*quak
  47   User-Agent:.Google.favicon
  48   From:.*(msnbot|yandex|googlebot|webcrawler)
  49   Referer:.*sex.*stream
  50   Referer:.*stream.*sex
  51   X-.*prefetch
  52   X-Purpose:.preview
  53 ));
  54
  55 @weed = qw(
  56   .*keep-alive
  57   .*no-cache
  58   Connection:
  59   Cache-Control:
  60   Content-Type:
  61   Accept
  62   TE:
  63   UA-CPU:
  64   Pragma:
  65   DNT:
  66   Via:
  67   profile:
  68   Upgrade-Insecure-Requests:
  69   if-modified-since
  70   Surrogate-Capability
  71   Proxy-Authorization
  72   http\.
  73   Device-Stock
  74   NOKIA_
  75   GPRS
  76   X-Proxy-ID
  77   X-Moz
  78   X.Wap
  79   X-FH
  80   X-FB
  81   X-WS
  82   X-Nokia
  83   X-UCBrowser
  84   X-NSN
  85   X-OperaMini
  86   x-Device
  87   x-source-id
  88   x.up
  89   X-Behavioral
  90   X-Do-Not-Track
  91   X-\S*Via
  92   x-Mobile
  93   X-Country
  94   X-ClickOnceSupport
  95   X-Newrelic
  96   X-IMForwards
  97   X-Clearswift
  98   X-MDS
  99   .*:\s*$
 100 );
 101
 102 $/ = "\n\n";
 103 $| = 1;
 104
 105 if (-t STDIN or $ENV{GATEWAY_INTERFACE}) {
 106   open L,$log or die "$0: $log - $!\n";
 107   seek L,0,2;
 108 } else {
 109   *L = *STDIN;
 110 }
 111 # binmode(L,":encoding(UTF-8)");
 112
 113 for (;;) {
 114   while (<L>) {
 115     next if /(^|\n)($ignore)/i;
 116     s/[\x00-\x08\x0B-\x1F\x1F\x80-\x9F]/_/g;
 117     s/^\n//;
 118     foreach $weed (@weed) {
 119       while (s/\n$weed.*\n/\n/i) {}
 120     }
 121     $post = /\nPOST\s/;
 122     if (/^\n*(CONNECT|CONTINUE).*\s\[([\d_]+)\]/i) { $pid = $2 }
 123     if (/\n(POST|GET)\s+(\S+)/i) {
 124       $cgi = $2;
 125       $cgi =~ s:.*/::;
 126       $cgi =~ s:\?.*::;
 127     }
 128     if (/Content-Length: (\d+)/i) {
 129       $d = $1;
 130       while ($d =~ s/(\d)(\d\d\d\b)/$1,$2/) {};
 131       s/Content-Length: \d+/Content-Length: $d/i;
 132     }
 133     s/[\s\n]*$/\n\n/;
 134     print or exit;
 135     $from = '';
 136     if (m:\nGET /fup/(\w{40,}):) {
 137       $_ = decode_b64($1);
 138       printf "  FROM=\"%s\"\n\n",$1 if /from=([\w\@.-]+)/;
 139     } elsif (m:\nGET /fop/(\w+)/:) {
 140       $dkey = $1;
 141       my $ddir = "$spooldir/.dkeys/$dkey";
 142       $_ = readlink $ddir or next;
 143       (undef,$to,$from) = split('/');
 144       printf "  FROM=\"%s\"\n",$from;
 145       printf "  TO=\"%s\"\n",$to;
 146       $cgi = '';
 147       if ($comment = slurp("$ddir/comment")) {
 148         printf "  COMMENT=\"%s\"\n",utf8decode($comment)||'';
 149       }
 150       if (not -f "$ddir/data" and $_ = slurp("$ddir/error")) {
 151         s/\n.*//s;
 152         print "  ERROR=\"$_\"\n";
 153       }
 154       elsif ($size = -s "$ddir/data") {
 155         printf "  SIZE=%s MB\n",int($size/1024/1024);
 156       }
 157       print "\n";
 158     } elsif (m:\nGET /fup.*skey=(\w+):) {
 159       read_skey($1);
 160       print "\n";
 161     }
 162     if ($debug and $pid and $post) {
 163       &read_debug_log;
 164     };
 165     $pid = $cgi = '';
 166   }
 167   sleep 1;
 168 }
 169
 170
 171 sub read_debug_log {
 172   my (@log,$log);
 173   local $/ = "\n";
 174   local $_;
 175   # https://rt.cpan.org/Public/Bug/Display.html?id=88592
 176   # local $^W;
 177   # no warnings "all";
 178   no warnings 'utf8';
 179
 180   for (1..2) {
 181     sleep 1;
 182     @log = `ls -rt $logdir[0]/.debug/*_${pid}.$cgi 2>/dev/null`;
 183     if ($log = $log[-1] and open $log,$log) {
 184       binmode($log,":utf8");
 185       while (<$log>) {
 186         s/\r//;
 187         s/[^\x09\x20-\xFF]/_/g;
 188         if (/^Content-Disposition:.*name="FILE".*filename="(.+)"/i) {
 189           print "  FILE=\"$1\"\n";
 190         } elsif (/^Content-Disposition:.*name="(\w+)"/i) {
 191           my $p = uc($1);
 192           $_ = <$log>;
 193           my $v = <$log>||'';
 194           $v =~ s/[\r\n]+//;
 195           if ($v) {
 196             my $vv = utf8decode($v)||$v;
 197             $vv =~ s/[\x00-\x1F]/_/g;
 198             $vv =~ s/[\x80-\x9F]/_/g;
 199             printf "  %s=\"%s\"\n",$p,$vv;
 200             read_akey($v) if $p eq 'AKEY';
 201             read_skey($v) if $p eq 'SKEY';
 202           }
 203         } elsif (/^(Param|Exp): (\w+=".+")/) {
 204           print "  $2\n";
 205         }
 206       }
 207       close $log;
 208       print "\n";
 209       return;
 210     }
 211   }
 212 }
 213
 214 sub read_akey {
 215   my $akey = "$spooldir/.akeys/" . shift;
 216   if (my $user = readlink($akey)) {
 217     $user =~ s:../::;
 218     printf "  USER=\"%s\"\n",$user;
 219   }
 220 }
 221
 222
 223 sub read_skey {
 224   my $skey = "$spooldir/.skeys/" . shift;
 225   if (open $skey,$skey) {
 226     while (<$skey>) {
 227       printf "  FROM=\"%s\"\n",$1 if /from=(.+)/;
 228       printf "  TO=\"%s\"\n",$1   if /to=(.+)/;
 229     }
 230     close $skey;
 231   }
 232 }
 233
 234
 235 sub utf8decode {
 236   local $_ = shift;
 237   s/([\xC0-\xDF])([\x80-\xBF])/chr(ord($1)<<6&0xC0|ord($2)&0x3F)/eg;
 238   return $_;
 239 }