web/bin/log-view.cgi

#!/usr/bin/perl

=head1 NAME

Suika Web Server Log viewer

=cut

use Suika::CGI;
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::http_error ('404') unless -e $logid;
  
  open LOG, $logid or Suika::CGI::Error::http_error ('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=junet
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::http_error ('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.8	#!/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	wakaba	1.9	Suika::CGI::Error::http_error ('404') unless -e $logid;
18	wakaba	1.8
19	wakaba	1.9	open LOG, $logid or Suika::CGI::Error::http_error ('500',''=> $!);
20	wakaba	1.8	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			<address>
103			$main::ENV{SERVER_SIGNATURE}
104			</address>
105			</body></html>
106			EOH
107
108			} else {
109	wakaba	1.9	Suika::CGI::Error::http_error ('400');
110	wakaba	1.8	}
111
112			sub _html ($) {
113			my $s = shift;
114			$s =~ s/&/&/g;
115			$s =~ s/</</g;
116			$s =~ s/>/>/g;
117			$s =~ s/"/"/g;
118			$s;
119			}
120
121			1;
122
123			=head1 AUTHOR
124
125			wakaba <w@suika.fam.cx>
126
127			=head1 LICENSE
128
129			Copyright 2001,2002 wakaba <w@suika.fam.cx>.
130
131			This program is free software; you can redistribute it and/or modify
132			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			(at your option) any later version.
135
136			This program is distributed in the hope that it will be useful,
137			but WITHOUT ANY WARRANTY; without even the implied warranty of
138			MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
139			GNU General Public License for more details.
140
141			You should have received a copy of the GNU General Public License
142			along with this program; see the file COPYING. If not, write to
143			the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
144			Boston, MA 02111-1307, USA.
145
146			=cut