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