Started ripping out mod_perl

This commit is contained in:
Patrick Donelan 2010-03-11 20:24:50 -05:00
parent 97432e2407
commit 7603fce565
9 changed files with 181 additions and 249 deletions

View file

@ -1,25 +1,29 @@
use Plack::Builder; use Plack::Builder;
use lib '/data/WebGUI/lib'; use lib '/data/WebGUI/lib';
use WebGUI; use WebGUI;
WebGUI->init( root => '/data/WebGUI', config => 'dev.localhost.localdomain.conf' );
my $wg = WebGUI->new(
root => '/data/WebGUI',
config => 'dev.localhost.localdomain.conf',
);
builder { builder {
# Handle /extras via Plack::Middleware::Static # Handle /extras via Plack::Middleware::Static
# (or Plack::Middleware::WebGUI could do this for us by looking up extrasPath and extrasURL in site.conf) # (or Plack::Middleware::WebGUI could do this for us by looking up extrasPath and extrasURL in site.conf)
enable 'Plack::Middleware::Static', # enable 'Plack::Middleware::Static',
path => qr{^/extras/}, # path => '^' . $wg->config->get('extrasURL') . '/',
root => '/data/WebGUI/www'; # root => $wg->config->get('extrasPath');
#
# # Handle /uploads via Plack::Middleware::WGAccess (including .wgaccess)
# # (or Plack::Middleware::WebGUI could do this for us by looking up uploadsPath and uploadsURL in site.conf)
# #enable 'Plack::Middleware::WGAccess',
# # path => '^' . $wg->config->get('uploadsURL') . '/',
# # root => $wg->config->get('uploadsPath');
#
# enable 'Plack::Middleware::Static',
# path => '^' . $wg->config->get('uploadsURL') . '/',
# root => $wg->config->get('uploadsPath');
# Handle /uploads via Plack::Middleware::WGAccess (including .wgaccess) sub { $wg->run(@_) };
# (or Plack::Middleware::WebGUI could do this for us by looking up uploadsPath and uploadsURL in site.conf)
#enable 'Plack::Middleware::WGAccess',
# path => qr{^/uploads/},
# root => '/data/domains/dev.localhost.localdomain/public';
enable 'Plack::Middleware::Static',
path => qr{^/uploads/},
root => '/data/domains/dev.localhost.localdomain/public';
sub { WebGUI::handle_psgi(shift) };
} }

View file

