misc/plugins/request-log.wp2

#?SuikaWikiConfig/2.0

Plugin:
  @Name: RequestLog
  @Description:
    @@@: HTTP Request Logging
    @@lang:en
  @License: %%Perl%%
  @Author:
    @@Name:
      @@@@: Wakaba
      @@@lang:ja
      @@@script:Latn
    @@Mail[list]: w@suika.fam.cx
  @Date.RCS:
    $Date: 2004/01/16 07:54:22 $
  @Use:
    use Message::Util::Error;

PluginConst:
  @NS_XHTML1:
    http://www.w3.org/1999/xhtml

FormattingRule:
  @Category[list]:
    view
    view-resource
    form-input
  @Name: rl--log
  @Parameter:
    @@Name: name
    @@Type: name
    @@Default:#REQUIRED
    @@Description:
      @@@: Log category name
      @@lang: en
  @Formatting:
    __ATTRTEXT:%name__;
    my @list;
    try {
      @list = map {[split /\x09/, $_, 2]}
              split /\x0A/,
              $o->{wiki}->{db}->get ('log__http_request',
                                     $o->{wiki}->name ($p->{name} ||
                                       $o->{wiki}->{var}->{page}));
    } catch SuikaWiki::DB::Util::Error with {
      my $err = shift;
      $err->throw if $err->{-type} eq 'ERROR_REPORTED';
    };
    
    if (@list) {
      my $list = $p->{-parent}->append_new_node
                     (type => '#element',
                      namespace_uri => $NS_XHTML1,
                      local_name => 'ol');
      for (sort {$b->[1] <=> $a->[1] or $a->[0] cmp $b->[0]} @list) {
        $list->append_new_node
                     (type => '#element',
                      namespace_uri => $NS_XHTML1,
                      local_name => 'li')
             ->append_text (sprintf '{%d} %s', $_->[1], $_->[0]);
      }
    }

Function:
  @Name: http_request_log
  @Main:
    my (undef, %opt) = @_;
    return if not $opt{wiki}->{db} or not $opt{wiki}->{input};
    $opt{prop} ||= 'log__http_request';
    $opt{ns} ||= [qw/Wiki Log/, (gmtime)[5] + 1900];
    
    ## From HTTP_* CGI meta variables
    for (qw/
      Accept Accept-Charset Accept-Encoding Accept-Language
      Accept-Geo Accept-Features AcceptLanguage
      X-Awg-Client-Protocol-Version X-Awg-Client-Version
      Blonde-Hunter
      Cache-Control X-Cache-ID Cache-Info
      Connection Xonnection Cneonction
      Proxy-Connection Xroxy-Connection
      Content-Disposition Content-Language Content-Transfer-Encoding
      Content-Encoding Content-Feature
      Date
      Extension
      X-EGZ
      From
      X-Filtergate-Request X-IBM-RCA-Request
      If-Modified-Since Unless-Modified-Since If-Match If-None-Match
      If-Range
      Keep-Alive
      X-Locking
      MAX-Forwards
      MIME-Version
      Novinet
      Npfrefr Npfvoid
      Pragma
      ProbixpbContext ProbixpbSignature ProbixpbVersion
      Proxy-----------
      User-Agent Proxy-Agent Wser-Agent X-ICAP-Version X-HTX-Agent Dweb-Client
      Range Request-Range
      Referrer Weferer
      Server-Lover
      X-Sister
      TE Transfer-Encoding
      UA-Color UA-CPU UA-OS UA-Pixels
      X-UP-Subno
      XXXXX XXXXXXX XXXXXXXXXX XXXXXXXXXXXXXXX XXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXX
            ------- ---------- ---------------
    /) {
      (my $mv = uc $_) =~ tr/-/_/;
      __FUNCPACK__->_log_add (%opt,
        value => scalar $opt{wiki}->{input}->meta_variable ('HTTP_'.$mv),
        key => [@{$opt{ns}}, $_]);
    }

    __FUNCPACK__->_log_add (%opt,
        value => scalar $opt{wiki}->{input}->meta_variable ('CONTENT_TYPE'),
        key => [@{$opt{ns}}, 'Content-Type']);
    __FUNCPACK__->_log_add (%opt,
        value => scalar $opt{wiki}->{input}->meta_variable ('REQUEST_METHOD'),
        key => [@{$opt{ns}}, ':request-method']);

    ## Request header field list
    my %ua;
    my $key = [@{$opt{ns}}, ':header-field'];
    for (split /\x0A/, $opt{wiki}->{db}->get ($opt{prop}, $key)) {
      my ($n, $t) = split /\x09/, $_, 2;
      $ua{$n} = $t + 0;     
    }
    for (grep s/^HTTP_//, $opt{wiki}->{input}->meta_variable_list) {
      (my $v = ucfirst lc $_) =~ tr/_/-/;
      $v =~ s/(?<=-)([a-z])/uc $1/ge;
      $ua{$v}++;
    }
    $opt{wiki}->{db}->set ($opt{prop}, $key
            => join "\x0A", map {$_ . "\x09" . $ua{$_}} keys %ua);    

