diff --git a/README b/README index 62971c023..054eb5dd2 100644 --- a/README +++ b/README @@ -8,7 +8,7 @@ You can benchmark your server via: ab -t 3 -c 10 -k http://dev.localhost.localdomain:5000/ | grep Req -I'm currently getting 23 requests/second, whereas I'm getting 30/second on the non-PSGI WebGUI8 branch. +I'm currently getting 370 requests/second, whereas I'm getting 430/second on the non-PSGI WebGUI8 branch. = ARCHITECTURE = diff --git a/app.psgi b/app.psgi index 902dd0e6b..a8fda4126 100644 --- a/app.psgi +++ b/app.psgi @@ -9,7 +9,16 @@ my $wg = WebGUI->new( root => $root, site => 'dev.localhost.localdomain.conf' ); builder { enable 'Log4perl', category => 'mysite', conf => "$root/etc/log.conf"; + + # Reproduce URL handler functionality with middleware + enable '+WebGUI::Middleware::Snoop'; enable 'Static', root => $root, path => sub { s{^/\*give-credit-where-credit-is-due\*$}{docs/credits.txt} }; + enable 'Status', path => qr{^/uploads/dictionaries}, status => 401; + # For PassThru, use Plack::Builder::mount + + # Extras fallback (you should be using something else to serve static files in production) + my ($extrasURL, $extrasPath) = ( $wg->config->get('extrasURL'), $wg->config->get('extrasPath') ); + enable 'Static', root => "$extrasPath/", path => sub { s{^$extrasURL/}{} }; # Open/close the WebGUI::Session at the outer-most onion layer enable '+WebGUI::Middleware::Session', diff --git a/lib/WebGUI.pm b/lib/WebGUI.pm index 6270c0607..48f42f839 100644 --- a/lib/WebGUI.pm +++ b/lib/WebGUI.pm @@ -84,11 +84,9 @@ sub psgi_app { sub compile_psgi_app { my $self = shift; - my $catch = [ 500, [ 'Content-Type' => 'text/plain' ], [ "Internal Server Error" ] ]; - # WebGUI is a PSGI app is a Perl code reference. Let's create one. # Each web request results in a call to this sub - my $app = sub { + return sub { my $env = shift; # Use the PSGI callback style response, which allows for nice things like @@ -99,7 +97,7 @@ sub compile_psgi_app { my $session = $env->{'webgui.session'} or die 'Missing WebGUI Session - check WebGUI::Middleware::Session'; # Handle the request - $self->handle($session); + handle($session); # Construct the PSGI response my $response = $session->response; @@ -128,12 +126,11 @@ sub compile_psgi_app { $session->request->TRACE("Error detected after streaming response started"); $response->writer->close; } else { - $responder->( $catch ); + $responder->( [ 500, [ 'Content-Type' => 'text/plain' ], [ "Internal Server Error" ] ] ); } } } else { - # Not streaming, so immediately tell the callback to return # the response. In the future we could use an Event framework here # to make this a non-blocking delayed response. @@ -141,34 +138,10 @@ sub compile_psgi_app { } } }; - - # Wrap $app with some extra middleware that acts as a fallback for when - # you're not using something fast to serve static content - # - # This could also be in the .psgi file, but it seems sensible to have it - # baked in as a fallback (unless we find it drains performance) - my $config = $self->config; - - # Extras - use Plack::Middleware::Static; - my $extrasURL = $config->get('extrasURL'); - my $extrasPath = $config->get('extrasPath'); - $app = Plack::Middleware::Static->wrap($app, - path => sub { s{^$extrasURL/}{} }, - root => "$extrasPath/", - ); - - # Uploads - my $uploadsURL = $config->get('uploadsURL'); - my $uploadsPath = $config->get('uploadsPath'); - $app = Plack::Middleware::Static->wrap($app, - path => sub { s{^$uploadsURL/}{} }, - root => "$uploadsPath/", - ); } sub handle { - my ( $self, $session ) = @_; + my ( $session ) = @_; # uncomment the following to short-circuit contentHandlers (for benchmarking PSGI scaffolding vs. modperl) # $session->output->print("WebGUI PSGI with contentHandlers short-circuited for benchmarking\n"); diff --git a/lib/WebGUI/Middleware/Session.pm b/lib/WebGUI/Middleware/Session.pm index 5deb0189f..ab9d8f3d1 100644 --- a/lib/WebGUI/Middleware/Session.pm +++ b/lib/WebGUI/Middleware/Session.pm @@ -45,6 +45,7 @@ sub call { } catch { # We don't have a logger object, so for now just warn() the error warn "Unable to instantiate WebGUI::Session - $_"; + return; # make sure $session assignment is undef }; if ( !$session ) { @@ -85,7 +86,11 @@ sub call { # Close the Session $env->{'webgui.session'}->close(); + #memory_cycle_ok( $env->{'webgui.session'} ); delete $env->{'webgui.session'}; + + #use Test::Memory::Cycle; + #memory_cycle_ok( $env ); } ); } diff --git a/lib/WebGUI/Middleware/Snoop.pm b/lib/WebGUI/Middleware/Snoop.pm new file mode 100644 index 000000000..ec88ae9ff --- /dev/null +++ b/lib/WebGUI/Middleware/Snoop.pm @@ -0,0 +1,34 @@ +package WebGUI::Middleware::Snoop; +use strict; +use parent qw(Plack::Middleware); + +=head1 NAME + +WebGUI::Middleware::Snoop - sample middleware port of WebGUI::URL::Snoop + +=head1 DESCRIPTION + +This is PSGI middleware for WebGUI. + +It was ported from L, back when we still had URL handlers. + +L described itself as "A URL handler that should never be called." + +You might find this middleware useful as a template for creating other simple classes. + +=cut + +sub call { + my $self = shift; + my $env = shift; + + my $path = $env->{PATH_INFO}; + if ($path =~ qr{^/abcdefghijklmnopqrstuvwxyz$}) { + my $snoop = q|Snoopy
Why would you type in this URL? Really. What were you expecting to see here? You really need to get a life. Are you still here? Seriously, you need to go do something else. I think your boss is calling.
|; + return [ 200, [ 'Content-Type' => 'text/html' ], [ $snoop ] ]; + } else { + return $self->app->($env); + } +} + +1; \ No newline at end of file diff --git a/lib/WebGUI/URL/Credits.pm b/lib/WebGUI/URL/Credits.pm deleted file mode 100644 index 735e31e3a..000000000 --- a/lib/WebGUI/URL/Credits.pm +++ /dev/null @@ -1,65 +0,0 @@ -package WebGUI::URL::Credits; - -=head1 LEGAL - - ------------------------------------------------------------------- - WebGUI is Copyright 2001-2009 Plain Black Corporation. - ------------------------------------------------------------------- - Please read the legal notices (docs/legal.txt) and the license - (docs/license.txt) that came with this distribution before using - this software. - ------------------------------------------------------------------- - http://www.plainblack.com info@plainblack.com - ------------------------------------------------------------------- - -=cut - -use strict; -use Apache2::Const -compile => qw(OK DECLINED); -use APR::Finfo (); -use APR::Const -compile => qw(FINFO_NORM); -use WebGUI::Session; - -=head1 NAME - -Package WebGUI::URL::Credits - -=head1 DESCRIPTION - -A URL handler that displays the credits file. - -=head1 SYNOPSIS - - use WebGUI::URL::Credits; - my $status = WebGUI::URL::Credits::handler($r, $s, $config); - -=head1 SUBROUTINES - -These subroutines are available from this package: - -=cut - -#------------------------------------------------------------------- - -=head2 handler ( request, server, config ) - -The Apache request handler for this package. - -=cut - -sub handler { - my ($request, $server, $config) = @_; - my $filename = $config->getWebguiRoot."/docs/credits.txt"; - $request->push_handlers(PerlResponseHandler => sub { - $request->content_type('text/plain'); - $request->sendfile($filename); - return Apache2::Const::OK; - }); - $request->push_handlers(PerlTransHandler => sub { return Apache2::Const::OK }); - $request->push_handlers(PerlMapToStorageHandler => sub { return Apache2::Const::OK }); - return Apache2::Const::OK; -} - - -1; - diff --git a/lib/WebGUI/URL/PassThru.pm b/lib/WebGUI/URL/PassThru.pm deleted file mode 100644 index d07a268ec..000000000 --- a/lib/WebGUI/URL/PassThru.pm +++ /dev/null @@ -1,59 +0,0 @@ -package WebGUI::URL::PassThru; - -=head1 LEGAL - - ------------------------------------------------------------------- - WebGUI is Copyright 2001-2009 Plain Black Corporation. - ------------------------------------------------------------------- - Please read the legal notices (docs/legal.txt) and the license - (docs/license.txt) that came with this distribution before using - this software. - ------------------------------------------------------------------- - http://www.plainblack.com info@plainblack.com - ------------------------------------------------------------------- - -=cut - -use strict; -use Apache2::Const -compile => qw(OK DECLINED DIR_MAGIC_TYPE); - - -=head1 NAME - -Package WebGUI::URL::PassThru - -=head1 DESCRIPTION - -A URL handler that just passes the URLs back to Apache. - -=head1 SYNOPSIS - - use WebGUI::URL::PassThru; - my $status = WebGUI::URL::PassThru::handler($r, $s, $config); - -=head1 SUBROUTINES - -These subroutines are available from this package: - -=cut - -#------------------------------------------------------------------- - -=head2 handler ( request, server, config ) - -=cut - -sub handler { - my ($request, $server, $config) = @_; - if ($request->handler eq 'perl-script' && # Handler is Perl - -d $request->filename && # Filename requested is a directory - $request->is_initial_req) # and this is the initial request - { - $request->handler(Apache2::Const::DIR_MAGIC_TYPE); # Hand off to mod_dir - return Apache2::Const::OK; - } - return Apache2::Const::OK; -} - -1; - diff --git a/lib/WebGUI/URL/Snoop.pm b/lib/WebGUI/URL/Snoop.pm deleted file mode 100644 index 58ee708fe..000000000 --- a/lib/WebGUI/URL/Snoop.pm +++ /dev/null @@ -1,61 +0,0 @@ -package WebGUI::URL::Snoop; - -=head1 LEGAL - - ------------------------------------------------------------------- - WebGUI is Copyright 2001-2009 Plain Black Corporation. - ------------------------------------------------------------------- - Please read the legal notices (docs/legal.txt) and the license - (docs/license.txt) that came with this distribution before using - this software. - ------------------------------------------------------------------- - http://www.plainblack.com info@plainblack.com - ------------------------------------------------------------------- - -=cut - -use strict; -use Apache2::Const -compile => qw(OK DECLINED); -use WebGUI::Session; - -=head1 NAME - -Package WebGUI::URL::Snoop - -=head1 DESCRIPTION - -A URL handler that should never be called. - -=head1 SYNOPSIS - - use WebGUI::URL::Snoop; - my $status = WebGUI::URL::Snoop::handler($r, $configFile); - -=head1 SUBROUTINES - -These subroutines are available from this package: - -=cut - -#------------------------------------------------------------------- - -=head2 handler ( request, configFile ) - -The Apache request handler for this package. - -=cut - -sub handler { - my ($request, $server, $config) = @_; - $request->content_type("text/html"); - $request->push_handlers(PerlResponseHandler => sub { - $request->print(q|Snoopy
Why would you type in this URL? Really. What were you expecting to see here? You really need to get a life. Are you still here? Seriously, you need to go do something else. I think your boss is calling.
|); - return Apache2::Const::OK; - } ); - $request->push_handlers(PerlTransHandler => sub { return Apache2::Const::OK }); - return Apache2::Const::OK; -} - - -1; - diff --git a/lib/WebGUI/URL/Unauthorized.pm b/lib/WebGUI/URL/Unauthorized.pm deleted file mode 100644 index 6665c1cfd..000000000 --- a/lib/WebGUI/URL/Unauthorized.pm +++ /dev/null @@ -1,54 +0,0 @@ -package WebGUI::URL::Unauthorized; - -=head1 LEGAL - - ------------------------------------------------------------------- - WebGUI is Copyright 2001-2009 Plain Black Corporation. - ------------------------------------------------------------------- - Please read the legal notices (docs/legal.txt) and the license - (docs/license.txt) that came with this distribution before using - this software. - ------------------------------------------------------------------- - http://www.plainblack.com info@plainblack.com - ------------------------------------------------------------------- - -=cut - -use strict; -use Apache2::Const -compile => qw(AUTH_REQUIRED); - - -=head1 NAME - -Package WebGUI::URL::Unauthorized - -=head1 DESCRIPTION - -A URL handler that deals with requests where the user cannot access what they requested. - -=head1 SYNOPSIS - - use WebGUI::URL::Unauthorized; - my $status = WebGUI::URL::Unauthorized::handler($r, $s, $config); - -=head1 SUBROUTINES - -These subroutines are available from this package: - -=cut - -#------------------------------------------------------------------- - -=head2 handler ( request, server, config ) - -The Apache request handler for this package. - -=cut - -sub handler { - my ($request, $server, $config) = @_; - return Apache2::Const::AUTH_REQUIRED; -} - -1; - diff --git a/lib/WebGUI/URL/Uploads.pm b/lib/WebGUI/URL/Uploads.pm deleted file mode 100644 index e96e4ec84..000000000 --- a/lib/WebGUI/URL/Uploads.pm +++ /dev/null @@ -1,88 +0,0 @@ -package WebGUI::URL::Uploads; - -=head1 LEGAL - - ------------------------------------------------------------------- - WebGUI is Copyright 2001-2009 Plain Black Corporation. - ------------------------------------------------------------------- - Please read the legal notices (docs/legal.txt) and the license - (docs/license.txt) that came with this distribution before using - this software. - ------------------------------------------------------------------- - http://www.plainblack.com info@plainblack.com - ------------------------------------------------------------------- - -=cut - -use strict; -use Apache2::Const -compile => qw(OK DECLINED NOT_FOUND AUTH_REQUIRED); -use WebGUI::Session; - -=head1 NAME - -Package WebGUI::URL::Uploads; - -=head1 DESCRIPTION - -A URL handler that handles privileges for uploaded files. - -=head1 SYNOPSIS - - use WebGUI::URL::Uploads; - my $status = WebGUI::URL::Uploads::handler($r, $s, $config); - -=head1 SUBROUTINES - -These subroutines are available from this package: - -=cut - -#------------------------------------------------------------------- - -=head2 handler ( request, server, config ) - -The Apache request handler for this package. - -=cut - -sub handler { - my ($request, $server, $config) = @_; - $request->push_handlers(PerlAccessHandler => sub { - if (-e $request->filename) { - my $path = $request->filename; - $path =~ s/^(\/.*\/).*$/$1/; - if (-e $path.".wgaccess") { - my $fileContents; - open(my $FILE, "<" ,$path.".wgaccess"); - while (my $line = <$FILE>) { - $fileContents .= $line; - } - close($FILE); - my @privs = split("\n", $fileContents); - unless ($privs[1] eq "7" || $privs[1] eq "1") { - my $session = $request->pnotes('wgSession'); - unless (defined $session) { -# $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])); - $session->close(); - if ($hasPrivs) { - return Apache2::Const::OK; - } - else { - return Apache2::Const::AUTH_REQUIRED; - } - } - } - return Apache2::Const::OK; - } - else { - return Apache2::Const::NOT_FOUND; - } - } ); - return Apache2::Const::OK; -} - - -1; - diff --git a/lib/WebGUI/URL/_url.skeleton b/lib/WebGUI/URL/_url.skeleton deleted file mode 100644 index 4faceab04..000000000 --- a/lib/WebGUI/URL/_url.skeleton +++ /dev/null @@ -1,55 +0,0 @@ -package WebGUI::URL::MyHandler; - -=head1 LEGAL - - ------------------------------------------------------------------- - WebGUI is Copyright 2001-2009 Plain Black Corporation. - ------------------------------------------------------------------- - Please read the legal notices (docs/legal.txt) and the license - (docs/license.txt) that came with this distribution before using - this software. - ------------------------------------------------------------------- - http://www.plainblack.com info@plainblack.com - ------------------------------------------------------------------- - -=cut - -use strict; -use Apache2::Const -compile => qw(OK DECLINED NOT_FOUND); - - -=head1 NAME - -Package WebGUI::URL::MyHandler - -=head1 DESCRIPTION - -A URL handler that does whatever I tell it to do. - -=head1 SYNOPSIS - - use WebGUI::URL::MyHandler; - my $status = WebGUI::URL::MyHandler::handler($r, $configFile); - -=head1 SUBROUTINES - -These subroutines are available from this package: - -=cut - -#------------------------------------------------------------------- - -=head2 handler ( request, server, config ) - -The Apache request handler for this package. - -=cut - -sub handler { - my ($request, $server, $config) = @_; - # ... - return Apache2::Const::OK; -} - -1; -#vim:ft=perl