@ -69,15 +69,11 @@ sub _handle_static {
close($FILE); close($FILE);
my @privs = split("\n", $fileContents); my @privs = split("\n", $fileContents);
unless ($privs[1] eq "7" || $privs[1] eq "1") { unless ($privs[1] eq "7" || $privs[1] eq "1") {
my $request = Plack::Request->new( $env );
# Construct request,server,config in the usual way # my $session = $request->pnotes('wgSession');
require WebGUI::Session::Plack;
my $request = WebGUI::Session::Plack->new( env => $env );
my $server = $request->server;
my $session = $request->pnotes('wgSession');
unless (defined $session) { unless (defined $session) {
$session = WebGUI::Session->open($server->dir_config('WebguiRoot'), $request->dir_config('WebguiConfig'), $request, $server); # $session = WebGUI::Session->open($env->{dir_config('WebguiRoot'), $request->dir_config('WebguiConfig'), $request );
} }
my $hasPrivs = ($session->var->get("userId") eq $privs[0] || $session->user->isInGroup($privs[1]) || $session->user->isInGroup($privs[2])); my $hasPrivs = ($session->var->get("userId") eq $privs[0] || $session->user->isInGroup($privs[1]) || $session->user->isInGroup($privs[2]));
$session->close(); $session->close();

View file

@ -20,18 +20,17 @@ our $STATUS = 'beta';
=cut =cut
use strict; use strict;
use Apache2::Access ();
use Apache2::Const -compile => qw(OK DECLINED HTTP_UNAUTHORIZED SERVER_ERROR);
use Apache2::Request;
use Apache2::RequestIO;
use Apache2::RequestUtil ();
use Apache2::ServerUtil ();
use APR::Request::Apache2;
use MIME::Base64 (); use MIME::Base64 ();
use WebGUI::Config; use WebGUI::Config;
use WebGUI::Pluggable; use WebGUI::Pluggable;
use WebGUI::Session; use WebGUI::Session;
use WebGUI::User; use WebGUI::User;
use Any::Moose;
use Plack::Request;
has root => ( is => 'ro', required => 1 ); # WEBGUI_ROOT
has config => ( is => 'ro', required => 1 ); # WEBGUI_CONFIG
has session => ( is => 'rw', isa => 'WebGUI::Session' );
=head1 NAME =head1 NAME
@ -39,7 +38,7 @@ Package WebGUI
=head1 DESCRIPTION =head1 DESCRIPTION
An Apache mod_perl handler for WebGUI. PSGI handler for WebGUI.
=head1 SYNOPSIS =head1 SYNOPSIS
@ -59,7 +58,7 @@ HTTP Basic auth for WebGUI.
=head3 requestObject =head3 requestObject
The Apache2::RequestRec object passed in by Apache's mod_perl. The Plack::Request object instantiated from the PSGI env hash
=head3 user =head3 user
@ -75,46 +74,43 @@ A reference to a WebGUI::Config object. One will be created if it isn't specifie
=cut =cut
sub authen { sub authen {
my ($request, $username, $password, $config) = @_; my ($self, $request, $username, $password, $config) = @_;
my $server;
if ($request->isa('WebGUI::Session::Plack')) { my $response = $request->new_response( 200 );
$server = $request->server;
} else { # # set username and password if it's an auth handler
$request = Apache2::Request->new($request); # if ($username eq "") {
$server = Apache2::ServerUtil->server; #instantiate the server api # if ($request->auth_type eq "Basic") {
} ## ($status, $password) = $request->get_basic_auth_pw; # TODO - don't think this is supported by Plack::Request
my $status = Apache2::Const::OK; # $username = $request->user;
# }
# else {
# $response->status( 401 ); # HTTP_UNAUTHORIZED;
# return;
# }
# }
# set username and password if it's an auth handler $config ||= WebGUI::Config->new( $self->root, $self->config );
if ($username eq "") {
if ($request->auth_type eq "Basic") {
($status, $password) = $request->get_basic_auth_pw;
$username = $request->user;
}
else {
return Apache2::Const::HTTP_UNAUTHORIZED;
}
}
$config ||= WebGUI::Config->new($server->dir_config('WebguiRoot'),$request->dir_config('WebguiConfig'));
my $cookies = APR::Request::Apache2->handle($request)->jar();
# determine session id # determine session id
my $sessionId = $cookies->{$config->getCookieName}; my $sessionId = $request->cookies->{$config->getCookieName};
my $session = WebGUI::Session->open($server->dir_config('WebguiRoot'),$config->getFilename, $request, $server, $sessionId);
my $log = $session->log; # Instantiate the session object
$request->pnotes(wgSession => $session); my $session = $self->session( WebGUI::Session->open($self->root, $self->config, $request, $sessionId) );
my $log = $session->log;
# $request->pnotes(wgSession => $session); # TODO - no more pnotes
if (defined $sessionId && $session->user->isRegistered) { # got a session id passed in or from a cookie if (defined $sessionId && $session->user->isRegistered) { # got a session id passed in or from a cookie
$log->info("BASIC AUTH: using cookie"); $log->info("BASIC AUTH: using cookie");
return Apache2::Const::OK; $response->status( 200 ); # OK;
} return;
elsif ($status != Apache2::Const::OK) { # prompt the user for their username and password
$log->info("BASIC AUTH: prompt for user/pass");
return $status;
} }
# TODO - put this back in once we figure out get_basic_auth_pw
# elsif ($status != 200) { # prompt the user for their username and password
# $log->info("BASIC AUTH: prompt for user/pass");
# return $status;
# }
elsif (defined $username && $username ne "") { # no session cookie, let's try to do basic auth elsif (defined $username && $username ne "") { # no session cookie, let's try to do basic auth
$log->info("BASIC AUTH: using user/pass"); $log->info("BASIC AUTH: using user/pass");
my $user = WebGUI::User->newByUsername($session, $username); my $user = WebGUI::User->newByUsername($session, $username);
@ -124,7 +120,8 @@ sub authen {
my $auth = eval { WebGUI::Pluggable::instanciate("WebGUI::Auth::".$authMethod, "new", [ $session, $authMethod ] ) }; my $auth = eval { WebGUI::Pluggable::instanciate("WebGUI::Auth::".$authMethod, "new", [ $session, $authMethod ] ) };
if ($@) { # got an error if ($@) { # got an error
$log->error($@); $log->error($@);
return Apache2::Const::SERVER_ERROR; $response->status( 500 ); # SERVER_ERROR
return;
} }
elsif ($auth->authenticate($username, $password)) { # lets try to authenticate elsif ($auth->authenticate($username, $password)) { # lets try to authenticate
$log->info("BASIC AUTH: authenticated successfully"); $log->info("BASIC AUTH: authenticated successfully");
@ -136,116 +133,90 @@ sub authen {
} }
$session->{_var} = WebGUI::Session::Var->new($session, $sessionId); $session->{_var} = WebGUI::Session::Var->new($session, $sessionId);
$session->user({user=>$user}); $session->user({user=>$user});
return Apache2::Const::OK; $response->status( 200 ); # OK
return;
} }
} }
} }
$log->security($username." failed to login using HTTP Basic Authentication"); $log->security($username." failed to login using HTTP Basic Authentication");
$request->note_basic_auth_failure; $request->note_basic_auth_failure;
return Apache2::Const::HTTP_UNAUTHORIZED; $response->status( 401 ); # HTTP_UNAUTHORIZED;
return;
} }
$log->info("BASIC AUTH: skipping"); $log->info("BASIC AUTH: skipping");
return Apache2::Const::HTTP_UNAUTHORIZED; $response->status( 401 ); # HTTP_UNAUTHORIZED;
return;
} }
#------------------------------------------------------------------- #-------------------------------------------------------------------
=head2 handler ( requestObject ) =head2 run ( env )
Primary http init/response handler for WebGUI. This method decides whether to hand off the request to contentHandler() or uploadsHandler() Primary http init/response handler for WebGUI. This method decides whether to hand off the request to contentHandler() or uploadsHandler()
=head3 requestObject =head3 env
The Apache2::RequestRec object passed in by Apache's mod_perl. The PSGI environment hash
=cut =cut
sub handler { sub run {
my $request = shift; # either apache request object or PSGI env hash my ($self, $env) = @_;
my ($server, $config);
if ($request->isa('WebGUI::Session::Plack')) { my $request = Plack::Request->new( $env );
$server = $request->server; my $response = $request->new_response( 200 );
$config = WebGUI->config; # use our cached version my $config = WebGUI::Config->new( $self->root, $self->config );
} else {
$request = Apache2::Request->new($request);
$server = Apache2::ServerUtil->server; #instantiate the server api
my $configFile = shift || $request->dir_config('WebguiConfig'); #either we got a config file, or we'll build it from the request object's settings
$config = WebGUI::Config->new($server->dir_config('WebguiRoot'), $configFile); #instantiate the config object
}
my $error = "";
my $matchUri = $request->uri; my $matchUri = $request->uri;
my $gateway = $config->get("gateway"); my $gateway = $config->get("gateway");
$matchUri =~ s{^$gateway}{/}; $matchUri =~ s{^$gateway}{/};
my $gotMatch = 0;
# handle basic auth # handle basic auth
my $auth = $request->headers_in->{'Authorization'}; my $auth = $request->header('Authorization');
if ($auth =~ m/^Basic/) { # machine oriented if ($auth && $auth =~ m/^Basic/) { # machine oriented
# Get username and password from Apache and hand over to authen # Get username and password and hand over to authen
$auth =~ s/Basic //; $auth =~ s/Basic //;
authen($request, split(":", MIME::Base64::decode_base64($auth), 2), $config); $self->authen($request, split(":", MIME::Base64::decode_base64($auth), 2), $config);
} }
else { # realm oriented else { # realm oriented
$request->push_handlers(PerlAuthenHandler => sub { return WebGUI::authen($request, undef, undef, $config)}); # TODO - what to do here? Should we check response status after call to authen?
# $request->push_handlers(PerlAuthenHandler => sub { return WebGUI::authen($request, undef, undef, $config)});
$self->authen($request, undef, undef, $config);
} }
# url handlers # url handlers
# TODO - rip out urlHandler API - convert all to middleware
# all remaining url handlers (probably just Asset which might get converted to something else) should
# set $repsonse->body (e.g. so they can set it to IO) -- they no longer return $output
my $error = "";
my $gotMatch = 0;
# TODO - would now be a time to fix the WEBGUI_FATAL label black magic?
WEBGUI_FATAL: foreach my $handler (@{$config->get("urlHandlers")}) { WEBGUI_FATAL: foreach my $handler (@{$config->get("urlHandlers")}) {
my ($regex) = keys %{$handler}; my ($regex) = keys %{$handler};
if ($matchUri =~ m{$regex}i) { if ($matchUri =~ m{$regex}i) {
my $output = eval { WebGUI::Pluggable::run($handler->{$regex}, "handler", [$request, $server, $config]) }; eval { WebGUI::Pluggable::run($handler->{$regex}, "handler", [$request, $self->session]) };
if ($@) { if ($@) {
$error = $@; $error = $@;
last; last;
} }
else { else {
# Record that at least one url handler ran successfully
$gotMatch = 1; $gotMatch = 1;
if ($output ne Apache2::Const::DECLINED) {
return $output; # But only return response if body was set
if (defined $response->body ) { # or maybe get a smarter way for url handlers to flag success - b/c this may break delayed IO
return $response->finalize;
} }
} }
} }
} }
return Apache2::Const::DECLINED if ($gotMatch);
# can't handle the url due to error or misconfiguration if ( !$gotMatch ) {
$request->push_handlers(PerlResponseHandler => sub { # can't handle the url due to error or misconfiguration
print "This server is unable to handle the url '".$request->uri."' that you requested. ".$error; $response->body( "This server is unable to handle the url '".$request->uri."' that you requested. ".$error );
return Apache2::Const::OK; }
} ); return $response->finalize;
$request->push_handlers(PerlTransHandler => sub { return Apache2::Const::OK });
return Apache2::Const::DECLINED;
} }
sub handle_psgi {
my $env = shift;
require WebGUI::Session::Plack;
my $plack = WebGUI::Session::Plack->new( env => $env );
# returns something like Apache2::Const::OK, which we ignore
my $ret = handler($plack);
# let Plack::Response do its thing
return $plack->finalize;
}
# Experimental speed boost
my ($root, $config_file, $config);
sub init {
my $class = shift;
my %opts = @_;
$root = $opts{root};
$config_file = $opts{config};
$config = WebGUI::Config->new($root, $config_file);
warn 'INIT';
}
sub config { $config }
sub root { $root }
sub config_file { $config_file }
1; 1;

