/[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.2 - (hide annotations) (download)
Sun Feb 17 09:20:36 2002 UTC (22 years, 9 months ago) by wakaba
Branch: MAIN
Changes since 1.1: +144 -144 lines
*** empty log message ***

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

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24