misc/plugins/RequestLog.wps

Name:
        RequestLog
FullName:
        Logging HTTP Header Field Body Value in the Request
URI:
        IW:SuikaWiki:"Wiki//Log"

Description:
        Implementation of this module is temporary.
        Reimplementation is needed!

MODULE:
        our $LoggingName;
        sub add ($$) {
          my ($name, $s) = @_;
          return unless length $s;
          $s =~ s/([^\x20-\x24\x26-\x5A\x5C-\x7E])/sprintf '%%%02X', unpack 'C', $1/ge;
              $s =~ s/(bypass-client=\d+\.\d+\.)(\d+)\.(\d+)/$1.'[VAR['.('*' x length $2).']].[VAR['.('*' x length $3).']]'/ge;
              $s =~ s/[0-5]\d:[0-5]\d:[0-5]\d GMT/[VAR[**]]:[VAR[**]]:[VAR[**]] GMT/g;
              $s =~ s/, (?:[012]\d|3[01])(?=[ -][JFMASOND])/, [VAR[**]]/g;
              $s =~ s/; length=([0-9]+)/'; length=[VAR['.('*' x length $1).']]'/ge;
          my %ua;
          for (split /\n/, $main::database{$main::PageName{'Log_'.$name}}) {
            if (/^-\{(\d+)\} (.+)$/) {
              my ($t, $n) = ($1, $2);
              $n =~ tr/\x0A\x0D//d;
              $ua{$n} = $t;
            }
          }
          $ua{$s}++;
          my $s = qq(#?SuikaWiki/0.9 interactive="yes"\n);
          for (sort {$ua{$a} <=> $ua{$b}} keys %ua) {
            $s .= sprintf qq(-{%d} %s\n), $ua{$_}, $_;
          }
          SuikaWiki::Plugin->_database->STORE ($main::PageName{'Log_'.$name} => $s, -touch => 0);
        }
        
        my $year = (gmtime)[5] + 1900;
        my @fields = (
            [qw/ACCEPT AcceptType/],
            [qw/ACCEPT_CHARSET AcceptCharset/],
            [qw/ACCEPT_ENCODING AcceptEncoding/],
            [qw/ACCEPT_LANGUAGE AcceptLanguage/],
            [qw/TE AcceptTransferEncoding/],
            [qw/CONNECTION Connection/],
            [qw/ACCEPT_GEO AcceptGeo/],
            [qw/KEEP_ALIVE KeepAlive/],
            [qw/MIME_VERSION MIMEVersion/],
            [qw/UA_COLOR UserAgentDisplayColor/],
            [qw/UA_CPU UserAgentCPU/],
            [qw/UA_OS UserAgentOS/],
            [qw/UA_PIXELS UserAgentDisplaySize/],
            [qw/CACHE_CONTROL CacheControl/],
            [qw/PRAGMA Pragma/],
            [qw/IF_MODIFIED_SINCE IMS/],
            [qw/XONNECTION Xonnection:/],
            [qw/XROXY_CONNECTION Xroxy-Connection:/],
            [qw/UNLESS_MODIFIED_SINCE Unless-Modified-Since/],
            [qw/XXXXXXXXXXXXXXX XXXXXXXXXXXXXXX:/],
            [qw/XXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXX:/],
            [qw/RANGE Range:/],
            [qw/REQUEST_RANGE Request-Range/],
            [qw/FROM From:/],
            [qw/DATE Date:/],
            [qw/CONTENT_TRANSFER_ENCODING CTE/],
            [qw/CONTENT_LANGUAGE Content-Language/],
            [qw/CONTENT_DISPOSITION Content-Disposition/],
            [qw/REFERRER Referrer/],
            [qw/CONTENT_ENCODING Content-Encoding/],
            [qw/CONTENT_FEATURES Content-Feature/],
            [qw/ACCEPT_FEATURES Accept-Features/],
            [qw/TRANSFER_ENCODING Transfer-Encoding/],
            [qw/CONTENT_VERSION Content-Version/],
            [qw/DERIVED_FROM Derived-From/],
            [qw/IF_MATCH If-Match/],
            [qw/IF_NONE_MATCH If-None-Match/],
            [qw/EXTENSION Extension/],
            [qw/_______ -------/],
            [qw/_______________ ---------------/],
#           [qw/ /],
          );
          for (@fields) {
            $main::PageName{'Log_'.$_->[0]} = 'Wiki//Log//'.$_->[1].'//'.$year;
          }
          $main::PageName{Log_CONTENT_TYPE} = 'Wiki//Log//ContentType//'.$year;
          $main::PageName{Log_REQUEST_METHOD} = 'Wiki//Log//RequestMethod//'.$year;
          $main::PageName{Log_HeaderField} = 'Wiki//Log//HeaderField//'.$year;
        
          push @{$SuikaWiki::Plugin::On{WikiDatabaseLoaded}}, sub {
            for (map {$_->[0]} @fields) {
              my $v = $main::ENV{'HTTP_'.$_};
              add ($_ => $v);
            }
            add ('CONTENT_TYPE' => $main::ENV{CONTENT_TYPE});
            add ('REQUEST_METHOD' => $main::ENV{REQUEST_METHOD});

            for (grep s/^HTTP_//, keys %main::ENV) {
              (my $name = ucfirst lc $_) =~ s/_([a-z])/-\U$1/g;
              $name =~ tr/_/-/;
              add ('HeaderField' => $name);
            }
          };
        
        
POD:TO DO:
        - better storing format
        
        - Logging method should be more customizable (what mode? what's except?...)
POD:LICENSE:
        Copyright 2003 Wakaba <w@suika.fam.cx>
        
        %%GNUGPL2%%
1	wakaba	1.1	Name:
2			RequestLog
3			FullName:
4	wakaba	1.1.2.1	Logging HTTP Header Field Body Value in the Request
5	wakaba	1.1	URI:
6	wakaba	1.1.2.1	IW:SuikaWiki:"Wiki//Log"
7	wakaba	1.1
8			Description:
9			Implementation of this module is temporary.
10			Reimplementation is needed!
11
12			MODULE:
13			our $LoggingName;
14			sub add ($$) {
15			my ($name, $s) = @_;
16			return unless length $s;
17	wakaba	1.1.2.1	$s =~ s/([^\x20-\x24\x26-\x5A\x5C-\x7E])/sprintf '%%%02X', unpack 'C', $1/ge;
18			$s =~ s/(bypass-client=\d+\.\d+\.)(\d+)\.(\d+)/$1.'[VAR['.('' x length $2).']].[VAR['.('' x length $3).']]'/ge;
19			$s =~ s/[0-5]\d:[0-5]\d:[0-5]\d GMT/[VAR[]]:[VAR[]]:[VAR[**]] GMT/g;
20	wakaba	1.1.2.2	$s =~ s/, (?:[012]\d\|3[01])(?=[ -][JFMASOND])/, [VAR[**]]/g;
21	wakaba	1.1.2.1	$s =~ s/; length=([0-9]+)/'; length=[VAR['.('*' x length $1).']]'/ge;
22	wakaba	1.1	my %ua;
23			for (split /\n/, $main::database{$main::PageName{'Log_'.$name}}) {
24			if (/^-\{(\d+)\} (.+)$/) {
25			my ($t, $n) = ($1, $2);
26			$n =~ tr/\x0A\x0D//d;
27			$ua{$n} = $t;
28			}
29			}
30			$ua{$s}++;
31			my $s = qq(#?SuikaWiki/0.9 interactive="yes"\n);
32			for (sort {$ua{$a} <=> $ua{$b}} keys %ua) {
33			$s .= sprintf qq(-{%d} %s\n), $ua{$_}, $_;
34			}
35			SuikaWiki::Plugin->_database->STORE ($main::PageName{'Log_'.$name} => $s, -touch => 0);
36			}
37
38			my $year = (gmtime)[5] + 1900;
39			my @fields = (
40			[qw/ACCEPT AcceptType/],
41			[qw/ACCEPT_CHARSET AcceptCharset/],
42			[qw/ACCEPT_ENCODING AcceptEncoding/],
43			[qw/ACCEPT_LANGUAGE AcceptLanguage/],
44			[qw/TE AcceptTransferEncoding/],
45			[qw/CONNECTION Connection/],
46			[qw/ACCEPT_GEO AcceptGeo/],
47			[qw/KEEP_ALIVE KeepAlive/],
48			[qw/MIME_VERSION MIMEVersion/],
49			[qw/UA_COLOR UserAgentDisplayColor/],
50			[qw/UA_CPU UserAgentCPU/],
51			[qw/UA_OS UserAgentOS/],
52			[qw/UA_PIXELS UserAgentDisplaySize/],
53			[qw/CACHE_CONTROL CacheControl/],
54			[qw/PRAGMA Pragma/],
55			[qw/IF_MODIFIED_SINCE IMS/],
56			[qw/XONNECTION Xonnection:/],
57			[qw/XROXY_CONNECTION Xroxy-Connection:/],
58	wakaba	1.1.2.1	[qw/UNLESS_MODIFIED_SINCE Unless-Modified-Since/],
59	wakaba	1.1	[qw/XXXXXXXXXXXXXXX XXXXXXXXXXXXXXX:/],
60			[qw/XXXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXX:/],
61			[qw/RANGE Range:/],
62	wakaba	1.1.2.1	[qw/REQUEST_RANGE Request-Range/],
63	wakaba	1.1	[qw/FROM From:/],
64			[qw/DATE Date:/],
65			[qw/CONTENT_TRANSFER_ENCODING CTE/],
66	wakaba	1.1.2.1	[qw/CONTENT_LANGUAGE Content-Language/],
67			[qw/CONTENT_DISPOSITION Content-Disposition/],
68			[qw/REFERRER Referrer/],
69			[qw/CONTENT_ENCODING Content-Encoding/],
70			[qw/CONTENT_FEATURES Content-Feature/],
71			[qw/ACCEPT_FEATURES Accept-Features/],
72			[qw/TRANSFER_ENCODING Transfer-Encoding/],
73			[qw/CONTENT_VERSION Content-Version/],
74			[qw/DERIVED_FROM Derived-From/],
75			[qw/IF_MATCH If-Match/],
76			[qw/IF_NONE_MATCH If-None-Match/],
77	wakaba	1.1.2.2	[qw/EXTENSION Extension/],
78			[qw/_______ -------/],
79			[qw/_______________ ---------------/],
80	wakaba	1.1	# [qw/ /],
81			);
82			for (@fields) {
83			$main::PageName{'Log_'.$_->[0]} = 'Wiki//Log//'.$_->[1].'//'.$year;
84			}
85			$main::PageName{Log_CONTENT_TYPE} = 'Wiki//Log//ContentType//'.$year;
86			$main::PageName{Log_REQUEST_METHOD} = 'Wiki//Log//RequestMethod//'.$year;
87	wakaba	1.1.2.2	$main::PageName{Log_HeaderField} = 'Wiki//Log//HeaderField//'.$year;
88
89	wakaba	1.1	push @{$SuikaWiki::Plugin::On{WikiDatabaseLoaded}}, sub {
90			for (map {$_->[0]} @fields) {
91	wakaba	1.1.2.1	my $v = $main::ENV{'HTTP_'.$_};
92			add ($_ => $v);
93	wakaba	1.1	}
94			add ('CONTENT_TYPE' => $main::ENV{CONTENT_TYPE});
95			add ('REQUEST_METHOD' => $main::ENV{REQUEST_METHOD});
96	wakaba	1.1.2.2
97			for (grep s/^HTTP_//, keys %main::ENV) {
98			(my $name = ucfirst lc $_) =~ s/_([a-z])/-\U$1/g;
99			$name =~ tr/_/-/;
100			add ('HeaderField' => $name);
101			}
102	wakaba	1.1	};
103	wakaba	1.1.2.2
104	wakaba	1.1
105
106
107			POD:TO DO:
108			- better storing format
109
110			- Logging method should be more customizable (what mode? what's except?...)
111			POD:LICENSE:
112			Copyright 2003 Wakaba <w@suika.fam.cx>
113
114			%%GNUGPL2%%