Test-HTTP-LocalServer-0.76/0000755000175000017500000000000014571142462014733 5ustar corioncorionTest-HTTP-LocalServer-0.76/MANIFEST.SKIP0000644000175000017500000000042114571142460016624 0ustar corioncorion^\.appveyor.yml$ .cvsignore$ .git/ ^.lwpcookies ^.prove ^.releaserc ^.travis.yml ^blib/ ^Test-HTTP-LocalServer-.*$ CVS/ ^pm_to_blib .tar.gz$ .old$ ^Makefile$ ^cvstest$ ^blibdirs$ .bak$ ^cover_db/ ^db/ ^firefox-versions/ ^ppd/ t/70-real-status-timeout.t ^MYMETA.* ^.*\.log$ Test-HTTP-LocalServer-0.76/Makefile.PL0000644000175000017500000001723414571142460016712 0ustar corioncorion# -*- mode: perl; c-basic-offset: 4; indent-tabs-mode: nil; -*- use strict; use ExtUtils::MakeMaker qw(WriteMakefile); # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. # Normalize version strings like 6.30_02 to 6.3002, # so that we can do numerical comparisons on it. my $eumm_version = $ExtUtils::MakeMaker::VERSION; $eumm_version =~ s/_//; my $module = 'Test::HTTP::LocalServer'; (my $main_file = "lib/$module.pm" ) =~ s!::!/!g; (my $distbase = $module) =~ s!::!-!g; my $distlink = $distbase; my @tests = map { glob $_ } 't/*.t', 't/*/*.t'; my %module = ( MIN_PERL_VERSION => '5.008', NAME => $module, AUTHOR => q{Max Maischein }, VERSION_FROM => $main_file, ABSTRACT_FROM => $main_file, META_MERGE => { "meta-spec" => { version => 2 }, resources => { repository => { web => "https://github.com/Corion/$distlink", url => "git://github.com/Corion/$distlink.git", type => 'git', }, bugtracker => { web => "https://github.com/Corion/$distbase/issues", # mailto => 'meta-bugs@example.com', }, license => "https://dev.perl.org/licenses/", }, dynamic_config => 0, # we promise to keep META.* up-to-date x_static_install => 0, }, 'LICENSE'=> 'perl', PL_FILES => {}, BUILD_REQUIRES => { # Fairly long in core 'File::Path' => 0, 'File::Copy' => 0, 'File::Find' => 0, 'File::Basename' => 0, 'ExtUtils::MakeMaker' => 0, }, PREREQ_PM => { 'Carp' => 0, 'Getopt::Long' => 0, 'File::Spec' => 0, 'File::Temp' => 0, 'Cwd' => 0, 'File::Basename' => 0, 'HTTP::Response' => 0, 'HTTP::Daemon' => 6.05, 'HTTP::Tiny' => 0, 'IO::Socket::INET' => 0, # For port probing 'CGI' => 0, 'HTTP::Request::AsCGI' => 0, 'Socket' => 0, # for detecting 127.0.0.1 vs [::1] 'IO::Socket::IP' => 0.25, # for handling IPv6-only localhost 'URI' => 0, 'URI::URL' => 0, 'Time::HiRes' => 0, }, TEST_REQUIRES => { 'Test::More' => 0, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => "$distbase-*" }, test => { TESTS => join( ' ', @tests ) }, ); # This is so that we can do # require 'Makefile.PL' # and then call get_module_info sub get_module_info { %module } if( ! caller ) { # I should maybe use something like Shipwright... regen_README($main_file); regen_EXAMPLES() if -d 'examples'; WriteMakefile1(get_module_info); }; 1; sub WriteMakefile1 { #Written by Alexandr Ciornii, version 0.21. Added by eumm-upgrade. my %params=@_; my $eumm_version=$ExtUtils::MakeMaker::VERSION; $eumm_version=eval $eumm_version; die "EXTRA_META is deprecated" if exists $params{EXTRA_META}; die "License not specified" if not exists $params{LICENSE}; if ($params{BUILD_REQUIRES} and $eumm_version < 6.5503) { #EUMM 6.5502 has problems with BUILD_REQUIRES $params{PREREQ_PM}={ %{$params{PREREQ_PM} || {}} , %{$params{BUILD_REQUIRES}} }; delete $params{BUILD_REQUIRES}; } if ($params{TEST_REQUIRES} and $eumm_version < 6.64) { $params{PREREQ_PM}={ %{$params{PREREQ_PM} || {}} , %{$params{TEST_REQUIRES}} }; delete $params{TEST_REQUIRES}; } delete $params{CONFIGURE_REQUIRES} if $eumm_version < 6.52; delete $params{MIN_PERL_VERSION} if $eumm_version < 6.48; delete $params{META_MERGE} if $eumm_version < 6.46; delete $params{META_ADD} if $eumm_version < 6.46; delete $params{LICENSE} if $eumm_version < 6.31; delete $params{AUTHOR} if $] < 5.005; delete $params{ABSTRACT_FROM} if $] < 5.005; delete $params{BINARY_LOCATION} if $] < 5.005; WriteMakefile(%params); } sub regen_README { # README is the short version that just tells people what this is # and how to install it eval { # Get description my $readme = join "\n", pod_section($_[0], 'NAME', 'no heading' ), pod_section($_[0], 'DESCRIPTION' ), <new(); # Read POD from Module.pm and write to README $parser->parse_from_file($_[0]); my $readme_mkdn = <as_markdown; [![Travis Build Status](https://travis-ci.org/Corion/$distlink.svg?branch=master)](https://travis-ci.org/Corion/$distlink) [![AppVeyor Build Status](https://ci.appveyor.com/api/projects/status/github/Corion/$distlink?branch=master&svg=true)](https://ci.appveyor.com/project/Corion/$distlink) STATUS update_file( 'README.mkdn', $readme_mkdn ); }; } sub pod_section { my( $filename, $section, $remove_heading ) = @_; open my $fh, '<', $filename or die "Couldn't read '$filename': $!"; my @section = grep { /^=head1\s+$section/.../^=/ } <$fh>; # Trim the section if( @section ) { pop @section if $section[-1] =~ /^=/; shift @section if $remove_heading; pop @section while @section and $section[-1] =~ /^\s*$/; shift @section while @section and $section[0] =~ /^\s*$/; }; @section = map { $_ =~ s!^=\w+\s+!!; $_ } @section; return join "", @section; } sub regen_EXAMPLES { my $perl = $^X; if ($perl =~/\s/) { $perl = qq{"$perl"}; }; (my $example_file = $main_file) =~ s!\.pm$!/Examples.pm!; my $examples = `$perl -w examples/gen_examples_pod.pl`; if ($examples) { warn "(Re)Creating $example_file\n"; $examples =~ s/\r\n/\n/g; update_file( $example_file, $examples ); }; }; sub update_file { my( $filename, $new_content ) = @_; my $content; if( -f $filename ) { open my $fh, '<:raw:encoding(UTF-8)', $filename or die "Couldn't read '$filename': $!"; local $/; $content = <$fh>; }; if( $content ne $new_content ) { if( open my $fh, '>:raw:encoding(UTF-8)', $filename ) { print $fh $new_content; } else { warn "Couldn't (re)write '$filename': $!"; }; }; } Test-HTTP-LocalServer-0.76/t/0000755000175000017500000000000014571142462015176 5ustar corioncorionTest-HTTP-LocalServer-0.76/t/03-sticky-fields.t0000644000175000017500000000211314571142460020350 0ustar corioncorion#!perl -w use strict; use warnings; use Test::HTTP::LocalServer; use Time::HiRes; use HTTP::Tiny; use Test::More tests => 6; my $server = Test::HTTP::LocalServer->spawn( # debug => 1 ); my $pid = $server->{_pid}; my $res = kill 0, $pid; is $res, 1, "PID $pid is an existing process"; local @ENV{ qw[ HTTP_PROXY http_proxy HTTP_PROXY_ALL http_proxy_all HTTPS_PROXY https_proxy CGI_HTTP_PROXY ALL_PROXY all_proxy ] }; my $ua = HTTP::Tiny->new(); $res = $ua->get( $server->url ); ok $res->{success}, "Retrieve " . $server->url; $res = $ua->post_form( $server->url, [query => 'test1'] ); ok $res->{success}, "POST to " . $server->url; like $res->{content}, qr/\bname="query"\s+value="test1"/, "We have sticky form fields"; my @log = $server->get_log; cmp_ok 0+@log, '>', 0, "We have some lines in the log file"; $server->stop; my $timeout = time + 5; # just give it more time to be really sure while ( time < $timeout ) { sleep 0.1; $res = kill 0, $pid; last if defined $res and $res == 0; }; is $res, 0, "PID $pid doesn't exist anymore"; Test-HTTP-LocalServer-0.76/t/00-load.t0000644000175000017500000000055014571142460016515 0ustar corioncorion#!perl -T use strict; use warnings; use Test::More tests => 1; my $module; BEGIN { $module = "Test::HTTP::LocalServer"; require_ok( $module ); } diag( sprintf "Testing %s %s, Perl %s", $module, $module->VERSION, $] ); for (sort grep /\.pm\z/, keys %INC) { s/\.pm\z//; s!/!::!g; eval { diag(join(' ', $_, $_->VERSION || '')) }; } Test-HTTP-LocalServer-0.76/t/05-simplest.t0000644000175000017500000000031014571142460017435 0ustar corioncorion#!perl -w use strict; use warnings; use Test::HTTP::LocalServer; use Test::More tests => 1; my $server = Test::HTTP::LocalServer->spawn; ok "We'll finish in DESTROY"; # and ideally, $? is 0 still Test-HTTP-LocalServer-0.76/t/05-basic-auth.t0000644000175000017500000000234214571142460017624 0ustar corioncorion#!perl -w use strict; use warnings; use Test::HTTP::LocalServer; use HTTP::Tiny; use Test::More tests => 5; my $server = Test::HTTP::LocalServer->spawn( # debug => 1, ); local @ENV{ qw[ HTTP_PROXY http_proxy HTTP_PROXY_ALL http_proxy_all HTTPS_PROXY https_proxy CGI_HTTP_PROXY ALL_PROXY all_proxy ] }; my $pid = $server->{_pid}; my $res = kill 0, $pid; is $res, 1, "PID $pid is an existing process"; my $challenge_url = $server->basic_auth('foo','secret'); $res = HTTP::Tiny->new->get($challenge_url); is $res->{status}, 401, "We can get a basic auth challenge"; my $wrong_pw = URI->new( $challenge_url ); $wrong_pw->userinfo('foo:hunter2'); $res = HTTP::Tiny->new->get($wrong_pw); is $res->{status}, 401, "We get the challenge with a wrong user/password as well"; my $basic_url = URI->new( $challenge_url ); $basic_url->userinfo('foo:secret'); $res = HTTP::Tiny->new->get($basic_url); is $res->{status}, 200, "We pass once we supply the correct credentials"; $server->stop; my $timeout = time + 5; # just give it more time to be really sure while ( time < $timeout ) { sleep 0.1; $res = kill 0, $pid; last if defined $res and $res == 0; }; is $res, 0, "PID $pid doesn't exist anymore"; Test-HTTP-LocalServer-0.76/t/02-start-stop.t0000644000175000017500000000074114571142460017722 0ustar corioncorion#!perl -w use strict; use warnings; use Test::HTTP::LocalServer; use Test::More tests => 2; my $server = Test::HTTP::LocalServer->spawn; my $pid = $server->{_pid}; my $res = kill 0, $pid; is $res, 1, "PID $pid is an existing process"; $server->stop; my $timeout = time + 5; # just give it more time to be really sure while ( time < $timeout ) { sleep 0.1; $res = kill 0, $pid; last if defined $res and $res == 0; }; is $res, 0, "PID $pid doesn't exist anymore"; Test-HTTP-LocalServer-0.76/t/01-start.t0000644000175000017500000000166414571142460016743 0ustar corioncorion#!perl -w use strict; use warnings; use Test::HTTP::LocalServer; use HTTP::Tiny; use Test::More tests => 4; sub get { my( $url ) = @_; local @ENV{ qw[ HTTP_PROXY http_proxy HTTP_PROXY_ALL http_proxy_all HTTPS_PROXY https_proxy CGI_HTTP_PROXY ALL_PROXY all_proxy ] }; HTTP::Tiny->new->get( $url )->{content}; } my $server = Test::HTTP::LocalServer->spawn( # debug => 1 ); my $pid = $server->{_pid}; my $res = kill 0, $pid; is $res, 1, "PID $pid is an existing process"; ok get $server->url, "Retrieve " . $server->url; my @log = $server->get_log; cmp_ok 0+@log, '>', 0, "We have some lines in the log file"; $server->stop; my $timeout = time + 5; # just give it more time to be really sure while ( time < $timeout ) { sleep 0.1; $res = kill 0, $pid; last if defined $res and $res == 0; }; is $res, 0, "PID $pid doesn't exist anymore"; Test-HTTP-LocalServer-0.76/t/04-server-name.t0000644000175000017500000000134214571142460020026 0ustar corioncorion#!perl -w use strict; use warnings; use Test::HTTP::LocalServer; use Test::More tests => 3; my $server = Test::HTTP::LocalServer->spawn; my $pid = $server->{_pid}; my $res = kill 0, $pid; is $res, 1, "PID $pid is an existing process"; my $real_url = $server->url; $server->server_url->host('example.com'); like $server->url, qr!^http://example\.com:!, "We can override the hostname"; # Except that this doesn't help us anyhow, but still ... $server->server_url->host( $real_url->host ); $server->stop; my $timeout = time + 5; # just give it more time to be really sure while ( time < $timeout ) { sleep 0.1; $res = kill 0, $pid; last if defined $res and $res == 0; }; is $res, 0, "PID $pid doesn't exist anymore"; Test-HTTP-LocalServer-0.76/t/06-exitcode.t0000644000175000017500000000060614571142460017412 0ustar corioncorion#!perl -w use strict; use warnings; use Test::HTTP::LocalServer; use Test::More tests => 3; { my $server = Test::HTTP::LocalServer->spawn; } is $?, 0, "We have a zero exit code"; $? = 1; is $?, 1, "We set up the exit code correctly"; { note $?; my $server = Test::HTTP::LocalServer->spawn; note $?; } note $?; is $?, 1, "We leave the exit code untouched in the destructor"; Test-HTTP-LocalServer-0.76/README.mkdn0000644000175000017500000001500514571142460016542 0ustar corioncorion [![Travis Build Status](https://travis-ci.org/Corion/Test-HTTP-LocalServer.svg?branch=master)](https://travis-ci.org/Corion/Test-HTTP-LocalServer) [![AppVeyor Build Status](https://ci.appveyor.com/api/projects/status/github/Corion/Test-HTTP-LocalServer?branch=master&svg=true)](https://ci.appveyor.com/project/Corion/Test-HTTP-LocalServer) # NAME Test::HTTP::LocalServer - spawn a local HTTP server for testing # SYNOPSIS use HTTP::Tiny; my $server = Test::HTTP::LocalServer->spawn( request_pause => 1, # wait one second before accepting the next request ); my $res = HTTP::Tiny->new->get( $server->url ); print $res->{content}; $server->stop; # DESCRIPTION This module implements a tiny web server suitable for running "live" tests of HTTP clients against it. It also takes care of cleaning `%ENV` from settings that influence the use of a local proxy etc. Use this web server if you write an HTTP client and want to exercise its behaviour in your test suite without talking to the outside world. # METHODS ## `Test::HTTP::LocalServer->spawn %ARGS` my $server = Test::HTTP::LocalServer->spawn; This spawns a new HTTP server. The server will stay running until $server->stop is called. Ideally, you explicitly call `->stop` or use undef $server before the main program ends so that the program exit code reflects the real exit code and not the chlid exit code. Valid arguments are : - `html =>` scalar containing the page to be served If this is not specified, an informative default page will be used. - `request_pause =>` number of seconds to sleep before accepting the next request If your system is slow or needs to wait some time before a socket connection is ready again, use this parameter to make the server wait a bit before handling the next connection. - `file =>` filename containing the page to be served - `debug => 1` to make the spawned server output debug information - `eval =>` string that will get evaluated per request in the server Try to avoid characters that are special to the shell, especially quotes. A good idea for a slow server would be eval => sleep+10 All served HTML will have the first %s replaced by the current location. The following entries will be removed from `%ENV` when making a request: HTTP_PROXY http_proxy HTTP_PROXY_ALL http_proxy_all HTTPS_PROXY https_proxy CGI_HTTP_PROXY ALL_PROXY all_proxy ## `$server->port` This returns the port of the current server. As new instances will most likely run under a different port, this is convenient if you need to compare results from two runs. ## `$server->url` This returns the [URI](https://metacpan.org/pod/URI) where you can contact the server. This url is valid until the `$server` goes out of scope or you call $server->stop; The returned object is a copy that you can modify at your leisure. ## `$server->server_url` This returns the [URI](https://metacpan.org/pod/URI) object of the server URL. Use ["$server->url"](#server-url) instead. Use this object if you want to modify the hostname or other properties of the server object. Consider this basically an emergency accessor. In about every case, using `->url()` does what you want. ## `$server->stop` This stops the server process by requesting a special url. ## `$server->kill` This kills the server process via `kill`. The log cannot be retrieved then. ## `$server->get_log` This returns the output of the server process. This output will be a list of all requests made to the server concatenated together as a string. ## `$server->local` my $url = $server->local('foo.html'); # file:///.../foo.html Returns an URL for a local file which will be read and served by the webserver. The filename must be a relative filename relative to the location of the current program. # URLs implemented by the server ## arbitrary content `$server->content($html)` $server->content(<<'HTML'); HTML The URL will contain the HTML as supplied. This is convenient for supplying Javascript or special URL to your user agent. ## download `$server->download($name)` This URL will send a file with a `Content-Disposition` header and indicate the suggested filename as passed in. ## 302 redirect `$server->redirect($target)` This URL will issue a redirect to `$target`. No special care is taken towards URL-decoding `$target` as not to complicate the server code. You need to be wary about issuing requests with escaped URL parameters. ## 401 basic authentication challenge `$server->basic_auth($user, $pass)` This URL will issue a 401 basic authentication challenge. The expected user and password are encoded in the URL. my $challenge_url = $server->basic_auth('foo','secret'); my $wrong_pw = URI->new( $challenge_url ); $wrong_pw->userinfo('foo:hunter2'); $res = HTTP::Tiny->new->get($wrong_pw); is $res->{status}, 401, "We get the challenge with a wrong user/password"; ## 404 error `$server->error_notfound($target)` This URL will response with status code 404. ## Timeout `$server->error_timeout($seconds)` This URL will send a 599 error after `$seconds` seconds. ## Timeout+close `$server->error_close($seconds)` This URL will send nothing and close the connection after `$seconds` seconds. ## Error in response content `$server->error_after_headers` This URL will send headers for a successful response but will close the socket with an error after 2 blocks of 16 spaces have been sent. ## Chunked response `$server->chunked` This URL will return 5 blocks of 16 spaces at a rate of one block per second in a chunked response. ## Surprisingly large bzip2 encoded response `$server->bzip2` This URL will return a short HTTP response that expands to 16M body. ## Surprisingly large gzip encoded response `$server->gzip` This URL will return a short HTTP response that expands to 16M body. ## Other URLs All other URLs will echo back the cookies and query parameters. # EXPORT None by default. # COPYRIGHT AND LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Copyright (C) 2003-2024 Max Maischein # AUTHOR Max Maischein, Please contact me if you find bugs or otherwise improve the module. More tests are also very welcome ! # SEE ALSO [WWW::Mechanize](https://metacpan.org/pod/WWW%3A%3AMechanize),[WWW::Mechanize::Shell](https://metacpan.org/pod/WWW%3A%3AMechanize%3A%3AShell),[WWW::Mechanize::Firefox](https://metacpan.org/pod/WWW%3A%3AMechanize%3A%3AFirefox) Test-HTTP-LocalServer-0.76/.gitignore0000644000175000017500000000022114571142460016714 0ustar corioncorionMakefile Makefile.old *.tar.gz *.tar *.bak pm_to_blib blib/ Test-HTTP-LocalServer-* Test-HTTP-LocalServer-*/ .releaserc cover_db MYMETA.* .prove Test-HTTP-LocalServer-0.76/META.yml0000644000175000017500000000223714571142462016210 0ustar corioncorion--- abstract: 'spawn a local HTTP server for testing' author: - 'Max Maischein ' build_requires: ExtUtils::MakeMaker: '0' File::Basename: '0' File::Copy: '0' File::Find: '0' File::Path: '0' Test::More: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 generated_by: 'ExtUtils::MakeMaker version 7.64, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Test-HTTP-LocalServer no_index: directory: - t - inc requires: CGI: '0' Carp: '0' Cwd: '0' File::Basename: '0' File::Spec: '0' File::Temp: '0' Getopt::Long: '0' HTTP::Daemon: '6.05' HTTP::Request::AsCGI: '0' HTTP::Response: '0' HTTP::Tiny: '0' IO::Socket::INET: '0' IO::Socket::IP: '0.25' Socket: '0' Time::HiRes: '0' URI: '0' URI::URL: '0' perl: '5.008' resources: bugtracker: https://github.com/Corion/Test-HTTP-LocalServer/issues license: https://dev.perl.org/licenses/ repository: git://github.com/Corion/Test-HTTP-LocalServer.git version: '0.76' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' x_static_install: 0 Test-HTTP-LocalServer-0.76/lib/0000755000175000017500000000000014571142462015501 5ustar corioncorionTest-HTTP-LocalServer-0.76/lib/Test/0000755000175000017500000000000014571142462016420 5ustar corioncorionTest-HTTP-LocalServer-0.76/lib/Test/HTTP/0000755000175000017500000000000014571142462017177 5ustar corioncorionTest-HTTP-LocalServer-0.76/lib/Test/HTTP/log-server0000644000175000017500000003545614571142460021222 0ustar corioncorion# Thanks to merlyn for nudging me and giving me this snippet! use strict; use HTTP::Daemon 6.05; use URI; use CGI; use HTTP::Request::AsCGI; use Getopt::Long; use Socket(); use Time::HiRes 'sleep'; our $VERSION = '0.74'; $|++; GetOptions( 'e=s' => \my $expression, 'f=s' => \my $url_filename, 's=s' => \my $request_pause, ); if( ! defined $request_pause ) { $request_pause = 1; } # HTTP::Daemon(IO::Socket::IP) sets $@ in case of error my $d = HTTP::Daemon->new or die "Couldn't create HTTP::Daemon: $@"; my $url = URI->new( $d->url ); if( $d->sockdomain == Socket::AF_INET ) { $url->host('127.0.0.1'); } elsif ($d->sockdomain == Socket::AF_INET6 ) { $url->host('[::1]'); } else { die "Unexpected sockdomain: " . $d->sockdomain; }; { my $fh; if( $url_filename ) { open $fh, '>', $url_filename or die "Couldn't write URL to tempfile '$url_filename': $!"; } else { $fh = \*STDOUT; }; print {$fh} "$url\n"; close $fh unless $url_filename; } my ($filename,$logfile) = @ARGV[0,1]; if ($filename) { open DATA, "< $filename" or die "Couldn't read page '$filename' : $!\n"; }; #open LOG, ">", $logfile # or die "Couldn't create logfile '$logfile' : $!\n"; my $log; my $body = join "", ; sub debug($) { my $message = $_[0]; $message =~ s!\n!\n#SERVER:!g; warn "#SERVER: $message" if $ENV{TEST_HTTP_VERBOSE}; }; my $multi_param = eval { CGI->can('multi_param') } ? 'multi_param' : 'param'; sub respond_200 { my( $location, $r ) = @_; my $context = HTTP::Request::AsCGI->new( $r )->setup; my $q = CGI->new(); # Make sticky form fields my ($filename, $filetype, $filecontent, $query,$botcheck_query,$query2,$session,%cat); $query = defined $q->param('query') ? $q->param('query') : "(empty)"; $botcheck_query = defined $q->param('botcheck_query') ? $q->param('botcheck_query') : "(empty)"; $query2 = defined $q->param('query2') ? $q->param('query2') : "(empty)"; $session = defined $q->param('session') ? $q->param('session') : 1; my @cats = $q->$multi_param('cat'); %cat = map { $_ => 1 } ( @cats ? @cats : qw( cat_foo cat_bar )); my @categories = map { $cat{$_} ? "checked" : "" } qw( cat_foo cat_bar cat_baz ); my $headers = CGI::escapeHTML( $r->headers->as_string ); my $rbody = sprintf $body,$headers, $location, $filename, $filetype, $filecontent, $session,$query,$botcheck_query,$query2,@categories, ; my $res = HTTP::Response->new(200, "OK", [ 'Set-Cookie' => $q->cookie(-name => 'log-server-httponly',-value=>'supersecret', -discard => 1, -httponly=>1), 'Set-Cookie' => $q->cookie(-name => 'log-server',-value=>'shazam2', -discard=>1,), 'Cache-Control' => 'no-cache', 'Pragma' => 'no-cache', 'Max-Age' => 0, 'Connection' => 'close', 'Content-Length' => length($rbody), ], $rbody); $res->content_type('text/html; charset=ISO-8859-1'); debug "Request " . ($r->uri->path || "/"); $res } SERVERLOOP: { my $quitserver; while (my $c = $d->accept) { debug "New connection"; while (my $r = $c->get_request) { debug "Request:\n" . $r->as_string; my $location = ($r->uri->path || "/"); my ($link1,$link2) = ('',''); if ($location =~ m!^/link/([^/]+)/(.*)$!) { ($link1,$link2) = ($1,$2); }; my $res; if ($location eq '/get_server_log') { $res = HTTP::Response->new(200, "OK", undef, $log); $log = ''; } elsif ( $location eq '/quit_server') { debug "Quitting"; $res = HTTP::Response->new(200, "OK", [Connection => 'close'], "quit"); $quitserver = 1; } else { eval $expression if $expression; warn "eval: $@" if $@; $log .= "Request:\n" . $r->as_string . "\n"; if ($location =~ m!^/redirect/(.*)$!) { $res = HTTP::Response->new(302); $res->header('location', $url . $1); } elsif ($location =~ m!^/local/(.*)$!) { my $rbody= do { open my $fh, '<', $1; binmode $fh; local $/; <$fh> }; $res = HTTP::Response->new(200, "OK", [ 'Cache-Control' => 'no-cache', 'Pragma' => 'no-cache', 'Max-Age' => 0, 'Connection' => 'close', 'Content-Length' => length($rbody), ], $rbody); } elsif ($location =~ m!^/download/([\w.-]+)$!) { my $rbody= do { open my $fh, '<', $0; binmode $fh; local $/; <$fh> }; $res = HTTP::Response->new(200, "OK", [ 'Cache-Control' => 'no-cache', 'Pragma' => 'no-cache', 'Max-Age' => 0, 'Connection' => 'close', 'Content-Length' => length($rbody), 'Content-Disposition' => qq{attachment; filename=$1;}, ], $rbody); } elsif ($location =~ m!^/error/notfound/(.*)$! or $location =~ m!^/favicon.ico!) { $res = HTTP::Response->new(404, "Not found", [Connection => 'close']); } elsif ($location =~ m!^/error/timeout/(\d+)$!) { sleep $1; $res = HTTP::Response->new(599, "Timeout reached", [Connection => 'close']); } elsif ($location =~ m!^/error/close/(\d+)$!) { sleep $1; $res = undef; } elsif ( $location =~ m!^/chunks!) { my $count = 5; $res = HTTP::Response->new(200, "OK", undef, sub { sleep 1; my $buf = 'x' x 16; return $buf if $count-- > 0; return undef; # done }); } elsif ($location =~ m!^/error/after_headers$!) { my $count = 2; $res = HTTP::Response->new(200, "OK", undef, sub { sleep 1; my $buf = 'x' x 16; return $buf if $count-- > 0; die "Planned error after headers"; }); } elsif ($location =~ m!^/large/bzip/16M$!) { my $headers = HTTP::Headers->new( Content_Type => "application/xml", Content_Encoding => 'bzip2,bzip2,bzip2', # say my name three times ); # 16M bzip thrice-encoded, see gen-bzipbomb.pl $body = join "", "BZh11AY&SY\tPFN\0\0'\177\377\355\e\177v\363\267|\344?\226]pVbW\25\313|F", "]h0\30\303\305i\272CF9fS\260\0\271\b\32\32h\323\32414\304ddbh4\304h4\304z\231\6h", "#\32\2154\310\365=\4`\32 fQ\341O)\371Q\6L\0\230\0\t\200#L#\0\0\0\4\311\246&\203", "\0#\0\0\0\0\203&\322a11\240\0&\21\200\320\232`\1\0310\4\323\0#4\20d\300L\4d`\34", "\370I\21o\f\304\0\205b\344\365u\326\334O\301\0054}\306\274\215\246\240\351\247\240", "M\252\333Je)\25\217\231\230\00046\236)\4(R\301\370\363\371\350\277\b0\26\275\16&", "W\260\2\2151\272\177\301\366}\327b\213\374\t\264g~\245\203\225\220\2660,\226\213", "\247\246l\351\303\304\300\$z0Hg\272;\31\226B\244\266\376\301\364\355I~\222\273", "\226*S\"\3\263\360\200Iv\241}|\344\227q\1I\6\217I\30\302\2\261\207\224h\305\16\17", "\324\1779\1\247\\R{\335\$pM8cL\"\201\311 \374\364P\274\227p\237\300\320`\36pJ\264", "\21\277\305\334\221N\24\$\2T\21\223\200" ; $res = HTTP::Response->new(200, "OK", $headers, $body); } elsif ($location =~ m!^/large/gzip/16M$!) { my $headers = HTTP::Headers->new( Content_Type => "application/xml", Content_Encoding => 'gzip,gzip,gzip', # say my name three times ); # 16M bzip thrice-encoded, see gen-gzipbomb.pl $body = join "", "\37\213\b\0\0\0\0\0\0\377\223\357\346`\0\203\377o/l\344mr`h}h\235\321\341", "- T^\300^\225-\276p\307\221Km\242>/b\31\237%\260>\346\220S7\2760\243&\376\363", "\277_[\373\325\336|\252\356\334\230#\265\177\275\1771\27\304\f\206\3\363\275_", "\357]Ww\361\351\355\247o\370\241b\26\aj\336\316?\34\242\224\27a\347\24\270", "\336\236\201\1\0!\203w\217s\0\0\0", ; $res = HTTP::Response->new(200, "OK", $headers, $body); } elsif ($location =~ m!^/content/(.*)$!) { my $headers = HTTP::Headers->new( Content_Type => "text/html", ); (my $html = $1) =~ s!%([a-fA-F0-9]{2})!chr(hex($1))!ge; $body = join "", "", "$html", "", ; $res = HTTP::Response->new(200, "OK", $headers, $body); } elsif ($location =~ m!^/basic_auth/([^/]+)/([^/]+)$!) { my ($user, $pass) = $r->authorization_basic; my( $ex_user, $ex_pass ) = ($1,$2); if( $user eq $ex_user and $pass eq $ex_pass) { $res = respond_200( $location, $r ); } else { debug "# User : '$user' Password : '$pass'\n"; $res = HTTP::Response->new(401, "Auth Required", undef, "auth required ($user/$pass)"); $res->www_authenticate("Basic realm=\"testing realm\""); }; } else { $res = respond_200( $location, $r ); }; }; debug "Response:\n" . $res->as_string if $res; eval { $c->send_response($res) if $res; }; if (my $err = $@) { debug "Server raised error: $err"; if ($err !~ /^Planned error\b/) { warn $err; }; $c->close; }; if (! $res) { $c->close; }; last if $quitserver; } sleep $request_pause; undef($c); last SERVERLOOP if $quitserver; }; undef $d; }; END { debug "Server $$ stopped" }; # The below tag should stop the browser from requesting a favicon.ico, but we still see it... __DATA__ WWW::Mechanize::Firefox test page

