Permalink
Browse files

Added Perlbal::Plugin::PSGI and tests that pass all.

  • Loading branch information...
1 parent 9cec53b commit d9f918302d7916804acebd6840914b004053f804 @miyagawa committed Sep 17, 2009
Showing with 143 additions and 0 deletions.
  1. +143 −0 lib/Perlbal/Plugin/PSGI.pm
@@ -0,0 +1,143 @@
+package Perlbal::Plugin::PSGI;
+use strict;
+use Perlbal;
+use Plack::Util;
+use Plack::HTTPParser qw(parse_http_request);
+use HTTP::Status;
+
+sub register {
+ my ($class, $svc) = @_;
+ $svc->register_hook('PSGI', 'start_http_request', sub { Perlbal::Plugin::PSGI::handle_request($svc, $_[0]); });
+}
+
+sub handle_request {
+ my $svc = shift;
+ my $pb = shift;
+
+ my $app = $svc->{extra_config}->{_psgi_app};
+ unless (defined $app) {
+ return $pb->send_response(500, "No PSGI app is configured for this service");
+ }
+
+ my $hdr = $pb->{req_headers} or return 0;
+
+ my $env = {
+ 'psgi.version' => [ 1, 0 ],
+ 'psgi.errors' => Plack::Util::inline_object(print => sub { Perlbal::log('error', @_) }),
+ 'psgi.url_scheme' => 'http',
+ 'psgi.async' => 1,
+ 'psgi.run_once' => Plack::Util::FALSE,
+ 'psgi.multithread' => Plack::Util::FALSE,
+ 'psgi.multiprocess' => Plack::Util::FALSE,
+ 'psgi.async' => Plack::Util::TRUE,
+ REMOTE_ADDR => $pb->{peer_ip},
+ SERVER_NAME => (split /:/, $svc->{listen})[0],
+ SERVER_PORT => (split /:/, $svc->{listen})[1],
+ };
+
+ parse_http_request($pb->{headers_string}, $env);
+
+ if ($env->{REQUEST_METHOD} eq 'POST') {
+ my $buf_ref = $pb->read($env->{CONTENT_LENGTH}) || \"";
+ open my $input, "<", $buf_ref;
+ $env->{'psgi.input'} = $input;
+ }
+
+ my $start_response = sub {
+ my $res = shift;
+
+ $pb->write("HTTP/1.0 $res->[0] @{[ HTTP::Status::status_message($res->[0]) ]}\015\012");
+ while (my($k, $v) = splice @{$res->[1]}, 0, 2) {
+ $pb->write("$k: $v\015\012");
+ }
+ $pb->write("\015\012");
+
+ return unless defined wantarray;
+
+ Plack::Util::inline_object(
+ write => sub { $pb->write(@_) },
+ close => sub { $pb->write(sub { $pb->http_response_sent }) },
+ );
+ };
+
+ my $res = $app->($env, $start_response);
+ return 1 if @$res == 0;
+
+ $start_response->($res);
+
+ if (Plack::Util::is_real_fh($res->[2])) {
+ $pb->reproxy_fh($res->[2], -s $res->[2]);
+ } else {
+ Plack::Util::foreach($res->[2], sub { $pb->write(@_) });
+ $pb->write(sub { $pb->http_response_sent });
+ }
+}
+
+sub handle_psgi_app_command {
+ my $mc = shift->parse(qr/^psgi_app\s*=\s*(\S+)$/, "usage: PSGI_APP=<path>");
+ my ($app_path) = $mc->args;
+
+ my $handler = do $app_path;
+ unless (defined $handler && ref $handler eq 'CODE') {
+ return $mc->err("Failed to load $app_path: " . ($! || $@))
+ }
+
+ my $svcname;
+ unless ($svcname ||= $mc->{ctx}{last_created}) {
+ return $mc->err("No service name in context from CREATE SERVICE <name> or USE <service_name>");
+ }
+
+ my $svc = Perlbal->service($svcname);
+ return $mc->err("Non-existent service '$svcname'") unless $svc;
+
+ my $cfg = $svc->{extra_config}->{_psgi_app} = $handler;
+
+ return 1;
+}
+
+sub unregister {
+ my ($class, $svc) = @_;
+ $svc->unregister_hooks('PSGI');
+ return 1;
+}
+
+sub load {
+ Perlbal::register_global_hook('manage_command.psgi_app', \&Perlbal::Plugin::PSGI::handle_psgi_app_command);
+ return 1;
+}
+
+sub unload {
+ return 1;
+}
+
+1;
+
+=head1 NAME
+
+Perlbal::Plugin::PSGI - PSGI web server on Perlbal
+
+=head1 SYNOPSIS
+
+ LOAD PSGI
+ CREATE SERVICE psgi
+ SET role = web_server
+ SET listen = 127.0.0.1:80
+ SET plugins = psgi
+ PSGI_APP = /path/to/app.psgi
+ ENABLE psgi
+
+=head1 DESCRIPTION
+
+This is a Perlbal plugin to asllow any PSGI application run natively
+inside Perlbal process. This PSGI server enables C<psgi.async> mode on
+so that you can use the second parameter C<$start_response> to do
+server push, or does callback style programming when doing I/O wait
+etc.
+
+=head1 AUTHOR
+
+Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>
+
+Based on Perlbal::Plugin::Cgilike written by Martin Atkins.
+
+=cut

0 comments on commit d9f9183

Please sign in to comment.