View file

@ -71,7 +71,6 @@ B<NOTE:> It is important to distinguish the difference between a WebGUI session
$session->privilege $session->privilege
$session->request $session->request
$session->scratch $session->scratch
$session->server
$session->setting $session->setting
$session->stow $session->stow
$session->style $session->style
@ -424,7 +423,7 @@ sub log {
#------------------------------------------------------------------- #-------------------------------------------------------------------
=head2 open ( webguiRoot, configFile [, requestObject, serverObject, sessionId, noFuss ] ) =head2 open ( webguiRoot, configFile [, requestObject, sessionId, noFuss ] )
Constructor. Opens a closed ( or new ) WebGUI session. Constructor. Opens a closed ( or new ) WebGUI session.
@ -438,11 +437,7 @@ The filename of the config file that WebGUI should operate from.
=head3 requestObject =head3 requestObject
The Apache request object (aka $r). If this session is being instanciated from the web, this is required. The Plack::Request object. If this session is being instanciated from the web, this is required.
=head3 serverObject
The Apache server object (Apache2::ServerUtil). If this session is being instanciated from the web, this is required.
=head3 sessionId =head3 sessionId
@ -459,23 +454,10 @@ sub open {
my $webguiRoot = shift; my $webguiRoot = shift;
my $configFile = shift; my $configFile = shift;
my $request = shift; my $request = shift;
my $server = shift; my $config = WebGUI::Config->new($webguiRoot,$configFile);
my $config = WebGUI->config || WebGUI::Config->new($webguiRoot,$configFile); my $self = {_config=>$config };
my $self = {_config=>$config, _server=>$server};
bless $self , $class; bless $self , $class;
$self->{_request} = $request if (defined $request);
# $self->{_request} = $request if (defined $request);
if ($request) {
if ($request->isa('WebGUI::Session::Plack')) {
# Use our WebGUI::Session::Plack object that is supposed to do everything Apache2::* can
$self->{_request} = $request;
} else {
# Use WebGUI::Session::Request to wrap Apache2::* calls
require WebGUI::Session::Request;
$self->{_request} = WebGUI::Session::Request->new( r => $request, session => $self );
}
}
my $sessionId = shift || $self->http->getCookies->{$config->getCookieName} || $self->id->generate; my $sessionId = shift || $self->http->getCookies->{$config->getCookieName} || $self->id->generate;
$sessionId = $self->id->generate unless $self->id->valid($sessionId); $sessionId = $self->id->generate unless $self->id->valid($sessionId);
my $noFuss = shift; my $noFuss = shift;
@ -559,7 +541,7 @@ sub quick {
=head2 request ( ) =head2 request ( )
Returns the Apache request (aka $r) object, or undef if it doesn't exist. Returns the Plack::Request object, or undef if it doesn't exist.
=cut =cut
@ -588,13 +570,13 @@ sub scratch {
=head2 server ( ) =head2 server ( )
Returns the Apache server object (Apache2::ServerUtil), or undef if it doesn't exist. DEPRECATED (used to return the Apache2::ServerUtil object)
=cut =cut
sub server { sub server {
my $self = shift; my $self = shift;
return $self->{_server}; $self->log->fatal('WebGUI::Session::server is deprecated');
} }
#------------------------------------------------------------------- #-------------------------------------------------------------------

View file

@ -91,20 +91,7 @@ Retrieves the cookies from the HTTP header and returns a hash reference containi
sub getCookies { sub getCookies {
my $self = shift; my $self = shift;
if ($self->session->request) { return $self->session->request ? $self->session->request->cookies : {};
if ($self->session->request->isa('WebGUI::Session::Plack')) {
return $self->session->request->{request}->cookies;
}
# Have to require this instead of using it otherwise it causes problems for command-line scripts on some platforms (namely Windows)
require APR::Request::Apache2;
my $jarHashRef = APR::Request::Apache2->handle($self->session->request)->jar();
return $jarHashRef if $jarHashRef;
return {};
}
else {
return {};
}
} }
@ -219,7 +206,7 @@ sub ifModifiedSince {
my $self = shift; my $self = shift;
my $epoch = shift; my $epoch = shift;
require APR::Date; require APR::Date;
my $modified = $self->session->request->headers_in->{'If-Modified-Since'}; my $modified = $self->session->request->header('If-Modified-Since');
return 1 if ($modified eq ""); return 1 if ($modified eq "");
$modified = APR::Date::parse_http($modified); $modified = APR::Date::parse_http($modified);
return ($epoch > $modified); return ($epoch > $modified);
@ -282,32 +269,32 @@ sub sendHeader {
$self->setNoHeader(1); $self->setNoHeader(1);
my %params; my %params;
if ($self->isRedirect()) { if ($self->isRedirect()) {
$request->headers_out->set(Location => $self->getRedirectLocation); $request->new_response->header(Location => $self->getRedirectLocation);
$request->status($self->getStatus); $request->new_response->status($self->getStatus);
} else { } else {
$request->content_type($self->getMimeType); $request->content_type($self->getMimeType);
my $cacheControl = $self->getCacheControl; my $cacheControl = $self->getCacheControl;
my $date = ($userId eq "1") ? $datetime->epochToHttp($self->getLastModified) : $datetime->epochToHttp; my $date = ($userId eq "1") ? $datetime->epochToHttp($self->getLastModified) : $datetime->epochToHttp;
# under these circumstances, don't allow caching # under these circumstances, don't allow caching
if ($userId ne "1" || $cacheControl eq "none" || $self->session->setting->get("preventProxyCache")) { if ($userId ne "1" || $cacheControl eq "none" || $self->session->setting->get("preventProxyCache")) {
$request->headers_out->set("Cache-Control" => "private, max-age=1"); $request->new_response->header("Cache-Control" => "private, max-age=1");
$request->no_cache(1); $request->no_cache(1);
} }
# in all other cases, set cache, but tell it to ask us every time so we don't mess with recently logged in users # in all other cases, set cache, but tell it to ask us every time so we don't mess with recently logged in users
else { else {
$request->headers_out->set('Last-Modified' => $date); $request->new_response->header( 'Last-Modified' => $date);
$request->headers_out->set('Cache-Control' => "must-revalidate, max-age=" . $cacheControl); $request->new_response->header( 'Cache-Control' => "must-revalidate, max-age=" . $cacheControl );
# do an extra incantation if the HTTP protocol is really old # do an extra incantation if the HTTP protocol is really old
if ($request->protocol =~ /(\d\.\d)/ && $1 < 1.1) { if ($request->protocol =~ /(\d\.\d)/ && $1 < 1.1) {
my $date = $datetime->epochToHttp(time() + $cacheControl); my $date = $datetime->epochToHttp(time() + $cacheControl);
$request->headers_out->set('Expires' => $date); $request->new_response->header( 'Expires' => $date );
} }
} }
if ($self->getFilename) { if ($self->getFilename) {
$request->headers_out->set('Content-Disposition' => qq{attachment; filename="}.$self->getFilename().'"'); $request->new_response->headers( 'Content-Disposition' => qq{attachment; filename="}.$self->getFilename().'"');
} }
$request->status($self->getStatus()); $request->new_response->status($self->getStatus());
$request->status_line($self->getStatus().' '.$self->getStatusDescription()); # $request->new_response->status_line($self->getStatus().' '.$self->getStatusDescription()); # TODO - re-enable
} }
return undef; return undef;
} }
@ -316,10 +303,10 @@ sub _sendMinimalHeader {
my $self = shift; my $self = shift;
my $request = $self->session->request; my $request = $self->session->request;
$request->content_type('text/html; charset=UTF-8'); $request->content_type('text/html; charset=UTF-8');
$request->headers_out->set('Cache-Control' => 'private'); $request->new_response->header('Cache-Control' => 'private');
$request->no_cache(1); $request->no_cache(1);
$request->status($self->getStatus()); $request->response->status($self->getStatus());
$request->status_line($self->getStatus().' '.$self->getStatusDescription()); # $request->response->status_line($self->getStatus().' '.$self->getStatusDescription()); # TODO - re-enable
return undef; return undef;
} }
@ -389,26 +376,12 @@ sub setCookie {
$ttl = (defined $ttl ? $ttl : '+10y'); $ttl = (defined $ttl ? $ttl : '+10y');
if ($self->session->request) { if ($self->session->request) {
if ( $self->session->request->isa('WebGUI::Session::Plack') ) { $self->session->request->new_response->cookies->{$name} = {
$self->session->request->{response}->cookies->{$name} = {
value => $value, value => $value,
path => '/', path => '/',
expires => $ttl ne 'session' ? $ttl : undef, expires => $ttl ne 'session' ? $ttl : undef,
domain => $domain, domain => $domain,
}; };
}
return;
require Apache2::Cookie;
my $cookie = Apache2::Cookie->new($self->session->request,
-name=>$name,
-value=>$value,
-path=>'/'
);
$cookie->expires($ttl) if $ttl ne 'session';
$cookie->domain($domain) if ($domain);
$cookie->bake($self->session->request);
} }
} }

View file

@ -95,7 +95,17 @@ sub print {
print $handle $content; print $handle $content;
} }
elsif ($self->session->request) { elsif ($self->session->request) {
$self->session->request->print($content); # TODO - take away this hack
if (ref $self->session->request->body eq 'ARRAY') {
push @{$self->session->request->body}, $content;
} else {
if ($self->session->request->logger) {
$self->session->request->logger->({ level => 'warn', message => "dropping content: $content" });
} else {
warn "dropping content: $content";
}
}
# $self->session->request->print($content);
} }
else { else {
print $content; print $content;

View file

@ -15,7 +15,6 @@ package WebGUI::URL::Content;
=cut =cut
use strict; use strict;
use Apache2::Const -compile => qw(OK DECLINED);
use WebGUI::Affiliate; use WebGUI::Affiliate;
use WebGUI::Exception; use WebGUI::Exception;
use WebGUI::Pluggable; use WebGUI::Pluggable;
@ -42,7 +41,7 @@ These subroutines are available from this package:
#------------------------------------------------------------------- #-------------------------------------------------------------------
=head2 handler ( request, server, config ) =head2 handler ( request, session )
The Apache request handler for this package. The Apache request handler for this package.
@ -61,55 +60,51 @@ to the user, instead of displaying the Page Not Found page.
=cut =cut
sub handler { sub handler {
my ($request, $server, $config) = @_; my ($request, $session) = @_;
$request->push_handlers(PerlResponseHandler => sub { my $config = $session->config;
my $session = $request->pnotes('wgSession'); # my $session = $request->pnotes('wgSession'); # TODO - no more pnotes
unless (defined $session) { # unless (defined $session) {
$session = WebGUI::Session->open($server->dir_config('WebguiRoot'), $config->getFilename, $request, $server); # TODO - fix this - server is gone
# $session = WebGUI::Session->open($server->dir_config('WebguiRoot'), $config->getFilename, $request, $server);
# }
WEBGUI_FATAL: foreach my $handler (@{$config->get("contentHandlers")}) {
my $output = eval { WebGUI::Pluggable::run($handler, "handler", [ $session ] )};
if ( my $e = WebGUI::Error->caught ) {
$session->errorHandler->error($e->package.":".$e->line." - ".$e->error);
$session->errorHandler->debug($e->package.":".$e->line." - ".$e->trace);
} }
WEBGUI_FATAL: foreach my $handler (@{$config->get("contentHandlers")}) { elsif ( $@ ) {
my $output = eval { WebGUI::Pluggable::run($handler, "handler", [ $session ] )}; $session->errorHandler->error( $@ );
if ( my $e = WebGUI::Error->caught ) { }
$session->errorHandler->error($e->package.":".$e->line." - ".$e->error); else {
$session->errorHandler->debug($e->package.":".$e->line." - ".$e->trace); if ($output eq "chunked") {
if ($session->errorHandler->canShowDebug()) {
$session->output->print($session->errorHandler->showDebug(),1);
}
last;
} }
elsif ( $@ ) { if ($output eq "empty") {
$session->errorHandler->error( $@ ); if ($session->errorHandler->canShowDebug()) {
$session->output->print($session->errorHandler->showDebug(),1);
}
last;
} }
else { elsif (defined $output && $output ne "") {
if ($output eq "chunked") { $session->http->sendHeader;
if ($session->errorHandler->canShowDebug()) { $session->output->print($output);
$session->output->print($session->errorHandler->showDebug(),1); if ($session->errorHandler->canShowDebug()) {
} $session->output->print($session->errorHandler->showDebug(),1);
last;
}
if ($output eq "empty") {
if ($session->errorHandler->canShowDebug()) {
$session->output->print($session->errorHandler->showDebug(),1);
}
last;
}
elsif (defined $output && $output ne "") {
$session->http->sendHeader;
$session->output->print($output);
if ($session->errorHandler->canShowDebug()) {
$session->output->print($session->errorHandler->showDebug(),1);
}
last;
}
# Keep processing for success codes
elsif ($session->http->getStatus < 200 || $session->http->getStatus > 299) {
$session->http->sendHeader;
last;
} }
last;
}
# Keep processing for success codes
elsif ($session->http->getStatus < 200 || $session->http->getStatus > 299) {
$session->http->sendHeader;
last;
} }
} }
$session->close; }
return Apache2::Const::OK; $session->close;
});
$request->push_handlers(PerlMapToStorageHandler => sub { return Apache2::Const::OK });
$request->push_handlers(PerlTransHandler => sub { return Apache2::Const::OK });
return Apache2::Const::OK;
} }
1; 1;

View file

@ -62,7 +62,7 @@ sub handler {
unless ($privs[1] eq "7" || $privs[1] eq "1") { unless ($privs[1] eq "7" || $privs[1] eq "1") {
my $session = $request->pnotes('wgSession'); my $session = $request->pnotes('wgSession');
unless (defined $session) { unless (defined $session) {
$session = WebGUI::Session->open($server->dir_config('WebguiRoot'), $config->getFilename, $request, $server); # $session = WebGUI::Session->open($server->dir_config('WebguiRoot'), $config->getFilename, $request);
} }
my $hasPrivs = ($session->var->get("userId") eq $privs[0] || $session->user->isInGroup($privs[1]) || $session->user->isInGroup($privs[2])); my $hasPrivs = ($session->var->get("userId") eq $privs[0] || $session->user->isInGroup($privs[1]) || $session->user->isInGroup($privs[2]));
$session->close(); $session->close();

View file

@ -105,7 +105,8 @@ checkModule("Finance::Quote", 1.15 );
checkModule("POE", 1.005 ); checkModule("POE", 1.005 );
checkModule("POE::Component::IKC::Server", 0.2001 ); checkModule("POE::Component::IKC::Server", 0.2001 );
checkModule("POE::Component::Client::HTTP", 0.88 ); checkModule("POE::Component::Client::HTTP", 0.88 );
checkModule("Apache2::Request", 2.08 ); checkModule("Plack::Request");
checkModule("Plack::Response");
checkModule("URI::Escape", "3.29" ); checkModule("URI::Escape", "3.29" );
checkModule("POSIX" ); checkModule("POSIX" );
checkModule("List::Util" ); checkModule("List::Util" );