Request headers

%s

Location: %s

Link /test Link /foo Link / /Link /Link in slashes/ Link foo1.save_log_server_test.tmp Link foo2.save_log_server_test.tmp Link foo3.save_log_server_test.tmp
Col1Col2Col3
A1A2A3
B1B2B3
C1C2C3

  Filename: %s
  Filetype: %s
  Content:  %s

Test-HTTP-LocalServer-0.76/lib/Test/HTTP/gzip-streamed.psgi0000644000175000017500000000222514571142460022635 0ustar corioncorion#!perl # Created by Hauke Daempfling 2018 use strict; use warnings; use IO::Compress::Gzip qw/$GzipError Z_PARTIAL_FLUSH/; our $VERSION = '0.67'; my $app = sub { my $env = shift; die "This app needs a server that supports psgi.streaming" unless $env->{'psgi.streaming'}; die "The client did not send the 'Accept-Encoding: gzip' header" unless defined $env->{HTTP_ACCEPT_ENCODING} && $env->{HTTP_ACCEPT_ENCODING} =~ /\bgzip\b/; # Note some browsers don't correctly support gzip correctly, # see e.g. https://metacpan.org/pod/Plack::Middleware::Deflater # but we're not checking that here (and we don't set the Vary header) return sub { my $respond = shift; my $zipped; my $z = IO::Compress::Gzip->new(\$zipped) or die "IO::Compress::Gzip: $GzipError"; my $w = $respond->([ 200, [ 'Content-Type' => 'text/plain; charset=ascii', 'Content-Encoding' => 'gzip', ] ]); for (1..10) { $z->print("Hello, it is ".gmtime." GMT\n"); $z->flush(Z_PARTIAL_FLUSH); $w->write($zipped) if defined $zipped; $zipped = undef; sleep 1; } $z->print("Goodbye!\n"); $z->close; $w->write($zipped) if defined $zipped; $w->close; }; }; Test-HTTP-LocalServer-0.76/lib/Test/HTTP/LocalServer.pm0000644000175000017500000003001114571142460021747 0ustar corioncorionpackage Test::HTTP::LocalServer; use strict; use 5.008; # We use "fancy" opening of lexical filehandle, see below use FindBin; use File::Spec; use File::Temp; use URI::URL qw(); use Carp qw(carp croak); use Cwd; use File::Basename; use Time::HiRes qw ( time sleep ); use HTTP::Tiny; use HTTP::Daemon 6.05; # Our log server needs this, but we load it here to find its version our $VERSION = '0.76'; =head1 NAME Test::HTTP::LocalServer - spawn a local HTTP server for testing =head1 SYNOPSIS use HTTP::Tiny; my $server = Test::HTTP::LocalServer->spawn( request_pause => 1, # wait one second before accepting the next request ); my $res = HTTP::Tiny->new->get( $server->url ); print $res->{content}; $server->stop; =head1 DESCRIPTION This module implements a tiny web server suitable for running "live" tests of HTTP clients against it. It also takes care of cleaning C<%ENV> from settings that influence the use of a local proxy etc. Use this web server if you write an HTTP client and want to exercise its behaviour in your test suite without talking to the outside world. =head1 METHODS =head2 Cspawn %ARGS> my $server = Test::HTTP::LocalServer->spawn; This spawns a new HTTP server. The server will stay running until $server->stop is called. Ideally, you explicitly call C<< ->stop >> or use undef $server before the main program ends so that the program exit code reflects the real exit code and not the chlid exit code. Valid arguments are : =over 4 =item * C<< html => >> scalar containing the page to be served If this is not specified, an informative default page will be used. =item * C<< request_pause => >> number of seconds to sleep before accepting the next request If your system is slow or needs to wait some time before a socket connection is ready again, use this parameter to make the server wait a bit before handling the next connection. =item * C<< file => >> filename containing the page to be served =item * C<< debug => 1 >> to make the spawned server output debug information =item * C<< eval => >> string that will get evaluated per request in the server Try to avoid characters that are special to the shell, especially quotes. A good idea for a slow server would be eval => sleep+10 =back All served HTML will have the first %s replaced by the current location. The following entries will be removed from C<%ENV> when making a request: HTTP_PROXY http_proxy HTTP_PROXY_ALL http_proxy_all HTTPS_PROXY https_proxy CGI_HTTP_PROXY ALL_PROXY all_proxy =cut sub get { my( $url ) = @_; local *ENV; delete @ENV{qw( HTTP_PROXY http_proxy CGI_HTTP_PROXY HTTPS_PROXY https_proxy HTTP_PROXY_ALL http_proxy_all ALL_PROXY all_proxy )}; my $response = HTTP::Tiny->new->get($url); $response->{content} } sub spawn_child_win32 { my ( $self, @cmd ) = @_; local $?; system(1, @cmd) } sub spawn_child_posix { my ( $self, @cmd ) = @_; require POSIX; POSIX->import("setsid"); # daemonize defined(my $pid = fork()) || die "can't fork: $!"; if( $pid ) { # non-zero now means I am the parent return $pid; }; #chdir("/") || die "can't chdir to /: $!"; # We are the child, close about everything, then exec (setsid() != -1) || die "Can't start a new session: $!"; #open(STDERR, ">&STDOUT") || die "can't dup stdout: $!"; #open(STDIN, "< /dev/null") || die "can't read /dev/null: $!"; #open(STDOUT, "> /dev/null") || die "can't write to /dev/null: $!"; exec @cmd or warn $!; } sub spawn_child { my ( $self, @cmd ) = @_; my ($pid); if( $^O =~ /mswin/i ) { $pid = $self->spawn_child_win32(@cmd) } else { $pid = $self->spawn_child_posix(@cmd) }; return $pid } sub spawn { my ($class,%args) = @_; $args{ request_pause } ||= 0; my $self = { %args }; bless $self,$class; local $ENV{TEST_HTTP_VERBOSE}; $ENV{TEST_HTTP_VERBOSE}= 1 if (delete $args{debug}); $self->{delete} = []; if (my $html = delete $args{html}) { # write the html to a temp file my ($fh,$tempfile) = File::Temp::tempfile(); binmode $fh; print $fh $html or die "Couldn't write tempfile $tempfile : $!"; close $fh; push @{$self->{delete}},$tempfile; $args{file} = $tempfile; }; my ($tmpfh,$logfile) = File::Temp::tempfile(); close $tmpfh; push @{$self->{delete}},$logfile; $self->{logfile} = $logfile; my $web_page = delete $args{file} || ""; my $file = __PACKAGE__; $file =~ s!::!/!g; $file .= '.pm'; my $server_file = File::Spec->catfile( dirname( $INC{$file} ),'log-server' ); my ($fh,$url_file) = File::Temp::tempfile; close $fh; # race condition, but oh well my @opts = ("-f", $url_file); push @opts, "-e" => delete($args{ eval }) if $args{ eval }; push @opts, "-s" => $args{ request_pause }; my @cmd=( $^X, $server_file, $web_page, $logfile, @opts ); my $pid = $self->spawn_child(@cmd); my $timeout = time +2; while( time < $timeout and (-s $url_file <= 15)) { sleep( 0.1 ); # overkill, but good enough for the moment } my $server; while( time < $timeout and !open $server, '<', $url_file ) { sleep(0.1); }; $server or die "Couldn't read back URL from '$url_file': $!"; my $url = <$server>; close $server; unlink $url_file; chomp $url; die "Couldn't read back local server url" unless $url; $self->{_pid} = $pid; $self->{_server_url} = URI::URL->new($url); $self; }; =head2 C<< $server->port >> This returns the port of the current server. As new instances will most likely run under a different port, this is convenient if you need to compare results from two runs. =cut sub port { carp __PACKAGE__ . "::port called without a server" unless $_[0]->server_url; $_[0]->server_url->port }; =head2 C<< $server->url >> This returns the L where you can contact the server. This url is valid until the C<$server> goes out of scope or you call $server->stop; The returned object is a copy that you can modify at your leisure. =cut sub url { $_[0]->server_url->abs }; =head2 C<< $server->server_url >> This returns the L object of the server URL. Use Lurl> instead. Use this object if you want to modify the hostname or other properties of the server object. Consider this basically an emergency accessor. In about every case, using C<< ->url() >> does what you want. =cut sub server_url { $_[0]->{_server_url} }; =head2 C<< $server->stop >> This stops the server process by requesting a special url. =cut sub stop { local $?; # so we don't override the exit code of a child here get( $_[0]->server_url() . "quit_server" ); undef $_[0]->{_server_url}; my $pid = delete $_[0]->{_pid}; waitpid $pid, 0; #my $retries = 10; #while(--$retries and CORE::kill( 0 => $_[0]->{ _pid } )) { #warn "Waiting for '$_[0]->{ _pid }'"; #sleep 1; # to give the child a chance to go away #}; #if( ! $retries ) { #$_[0]->kill; #}; }; =head2 C<< $server->kill >> This kills the server process via C. The log cannot be retrieved then. =cut sub kill { my $pid = delete $_[0]->{_pid}; if( $pid and CORE::kill( 0 => $pid )) { local $?; # so we don't override the exit code of a child here # The kid is still alive CORE::kill( 'KILL' => $pid ) or warn "Couldn't kill pid '$pid': $!"; waitpid $pid, 0; }; undef $_[0]->{_server_url}; }; =head2 C<< $server->get_log >> This returns the output of the server process. This output will be a list of all requests made to the server concatenated together as a string. =cut sub get_log { my ($self) = @_; return get( $self->server_url() . "get_server_log" ); }; sub DESTROY { $_[0]->stop if $_[0]->server_url; for my $file (@{$_[0]->{delete}}) { unlink $file or warn "Couldn't remove tempfile $file : $!\n"; }; if( $_[0]->{_pid } and CORE::kill( 0 => $_[0]->{_pid })) { $_[0]->kill; # boom }; }; =head2 C<< $server->local >> my $url = $server->local('foo.html'); # file:///.../foo.html Returns an URL for a local file which will be read and served by the webserver. The filename must be a relative filename relative to the location of the current program. =cut sub local { my ($self, $htmlfile) = @_; require File::Spec; my $fn= File::Spec->file_name_is_absolute( $htmlfile ) ? $htmlfile : File::Spec->rel2abs( File::Spec->catfile(dirname($0),$htmlfile), Cwd::getcwd(), ); $fn =~ s!\\!/!g; # fakey "make file:// URL" $self->local_abs($fn) } =head1 URLs implemented by the server =head2 arbitrary content C<< $server->content($html) >> $server->content(<<'HTML'); HTML The URL will contain the HTML as supplied. This is convenient for supplying Javascript or special URL to your user agent. =head2 download C<< $server->download($name) >> This URL will send a file with a C header and indicate the suggested filename as passed in. =head2 302 redirect C<< $server->redirect($target) >> This URL will issue a redirect to C<$target>. No special care is taken towards URL-decoding C<$target> as not to complicate the server code. You need to be wary about issuing requests with escaped URL parameters. =head2 401 basic authentication challenge C<< $server->basic_auth($user, $pass) >> This URL will issue a 401 basic authentication challenge. The expected user and password are encoded in the URL. my $challenge_url = $server->basic_auth('foo','secret'); my $wrong_pw = URI->new( $challenge_url ); $wrong_pw->userinfo('foo:hunter2'); $res = HTTP::Tiny->new->get($wrong_pw); is $res->{status}, 401, "We get the challenge with a wrong user/password"; =head2 404 error C<< $server->error_notfound($target) >> This URL will response with status code 404. =head2 Timeout C<< $server->error_timeout($seconds) >> This URL will send a 599 error after C<$seconds> seconds. =head2 Timeout+close C<< $server->error_close($seconds) >> This URL will send nothing and close the connection after C<$seconds> seconds. =head2 Error in response content C<< $server->error_after_headers >> This URL will send headers for a successful response but will close the socket with an error after 2 blocks of 16 spaces have been sent. =head2 Chunked response C<< $server->chunked >> This URL will return 5 blocks of 16 spaces at a rate of one block per second in a chunked response. =head2 Surprisingly large bzip2 encoded response C<< $server->bzip2 >> This URL will return a short HTTP response that expands to 16M body. =head2 Surprisingly large gzip encoded response C<< $server->gzip >> This URL will return a short HTTP response that expands to 16M body. =head2 Other URLs All other URLs will echo back the cookies and query parameters. =cut use vars qw(%urls); %urls = ( 'local_abs' => 'local/%s', 'redirect' => 'redirect/%s', 'error_notfound' => 'error/notfound/%s', 'error_timeout' => 'error/timeout/%s', 'error_close' => 'error/close/%s', 'error_after_headers' => 'error/after_headers', 'gzip' => 'large/gzip/16M', 'bzip2' => 'large/bzip/16M', 'chunked' => 'chunks', 'download' => 'download/%s', 'basic_auth' => 'basic_auth/%s/%s', ); for (keys %urls) { no strict 'refs'; my $name = $_; *{ $name } = sub { my $self = shift; $self->url . sprintf $urls{ $name }, @_; }; }; sub content { my( $self, $html ) = @_; (my $encoded = $html) =~ s!([^\w])!sprintf '%%%02x',$1!ge; $self->url . $encoded; } =head1 EXPORT None by default. =head1 COPYRIGHT AND LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Copyright (C) 2003-2024 Max Maischein =head1 AUTHOR Max Maischein, Ecorion@cpan.orgE Please contact me if you find bugs or otherwise improve the module. More tests are also very welcome ! =head1 SEE ALSO L,L,L =cut 1; Test-HTTP-LocalServer-0.76/lib/Test/HTTP/cookie-server0000644000175000017500000000165614571142460021705 0ustar corioncorion#!perl -w # Thanks to merlyn for nudging me and giving me this snippet! use strict; require HTTP::Daemon; our $VERSION = '0.67'; $|++; my $d = HTTP::Daemon->new or die; print $d->url, "\n"; # How many requests do we expect? my ($ex_user,$ex_pass) = @ARGV; my $verbose = $ENV{TEST_HTTP_VERBOSE}; my $done = 0; while (! $done and my $c = $d->accept) { while (my $req = $c->get_request) { if ($verbose) { warn "# Request URI: " . $req->url->path; my @lines = split "\n",$req->as_string; warn "# $_\n" for @lines; }; my $res; my ($user,$pass); if ($req->url->path eq '/exit') { $done = 1; $res = HTTP::Response->new(200, "OK", undef, "done"); }; if ($verbose) { warn "---\n"; my @lines = split "\n",$res->as_string; warn "# $_\n" for @lines; }; $c->send_response($res); } $c->close; undef($c); }; Test-HTTP-LocalServer-0.76/META.json0000644000175000017500000000413514571142462016357 0ustar corioncorion{ "abstract" : "spawn a local HTTP server for testing", "author" : [ "Max Maischein " ], "dynamic_config" : 0, "generated_by" : "ExtUtils::MakeMaker version 7.64, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Test-HTTP-LocalServer", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0", "File::Basename" : "0", "File::Copy" : "0", "File::Find" : "0", "File::Path" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "CGI" : "0", "Carp" : "0", "Cwd" : "0", "File::Basename" : "0", "File::Spec" : "0", "File::Temp" : "0", "Getopt::Long" : "0", "HTTP::Daemon" : "6.05", "HTTP::Request::AsCGI" : "0", "HTTP::Response" : "0", "HTTP::Tiny" : "0", "IO::Socket::INET" : "0", "IO::Socket::IP" : "0.25", "Socket" : "0", "Time::HiRes" : "0", "URI" : "0", "URI::URL" : "0", "perl" : "5.008" } }, "test" : { "requires" : { "Test::More" : "0" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/Corion/Test-HTTP-LocalServer/issues" }, "license" : [ "https://dev.perl.org/licenses/" ], "repository" : { "type" : "git", "url" : "git://github.com/Corion/Test-HTTP-LocalServer.git", "web" : "https://github.com/Corion/Test-HTTP-LocalServer" } }, "version" : "0.76", "x_serialization_backend" : "JSON::PP version 4.07", "x_static_install" : 0 } Test-HTTP-LocalServer-0.76/xt/0000755000175000017500000000000014571142462015366 5ustar corioncorionTest-HTTP-LocalServer-0.76/xt/99-examples.t0000644000175000017500000000056514571142460017634 0ustar corioncorion#!perl -w use warnings; use strict; use Test::More; use File::Find; if( ! -d 'examples' ) { plan 'skip_all', "No examples directory found"; exit; }; plan 'no_plan'; sub check { return if (! m{\.pl \z}xms); my $output = `"$^X" -c $_ 2>&1`; like( $output, qr/$_ syntax OK/, "$_ compiles" ) } find({wanted => \&check, no_chdir => 1}, 'examples'); Test-HTTP-LocalServer-0.76/xt/99-todo.t0000644000175000017500000000216614571142460016762 0ustar corioncorionuse Test::More; use File::Spec; use File::Find; use strict; # Check that all files do not contain any # lines with "XXX" - such markers should # either have been converted into Todo-stuff # or have been resolved. # The test was provided by Andy Lester. require './Makefile.PL'; # Loaded from Makefile.PL our %module = get_module_info(); my @files; my $blib = File::Spec->catfile(qw(blib lib)); find(\&wanted, grep { -d } ($blib)); if( my $exe = $module{EXE_FILES}) { push @files, @$exe; }; plan tests => 2* @files; foreach my $file (@files) { source_file_ok($file); } sub wanted { push @files, $File::Find::name if /\.p(l|m|od)$/; } sub source_file_ok { my $file = shift; open( my $fh, '<', $file ) or die "Can't open $file: $!"; my @lines = <$fh>; close $fh; my $n = 0; for ( @lines ) { ++$n; s/^/$file ($n): /; } my @x = grep /XXX/, @lines; if ( !is( scalar @x, 0, "Looking for XXXes in $file" ) ) { diag( $_ ) for @x; } @x = grep /<<<|>>>/, @lines; if ( !is( scalar @x, 0, "Looking for <<<<|>>>> in $file" ) ) { diag( $_ ) for @x; } } Test-HTTP-LocalServer-0.76/xt/99-changes.t0000644000175000017500000000133714571142460017424 0ustar corioncorion#!perl -w use warnings; use strict; use File::Find; use Test::More tests => 2; =head1 PURPOSE This test ensures that the Changes file mentions the current version and that a release date is mentioned as well =cut require './Makefile.PL'; # Loaded from Makefile.PL our %module = get_module_info(); my $module = $module{NAME}; (my $file = $module) =~ s!::!/!g; require "$file.pm"; my $version = sprintf '%0.2f', $module->VERSION; my $changes = do { local $/; open my $fh, 'Changes' or die $!; <$fh> }; ok $changes =~ /^(.*$version.*)$/m, "We find version $version for $module"; my $changes_line = $1; ok $changes_line =~ /$version\s+20\d\d-[01]\d-[0123]\d\b/, "We find a release date on the same line" or diag $changes_line; Test-HTTP-LocalServer-0.76/xt/99-manifest.t0000644000175000017500000000204414571142460017616 0ustar corioncorionuse strict; use Test::More; # Check that MANIFEST and MANIFEST.skip are sane : use File::Find; use File::Spec; my @files = qw( MANIFEST MANIFEST.SKIP ); plan tests => scalar @files * 4 +1 # MANIFEST existence check +1 # MYMETA.* non-existence check ; for my $file (@files) { ok(-f $file, "$file exists"); open my $fh, '<', $file or die "Couldn't open $file : $!"; my @lines = <$fh>; is_deeply([grep(/^$/, @lines)],[], "No empty lines in $file"); is_deeply([grep(/^\s+$/, @lines)],[], "No whitespace-only lines in $file"); is_deeply([grep(/^\s*\S\s+$/, @lines)],[],"No trailing whitespace on lines in $file"); if ($file eq 'MANIFEST') { chomp @lines; is_deeply([grep { s/\s.*//; ! -f } @lines], [], "All files in $file exist") or do { diag "$_ is mentioned in $file but doesn't exist on disk" for grep { ! -f } @lines }; # Exclude some files from shipping is_deeply([grep(/^MYMETA\.(yml|json)$/, @lines)],[],"We don't try to ship MYMETA.* $file"); }; close $fh; }; Test-HTTP-LocalServer-0.76/xt/99-unix-text.t0000644000175000017500000000174514571142460017764 0ustar corioncorionuse Test::More; # Check that all released module files are in # UNIX text format use File::Spec; use File::Find; use strict; my @files = ('Makefile.PL', 'MANIFEST', 'MANIFEST.SKIP', glob 't/*.t'); require './Makefile.PL'; # Loaded from Makefile.PL our %module = get_module_info(); my @files; my $blib = File::Spec->catfile(qw(blib lib)); find(\&wanted, grep { -d } ($blib)); if( my $exe = $module{EXE_FILES}) { push @files, @$exe; }; plan tests => scalar @files; foreach my $file (@files) { unix_file_ok($file); } sub wanted { push @files, $File::Find::name if /\.p(l|m|od)$/; } sub unix_file_ok { my ($filename) = @_; local $/; open my $fh, '<', $filename or die "Couldn't open '$filename' : $!\n"; binmode $fh; my $content = <$fh>; my $i; my @lines = grep { /\x0D\x0A$/sm } map { sprintf "%s: %s\x0A", $i++, $_ } split /\x0A/, $content; unless (is(scalar @lines, 0,"'$filename' contains no windows newlines")) { diag $_ for @lines; }; close $fh; }; Test-HTTP-LocalServer-0.76/xt/99-test-prerequisites.t0000644000175000017500000000653514571142460021702 0ustar corioncorion#!perl -w use warnings; use strict; use Test::More; use Data::Dumper; use File::Find; =head1 DESCRIPTION This test checks whether all tests still pass when the optional test prerequisites for the test are not present. This is done by using L to rerun the test while excluding the optional prerequisite. =cut BEGIN { eval { require CPAN::Meta::Prereqs; require Parse::CPAN::Meta; require Perl::PrereqScanner::Lite; require Module::CoreList; require Test::Without::Module; require Capture::Tiny; Capture::Tiny->import('capture'); require Path::Class; Path::Class->import('dir'); }; if (my $err = $@) { warn "# $err"; plan skip_all => "Prerequisite needed for testing is missing"; exit 0; }; }; my @tests; if( @ARGV ) { @tests = @ARGV; } else { open my $manifest, '<', 'MANIFEST' or die "Couldn't read MANIFEST: $!"; @tests = grep { -f $_ } grep { m!^(t/.*\.t|scripts/.*\.pl)$! } map { s!\s*$!!; $_ } <$manifest> } plan tests => 0+@tests; my $meta = Parse::CPAN::Meta->load_file('META.json'); # Find what META.* declares my $explicit_test_prereqs = CPAN::Meta::Prereqs->new( $meta->{prereqs} )->merged_requirements->as_string_hash; my $minimum_perl = $meta->{prereqs}->{runtime}->{requires}->{perl} || 5.006; sub distributed_packages { my @modules; for( @_ ) { dir($_)->recurse( callback => sub { my( $child ) = @_; if( !$child->is_dir and $child =~ /\.pm$/) { push @modules, ((scalar $child->slurp()) =~ m/^\s*package\s+(?:#.*?\n\s+)*(\w+(?:::\w+)*)\b/msg); } }); }; map { $_ => $_ } @modules; } # Find what we distribute: my %distribution = distributed_packages('blib','t'); my $scanner = Perl::PrereqScanner::Lite->new; for my $test_file (@tests) { my $implicit_test_prereqs = $scanner->scan_file($test_file)->as_string_hash; my %missing = %{ $implicit_test_prereqs }; #warn Dumper \%missing; for my $p ( keys %missing ) { # remove core modules if( Module::CoreList::is_core( $p, undef, $minimum_perl)) { delete $missing{ $p }; #diag "$p is core for $minimum_perl"; } else { #diag "$p is not in core for $minimum_perl"; }; }; # remove explicit (test) prerequisites for my $k (keys %$explicit_test_prereqs) { delete $missing{ $k }; }; #warn Dumper $explicit_test_prereqs->as_string_hash; # Remove stuff from our distribution for my $k (keys %distribution) { delete $missing{ $k }; }; # If we have no apparent missing prerequisites, we're good my @missing = sort keys %missing; # Rerun the test without these modules and see whether it crashes my @failed; for my $candidate (@missing) { diag "Checking that $candidate is not essential"; my @cmd = ($^X, "-MTest::Without::Module=$candidate", "-Mblib", '-w', $test_file); my $cmd = join " ", @cmd; my ($stdout, $stderr, $exit) = capture { system( @cmd ); }; if( $exit != 0 ) { push @failed, [ $candidate, [@cmd]]; } elsif( $? != 0 ) { push @failed, [ $candidate, [@cmd]]; }; }; is 0+@failed, 0, $test_file or diag Dumper \@failed; }; done_testing; Test-HTTP-LocalServer-0.76/xt/99-pod.t0000644000175000017500000000145514571142460016577 0ustar corioncorionuse Test::More; # Check our Pod # The test was provided by Andy Lester, # who stole it from Brian D. Foy # Thanks to both ! use File::Spec; use File::Find; use strict; eval { require Test::Pod; Test::Pod->import; }; require './Makefile.PL'; # Loaded from Makefile.PL our %module = get_module_info(); my @files; if ($@) { plan skip_all => "Test::Pod required for testing POD"; } elsif ($Test::Pod::VERSION < 0.95) { plan skip_all => "Test::Pod 0.95 required for testing POD"; } else { my $blib = File::Spec->catfile(qw(blib lib)); find(\&wanted, grep { -d } ($blib)); if( my $exe = $module{EXE_FILES}) { push @files, @$exe; }; plan tests => scalar @files; foreach my $file (@files) { pod_file_ok($file); } } sub wanted { push @files, $File::Find::name if /\.p(l|m|od)$/; } Test-HTTP-LocalServer-0.76/xt/copyright.t0000644000175000017500000000465014571142460017566 0ustar corioncorion#!perl use warnings; use strict; use File::Find; use Test::More tests => 1; use POSIX 'strftime'; my $this_year = strftime '%Y', localtime; my $last_modified_year = 0; my $is_checkout = -d '.git'; require './Makefile.PL'; # Loaded from Makefile.PL our %module = get_module_info(); my @files; #my $blib = File::Spec->catfile(qw(blib lib)); find(\&wanted, grep { -d } ('lib')); if( my $exe = $module{EXE_FILES}) { push @files, @$exe; }; sub wanted { push @files, $File::Find::name if /\.p(l|m|od)$/; } sub collect { my( $file ) = @_; note $file; my $modified_ts; if( $is_checkout ) { # diag `git log -1 --pretty="format:%ct" "$file"`; $modified_ts = `git log -1 --pretty="format:%ct" "$file"`; } else { $modified_ts = (stat($_))[9]; } my $modified_year; if( $modified_ts ) { $modified_year = strftime('%Y', localtime($modified_ts)); } else { $modified_year = 1970; }; open my $fh, '<', $file or die "Couldn't read $file: $!"; my @copyright = map { /\bcopyright\b.*?\d{4}-(\d{4})\b/i ? [ $_ => $1 ] : () } <$fh>; my $copyright = 0; for (@copyright) { $copyright = $_->[1] > $copyright ? $_->[1] : $copyright; }; return { file => $file, copyright_lines => \@copyright, copyright => $copyright, modified => $modified_year, }; }; my @results; for my $file (@files) { push @results, collect($file); }; for my $file (@results) { $last_modified_year = $last_modified_year < $file->{modified} ? $file->{modified} : $last_modified_year; }; note "Distribution was last modified in $last_modified_year"; my @out_of_date = grep { $_->{copyright} and $_->{copyright} < $last_modified_year } @results; if(! is 0+@out_of_date, 0, "All files have a current copyright year ($last_modified_year)") { for my $file (@out_of_date) { diag sprintf "%s modified %d, but copyright is %d", $file->{file}, $file->{modified}, $file->{copyright}; diag $_ for map {@$_} @{ $file->{copyright_lines}}; }; diag q{To fix (in a rough way, please review) run}; diag sprintf q{ perl -i -ple 's!(\bcopyright\b.*?\d{4}-)(\d{4})\b!${1}%s!i' %s}, $this_year, join ' ', map { $_->{file} } @out_of_date; }; Test-HTTP-LocalServer-0.76/xt/99-compile.t0000644000175000017500000000202514571142460017437 0ustar corioncorion#!perl use warnings; use strict; use File::Find; use Test::More; BEGIN { eval 'use Capture::Tiny ":all"; 1'; if ($@) { plan skip_all => "Capture::Tiny needed for testing"; exit 0; }; }; plan 'no_plan'; require './Makefile.PL'; # Loaded from Makefile.PL our %module = get_module_info(); my $last_version = undef; sub check { #return if (! m{(\.pm|\.pl) \z}xmsi); my ($stdout, $stderr, $exit) = capture(sub { system( $^X, '-Mblib', '-c', $_ ); }); s!\s*\z!! for ($stdout, $stderr); if( $exit ) { diag $stderr; diag "Exit code: ", $exit; fail($_); } elsif( $stderr ne "$_ syntax OK") { diag $stderr; fail($_); } else { pass($_); }; } my @files; find({wanted => \&wanted, no_chdir => 1}, grep { -d $_ } 'blib/lib', 'examples', 'lib' ); if( my $exe = $module{EXE_FILES}) { push @files, @$exe; }; for (@files) { check($_) } sub wanted { push @files, $File::Find::name if /\.p(l|m|od)$/; } Test-HTTP-LocalServer-0.76/xt/99-synopsis.t0000644000175000017500000000301114571142460017672 0ustar corioncorionuse strict; use Test::More; use File::Spec; use File::Find; use File::Temp 'tempfile'; require './Makefile.PL'; # Loaded from Makefile.PL our %module = get_module_info(); my @files; my $blib = File::Spec->catfile(qw(blib lib)); find(\&wanted, grep { -d } ($blib)); #if( my $exe = $module{EXE_FILES}) { # push @files, @$exe; #}; plan tests => scalar @files; foreach my $file (@files) { synopsis_file_ok($file); } sub wanted { push @files, $File::Find::name if /\.p(l|m|od)$/ and $_ !~ /\bDSL\.pm$/; # we skip that one as it initializes immediately } sub synopsis_file_ok { my( $file ) = @_; my $name = "SYNOPSIS in $file compiles"; open my $fh, '<', $file or die "Couldn't read '$file': $!"; my @synopsis = map { s!^\s\s!!; $_ } # outdent all code for here-docs grep { /^\s\s/ } # extract all verbatim (=code) stuff grep { /^=head1\s+SYNOPSIS$/.../^=/ } # extract Pod synopsis <$fh>; if( @synopsis ) { my($tmpfh,$tempname) = tempfile(); print {$tmpfh} join '', @synopsis; close $tmpfh; # flush it my $output = `$^X -Ilib -c $tempname 2>&1`; if( $output =~ /\ssyntax OK$/ ) { pass $name; } else { fail $name; diag $output; diag $_ for @synopsis; }; unlink $tempname or warn "Couldn't clean up $tempname: $!"; } else { SKIP: { skip "$file has no SYNOPSIS section", 1; }; }; } Test-HTTP-LocalServer-0.76/xt/99-versions.t0000644000175000017500000000315714571142460017666 0ustar corioncorion#!perl -w # Stolen from ChrisDolan on use.perl.org # http://use.perl.org/comments.pl?sid=29264&cid=44309 use warnings; use strict; use File::Find; use Test::More; require './Makefile.PL'; # Loaded from Makefile.PL our %module = get_module_info(); my @files; my $blib = File::Spec->catfile(qw(blib lib)); find(\&wanted, grep { -d } ($blib)); if( my $exe = $module{EXE_FILES}) { push @files, @$exe; }; sub read_file { open my $fh, '<', $_[0] or die "Couldn't read '$_[0]': $!"; binmode $fh; local $/; <$fh> } sub wanted { push @files, $File::Find::name if /\.p(l|m|od)$/; } plan tests => 0+@files; my $last_version = undef; sub check { my $content = read_file($_); # only look at perl scripts, not sh scripts return if (m{blib/script/}xms && $content !~ m/\A \#![^\r\n]+?perl/xms); # what my version numbers look like my $version = qr/\d+\.\d+/; my @version_lines = grep { defined } $content =~ m/ [^\n]* \$VERSION \s* = \s* ["']($version)['"] | package \s+ \S+ \s+ ($version) \s* ; /gxms; if (@version_lines == 0) { fail($_); } for my $line (@version_lines) { $line =~ s/^\s+//; $line =~ s/\s+$//; if (!defined $last_version) { $last_version = shift @version_lines; diag "Checking for $last_version"; pass($_); } else { is($line, $last_version, $_); } } } for (@files) { check(); }; if (! defined $last_version) { fail('Failed to find any files with $VERSION'); } Test-HTTP-LocalServer-0.76/xt/99-minimumversion.t0000644000175000017500000000047114571142460021073 0ustar corioncorion#!perl -w use strict; use Test::More; eval { #require Test::MinimumVersion::Fast; require Test::MinimumVersion; Test::MinimumVersion->import; }; my @files; if ($@) { plan skip_all => "Test::MinimumVersion required for testing minimum Perl version"; } else { all_minimum_version_from_metajson_ok(); } Test-HTTP-LocalServer-0.76/xt/meta-lint.t0000644000175000017500000000216614571142460017450 0ustar corioncorion#!perl -w # Stolen from ChrisDolan on use.perl.org # http://use.perl.org/comments.pl?sid=29264&cid=44309 use warnings; use strict; use File::Find; use Test::More; eval { #require Test::MinimumVersion::Fast; require Parse::CPAN::Meta; Parse::CPAN::Meta->import(); require CPAN::Meta::Validator; CPAN::Meta::Validator->VERSION(2.15); }; if ($@) { plan skip_all => "CPAN::Meta::Validator version 2.15 required for testing META files"; } else { plan tests => 4; } use lib '.'; use vars '%module'; require 'Makefile.PL'; # Loaded from Makefile.PL %module = get_module_info(); my $module = $module{NAME}; (my $file = $module) =~ s!::!/!g; require "$file.pm"; my $version = sprintf '%0.2f', $module->VERSION; for my $meta_file ('META.yml', 'META.json') { my $meta = Parse::CPAN::Meta->load_file($meta_file); my $cmv = CPAN::Meta::Validator->new( $meta ); if(! ok $cmv->is_valid, "$meta_file is valid" ) { diag $_ for $cmv->errors; }; # Also check that the declared version matches the version in META.* is $meta->{version}, $version, "$meta_file version matches module version ($version)"; }; Test-HTTP-LocalServer-0.76/.github/0000755000175000017500000000000014571142462016273 5ustar corioncorionTest-HTTP-LocalServer-0.76/.github/workflows/0000755000175000017500000000000014571142462020330 5ustar corioncorionTest-HTTP-LocalServer-0.76/.github/workflows/linux.yml0000644000175000017500000000106514571142460022212 0ustar corioncorionname: linux on: push: branches: - '*' tags-ignore: - '*' pull_request: jobs: perl: runs-on: ubuntu-latest strategy: matrix: perl-version: - '5.8' - '5.10' - '5.16' - 'latest' container: image: perl:${{ matrix.perl-version }} steps: - uses: actions/checkout@v1 - name: perl -V run: perl -V - name: Install Dependencies run: curl -L https://cpanmin.us | perl - --installdeps . - name: Run Tests run: prove -l t Test-HTTP-LocalServer-0.76/.github/workflows/macos.yml0000644000175000017500000000066014571142460022155 0ustar corioncorionname: macos on: push: branches: - '*' tags-ignore: - '*' pull_request: jobs: perl: runs-on: macOS-latest steps: - uses: actions/checkout@v1 - name: Set up Perl run: brew install perl - name: perl -V run: perl -V - name: Install Dependencies run: curl -L https://cpanmin.us | perl - --installdeps . - name: Run Tests run: prove -l t Test-HTTP-LocalServer-0.76/.github/workflows/windows.yml0000644000175000017500000000114414571142460022543 0ustar corioncorionname: windows on: push: branches: - '*' tags-ignore: - '*' pull_request: jobs: perl: runs-on: windows-latest steps: - uses: actions/checkout@master - name: Set up Perl run: | choco install strawberryperl echo "C:\strawberry\c\bin;C:\strawberry\perl\site\bin;C:\strawberry\perl\bin" | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append - name: perl -V run: perl -V - name: Install Dependencies run: curl -L https://cpanmin.us | perl - --installdeps . - name: Run Tests run: prove -l t Test-HTTP-LocalServer-0.76/Changes0000644000175000017500000000776214571142460016240 0ustar corioncorion0.76 2024-03-02 * Unset x_static_install , which means that some installers will actually install the log_server script. Provided by zmughal. 0.75 2023-07-21 * Various build and test upgrades, no code changes, no need to upgrade 0.74 2021-10-24 * Restore compatibility with Perl 5.8.x 0.73 2021-10-22 * Actually allow sub-second delays for the "request_pause" option 0.72 2021-10-21 * Introduce the "request_pause" option to adjust the pause between requests. Depending on the UA under test, the default of 1 second may slow down testing too much, or may be necessary. 0.71 2020-01-10 * Require IO::Socket::IP explicitly, for better IPv6 support (CPAN testers failure at http://www.cpantesters.org/cpan/report/e9fda1dc-3325-11ea-b88a-584e1f24ea8f ) * Output diagnostics when HTTP::Daemon fails to start up (CPAN testers failure at http://www.cpantesters.org/cpan/report/55b7db81-6bfd-1014-acc9-ccd2be2b35a3 ) 0.70 2020-01-07 * Protect the main exit code in $? against child exit code leaking, and add some more tests against this. This should fix downstream test failures in WWW::Mechanize::Chrome. * More automated CI testing 0.69 2019-10-01 * Protect test suite against HTTP_PROXY (etc) being set, again This is mostly because the module itself doesn't care anymore, but now the test suite needs to protect itself. 0.68 2019-09-30 * Add ->basic_auth endpoint 0.67 2019-09-29 * More aggressively watch for startup of the web server to reduce idle times. Also speed up the test suite by polling instead of sleep()ing. * Added ->server_url() as a half-documented way of changing the URL the server is accessed at. This is self-service and if things break, you get to keep all the parts. * LWP::UserAgent is no more a (test) prerequisite. We do the tests from HTTP::Tiny (core since 5.14, runs on 5.6+). 0.66 2019-09-10 * Make detection of IPv4 localhost vs. IPv6 localhost much more resilient. Backported from WWW::Mechanize, implemented by Shoichi Kaji. * We now need HTTP::Daemon 6.05. 0.65 2019-09-05 * Fix order of module usage in test scripts, spotted by Jorol This only was a problem when you had $ENV{HTTP_PROXY} set. * Document that we clean out $ENV{HTTPS_PROXY} as well. 0.64 2018-10-28 * Re-release including correct META.* information * No upgrade necessary 0.63 2018-06-04 * Fix the form parameters getting lost This was since we changed the form from GET to POST ... 0.62 2018-05-20 * Fix the ->redirect URL to honor the specified host This prevents breakage due to localhost vs. 127.0.0.1 mixups * Add ->content method to serve arbitrary content like Javascript 0.61 2017-11-29 * Make the "->download" method actually work in the sense that it will send downloads with a name other than "$1". 0.60 2017-11-27 * Add method to "download" a file This is in preparation for WWW::Mechanize::Chrome trying to download a file * Rework IPC to launch the server The old method of a pipe-open was elegant but didn't really work out for cleanly shutting down the process. The new approach uses the same way we spawn and dissociate Chrome in WWW::Mechanize::Chrome. * We are now more defensive about finding out whether CGI.pm can do ->multi_param or not 0.59 2017-06-17 * Add support for checking Javascript properties if Javascript runs on the client Currently, this only mirrors back the window.navigator.userAgent variable 0.58 2017-05-18 * Remove support for Perl 5.6.x The module uses a fancy way of opening a lexical filehandle which doesn't work on Perl 5.6.x. Instead of trying to figure out how to make 5.6.x open() work with an undef lexial variable for a filehandle via Travis CI, I simply declare this module incompatible with 5.6.x. 0.57 2017-05-08 * Spun off from WWW::Mechanize::PhantomJS (and WWW::Mechanize::Firefox, and WWW::Mechanize::Shell) Test-HTTP-LocalServer-0.76/README0000644000175000017500000000230114571142460015605 0ustar corioncorionTest::HTTP::LocalServer - spawn a local HTTP server for testing DESCRIPTION This module implements a tiny web server suitable for running "live" tests of HTTP clients against it. It also takes care of cleaning C<%ENV> from settings that influence the use of a local proxy etc. Use this web server if you write an HTTP client and want to exercise its behaviour in your test suite without talking to the outside world. INSTALLATION This is a Perl module distribution. It should be installed with whichever tool you use to manage your installation of Perl, e.g. any of cpanm . cpan . cpanp -i . Consult https://www.cpan.org/modules/INSTALL.html for further instruction. Should you wish to install this module manually, the procedure is perl Makefile.PL make make test make install SEE ALSO L,L,L AUTHOR Max Maischein, Ecorion@cpan.orgE Please contact me if you find bugs or otherwise improve the module. More tests are also very welcome ! COPYRIGHT AND LICENSE This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Copyright (C) 2003-2024 Max Maischein Test-HTTP-LocalServer-0.76/development/0000755000175000017500000000000014571142462017255 5ustar corioncorionTest-HTTP-LocalServer-0.76/development/gen-gzipbomb.pl0000644000175000017500000000117014571142460022167 0ustar corioncorion#!perl -w use strict; use warnings; use IO::Compress::Gzip qw(gzip $GzipError); =head1 NAME gen-gzipbomb.pl - generate a thrice-encoded gzip stream that decodes to 16MB =cut # Create a nasty gzip stream: my $size = 16 * 1024 * 1024; my $stream = "\0" x $size; # Compress that stream three times: my $compressed = $stream; for( 1..3 ) { my $last = $compressed; gzip(\$last, \$compressed, Level => 9, -Minimal => 1) or die "Can't gzip content: $GzipError"; #diag sprintf "Encoded size %d bytes after round %d", length $compressed, $_; }; use Data::Dumper; $Data::Dumper::Useqq = 1; print Dumper $compressed; Test-HTTP-LocalServer-0.76/development/gen-bzipbomb.pl0000644000175000017500000000114514571142460022164 0ustar corioncorion#!perl -w use strict; use warnings; use IO::Compress::Bzip2 qw(bzip2 $Bzip2Error); =head1 NAME gen-bzipbomb.pl - generate a thrice-encoded bzip2 stream that decodes to 16MB =cut # Create a nasty bzip2 stream: my $size = 16 * 1024 * 1024; my $stream = "\0" x $size; # Compress that stream three times: my $compressed = $stream; for( 1..3 ) { my $last = $compressed; bzip2(\$last, \$compressed) or die "Can't bzip2 content: $Bzip2Error"; #diag sprintf "Encoded size %d bytes after round %d", length $compressed, $_; }; use Data::Dumper; $Data::Dumper::Useqq = 1; print Dumper $compressed; Test-HTTP-LocalServer-0.76/MANIFEST0000644000175000017500000000135414571142460016065 0ustar corioncorion.github/workflows/linux.yml .github/workflows/macos.yml .github/workflows/windows.yml .gitignore Changes development/gen-bzipbomb.pl development/gen-gzipbomb.pl lib/Test/HTTP/cookie-server lib/Test/HTTP/gzip-streamed.psgi lib/Test/HTTP/LocalServer.pm lib/Test/HTTP/log-server LICENSE Makefile.PL MANIFEST This list of files MANIFEST.SKIP META.json META.yml README README.mkdn t/00-load.t t/01-start.t t/02-start-stop.t t/03-sticky-fields.t t/04-server-name.t t/05-basic-auth.t t/05-simplest.t t/06-exitcode.t testrules.yml xt/99-changes.t xt/99-compile.t xt/99-examples.t xt/99-manifest.t xt/99-minimumversion.t xt/99-pod.t xt/99-synopsis.t xt/99-test-prerequisites.t xt/99-todo.t xt/99-unix-text.t xt/99-versions.t xt/copyright.t xt/meta-lint.t Test-HTTP-LocalServer-0.76/LICENSE0000644000175000017500000002127514571142460015745 0ustar corioncorion The Artistic License 2.0 Copyright (c) 2000-2006, The Perl Foundation. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble This license establishes the terms under which a given free software Package may be copied, modified, distributed, and/or redistributed. The intent is that the Copyright Holder maintains some artistic control over the development of that Package while still keeping the Package available as open source and free software. You are always permitted to make arrangements wholly outside of this license directly with the Copyright Holder of a given Package. If the terms of this license do not permit the full use that you propose to make of the Package, you should contact the Copyright Holder and seek a different licensing arrangement. Definitions "Copyright Holder" means the individual(s) or organization(s) named in the copyright notice for the entire Package. "Contributor" means any party that has contributed code or other material to the Package, in accordance with the Copyright Holder's procedures. "You" and "your" means any person who would like to copy, distribute, or modify the Package. "Package" means the collection of files distributed by the Copyright Holder, and derivatives of that collection and/or of those files. A given Package may consist of either the Standard Version, or a Modified Version. "Distribute" means providing a copy of the Package or making it accessible to anyone else, or in the case of a company or organization, to others outside of your company or organization. "Distributor Fee" means any fee that you charge for Distributing this Package or providing support for this Package to another party. It does not mean licensing fees. "Standard Version" refers to the Package if it has not been modified, or has been modified only in ways explicitly requested by the Copyright Holder. "Modified Version" means the Package, if it has been changed, and such changes were not explicitly requested by the Copyright Holder. "Original License" means this Artistic License as Distributed with the Standard Version of the Package, in its current version or as it may be modified by The Perl Foundation in the future. "Source" form means the source code, documentation source, and configuration files for the Package. "Compiled" form means the compiled bytecode, object code, binary, or any other form resulting from mechanical transformation or translation of the Source form. Permission for Use and Modification Without Distribution (1) You are permitted to use the Standard Version and create and use Modified Versions for any purpose without restriction, provided that you do not Distribute the Modified Version. Permissions for Redistribution of the Standard Version (2) You may Distribute verbatim copies of the Source form of the Standard Version of this Package in any medium without restriction, either gratis or for a Distributor Fee, provided that you duplicate all of the original copyright notices and associated disclaimers. At your discretion, such verbatim copies may or may not include a Compiled form of the Package. (3) You may apply any bug fixes, portability changes, and other modifications made available from the Copyright Holder. The resulting Package will still be considered the Standard Version, and as such will be subject to the Original License. Distribution of Modified Versions of the Package as Source (4) You may Distribute your Modified Version as Source (either gratis or for a Distributor Fee, and with or without a Compiled form of the Modified Version) provided that you clearly document how it differs from the Standard Version, including, but not limited to, documenting any non-standard features, executables, or modules, and provided that you do at least ONE of the following: (a) make the Modified Version available to the Copyright Holder of the Standard Version, under the Original License, so that the Copyright Holder may include your modifications in the Standard Version. (b) ensure that installation of your Modified Version does not prevent the user installing or running the Standard Version. In addition, the Modified Version must bear a name that is different from the name of the Standard Version. (c) allow anyone who receives a copy of the Modified Version to make the Source form of the Modified Version available to others under (i) the Original License or (ii) a license that permits the licensee to freely copy, modify and redistribute the Modified Version using the same licensing terms that apply to the copy that the licensee received, and requires that the Source form of the Modified Version, and of any works derived from it, be made freely available in that license fees are prohibited but Distributor Fees are allowed. Distribution of Compiled Forms of the Standard Version or Modified Versions without the Source (5) You may Distribute Compiled forms of the Standard Version without the Source, provided that you include complete instructions on how to get the Source of the Standard Version. Such instructions must be valid at the time of your distribution. If these instructions, at any time while you are carrying out such distribution, become invalid, you must provide new instructions on demand or cease further distribution. If you provide valid instructions or cease distribution within thirty days after you become aware that the instructions are invalid, then you do not forfeit any of your rights under this license. (6) You may Distribute a Modified Version in Compiled form without the Source, provided that you comply with Section 4 with respect to the Source of the Modified Version. Aggregating or Linking the Package (7) You may aggregate the Package (either the Standard Version or Modified Version) with other packages and Distribute the resulting aggregation provided that you do not charge a licensing fee for the Package. Distributor Fees are permitted, and licensing fees for other components in the aggregation are permitted. The terms of this license apply to the use and Distribution of the Standard or Modified Versions as included in the aggregation. (8) You are permitted to link Modified and Standard Versions with other works, to embed the Package in a larger work of your own, or to build stand-alone binary or bytecode versions of applications that include the Package, and Distribute the result without restriction, provided the result does not expose a direct interface to the Package. Items That are Not Considered Part of a Modified Version (9) Works (including, but not limited to, modules and scripts) that merely extend or make use of the Package, do not, by themselves, cause the Package to be a Modified Version. In addition, such works are not considered parts of the Package itself, and are not subject to the terms of this license. General Provisions (10) Any use, modification, and distribution of the Standard or Modified Versions is governed by this Artistic License. By using, modifying or distributing the Package, you accept this license. Do not use, modify, or distribute the Package, if you do not accept this license. (11) If your Modified Version has been derived from a Modified Version made by someone other than you, you are nevertheless required to ensure that your Modified Version complies with the requirements of this license. (12) This license does not grant you the right to use any trademark, service mark, tradename, or logo of the Copyright Holder. (13) This license includes the non-exclusive, worldwide, free-of-charge patent license to make, have made, use, offer to sell, sell, import and otherwise transfer the Package with respect to any patent claims licensable by the Copyright Holder that are necessarily infringed by the Package. If you institute patent litigation (including a cross-claim or counterclaim) against any party alleging that the Package constitutes direct or contributory patent infringement, then this Artistic License to you shall terminate on the date that such litigation is filed. (14) Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES. THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.Test-HTTP-LocalServer-0.76/testrules.yml0000644000175000017500000000012114571142460017500 0ustar corioncorion--- # This test suite can be run fully in parallel par: - t/*.t - xt/*.t