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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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