HTTP-Server-Simple-0.52/000755 000765 000024 00000000000 13067537402 015510 5ustar00jbrandtstaff000000 000000 HTTP-Server-Simple-0.52/Changes000644 000765 000024 00000020206 13067536317 017007 0ustar00jbrandtstaff000000 000000 0.52 2017-03-31 - Add . to lib in Makefile.PL to support perl 5.25.11 0.51 2015-09-16 - add OPTIONS as a valid method - better compatibility with CGI.pm < 3.36 - fix tests for freebsd and IPv6 - repository info 0.50 2015-02-02 - All collected changes since 0.44 0.45_08 2015-01-29 - IPv6 skipping code always turned off tests, rather than just skipping on bad hosts. 0.45_07 2015-01-27T22:24Z - Skip IPv6 tests in 01live.t on machines where IPv6 isn't configured 0.45_06 2015-01-23T17:55Z - Further test iteration and diagnostics for smoke failures 0.45_05 2015-01-22T16:23Z - Test diagnostics for cpantester failures - Hopefully better localhost handling 0.45_04 2015-01-20T17:40Z - Fix compatibility for the IPv6 support in .45_02 - Hopefully improve the live tests 0.45_03 2015-01-14T19:48Z - Remove useless VERSION from HTTP::Server::Simple::CGI and HTTP::Server::Simple::CGI::Environment 0.45_02 2012-05-20T18:15Z - Support for IPv6 - Daniel Kahn Gillmor [rt.cpan.org #61200] 0.45_01 2011-09-22T10:10:41Z - Support full URIs as required by RFC2616 - penfold [rt.cpan.org #69445] 0.44 2011-04-04T16:59:59Z - Fix tests to run in a FreeBSD Jail - Tom Hukins [rt.cpan.org #49807] 0.43 2010-05-01T22:23:55Z - Support for getting REMOTE_PORT -- rgs 0.42_01 2010-04-02T12:59:48Z - Patch to t/01live.t to prevent spurious win32 test failures. 0.42 2010-02-18T10:13:11Z - Inline uri_unescape to drop URI::Escape which is the only non-core dependency of this distribution. -- miyagawa - Do not special case COOKIE and sets Cookie header to HTTP_COOKIE. -- miyagawa O'Reilly's WebSite server misuses COOKIE environment instead of HTTP_COOKIE. We don't need to replicate that bug since HTTP::Server::Simple is a server, not a CGI library like CGI.pm. 0.41_01 2010-02-02T12:08:15Z - Pluggable CGI class support based on a patch from NANIS 0.41 2009-09-29T23:05:04Z - HTTP header concatenation fixes from miyagawa 0.40 2009-08-17T22:01:07Z - After a fork, we need to reset the random seed lest we have duplicated random numbers in both forks. 0.39 2009-08-17T09:41:05Z - Added signature tests 0.38_04 2009-08-12T20:15:14Z - Another pass at the Win32 fixes from KMX 0.38_03 2009-04-11T18:47:29Z - Subject: [rt.cpan.org #44961] [PATCH] xdg reports select() is problematic on win32 0.38_02 2009-04-10T20:57:19Z - Specify an HTTP version for our GETs should get escaping to wokr 0.38_01 2009-03-02T18:11:46Z - http://rt.cpan.org/Ticket/Attachment/568795/286902/ from confound++ for http://rt.cpan.org/Public/Bug/Display.html?id=28122 0.38 2009-01-11T14:42:57Z - Improve startup banner generation 0.37 2009-01-02T12:21:30Z - Several fixes for [rt.cpan.org #38011] designed to help get HSS to pass tests on Strawberry Perl 0.36 - Documentation fixups 0.35 - Pass arguments to ->run through to Net::Server->run 0.34 - Call setup_environment if a Net::Server is being used, for consistency. - Don't print_banner if a Net::Server is being used. - Make header parsing comply with RFC 2616. [rt.cpan.org #21411] 0.33 2008-04-25T13:57:30Z - The new support for background processes notifying the parent didn't quite work right for some apps using HSS. It's been reverted for now and the tests TODOED 0.32 2008-04-24T09:45:14Z - At least Apache and lighttpd put unencoded strings into PATH_INFO, so so should we. - Patch from ntyni@iki.fi to make backgrounding of the standalone server's server process deterministic. [rt.cpan.org #28122] 0.31 2008-03-16T20:51:04Z - Test suite parallelization fixes. Thanks to Slaven Rezic 0.30 2008-03-11T12:14:24Z - Minor doc fix from Paul Miller. - Fixing doc style from "$this" to "$self" like any self-respecting perl code 0.29 2008-02-15T11:43:29Z - new example section from almut on perlmonks 0.28 2008-01-15T09:33:58Z - New restartability support from Mark Stosberg After reviewing the code in HTTP::Server::Simple, Catalyst::Engine::HTTP and HTTP::Server::Brick, I found and implemented an updated signal handling approach that I like and understand, and actually works. The current code restarted immediately if a SIGHUP came in, no matter what was happening, including if a request was in process of being fulfilled. The new code works more like "apachectl graceful". It waits for the current request cycle to finish, and then restarts the server. This code has to be integrated in the core, but its just about the same amount of signal handling code that was there... it just works better. It's also written in such a way I think subclass/mixin authors could rewrite just these parts if they wanted. Also, it looks like a Net::Server based sub-class would already be doing its own thing with SIGHUP handling, and should continue to be unaffected. 0.27 - 0.26 release apparently didn't get to cpan correctly 0.26 - Supports multi-line encoded values in query_sting (like foo%0Abar) -- Dobrica Pavlinusic - Fixes to URI unescaping to behave like apache does 0.24 - Hopefully deal with an odd case where a poorly behaved Internet Explorer could crash the server. Thanks to the Catalyst project. 0.23 - Fix a release-engineering messup. Thanks to ANDK 0.22 2006-10-18T23:36:34Z - Query string processing improvements 0.21 2006-10-18T23:31:42Z - [rt.cpan.org #21727] [PATCH] Support for Perl 5.004 -- Sébastien Aperghis-Tramoni 0.20 - Require POSIX only if we need it, rather than "use" it all the time - [cpan #17533] - Brad Bowman 0.19 - Catch and ignore SIGPIPE, so broken pipes from the client don't cause - Standalone to drop all the way back to the shell. 0.18 - new method: valid_http_method() from Chris Dent to make it easier to - create servers handling non-standard HTTP verbs. 0.17 - Workaround for Class::Spiffy classloading order issue - Better handling for completely mangled requests. 0.16 2005-11-07T14:40:43Z - SIG{'HUP'} does not exist on Win32 (cpan #15606) 0.15 2005-10-06T21:11:02Z - Precompute the local host's hostname and IP to save on DNS lookups at runtime 0.14 2005-10-06T20:48:49Z - Split out HTTP::Server::Simple::CGI::Environment to support non-CGI.pm CGIs - Ignore SIGPIPE - Signal handlers are now installed on ->run, not on new. Also, they're - documented. Thanks to Mark Fowler. - We no longer lookup $ENV{'REMOTE_HOST'} by hostname, as it can cause huge performance problems. 0.13 2005-08-09T21:25:20Z - Signal handlers should be 'localed', so as not to mess with others' - code. -- Thanks to David Wheeler 0.12 2005-07-17T02:14:57Z - Test suite improvements from Mattia Barbon 0.11 2005-07-08T22:56:01Z - Bogus META.yml broke signature checks. Thanks to sungo. 0.10 2005-06-28T11:27:58Z - Allow separate treatment of STDIN and STDOUT handles to the server. This gives support for HTTP::Server::Simple::Recorder. 0.09 2005-04-19T21:43:31Z - Now we set the GATEWAY_INTERFACE metavariable in H:S:S:CGI. 0.08 2005-04-16T01:27:17Z - New tests for HTTP::Server:Simple::CGI from hide. 0.07 2005-03-26T14:25:38Z - PAUSE broke :/ 0.05 2005-03-26T14:14:54Z - Fix a bug in HTTP::Server::Simple::CGI that clobbered CGI ENV variables in some cases. Thanks, Hide. - New public subclass-overridable method ->net_server() that can optionally take a Net::Server subclass name and use it to replace the default ->run() method. -- Autrijus Tang 0.04 2005-03-22T23:34:36Z - Changed ->headers calling conventions. This may break backwards compat, but is cleaner and safer. - Fixed bugs in ::CGI that broke http header handling - Refactored code to be more transparent - Patch from Sebastian Riedel to do proper parsing of form data from STDIN 0.03_03 2005-03-18T15:09:52Z - Finish fixes from http://rt.cpan.org/NoAuth/Bug.html?id=11409 0.03_02 2005-02-17T23:34:00Z - Make test script not depend on LWP - Add ->header(), and various generic hook capabilities - Made HTTP::Server::Simple::CGI use those hooks - Add ->bad_request(), for protocol errors 0.03_01 2005-02-17T21:39:34Z - Add ->setup() and ->handler() - Add support for specifying a host to bind listener to - Split out CGI.pm support into sub-class - Add Changes file to MANIFEST 0.03 2005-01-26T08:55:34Z - Test fixes for Win32 HTTP-Server-Simple-0.52/ex/000755 000765 000024 00000000000 13067537375 016135 5ustar00jbrandtstaff000000 000000 HTTP-Server-Simple-0.52/inc/000755 000765 000024 00000000000 13067537375 016272 5ustar00jbrandtstaff000000 000000 HTTP-Server-Simple-0.52/lib/000755 000765 000024 00000000000 13067537375 016267 5ustar00jbrandtstaff000000 000000 HTTP-Server-Simple-0.52/Makefile.PL000644 000765 000024 00000000452 13067461225 017462 0ustar00jbrandtstaff000000 000000 use lib '.'; use inc::Module::Install; all_from('lib/HTTP/Server/Simple.pm'); name('HTTP-Server-Simple'); license('perl'); requires( Socket => 1.94, 'Test::More' => 0, CGI => 0, ); repository('https://github.com/bestpractical/http-server-simple'); WriteAll( sign => 1); HTTP-Server-Simple-0.52/MANIFEST000644 000765 000024 00000001045 13067537375 016652 0ustar00jbrandtstaff000000 000000 ex/sample_server inc/Module/Install.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/Win32.pm inc/Module/Install/WriteAll.pm lib/HTTP/Server/Simple.pm lib/HTTP/Server/Simple/CGI.pm lib/HTTP/Server/Simple/CGI/Environment.pm Makefile.PL MANIFEST This list of files META.yml README Changes t/00smoke.t t/01live.t t/02pod.t t/03podcoverage.t t/04cgi.t SIGNATURE Public-key signature (added by MakeMaker) HTTP-Server-Simple-0.52/META.yml000644 000765 000024 00000001250 13067537062 016761 0ustar00jbrandtstaff000000 000000 --- abstract: 'Lightweight HTTP server' author: - 'Best Practical Solutions, LLC ' build_requires: ExtUtils::MakeMaker: 6.36 configure_requires: ExtUtils::MakeMaker: 6.36 distribution_type: module dynamic_config: 1 generated_by: 'Module::Install version 1.17' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 module_name: HTTP::Server::Simple name: HTTP-Server-Simple no_index: directory: - inc - t requires: CGI: 0 Socket: 1.94 Test::More: 0 resources: license: http://dev.perl.org/licenses/ repository: https://github.com/bestpractical/http-server-simple version: '0.52' HTTP-Server-Simple-0.52/README000644 000765 000024 00000000631 12630404553 016363 0ustar00jbrandtstaff000000 000000 HTTP::Server::Simple is a very simple standalone HTTP daemon with no non-core module dependencies. It's ideal for building a standalone http-based UI to your existing tools. This code is a derivative of the "standalone_httpd" tool used by RT. (http://bestpractical.com/rt) It's desperately short of tests and documentation. It wants your love and help. Jesse Vincent jesse@bestpractical.com. HTTP-Server-Simple-0.52/SIGNATURE000644 000765 000024 00000004640 13067537402 017000 0ustar00jbrandtstaff000000 000000 This file contains message digests of all files listed in MANIFEST, signed via the Module::Signature module, version 0.79. To verify the content in this distribution, first make sure you have Module::Signature installed, then type: % cpansign -v It will check each file's integrity, as well as the signature's validity. If "==> Signature verified OK! <==" is not displayed, the distribution may already have been compromised, and you should not run its Makefile.PL or Build.PL. -----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 SHA1 d799b9ed8589d1acc5afb7e0dfbfcd29ec0dd07c Changes SHA1 86a31bfdcdcd54159cbd433fd8dad4590ea172e9 MANIFEST SHA1 900df8090043ab2e861edf274cc6b657bfd5a9e2 META.yml SHA1 b27fd7983547b8d5dc5838b31429a14249e4f86c Makefile.PL SHA1 ed0c107672daac3bc9e266876666e1059dbe44b7 README SHA1 4ea1e9072ca87399184a46233df52a21e285604d ex/sample_server SHA1 05a17c51aceb6435a1eac17137f19911a09e5050 inc/Module/Install.pm SHA1 dc73c2baf4357ad1cc884146147f557a50a29300 inc/Module/Install/Base.pm SHA1 c7f311a5bc5a7f96e9105d5f16a0e13fc596899d inc/Module/Install/Can.pm SHA1 8c8f9ff5b0a536af59814e16a901ce39fbc23299 inc/Module/Install/Fetch.pm SHA1 4f77eb02e104324b08a047585c498146b045613b inc/Module/Install/Makefile.pm SHA1 2f5be6af6098acf6d786a4a7299a34d0c6c04ef9 inc/Module/Install/Metadata.pm SHA1 aa6723cc4a8d4475026f6ceb28e1f16459e8a11b inc/Module/Install/Win32.pm SHA1 6661285caedfe012cb5a1ca915a422ffc292ae2b inc/Module/Install/WriteAll.pm SHA1 fece79a06f46cd4ba35a023cc566657db3e1f757 lib/HTTP/Server/Simple.pm SHA1 6c552ef4704ad7ff0acde604fc984982c7bb586e lib/HTTP/Server/Simple/CGI.pm SHA1 cb2059aaae64bf98b586ae1a5d7e2edf95aa8b11 lib/HTTP/Server/Simple/CGI/Environment.pm SHA1 db064af54cab345a71daec576e32e64b8fb1033d t/00smoke.t SHA1 053fe4d227e7cecdc28a259fffab818117407112 t/01live.t SHA1 aca95653cfce68912e08c57b3a4566207e2f99b3 t/02pod.t SHA1 a7024d0d8e7b80d26f75a3551a1406a797b382f8 t/03podcoverage.t SHA1 77cfd507bd58ed91f7b96058a56cd68edee5bb0c t/04cgi.t -----BEGIN PGP SIGNATURE----- Version: GnuPG v1 iQEcBAEBAgAGBQJY3r79AAoJEBXncVGnZqUU0agH+wVkaug1ovbE4e3bgSG3J9cT nzFGnwvzRxoxN+MPHlz6Z3H6YF3Tq3u3oDKYVp4SNdXp3P+km5uGnUPVtnLHjbXd IiftWvZah1k+gyIgDti3FdIj5qfCzh8Hp5FSnoD2m3FVc6XdZKFO8kDLfZ4+JKcg WfA5h1ftG1kZwVRHeE89V1nlANIHZasmqK8snHay+4rnQTc0lJfQqCK5uw3Q0pH7 Qyf1a30z1veYxdrtv7Z06sApB/zr93iCMiUUHhl71jiFJXPzLzzX5RjxI7j+Lain 51NQ/xc9v91dXtGM1FA8ICCFEVHicHJFid/IchzUMoU96NEs5+pG9aQDvK6da2I= =U46d -----END PGP SIGNATURE----- HTTP-Server-Simple-0.52/t/000755 000765 000024 00000000000 13067537375 015764 5ustar00jbrandtstaff000000 000000 HTTP-Server-Simple-0.52/t/00smoke.t000644 000765 000024 00000000603 12630404553 017410 0ustar00jbrandtstaff000000 000000 use Test::More tests=>8; use_ok(HTTP::Server::Simple); ok(HTTP::Server::Simple->can('new'), 'can new()'); my $s= HTTP::Server::Simple->new(); isa_ok($s,'HTTP::Server::Simple'); is($s->port(),8080,'Defaults to 8080'); is($s->port(13432),13432,'Can change port'); is($s->port(),13432,'Change persists'); ok($s->can('print_banner'), 'can print_banner()'); ok($s->can('run'), 'can run()'); HTTP-Server-Simple-0.52/t/01live.t000644 000765 000024 00000012752 12630404553 017242 0ustar00jbrandtstaff000000 000000 # -*- perl -*- use Socket; use Test::More; use strict; # This script assumes that `localhost' will resolve to a local IP # address that may be bound to, my $PORT = 40000 + int(rand(10000)); my $RUN_IPV6 = eval { my $ipv6_host = get_localhost(AF_INET6); socket my $sockh, Socket::PF_INET6(), SOCK_STREAM, 0 or die "Cannot socket(PF_INET6) - $!"; my ($err, @res) = Socket::getaddrinfo($ipv6_host, $PORT, { family => AF_INET6, socktype => SOCK_STREAM } ); die $err if $err; for my $r (@res) { next unless ($r->{'family'} == AF_INET6); bind $sockh, $r->{'addr'} or die "Cannot bind - $!"; last; } return 1; }; if ( $RUN_IPV6) { plan tests => 34; } else { diag("Skipping IPv6"); plan tests => 17; } use HTTP::Server::Simple; package SlowServer; # This test class just waits a while before it starts # accepting connections. This makes sure that CPAN #28122 is fixed: # background() shouldn't return prematurely. use base qw(HTTP::Server::Simple::CGI); sub setup_listener { my $self = shift; $self->SUPER::setup_listener(); sleep 2; } 1; package main; my $DEBUG = 1 if @ARGV; my @pids = (); my @classes = (qw(HTTP::Server::Simple SlowServer)); for my $class (@classes) { run_server_tests($class, AF_INET); run_server_tests($class, AF_INET6) if $RUN_IPV6; $PORT++; # don't reuse the port incase your bogus os doesn't release in time } for my $fam ( AF_INET, AF_INET6 ) { next if ($fam == AF_INET6 && not $RUN_IPV6); my $s=HTTP::Server::Simple::CGI->new($PORT, $fam); is($fam, $s->family(), 'family OK'); $s->host(get_localhost($fam)); my $pid=$s->background(); diag("started server PID='$pid'") if ($ENV{'TEST_VERBOSE'}); like($pid, '/^-?\d+$/', 'pid is numeric'); select(undef,undef,undef,0.2); # wait a sec SKIP: { skip "No localhost for $fam", 4 unless defined $s->host; my $content=fetch($fam, "GET / HTTP/1.1", ""); like($content, '/Congratulations/', "Returns a page"); eval { like(fetch($fam, "GET a bogus request"), '/bad request/i', "knows what a request isn't"); }; fail("got exception in client: $@") if $@; like(fetch($fam, "GET / HTTP/1.1", ""), '/Congratulations/', "HTTP/1.1 request"); like(fetch($fam, "GET /"), '/Congratulations/', "HTTP/0.9 request"); } is(kill(9,$pid),1,'Signaled 1 process successfully'); } is( kill( 9, $_ ), 1, "Killed PID: $_" ) for @pids; # this function may look excessive, but hopefully will be very useful # in identifying common problems sub fetch { my $family = shift; my $hostname = get_localhost($family); my $port = $PORT; my $message = join "", map { "$_\015\012" } @_; my $timeout = 5; my $response; my $proto = getprotobyname('tcp') || die "getprotobyname: $!"; my $socktype = SOCK_STREAM; eval { local $SIG{ALRM} = sub { die "early exit - SIGALRM caught" }; alarm $timeout*2; #twice longer than timeout used later by select() my $paddr; my ($err, @res) = Socket::getaddrinfo($hostname, $port, { family => $family, socktype => $socktype, protocol => $proto }); die "getaddrinfo: $err operating on [$hostname] [$port] [$family] [$socktype] [$proto]" if ($err); while ($a = shift(@res)) { next unless ($family == $a->{'family'}); next unless ($proto == $a->{'protocol'}); next unless ($socktype == $a->{'socktype'}); $paddr = $a->{'addr'}; last } socket(SOCK, $family, $socktype, $proto) || die "socket: $!"; connect(SOCK, $paddr) || die "connect: $!"; (send SOCK, $message, 0) || die "send: $!"; my $rvec = ''; vec($rvec, fileno(SOCK), 1) = 1; die "vec(): $!" unless $rvec; $response = ''; for (;;) { my $r = select($rvec, undef, undef, $timeout); die "select: timeout - no data to read from server" unless ($r > 0); my $l = sysread(SOCK, $response, 1024, length($response)); die "sysread: $!" unless defined($l); last if ($l == 0); } $response =~ s/\015\012/\n/g; (close SOCK) || die "close(): $!"; alarm 0; }; if ($@) { return "[ERROR] $@"; } else { return $response; } } sub run_server_tests { my $class = shift; my $fam = shift; my $s = $class->new($PORT, $fam); is($s->family(), $fam, 'constructor set family properly'); is($s->port(),$PORT,"Constructor set port correctly"); my $localhost = get_localhost($fam); $s->host($localhost); # otherwise we bind to * which doesn't work on all systems my $pid=$s->background(); select(undef,undef,undef,0.2); # wait a sec like($pid, '/^-?\d+$/', 'pid is numeric'); SKIP: { skip "No localhost defined for $fam", 1 unless defined $localhost; my $content=fetch($fam, "GET / HTTP/1.1", ""); like($content, '/Congratulations/', "Returns a page"); } push @pids, $pid; } { my %localhost; sub get_localhost { my $family = shift; return $localhost{$family} if $localhost{$family}; if ($family == AF_INET) { $localhost{$family} = gethostbyaddr(INADDR_LOOPBACK,$family); } else { $localhost{$family} = gethostbyaddr(Socket::IN6ADDR_LOOPBACK,$family); } return $localhost{$family}; } } HTTP-Server-Simple-0.52/t/02pod.t000644 000765 000024 00000000243 12630404553 017056 0ustar00jbrandtstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); HTTP-Server-Simple-0.52/t/03podcoverage.t000644 000765 000024 00000000352 12630404553 020574 0ustar00jbrandtstaff000000 000000 #!/usr/bin/perl -w use strict; use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; all_pod_coverage_ok({ also_private => [ '/^[A-Z_]+$/' ], }); HTTP-Server-Simple-0.52/t/04cgi.t000644 000765 000024 00000014600 12630404553 017042 0ustar00jbrandtstaff000000 000000 # -*- perl -*- use Test::More; use Socket; use strict; my $PORT = 40000 + int(rand(10000)); my $host = gethostbyaddr(inet_aton('localhost'), AF_INET); my %methods=( url => "url: http://$host:".$PORT, path_info => 'path_info: /cgitest/path_info', server_name => "server_name: $host", server_port => 'server_port: '.$PORT, server_software => 'server_software: HTTP::Server::Simple/\d+.\d+', request_method => 'request_method: GET', raw_cookie => undef, # do not test ); my %envvars=( SERVER_URL => "SERVER_URL: http://$host:".$PORT.'/', SERVER_PORT => 'SERVER_PORT: '.$PORT, REQUEST_METHOD => 'REQUEST_METHOD: GET', REQUEST_URI => 'REQUEST_URI: /cgitest/REQUEST_URI', SERVER_PROTOCOL => 'SERVER_PROTOCOL: HTTP/1.1', SERVER_NAME => "SERVER_NAME: $host", SERVER_SOFTWARE => 'SERVER_SOFTWARE: HTTP::Server::Simple/\d+.\d+', REMOTE_ADDR => 'REMOTE_ADDR: 127.0.0.1', QUERY_STRING => 'QUERY_STRING: ', PATH_INFO => 'PATH_INFO: /cgitest/PATH_INFO', ); if ($^O eq 'freebsd' && `sysctl -n security.jail.jailed` == 1) { delete @methods{qw(url server_name)}; delete @envvars{qw(SERVER_URL SERVER_NAME REMOTE_ADDR)}; plan tests => 47; } else { plan tests => 62; } { my $server=CGIServer->new($PORT); is($server->port(),$PORT,'Constructor set port correctly'); sleep(3); # wait just a moment my $pid=$server->background; like($pid, '/^-?\d+$/', 'pid is numeric'); select(undef,undef,undef,0.2); # wait a sec my @message_tests = ( [["GET / HTTP/1.1",""], '/NOFILE/', '[GET] no file'], [["POST / HTTP/1.1","Content-Length: 0",""], '/NOFILE/', '[POST] no file'], [["HEAD / HTTP/1.1",""], '/NOFILE/', '[HEAD] no file'], [["PUT / HTTP/1.1","Content-Length: 0",""], '/NOFILE/', '[PUT] no file'], [["DELETE / HTTP/1.1",""], '/NOFILE/', '[DELETE] no file'], [["PATCH / HTTP/1.1","Content-Length: 0",""], '/NOFILE/', '[PATCH] no file'], [["OPTIONS / HTTP/1.1","Content-Length: 0",""], '/NOFILE/', '[OPTIONS] no file'], ); foreach my $message_test (@message_tests) { my ($message, $expected, $description) = @$message_test; like(fetch(@$message), $expected, $description); select(undef,undef,undef,0.2); # wait a sec } foreach my $method (keys(%methods)) { next unless defined $methods{$method}; like( fetch("GET /cgitest/$method HTTP/1.1",""), "/$methods{$method}/", "method - $method" ); select(undef,undef,undef,0.2); # wait a sec } foreach my $envvar (keys(%envvars)) { like( fetch("GET /cgitest/$envvar HTTP/1.1",""), "/$envvars{$envvar}/", "Environment - $envvar" ); select(undef,undef,undef,0.2); # wait a sec } # extra tests for HTTP/1.1 absolute URLs foreach my $verb ('GET', 'HEAD') { foreach my $method (keys(%methods)) { next unless defined $methods{$method}; my $method_value = $methods{$method}; $method_value =~ s/\bGET\b/$verb/; like( fetch("$verb http://localhost/cgitest/$method HTTP/1.1",""), "/$method_value/", "method (absolute URL) - $method" ); select(undef,undef,undef,0.2); # wait a sec } foreach my $envvar (keys(%envvars)) { (my $envvar_value = $envvars{$envvar}); $envvar_value =~ s/\bGET\b/$verb/; like( fetch("$verb http://localhost/cgitest/$envvar HTTP/1.1",""), "/$envvar_value/", "Environment (absolute URL) - $envvar" ); select(undef,undef,undef,0.2); # wait a sec } } like( fetch("GET /cgitest/REQUEST_URI?foo%3Fbar HTTP/1.0",""), qr/foo%3Fbar/, "Didn't decode already" ); like( fetch("GET /cgitest/foo%2Fbar/PATH_INFO HTTP/1.0",""), qr|foo/bar|, "Did decode already" ); like( fetch("GET /cgitest/raw_cookie HTTP/1.0","Cookie: foo=bar",""), qr|foo=bar|, "uses HTTP_COOKIE", ); like( fetch("GET /cgitest/raw_cookie HTTP/1.0", "Cookie: foo=bar\r\nCookie: baz=qux",""), qr|foo=bar[;,] baz=qux|, "combines multiple cookies into HTTP_COOKIE" ); is(kill(9,$pid),1,'Signaled 1 process successfully'); wait or die "counldn't wait for sub-process completion"; } sub fetch { my $hostname = "localhost"; my $port = $PORT; my $message = join "", map { "$_\015\012" } @_; my $timeout = 5; my $response; eval { local $SIG{ALRM} = sub { die "early exit - SIGALRM caught" }; alarm $timeout*2; #twice longer than timeout used later by select() my $iaddr = inet_aton($hostname) || die "inet_aton: $!"; my $paddr = sockaddr_in($port, $iaddr) || die "sockaddr_in: $!"; my $proto = getprotobyname('tcp') || die "getprotobyname: $!"; socket(SOCK, PF_INET, SOCK_STREAM, $proto) || die "socket: $!"; connect(SOCK, $paddr) || die "connect: $!"; (send SOCK, $message, 0) || die "send: $!"; my $rvec = ''; vec($rvec, fileno(SOCK), 1) = 1; die "vec(): $!" unless $rvec; $response = ''; for (;;) { my $r = select($rvec, undef, undef, $timeout); die "select: timeout - no data to read from server" unless ($r > 0); my $l = sysread(SOCK, $response, 1024, length($response)); die "sysread: $!" unless defined($l); last if ($l == 0); } $response =~ s/\015\012/\n/g; (close SOCK) || die "close(): $!"; alarm 0; }; if ($@) { return "[ERROR] $@"; } else { return $response; } } { package CGIServer; use base qw(HTTP::Server::Simple::CGI); sub handle_request { my $self=shift; my $cgi=shift; my $file=(split('/',$cgi->path_info))[-1]||'NOFILE'; $file=~s/\s+//g; $file||='NOFILE'; print "HTTP/1.0 200 OK\r\n"; # probably OK by now print "Content-Type: text/html\r\nContent-Length: "; my $response; if(exists $methods{$file}) { $response = "$file: ".$cgi->$file(); } elsif($envvars{$file}) { $response="$file: $ENV{$file}"; } else { $response=$file; } print length($response), "\r\n\r\n", $response; } } HTTP-Server-Simple-0.52/lib/HTTP/000755 000765 000024 00000000000 13067537375 017046 5ustar00jbrandtstaff000000 000000 HTTP-Server-Simple-0.52/lib/HTTP/Server/000755 000765 000024 00000000000 13067537375 020314 5ustar00jbrandtstaff000000 000000 HTTP-Server-Simple-0.52/lib/HTTP/Server/Simple/000755 000765 000024 00000000000 13067537375 021545 5ustar00jbrandtstaff000000 000000 HTTP-Server-Simple-0.52/lib/HTTP/Server/Simple.pm000644 000765 000024 00000052104 13067536345 022101 0ustar00jbrandtstaff000000 000000 use strict; use warnings; package HTTP::Server::Simple; use FileHandle; use Socket; use Carp; use vars qw($VERSION $bad_request_doc); $VERSION = '0.52'; =head1 NAME HTTP::Server::Simple - Lightweight HTTP server =head1 SYNOPSIS use warnings; use strict; use HTTP::Server::Simple; my $server = HTTP::Server::Simple->new(); $server->run(); However, normally you will sub-class the HTTP::Server::Simple::CGI module (see L); package Your::Web::Server; use base qw(HTTP::Server::Simple::CGI); sub handle_request { my ($self, $cgi) = @_; #... do something, print output to default # selected filehandle... } 1; =head1 DESCRIPTION This is a simple standalone HTTP server. By default, it doesn't thread or fork. It does, however, act as a simple frontend which can be used to build a standalone web-based application or turn a CGI into one. It is possible to use L classes to create forking, pre-forking, and other types of more complicated servers; see L. By default, the server traps a few signals: =over =item HUP When you C the server, it lets the current request finish being processed, then uses the C method to re-exec itself. Please note that in order to provide restart-on-SIGHUP, HTTP::Server::Simple sets a SIGHUP handler during initialisation. If your request handling code forks you need to make sure you reset this or unexpected things will happen if somebody sends a HUP to all running processes spawned by your app (e.g. by "kill -HUP