/[suikacvs]/webroot/admin/web/bin/log-view.cgi
Suika

Contents of /webroot/admin/web/bin/log-view.cgi

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1.10 - (hide annotations) (download)
Sun Feb 17 10:35:11 2002 UTC (24 years, 9 months ago) by wakaba
Branch: MAIN
Changes since 1.9: +146 -146 lines 
2002-02-17  wakaba <w@suika.fam.cx>

	* ChangeLog: New file.
	
	* log-view.cgi: New file.
	* log-view-style.css: New file.
<
1 wakaba 1.10 #!/usr/bin/perl
2    
3     =head1 NAME
4    
5     Suika Web Server Log viewer
6    
7     =cut
8    
9     use Suika::CGI;
10     use Suika::CGI::Error;
11     use strict;
12     require 'jcode.pl';
13    
14     if ($main::ENV{PATH_TRANSLATED}) {
15     my $logid = $main::ENV{PATH_TRANSLATED};
16     $logid = readlink ($logid) if -l $logid;
17     Suika::CGI::Error::http_error ('404') unless -e $logid;
18    
19     open LOG, $logid or Suika::CGI::Error::http_error ('500',''=> $!);
20     my @log = <LOG>;
21     close LOG;
22    
23     $logid =~ s#^/usr/local/apache/htdocs##;
24     $logid =~ s#^/home(/[^/]+)/public_html#$1#;
25    
26     print STDOUT <<EOH;
27     Content-Type: text/html; charset=junet
28     Content-Language: en
29    
30     <!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01//EN">
31     <html lang="en">
32     <head>
33     <title lang="en">Web server log -- ${logid}</title>
34     <link rel="stylesheet" href="/admin/web/bin/log-view-style">
35     <link rev="mail" href="mailto:webmaster\@suika.fam.cx">
36     <link rel="copyright" href="/c/pd" title="Public Domain.">
37     </head>
38     <body>
39    
40     <h1>Web server log -- ${logid}</h1>
41    
42     <table><tbody>
43     EOH
44    
45     for (sort @log) {
46     my ($vname, $value) = split /\x1f/;
47     my ($item, $sitem) = split /: */, $vname, 2;
48     if ($item eq 'Referer') {
49     if ($sitem =~ m#http://(?:suika\.fam\.cx|suika\.susumu|suika\.ssm|61\.201\.226\.127|192\.168\.0\.4)/search/(?:namazu)\?.*?query=([\x21-\x7e]+?)(?:[&;]|$)#) {
50     my $query = $1; $query =~ tr/+/ /;
51     $query =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack('C', hex($1))/eg;
52     jcode::convert(\$query, 'euc'); $query = _html($query);
53     jcode::convert(\$query, 'jis');
54     jcode::fw2hw(\$query, 'jis');
55     $sitem = 'Search for '.$query.'<!-- '.$sitem.' -->';
56     } elsif ($sitem =~ m#http://www\.google\.(?:com|co\.jp)/search\?([\x00-\xff]+)$#) {
57     my @queries = split /[&;]/, $1;
58     my $ret;
59     for (@queries) {
60     my ($name,$query) = split /=/, $_;
61     if ($name =~ /q/) {
62     $query =~ tr/+/ /;
63     $query =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack('C', hex($1))/eg;
64     jcode::convert(\$query, 'euc'); $query = _html($query);
65     jcode::convert(\$query, 'jis'); jcode::fw2hw(\$query, 'jis');
66     $ret .= ' '.$query
67     }
68     }
69     $sitem = 'Search (Google) for '.$ret.'<!-- '.$sitem.' -->';
70     } elsif ($sitem =~ m#http://google\.yahoo\.co\.jp/bin/query\?(?:.*?[&;])?p=([\x21-\x7e]+?)(?:[&;]|$)#) {
71     my $query = $1; $query =~ tr/+/ /;
72     $query =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack('C', hex($1))/eg;
73     jcode::convert(\$query, 'euc'); $query = _html($query);
74     jcode::convert(\$query, 'jis'); jcode::fw2hw(\$query, 'jis');
75     $sitem = 'Search (Google.Yahoo!j) for '.$query.'<!-- '.$sitem.' -->';
76     } elsif ($sitem =~ m#http://asearch\.nifty\.com/cgi-bin/Search.cgi\?(?:.*?[&;])?q=([\x21-\x7e]+?)(?:[&;]|$)#) {
77     my $query = $1; $query =~ tr/+/ /;
78     $query =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack('C', hex($1))/eg;
79     jcode::convert(\$query, 'euc'); $query = _html($query);
80     jcode::convert(\$query, 'jis'); jcode::fw2hw(\$query, 'jis');
81     $sitem = 'Search (@search) for '.$query.'<!-- '.$sitem.' -->';
82     } elsif ($sitem =~ m#http://(?:suika\.fam\.cx|suika\.susumu|suika\.ssm|61\.201\.226\.127|192\.168\.0\.4)(/[\x21-\x7e]*)#) {
83     $sitem = '<a href="'._html($1).'">'._html($1).'</a>';
84     } else {
85     $sitem =~ tr/\x00-\x20\x7f-\xff//d;
86     $sitem = '<a href="'.$sitem.'">'.$sitem.'</a>';
87     }
88     } elsif ($item eq 'User') {
89     $sitem =~ tr/\x00-\x20\x7f-\xff//d;
90     $sitem = jcode::jis(_html(Suika::CGI::User::ID2Name($sitem)).
91     ' ('.$sitem.')' || $sitem);
92     } else {
93     $item = 'UA' if $item eq 'User-Agent';
94     $sitem = _html($sitem)
95     }
96     print '<tr><th>'.$item.'</th><td>'.$sitem.'</td><td class="count">'.$value.'</td></tr>'."\n";
97     }
98    
99     print <<EOH;
100     </tbody></table>
101    
102     <address>
103     $main::ENV{SERVER_SIGNATURE}
104     </address>
105     </body></html>
106     EOH
107    
108     } else {
109     Suika::CGI::Error::http_error ('400');
110     }
111    
112     sub _html ($) {
113     my $s = shift;
114     $s =~ s/&/&amp;/g;
115     $s =~ s/</&lt;/g;
116     $s =~ s/>/&gt;/g;
117     $s =~ s/"/&quot;/g;
118     $s;
119     }
120    
121     1;