Function:
  @Name: _log_add
  @Main:
          my (undef, %opt) = @_;
          return unless length $opt{value};
    for ($opt{value}) {
      s/([^\x20-\x24\x26-\x5A\x5C-\x7E])/sprintf '%%%02X', unpack 'C', $1/ge;
      s/(bypass-client=\d+\.\d+\.)(\d+)\.(\d+)/$1.'[VAR['.('*' x length $2).']].[VAR['.('*' x length $3).']]'/ge;
      s/[0-5]\d:[0-5]\d:[0-5]\d GMT/[VAR[**]]:[VAR[**]]:[VAR[**]] GMT/g;
      s/, (?:[012]\d|3[01])(?=[ -][JFMASOND])/, [VAR[**]]/g;
      s/; length=([0-9]+)/'; length=[VAR['.('*' x length $1).']]'/ge;
    }
          my %ua;
          for (split /\x0A/, $opt{wiki}->{db}->get ($opt{prop}, $opt{key})) {
              my ($n, $t) = split /\x09/, $_, 2;
              $ua{$n} = $t + 0;     
          }
          $ua{$opt{value}}++;
          $opt{wiki}->{db}->set ($opt{prop}, $opt{key}
            => join "\x0A", map {$_ . "\x09" . $ua{$_}} keys %ua);
