=head1 NAME suikawiki.pl - SuikaWiki Driver as HTTP CGI Script (SWHCS) =head1 DESCRIPTION This script is a WikiDriver for SuikaWiki, working as HTTP CGI script. With this script, SuikaWiki WikiEngine can be controled via remote WWW user agents. This file is part of SuikaWiki. =cut package wiki::driver::http; use strict; our $VERSION = do{my @r=(q$Revision: 1.30 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r}; ## These lines should be removed after utf8 support BEGIN { $Message::Util::Formatter::Base::Token = qr/[\w._+\x80-\xFF-]+/; require Message::Util::Formatter::Base; } ## -- Constructing a new instance of the WikiEngine -- require SuikaWiki::Implementation; our $WIKI = SuikaWiki::Implementation->new; ## -- Registering Version of the WikiDriver -- $WIKI->{driver_name} = 'SWHCS'; $WIKI->{driver_version} = $VERSION; $WIKI->{driver_uri_reference} = q; ## -- Preparing Dying Message as HTTP Response -- require SuikaWiki::Output::CGICarp; $SuikaWiki::Output::CGICarp::CUSTOM_REASON_TEXT = 'Internal WikiEngine Error'; CGI::Carp::set_message (sub { my $msg = shift; ## Already escaped my $wiki_name_version = sprintf '%s/%s %s/%s', $WIKI->{driver_name}, $WIKI->{driver_version}, $WIKI->{engine_name}, $WIKI->{engine_version}; my $trace = Carp::longmess (); for ($trace, $wiki_name_version) { s/&/&/g; s/ 500 Internal WikiEngine Error

Internal WikiEngine Error

$msg

$trace

$wiki_name_version
EOH }); ## -- Loading Configuration File -- $_->($WIKI) for our @Config; ## -- Setting Upper Bound for Too Many Accesses at the Same Time -- { require SuikaWiki::DB::Util::Lock; my $lock = SuikaWiki::DB::Util::Lock ->new (-directory => $WIKI->{config}->{path_to}->{db__lock__dir}, -name => 'main', -share => 1, -limit => 15); $lock->lock or do { require SuikaWiki::Output::HTTP; my $out = SuikaWiki::Output::HTTP->new; $out->{status_code} = 503; $out->{status_phrase} = q; $out->add_header_field ('Retry-After' => 120); $out->{entity}->{media_type} = q; $out->{entity}->{charset} = q; $out->{entity}->{language} = [q]; $out->{entity}->{body_is_octet_stream} = 1; my $wiki_name_version = sprintf '%s/%s %s/%s', $WIKI->{driver_name}, $WIKI->{driver_version}, $WIKI->{engine_name}, $WIKI->{engine_version}; for ($wiki_name_version) { s/&/&/g; s/{entity}->{body} = qq< 503 WikiEngine Busy

WikiEngine Busy

WikiEngine is now busy and is unable to complete your request. Please retry again after a moment.

