]> git.treefish.org Git - fex.git/blob - bin/logwatch
fdc2f2554993a9db754b1f917b8fd7bf4a754a03
[fex.git] / 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+\/(\w+)/i)                 { $cgi = $2 }
124     if (/Content-Length: (\d+)/i) {
125       $d = $1;
126       while ($d =~ s/(\d)(\d\d\d\b)/$1,$2/) {};
127       s/Content-Length: \d+/Content-Length: $d/i;
128     }
129     s/[\s\n]*$/\n\n/;
130     print or exit;
131     $from = '';
132     if (m:\nGET /fup/(\w{40,}):) {
133       $_ = decode_b64($1);
134       printf "  FROM=\"%s\"\n\n",$1 if /from=([\w\@.-]+)/;
135     } elsif (m:\nGET /fop/(\w+)/:) {
136       $dkey = $1;
137       my $ddir = "$spooldir/.dkeys/$dkey";
138       $_ = readlink $ddir or next;
139       (undef,$to,$from) = split('/');
140       printf "  FROM=\"%s\"\n",$from;
141       printf "  TO=\"%s\"\n",$to;
142       $cgi = '';
143       if ($comment = slurp("$ddir/comment")) {
144         printf "  COMMENT=\"%s\"\n",utf8decode($comment)||'';
145       }
146       if (not -f "$ddir/data" and $_ = slurp("$ddir/error")) {
147         s/\n.*//s;
148         print "  ERROR=\"$_\"\n";
149       }
150       elsif ($size = -s "$ddir/data") {
151         printf "  SIZE=%s MB\n",int($size/1024/1024);
152       }
153       print "\n";
154     } elsif (m:\nGET /fup.*skey=(\w+):) {
155       read_skey($1);
156       print "\n";
157     }
158     if ($debug and $pid and $post) {
159       &read_debug_log;
160     };
161     $pid = $cgi = '';
162   }
163   sleep 1;
164 }
165
166
167 sub read_debug_log {
168   my (@log,$log);
169   local $/ = "\n";
170   local $_;
171   # https://rt.cpan.org/Public/Bug/Display.html?id=88592
172   # local $^W;
173   # no warnings "all";
174   no warnings 'utf8';
175
176   for (1..2) {
177     sleep 1;
178     @log = `ls -rt $logdir[0]/.debug/*_${pid}.$cgi 2>/dev/null`;
179     if ($log = $log[-1] and open $log,$log) {
180       binmode($log,":utf8");
181       while (<$log>) {
182         s/\r//;
183         if (/^Content-Disposition:.*name="FILE".*filename="(.+)"/i) {
184           print "  FILE=\"$1\"\n";
185         } elsif (/^Content-Disposition:.*name="(\w+)"/i) {
186           my $p = uc($1);
187           $_ = <$log>;
188           my $v = <$log>||'';
189           $v =~ s/[\r\n]+//;
190           if ($v) {
191             my $vv = utf8decode($v)||$v;
192             $vv =~ s/[\x00-\x1F]/_/g;
193             $vv =~ s/[\x80-\x9F]/_/g;
194             printf "  %s=\"%s\"\n",$p,$vv;
195             read_akey($v) if $p eq 'AKEY';
196             read_skey($v) if $p eq 'SKEY';
197           }
198         } elsif (/^(Param|Exp): (\w+=".+")/) {
199           print "  $2\n";
200         }
201       }
202       close $log;
203       print "\n";
204       return;
205     }
206   }
207 }
208
209 sub read_akey {
210   my $akey = "$spooldir/.akeys/" . shift;
211   if (my $user = readlink($akey)) {
212     $user =~ s:../::;
213     printf "  USER=\"%s\"\n",$user;
214   }
215 }
216
217
218 sub read_skey {
219   my $skey = "$spooldir/.skeys/" . shift;
220   if (open $skey,$skey) {
221     while (<$skey>) {
222       printf "  FROM=\"%s\"\n",$1 if /from=(.+)/;
223       printf "  TO=\"%s\"\n",$1   if /to=(.+)/;
224     }
225     close $skey;
226   }
227 }
228
229
230 sub utf8decode {
231   local $_ = shift;
232   s/([\xC0-\xDF])([\x80-\xBF])/chr(ord($1)<<6&0xC0|ord($2)&0x3F)/eg;
233   return $_;
234 }