pax_global_header00006660000000000000000000000064120510627260014513gustar00rootroot0000000000000052 comment=1b4a03b6c13e9c71282e835aa0a053ecee5bc1be starman-0.3005/000075500000000000000000000000001205106272600132455ustar00rootroot00000000000000starman-0.3005/.gitignore000064400000000000000000000000561205106272600152360ustar00rootroot00000000000000META.yml Makefile inc/ pm_to_blib *~ MYMETA.* starman-0.3005/.shipit000064400000000000000000000001651205106272600145500ustar00rootroot00000000000000steps = FindVersion, ChangeVersion, CheckChangeLog, DistTest, Commit, Tag, MakeDist, UploadCPAN git.push_to = origin starman-0.3005/Changes000064400000000000000000000104331205106272600145410ustar00rootroot00000000000000Revision history for Perl extension Starman 0.3005 Wed Nov 14 19:46:31 PST 2012 - Added a warning in runtime/documentation to NOT use -r/-R with Starman 0.3004 Thu Nov 8 19:40:45 PST 2012 - Added --interval option to the sample start_server command - Makefile.PL fix 0.3003 Thu Sep 27 09:39:56 JST 2012 - Fixed the test hang in some environments, introduced in 0.3002 [RT:79865] 0.3002 Tue Sep 25 15:26:43 JST 2012 - Added a documentation for --signal-on-term for Server::Starter 0.12 (kazuho, ether) - Set REMOTE_PORT PSGI environment variable #50 (dex4er) - Fix a test failure with a directory containing whitespace (clkao) 0.3001 Mon Jun 25 10:57:20 PDT 2012 - Fix SERVER_NAME and SERVER_PORT not exist on UNIX socket mode #24 - Improved documentation - Ensure that chunk buffer contains terminating HTTP newline (Peter Makholm) 0.3000 Mon Feb 20 16:31:44 PST 2012 - This be a 0.3 release 0.29_90 Thu Dec 1 19:40:52 PST 2011 - Changed the way server handles HUP and QUIT signals HUP will just restart all the workers gracefully QUIT will gracefully shutdown workers and the master See `man 1 starman` and look for SIGNALS section. 0.2014 Sun Sep 18 12:43:06 PDT 2011 - Fixed broken PSGI response headers after the output (cho45) 0.2013 Sat Jun 25 11:51:47 PDT 2011 - Relaxed the harakiri tests (audreyt) 0.2012 Wed Jun 22 13:51:59 PDT 2011 - Implemented psgix.harakiri mode (audreyt) - Added --error-log option (Paulo E. Castro) 0.2011 Tue May 24 09:41:52 PDT 2011 - Fix chunked response with 0-length PSGI array elements (chmrr) 0.2010 Mon Mar 28 16:23:23 PDT 2011 - Fixed packaging. No changes. 0.2009 Fri Mar 25 19:15:23 PDT 2011 - Requires Plack 0.9971 to support localizing $0 to fix the FindBin issues #7, #15, #18, #19 - Calls srand() automatically in the child init hook to avoid a fixed random seed #20 - Implemented --keepalive-timeout which defaults to 1 (acme) 0.2008 Mon Feb 14 17:19:20 PST 2011 - Documented that -E is automatically set to 'deployment' RT:61517 (timbunce) - Check the defined-ness of the input buffer to suppress warnings RT:60007 0.2007 Thu Sep 30 14:09:00 PDT 2010 - Fixed a bug where Date header can be duplicate if the app generates one (spleenjack) 0.2006 Fri Jul 2 17:21:22 PDT 2010 - Fixed a bug in chunked response when Content-Length is 0. #8 (chiba) - Documented --pid and --daemonize 0.2005 Fri Jul 2 17:02:16 PDT 2010 - Don't use lib 'lib' - Documentation updates (miyagawa, grantm) 0.2004 Tue Apr 20 21:22:31 JST 2010 - Delay set $0 in master so FindBin works. #7 0.2003 Mon Apr 19 15:19:06 JST 2010 - Upped Plack dependency 0.2002 Sat Apr 17 18:44:24 PDT 2010 - Switch kyoto.jpg to use baybridge.jpg for testing 0.2001 Tue Apr 13 21:45:15 PDT 2010 - Fixed the way to set the default Delayed loader 0.2000 Tue Apr 13 20:22:24 PDT 2010 - INCOMPATIBLE: starman executable by default loads the application with Delayed to be safer. Use --preload-app command line option to preload the application in the master process. See `starman --help` for details. 0.1007 Tue Apr 13 19:45:59 PDT 2010 - Fixed a bug where Content-Length less response are sent in Keep-Alive without chunked, choking HTTP/1.0 clients (patspam) #6 0.1006 Tue Apr 13 00:01:23 CEST 2010 - Fixed 100% CPU loop when an unexpected EOF happens (Graham Barr) 0.1005 Sun Mar 28 14:37:03 PDT 2010 - Implemented starman -v 0.1004 Sat Mar 27 19:10:06 PDT 2010 - Implemented --disable-keepalive for broken frontend proxy such as mod_proxy + mpm_prefork - Documented --backlog 0.1003 Sun Mar 21 21:08:39 PDT 2010 - Fixed SERVER_PORT when used with Server::Starter (Reported by ronsavage) 0.1002 Wed Mar 10 12:10:46 JST 2010 - Officially do not support Win32 0.1001 Sat Feb 27 05:03:18 PST 2010 - Fix documentations - Set 'deployment' PLACK_ENV by default - Do not reopen stdio for possibly faster operations - require Net::Server 0.91 for new() (sekimura) 0.1000 Mon Feb 15 17:56:33 PST 2010 - original version starman-0.3005/MANIFEST000064400000000000000000000013661205106272600144040ustar00rootroot00000000000000.gitignore bin/starman Changes inc/Module/Install.pm inc/Module/Install/AuthorTests.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/Fetch.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/ReadmeFromPod.pm inc/Module/Install/Repository.pm inc/Module/Install/Scripts.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm lib/HTTP/Server/PSGI/Net/Server/PreFork.pm lib/Plack/Handler/Starman.pm lib/Starman.pm lib/Starman/Server.pm Makefile.PL MANIFEST This list of files META.yml README t/00_compile.t t/chunked_req.t t/chunked_termination.t t/chunked_zero_length.t t/findbin.psgi t/findbin.t t/harakiri.t t/rand.psgi t/rand.t t/suite.t xt/perlcritic.t xt/pod.t xt/podspell.t xt/synopsis.t starman-0.3005/MANIFEST.SKIP000064400000000000000000000002021205106272600151350ustar00rootroot00000000000000\bRCS\b \bCVS\b \.svn/ \.git/ ^MANIFEST\. ^Makefile$ ~$ \.old$ ^blib/ ^pm_to_blib ^MakeMaker-\d \.gz$ \.cvsignore \.shipit MYMETA starman-0.3005/Makefile.PL000064400000000000000000000011261205106272600152170ustar00rootroot00000000000000if ($^O eq 'MSWin32') { print STDERR "OS unsupported: $^O\n"; exit; } use inc::Module::Install; name 'Starman'; all_from 'lib/Starman.pm'; readme_from 'lib/Starman.pm'; build_requires 'Test::More'; requires 'Plack', 0.9971; requires 'Net::Server', 0.91; requires 'Data::Dump'; requires 'HTTP::Parser::XS'; requires 'HTTP::Status'; requires 'HTTP::Date'; requires 'parent'; requires 'Test::TCP', 1.11; install_script 'bin/starman'; recommends 'Server::Starter', 0.12; recommends 'Net::Server::SS::PreFork'; test_requires 'Test::Requires'; author_tests('xt'); auto_set_repository; WriteAll; starman-0.3005/README000064400000000000000000000075771205106272600141450ustar00rootroot00000000000000NAME Starman - High-performance preforking PSGI/Plack web server SYNOPSIS # Run app.psgi with the default settings > starman # run with Server::Starter > start_server --port 127.0.0.1:80 -- starman --workers 32 myapp.psgi # UNIX domain sockets > starman --listen /tmp/starman.sock DESCRIPTION Starman is a PSGI perl web server that has unique features such as: High Performance Uses the fast XS/C HTTP header parser Preforking Spawns workers preforked like most high performance UNIX servers do. Starman also reaps dead children and automatically restarts the worker pool. Signals Supports "HUP" for graceful worker restarts, and "TTIN"/"TTOU" to dynamically increase or decrease the number of worker processes, as well as "QUIT" to gracefully shutdown the worker processes. Superdaemon aware Supports Server::Starter for hot deploy and graceful restarts. Multiple interfaces and UNIX Domain Socket support Able to listen on multiple intefaces including UNIX sockets. Small memory footprint Preloading the applications with "--preload-app" command line option enables copy-on-write friendly memory management. Also, the minimum memory usage Starman requires for the master process is 7MB and children (workers) is less than 3.0MB. PSGI compatible Can run any PSGI applications and frameworks HTTP/1.1 support Supports chunked requests and responses, keep-alive and pipeline requests. UNIX only This server does not support Win32. PERFORMANCE Here's a simple benchmark using "Hello.psgi". -- server: Starman (workers=10) Requests per second: 6849.16 [#/sec] (mean) -- server: Twiggy Requests per second: 3911.78 [#/sec] (mean) -- server: AnyEvent::HTTPD Requests per second: 2738.49 [#/sec] (mean) -- server: HTTP::Server::PSGI Requests per second: 2218.16 [#/sec] (mean) -- server: HTTP::Server::PSGI (workers=10) Requests per second: 2792.99 [#/sec] (mean) -- server: HTTP::Server::Simple Requests per second: 1435.50 [#/sec] (mean) -- server: Corona Requests per second: 2332.00 [#/sec] (mean) -- server: POE Requests per second: 503.59 [#/sec] (mean) This benchmark was processed with "ab -c 10 -t 1 -k" on MacBook Pro 13" late 2009 model on Mac OS X 10.6.2 with perl 5.10.0. YMMV. NAMING Starman? The name Starman is taken from the song (*Star na Otoko*) by the Japanese rock band Unicorn (yes, Unicorn!). It's also known as a song by David Bowie, a power-up from Super Mario Brothers and a character from Earthbound, all of which I love. Why the cute name instead of more descriptive namespace? Are you on drugs? I'm sick of naming Perl software like HTTP::Server::PSGI::How::Its::Written::With::What::Module and people call it HSPHIWWWM on IRC. It's hard to say on speeches and newbies would ask questions what they stand for every day. That's crazy. This module actually includes the longer alias and an empty subclass HTTP::Server::PSGI::Net::Server::PreFork for those who like to type more ::'s. It would actually help you find this software by searching for *PSGI Server Prefork* on CPAN, which i believe is a good thing. Yes, maybe I'm on drugs. We'll see. AUTHOR Tatsuhiko Miyagawa Andy Grundman wrote Catalyst::Engine::HTTP::Prefork, which this module is heavily based on. Kazuho Oku wrote Net::Server::SS::PreFork that makes it 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 Catalyst::Engine::HTTP::Prefork Net::Server::PreFork starman-0.3005/bin/000075500000000000000000000000001205106272600140155ustar00rootroot00000000000000starman-0.3005/bin/starman000075500000000000000000000201201205106272600154030ustar00rootroot00000000000000#!/usr/bin/perl use strict; use Plack::Runner; sub version { require Starman; print "Starman $Starman::VERSION\n"; } my $preload_app; require Getopt::Long; Getopt::Long::Configure("no_ignore_case", "no_auto_abbrev", "pass_through"); Getopt::Long::GetOptions( "preload-app" => \$preload_app, ); my @args = (server => 'Starman', env => 'deployment', version_cb => \&version); if (!$preload_app) { push @args, 'loader' => 'Delayed'; } my @argv = @ARGV; my $runner = Plack::Runner->new(@args); $runner->parse_options(@argv); if ($runner->{loader} eq 'Restarter') { warn <set_options(argv => \@argv); $runner->run; __END__ =head1 NAME starman - Starman launcher =head1 SYNOPSIS starman --listen :5001 --listen /tmp/starman.sock starman --workers 32 --port 8080 =head1 OPTIONS =over 4 =item -l, --listen --listen HOST:PORT --listen :PORT --listen UNIX_SOCKET Specifies the TCP address, ports and UNIX domain sockets to bind to wait for requests. You can repeat as many times as you want and mix TCP and UNIX domain sockets. Defaults to any IP address and port 5000. =item --host --host 127.0.0.1 Specifies the address to bind. This option is for a compatiblity with L and you're recommended to use C<--listen> instead. =item --port --port 8080 Specifies the port to bind. This option is for a compatiblity with L and you're recommended to use C<--listen> instead. =item -S, --socket -S /tmp/starman.sock Specifies the path to UNIX domain socket to bind. This option is for a compatiblity with L and you're recommended to use C<--listen> instead. =item --workers Specifies the number of worker pool. Defaults to 5. Starman by default sets up other spare server configuration based on this workers value, making sure there are B C worker processes running. So even if there're no idle workers, Starman won't spawn off spare processes since that's mostly what you want to do by fine tuning the memory usage etc. in the production environment. =item --backlog Specifies the number of backlog (listen queue size) of listener sockets. Defaults to 1024. On production systems, setting a very low value can allow failover on frontend proxy (like nginx) to happen more quickly, if you have multiple Starman clusters. If you're doing simple benchmarks and getting connection errors, increasing this parameter can help avoid them. You should also consider increasing C. Note that this is not recommended for real production system if you have another cluster to failover (see above). =item --max-requests Number of the requests to process per one worker process. Defaults to 1000. =item --preload-app This option lets Starman preload the specified PSGI application in the master parent process before preforking children. This allows memory savings with copy-on-write memory management. When not set (default), forked children loads the application in the initialization hook. Enabling this option can cause bad things happen when resources like sockets or database connections are opened at load time by the master process and shared by multiple children. Since Starman 0.2000, this option defaults to false, and you should explicitly set this option to preload the application in the master process. Alternatively, you can use -M command line option (plackup's common option) to preload the I rather than the itself. starman -MCatalyst -MDBIx::Class myapp.psgi will load the modules in the master process for memory savings with CoW, but the actual loading of C is done per children, allowing resource managements such as database connection safer. If you enable this option, sending C signal to the master process I pick up any code changes you make. See L for details. =item --disable-keepalive Disable Keep-alive persistent connections. It is an useful workaround if you run Starman behind a broken frontend proxy that tries to pool connections more than a number of backend workers (i.e. Apache mpm_prefork + mod_proxy). =item --keepalive-timeout The number of seconds Starman will wait for a subsequent request before closing the connection if Keep-alive persistent connections are enabled. Setting this to a high value may cause performance problems in heavily loaded servers. The higher the timeout, the more backend workers will be kept occupied waiting on connections with idle clients. Defaults to 1. =item --user To listen on a low-numbered (E1024) port, it will be necessary to start the server as root. Use the C<--user> option to specify a userid or username that the server process should switch to after binding to the port. Defaults to the current userid. =item --group Specify the group id or group name that the server should switch to after binding to the port. This option is usually used with C<--user>. Defaults to the current group id. =item --pid Specify the pid file path. Use it with C<-D|--daemonize> option, described in C. =item --error-log Specify the pathname of a file where the error log should be written. This enables you to still have access to the errors when using C<--daemonize>. =back Starman passes through other options given to L, the common backend that L uses, so the most options explained in C such as C<--access-log> or C<--daemonize> works fine in starman too. Setting the environment variable C to 1 makes the Starman server runninng in the debug mode. =cut =head1 SIGNALS =over 4 =item HUP Sending C signal to the master process will restart all the workers gracefully (meaning the currently running requests will shut down once the request is complete), and by default, the workers will pick up the code changes you make by reloading the application. If you enable C<--preload-app> option, however, the code will be only loaded in the startup process and will not pick up the code changes you made. If you want to preload the app I do graceful restarts by reloading the code changes, you're recommended to use L, configured to send C signal when superdaemon received C, i.e: start_server --interval 5 --port 8080 --signal-on-hup=QUIT -- \ starman --preload-app myapp.psgi You will then send the HUP signal to C process to gracefully reload the starman cluster (master and workers). With Server::Starter 0.12 or later, you should also be able to set C<--signal-on-term> to QUIT so that you can safely shutdown Starman first and then stop the C daemon process as well. =item TTIN, TTOU Sending C signal to the master process will dynamically increase the number of workers, and C signal will decrease it. =item INT, TERM Sending C or C signal to the master process will kill all the workers immediately and shut down the server. =item QUIT Sending C signal to the master process will gracefully shutdown the workers (meaning the currently running requests will shut down once the request is complete). =back =head1 RELOADING THE APPLICATION You're recommended to use signals (see above) to reload the application, and are strongly discouraged to use C<-r> or C<-R> (reloading flag) from plackup. These options will make a separate directory watcher thread, and makes your life difficult if you want to combine with other process daemon tools such as Server::Strater. =head1 DIFFERENCES WITH PLACKUP C executable is basically the equivalent of using C with C server handler i.e. C, except that C delay loads the application with the Delayed loader by default, which can be disabled with C<--preload-app>. C command also automatically sets the environment (C<-E>) to the value of I. You're recommended to use C unless there's a reason to stick to C for compatiblity. =head1 SEE ALSO L =cut starman-0.3005/lib/000075500000000000000000000000001205106272600140135ustar00rootroot00000000000000starman-0.3005/lib/HTTP/000075500000000000000000000000001205106272600145725ustar00rootroot00000000000000starman-0.3005/lib/HTTP/Server/000075500000000000000000000000001205106272600160405ustar00rootroot00000000000000starman-0.3005/lib/HTTP/Server/PSGI/000075500000000000000000000000001205106272600166025ustar00rootroot00000000000000starman-0.3005/lib/HTTP/Server/PSGI/Net/000075500000000000000000000000001205106272600173305ustar00rootroot00000000000000starman-0.3005/lib/HTTP/Server/PSGI/Net/Server/000075500000000000000000000000001205106272600205765ustar00rootroot00000000000000starman-0.3005/lib/HTTP/Server/PSGI/Net/Server/PreFork.pm000064400000000000000000000001261205106272600225030ustar00rootroot00000000000000package HTTP::Server::PSGI::Net::Server::PreFork; use parent qw(Starman::Server); 1; starman-0.3005/lib/Plack/000075500000000000000000000000001205106272600150455ustar00rootroot00000000000000starman-0.3005/lib/Plack/Handler/000075500000000000000000000000001205106272600164225ustar00rootroot00000000000000starman-0.3005/lib/Plack/Handler/Starman.pm000064400000000000000000000014661205106272600203740ustar00rootroot00000000000000package Plack::Handler::Starman; use strict; use Starman::Server; sub new { my $class = shift; bless { @_ }, $class; } sub run { my($self, $app) = @_; if ($ENV{SERVER_STARTER_PORT}) { require Net::Server::SS::PreFork; @Starman::Server::ISA = qw(Net::Server::SS::PreFork); # Yikes. } Starman::Server->new->run($app, {%$self}); } 1; __END__ =head1 NAME Plack::Handler::Starman - Plack adapter for Starman =head1 SYNOPSIS plackup -s Starman =head1 DESCRIPTION This handler exists for the C compatibility. Essentially, C is equivalent to C, because the C executable delay loads the application by default. See L for more details. =head1 AUTHOR Tatsuhiko Miyagawa =head1 SEE ALSO L =cut starman-0.3005/lib/Starman.pm000064400000000000000000000075201205106272600157620ustar00rootroot00000000000000package Starman; use strict; use 5.008_001; our $VERSION = '0.3005'; 1; __END__ =encoding utf-8 =for stopwords =head1 NAME Starman - High-performance preforking PSGI/Plack web server =head1 SYNOPSIS # Run app.psgi with the default settings > starman # run with Server::Starter > start_server --port 127.0.0.1:80 -- starman --workers 32 myapp.psgi # UNIX domain sockets > starman --listen /tmp/starman.sock =head1 DESCRIPTION Starman is a PSGI perl web server that has unique features such as: =over 4 =item High Performance Uses the fast XS/C HTTP header parser =item Preforking Spawns workers preforked like most high performance UNIX servers do. Starman also reaps dead children and automatically restarts the worker pool. =item Signals Supports C for graceful worker restarts, and C/C to dynamically increase or decrease the number of worker processes, as well as C to gracefully shutdown the worker processes. =item Superdaemon aware Supports L for hot deploy and graceful restarts. =item Multiple interfaces and UNIX Domain Socket support Able to listen on multiple intefaces including UNIX sockets. =item Small memory footprint Preloading the applications with C<--preload-app> command line option enables copy-on-write friendly memory management. Also, the minimum memory usage Starman requires for the master process is 7MB and children (workers) is less than 3.0MB. =item PSGI compatible Can run any PSGI applications and frameworks =item HTTP/1.1 support Supports chunked requests and responses, keep-alive and pipeline requests. =item UNIX only This server does not support Win32. =back =head1 PERFORMANCE Here's a simple benchmark using C. -- server: Starman (workers=10) Requests per second: 6849.16 [#/sec] (mean) -- server: Twiggy Requests per second: 3911.78 [#/sec] (mean) -- server: AnyEvent::HTTPD Requests per second: 2738.49 [#/sec] (mean) -- server: HTTP::Server::PSGI Requests per second: 2218.16 [#/sec] (mean) -- server: HTTP::Server::PSGI (workers=10) Requests per second: 2792.99 [#/sec] (mean) -- server: HTTP::Server::Simple Requests per second: 1435.50 [#/sec] (mean) -- server: Corona Requests per second: 2332.00 [#/sec] (mean) -- server: POE Requests per second: 503.59 [#/sec] (mean) This benchmark was processed with C on MacBook Pro 13" late 2009 model on Mac OS X 10.6.2 with perl 5.10.0. YMMV. =head1 NAMING =head2 Starman? The name Starman is taken from the song (I) by the Japanese rock band Unicorn (yes, Unicorn!). It's also known as a song by David Bowie, a power-up from Super Mario Brothers and a character from Earthbound, all of which I love. =head2 Why the cute name instead of more descriptive namespace? Are you on drugs? I'm sick of naming Perl software like HTTP::Server::PSGI::How::Its::Written::With::What::Module and people call it HSPHIWWWM on IRC. It's hard to say on speeches and newbies would ask questions what they stand for every day. That's crazy. This module actually includes the longer alias and an empty subclass L for those who like to type more ::'s. It would actually help you find this software by searching for I on CPAN, which i believe is a good thing. Yes, maybe I'm on drugs. We'll see. =head1 AUTHOR Tatsuhiko Miyagawa Emiyagawa@bulknews.netE Andy Grundman wrote L, which this module is heavily based on. Kazuho Oku wrote L that makes it easy to add L support to this software. =head1 LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L L L =cut starman-0.3005/lib/Starman/000075500000000000000000000000001205106272600154205ustar00rootroot00000000000000starman-0.3005/lib/Starman/Server.pm000064400000000000000000000405111205106272600172250ustar00rootroot00000000000000package Starman::Server; use strict; use base 'Net::Server::PreFork'; use Data::Dump qw(dump); use Socket qw(IPPROTO_TCP TCP_NODELAY); use IO::Socket qw(:crlf); use HTTP::Parser::XS qw(parse_http_request); use HTTP::Status qw(status_message); use HTTP::Date qw(time2str); use Symbol; use Plack::Util; use Plack::TempBuffer; use constant DEBUG => $ENV{STARMAN_DEBUG} || 0; use constant CHUNKSIZE => 64 * 1024; use constant READ_TIMEOUT => 5; my $null_io = do { open my $io, "<", \""; $io }; use Net::Server::SIG qw(register_sig); # Override Net::Server's HUP handling - just restart all the workers and that's about it sub sig_hup { my $self = shift; $self->hup_children; } sub run { my($self, $app, $options) = @_; $self->{app} = $app; $self->{options} = $options; my %extra = (); if ( $options->{pid} ) { $extra{pid_file} = $options->{pid}; } if ( $options->{daemonize} ) { $extra{setsid} = $extra{background} = 1; } if (! exists $options->{keepalive}) { $options->{keepalive} = 1; } if (! exists $options->{keepalive_timeout}) { $options->{keepalive_timeout} = 1; } my($host, $port, $proto); for my $listen (@{$options->{listen} || [ "$options->{host}:$options->{port}" ]}) { if ($listen =~ /:/) { my($h, $p) = split /:/, $listen, 2; push @$host, $h || '*'; push @$port, $p; push @$proto, 'tcp'; } else { push @$host, 'localhost'; push @$port, $listen; push @$proto, 'unix'; } } my $workers = $options->{workers} || 5; local @ARGV = (@{$options->{argv} || []}); $self->SUPER::run( port => $port, host => $host, proto => $proto, serialize => 'flock', log_level => DEBUG ? 4 : 2, ($options->{error_log} ? ( log_file => $options->{error_log} ) : () ), min_servers => $options->{min_servers} || $workers, min_spare_servers => $options->{min_spare_servers} || $workers - 1, max_spare_servers => $options->{max_spare_servers} || $workers - 1, max_servers => $options->{max_servers} || $workers, max_requests => $options->{max_requests} || 1000, user => $options->{user} || $>, group => $options->{group} || $), listen => $options->{backlog} || 1024, check_for_waiting => 1, no_client_stdout => 1, %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 => $port =~ /unix/ ? 'unix' : 'http', server_software => 'Starman', }) if $self->{options}{server_ready}; register_sig( TTIN => sub { $self->{server}->{$_}++ for qw( min_servers max_servers ) }, TTOU => sub { $self->{server}->{$_}-- for qw( min_servers max_servers ) }, QUIT => sub { $self->server_close(1) }, ); } sub server_close { my($self, $quit) = @_; if ($quit) { $self->log(2, $self->log_time . " Received QUIT. Running a graceful shutdown\n"); $self->{server}->{$_} = 0 for qw( min_servers max_servers ); $self->hup_children; while (1) { Net::Server::SIG::check_sigs(); $self->coordinate_children; last if !keys %{$self->{server}{children}}; sleep 1; } $self->log(2, $self->log_time . " Worker processes cleaned up\n"); } $self->SUPER::server_close(); } sub run_parent { my $self = shift; $0 = "starman master " . join(" ", @{$self->{options}{argv} || []}); no warnings 'redefine'; local *Net::Server::PreFork::register_sig = sub { my %args = @_; delete $args{QUIT}; Net::Server::SIG::register_sig(%args); }; $self->SUPER::run_parent(@_); } # The below methods run in the child process sub child_init_hook { my $self = shift; srand(); if ($self->{options}->{psgi_app_builder}) { DEBUG && warn "[$$] Initializing the PSGI app\n"; $self->{app} = $self->{options}->{psgi_app_builder}->(); } $0 = "starman worker " . join(" ", @{$self->{options}{argv} || []}); } sub post_accept_hook { my $self = shift; $self->{client} = { headerbuf => '', inputbuf => '', keepalive => 1, }; } sub process_request { my $self = shift; my $conn = $self->{server}->{client}; if ($conn->NS_proto eq 'TCP') { setsockopt($conn, IPPROTO_TCP, TCP_NODELAY, 1) or die $!; } while ( $self->{client}->{keepalive} ) { last if !$conn->connected; # Read until we see all headers last if !$self->_read_headers; my $env = { REMOTE_ADDR => $self->{server}->{peeraddr}, REMOTE_HOST => $self->{server}->{peerhost} || $self->{server}->{peeraddr}, REMOTE_PORT => $self->{server}->{peerport} || 0, SERVER_NAME => $self->{server}->{sockaddr} || 0, # XXX: needs to be resolved? SERVER_PORT => $self->{server}->{sockport} || 0, SCRIPT_NAME => '', '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, 'psgix.io' => $conn, 'psgix.input.buffered' => Plack::Util::TRUE, 'psgix.harakiri' => Plack::Util::TRUE, }; # Parse headers my $reqlen = parse_http_request(delete $self->{client}->{headerbuf}, $env); if ( $reqlen == -1 ) { # Bad request DEBUG && warn "[$$] Bad request\n"; $self->_http_error(400, { SERVER_PROTOCOL => "HTTP/1.0" }); last; } # Initialize PSGI environment # Determine whether we will keep the connection open after the request my $connection = delete $env->{HTTP_CONNECTION}; my $proto = $env->{SERVER_PROTOCOL}; 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 ( $env->{HTTP_EXPECT} ) { if ( $env->{HTTP_EXPECT} eq '100-continue' ) { syswrite $conn, '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 ($env->{HTTP_HOST}) { # No host, bad request DEBUG && warn "[$$] Bad request, HTTP/1.1 without Host header\n"; $self->_http_error( 400, $env ); last; } } unless ($self->{options}->{keepalive}) { DEBUG && warn "[$$] keep-alive is disabled. Closing the connection after this request\n"; $self->{client}->{keepalive} = 0; } $self->_prepare_env($env); # 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($self->{options}->{keepalive_timeout}); } } 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 defined $self->{client}->{inputbuf} && $self->{client}->{inputbuf} =~ /$CRLF$CRLF/s; # If not, read some data my $read = sysread $self->{server}->{client}, 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) = @_; my $get_chunk = sub { if ($self->{client}->{inputbuf}) { my $chunk = delete $self->{client}->{inputbuf}; return ($chunk, length $chunk); } my $read = sysread $self->{server}->{client}, my($chunk), CHUNKSIZE; return ($chunk, $read); }; my $chunked = do { no warnings; lc delete $env->{HTTP_TRANSFER_ENCODING} eq 'chunked' }; if (my $cl = $env->{CONTENT_LENGTH}) { my $buf = Plack::TempBuffer->new($cl); while ($cl > 0) { my($chunk, $read) = $get_chunk->(); if ( !defined $read || $read == 0 ) { die "Read error: $!\n"; } $cl -= $read; $buf->print($chunk); } $env->{'psgi.input'} = $buf->rewind; } elsif ($chunked) { my $buf = Plack::TempBuffer->new; my $chunk_buffer = ''; my $length; DECHUNK: while (1) { my($chunk, $read) = $get_chunk->(); $chunk_buffer .= $chunk; while ( $chunk_buffer =~ s/^(([0-9a-fA-F]+).*\015\012)// ) { my $trailer = $1; my $chunk_len = hex $2; if ($chunk_len == 0) { last DECHUNK; } elsif (length $chunk_buffer < $chunk_len + 2) { $chunk_buffer = $trailer . $chunk_buffer; last; } $buf->print(substr $chunk_buffer, 0, $chunk_len, ''); $chunk_buffer =~ s/^\015\012//; $length += $chunk_len; } last unless $read && $read > 0; } $env->{CONTENT_LENGTH} = $length; $env->{'psgi.input'} = $buf->rewind; } else { $env->{'psgi.input'} = $null_io; } } sub _finalize_response { my($self, $env, $res) = @_; if ($env->{'psgix.harakiri.commit'}) { $self->{client}->{keepalive} = 0; $self->{client}->{harakiri} = 1; } 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; my $headers = $res->[1]; for (my $i = 0; $i < @$headers; $i += 2) { my $k = $headers->[$i]; my $v = $headers->[$i + 1]; next if $k eq 'Connection'; push @headers, "$k: $v"; $headers{lc $k} = $v; } if ( $protocol eq 'HTTP/1.1' ) { if ( !exists $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; } } } else { if ( !exists $headers{'content-length'} ) { DEBUG && warn "[$$] Disabling keep-alive after sending unknown length body on $protocol\n"; $self->{client}->{keepalive} = 0; } } if ( ! $headers{date} ) { 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'; } my $conn = $self->{server}->{client}; # Buffer the headers so they are sent with the first write() call # This reduces the number of TCP packets we are sending syswrite $conn, join( $CRLF, @headers, '' ) . $CRLF; if (defined $res->[2]) { Plack::Util::foreach($res->[2], sub { my $buffer = $_[0]; if ($chunked) { my $len = length $buffer; return unless $len; $buffer = sprintf( "%x", $len ) . $CRLF . $buffer . $CRLF; } syswrite $conn, $buffer; DEBUG && warn "[$$] Wrote " . length($buffer) . " bytes\n"; }); syswrite $conn, "0$CRLF$CRLF" if $chunked; } else { return Plack::Util::inline_object write => sub { my $buffer = $_[0]; if ($chunked) { my $len = length $buffer; return unless $len; $buffer = sprintf( "%x", $len ) . $CRLF . $buffer . $CRLF; } syswrite $conn, $buffer; DEBUG && warn "[$$] Wrote " . length($buffer) . " bytes\n"; }, close => sub { syswrite $conn, "0$CRLF$CRLF" if $chunked; }; } } sub post_client_connection_hook { my $self = shift; if ($self->{client}->{harakiri}) { exit; } } 1; starman-0.3005/t/000075500000000000000000000000001205106272600135105ustar00rootroot00000000000000starman-0.3005/t/00_compile.t000064400000000000000000000001031205106272600156160ustar00rootroot00000000000000use strict; use Test::More tests => 1; BEGIN { use_ok 'Starman' } starman-0.3005/t/chunked_req.t000064400000000000000000000016741205106272600161750ustar00rootroot00000000000000use strict; use Plack::Test; use File::ShareDir; use HTTP::Request; use Test::More; use Digest::MD5; $Plack::Test::Impl = "Server"; $ENV{PLACK_SERVER} = 'Starman'; my $file = File::ShareDir::dist_dir('Plack') . "/baybridge.jpg"; my $app = sub { my $env = shift; my $body; my $clen = $env->{CONTENT_LENGTH}; while ($clen > 0) { $env->{'psgi.input'}->read(my $buf, $clen) or last; $clen -= length $buf; $body .= $buf; } return [ 200, [ 'Content-Type', 'text/plain', 'X-Content-Length', $env->{CONTENT_LENGTH} ], [ $body ] ]; }; test_psgi $app, sub { my $cb = shift; open my $fh, "<:raw", $file; local $/ = \1024; my $req = HTTP::Request->new(POST => "http://localhost/"); $req->content(sub { scalar <$fh> }); my $res = $cb->($req); is $res->header('X-Content-Length'), 79838; is Digest::MD5::md5_hex($res->content), '983726ae0e4ce5081bef5fb2b7216950'; }; done_testing; starman-0.3005/t/chunked_termination.t000064400000000000000000000021641205106272600177320ustar00rootroot00000000000000use strict; use Test::More; { package Starman::Server; # Override the sysread method enabling it to read a stream of packages # from an arrayref instead of an file handle: use subs 'sysread'; *Starman::Server::sysread = sub { if (ref $_[0] eq "ARRAY") { die "EWOULDBLOCK\n" unless @{ $_[0] }; $_[1] = shift @{ $_[0] }; return length $_[1]; } return CORE::sysread($_[0], $_[1], $_[2]); }; } use Starman::Server; my $server = { server => { client => [ "3\015\012foo\015\012", # Full chunk "3\015\012bar", # Chunk missing terminating HTTP newline "\015\012", # ... and then the termination "0\015\012", # Empty chunk to mark end of stream ], } }; my $env = { HTTP_TRANSFER_ENCODING => 'chunked', }; my $blocked; eval { Starman::Server::_prepare_env( $server, $env ); 1; } or do { $blocked = 1 if $@ =~ /^EWOULDBLOCK$/; }; ok( !$blocked, "Reading chunked encoding does not block on well-placed package borders" ); done_testing; starman-0.3005/t/chunked_zero_length.t000064400000000000000000000011401205106272600177120ustar00rootroot00000000000000use strict; use Plack::Test; use HTTP::Request; use Test::More; $Plack::Test::Impl = "Server"; $ENV{PLACK_SERVER} = 'Starman'; my $app = sub { my $env = shift; return sub { my $response = shift; my $writer = $response->([ 200, [ 'Content-Type', 'text/plain' ]]); $writer->write("Content"); $writer->write(""); $writer->write("Again"); $writer->close; } }; test_psgi $app, sub { my $cb = shift; my $req = HTTP::Request->new(GET => "http://localhost/"); my $res = $cb->($req); is $res->content, "ContentAgain"; }; done_testing; starman-0.3005/t/findbin.psgi000064400000000000000000000002001205106272600157750ustar00rootroot00000000000000use strict; use FindBin; sub { my $env = shift; return [ 200, [ "Content-Type", "text/plain" ], [ $FindBin::Bin ] ]; }; starman-0.3005/t/findbin.t000064400000000000000000000006371205106272600153140ustar00rootroot00000000000000use Test::TCP; use LWP::UserAgent; use FindBin; use Test::More; my $s = Test::TCP->new( code => sub { my $port = shift; exec $^X, "bin/starman", "--port", $port, "--max-requests=1", "--workers=1", "t/findbin.psgi"; }, ); my $ua = LWP::UserAgent->new(timeout => 3); for (1..2) { my $res = $ua->get("http://localhost:" . $s->port); is $res->content, $FindBin::Bin; } done_testing; starman-0.3005/t/harakiri.t000064400000000000000000000017331205106272600154730ustar00rootroot00000000000000use strict; use warnings; use HTTP::Request::Common; use Plack::Test; use Test::More; $Plack::Test::Impl = 'Server'; $ENV{PLACK_SERVER} = 'Starman'; test_psgi app => sub { my $env = shift; return [ 200, [ 'Content-Type' => 'text/plain' ], [$$] ]; }, client => sub { my %seen_pid; my $cb = shift; for (1..23) { my $res = $cb->(GET "/"); $seen_pid{$res->content}++; } cmp_ok(keys(%seen_pid), '<=', 5, 'In non-harakiri mode, pid is reused'); }; test_psgi app => sub { my $env = shift; $env->{'psgix.harakiri.commit'} = 1; return [ 200, [ 'Content-Type' => 'text/plain' ], [$$] ]; }, client => sub { my %seen_pid; my $cb = shift; for (1..23) { my $res = $cb->(GET "/"); $seen_pid{$res->content}++; } is keys(%seen_pid), 23, 'In Harakiri mode, each pid only used once'; }; done_testing; starman-0.3005/t/rand.psgi000064400000000000000000000001701205106272600153160ustar00rootroot00000000000000rand(); # this initializes the random seed sub { return [ 200, ["Content-Type", "text/plain"], [ rand(100) ] ]; }; starman-0.3005/t/rand.t000064400000000000000000000011011205106272600146120ustar00rootroot00000000000000use Test::TCP; use LWP::UserAgent; use FindBin; use Test::More; for (1..2) { # preload, non-preload my @preload = $_ == 1 ? ("--preload-app") : (); my $s = Test::TCP->new( code => sub { my $port = shift; exec $^X, "bin/starman", @preload, "--port", $port, "--max-requests=1", "--workers=1", "t/rand.psgi"; }, ); my $ua = LWP::UserAgent->new; my @res; for (1..2) { push @res, $ua->get("http://localhost:" . $s->port); } isnt $res[0]->content, $res[1]->content; undef $s; } done_testing; starman-0.3005/t/suite.t000064400000000000000000000002051205106272600150230ustar00rootroot00000000000000use strict; use warnings; use Test::More; use Plack::Test::Suite; Plack::Test::Suite->run_server_tests('Starman'); done_testing(); starman-0.3005/xt/000075500000000000000000000000001205106272600137005ustar00rootroot00000000000000starman-0.3005/xt/perlcritic.t000064400000000000000000000002231205106272600162220ustar00rootroot00000000000000use strict; use Test::More; eval q{ use Test::Perl::Critic }; plan skip_all => "Test::Perl::Critic is not installed." if $@; all_critic_ok("lib"); starman-0.3005/xt/pod.t000064400000000000000000000002011205106272600146400ustar00rootroot00000000000000use Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); starman-0.3005/xt/podspell.t000064400000000000000000000003421205106272600157060ustar00rootroot00000000000000use Test::More; eval q{ use Test::Spelling }; plan skip_all => "Test::Spelling is not installed." if $@; add_stopwords(); set_spell_cmd("aspell -l en list"); all_pod_files_spelling_ok('lib'); __DATA__ Tatsuhiko Miyagawa starman-0.3005/xt/synopsis.t000064400000000000000000000001601205106272600157510ustar00rootroot00000000000000use Test::More; eval "use Test::Synopsis"; plan skip_all => "Test::Synopsis required" if $@; all_synopsis_ok();