$wiki_name_version
>; $out->output (output => 'http-cgi'); exit; }; END { $lock->unlock } } ## -- Loading Modules -- use SuikaWiki::DB::Util::Error; ## -- Transitional Functions -- # [to be obsolete] ->Message::MIME::Charset sub main::code_convert { my ($contentref, $code, $srccode) = @_; return $$contentref if $$contentref !~ /[^\x21-\x7E]/; require Jcode; $code ||= $WIKI->{config}->{charset}->{internal}; for ($code, $srccode) { s/[^0-9A-Za-z_.+-]+//g; if ($_ eq 'euc-jp') { $_ = 'euc' } elsif ($_ eq 'iso-2022-jp') { $_ = 'jis' } elsif ($_ eq 'utf-8') { $_ = 'utf8' } elsif ($_ eq 'shift_jis') { $_ = 'sjis' } } if ($code eq 'iso-8859-1') { return $$contentref; ## TODO: } $$contentref = Jcode->new ($contentref, $srccode) ## Normalize FULLWIDTH characters and IDEOGRAPHIC SPACE ->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&,.:;?!`^_/|()[]{}+$%#*@=>< '"~-)) # ->tr (qq(\x8E\xDE\x8E\xDF) => qq(\xA1\xAB\xA1\xAC)) ->h2z (1) ->$code; return $$contentref; } ## -- Initializing WikiPlugin -- $WIKI->init_plugin; ## WikiPlugin manager ## -- Initializing WikiView -- $WIKI->init_view; ## WikiView manager $WIKI->{view}->register_common_modes; ## WikiView manager error handler push @{$WIKI->{event}->{view_error}}, sub { my ($wiki, $event) = @_; SuikaWiki::Plugin->module_package ('Error') ->report_error_simple ($wiki, WikiView => $event->{error}->text, -trace => 1) if $event->{error}->{-def}->{level} eq 'fatal' or $wiki->{config}->{debug}->{view}; unless ($event->{error}->{-def}->{level} eq 'fatal' or $event->{error}->{-def}->{level} eq 'stop') { $event->{cancel} = 1; } }; ## "view_in_mode" method definition push @{$WIKI->{event}->{view_in_mode}}, sub { my ($wiki, $event) = @_; my $opt = $event->{view_in_mode}; my $arg = {condition => {mode => $opt->{mode} || '-error', output => 'http-cgi', http_method => $opt->{method} || 'GET'}}; my $viewobj = $wiki->{view}->instantiate ($opt->{mode} || '-error', $arg); if (ref $viewobj) { $viewobj->main ($arg); } elsif ($opt->{mode} ne '-error') { report SuikaWiki::View::Implementation::error -type => 'WARN_VIEW_NOT_DEFINED', condition => $arg->{condition}, -object => $wiki->{view}, method => 'view_in_mode'; $wiki->view_in_mode (mode => '-wv--no-view-definition', method => 'GET'); ## TODO: cache control for non-GET } else { die "Some error occured. Additionally, error reporting mode not defined"; } }; ## WikiView formatting template error handler $WIKI->{config}->{catch}->{formatter_view} = catch Message::Util::Formatter::error with { my $err = shift; my $wiki = $err->{option}->{param}->{wiki}; SuikaWiki::Plugin->module_package ('Error') ->reporting_formatting_template_error ($err, $wiki, trace => 1); $wiki->view_in_mode (mode => '-error', method => 'GET'); throw SuikaWiki::View::Implementation::error -type => 'ERROR_REPORTED'; }; ## WikiView formatting template error handler (occured in "-error" mode) $WIKI->{config}->{catch}->{formatter_view_error} = catch Message::Util::Formatter::error with { my $err = shift; my $wiki = $err->{option}->{param}->{wiki}; SuikaWiki::Plugin->module_package ('Error') ->reporting_formatting_template_error ($err, $wiki, trace => 1); $wiki->view_in_mode (mode => '-error-error', method => 'GET'); throw SuikaWiki::View::Implementation::error -type => 'ERROR_REPORTED'; }; ## -- Preparing for WikiDatabase Error Reports -- { my $error_report = sub { my ($wiki, $err) = @_; if ($err->{-def}->{level} eq 'fatal') { $wiki->close_db if $wiki->{db}; } my $report = ($err->{-def}->{level} eq 'fatal' or $err->{-def}->{level} eq 'stop' or $wiki->{config}->{debug}->{db}) ? 1 : 0; if ($report and $wiki->{config}->{path_to}->{db__content__error_log}) { my $err_msg = caller (1).($err->{method}? '->'.$err->{method}: '').': ' .(defined $err->{file}? $err->{file} . ': ' : '') .(defined $err->{prop}? $err->{prop} . ': ' : '') .(defined $err->{key}? join ('//', @{$err->{key}}).': ':'') . $err->text . ($wiki->{config}->{debug}->{db} > 1 ? Carp::longmess () : ''); open LOG, '>>', $wiki->{config}->{path_to}->{db__content__error_log}; print LOG scalar (gmtime), " @{[$$]} {$err->{-def}->{level}}: ", $err_msg, "\n"; close LOG; } SuikaWiki::Plugin->module_package ('WikiDB') ->reporting_error ($err, $wiki) if $report; if ($err->{-def}->{level} eq 'fatal' # or $err->{-def}->{level} eq 'stop' ## for debug ) { $wiki->view_in_mode (mode => '-wdb--fatal-error'); throw SuikaWiki::DB::Util::Error -type => 'ERROR_REPORTED'; } }; unshift @{$WIKI->{event}->{database_loaded}}, sub { my $wiki = shift; unshift @{$wiki->{db}->{event}->{error}}, sub { my ($db, $event) = @_; $error_report->($wiki, $event->{error}); if ($event->{error}->{-type} eq 'INFO_DB_PROP_OPENED') { unshift @{$db->{prop}->{$event->{error}->{prop}}->{-db} ->{event}->{error}}, sub { my ($db, $event) = @_; $error_report->($wiki, $event->{error}); }; } }; # database error }; # database_loaded } ## -- Preparing for Misc. Error Reports -- if ($WIKI->{config}->{debug}->{general}) { $main::SIG{__WARN__} = sub { push @{$WIKI->{var}->{error}||=[]}, { description => Message::Markup::XML::Node->new (type => '#text', value => $_[0]), }; }; } ## -- (Declaring for) Initializing $wiki->{var} -- push @{$WIKI->{event}->{setting_initial_variables}}, sub { my $wiki = shift; ## Database access mode $wiki->{var}->{db}->{read_only}->{'#default'} = 1; $wiki->{var}->{db}->{lock_module}->{'#default'} = q; $wiki->{var}->{db}->{read_lock_module}->{'#default'} = q; ## Input parameter require SuikaWiki::Input::HTTP; $wiki->{input} = SuikaWiki::Input::HTTP->new (wiki => $wiki); $wiki->{input}->{decoder}->{'#default'} = sub { my ($http, $s, $temp_params) = @_; return main::code_convert (\$s, $wiki->{config}->{charset}->{internal}, lc (@{$temp_params->{_charset_}||[]}[0]) || $wiki->{config}->{charset}->{uri_param}); }; ## User agent negotiation $wiki->{var}->{client}->{user_agent_name} = $wiki->{input}->meta_variable ('HTTP_USER_AGENT'); $wiki->{var}->{client}->{used_for_negotiate} = ['User-Agent']; try { my $dg = SuikaWiki::Plugin->module_package ('Downgrade'); $dg->set_downgrade_flags ($wiki) if $dg; } catch SuikaWiki::Plugin::error with { my $err = shift; $err->raise unless $err->{-type} eq 'PLUGIN_NOT_FOUND'; }; ## TODO: PATH_INFO support ## URI query parameter my $page = $wiki->{input}->meta_variable ('QUERY_STRING'); if ($page and not (index ($page, '=') > -1)) { $page =~ tr/+/ /; $page =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack 'C', hex $1/ge; $page = main::code_convert (\$page, $wiki->{config}->{charset}->{internal}, $wiki->{config}->{charset}->{uri_query}); } else { $page = $wiki->{input}->parameter ('mypage'); } ## ISSUE: WikiName normalization needed $page =~ s/\s+/\x20/g; $page =~ s/^\x20//; $page =~ s/\x20+$//; $page =~ tr/\x00-\x1F\x7F//d; if ($page) { $wiki->{var}->{page} = $wiki->name ($page); } else { # $wiki->{var}->{page} = $wiki->{config}->{page}->{Default}; $wiki->{var}->{page} = $wiki->name ([]); } ## Mode my $mode = $wiki->{input}->parameter ('mode') || $wiki->{input}->parameter ('mycmd') ## for compatibility with || 'default'; ## YukiWiki and SuikaWiki 2 $mode =~ tr/-/_/; if ($mode eq 'default' or $mode =~ /[^0-9A-Za-z_]/) { my $cookie = $wiki->{input}->meta_variable ('HTTP_COOKIE'); ## BUG: this code is not strict if ($cookie =~ /SelectedMode=([0-9A-Za-z_-]+)/) { $mode = $1; $mode =~ tr/-/_/; } else { $mode = 'read'; } push @{$wiki->{var}->{client}->{used_for_negotiate}}, 'Cookie'; } $wiki->{var}->{mode} = $mode; }; #### ---- Per-Session ---- ## -- Initializing $wiki->{var} (Actual) -- $WIKI->init_variables; ## Per-session variables ## -- Instantiating WikiView -- try { $WIKI->view_in_mode (mode => $WIKI->{var}->{mode}, method => $WIKI->{input}->meta_variable ('REQUEST_METHOD')); } catch SuikaWiki::DB::Util::Error with { my $err = shift; unless ($err->{-type} eq 'ERROR_REPORTED') { $WIKI->view_in_mode (mode => '-wdb--fatal-error'); } } catch SuikaWiki::View::Implementation::error with { my $err = shift; $err->throw unless $err->{-type} eq 'ERROR_REPORTED'; } catch SuikaWiki::Format::Definition::error with { $WIKI->view_in_mode (mode => '-wf--converter-not-found'); } finally { $WIKI->close_input; $WIKI->close_db; }; exit; ## -- Terminating WikiEngine -- END { $WIKI->exit; } =head1 SYNOPSIS In your C, write as: #!/usr/bin/perl BEGIN { $0 = ''.$0 } use strict; use lib qw(lib); use CGI::Carp qw(fatalsToBrowser); require 'suikawiki.pl'; =head1 SEE ALSO , , C, C, C =head1 LICENSE Copyright 2000-2004 Wakaba , et. al. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; # $Date: 2004/04/01 04:46:36 $