/[pub]/suikawiki/script/lib/suikawiki.pl
Suika

Contents of /suikawiki/script/lib/suikawiki.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.34 - (show annotations) (download)
Sun Aug 17 05:14:53 2008 UTC (16 years, 3 months ago) by wakaba
Branch: MAIN
CVS Tags: suikawiki3-redirect, HEAD
Changes since 1.33: +24 -6 lines
File MIME type: text/plain
*** empty log message ***

1 =head1 NAME
2
3 suikawiki.pl - SuikaWiki Driver as HTTP CGI Script (SWHCS)
4
5 =head1 DESCRIPTION
6
7 This script is a WikiDriver for SuikaWiki, working as HTTP CGI script.
8 With this script, SuikaWiki WikiEngine can be controled via remote WWW
9 user agents.
10
11 This file is part of SuikaWiki.
12
13 =cut
14
15 package wiki::driver::http;
16 use strict;
17 our $VERSION = do{my @r=(q$Revision: 1.33 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
18
19 ## These lines should be removed after utf8 support
20 BEGIN {
21 $Message::Util::Formatter::Base::Token = qr/[\w._+\x80-\xFF-]+/;
22 require Message::Util::Formatter::Base;
23 }
24
25 ## -- Constructing a new instance of the WikiEngine --
26
27 require SuikaWiki::Implementation;
28 our $WIKI = SuikaWiki::Implementation->new;
29
30 ## -- Registering Version of the WikiDriver --
31
32 $WIKI->{driver_name} = 'SWHCS';
33 $WIKI->{driver_version} = $VERSION;
34 $WIKI->{driver_uri_reference}
35 = q<http://suika.fam.cx/~wakaba/-temp/wiki/wiki?SWHCS>;
36
37 ## -- Preparing Dying Message as HTTP Response --
38
39 require SuikaWiki::Output::CGICarp;
40 $SuikaWiki::Output::CGICarp::CUSTOM_REASON_TEXT = 'Internal WikiEngine Error';
41 CGI::Carp::set_message (sub {
42 my $msg = shift; ## Already escaped
43 my $wiki_name_version = sprintf '%s/%s %s/%s',
44 $WIKI->{driver_name}, $WIKI->{driver_version},
45 $WIKI->{engine_name}, $WIKI->{engine_version};
46 my $trace = Carp::longmess ();
47 for ($trace, $wiki_name_version) {
48 s/&/&amp;/g; s/</&lt;/g; s/([^\x20-\x7E])/sprintf '&#x%02X;', ord $1/ge;
49 };
50 print <<" EOH";
51 <!DOCTYPE html SYSTEM>
52 <title lang="en">500 Internal WikiEngine Error</title>
53 <h1 lang="en">Internal WikiEngine Error</h1>
54 <p>$msg</p>
55 <p>$trace</p>
56 <address>$wiki_name_version</address>
57 EOH
58 });
59
60 ## -- Loading Configuration File --
61
62 $_->($WIKI) for our @Config;
63
64 ## -- Setting Upper Bound for Too Many Accesses at the Same Time --
65
66 {
67 my $lock_key = 'main';
68 my $lock_limit = $WIKI->{config}->{engine_max_access};
69 if ($main::ENV{HTTP_USER_AGENT} eq '' or
70 $main::ENV{HTTP_USER_AGENT} =~ /[Bb][Oo][Tt]/) {
71 $lock_key = 'robot-main';
72 $lock_limit = $WIKI->{config}->{engine_robot_max_access};
73 } elsif ($main::ENV{REQUEST_METHOD} eq 'POST' and
74 $main::ENV{HTTP_USER_AGENT} =~ /Gecko/) {
75 $lock_key = 'main-post';
76 }
77
78 require SuikaWiki::DB::Util::Lock;
79 my $lock = SuikaWiki::DB::Util::Lock
80 ->new (-directory => $WIKI->{config}->{path_to}->{db__lock__dir},
81 -name => $lock_key,
82 -share => 1,
83 -limit => $lock_limit);
84 $lock->lock or do {
85 require SuikaWiki::Output::HTTP;
86 my $out = SuikaWiki::Output::HTTP->new;
87 $out->{status_code} = 503;
88 $out->{status_phrase} = q<WikiEngine Busy>;
89 $out->add_header_field ('Retry-After' => 120);
90 $out->{entity}->{media_type} = q<text/html>;
91 $out->{entity}->{charset} = q<iso-8859-1>;
92 $out->{entity}->{language} = [q<en>];
93 $out->{entity}->{body_is_octet_stream} = 1;
94 my $wiki_name_version = sprintf '%s/%s %s/%s',
95 $WIKI->{driver_name}, $WIKI->{driver_version},
96 $WIKI->{engine_name}, $WIKI->{engine_version};
97 for ($wiki_name_version) {
98 s/&/&amp;/g; s/</&lt;/g; s/([^\x20-\x7E])/sprintf '&#x%02X;', ord $1/ge;
99 };
100 my $refresh = '';
101 my $refresh_flag = '';
102 if ($main::ENV{REQUEST_METHOD} eq 'GET') {
103 $refresh = '<meta http-equiv=Refresh content=60>';
104 $refresh_flag = ' [Refreshed after a minute]';
105 }
106 $out->{entity}->{body} = qq<
107 <!DOCTYPE html SYSTEM>
108 <title>503 WikiEngine Busy$refresh_flag</title>
109 $refresh
110 <h1>WikiEngine Busy</h1>
111 <p>WikiEngine is now busy and is unable to complete your request.
112 Please retry again after a moment.</p>
113 <address>$wiki_name_version</address>
114 >;
115 $out->output (output => 'http-cgi');
116 exit;
117 };
118 END { $lock->unlock }
119 }
120
121 ## -- Loading Modules --
122
123 use SuikaWiki::DB::Util::Error;
124
125 ## -- Transitional Functions --
126
127 # [to be obsolete] ->Message::MIME::Charset
128 sub main::code_convert {
129 my ($contentref, $code, $srccode) = @_;
130 return $$contentref if $$contentref !~ /[^\x21-\x7E]/;
131 require Jcode;
132 $code ||= $WIKI->{config}->{charset}->{internal};
133 for ($code, $srccode) {
134 s/[^0-9A-Za-z_.+-]+//g;
135 if ($_ eq 'euc-jp') { $_ = 'euc' }
136 elsif ($_ eq 'iso-2022-jp') { $_ = 'jis' }
137 elsif ($_ eq 'utf-8') { $_ = 'utf8' }
138 elsif ($_ eq 'shift_jis') { $_ = 'sjis' }
139 }
140 if ($code eq 'iso-8859-1') {
141 return $$contentref; ## TODO:
142 }
143 $$contentref = Jcode->new ($contentref, $srccode)
144 ## Normalize FULLWIDTH characters and IDEOGRAPHIC SPACE
145 ->tr ("\xA3\xB0-\xA3\xB9\xA3\xC1-\xA3\xDA\xA3\xE1-\xA3\xFA\xA1\xF5\xA1\xA4\xA1\xA5\xA1\xA7\xA1\xA8\xA1\xA9\xA1\xAA\xA1\xAE\xA1\xB0\xA1\xB2\xA1\xBF\xA1\xC3\xA1\xCA\xA1\xCB\xA1\xCE\xA1\xCF\xA1\xD0\xA1\xD1\xA1\xDC\xA1\xF0\xA1\xF3\xA1\xF4\xA1\xF6\xA1\xF7\xA1\xE1\xA1\xE4\xA1\xE3\xA1\xA1\xA2\xAF\xA2\xB0\xA2\xB2\xA2\xB1" => q(0-9A-Za-z&,.:;?!`^_/|()[]{}+$%#*@=>< '"~-))
146 # ->tr (qq(\x8E\xDE\x8E\xDF) => qq(\xA1\xAB\xA1\xAC))
147 ->h2z (1)
148 ->$code;
149 return $$contentref;
150 }
151
152 ## -- Initializing WikiPlugin --
153
154 $WIKI->init_plugin; ## WikiPlugin manager
155
156 ## -- Initializing WikiView --
157
158 $WIKI->init_view; ## WikiView manager
159 $WIKI->{view}->register_common_modes;
160
161 ## WikiView manager error handler
162 push @{$WIKI->{event}->{view_error}}, sub {
163 my ($wiki, $event) = @_;
164 SuikaWiki::Plugin->module_package ('Error')
165 ->report_error_simple
166 ($wiki, WikiView => $event->{error}->text,
167 -trace => 1)
168 if $event->{error}->{-def}->{level} eq 'fatal'
169 or $wiki->{config}->{debug}->{view};
170 unless ($event->{error}->{-def}->{level} eq 'fatal'
171 or $event->{error}->{-def}->{level} eq 'stop') {
172 $event->{cancel} = 1;
173 }
174 };
175
176 ## "view_in_mode" method definition
177 push @{$WIKI->{event}->{view_in_mode}}, sub {
178 my ($wiki, $event) = @_;
179 my $opt = $event->{view_in_mode};
180 my $arg = {condition => {mode => $opt->{mode} || '-error',
181 output => 'http-cgi',
182 http_method => $opt->{method} || 'GET'}};
183 my $viewobj = $wiki->{view}->instantiate ($opt->{mode} || '-error', $arg);
184 if (ref $viewobj) {
185 $viewobj->main ($arg);
186 } elsif ($opt->{mode} ne '-error') {
187 report SuikaWiki::View::Implementation::error
188 -type => 'WARN_VIEW_NOT_DEFINED', condition => $arg->{condition},
189 -object => $wiki->{view}, method => 'view_in_mode';
190 $wiki->view_in_mode (mode => '-wv--no-view-definition', method => 'GET');
191 ## TODO: cache control for non-GET
192 } else {
193 die "Some error occured. Additionally, error reporting mode not defined";
194 }
195 };
196
197 ## WikiView formatting template error handler
198 $WIKI->{config}->{catch}->{formatter_view}
199 = catch Message::Util::Formatter::error with {
200 my $err = shift;
201 my $wiki = $err->{option}->{param}->{wiki};
202 SuikaWiki::Plugin->module_package ('Error')
203 ->reporting_formatting_template_error ($err, $wiki,
204 trace => 1);
205 $wiki->view_in_mode (mode => '-error', method => 'GET');
206 throw SuikaWiki::View::Implementation::error
207 -type => 'ERROR_REPORTED';
208 };
209
210 ## WikiView formatting template error handler (occured in "-error" mode)
211 $WIKI->{config}->{catch}->{formatter_view_error}
212 = catch Message::Util::Formatter::error with {
213 my $err = shift;
214 my $wiki = $err->{option}->{param}->{wiki};
215 SuikaWiki::Plugin->module_package ('Error')
216 ->reporting_formatting_template_error ($err, $wiki,
217 trace => 1);
218 $wiki->view_in_mode (mode => '-error-error', method => 'GET');
219 throw SuikaWiki::View::Implementation::error
220 -type => 'ERROR_REPORTED';
221 };
222
223 ## -- Preparing for WikiDatabase Error Reports --
224 {
225 my $error_report = sub {
226 my ($wiki, $err) = @_;
227 if ($err->{-def}->{level} eq 'fatal') {
228 $wiki->close_db if $wiki->{db};
229 }
230 my $report = ($err->{-def}->{level} eq 'fatal' or
231 $err->{-def}->{level} eq 'stop' or
232 $wiki->{config}->{debug}->{db}) ? 1 : 0;
233 if ($report and $wiki->{config}->{path_to}->{db__content__error_log}) {
234 my $err_msg = caller (1).($err->{method}? '->'.$err->{method}: '').': '
235 .(defined $err->{file}? $err->{file} . ': ' : '')
236 .(defined $err->{prop}? $err->{prop} . ': ' : '')
237 .(defined $err->{key}? join ('//', @{$err->{key}}).': ':'')
238 . $err->text
239 . ($wiki->{config}->{debug}->{db} > 1 ? Carp::longmess () : '');
240 open LOG, '>>', $wiki->{config}->{path_to}->{db__content__error_log};
241 print LOG scalar (gmtime), " @{[$$]} {$err->{-def}->{level}}: ",
242 $err_msg, "\n";
243 close LOG;
244 }
245 SuikaWiki::Plugin->module_package ('WikiDB')
246 ->reporting_error ($err, $wiki) if $report;
247 if ($err->{-def}->{level} eq 'fatal'
248 # or $err->{-def}->{level} eq 'stop' ## for debug
249 ) {
250 $wiki->view_in_mode (mode => '-wdb--fatal-error');
251 throw SuikaWiki::DB::Util::Error -type => 'ERROR_REPORTED';
252 }
253 };
254 unshift @{$WIKI->{event}->{database_loaded}}, sub {
255 my $wiki = shift;
256 unshift @{$wiki->{db}->{event}->{error}}, sub {
257 my ($db, $event) = @_;
258 $error_report->($wiki, $event->{error});
259 if ($event->{error}->{-type} eq 'INFO_DB_PROP_OPENED') {
260 unshift @{$db->{prop}->{$event->{error}->{prop}}->{-db}
261 ->{event}->{error}}, sub {
262 my ($db, $event) = @_;
263 $error_report->($wiki, $event->{error});
264 };
265 }
266 }; # database error
267 }; # database_loaded
268 }
269
270 ## -- Preparing for Misc. Error Reports --
271
272 if ($WIKI->{config}->{debug}->{general}) {
273 $main::SIG{__WARN__} = sub {
274 push @{$WIKI->{var}->{error}||=[]}, {
275 description => Message::Markup::XML::Node->new
276 (type => '#text',
277 value => $_[0]),
278 };
279 };
280 }
281
282 ## -- (Declaring for) Initializing $wiki->{var} --
283
284 push @{$WIKI->{event}->{setting_initial_variables}}, sub {
285 my $wiki = shift;
286 ## Database access mode
287 $wiki->{var}->{db}->{read_only}->{'#default'} = 1;
288 $wiki->{var}->{db}->{lock_module}->{'#default'}
289 = q<SuikaWiki::DB::Util::Lock>;
290 $wiki->{var}->{db}->{read_lock_module}->{'#default'}
291 = q<SuikaWiki::DB::Lock::NoLock>;
292
293 ## Input parameter
294 require SuikaWiki::Input::HTTP;
295 $wiki->{input} = SuikaWiki::Input::HTTP->new (wiki => $wiki);
296 $wiki->{input}->{decoder}->{'#default'} = sub {
297 my ($http, $s, $temp_params) = @_;
298 return main::code_convert (\$s, $wiki->{config}->{charset}->{internal},
299 lc (@{$temp_params->{_charset_}||[]}[0])
300 || $wiki->{config}->{charset}->{uri_param});
301 };
302
303 ## User agent negotiation
304 $wiki->{var}->{client}->{user_agent_name}
305 = $wiki->{input}->meta_variable ('HTTP_USER_AGENT');
306 $wiki->{var}->{client}->{used_for_negotiate} = ['User-Agent'];
307 try {
308 my $dg = SuikaWiki::Plugin->module_package ('Downgrade');
309 $dg->set_downgrade_flags ($wiki) if $dg;
310 } catch SuikaWiki::Plugin::error with {
311 my $err = shift;
312 $err->raise unless $err->{-type} eq 'PLUGIN_NOT_FOUND';
313 };
314
315 ## TODO: PATH_INFO support
316
317 ## URI query parameter
318 my $page = $wiki->{input}->meta_variable ('QUERY_STRING');
319 if ($page and not (index ($page, '=') > -1)) {
320 $page =~ tr/+/ /;
321 $page =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack 'C', hex $1/ge;
322 $page = main::code_convert
323 (\$page, $wiki->{config}->{charset}->{internal},
324 $wiki->{config}->{charset}->{uri_query});
325 } else {
326 $page = $wiki->{input}->parameter ('mypage');
327 }
328
329 ## ISSUE: WikiName normalization needed
330 $page =~ s/\s+/\x20/g;
331 $page =~ s/^\x20//; $page =~ s/\x20+$//;
332 $page =~ tr/\x00-\x1F\x7F//d;
333 if ($page) {
334 $wiki->{var}->{page} = $wiki->name ($page);
335 } else {
336 # $wiki->{var}->{page} = $wiki->{config}->{page}->{Default};
337 $wiki->{var}->{page} = $wiki->name ([]);
338 }
339
340 ## Mode
341 my $mode = $wiki->{input}->parameter ('mode')
342 || $wiki->{input}->parameter ('mycmd') ## for compatibility with
343 || 'default'; ## YukiWiki and SuikaWiki 2
344 $mode =~ tr/-/_/;
345 my $data = $wiki->{input}->parameter ('wikiform__msg');
346 if (($mode eq 'wikiform' and $page =~ /^http:/) or
347 ($mode eq 'wikiform' and ($data =~ s/http:/http:/g) > 5)) {
348 $mode = 'spam';
349 push @{$wiki->{var}->{client}->{used_for_negotiate}}, 'Negotiate';
350 }
351 if ($mode eq 'default' or $mode =~ /[^0-9A-Za-z_]/) {
352 my $cookie = $wiki->{input}->meta_variable ('HTTP_COOKIE');
353 ## BUG: this code is not strict
354 if ($cookie =~ /SelectedMode=([0-9A-Za-z_-]+)/) {
355 $mode = $1; $mode =~ tr/-/_/;
356 } elsif ($wiki->{var}->{client}->{downgrade}->{is_robot} and
357 $wiki->{plugin}->module_package ('Robot', allow_undef => 1)) {
358 $mode = 'robot--read';
359 } else {
360 $mode = 'read';
361 }
362 push @{$wiki->{var}->{client}->{used_for_negotiate}}, 'Cookie';
363 }
364 $wiki->{var}->{mode} = $mode;
365 };
366
367 ## -- Referer Logging --
368 push @{$WIKI->{event}->{input_close}}, sub {
369 my ($wiki, $event) = @_;
370 try {
371 SuikaWiki::Plugin->module_package ('Referer')
372 ->add_referer (wiki => $wiki,
373 uri => $wiki->{input}->meta_variable
374 ('HTTP_REFERER'));
375 } catch SuikaWiki::Plugin::error with {
376 my $err = shift;
377 $err->raise unless $err->{-type} eq 'PLUGIN_NOT_FOUND';
378 };
379 };
380
381 #### ---- Per-Session ----
382
383 ## -- Initializing $wiki->{var} (Actual) --
384
385 $WIKI->init_variables; ## Per-session variables
386
387 ## -- Instantiating WikiView --
388
389 try {
390 $WIKI->view_in_mode
391 (mode => $WIKI->{var}->{mode},
392 method => $WIKI->{input}->meta_variable ('REQUEST_METHOD'));
393 } catch SuikaWiki::DB::Util::Error with {
394 my $err = shift;
395 unless ($err->{-type} eq 'ERROR_REPORTED') {
396 $WIKI->view_in_mode (mode => '-wdb--fatal-error');
397 }
398 } catch SuikaWiki::View::Implementation::error with {
399 my $err = shift;
400 $err->throw unless $err->{-type} eq 'ERROR_REPORTED';
401 } catch SuikaWiki::Format::Definition::error with {
402 $WIKI->view_in_mode (mode => '-wf--converter-not-found');
403 } finally {
404 $WIKI->close_input;
405 $WIKI->close_db;
406 };
407 exit;
408
409
410
411 ## -- Terminating WikiEngine --
412
413 END {
414 $WIKI->exit;
415 }
416
417 =head1 SYNOPSIS
418
419 In your C<suikawiki.cgi>, write as:
420
421 #!/usr/bin/perl
422 BEGIN { $0 = ''.$0 }
423 use strict;
424 use lib qw(lib);
425 use CGI::Carp qw(fatalsToBrowser);
426 require 'suikawiki.pl';
427
428 =head1 SEE ALSO
429
430 <http://suika.fam.cx/~wakaba/-temp/wiki/wiki?SuikaWiki>,
431 <http://suika.fam.cx/~wakaba/-temp/wiki/wiki?SWHCS>,
432 C<wiki.cgi>, C<wikidata/suikawiki-config.ph>,
433 C<SuikaWiki::Implementation>
434
435 =head1 LICENSE
436
437 Copyright 2000-2004 Wakaba <w@suika.fam.cx>, et. al. All rights reserved.
438
439 This program is free software; you can redistribute it and/or
440 modify it under the same terms as Perl itself.
441
442 =cut
443
444 1; # $Date: 2006/05/28 01:59:51 $

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24