web/bin/log-view.cgi

#!/usr/bin/perl

=head1 NAME

Suika Web Server Log viewer

=cut

use Suika::CGI::Error;
use strict;
require 'jcode.pl';

if ($main::ENV{PATH_TRANSLATED}) {
  my $logid = $main::ENV{PATH_TRANSLATED};
  $logid = readlink ($logid) if -l $logid;
  Suika::CGI::Error::die ('404') unless -e $logid;
  
  open LOG, $logid or Suika::CGI::Error::die ('500',''=> $!);
    my @log = <LOG>;
  close LOG;
  
  $logid =~ s#^/usr/local/apache/htdocs##;
  $logid =~ s#^/home(/[^/]+)/public_html#$1#;
  
  print STDOUT <<EOH;
Content-Type: text/html; charset=iso-8859-1
Content-Language: en

<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01//EN">
<html lang="en">
<head>
<title lang="en">Web server log -- ${logid}</title>
<link rel="stylesheet" href="/admin/web/bin/log-view-style">
<link rev="mail" href="mailto:webmaster\@suika.fam.cx">
<link rel="copyright" href="/c/pd" title="Public Domain.">
</head>
<body>

<h1>Web server log -- ${logid}</h1>

<table><tbody>
EOH
  
  for (sort @log) {
    my ($vname, $value) = split /\x1f/;
    my ($item, $sitem) = split /: */, $vname, 2;
    if ($item eq 'Referer') {
      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 $query = $1; $query =~ tr/+/ /;
        $query =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack('C', hex($1))/eg;
        jcode::convert(\$query, 'euc');  $query = _html($query);
        jcode::convert(\$query, 'jis');
        jcode::fw2hw(\$query, 'jis');
        $sitem = 'Search for '.$query.'<!-- '.$sitem.' -->';
      } elsif ($sitem =~ m#http://www\.google\.(?:com|co\.jp)/search\?([\x00-\xff]+)$#) {
        my @queries = split /[&;]/, $1;
        my $ret;
        for (@queries) {
          my ($name,$query) = split /=/, $_;
          if ($name =~ /q/) {
            $query =~ tr/+/ /;
            $query =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack('C', hex($1))/eg;
            jcode::convert(\$query, 'euc');  $query = _html($query);
            jcode::convert(\$query, 'jis');  jcode::fw2hw(\$query, 'jis');
            $ret .= ' '.$query
          }
        }
        $sitem = 'Search (Google) for '.$ret.'<!-- '.$sitem.' -->';
      } elsif ($sitem =~ m#http://google\.yahoo\.co\.jp/bin/query\?(?:.*?[&;])?p=([\x21-\x7e]+?)(?:[&;]|$)#) {
        my $query = $1; $query =~ tr/+/ /;
        $query =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack('C', hex($1))/eg;
        jcode::convert(\$query, 'euc');  $query = _html($query);
        jcode::convert(\$query, 'jis');  jcode::fw2hw(\$query, 'jis');
        $sitem = 'Search (Google.Yahoo!j) for '.$query.'<!-- '.$sitem.' -->';
      } elsif ($sitem =~ m#http://asearch\.nifty\.com/cgi-bin/Search.cgi\?(?:.*?[&;])?q=([\x21-\x7e]+?)(?:[&;]|$)#) {
        my $query = $1; $query =~ tr/+/ /;
        $query =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack('C', hex($1))/eg;
        jcode::convert(\$query, 'euc');  $query = _html($query);
        jcode::convert(\$query, 'jis');  jcode::fw2hw(\$query, 'jis');
        $sitem = 'Search (@search) for '.$query.'<!-- '.$sitem.' -->';
      } elsif ($sitem =~ m#http://(?:suika\.fam\.cx|suika\.susumu|suika\.ssm|61\.201\.226\.127|192\.168\.0\.4)(/[\x21-\x7e]*)#) {
        $sitem = '<a href="'._html($1).'">'._html($1).'</a>';
      } else {
        $sitem =~ tr/\x00-\x20\x7f-\xff//d;
        $sitem = '<a href="'.$sitem.'">'.$sitem.'</a>';
      }
    } elsif ($item eq 'User') {
      $sitem =~ tr/\x00-\x20\x7f-\xff//d;
      $sitem = jcode::jis(_html(Suika::CGI::User::ID2Name($sitem)).
               ' ('.$sitem.')' || $sitem);
    } else {
      $item = 'UA' if $item eq 'User-Agent';
      $sitem = _html($sitem)
    }
    print '<tr><th>'.$item.'</th><td>'.$sitem.'</td><td class="count">'.$value.'</td></tr>'."\n";
  }
  
  print <<EOH;
</tbody></table>

<address>
$main::ENV{SERVER_SIGNATURE}
</address>
</body></html>
EOH

} else {
  Suika::CGI::Error::die ('400');
}

sub _html ($) {
  my $s = shift;
  $s =~ s/&/&amp;/g;
  $s =~ s/</&lt;/g;
  $s =~ s/>/&gt;/g;
  $s =~ s/"/&quot;/g;
  $s;
}

1;

=head1 AUTHOR

wakaba <w@suika.fam.cx>

=head1 LICENSE

Copyright 2001,2002 wakaba <w@suika.fam.cx>.

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; see the file COPYING.  If not, write to
    the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
    Boston, MA 02111-1307, USA.

=cut
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	wakaba	1.6	open LOG, $logid or Suika::CGI::Error::die ('500',''=> $!);
19	wakaba	1.2	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/&/&/g;
114			$s =~ s/</</g;
115			$s =~ s/>/>/g;
116			$s =~ s/"/"/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