1	wakaba	1.1	#?SuikaWikiConfig/2.0
2
3			Plugin:
4			@Name: RequestLog
5			@Description:
6			@@@: HTTP Request Logging
7			@@lang:en
8			@License: %%Perl%%
9			@Author:
10			@@Name:
11			@@@@: Wakaba
12			@@@lang:ja
13			@@@script:Latn
14			@@Mail[list]: w@suika.fam.cx
15			@Date.RCS:
16			$Date: 2004/01/16 07:54:22 $
17			@Use:
18			use Message::Util::Error;
19
20			PluginConst:
21			@NS_XHTML1:
22			http://www.w3.org/1999/xhtml
23
24			FormattingRule:
25			@Category[list]:
26			view
27			view-resource
28			form-input
29			@Name: rl--log
30			@Parameter:
31			@@Name: name
32			@@Type: name
33			@@Default:#REQUIRED
34			@@Description:
35			@@@: Log category name
36			@@lang: en
37			@Formatting:
38			__ATTRTEXT:%name__;
39			my @list;
40			try {
41			@list = map {[split /\x09/, $_, 2]}
42			split /\x0A/,
43			$o->{wiki}->{db}->get ('log__http_request',
44			$o->{wiki}->name ($p->{name} \|\|
45			$o->{wiki}->{var}->{page}));
46			} catch SuikaWiki::DB::Util::Error with {
47			my $err = shift;
48			$err->throw if $err->{-type} eq 'ERROR_REPORTED';
49			};
50
51			if (@list) {
52			my $list = $p->{-parent}->append_new_node
53			(type => '#element',
54			namespace_uri => $NS_XHTML1,
55			local_name => 'ol');
56			for (sort {$b->[1] <=> $a->[1] or $a->[0] cmp $b->[0]} @list) {
57			$list->append_new_node
58			(type => '#element',
59			namespace_uri => $NS_XHTML1,
60			local_name => 'li')
61			->append_text (sprintf '{%d} %s', $_->[1], $_->[0]);
62			}
63			}
64
65			Function:
66			@Name: http_request_log
67			@Main:
68			my (undef, %opt) = @_;
69			return if not $opt{wiki}->{db} or not $opt{wiki}->{input};
70			$opt{prop} \|\|= 'log__http_request';
71			$opt{ns} \|\|= [qw/Wiki Log/, (gmtime)[5] + 1900];
72
73			## From HTTP_* CGI meta variables
74			for (qw/
75			Accept Accept-Charset Accept-Encoding Accept-Language
76			Accept-Geo Accept-Features AcceptLanguage
77			X-Awg-Client-Protocol-Version X-Awg-Client-Version
78			Blonde-Hunter
79			Cache-Control X-Cache-ID Cache-Info
80			Connection Xonnection Cneonction
81			Proxy-Connection Xroxy-Connection
82			Content-Disposition Content-Language Content-Transfer-Encoding
83			Content-Encoding Content-Feature
84			Date
85			Extension
86			X-EGZ
87			From
88			X-Filtergate-Request X-IBM-RCA-Request
89			If-Modified-Since Unless-Modified-Since If-Match If-None-Match
90			If-Range
91			Keep-Alive
92			X-Locking
93			MAX-Forwards
94			MIME-Version
95			Novinet
96			Npfrefr Npfvoid
97			Pragma
98			ProbixpbContext ProbixpbSignature ProbixpbVersion
99			Proxy-----------
100			User-Agent Proxy-Agent Wser-Agent X-ICAP-Version X-HTX-Agent Dweb-Client
101			Range Request-Range
102			Referrer Weferer
103			Server-Lover
104			X-Sister
105			TE Transfer-Encoding
106			UA-Color UA-CPU UA-OS UA-Pixels
107			X-UP-Subno
108			XXXXX XXXXXXX XXXXXXXXXX XXXXXXXXXXXXXXX XXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXX
109			------- ---------- ---------------
110			/) {
111			(my $mv = uc $_) =~ tr/-/_/;
112			__FUNCPACK__->_log_add (%opt,
113			value => scalar $opt{wiki}->{input}->meta_variable ('HTTP_'.$mv),
114			key => [@{$opt{ns}}, $_]);
115			}
116
117			__FUNCPACK__->_log_add (%opt,
118			value => scalar $opt{wiki}->{input}->meta_variable ('CONTENT_TYPE'),
119			key => [@{$opt{ns}}, 'Content-Type']);
120			__FUNCPACK__->_log_add (%opt,
121			value => scalar $opt{wiki}->{input}->meta_variable ('REQUEST_METHOD'),
122			key => [@{$opt{ns}}, ':request-method']);
123
124			## Request header field list
125			my %ua;
126			my $key = [@{$opt{ns}}, ':header-field'];
127			for (split /\x0A/, $opt{wiki}->{db}->get ($opt{prop}, $key)) {
128			my ($n, $t) = split /\x09/, $_, 2;
129			$ua{$n} = $t + 0;
130			}
131			for (grep s/^HTTP_//, $opt{wiki}->{input}->meta_variable_list) {
132			(my $v = ucfirst lc $_) =~ tr/_/-/;
133			$v =~ s/(?<=-)([a-z])/uc $1/ge;
134			$ua{$v}++;
135			}
136			$opt{wiki}->{db}->set ($opt{prop}, $key
137			=> join "\x0A", map {$_ . "\x09" . $ua{$_}} keys %ua);
138
139			Function:
140			@Name: _log_add
141			@Main:
142			my (undef, %opt) = @_;
143			return unless length $opt{value};
144			for ($opt{value}) {
145			s/([^\x20-\x24\x26-\x5A\x5C-\x7E])/sprintf '%%%02X', unpack 'C', $1/ge;
146			s/(bypass-client=\d+\.\d+\.)(\d+)\.(\d+)/$1.'[VAR['.('' x length $2).']].[VAR['.('' x length $3).']]'/ge;
147			s/[0-5]\d:[0-5]\d:[0-5]\d GMT/[VAR[]]:[VAR[]]:[VAR[**]] GMT/g;
148			s/, (?:[012]\d\|3[01])(?=[ -][JFMASOND])/, [VAR[**]]/g;
149			s/; length=([0-9]+)/'; length=[VAR['.('*' x length $1).']]'/ge;
150			}
151			my %ua;
152			for (split /\x0A/, $opt{wiki}->{db}->get ($opt{prop}, $opt{key})) {
153			my ($n, $t) = split /\x09/, $_, 2;
154			$ua{$n} = $t + 0;
155			}
156			$ua{$opt{value}}++;
157			$opt{wiki}->{db}->set ($opt{prop}, $opt{key}
158			=> join "\x0A", map {$_ . "\x09" . $ua{$_}} keys %ua);