Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Rewrote Nomo using Catalyst::Engine::HTTP::Prefork as a base code.

  • Loading branch information...
commit f8bdf60c43f4592c424ad94e5d74a3d0da6380e3 1 parent 3b41466
@miyagawa authored
View
14 Makefile.PL
@@ -3,11 +3,15 @@ name 'Nomo';
all_from 'lib/Nomo.pm';
readme_from 'lib/Nomo.pm';
build_requires 'Test::More';
-use_test_base;
-requires 'Plack', 0.9032;
-requires 'Parallel::Prefork';
-requires 'HTTP::Parser::XS';
-#requires 'AnyEvent';
+requires 'Plack', 0.99;
+requires 'Net::Server';
+requires 'Net::Server::SS::Prefork';
+requires 'Data::Dump';
+requires 'HTTP::HeaderParser::XS';
+requires 'HTTP::Status';
+requires 'HTTP::Date';
+requires 'URI::Escape';
+
recommends 'Server::Starter';
test_requires 'Test::Requires';
auto_include_deps;
View
64 README
@@ -1,68 +1,52 @@
NAME
- Nomo - High performance, starter-aware and preforking PSGI web server
+ Nomo - High-performance preforking PSGI web server
SYNOPSIS
- # preforking HTTP server
- % nomo --max-workers 20 app.psgi
+ # Run app.psgi with the default settings
+ > nomo
- # run with Server::Starter superdaemon
- % server_starter --port 127.0.0.1:80 -- nomo --max-workers 32 app.psgi
+ # run with Server::Starter
+ > start_server --port 127.0.0.1:80 -- nomo --max-servers 32 myapp.psgi
+
+ # UNIX domain sockets
+ > nomo --listen /tmp/nomo.sock
DESCRIPTION
Nomo is a PSGI perl web server that has unique features such as:
High Performance
- Uses XS/C extensions to parse HTTP headers for the best performance.
+ Uses the fast XS/C HTTP header parser
Preforking
Runs servers preforked like most high performance UNIX servers do.
- This means your applications are preloaded to be copy-on-write
- friendly.
-
- It also means your application can be blocking, and load-balancing
- is handled by kernels. No requests piled up behind busy workers.
Superdaemon aware
- Automatically detect superdaemon such as Server::Starter and
- ControlFreak to benefit from their features such as hot deploy,
- graceful restarts, dynamic worker pool configuration and sharing
- UNIX Domain sockets.
+ Supports Server::Starter for hot deploy and graceful restarts.
- UNIX only
- Optimized for UNIX for the best performance by avoiding weird Win32
- compatible code.
+ UNIX Domain Socket support
+ Forked children share the UNIX domain socket with the parent process
+ for the best performance when used with the nginx proxy in front.
PSGI compatible
- Can run any PSGI applications and frameworks.
-
- Daemon mode
- Can use "--daemonize" and "--pid" to become daemon just like normal
- UNIX tools, but can also be used with other supervisor tools such as
- daemontools or supervisord.
-
- Features that are planned but not implemented are:
-
- Reaping dead workers
- Log rotation via signals
- Listening to UNIX domain sockets
- Perl DSL configuration
- Per worker hooks
+ Can run any PSGI applications and frameworks
-NOMO?
- The name Nomo is taken from the baseball player <Hideo Nomo>, who is a
- great starter, famous for his forkball and whose nickname is Tornado.
+ HTTP/1.1 support
+ Supports chunked requests and responses, keep-alive and pipeline
+ requests.
-AUTHORS
- Tatsuhiko Miyagawa
+AUTHOR
+ Tatsuhiko Miyagawa <miyagawa@bulknews.net>
- Kazuho Oku
+ Andy Grundman wrote Catalyst::Engine::HTTP::Prefork, which this module
+ is heavily based on.
- Daisuke Maki
+ Kazuho Oku wrote Net::Server::SS::PreFork that makes easy to add
+ Server::Starter support to this software.
LICENSE
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
SEE ALSO
- Plack HTTP::Server::PSGI::Prefork
+ Plack Catalyst::Engine::HTTP::Prefork Net::Server::Prefork
View
18 bin/nomo
@@ -1,22 +1,28 @@
#!/usr/bin/perl
use strict;
use lib "lib";
-use Nomo::Runner;
+use Plack::Runner;
-Nomo::Runner->run("--server", "+Nomo::Loader", @ARGV);
+my $runner = Plack::Runner->new(server => 'Nomo', env => 'production');
+$runner->parse_options(@ARGV);
+$runner->run;
__END__
=head1 NAME
-nomo - Nomo frontend
+nomo - Nomo launcher
=head1 SYNOPSIS
- # TBD
+ nomo --port 8081
+ nomo --socket /tmp/nomo.sock
+ nomo --max-servers 32
-See plackup --help for more options.
+See `plackup -h` for more options.
-=cut
+=head1 SEE ALSO
+L<Nomo>
+=cut
View
66 bin/nomo-cfk
@@ -1,66 +0,0 @@
-#!/usr/bin/perl
-use strict;
-use warnings;
-
-use AnyEvent;
-use Plack::Util;
-use ControlFreak::Proxy::Process;
-use Nomo::Loader;
-
-$ENV{NOMO_USE_CONTROLFREAK} = 1;
-
-my $app_psgi = $ARGV[0] || "app.psgi";
-my $app = Plack::Util::load_psgi($app_psgi);
-
-my $cfd = $ENV{_CFK_COMMAND_FD} or die "no command fd";
-my $sfd = $ENV{_CFK_STATUS_FD} or die "no status fd";
-my $lfd = $ENV{_CFK_LOG_FD} or die "no log fd";
-
-open my $cfh, "<&=$cfd"
- or die "Cannot open Command filehandle, is descriptor correct?";
-
-open my $sfh, ">>&=$sfd"
- or die "Cannot open Status filehandle, is descriptor correct?";
-
-open my $lfh, ">>&=$lfd"
- or die "Cannot open Status filehandle, is descriptor correct?";
-
-trap_sigs();
-
-my $sockets = ControlFreak::Proxy::Process->sockets_from_env;
-
-my $proxy = ControlFreak::Proxy::Process->new(
- command_fh => $cfh,
- status_fh => $sfh,
- log_fh => $lfh,
- sockets => $sockets,
- svc_coderef => sub {
- Nomo::Loader->new->run($app),
- },
-);
-
-$proxy->{app} = $app;
-
-$proxy->log('out', "$0 proxy started");
-$proxy->run;
-
-sub trap_sigs {
- $SIG{HUP} = $SIG{INT} = $SIG{TERM} = sub {
- my $sig = shift;
- if ($proxy) {
- $proxy->log("err", "Got signal $sig");
- $proxy->shutdown;
- }
- exit 0;
- };
- $SIG{__WARN__} = sub {
- my $warn = shift || "";
- $proxy->log("err", "warn $warn") if $proxy;
- };
- $SIG{__DIE__} = sub {
- my $reason = shift || "";
- return if $^S;
- $proxy->log("err", "die $reason") if $proxy;
- exit -1;
- };
-}
View
25 eg/cfk.conf
@@ -1,25 +0,0 @@
-console full=yes
-console address=127.0.0.1:4000
-
-socket httpsock host=127.0.0.1
-socket httpsock service=5000
-
-proxy httpproxy cmd=nomo-cfk app.psgi
-proxy httpproxy service nomo1 cmd=nomo1
-proxy httpproxy service nomo1 tie_stdin_to=httpsock
-proxy httpproxy service nomo2 cmd=nomo2
-proxy httpproxy service nomo2 tie_stdin_to=httpsock
-proxy httpproxy service nomo3 cmd=nomo3
-proxy httpproxy service nomo3 tie_stdin_to=httpsock
-proxy httpproxy service nomo4 cmd=nomo4
-proxy httpproxy service nomo4 tie_stdin_to=httpsock
-proxy httpproxy service nomo5 cmd=nomo5
-proxy httpproxy service nomo5 tie_stdin_to=httpsock
-
-command bind httpsock
-command pup httpproxy
-command up service nomo1
-command up service nomo2
-command up service nomo3
-command up service nomo4
-command up service nomo5
View
75 lib/Nomo.pm
@@ -13,15 +13,18 @@ __END__
=head1 NAME
-Nomo - High performance, starter-aware and preforking PSGI web server
+Nomo - High-performance preforking PSGI web server
=head1 SYNOPSIS
- # preforking HTTP server
- % nomo --max-workers 20 app.psgi
+ # Run app.psgi with the default settings
+ > nomo
- # run with Server::Starter superdaemon
- % server_starter --port 127.0.0.1:80 -- nomo --max-workers 32 app.psgi
+ # run with Server::Starter
+ > start_server --port 127.0.0.1:80 -- nomo --max-servers 32 myapp.psgi
+
+ # UNIX domain sockets
+ > nomo --listen /tmp/nomo.sock
=head1 DESCRIPTION
@@ -31,70 +34,40 @@ Nomo is a PSGI perl web server that has unique features such as:
=item High Performance
-Uses XS/C extensions to parse HTTP headers for the best performance.
+Uses the fast XS/C HTTP header parser
=item Preforking
-Runs servers preforked like most high performance UNIX servers
-do. This means your applications are preloaded to be copy-on-write
-friendly.
-
-It also means your application can be blocking, and load-balancing is
-handled by kernels. No requests piled up behind busy workers.
+Runs servers preforked like most high performance UNIX servers do.
=item Superdaemon aware
-Automatically detect superdaemon such as Server::Starter and
-ControlFreak to benefit from their features such as hot deploy,
-graceful restarts, dynamic worker pool configuration and sharing UNIX
-Domain sockets.
+Supports L<Server::Starter> for hot deploy and graceful restarts.
-=item UNIX only
+=item UNIX Domain Socket support
-Optimized for UNIX for the best performance by avoiding weird Win32
-compatible code.
+Forked children share the UNIX domain socket with the parent process
+for the best performance when used with the nginx proxy in front.
=item PSGI compatible
-Can run any PSGI applications and frameworks.
-
-=item Daemon mode
-
-Can use C<--daemonize> and C<--pid> to become daemon just like normal
-UNIX tools, but can also be used with other supervisor tools such as
-daemontools or supervisord.
-
-=back
-
-Features that are planned but not implemented are:
+Can run any PSGI applications and frameworks
-=over 4
-
-=item Reaping dead workers
-
-=item Log rotation via signals
-
-=item Listening to UNIX domain sockets
+=item HTTP/1.1 support
-=item Perl DSL configuration
-
-=item Per worker hooks
+Supports chunked requests and responses, keep-alive and pipeline requests.
=back
-=head1 NOMO?
-
-The name Nomo is taken from the baseball player
-L<Hideo Nomo|http://en.wikipedia.org/wiki/Hideo_Nomo>, who is a great
-starter, famous for his forkball and whose nickname is Tornado.
-
-=head1 AUTHORS
+=head1 AUTHOR
-Tatsuhiko Miyagawa
+Tatsuhiko Miyagawa E<lt>miyagawa@bulknews.netE<gt>
-Kazuho Oku
+Andy Grundman wrote L<Catalyst::Engine::HTTP::Prefork>, which this module
+is heavily based on.
-Daisuke Maki
+Kazuho Oku wrote L<Net::Server::SS::PreFork> that makes it easy to add
+L<Server::Starter> support to this software.
=head1 LICENSE
@@ -103,6 +76,6 @@ it under the same terms as Perl itself.
=head1 SEE ALSO
-L<Plack> L<HTTP::Server::PSGI::Prefork>
+L<Plack> L<Catalyst::Engine::HTTP::Prefork> L<Net::Server::Prefork>
=cut
View
12 lib/Nomo/Engine/HTTPServer.pm
@@ -1,12 +0,0 @@
-package Nomo::Engine::HTTPServer;
-use strict;
-use Plack::Util;
-use HTTP::Parser::XS;
-use HTTP::Server::PSGI;
-
-sub new {
- my($class, %opts) = @_;
- HTTP::Server::PSGI->new(%opts);
-}
-
-1;
View
17 lib/Nomo/Engine/HTTPServer/ControlFreak.pm
@@ -1,17 +0,0 @@
-package Nomo::Engine::HTTPServer::ControlFreak;
-use strict;
-
-sub wrap {
- my($class, $cb, $options) = @_;
-
- my $server = $cb->($options);
-
- open my $socket, "<&=0"
- or die "Cannot open stdin: $!";
- bless $socket, "IO::Socket::INET";
- $server->{listen_sock} = $socket;
-
- $server;
-}
-
-1;
View
34 lib/Nomo/Engine/HTTPServer/ServerStarter.pm
@@ -1,34 +0,0 @@
-package Nomo::Engine::HTTPServer::ServerStarter;
-use strict;
-use Server::Starter;
-
-sub wrap {
- my($class, $cb, $opts) = @_;
-
- my ($hostport, $fd) = %{Server::Starter::server_ports()};
- if ($hostport =~ /(.*):(\d+)/) {
- $opts->{host} = $1;
- $opts->{port} = $2;
- } else {
- $opts->{port} = $hostport;
- }
-
- $opts->{server_ready} = sub {
- my $server = shift;
- print STDERR "$server->{server_software}: Accepting connections at ",
- "http://$server->{host}:$server->{port}/ (via Server::Starter socket $fd)\n";
- } if $opts->{server_ready};
-
- my $server = $cb->($opts);
-
- $server->{listen_sock} = IO::Socket::INET->new(
- Proto => 'tcp',
- ) or die "failed to create socket:$!";
-
- $server->{listen_sock}->fdopen($fd, 'w')
- or die "failed to bind to listening socket:$!";
-
- $server;
-}
-
-1;
View
45 lib/Nomo/Loader.pm
@@ -1,45 +0,0 @@
-package Nomo::Loader;
-use strict;
-use Plack::Util;
-
-sub build(&$;$) {
- my($builder, $cb, $opts) = @_;
- sub { $builder->($cb, $opts) };
-}
-
-sub new {
- my($class, %opts) = @_;
-
- my $engine = $opts{engine} || "HTTPServer"; # TODO support AnyEvent
- my $workers = $opts{max_workers} || 32;
-
- my $server_class = Plack::Util::load_class($engine, "Nomo::Engine");
- my $builder = sub { $server_class->new(%{$_[0]}) };
-
- my @wrappers;
- if ($ENV{NOMO_USE_CONTROLFREAK}) {
- $workers = 1;
- push @wrappers, "ControlFreak";
- } else {
- push @wrappers, "ServerStarter" if $ENV{SERVER_STARTER_PORT};
- }
-
- for my $wrapper (@wrappers) {
- my $wrapper_class = Plack::Util::load_class($wrapper, "Nomo::Engine::$engine");
- $builder = build { $wrapper_class->wrap(@_) } $builder, \%opts;
- }
-
- $opts{max_workers} = $workers;
- $opts{server_software} = "Nomo";
-
- my $server = $builder->(\%opts);
- bless { server => $server }, $class;
-}
-
-sub run {
- my($self, $app) = @_;
-
- $self->{server}->run($app);
-}
-
-1;
View
65 lib/Nomo/Runner.pm
@@ -1,65 +0,0 @@
-package Nomo::Runner;
-use strict;
-use Plack::Runner;
-use Getopt::Long;
-
-my $pidfile;
-
-sub run {
- my $class = shift;
-
- local @ARGV = @_;
-
- my $pid;
- my $daemonize;
-
- Getopt::Long::Configure("no_ignore_case", "pass_through");
- GetOptions(
- "pid=s", \$pid,
- "D|daemonize", \$daemonize,
- );
-
- daemonize() if $daemonize;
- write_pid($pid) if $pid;
-
- Plack::Runner->run(@ARGV);
-}
-
-sub _fork_or_die {
- my $pid = fork;
- die "Unable to fork" unless defined $pid;
- exit 0 if $pid;
-}
-
-sub daemonize {
- require POSIX;
-
- _fork_or_die;
- POSIX::setsid() or die "Can't detach: $!";
-
- # Fork again to ensure that daemon never reacquires a control terminal
- _fork_or_die;
-
- open STDIN, "</dev/null";
- open STDOUT, ">/dev/null";
- open STDERR, ">&STDOUT";
-
-# chdir "/";
- umask 0;
-}
-
-sub write_pid {
- my $file = shift;
-
- open my $fh, ">", $file or die "$file: $!";
- print $fh $$, "\n";
-
- $pidfile = $file;
- $SIG{INT} = $SIG{TERM} = sub { unlink $file; exit 0 };
-}
-
-END {
- unlink $pidfile if $pidfile;
-}
-
-1;
View
395 lib/Nomo/Server.pm
@@ -0,0 +1,395 @@
+package Nomo::Server;
+use strict;
+use base 'Net::Server::PreFork';
+
+use Data::Dump qw(dump);
+use Socket;
+use IO::Socket qw(:crlf);
+use HTTP::HeaderParser::XS;
+use HTTP::Status qw(status_message);
+use HTTP::Date qw(time2str);
+use URI::Escape;
+
+use Plack::Util;
+use Plack::Middleware::Dechunk;
+
+use constant DEBUG => $ENV{NOMO_DEBUG} || 0;
+use constant CHUNKSIZE => 64 * 1024;
+use constant READ_TIMEOUT => 5;
+
+sub run {
+ my($self, $app, $options) = @_;
+
+ $self->{app} = Plack::Middleware::Dechunk->wrap($app);
+ $self->{options} = $options;
+
+ my %extra = ();
+ if ( $options->{pid_file} ) {
+ $extra{pid_file} = $options->{pid_file};
+ }
+ if ( $options->{background} ) {
+ $extra{setsid} = $extra{background} = 1;
+ }
+
+ $self->SUPER::run(
+ port => $options->{port} || 5000,
+ host => $options->{host} || '*',
+ serialize => 'flock',
+ log_level => DEBUG ? 4 : 1,
+ min_servers => $options->{min_servers} || 5,
+ min_spare_servers => $options->{min_spare_servers} || 2,
+ max_spare_servers => $options->{max_spare_servers} || 10,
+ max_servers => $options->{max_servers} || 50,
+ max_requests => $options->{max_requests} || 1000,
+ leave_children_open_on_hup => $options->{restart_graceful} || 0,
+
+ %extra
+ );
+}
+
+sub pre_loop_hook {
+ my $self = shift;
+
+ my $host = $self->{server}->{host}->[0];
+ my $port = $self->{server}->{port}->[0];
+
+ $self->{options}{server_ready}->({
+ host => $host,
+ port => $port,
+ proto => 'http',
+ server_software => 'Nomo',
+ }) if $self->{options}{server_ready};
+}
+
+# The below methods run in the child process
+
+sub post_accept_hook {
+ my $self = shift;
+
+ $self->{client} = {
+ headerbuf => '',
+ inputbuf => '',
+ keepalive => 1,
+ };
+}
+
+sub process_request {
+ my $self = shift;
+ my $conn = $self->{server}->{client};
+
+ while ( $self->{client}->{keepalive} ) {
+ last if !$conn->connected;
+
+ # Read until we see all headers
+ last if !$self->_read_headers;
+
+ # Parse headers
+ my $h = HTTP::HeaderParser::XS->new( \delete $self->{client}->{headerbuf} );
+
+ if ( !$h ) {
+ # Bad request
+ DEBUG && warn "[$$] Bad request\n";
+ $self->_http_error(400, { SERVER_PROTOCOL => "HTTP/1.0" });
+ last;
+ }
+
+ # Initialize PSGI environment
+ my $uri = $h->request_uri();
+ my ( $path, $query_string ) = split /\?/, $uri, 2;
+
+ my $version = $h->version_number();
+ my $proto = sprintf( "HTTP/%d.%d", int( $version / 1000 ), $version % 1000 );
+ my $headers = $h->getHeaders();
+
+ my $env = {
+ REMOTE_ADDR => $self->{server}->{peeraddr},
+ REMOTE_HOST => $self->{server}->{peerhost} || $self->{server}->{peeraddr},
+ SERVER_NAME => $self->{server}->{sockaddr}, # XXX: needs to be resolved?
+ SERVER_PORT => $self->{server}->{port}->[0],
+ SCRIPT_NAME => '',
+ REQUEST_METHOD => $h->request_method() || '',
+ PATH_INFO => URI::Escape::uri_unescape($path),
+ REQUEST_URI => $uri,
+ QUERY_STRING => $query_string || '',
+ SERVER_PROTOCOL => $proto,
+ CONTENT_TYPE => $headers->{'Content-Type'},
+ CONTENT_LENGTH => $headers->{'Content-Length'},
+ 'psgi.version' => [ 1, 1 ],
+ 'psgi.errors' => *STDERR,
+ 'psgi.url_scheme' => 'http',
+ 'psgi.nonblocking' => Plack::Util::FALSE,
+ 'psgi.streaming' => Plack::Util::TRUE,
+ 'psgi.run_once' => Plack::Util::FALSE,
+ 'psgi.multithread' => Plack::Util::FALSE,
+ 'psgi.multiprocess' => Plack::Util::TRUE,
+ };
+
+ # Add headers
+ while (my($key, $value) = each %$headers) {
+ next if $key eq 'Content-Length' or $key eq 'Content-Type';
+ $key =~ tr/-/_/;
+ $env->{"HTTP_" . uc($key)} = $value;
+ }
+
+ # Determine whether we will keep the connection open after the request
+ my $connection = $headers->{Connection};
+ if ( $proto && $proto eq 'HTTP/1.0' ) {
+ if ( $connection && $connection =~ /^keep-alive$/i ) {
+ # Keep-alive only with explicit header in HTTP/1.0
+ $self->{client}->{keepalive} = 1;
+ }
+ else {
+ $self->{client}->{keepalive} = 0;
+ }
+ }
+ elsif ( $proto && $proto eq 'HTTP/1.1' ) {
+ if ( $connection && $connection =~ /^close$/i ) {
+ $self->{client}->{keepalive} = 0;
+ }
+ else {
+ # Keep-alive assumed in HTTP/1.1
+ $self->{client}->{keepalive} = 1;
+ }
+
+ # Do we need to send 100 Continue?
+ if ( $headers->{Expect} ) {
+ if ( $headers->{Expect} eq '100-continue' ) {
+ syswrite STDOUT, 'HTTP/1.1 100 Continue' . $CRLF . $CRLF;
+ DEBUG && warn "[$$] Sent 100 Continue response\n";
+ }
+ else {
+ DEBUG && warn "[$$] Invalid Expect header, returning 417\n";
+ $self->_http_error( 417, $env );
+ last;
+ }
+ }
+
+ unless ($headers->{Host}) {
+ # No host, bad request
+ DEBUG && warn "[$$] Bad request, HTTP/1.1 without Host header\n";
+ $self->_http_error( 400, $env );
+ last;
+ }
+ }
+
+ $self->_prepare_env($env, $headers);
+
+ # Run PSGI apps
+ my $res = Plack::Util::run_app($self->{app}, $env);
+
+ if (ref $res eq 'CODE') {
+ $res->(sub { $self->_finalize_response($env, $_[0]) });
+ } else {
+ $self->_finalize_response($env, $res);
+ }
+
+ DEBUG && warn "[$$] Request done\n";
+
+ if ( $self->{client}->{keepalive} ) {
+ # If we still have data in the input buffer it may be a pipelined request
+ if ( $self->{client}->{inputbuf} ) {
+ if ( $self->{client}->{inputbuf} =~ /^(?:GET|HEAD)/ ) {
+ if ( DEBUG ) {
+ warn "Pipelined GET/HEAD request in input buffer: "
+ . dump( $self->{client}->{inputbuf} ) . "\n";
+ }
+
+ # Continue processing the input buffer
+ next;
+ }
+ else {
+ # Input buffer just has junk, clear it
+ if ( DEBUG ) {
+ warn "Clearing junk from input buffer: "
+ . dump( $self->{client}->{inputbuf} ) . "\n";
+ }
+
+ $self->{client}->{inputbuf} = '';
+ }
+ }
+
+ DEBUG && warn "[$$] Waiting on previous connection for keep-alive request...\n";
+
+ my $sel = IO::Select->new($conn);
+ last unless $sel->can_read(1);
+ }
+ }
+
+ DEBUG && warn "[$$] Closing connection\n";
+}
+
+sub _read_headers {
+ my $self = shift;
+
+ eval {
+ local $SIG{ALRM} = sub { die "Timed out\n"; };
+
+ alarm( READ_TIMEOUT );
+
+ while (1) {
+ # Do we have a full header in the buffer?
+ # This is before sysread so we don't read if we have a pipelined request
+ # waiting in the buffer
+ last if $self->{client}->{inputbuf} =~ /$CRLF$CRLF/s;
+
+ # If not, read some data
+ my $read = sysread STDIN, my $buf, CHUNKSIZE;
+
+ if ( !defined $read || $read == 0 ) {
+ die "Read error: $!\n";
+ }
+
+ if ( DEBUG ) {
+ warn "[$$] Read $read bytes: " . dump($buf) . "\n";
+ }
+
+ $self->{client}->{inputbuf} .= $buf;
+ }
+ };
+
+ alarm(0);
+
+ if ( $@ ) {
+ if ( $@ =~ /Timed out/ ) {
+ DEBUG && warn "[$$] Client connection timed out\n";
+ return;
+ }
+
+ if ( $@ =~ /Read error/ ) {
+ DEBUG && warn "[$$] Read error: $!\n";
+ return;
+ }
+ }
+
+ # Pull out the complete header into a new buffer
+ $self->{client}->{headerbuf} = $self->{client}->{inputbuf};
+
+ # Save any left-over data, possibly body data or pipelined requests
+ $self->{client}->{inputbuf} =~ s/.*?$CRLF$CRLF//s;
+
+ return 1;
+}
+
+sub _http_error {
+ my ( $self, $code, $env ) = @_;
+
+ my $status = $code || 500;
+ my $msg = status_message($status);
+
+ my $res = [
+ $status,
+ [ 'Content-Type' => 'text/plain', 'Content-Length' => length($msg) ],
+ [ $msg ],
+ ];
+
+ $self->{client}->{keepalive} = 0;
+ $self->_finalize_response($env, $res);
+}
+
+sub _prepare_env {
+ my($self, $env) = @_;
+
+ $env->{'psgi.input'} = Plack::Util::inline_object
+ read => sub {
+ my(undef, $length, $offset) = @_;
+ $length = $length > CHUNKSIZE ? CHUNKSIZE : $length;
+
+ # If we have any remaining data in the input buffer, send it back first
+ my $read;
+ if ( my $buflen = length $self->{client}->{inputbuf} ) {
+ $read = $length < $buflen ? $length : $buflen;
+ $_[0] = substr $self->{client}->{inputbuf}, 0, $read;
+ $self->{client}->{inputbuf} = substr $self->{client}->{inputbuf}, $read;
+ $length -= $read;
+ $offset += $read;
+ }
+
+ if ($length > 0) {
+ $read += sysread STDIN, $_[0], $length, $offset;
+ }
+
+ return $read;
+ },
+ close => sub { };
+}
+
+sub _finalize_response {
+ my($self, $env, $res) = @_;
+
+ my $protocol = $env->{SERVER_PROTOCOL};
+ my $status = $res->[0];
+ my $message = status_message($status);
+
+ my(@headers, %headers);
+ push @headers, "$protocol $status $message";
+
+ # Switch on Transfer-Encoding: chunked if we don't know Content-Length.
+ my $chunked;
+ while (my($k, $v) = splice @{$res->[1]}, 0, 2) {
+ next if $k eq 'Connection';
+ push @headers, "$k: $v";
+ $headers{lc $k} = $v;
+ }
+
+ if ( $protocol eq 'HTTP/1.1' ) {
+ if ( !$headers{'content-length'} ) {
+ if ( $status !~ /^1\d\d|[23]04$/ ) {
+ DEBUG && warn "[$$] Using chunked transfer-encoding to send unknown length body\n";
+ push @headers, 'Transfer-Encoding: chunked';
+ $chunked = 1;
+ }
+ }
+ elsif ( my $te = $headers{'transfer-encoding'} ) {
+ if ( $te eq 'chunked' ) {
+ DEBUG && warn "[$$] Chunked transfer-encoding set for response\n";
+ $chunked = 1;
+ }
+ }
+ }
+
+ if ( ! $headers{Date} ) {
+ time2str(time);
+ push @headers, "Date: " . time2str( time() );
+ }
+
+ # Should we keep the connection open?
+ if ( $self->{client}->{keepalive} ) {
+ push @headers, 'Connection: keep-alive';
+ } else {
+ push @headers, 'Connection: close';
+ }
+
+ # Buffer the headers so they are sent with the first write() call
+ # This reduces the number of TCP packets we are sending
+ syswrite STDOUT, join( $CRLF, @headers, '' ) . $CRLF;
+
+ if (defined $res->[2]) {
+ Plack::Util::foreach($res->[2], sub {
+ my $buffer = $_[0];
+ if ($chunked) {
+ my $len = length $buffer;
+ $buffer = sprintf( "%x", $len ) . $CRLF . $buffer . $CRLF;
+ }
+ syswrite STDOUT, $buffer;
+ DEBUG && warn "[$$] Wrote " . length($buffer) . " bytes\n";
+ });
+
+ syswrite STDOUT, "0$CRLF$CRLF" if $chunked;
+ } else {
+ return Plack::Util::inline_object
+ write => sub {
+ my $buffer = $_[0];
+ if ($chunked) {
+ my $len = length $buffer;
+ $buffer = sprintf( "%x", $len ) . $CRLF . $buffer . $CRLF;
+ }
+ syswrite STDOUT, $buffer;
+ DEBUG && warn "[$$] Wrote " . length($buffer) . " bytes\n";
+ },
+ close => sub {
+ syswrite STDOUT, "0$CRLF$CRLF" if $chunked;
+ };
+ }
+}
+
+1;
View
43 lib/Plack/Handler/Nomo.pm
@@ -0,0 +1,43 @@
+package Plack::Handler::Nomo;
+use strict;
+use Nomo::Server;
+
+sub new {
+ my $class = shift;
+ bless { @_ }, $class;
+}
+
+sub run {
+ my($self, $app) = @_;
+
+ if ($ENV{SERVER_STARTER_PORT}) {
+ require Net::Server::SS::PreFork;
+ @Nomo::Server::ISA = qw(Net::Server::SS::PreFork); # Yikes.
+ }
+
+ Nomo::Server->new->run($app, {%$self});
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Plack::Handler::Nomo - Plack adapter for Nomo
+
+=head1 SYNOPSIS
+
+ plackup -s Nomo
+
+=head1 AUTHOR
+
+Tatsuhiko Miyagawa
+
+=head1 SEE ALSO
+
+L<Nomo>
+
+=cut
+
+
View
8 t/suite.t
@@ -0,0 +1,8 @@
+use strict;
+use warnings;
+use Test::More;
+use Plack::Test::Suite;
+
+Plack::Test::Suite->run_server_tests('Nomo');
+done_testing();
+
Please sign in to comment.
Something went wrong with that request. Please try again.