/[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.5 - (hide annotations) (download)
Sun Feb 17 09:41:12 2002 UTC (22 years, 9 months ago) by wakaba
Branch: MAIN
Changes since 1.4: +1 -0 lines
Support symlink.

1 wakaba 1.2 #!/usr/bin/perl
2    
3     =head1 NAME
4    
5     Suika Web Server Log viewer
6    
7     =cut
8    
9     use Suika::CGI::Error;
10     use strict;
11     require 'jcode.pl';
12    
13     if ($main::ENV{PATH_TRANSLATED}) {
14     my $logid = $main::ENV{PATH_TRANSLATED};
15 wakaba 1.5 $logid = readlink ($logid) if -l $logid;
16 wakaba 1.2 Suika::CGI::Error::die ('404') unless -e $logid;
17    
18     open LOG, $logid or Suika::CGI::Error::die ('500',''=> $!) unless -e $logid;
19     my @log = <LOG>;
20     close LOG;
21    
22     $logid =~ s#^/usr/local/apache/htdocs##;
23     $logid =~ s#^/home(/[^/]+)/public_html#$1#;
24    
25     print STDOUT <<EOH;
26     Content-Type: text/html; charset=iso-8859-1
27     Content-Language: en
28    
29     <!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01//EN">
30     <html lang="en">
31     <head>
32     <title lang="en">Web server log -- ${logid}</title>
33     <link rel="stylesheet" href="/admin/web/bin/log-view-style">
34     <link rev="mail" href="mailto:webmaster\@suika.fam.cx">
35     <link rel="copyright" href="/c/pd" title="Public Domain.">
36     </head>
37     <body>
38    
39     <h1>Web server log -- ${logid}</h1>
40    
41     <table><tbody>
42     EOH
43    
44     for (sort @log) {
45     my ($vname, $value) = split /\x1f/;
46     my ($item, $sitem) = split /: */, $vname, 2;
47     if ($item eq 'Referer') {
48     if ($sitem =~ m#http://(?:suika\.fam\.cx|suika\.susumu|suika\.ssm|61\.201\.226\.127|192\.168\.0\.4)/search/(?:namazu)\?.*?query=([\x21-\x7e]+?)(?:[&;]|$)#) {
49     my $query = $1; $query =~ tr/+/ /;
50 wakaba 1.3 $query =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack('C', hex($1))/eg;
51 wakaba 1.2 jcode::convert(\$query, 'euc'); $query = _html($query);
52     jcode::convert(\$query, 'jis');
53     jcode::fw2hw(\$query, 'jis');
54     $sitem = 'Search for '.$query.'<!-- '.$sitem.' -->';
55     } elsif ($sitem =~ m#http://www\.google\.(?:com|co\.jp)/search\?([\x00-\xff]+)$#) {
56     my @queries = split /[&;]/, $1;
57     my $ret;
58     for (@queries) {
59     my ($name,$query) = split /=/, $_;
60     if ($name =~ /q/) {
61     $query =~ tr/+/ /;
62 wakaba 1.4 $query =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack('C', hex($1))/eg;
63 wakaba 1.2 jcode::convert(\$query, 'euc'); $query = _html($query);
64     jcode::convert(\$query, 'jis'); jcode::fw2hw(\$query, 'jis');
65     $ret .= ' '.$query
66     }
67     }
68     $sitem = 'Search (Google) for '.$ret.'<!-- '.$sitem.' -->';
69     } elsif ($sitem =~ m#http://google\.yahoo\.co\.jp/bin/query\?(?:.*?[&;])?p=([\x21-\x7e]+?)(?:[&;]|$)#) {
70     my $query = $1; $query =~ tr/+/ /;
71 wakaba 1.4 $query =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack('C', hex($1))/eg;
72 wakaba 1.2 jcode::convert(\$query, 'euc'); $query = _html($query);
73     jcode::convert(\$query, 'jis'); jcode::fw2hw(\$query, 'jis');
74     $sitem = 'Search (Google.Yahoo!j) for '.$query.'<!-- '.$sitem.' -->';
75     } elsif ($sitem =~ m#http://asearch\.nifty\.com/cgi-bin/Search.cgi\?(?:.*?[&;])?q=([\x21-\x7e]+?)(?:[&;]|$)#) {
76     my $query = $1; $query =~ tr/+/ /;
77 wakaba 1.4 $query =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack('C', hex($1))/eg;
78 wakaba 1.2 jcode::convert(\$query, 'euc'); $query = _html($query);
79     jcode::convert(\$query, 'jis'); jcode::fw2hw(\$query, 'jis');
80     $sitem = 'Search (@search) for '.$query.'<!-- '.$sitem.' -->';
81     } elsif ($sitem =~ m#http://(?:suika\.fam\.cx|suika\.susumu|suika\.ssm|61\.201\.226\.127|192\.168\.0\.4)(/[\x21-\x7e]*)#) {
82     $sitem = '<a href="'._html($1).'">'._html($1).'</a>';
83     } else {
84     $sitem =~ tr/\x00-\x20\x7f-\xff//d;
85     $sitem = '<a href="'.$sitem.'">'.$sitem.'</a>';
86     }
87     } elsif ($item eq 'User') {
88     $sitem =~ tr/\x00-\x20\x7f-\xff//d;
89     $sitem = jcode::jis(_html(Suika::CGI::User::ID2Name($sitem)).
90     ' ('.$sitem.')' || $sitem);
91     } else {
92     $item = 'UA' if $item eq 'User-Agent';
93     $sitem = _html($sitem)
94     }
95     print '<tr><th>'.$item.'</th><td>'.$sitem.'</td><td class="count">'.$value.'</td></tr>'."\n";
96     }
97    
98     print <<EOH;
99     </tbody></table>
100    
101     <address>
102     $main::ENV{SERVER_SIGNATURE}
103     </address>
104     </body></html>
105     EOH
106    
107     } else {
108     Suika::CGI::Error::die ('400');
109     }
110    
111     sub _html ($) {
112     my $s = shift;
113     $s =~ s/&/&amp;/g;
114     $s =~ s/</&lt;/g;
115     $s =~ s/>/&gt;/g;
116     $s =~ s/"/&quot;/g;
117     $s;
118     }
119    
120     1;
121    
122     =head1 AUTHOR
123    
124     wakaba <w@suika.fam.cx>
125    
126     =head1 LICENSE
127    
128     Copyright 2001,2002 wakaba <w@suika.fam.cx>.
129    
130     This program is free software; you can redistribute it and/or modify
131     it under the terms of the GNU General Public License as published by
132     the Free Software Foundation; either version 2 of the License, or
133     (at your option) any later version.
134    
135     This program is distributed in the hope that it will be useful,
136     but WITHOUT ANY WARRANTY; without even the implied warranty of
137     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
138     GNU General Public License for more details.
139    
140     You should have received a copy of the GNU General Public License
141     along with this program; see the file COPYING. If not, write to
142     the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
143     Boston, MA 02111-1307, USA.
144    
145     =cut

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24