view release on metacpan or search on metacpan
smuggling (CVE-2026-7010)
0.092 2025-12-27 20:49:41+01:00 Europe/Berlin
- No changes from 0.091-TRIAL
0.091 2025-12-13 06:26:51+01:00 Europe/Brussels (TRIAL RELEASE)
[ADDED]
- Added keep_alive_timeout to force keepalive connections to be closed
based on a timeout.
[CHANGED]
- Optional tests are always required when releasing.
- Always use TCP_NODELAY option.
[FIXED]
replaced by a single space.
[FIXED]
- Per the RFC, control headers are now sent first before other headers
(which are sent in arbitrary order).
- Only well-known headers have their case canonicalized; all other
headers are sent in the case provided by the user.
- The 'keep_alive' option now also sets the SO_KEEPALIVE option
on the underlying socket to help with long-lived, idle connections.
- Request header field values are now validated against the RFC rules
(i.e. empty or else space-or-tab separated tokens of printable
characters).
0.056 2015-05-19 06:00:40-04:00 America/New_York
- No changes from 0.055
0.050 2014-09-23 15:30:18-04:00 America/New_York
[FIXED]
- Fixed CONNECT requests for some proxies
0.049 2014-09-02 11:20:07-04:00 America/New_York
[FIXED]
- 'keep_alive' is now fork-safe and thread-safe
0.048 2014-08-21 13:19:51-04:00 America/New_York
[FIXED]
- Protected proxy tests from ALL_PROXY in the environment
0.047 2014-07-29 14:09:05-04:00 America/New_York
[CHANGED]
- The 'proxy' attribute no longer takes precedence over the
'http_proxy' environment variable. With the addition of http_proxy
and https_proxy attributes (and corresponding environment variable
defaults), the legacy 'proxy' attribute now maps to the
all_proxy/ALL_PROXY environment variable and only takes effect when
other proxy attributes are not defined.
[ADDED (since 0.039)]
- Added 'keep_alive' attribute for single-server persistent connections
(Clinton Gormley)
- Added support for Basic authorization with proxies
- Added support for https proxies via CONNECT
[FIXED (since 0.039)]
- Requests are made with one less write for lower latency (Martin
Evans)
corpus/get-15.txt
corpus/get-16.txt
corpus/get-17.txt
corpus/get-18.txt
corpus/get-19.txt
corpus/get-20.txt
corpus/get-21.txt
corpus/get-22.txt
corpus/get-23.txt
corpus/head-01.txt
corpus/keepalive-01.txt
corpus/keepalive-02.txt
corpus/keepalive-03.txt
corpus/keepalive-04.txt
corpus/keepalive-05.txt
corpus/mirror-01.txt
corpus/mirror-02.txt
corpus/mirror-03.txt
corpus/mirror-04.txt
corpus/mirror-05.txt
corpus/post-01.txt
corpus/post-02.txt
corpus/proxy-auth-01.txt
corpus/put-01.txt
corpus/put-02.txt
t/103_delete.t
t/104_post.t
t/110_mirror.t
t/130_redirect.t
t/140_proxy.t
t/141_no_proxy.t
t/150_post_form.t
t/160_cookies.t
t/161_basic_auth.t
t/162_proxy_auth.t
t/170_keepalive.t
t/180_verify_SSL.t
t/190_find_CA.t
t/200_live.t
t/200_live_local_ip.t
t/210_live_ssl.t
t/BrokenCookieJar.pm
t/SimpleCookieJar.pm
t/Util.pm
xt/author/00-compile.t
xt/author/critic.t
"false".
* "cookie_jar" â An instance of HTTP::CookieJar â or equivalent class
that supports the "add" and "cookie_header" methods
* "default_headers" â A hashref of default headers to apply to
requests
* "local_address" â The local IP address to bind to
* "keep_alive" â Whether to reuse the last connection (if for the same
scheme, host and port) (defaults to 1)
* "keep_alive_timeout" â How many seconds to keep a connection
available for after a request (defaults to 0, unlimited)
* "max_redirect" â Maximum number of redirects allowed (defaults to 5)
* "max_size" â Maximum response size in bytes (only when not using a
data callback). If defined, requests with responses larger than this
will return a 599 status code.
* "http_proxy" â URL of a proxy server to use for HTTP connections
(default is $ENV{http_proxy} â if set)
An accessor/mutator method exists for each attribute.
Passing an explicit "undef" for "proxy", "http_proxy" or "https_proxy"
will prevent getting the corresponding proxies from the environment.
Errors during request execution will result in a pseudo-HTTP status code
of 599 and a reason of "Internal Exception". The content field in the
response will contain the text of the error.
The "keep_alive" parameter enables a persistent connection, but only to
a single destination scheme, host and port. If any connection-relevant
attributes are modified via accessor, or if the process ID or thread ID
change, the persistent connection will be dropped. If you want
persistent connections across multiple destinations, use multiple
HTTP::Tiny objects.
The "keep_alive_timeout" parameter allows you to control how long a keep
alive connection will be considered for reuse. By setting this lower
than the server keep alive time, this allows you to avoid race
conditions where the server closes the connection while preparing to
write the request on a reused persistent connection.
See "TLS/SSL SUPPORT" for more on the "verify_SSL" and "SSL_options"
attributes.
get|head|put|post|patch|delete
$response = $http->get($url);
$response = $http->get($url, \%options);
$response = $http->head($url);
available.
In scalar context, returns a boolean indicating if SSL is available. In
list context, returns the boolean and a (possibly multi-line) string of
errors indicating why SSL isn't available.
connected
$host = $http->connected;
($host, $port) = $http->connected;
Indicates if a connection to a peer is being kept alive, per the
"keep_alive" option.
In scalar context, returns the peer host and port, joined with a colon,
or "undef" (if no peer is connected). In list context, returns the peer
host and port or an empty list (if no peer is connected).
Note: This method cannot reliably be used to discover whether the remote
host has closed its end of the socket.
TLS/SSL SUPPORT
Direct "https" connections are supported only if IO::Socket::SSL 1.56 or
corpus/keepalive-05.txt view on Meta::CPAN
Not HTTP/1.1 with keep-alive
----------
0
----------
HTTP/1.0 200 OK
Date: Thu, 03 Feb 1994 00:00:00 GMT
Content-Type: text/html
Content-Length: 10
Connection: keep-alive
0123456789
lib/HTTP/Tiny.pm view on Meta::CPAN
#pod true value to revert to the legacy behavior of forwarding those headers.
#pod Default is C<false>.
#pod * C<allow_downgrade> â If a C<3XX> redirect changes the scheme from C<https> to
#pod plain C<http>, HTTP::Tiny will by default refuse to follow it, returning the
#pod C<3XX> response. Set this to a true value to revert to the legacy behavior of
#pod redirecting C<https> to C<http>. Default is C<false>.
#pod * C<cookie_jar> â An instance of L<HTTP::CookieJar> â or equivalent class
#pod that supports the C<add> and C<cookie_header> methods
#pod * C<default_headers> â A hashref of default headers to apply to requests
#pod * C<local_address> â The local IP address to bind to
#pod * C<keep_alive> â Whether to reuse the last connection (if for the same
#pod scheme, host and port) (defaults to 1)
#pod * C<keep_alive_timeout> â How many seconds to keep a connection available
#pod for after a request (defaults to 0, unlimited)
#pod * C<max_redirect> â Maximum number of redirects allowed (defaults to 5)
#pod * C<max_size> â Maximum response size in bytes (only when not using a data
#pod callback). If defined, requests with responses larger than this will return
#pod a 599 status code.
#pod * C<http_proxy> â URL of a proxy server to use for HTTP connections
#pod (default is C<$ENV{http_proxy}> â if set)
#pod * C<https_proxy> â URL of a proxy server to use for HTTPS connections
#pod (default is C<$ENV{https_proxy}> â if set)
#pod * C<proxy> â URL of a generic proxy server for both HTTP and HTTPS
lib/HTTP/Tiny.pm view on Meta::CPAN
#pod
#pod An accessor/mutator method exists for each attribute.
#pod
#pod Passing an explicit C<undef> for C<proxy>, C<http_proxy> or C<https_proxy> will
#pod prevent getting the corresponding proxies from the environment.
#pod
#pod Errors during request execution will result in a pseudo-HTTP status code of 599
#pod and a reason of "Internal Exception". The content field in the response will
#pod contain the text of the error.
#pod
#pod The C<keep_alive> parameter enables a persistent connection, but only to a
#pod single destination scheme, host and port. If any connection-relevant
#pod attributes are modified via accessor, or if the process ID or thread ID change,
#pod the persistent connection will be dropped. If you want persistent connections
#pod across multiple destinations, use multiple HTTP::Tiny objects.
#pod
#pod The C<keep_alive_timeout> parameter allows you to control how long a
#pod keep alive connection will be considered for reuse. By setting this lower
#pod than the server keep alive time, this allows you to avoid race conditions where
#pod the server closes the connection while preparing to write the request on
#pod a reused persistent connection.
#pod
#pod See L</TLS/SSL SUPPORT> for more on the C<verify_SSL> and C<SSL_options>
#pod attributes.
#pod
#pod =cut
my @attributes;
BEGIN {
@attributes = qw(
allow_credentialed_redirects allow_downgrade cookie_jar default_headers
http_proxy https_proxy keep_alive local_address max_redirect max_size
proxy no_proxy SSL_options verify_SSL
);
my %persist_ok = map {; $_ => 1 } qw(
cookie_jar default_headers max_redirect max_size
);
no strict 'refs';
no warnings 'uninitialized';
for my $accessor ( @attributes ) {
*{$accessor} = sub {
@_ > 1
lib/HTTP/Tiny.pm view on Meta::CPAN
# Support lower case verify_ssl argument, but only if verify_SSL is not
# true.
if ( exists $args{verify_ssl} ) {
$args{verify_SSL} ||= $args{verify_ssl};
}
my $self = {
max_redirect => 5,
timeout => defined $args{timeout} ? $args{timeout} : 60,
keep_alive => 1,
keep_alive_timeout => 0,
verify_SSL => defined $args{verify_SSL} ? $args{verify_SSL} : _verify_SSL_default(),
no_proxy => $ENV{no_proxy},
};
bless $self, $class;
$class->_validate_cookie_jar( $args{cookie_jar} ) if $args{cookie_jar};
for my $key ( @attributes ) {
$self->{$key} = $args{$key} if exists $args{$key}
lib/HTTP/Tiny.pm view on Meta::CPAN
}
wantarray ? ($ok, $reason) : $ok;
}
#pod =method connected
#pod
#pod $host = $http->connected;
#pod ($host, $port) = $http->connected;
#pod
#pod Indicates if a connection to a peer is being kept alive, per the C<keep_alive>
#pod option.
#pod
#pod In scalar context, returns the peer host and port, joined with a colon, or
#pod C<undef> (if no peer is connected).
#pod In list context, returns the peer host and port or an empty list (if no peer
#pod is connected).
#pod
#pod B<Note>: This method cannot reliably be used to discover whether the remote
#pod host has closed its end of the socket.
#pod
lib/HTTP/Tiny.pm view on Meta::CPAN
# response has no message body
$known_message_length = 1;
}
else {
# Ignore any data callbacks during redirection.
my $cb_args = @redir_args ? +{} : $args;
my $data_cb = $self->_prepare_data_cb($response, $cb_args);
$known_message_length = $handle->read_body($data_cb, $response);
}
if ( $self->{keep_alive}
&& $handle->connected
&& $known_message_length
&& $response->{protocol} eq 'HTTP/1.1'
&& ($response->{headers}{connection} || '') ne 'close'
) {
$handle->_update_last_used();
$self->{handle} = $handle;
}
else {
$handle->close;
lib/HTTP/Tiny.pm view on Meta::CPAN
}
sub _open_handle {
my ($self, $request, $scheme, $host, $port, $peer) = @_;
my $handle = HTTP::Tiny::Handle->new(
timeout => $self->{timeout},
SSL_options => $self->{SSL_options},
verify_SSL => $self->{verify_SSL},
local_address => $self->{local_address},
keep_alive => $self->{keep_alive},
keep_alive_timeout => $self->{keep_alive_timeout}
);
require Time::HiRes if $self->{keep_alive_timeout} > 0;
if ($self->{_has_proxy}{$scheme} && ! grep { $host =~ /\Q$_\E$/ } @{$self->{no_proxy}}) {
return $self->_proxy_connect( $request, $handle );
}
else {
return $handle->connect($scheme, $host, $port, $peer);
}
}
sub _proxy_connect {
lib/HTTP/Tiny.pm view on Meta::CPAN
}
}
if (exists $request->{headers}{'host'}) {
die(qq/The 'Host' header must not be provided as header option\n/);
}
$request->{headers}{'host'} = $request->{host_port};
$request->{headers}{'user-agent'} ||= $self->{agent};
$request->{headers}{'connection'} = "close"
unless $self->{keep_alive};
# Some servers error on an empty-body PUT/POST without a content-length
if ( $request->{method} eq 'PUT' || $request->{method} eq 'POST' ) {
if (!defined($args->{content}) || !length($args->{content}) ) {
$request->{headers}{'content-length'} = 0;
}
}
if ( defined $args->{content} ) {
if ( ref $args->{content} eq 'CODE' ) {
lib/HTTP/Tiny.pm view on Meta::CPAN
Proto => 'tcp',
Type => SOCK_STREAM,
Timeout => $self->{timeout},
) or die(qq/Could not connect to '$host:$port': $@\n/);
$self->{fh}->setsockopt(IPPROTO_TCP, TCP_NODELAY, 1);
binmode($self->{fh})
or die(qq/Could not binmode() socket: '$!'\n/);
if ( $self->{keep_alive} ) {
unless ( defined( $self->{fh}->setsockopt( SOL_SOCKET, SO_KEEPALIVE, 1 ) ) ) {
CORE::close($self->{fh});
die(qq/Could not set SO_KEEPALIVE on socket: '$!'\n/);
}
}
$self->start_ssl($host) if $scheme eq 'https';
$self->{scheme} = $scheme;
$self->{host} = $host;
lib/HTTP/Tiny.pm view on Meta::CPAN
}
return $self->_do_timeout('read', @_)
}
sub can_write {
@_ == 1 || @_ == 2 || die(q/Usage: $handle->can_write([timeout])/ . "\n");
my $self = shift;
return $self->_do_timeout('write', @_)
}
sub _has_keep_alive_expired {
my $self = shift;
return unless $self->{keep_alive_timeout} > 0;
my $now = Time::HiRes::time();
return $now - ($self->{last_used} || $now) > $self->{keep_alive_timeout};
}
sub _update_last_used {
my $self = shift;
return unless $self->{keep_alive_timeout} > 0;
$self->{last_used} = Time::HiRes::time();
}
sub _assert_ssl {
my($ok, $reason) = HTTP::Tiny->can_ssl();
die $reason unless $ok;
}
sub can_reuse {
my ($self,$scheme,$host,$port,$peer) = @_;
return 0 if
$self->{pid} != $$
|| $self->{tid} != _get_tid()
|| length($self->{rbuf})
|| $scheme ne $self->{scheme}
|| $host ne $self->{host}
|| $port ne $self->{port}
|| $peer ne $self->{peer}
|| $self->_has_keep_alive_expired()
|| eval { $self->can_read(0) }
|| $@ ;
return 1;
}
sub _find_CA {
my $self = shift;
my $ca_file = $self->{SSL_options}->{SSL_ca_file};
lib/HTTP/Tiny.pm view on Meta::CPAN
=item *
C<default_headers> â A hashref of default headers to apply to requests
=item *
C<local_address> â The local IP address to bind to
=item *
C<keep_alive> â Whether to reuse the last connection (if for the same scheme, host and port) (defaults to 1)
=item *
C<keep_alive_timeout> â How many seconds to keep a connection available for after a request (defaults to 0, unlimited)
=item *
C<max_redirect> â Maximum number of redirects allowed (defaults to 5)
=item *
C<max_size> â Maximum response size in bytes (only when not using a data callback). If defined, requests with responses larger than this will return a 599 status code.
=item *
lib/HTTP/Tiny.pm view on Meta::CPAN
An accessor/mutator method exists for each attribute.
Passing an explicit C<undef> for C<proxy>, C<http_proxy> or C<https_proxy> will
prevent getting the corresponding proxies from the environment.
Errors during request execution will result in a pseudo-HTTP status code of 599
and a reason of "Internal Exception". The content field in the response will
contain the text of the error.
The C<keep_alive> parameter enables a persistent connection, but only to a
single destination scheme, host and port. If any connection-relevant
attributes are modified via accessor, or if the process ID or thread ID change,
the persistent connection will be dropped. If you want persistent connections
across multiple destinations, use multiple HTTP::Tiny objects.
The C<keep_alive_timeout> parameter allows you to control how long a
keep alive connection will be considered for reuse. By setting this lower
than the server keep alive time, this allows you to avoid race conditions where
the server closes the connection while preparing to write the request on
a reused persistent connection.
See L</TLS/SSL SUPPORT> for more on the C<verify_SSL> and C<SSL_options>
attributes.
=head2 get|head|put|post|patch|delete
$response = $http->get($url);
$response = $http->get($url, \%options);
lib/HTTP/Tiny.pm view on Meta::CPAN
In scalar context, returns a boolean indicating if SSL is available.
In list context, returns the boolean and a (possibly multi-line) string of
errors indicating why SSL isn't available.
=head2 connected
$host = $http->connected;
($host, $port) = $http->connected;
Indicates if a connection to a peer is being kept alive, per the C<keep_alive>
option.
In scalar context, returns the peer host and port, joined with a colon, or
C<undef> (if no peer is connected).
In list context, returns the peer host and port or an empty list (if no peer
is connected).
B<Note>: This method cannot reliably be used to discover whether the remote
host has closed its end of the socket.
=for Pod::Coverage SSL_options
agent
allow_credentialed_redirects
allow_downgrade
cookie_jar
default_headers
http_proxy
https_proxy
keep_alive
local_address
max_redirect
max_size
no_proxy
proxy
timeout
verify_SSL
=head1 TLS/SSL SUPPORT
t/001_api.t view on Meta::CPAN
#!perl
use strict;
use warnings;
use Test::More tests => 2;
use HTTP::Tiny;
my @accessors = qw(
agent allow_credentialed_redirects allow_downgrade default_headers http_proxy
https_proxy keep_alive local_address max_redirect max_size proxy no_proxy timeout
SSL_options verify_SSL cookie_jar
);
my @methods = qw(
new get head put post patch delete post_form request mirror www_form_urlencode can_ssl
connected
);
my %api;
@api{@accessors} = (1) x @accessors;
@api{@methods} = (1) x @methods;
t/100_get.t view on Meta::CPAN
my $agent = $new_args{agent} || "HTTP-Tiny/$version";
# cleanup source data
$expect_req =~ s{HTTP-Tiny/VERSION}{$agent};
s{\n}{$CRLF}g for ($expect_req, $give_res);
# setup mocking and test
my $res_fh = tmpfile($give_res);
my $req_fh = tmpfile();
my $http = HTTP::Tiny->new(keep_alive => 0, %new_args);
clear_socket_source();
set_socket_source($req_fh, $res_fh);
(my $url_basename = $url) =~ s{.*/}{};
my @call_args = %options ? ($url, \%options) : ($url);
my $response = $http->get(@call_args);
my ($got_host, $got_port) = connect_args();
my ($exp_host, $exp_port) = (
t/101_head.t view on Meta::CPAN
}
if ( $case->{trailer_cb} ) {
$options{trailer_callback} = eval join "\n", @{$case->{trailer_cb}};
}
# setup mocking and test
my $res_fh = tmpfile($give_res);
my $req_fh = tmpfile();
my $http = HTTP::Tiny->new( keep_alive => 0 );
clear_socket_source();
set_socket_source($req_fh, $res_fh);
(my $url_basename = $url) =~ s{.*/}{};
my @call_args = %options ? ($url, \%options) : ($url);
my $response = $http->head(@call_args);
my $got_req = slurp($req_fh);
t/102_put.t view on Meta::CPAN
}
if ( $case->{trailer_cb} ) {
$options{trailer_callback} = eval join "\n", @{$case->{trailer_cb}};
}
# setup mocking and test
my $res_fh = tmpfile($give_res);
my $req_fh = tmpfile();
my $http = HTTP::Tiny->new( keep_alive => 0 );
clear_socket_source();
set_socket_source($req_fh, $res_fh);
(my $url_basename = $url) =~ s{.*/}{};
my @call_args = %options ? ($url, \%options) : ($url);
my $response = $http->put(@call_args);
my $got_req = slurp($req_fh);
t/103_delete.t view on Meta::CPAN
}
if ( $case->{trailer_cb} ) {
$options{trailer_callback} = eval join "\n", @{$case->{trailer_cb}};
}
# setup mocking and test
my $res_fh = tmpfile($give_res);
my $req_fh = tmpfile();
my $http = HTTP::Tiny->new( keep_alive => 0 );
clear_socket_source();
set_socket_source($req_fh, $res_fh);
(my $url_basename = $url) =~ s{.*/}{};
my @call_args = %options ? ($url, \%options) : ($url);
my $response = $http->delete(@call_args);
my $got_req = slurp($req_fh);
t/104_post.t view on Meta::CPAN
}
if ( $case->{trailer_cb} ) {
$options{trailer_callback} = eval join "\n", @{$case->{trailer_cb}};
}
# setup mocking and test
my $res_fh = tmpfile($give_res);
my $req_fh = tmpfile();
my $http = HTTP::Tiny->new( keep_alive => 0 );
clear_socket_source();
set_socket_source($req_fh, $res_fh);
(my $url_basename = $url) =~ s{.*/}{};
my @call_args = %options ? ($url, \%options) : ($url);
my $response = $http->post(@call_args);
my $got_req = slurp($req_fh);
t/110_mirror.t view on Meta::CPAN
# Deal with stat and daylight savings issues on Windows
# by reading back mtime
$timestamp{$url_basename} = (stat $tempfile)[9];
}
}
# setup mocking and test
my $res_fh = tmpfile($give_res);
my $req_fh = tmpfile();
my $http = HTTP::Tiny->new( keep_alive => 0 );
clear_socket_source();
set_socket_source($req_fh, $res_fh);
my @call_args = %options ? ($url, $tempfile, \%options) : ($url, $tempfile);
my $response = $http->mirror(@call_args);
my $got_req = slurp($req_fh);
my $label = basename($file);
t/130_redirect.t view on Meta::CPAN
# setup mocking and test
my $req_fh = tmpfile();
my $res_fh = tmpfile($give_res);
push @socket_pairs, [$req_fh, $res_fh, $expect_req];
}
clear_socket_source();
set_socket_source(@$_) for @socket_pairs;
my $http = HTTP::Tiny->new(keep_alive => 0, %new_args);
my $response = $http->request(@$call_args);
my $max_redirects = defined($new_args{max_redirect}) ? $new_args{max_redirect} : 5;
my $calls = 0 + $max_redirects;
for my $i ( 0 .. $calls ) {
last unless @socket_pairs;
my ($req_fh, $res_fh, $expect_req) = @{ shift @socket_pairs };
my $got_req = slurp($req_fh);
is( sort_headers($got_req), sort_headers($expect_req), "$label request ($i)");
$i++;
t/150_post_form.t view on Meta::CPAN
}
}
else {
$formdata = [ map { $_ eq "<undef>" ? undef : $_ } @params ];
}
# setup mocking and test
my $res_fh = tmpfile($give_res);
my $req_fh = tmpfile();
my $http = HTTP::Tiny->new( keep_alive => 0 );
clear_socket_source();
set_socket_source($req_fh, $res_fh);
(my $url_basename = $url) =~ s{.*/}{};
my $response = $http->post_form( $url, $formdata, %options ? (\%options) : ());
my $got_req = slurp($req_fh);
my $label = basename($file);
t/160_cookies.t view on Meta::CPAN
$new_args{cookie_jar} = $jar;
# cleanup source data
$expect_req =~ s{HTTP-Tiny/VERSION}{$agent};
s{\n}{$CRLF}g for ($expect_req, $give_res);
# setup mocking and test
my $res_fh = tmpfile($give_res);
my $req_fh = tmpfile();
$http = HTTP::Tiny->new(keep_alive => 0, %new_args) if !defined $http;
clear_socket_source();
set_socket_source($req_fh, $res_fh);
my @call_args = %options ? ($url, \%options) : ($url);
my $response = $http->get(@call_args);
my $got_req = slurp($req_fh);
is( sort_headers($got_req), sort_headers($expect_req), "$label case $case_n request data");
}
}
t/161_basic_auth.t view on Meta::CPAN
# setup mocking and test
my $req_fh = tmpfile();
my $res_fh = tmpfile($give_res);
push @socket_pairs, [$req_fh, $res_fh, $expect_req];
}
clear_socket_source();
set_socket_source(@$_) for @socket_pairs;
my $http = HTTP::Tiny->new(keep_alive => 0, %new_args);
my $response = $http->request(@$call_args);
my $calls = 0
+ (defined($new_args{max_redirect}) ? $new_args{max_redirect} : 5);
for my $i ( 0 .. $calls ) {
last unless @socket_pairs;
my ($req_fh, $res_fh, $expect_req) = @{ shift @socket_pairs };
my $got_req = slurp($req_fh);
is( sort_headers($got_req), sort_headers($expect_req), "$label request ($i)");
t/162_proxy_auth.t view on Meta::CPAN
# setup mocking and test
my $req_fh = tmpfile();
my $res_fh = tmpfile($give_res);
push @socket_pairs, [$req_fh, $res_fh, $expect_req];
}
clear_socket_source();
set_socket_source(@$_) for @socket_pairs;
my $http = HTTP::Tiny->new(keep_alive => 0, %new_args);
my $response = $http->request(@$call_args);
my $calls = 0
+ (defined($new_args{max_redirect}) ? $new_args{max_redirect} : 5);
for my $i ( 0 .. $calls ) {
last unless @socket_pairs;
my ($req_fh, $res_fh, $expect_req) = @{ shift @socket_pairs };
my $got_req = slurp($req_fh);
is( sort_headers($got_req), sort_headers($expect_req), "$label request ($i)");
t/170_keepalive.t view on Meta::CPAN
0123456789
RESPONSE
trim($response);
my $h;
new_ht();
test_ht( "Keep-alive", 1, 'http://foo.com' );
new_ht();
test_ht( "Different scheme", 0, 'https://foo.com' );
new_ht();
test_ht( "Different host", 0, 'http://bar.com' );
new_ht();
test_ht( "Different port", 0, 'http://foo.com:8000' );
t/170_keepalive.t view on Meta::CPAN
new_ht();
$h->timeout(60);
test_ht( "Same timeout", 1, 'http://foo.com' );
new_ht();
$h->default_headers({ 'X-Foo' => 'Bar' });
test_ht( "Default headers change", 1, 'http://foo.com' );
new_ht();
$h->{handle}->{last_used} = time - 3600;
test_ht( "Unlimited keep_alive_timeout", 1, 'http://foo.com' );
new_ht(keep_alive_timeout => 2);
test_ht( "Less than than keep_alive_timeout", 1, 'http://foo.com' );
new_ht(keep_alive_timeout => 2);
$h->{handle}->{last_used} = time - 3;
test_ht( "Longer than than keep_alive_timeout", 0, 'http://foo.com' );
new_ht();
$h->{handle}->close;
test_ht( "Socket closed", 0, 'http://foo.com' );
for my $file ( dir_list( "corpus", qr/^keepalive/ ) ) {
my $label = basename($file);
my $data = do { local ( @ARGV, $/ ) = $file; <> };
my ( $title, $ok, $response ) = map { trim($_) } split /--+/, $data;
new_ht();
clear_socket_source();
set_socket_source( tmpfile(), tmpfile($response) );
$h->request( 'POST', 'http://foo.com', { content => 'xx' } );
is !!$h->{handle}, !!$ok, "$label - $title";
}
t/170_keepalive.t view on Meta::CPAN
clear_socket_source();
set_socket_source( tmpfile(), tmpfile($response) );
$can_read = 0 if $result;
my $old = $h->{handle} || 'old';
$h->request( 'POST', $url, { content => 'xx' } );
my $new = $h->{handle} || 'new';
is $old eq $new, $result, $title;
}
sub new_ht {
$h = HTTP::Tiny->new( keep_alive => 1, @_ );
$can_read = 1;
clear_socket_source();
set_socket_source( tmpfile(), tmpfile($response) );
$h->request( 'POST', 'http://foo.com' );
}
sub trim { $_[0] =~ s/^\s+//; $_[0] =~ s/\s+$//; return $_ }
done_testing;