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

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

Parent Directory | Revision Log | View Patch Patch

-revision 1.1 by wakaba,
Sun Feb 17 08:59:05 2002 UTC
+revision 1.2 by wakaba,
Sun Feb 17 09:20:36 2002 UTC
 Line 1
  #!/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};
    Suika::CGI::Error::die ('404') unless -e $logid;
-   open LOG, $logid or Suika::CGI::Error::die ('500',=> $!) unless -e $logid;
+   open LOG, $logid or Suika::CGI::Error::die ('500',''=> $!) unless -e $logid;
      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;
  }
 ;
  =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

 Legend:



Removed from v.1.1
 


changed lines


 
Added in v.1.2
 Legend:



Removed from v.1.1
 


changed lines


 
Added in v.1.2
-Removed from v.1.1
+Added in v.1.2

admin@suikawiki.org	ViewVC Help
Powered by ViewVC 1.1.24