/[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.12 - (hide annotations) (download)
Fri Mar 11 11:51:06 2005 UTC (19 years, 8 months ago) by wakaba
Branch: MAIN
CVS Tags: HEAD
Changes since 1.11: +0 -0 lines
FILE REMOVED
Comma tools: new

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     $main::ENV{SERVER_SIGNATURE}
103     </body></html>
104     EOH
105    
106     } else {
107     Suika::CGI::Error::http_error ('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