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/02/18 07:22:11 $
  @Use:
    use Message::Util::Error;
  @Namespace:
    @@log:
      http://suika.fam.cx/~wakaba/-temp/2004/05/01/reqlog#
  @RequiredPlugin[list]:
    WikiLinking

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 $rlist;
    my $sub = [];
    try {
      my $page = $p->{name};
      $page ||= $o->{wiki}->{input}->parameter ('rl--for')
        if $o->{wiki}->{input};
      $page = $o->{wiki}->name ($page);
      unshift @$page, @{$o->{wiki}->{config}->{page}->{<Q:log:root>}||[]};
      $rlist = $o->{wiki}->{db}->get ('log__http_request', $page);
      $sub->[0] = [$o->{wiki}->{db}->keys ('log__http_request', -ns => $page)];
      $sub->[1] = [$o->{wiki}->{db}->keys ('log__http_request', -ns => $page,
                                           -type => 'ns')];
    } catch SuikaWiki::DB::Util::Error with {
      my $err = shift;
      $err->throw if $err->{-type} eq 'ERROR_REPORTED';
    };
    
    if ($rlist and keys %$rlist) {
      my $list = $p->{-parent}->append_new_node
                     (type => '#element',
                      namespace_uri => $NS_XHTML1,
                      local_name => 'ol');
      for (sort {$rlist->{$b} <=> $rlist->{$a} or $a cmp $b} keys %$rlist) {
        $list->append_new_node
                     (type => '#element',
                      namespace_uri => $NS_XHTML1,
                      local_name => 'li')
             ->append_text (sprintf '{%d} %s', $rlist->{$_}, $_);
      }
    }

    for my $i (0, 1) {
    if (@{$sub->[$i]}) {
      my $list = $p->{-parent}->append_new_node
                     (type => '#element',
                      namespace_uri => $NS_XHTML1,
                      local_name => 'ul');
      my $template = $o->{wiki}->{plugin}->module_package ('WikiResource')
                   ->get_text (name => 'RequestLog:List:'.[qw/Leaf Node/]->[$i],
                                   o => $o, wiki => $o->{wiki});
      for (sort {$a->[$#$a] cmp $b->[$#$b]} @{$sub->[$i]}) {
        $o->{wiki}->{plugin}->module_package ('WikiLinking')
          ->to_wikipage_in_html ({
          label => $template,
        } => {
          page_name => $o->{wiki}->{var}->{page},
          param => {
            'rl--for' => $o->{wiki}->name ($_)->stringify (wiki => $o->{wiki}),
          },
        }, {
          parent => $list->append_new_node
                     (type => '#element',
                      namespace_uri => $NS_XHTML1,
                      local_name => 'li'),
          o => $o,
        });
      } 
    }}

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} ||= [@{$opt{wiki}->{config}->{page}->{<Q:log:root>}||[]},
                  (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 $key = [@{$opt{ns}}, ':header-field'];
    my $list = $opt{wiki}->{db}->get ($opt{prop}, $key);

    for (grep s/^HTTP_//, $opt{wiki}->{input}->meta_variable_list) {
      (my $v = ucfirst lc $_) =~ tr/_/-/;
      $v =~ s/(?<=-)([a-z])/uc $1/ge;
      $list->{$v}++;
    }
    $opt{wiki}->{db}->set ($opt{prop}, $key => $list);
    my $list = $opt{wiki}->{db}->get ($opt{prop}, $key);

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 $list = $opt{wiki}->{db}->get ($opt{prop}, $opt{key});
    $list->{$opt{value}}++;
    $opt{wiki}->{db}->set ($opt{prop}, $opt{key} => $list);

FormattingRule:
  @Category[list]: page-link
  @Name: rl--for-param
  @Formatting:
    $p->{-parent}->append_text ($o->{link}->{dest}->{param}->{'rl--for'});

Resource:
  @RequestLog:List:Leaf:
    %link-to-it (
      label => {%rl--for-param;}p,
    );
  @RequestLog:List:Node:
    %link-to-it (
      label => {%rl--for-param;}p,
    );

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	wakaba	1.2	$Date: 2004/02/18 07:22:11 $
17	wakaba	1.1	@Use:
18			use Message::Util::Error;
19	wakaba	1.2	@Namespace:
20			@@log:
21			http://suika.fam.cx/~wakaba/-temp/2004/05/01/reqlog#
22			@RequiredPlugin[list]:
23			WikiLinking
24	wakaba	1.1
25			PluginConst:
26			@NS_XHTML1:
27			http://www.w3.org/1999/xhtml
28
29			FormattingRule:
30			@Category[list]:
31			view
32			view-resource
33			form-input
34			@Name: rl--log
35			@Parameter:
36			@@Name: name
37			@@Type: name
38			@@Default:#REQUIRED
39			@@Description:
40			@@@: Log category name
41			@@lang: en
42			@Formatting:
43			__ATTRTEXT:%name__;
44	wakaba	1.2	my $rlist;
45			my $sub = [];
46	wakaba	1.1	try {
47	wakaba	1.2	my $page = $p->{name};
48			$page \|\|= $o->{wiki}->{input}->parameter ('rl--for')
49			if $o->{wiki}->{input};
50			$page = $o->{wiki}->name ($page);
51			unshift @$page, @{$o->{wiki}->{config}->{page}->{<Q:log:root>}\|\|[]};
52			$rlist = $o->{wiki}->{db}->get ('log__http_request', $page);
53			$sub->[0] = [$o->{wiki}->{db}->keys ('log__http_request', -ns => $page)];
54			$sub->[1] = [$o->{wiki}->{db}->keys ('log__http_request', -ns => $page,
55			-type => 'ns')];
56	wakaba	1.1	} catch SuikaWiki::DB::Util::Error with {
57			my $err = shift;
58			$err->throw if $err->{-type} eq 'ERROR_REPORTED';
59			};
60
61	wakaba	1.2	if ($rlist and keys %$rlist) {
62	wakaba	1.1	my $list = $p->{-parent}->append_new_node
63			(type => '#element',
64			namespace_uri => $NS_XHTML1,
65			local_name => 'ol');
66	wakaba	1.2	for (sort {$rlist->{$b} <=> $rlist->{$a} or $a cmp $b} keys %$rlist) {
67	wakaba	1.1	$list->append_new_node
68			(type => '#element',
69			namespace_uri => $NS_XHTML1,
70			local_name => 'li')
71	wakaba	1.2	->append_text (sprintf '{%d} %s', $rlist->{$_}, $_);
72	wakaba	1.1	}
73			}
74
75	wakaba	1.2	for my $i (0, 1) {
76			if (@{$sub->[$i]}) {
77			my $list = $p->{-parent}->append_new_node
78			(type => '#element',
79			namespace_uri => $NS_XHTML1,
80			local_name => 'ul');
81			my $template = $o->{wiki}->{plugin}->module_package ('WikiResource')
82			->get_text (name => 'RequestLog:List:'.[qw/Leaf Node/]->[$i],
83			o => $o, wiki => $o->{wiki});
84			for (sort {$a->[$#$a] cmp $b->[$#$b]} @{$sub->[$i]}) {
85			$o->{wiki}->{plugin}->module_package ('WikiLinking')
86			->to_wikipage_in_html ({
87			label => $template,
88			} => {
89			page_name => $o->{wiki}->{var}->{page},
90			param => {
91			'rl--for' => $o->{wiki}->name ($_)->stringify (wiki => $o->{wiki}),
92			},
93			}, {
94			parent => $list->append_new_node
95			(type => '#element',
96			namespace_uri => $NS_XHTML1,
97			local_name => 'li'),
98			o => $o,
99			});
100			}
101			}}
102
103	wakaba	1.1	Function:
104			@Name: http_request_log
105			@Main:
106			my (undef, %opt) = @_;
107			return if not $opt{wiki}->{db} or not $opt{wiki}->{input};
108			$opt{prop} \|\|= 'log__http_request';
109	wakaba	1.2	$opt{ns} \|\|= [@{$opt{wiki}->{config}->{page}->{<Q:log:root>}\|\|[]},
110			(gmtime)[5] + 1900];
111	wakaba	1.1
112			## From HTTP_* CGI meta variables
113			for (qw/
114			Accept Accept-Charset Accept-Encoding Accept-Language
115			Accept-Geo Accept-Features AcceptLanguage
116			X-Awg-Client-Protocol-Version X-Awg-Client-Version
117			Blonde-Hunter
118			Cache-Control X-Cache-ID Cache-Info
119			Connection Xonnection Cneonction
120			Proxy-Connection Xroxy-Connection
121			Content-Disposition Content-Language Content-Transfer-Encoding
122			Content-Encoding Content-Feature
123			Date
124			Extension
125			X-EGZ
126			From
127			X-Filtergate-Request X-IBM-RCA-Request
128			If-Modified-Since Unless-Modified-Since If-Match If-None-Match
129			If-Range
130			Keep-Alive
131			X-Locking
132			MAX-Forwards
133			MIME-Version
134			Novinet
135			Npfrefr Npfvoid
136			Pragma
137			ProbixpbContext ProbixpbSignature ProbixpbVersion
138			Proxy-----------
139			User-Agent Proxy-Agent Wser-Agent X-ICAP-Version X-HTX-Agent Dweb-Client
140			Range Request-Range
141			Referrer Weferer
142			Server-Lover
143			X-Sister
144			TE Transfer-Encoding
145			UA-Color UA-CPU UA-OS UA-Pixels
146			X-UP-Subno
147			XXXXX XXXXXXX XXXXXXXXXX XXXXXXXXXXXXXXX XXXXXXXXXXXXXXXX XXXXXXXXXXXXXXXXX
148			------- ---------- ---------------
149			/) {
150			(my $mv = uc $_) =~ tr/-/_/;
151			__FUNCPACK__->_log_add (%opt,
152			value => scalar $opt{wiki}->{input}->meta_variable ('HTTP_'.$mv),
153			key => [@{$opt{ns}}, $_]);
154			}
155
156			__FUNCPACK__->_log_add (%opt,
157			value => scalar $opt{wiki}->{input}->meta_variable ('CONTENT_TYPE'),
158			key => [@{$opt{ns}}, 'Content-Type']);
159			__FUNCPACK__->_log_add (%opt,
160			value => scalar $opt{wiki}->{input}->meta_variable ('REQUEST_METHOD'),
161			key => [@{$opt{ns}}, ':request-method']);
162
163			## Request header field list
164			my $key = [@{$opt{ns}}, ':header-field'];
165	wakaba	1.2	my $list = $opt{wiki}->{db}->get ($opt{prop}, $key);
166
167	wakaba	1.1	for (grep s/^HTTP_//, $opt{wiki}->{input}->meta_variable_list) {
168			(my $v = ucfirst lc $_) =~ tr/_/-/;
169			$v =~ s/(?<=-)([a-z])/uc $1/ge;
170	wakaba	1.2	$list->{$v}++;
171	wakaba	1.1	}
172	wakaba	1.2	$opt{wiki}->{db}->set ($opt{prop}, $key => $list);
173			my $list = $opt{wiki}->{db}->get ($opt{prop}, $key);
174	wakaba	1.1
175			Function:
176			@Name: _log_add
177			@Main:
178	wakaba	1.2	my (undef, %opt) = @_;
179			return unless length $opt{value};
180	wakaba	1.1	for ($opt{value}) {
181			s/([^\x20-\x24\x26-\x5A\x5C-\x7E])/sprintf '%%%02X', unpack 'C', $1/ge;
182			s/(bypass-client=\d+\.\d+\.)(\d+)\.(\d+)/$1.'[VAR['.('' x length $2).']].[VAR['.('' x length $3).']]'/ge;
183			s/[0-5]\d:[0-5]\d:[0-5]\d GMT/[VAR[]]:[VAR[]]:[VAR[**]] GMT/g;
184			s/, (?:[012]\d\|3[01])(?=[ -][JFMASOND])/, [VAR[**]]/g;
185			s/; length=([0-9]+)/'; length=[VAR['.('*' x length $1).']]'/ge;
186			}
187	wakaba	1.2
188			my $list = $opt{wiki}->{db}->get ($opt{prop}, $opt{key});
189			$list->{$opt{value}}++;
190			$opt{wiki}->{db}->set ($opt{prop}, $opt{key} => $list);
191
192			FormattingRule:
193			@Category[list]: page-link
194			@Name: rl--for-param
195			@Formatting:
196			$p->{-parent}->append_text ($o->{link}->{dest}->{param}->{'rl--for'});
197
198			Resource:
199			@RequestLog:List:Leaf:
200			%link-to-it (
201			label => {%rl--for-param;}p,
202			);
203			@RequestLog:List:Node:
204			%link-to-it (
205			label => {%rl--for-param;}p,
206			);
207