summaryrefslogtreecommitdiff
path: root/cpan/HTTP-Tiny
diff options
context:
space:
mode:
authorChris 'BinGOs' Williams <chris@bingosnet.co.uk>2014-02-17 20:30:07 +0000
committerChris 'BinGOs' Williams <chris@bingosnet.co.uk>2014-02-17 20:30:07 +0000
commit91e4447ad17c1687664c3d73092318aa84d013a3 (patch)
treed3a0f0291822a32440b77e5e07aca67d4065998f /cpan/HTTP-Tiny
parent7dcac5f6a5195002b55c935ee1d67f67e1df280b (diff)
downloadperl-91e4447ad17c1687664c3d73092318aa84d013a3.tar.gz
Update HTTP-Tiny to CPAN version 0.041
[DELTA] 0.041 2014-02-17 13:07:54-05:00 America/New_York [no code change, only an amended Changes file] [INCOMPATIBLE CHANGES (from 0.039)] - 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) 0.040 2014-02-17 13:02:47-05:00 America/New_York [INCOMPATIBLE CHANGES] - 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] - Added support for Basic authorization with proxies - Added support for https proxies via CONNECT
Diffstat (limited to 'cpan/HTTP-Tiny')
-rw-r--r--cpan/HTTP-Tiny/lib/HTTP/Tiny.pm671
-rw-r--r--cpan/HTTP-Tiny/t/001_api.t3
-rw-r--r--cpan/HTTP-Tiny/t/100_get.t2
-rw-r--r--cpan/HTTP-Tiny/t/101_head.t2
-rw-r--r--cpan/HTTP-Tiny/t/102_put.t2
-rw-r--r--cpan/HTTP-Tiny/t/103_delete.t2
-rw-r--r--cpan/HTTP-Tiny/t/104_post.t2
-rw-r--r--cpan/HTTP-Tiny/t/110_mirror.t2
-rw-r--r--cpan/HTTP-Tiny/t/130_redirect.t2
-rw-r--r--cpan/HTTP-Tiny/t/140_proxy.t8
-rw-r--r--cpan/HTTP-Tiny/t/150_post_form.t2
-rw-r--r--cpan/HTTP-Tiny/t/160_cookies.t3
-rw-r--r--cpan/HTTP-Tiny/t/161_basic_auth.t2
-rw-r--r--cpan/HTTP-Tiny/t/162_proxy_auth.t75
-rw-r--r--cpan/HTTP-Tiny/t/170_keepalive.t98
-rw-r--r--cpan/HTTP-Tiny/t/Util.pm7
-rw-r--r--cpan/HTTP-Tiny/t/cases/keepalive-01.txt9
-rw-r--r--cpan/HTTP-Tiny/t/cases/keepalive-02.txt10
-rw-r--r--cpan/HTTP-Tiny/t/cases/keepalive-03.txt11
-rw-r--r--cpan/HTTP-Tiny/t/cases/keepalive-04.txt10
-rw-r--r--cpan/HTTP-Tiny/t/cases/keepalive-05.txt11
-rw-r--r--cpan/HTTP-Tiny/t/cases/proxy-auth-01.txt21
22 files changed, 830 insertions, 125 deletions
diff --git a/cpan/HTTP-Tiny/lib/HTTP/Tiny.pm b/cpan/HTTP-Tiny/lib/HTTP/Tiny.pm
index bb824c2eaa..9ed66bc1a3 100644
--- a/cpan/HTTP-Tiny/lib/HTTP/Tiny.pm
+++ b/cpan/HTTP-Tiny/lib/HTTP/Tiny.pm
@@ -3,18 +3,81 @@ package HTTP::Tiny;
use strict;
use warnings;
# ABSTRACT: A small, simple, correct HTTP/1.1 client
-our $VERSION = '0.039'; # VERSION
+our $VERSION = '0.041'; # VERSION
use Carp ();
+# =method new
+#
+# $http = HTTP::Tiny->new( %attributes );
+#
+# This constructor returns a new HTTP::Tiny object. Valid attributes include:
+#
+# =for :list
+# * C<agent>
+# A user-agent string (defaults to 'HTTP-Tiny/$VERSION'). If C<agent> ends in a space character, the default user-agent string is appended.
+# * C<cookie_jar>
+# An instance of L<HTTP::CookieJar> or equivalent class that supports the C<add> and C<cookie_header> methods
+# * C<default_headers>
+# A hashref of default headers to apply to requests
+# * C<local_address>
+# The local IP address to bind to
+# * C<keep_alive>
+# Whether to reuse the last connection (if for the same scheme, host and port) (defaults to 1)
+# * C<max_redirect>
+# Maximum number of redirects allowed (defaults to 5)
+# * C<max_size>
+# Maximum response size (only when not using a data callback). If defined, responses larger than this will return an exception.
+# * C<http_proxy>
+# URL of a proxy server to use for HTTP connections (default is C<$ENV{http_proxy}> if set)
+# * C<https_proxy>
+# URL of a proxy server to use for HTTPS connections (default is C<$ENV{https_proxy}> if set)
+# * C<proxy>
+# URL of a generic proxy server for both HTTP and HTTPS connections (default is C<$ENV{all_proxy}> if set)
+# * C<no_proxy>
+# List of domain suffixes that should not be proxied. Must be a comma-separated string or an array reference. (default is C<$ENV{no_proxy}>)
+# * C<timeout>
+# Request timeout in seconds (default is 60)
+# * C<verify_SSL>
+# A boolean that indicates whether to validate the SSL certificate of an C<https>
+# connection (default is false)
+# * C<SSL_options>
+# A hashref of C<SSL_*> options to pass through to L<IO::Socket::SSL>
+#
+# Exceptions from C<max_size>, C<timeout> or other errors 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 exception.
+#
+# The C<keep_alive> parameter enables a persistent connection, but only to a
+# single destination scheme, host and port. Also, if any connection-relevant
+# attributes are modified, a persistent connection will be dropped. If you want
+# persistent connections across multiple destinations, use multiple HTTP::Tiny
+# objects.
+#
+# See L</SSL SUPPORT> for more on the C<verify_SSL> and C<SSL_options> attributes.
+#
+# =cut
my @attributes;
BEGIN {
- @attributes = qw(cookie_jar default_headers local_address max_redirect max_size proxy no_proxy timeout SSL_options verify_SSL);
+ @attributes = qw(
+ cookie_jar default_headers http_proxy https_proxy keep_alive
+ local_address max_redirect max_size proxy no_proxy timeout
+ 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 ? $_[0]->{$accessor} = $_[1] : $_[0]->{$accessor};
+ @_ > 1
+ ? do {
+ delete $_[0]->{handle} if !$persist_ok{$accessor} && $_[1] ne $_[0]->{$accessor};
+ $_[0]->{$accessor} = $_[1]
+ }
+ : $_[0]->{$accessor};
};
}
}
@@ -34,6 +97,7 @@ sub new {
my $self = {
max_redirect => 5,
timeout => 60,
+ keep_alive => 1,
verify_SSL => $args{verify_SSL} || $args{verify_ssl} || 0, # no verification by default
no_proxy => $ENV{no_proxy},
};
@@ -48,13 +112,43 @@ sub new {
$self->agent( exists $args{agent} ? $args{agent} : $class->_agent );
- # Never override proxy argument as this breaks backwards compat.
- if (!exists $self->{proxy} && (my $http_proxy = $ENV{http_proxy})) {
- if ($http_proxy =~ m{\Ahttp://[^/?#:@]+:\d+/?\z}) {
- $self->{proxy} = $http_proxy;
+ $self->_set_proxies;
+
+ return $self;
+}
+
+sub _set_proxies {
+ my ($self) = @_;
+
+ if (! $self->{proxy} ) {
+ $self->{proxy} = $ENV{all_proxy} || $ENV{ALL_PROXY};
+ if ( defined $self->{proxy} ) {
+ $self->_split_proxy( 'generic proxy' => $self->{proxy} ); # validate
+ }
+ else {
+ delete $self->{proxy};
+ }
+ }
+
+ if (! $self->{http_proxy} ) {
+ $self->{http_proxy} = $ENV{http_proxy} || $self->{proxy};
+ if ( defined $self->{http_proxy} ) {
+ $self->_split_proxy( http_proxy => $self->{http_proxy} ); # validate
+ $self->{_has_proxy}{http} = 1;
}
else {
- Carp::croak(qq{Environment 'http_proxy' must be in format http://<host>:<port>/\n});
+ delete $self->{http_proxy};
+ }
+ }
+
+ if (! $self->{https_proxy} ) {
+ $self->{https_proxy} = $ENV{https_proxy} || $ENV{HTTPS_PROXY} || $self->{proxy};
+ if ( $self->{https_proxy} ) {
+ $self->_split_proxy( https_proxy => $self->{https_proxy} ); # validate
+ $self->{_has_proxy}{https} = 1;
+ }
+ else {
+ delete $self->{https_proxy};
}
}
@@ -64,9 +158,22 @@ sub new {
(defined $self->{no_proxy}) ? [ split /\s*,\s*/, $self->{no_proxy} ] : [];
}
- return $self;
+ return;
}
+# =method get|head|put|post|delete
+#
+# $response = $http->get($url);
+# $response = $http->get($url, \%options);
+# $response = $http->head($url);
+#
+# These methods are shorthand for calling C<request()> for the given method. The
+# URL must have unsafe characters escaped and international domain names encoded.
+# See C<request()> for valid options and a description of the response.
+#
+# The C<success> field of the response will be true if the status code is 2XX.
+#
+# =cut
for my $sub_name ( qw/get head put post delete/ ) {
my $req_method = uc $sub_name;
@@ -81,6 +188,25 @@ for my $sub_name ( qw/get head put post delete/ ) {
HERE
}
+# =method post_form
+#
+# $response = $http->post_form($url, $form_data);
+# $response = $http->post_form($url, $form_data, \%options);
+#
+# This method executes a C<POST> request and sends the key/value pairs from a
+# form data hash or array reference to the given URL with a C<content-type> of
+# C<application/x-www-form-urlencoded>. If data is provided as an array
+# reference, the order is preserved; if provided as a hash reference, the terms
+# are sorted on key and value for consistency. See documentation for the
+# C<www_form_urlencode> method for details on the encoding.
+#
+# The URL must have unsafe characters escaped and international domain names
+# encoded. See C<request()> for valid options and a description of the response.
+# Any C<content-type> header or content in the options hashref will be ignored.
+#
+# The C<success> field of the response will be true if the status code is 2XX.
+#
+# =cut
sub post_form {
my ($self, $url, $data, $args) = @_;
@@ -104,6 +230,28 @@ sub post_form {
);
}
+# =method mirror
+#
+# $response = $http->mirror($url, $file, \%options)
+# if ( $response->{success} ) {
+# print "$file is up to date\n";
+# }
+#
+# Executes a C<GET> request for the URL and saves the response body to the file
+# name provided. The URL must have unsafe characters escaped and international
+# domain names encoded. If the file already exists, the request will include an
+# C<If-Modified-Since> header with the modification timestamp of the file. You
+# may specify a different C<If-Modified-Since> header yourself in the C<<
+# $options->{headers} >> hash.
+#
+# The C<success> field of the response will be true if the status code is 2XX
+# or if the status code is 304 (unmodified).
+#
+# If the file was modified and the server response includes a properly
+# formatted C<Last-Modified> header, the file modification time will
+# be updated accordingly.
+#
+# =cut
sub mirror {
my ($self, $url, $file, $args) = @_;
@@ -136,6 +284,86 @@ sub mirror {
return $response;
}
+# =method request
+#
+# $response = $http->request($method, $url);
+# $response = $http->request($method, $url, \%options);
+#
+# Executes an HTTP request of the given method type ('GET', 'HEAD', 'POST',
+# 'PUT', etc.) on the given URL. The URL must have unsafe characters escaped and
+# international domain names encoded.
+#
+# If the URL includes a "user:password" stanza, they will be used for Basic-style
+# authorization headers. (Authorization headers will not be included in a
+# redirected request.) For example:
+#
+# $http->request('GET', 'http://Aladdin:open sesame@example.com/');
+#
+# If the "user:password" stanza contains reserved characters, they must
+# be percent-escaped:
+#
+# $http->request('GET', 'http://john%40example.com:password@example.com/');
+#
+# A hashref of options may be appended to modify the request.
+#
+# Valid options are:
+#
+# =for :list
+# * C<headers>
+# A hashref containing headers to include with the request. If the value for
+# a header is an array reference, the header will be output multiple times with
+# each value in the array. These headers over-write any default headers.
+# * C<content>
+# A scalar to include as the body of the request OR a code reference
+# that will be called iteratively to produce the body of the request
+# * C<trailer_callback>
+# A code reference that will be called if it exists to provide a hashref
+# of trailing headers (only used with chunked transfer-encoding)
+# * C<data_callback>
+# A code reference that will be called for each chunks of the response
+# body received.
+#
+# If the C<content> option is a code reference, it will be called iteratively
+# to provide the content body of the request. It should return the empty
+# string or undef when the iterator is exhausted.
+#
+# If the C<content> option is the empty string, no C<content-type> or
+# C<content-length> headers will be generated.
+#
+# If the C<data_callback> option is provided, it will be called iteratively until
+# the entire response body is received. The first argument will be a string
+# containing a chunk of the response body, the second argument will be the
+# in-progress response hash reference, as described below. (This allows
+# customizing the action of the callback based on the C<status> or C<headers>
+# received prior to the content body.)
+#
+# The C<request> method returns a hashref containing the response. The hashref
+# will have the following keys:
+#
+# =for :list
+# * C<success>
+# Boolean indicating whether the operation returned a 2XX status code
+# * C<url>
+# URL that provided the response. This is the URL of the request unless
+# there were redirections, in which case it is the last URL queried
+# in a redirection chain
+# * C<status>
+# The HTTP status code of the response
+# * C<reason>
+# The response phrase returned by the server
+# * C<content>
+# The body of the response. If the response does not have any content
+# or if a data callback is provided to consume the response body,
+# this will be the empty string
+# * C<headers>
+# A hashref of header fields. All header field names will be normalized
+# to be lower case. If a header is repeated, the value will be an arrayref;
+# it will otherwise be a scalar string containing the value
+#
+# On an exception during the execution of the request, the C<status> field will
+# contain 599, and the C<content> field will contain the text of the exception.
+#
+# =cut
my %idempotent = map { $_ => 1 } qw/GET HEAD PUT DELETE OPTIONS TRACE/;
@@ -153,7 +381,14 @@ sub request {
&& $@ =~ m{^(?:Socket closed|Unexpected end)};
}
- if (my $e = "$@") {
+ if (my $e = $@) {
+ # maybe we got a response hash thrown from somewhere deep
+ if ( ref $e eq 'HASH' && exists $e->{status} ) {
+ return $e;
+ }
+
+ # otherwise, stringify it
+ $e = "$e";
$response = {
url => $url,
success => q{},
@@ -169,6 +404,22 @@ sub request {
return $response;
}
+# =method www_form_urlencode
+#
+# $params = $http->www_form_urlencode( $data );
+# $response = $http->get("http://example.com/query?$params");
+#
+# This method converts the key/value pairs from a data hash or array reference
+# into a C<x-www-form-urlencoded> string. The keys and values from the data
+# reference will be UTF-8 encoded and escaped per RFC 3986. If a value is an
+# array reference, the key will be repeated with each of the values of the array
+# reference. If data is provided as a hash reference, the key/value pairs in the
+# resulting string will be sorted by key and value for consistent ordering.
+#
+# To preserve the order (r
+#
+#
+# =cut
sub www_form_urlencode {
my ($self, $data) = @_;
@@ -223,22 +474,17 @@ sub _request {
headers => {},
};
- my $handle = HTTP::Tiny::Handle->new(
- timeout => $self->{timeout},
- SSL_options => $self->{SSL_options},
- verify_SSL => $self->{verify_SSL},
- local_address => $self->{local_address},
- );
-
- if ($self->{proxy} && ! grep { $host =~ /\Q$_\E$/ } @{$self->{no_proxy}}) {
- $request->{uri} = "$scheme://$request->{host_port}$path_query";
- die(qq/HTTPS via proxy is not supported\n/)
- if $request->{scheme} eq 'https';
- $handle->connect(($self->_split_url($self->{proxy}))[0..2]);
- }
- else {
- $handle->connect($scheme, $host, $port);
+ # We remove the cached handle so it is not reused in the case of redirect.
+ # If all is well, it will be recached at the end of _request. We only
+ # reuse for the same scheme, host and port
+ my $handle = delete $self->{handle};
+ if ( $handle ) {
+ unless ( $handle->can_reuse( $scheme, $host, $port ) ) {
+ $handle->close;
+ undef $handle;
+ }
}
+ $handle ||= $self->_open_handle( $request, $scheme, $host, $port );
$self->_prepare_headers_and_cb($request, $args, $url, $auth);
$handle->write_request($request);
@@ -254,20 +500,137 @@ sub _request {
return $self->_request(@redir_args, $args);
}
+ my $known_message_length;
if ($method eq 'HEAD' || $response->{status} =~ /^[23]04/) {
# response has no message body
+ $known_message_length = 1;
}
else {
my $data_cb = $self->_prepare_data_cb($response, $args);
- $handle->read_body($data_cb, $response);
+ $known_message_length = $handle->read_body($data_cb, $response);
}
- $handle->close;
- $response->{success} = substr($response->{status},0,1) eq '2';
+ if ( $self->{keep_alive}
+ && $known_message_length
+ && $response->{protocol} eq 'HTTP/1.1'
+ && ($response->{headers}{connection} || '') ne 'close'
+ ) {
+ $self->{handle} = $handle;
+ }
+ else {
+ $handle->close;
+ }
+
+ $response->{success} = substr( $response->{status}, 0, 1 ) eq '2';
$response->{url} = $url;
return $response;
}
+sub _open_handle {
+ my ($self, $request, $scheme, $host, $port) = @_;
+
+ 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}
+ );
+
+ 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);
+ }
+}
+
+sub _proxy_connect {
+ my ($self, $request, $handle) = @_;
+
+ $request->{uri} = "$request->{scheme}://$request->{host_port}$request->{uri}";
+
+ my @proxy_vars;
+ if ( $request->{scheme} eq 'https' ) {
+ Carp::croak(qq{No https_proxy defined}) unless $self->{https_proxy};
+ @proxy_vars = $self->_split_proxy( https_proxy => $self->{https_proxy} );
+ if ( $proxy_vars[0] eq 'https' ) {
+ Carp::croak(qq{Can't proxy https over https: $request->{uri} via $self->{https_proxy}});
+ }
+ }
+ else {
+ Carp::croak(qq{No http_proxy defined}) unless $self->{http_proxy};
+ @proxy_vars = $self->_split_proxy( http_proxy => $self->{http_proxy} );
+ }
+
+ my ($p_scheme, $p_host, $p_port, $p_auth) = @proxy_vars;
+
+ if ( length $p_auth && ! defined $request->{headers}{'proxy-authorization'} ) {
+ $self->_add_basic_auth_header( $request, 'proxy-authorization' => $p_auth );
+ }
+
+ $handle->connect($p_scheme, $p_host, $p_port);
+
+ $self->_create_proxy_tunnel( $request, $handle )
+ if $request->{scheme} eq 'https';
+
+ return $handle;
+}
+
+sub _split_proxy {
+ my ($self, $type, $proxy) = @_;
+
+ my ($scheme, $host, $port, $path_query, $auth) = eval { $self->_split_url($proxy) };
+
+ unless(
+ defined($scheme) && length($scheme) && length($host) && length($port)
+ && $path_query eq '/'
+ ) {
+ Carp::croak(qq{$type URL must be in format http[s]://[auth@]<host>:<port>/\n});
+ }
+
+ return ($scheme, $host, $port, $auth);
+}
+
+sub _create_proxy_tunnel {
+ my ($self, $request, $handle) = @_;
+
+ $handle->_assert_ssl;
+
+ my $agent = exists($request->{headers}{'user-agent'})
+ ? $request->{headers}{'user-agent'} : $self->{agent};
+
+ my $connect_request = {
+ method => 'CONNECT',
+ uri => $request->{host_port},
+ headers => {
+ host => $request->{host_port},
+ 'user-agent' => $agent,
+ }
+ };
+
+ if ( $request->{headers}{'proxy-authorization'} ) {
+ $connect_request->{headers}{'proxy-authorization'} =
+ delete $request->{headers}{'proxy-authorization'};
+ }
+
+ $handle->write_request($connect_request);
+ my $response;
+ do { $response = $handle->read_response_header }
+ until (substr($response->{status},0,1) ne '1');
+
+ # if CONNECT failed, throw the response so it will be
+ # returned from the original request() method;
+ unless (substr($response->{status},0,1) eq '2') {
+ die $response;
+ }
+
+ # tunnel established, so start SSL handshake
+ $handle->start_ssl( $request->{host} );
+
+ return;
+}
+
sub _prepare_headers_and_cb {
my ($self, $request, $args, $url, $auth) = @_;
@@ -278,8 +641,9 @@ sub _prepare_headers_and_cb {
}
}
$request->{headers}{'host'} = $request->{host_port};
- $request->{headers}{'connection'} = "close";
$request->{headers}{'user-agent'} ||= $self->{agent};
+ $request->{headers}{'connection'} = "close"
+ unless $self->{keep_alive};
if ( defined $args->{content} ) {
if (ref $args->{content} eq 'CODE') {
@@ -313,14 +677,20 @@ sub _prepare_headers_and_cb {
# if we have Basic auth parameters, add them
if ( length $auth && ! defined $request->{headers}{authorization} ) {
- require MIME::Base64;
- $request->{headers}{authorization} =
- "Basic " . MIME::Base64::encode_base64($auth, "");
+ $self->_add_basic_auth_header( $request, 'authorization' => $auth );
}
return;
}
+sub _add_basic_auth_header {
+ my ($self, $request, $header, $auth) = @_;
+ require MIME::Base64;
+ $request->{headers}{$header} =
+ "Basic " . MIME::Base64::encode_base64($auth, "");
+ return;
+}
+
sub _prepare_data_cb {
my ($self, $response, $args) = @_;
my $data_cb = $args->{data_callback};
@@ -504,12 +874,7 @@ sub connect {
my ($self, $scheme, $host, $port) = @_;
if ( $scheme eq 'https' ) {
- # Need IO::Socket::SSL 1.42 for SSL_create_ctx_callback
- die(qq/IO::Socket::SSL 1.42 must be installed for https support\n/)
- unless eval {require IO::Socket::SSL; IO::Socket::SSL->VERSION(1.42)};
- # Need Net::SSLeay 1.49 for MODE_AUTO_RETRY
- die(qq/Net::SSLeay 1.49 must be installed for https support\n/)
- unless eval {require Net::SSLeay; Net::SSLeay->VERSION(1.49)};
+ $self->_assert_ssl;
}
elsif ( $scheme ne 'http' ) {
die(qq/Unsupported URL scheme '$scheme'\n/);
@@ -521,33 +886,49 @@ sub connect {
( LocalAddr => $self->{local_address} ) : (),
Proto => 'tcp',
Type => SOCK_STREAM,
- Timeout => $self->{timeout}
+ Timeout => $self->{timeout},
+ KeepAlive => !!$self->{keep_alive}
) or die(qq/Could not connect to '$host:$port': $@\n/);
binmode($self->{fh})
or die(qq/Could not binmode() socket: '$!'\n/);
- if ( $scheme eq 'https') {
- my $ssl_args = $self->_ssl_args($host);
- IO::Socket::SSL->start_SSL(
- $self->{fh},
- %$ssl_args,
- SSL_create_ctx_callback => sub {
- my $ctx = shift;
- Net::SSLeay::CTX_set_mode($ctx, Net::SSLeay::MODE_AUTO_RETRY());
- },
- );
+ $self->start_ssl($host) if $scheme eq 'https';
+
+ $self->{scheme} = $scheme;
+ $self->{host} = $host;
+ $self->{port} = $port;
- unless ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
+ return $self;
+}
+
+sub start_ssl {
+ my ($self, $host) = @_;
+
+ # As this might be used via CONNECT after an SSL session
+ # to a proxy, we shut down any existing SSL before attempting
+ # the handshake
+ if ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
+ unless ( $self->{fh}->stop_SSL ) {
my $ssl_err = IO::Socket::SSL->errstr;
- die(qq/SSL connection failed for $host: $ssl_err\n/);
+ die(qq/Error halting prior SSL connection: $ssl_err/);
}
}
- $self->{host} = $host;
- $self->{port} = $port;
+ my $ssl_args = $self->_ssl_args($host);
+ IO::Socket::SSL->start_SSL(
+ $self->{fh},
+ %$ssl_args,
+ SSL_create_ctx_callback => sub {
+ my $ctx = shift;
+ Net::SSLeay::CTX_set_mode($ctx, Net::SSLeay::MODE_AUTO_RETRY());
+ },
+ );
- return $self;
+ unless ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
+ my $ssl_err = IO::Socket::SSL->errstr;
+ die(qq/SSL connection failed for $host: $ssl_err\n/);
+ }
}
sub close {
@@ -723,11 +1104,13 @@ my %HeaderCase = (
'x-xss-protection' => 'X-XSS-Protection',
);
+# to avoid multiple small writes and hence nagle, you can pass the method line or anything else to
+# combine writes.
sub write_header_lines {
- (@_ == 2 && ref $_[1] eq 'HASH') || die(q/Usage: $handle->write_header_lines(headers)/ . "\n");
- my($self, $headers) = @_;
+ (@_ == 2 || @_ == 3 && ref $_[1] eq 'HASH') || die(q/Usage: $handle->write_header_lines(headers[,prefix])/ . "\n");
+ my($self, $headers, $prefix_data) = @_;
- my $buf = '';
+ my $buf = (defined $prefix_data ? $prefix_data : '');
while (my ($k, $v) = each %$headers) {
my $field_name = lc $k;
if (exists $HeaderCase{$field_name}) {
@@ -749,17 +1132,17 @@ sub write_header_lines {
return $self->write($buf);
}
+# return value indicates whether message length was defined; this is generally
+# true unless there was no content-length header and we just read until EOF.
+# Other message length errors are thrown as exceptions
sub read_body {
@_ == 3 || die(q/Usage: $handle->read_body(callback, response)/ . "\n");
my ($self, $cb, $response) = @_;
my $te = $response->{headers}{'transfer-encoding'} || '';
- if ( grep { /chunked/i } ( ref $te eq 'ARRAY' ? @$te : $te ) ) {
- $self->read_chunked_body($cb, $response);
- }
- else {
- $self->read_content_body($cb, $response);
- }
- return;
+ my $chunked = grep { /chunked/i } ( ref $te eq 'ARRAY' ? @$te : $te ) ;
+ return $chunked
+ ? $self->read_chunked_body($cb, $response)
+ : $self->read_content_body($cb, $response);
}
sub write_body {
@@ -785,11 +1168,11 @@ sub read_content_body {
$cb->($self->read($read, 0), $response);
$len -= $read;
}
+ return length($self->{rbuf}) == 0;
}
- else {
- my $chunk;
- $cb->($chunk, $response) while length( $chunk = $self->read(BUFSIZE, 1) );
- }
+
+ my $chunk;
+ $cb->($chunk, $response) while length( $chunk = $self->read(BUFSIZE, 1) );
return;
}
@@ -838,7 +1221,7 @@ sub read_chunked_body {
or die(qq/Malformed chunk: missing CRLF after chunk data\n/);
}
$self->read_header_lines($response->{headers});
- return;
+ return 1;
}
sub write_chunked_body {
@@ -887,10 +1270,10 @@ sub read_response_header {
unless $version =~ /0*1\.0*[01]/;
return {
- status => $status,
- reason => $reason,
- headers => $self->read_header_lines,
- protocol => $protocol,
+ status => $status,
+ reason => $reason,
+ headers => $self->read_header_lines,
+ protocol => $protocol,
};
}
@@ -898,8 +1281,7 @@ sub write_request_header {
@_ == 4 || die(q/Usage: $handle->write_request_header(method, request_uri, headers)/ . "\n");
my ($self, $method, $request_uri, $headers) = @_;
- return $self->write("$method $request_uri HTTP/1.1\x0D\x0A")
- + $self->write_header_lines($headers);
+ return $self->write_header_lines($headers, "$method $request_uri HTTP/1.1\x0D\x0A");
}
sub _do_timeout {
@@ -936,6 +1318,9 @@ sub _do_timeout {
sub can_read {
@_ == 1 || @_ == 2 || die(q/Usage: $handle->can_read([timeout])/ . "\n");
my $self = shift;
+ if ( ref($self->{fh}) eq 'IO::Socket::SSL' ) {
+ return 1 if $self->{fh}->pending;
+ }
return $self->_do_timeout('read', @_)
}
@@ -945,6 +1330,27 @@ sub can_write {
return $self->_do_timeout('write', @_)
}
+sub _assert_ssl {
+ # Need IO::Socket::SSL 1.42 for SSL_create_ctx_callback
+ die(qq/IO::Socket::SSL 1.42 must be installed for https support\n/)
+ unless eval {require IO::Socket::SSL; IO::Socket::SSL->VERSION(1.42)};
+ # Need Net::SSLeay 1.49 for MODE_AUTO_RETRY
+ die(qq/Net::SSLeay 1.49 must be installed for https support\n/)
+ unless eval {require Net::SSLeay; Net::SSLeay->VERSION(1.49)};
+}
+
+sub can_reuse {
+ my ($self,$scheme,$host,$port) = @_;
+ return 0 if
+ length($self->{rbuf})
+ || $scheme ne $self->{scheme}
+ || $host ne $self->{host}
+ || $port ne $self->{port}
+ || eval { $self->can_read(0) }
+ || $@ ;
+ return 1;
+}
+
# Try to find a CA bundle to validate the SSL cert,
# prefer Mozilla::CA or fallback to a system file
sub _find_CA_file {
@@ -973,7 +1379,7 @@ sub _ssl_args {
my ($self, $host) = @_;
my %ssl_args;
-
+
# This test reimplements IO::Socket::SSL::can_client_sni(), which wasn't
# added until IO::Socket::SSL 1.84
if ( Net::SSLeay::OPENSSL_VERSION_NUMBER() >= 0x01000000 ) {
@@ -1013,7 +1419,7 @@ HTTP::Tiny - A small, simple, correct HTTP/1.1 client
=head1 VERSION
-version 0.039
+version 0.041
=head1 SYNOPSIS
@@ -1039,8 +1445,7 @@ This is a very simple HTTP/1.1 client, designed for doing simple GET
requests without the overhead of a large framework like L<LWP::UserAgent>.
It is more correct and more complete than L<HTTP::Lite>. It supports
-proxies (currently only non-authenticating ones) and redirection. It
-also correctly resumes after EINTR.
+proxies and redirection. It also correctly resumes after EINTR.
=head1 METHODS
@@ -1078,6 +1483,12 @@ 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<max_redirect>
Maximum number of redirects allowed (defaults to 5)
@@ -1086,14 +1497,25 @@ Maximum number of redirects allowed (defaults to 5)
C<max_size>
-Maximum response size (only when not using a data callback). If defined,
-responses larger than this will return an exception.
+Maximum response size (only when not using a data callback). If defined, responses larger than this will return an exception.
+
+=item *
+
+C<http_proxy>
+
+URL of a proxy server to use for HTTP connections (default is C<$ENV{http_proxy}> if set)
+
+=item *
+
+C<https_proxy>
+
+URL of a proxy server to use for HTTPS connections (default is C<$ENV{https_proxy}> if set)
=item *
C<proxy>
-URL of a proxy server to use (default is C<$ENV{http_proxy}> if set)
+URL of a generic proxy server for both HTTP and HTTPS connections (default is C<$ENV{all_proxy}> if set)
=item *
@@ -1126,6 +1548,12 @@ Exceptions from C<max_size>, C<timeout> or other errors 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 exception.
+The C<keep_alive> parameter enables a persistent connection, but only to a
+single destination scheme, host and port. Also, if any connection-relevant
+attributes are modified, a persistent connection will be dropped. If you want
+persistent connections across multiple destinations, use multiple HTTP::Tiny
+objects.
+
See L</SSL SUPPORT> for more on the C<verify_SSL> and C<SSL_options> attributes.
=head2 get|head|put|post|delete
@@ -1316,25 +1744,29 @@ resulting string will be sorted by key and value for consistent ordering.
To preserve the order (r
-=for Pod::Coverage agent
+=for Pod::Coverage SSL_options
+agent
cookie_jar
default_headers
+http_proxy
+https_proxy
+keep_alive
local_address
max_redirect
max_size
-proxy
no_proxy
+proxy
timeout
verify_SSL
-SSL_options
=head1 SSL SUPPORT
Direct C<https> connections are supported only if L<IO::Socket::SSL> 1.56 or
greater and L<Net::SSLeay> 1.49 or greater are installed. An exception will be
thrown if a new enough versions of these modules not installed or if the SSL
-encryption fails. There is no support for C<https> connections via proxy (i.e.
-RFC 2817).
+encryption fails. An C<https> connection may be made via an C<http> proxy that
+supports the CONNECT command (i.e. RFC 2817). You may not proxy C<https> via
+a proxy that itself requires C<https> to communicate.
SSL provides two distinct capabilities:
@@ -1411,6 +1843,43 @@ client certificate for authentication to a server or controlling the choice of
cipher used for the SSL connection. See L<IO::Socket::SSL> documentation for
details.
+=head1 PROXY SUPPORT
+
+HTTP::Tiny can proxy both C<http> and C<https> requests. Only Basic proxy
+authorization is supported and it must be provided as part of the proxy URL:
+C<http://user:pass@proxy.example.com/>.
+
+HTTP::Tiny supports the following proxy environment variables:
+
+=over 4
+
+=item *
+
+http_proxy
+
+=item *
+
+https_proxy or HTTPS_PROXY
+
+=item *
+
+all_proxy or ALL_PROXY
+
+=back
+
+Tunnelling C<https> over an C<http> proxy using the CONNECT method is
+supported. If your proxy uses C<https> itself, you can not tunnel C<https>
+over it.
+
+Be warned that proxying an C<https> connection opens you to the risk of a
+man-in-the-middle attack by the proxy server.
+
+The C<no_proxy> environment variable is supported in the format of a
+comma-separated list of domain extensions proxy should not be used for.
+
+Proxy arguments passed to C<new> will override their corresponding
+environment variables.
+
=head1 LIMITATIONS
HTTP::Tiny is I<conditionally compliant> with the
@@ -1444,28 +1913,10 @@ mandated by the specification. There is no automatic support for status 305
=item *
-Persistent connections are not supported. The C<Connection> header will
-always be set to C<close>.
-
-=item *
-
Cookie support requires L<HTTP::CookieJar> or an equivalent class.
=item *
-Only the C<http_proxy> environment variable is supported in the format
-C<http://HOST:PORT/>. If a C<proxy> argument is passed to C<new> (including
-undef), then the C<http_proxy> environment variable is ignored.
-
-=item *
-
-C<no_proxy> environment variable is supported in the format comma-separated
-list of domain extensions proxy should not be used for. If a C<no_proxy>
-argument is passed to C<new>, then the C<no_proxy> environment variable is
-ignored.
-
-=item *
-
There is no provision for delaying a request body using an C<Expect> header.
Unexpected C<1XX> responses are silently ignored as per the specification.
@@ -1584,6 +2035,10 @@ Claes Jakobsson <claes@surfar.nu>
=item *
+Clinton Gormley <clint@traveljury.com>
+
+=item *
+
Craig Berry <cberry@cpan.org>
=item *
@@ -1604,6 +2059,10 @@ Lukas Eklund <leklund@gmail.com>
=item *
+Martin J. Evans <mjegh@ntlworld.com>
+
+=item *
+
Martin-Louis Bright <mlbright@gmail.com>
=item *
@@ -1630,7 +2089,7 @@ Tony Cook <tony@develop-help.com>
=head1 COPYRIGHT AND LICENSE
-This software is copyright (c) 2013 by Christian Hansen.
+This software is copyright (c) 2014 by Christian Hansen.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
diff --git a/cpan/HTTP-Tiny/t/001_api.t b/cpan/HTTP-Tiny/t/001_api.t
index 0111851e03..8e6ccd24c5 100644
--- a/cpan/HTTP-Tiny/t/001_api.t
+++ b/cpan/HTTP-Tiny/t/001_api.t
@@ -7,7 +7,8 @@ use Test::More tests => 2;
use HTTP::Tiny;
my @accessors = qw(
- agent default_headers local_address max_redirect max_size proxy no_proxy timeout SSL_options verify_SSL cookie_jar
+ agent 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 delete post_form request mirror www_form_urlencode
diff --git a/cpan/HTTP-Tiny/t/100_get.t b/cpan/HTTP-Tiny/t/100_get.t
index ff645a3d9a..228788f101 100644
--- a/cpan/HTTP-Tiny/t/100_get.t
+++ b/cpan/HTTP-Tiny/t/100_get.t
@@ -40,7 +40,7 @@ for my $file ( dir_list("t/cases", qr/^get/ ) ) {
my $res_fh = tmpfile($give_res);
my $req_fh = tmpfile();
- my $http = HTTP::Tiny->new(%new_args);
+ my $http = HTTP::Tiny->new(keep_alive => 0, %new_args);
set_socket_source($req_fh, $res_fh);
(my $url_basename = $url) =~ s{.*/}{};
diff --git a/cpan/HTTP-Tiny/t/101_head.t b/cpan/HTTP-Tiny/t/101_head.t
index ad95917ad1..c9a29a398a 100644
--- a/cpan/HTTP-Tiny/t/101_head.t
+++ b/cpan/HTTP-Tiny/t/101_head.t
@@ -45,7 +45,7 @@ for my $file ( dir_list("t/cases", qr/^head/ ) ) {
my $res_fh = tmpfile($give_res);
my $req_fh = tmpfile();
- my $http = HTTP::Tiny->new;
+ my $http = HTTP::Tiny->new( keep_alive => 0 );
set_socket_source($req_fh, $res_fh);
(my $url_basename = $url) =~ s{.*/}{};
diff --git a/cpan/HTTP-Tiny/t/102_put.t b/cpan/HTTP-Tiny/t/102_put.t
index 2fc1169b4b..e9a086e3bb 100644
--- a/cpan/HTTP-Tiny/t/102_put.t
+++ b/cpan/HTTP-Tiny/t/102_put.t
@@ -45,7 +45,7 @@ for my $file ( dir_list("t/cases", qr/^put/ ) ) {
my $res_fh = tmpfile($give_res);
my $req_fh = tmpfile();
- my $http = HTTP::Tiny->new;
+ my $http = HTTP::Tiny->new( keep_alive => 0 );
set_socket_source($req_fh, $res_fh);
(my $url_basename = $url) =~ s{.*/}{};
diff --git a/cpan/HTTP-Tiny/t/103_delete.t b/cpan/HTTP-Tiny/t/103_delete.t
index a5654847c5..767008b6c7 100644
--- a/cpan/HTTP-Tiny/t/103_delete.t
+++ b/cpan/HTTP-Tiny/t/103_delete.t
@@ -45,7 +45,7 @@ for my $file ( dir_list("t/cases", qr/^delete/ ) ) {
my $res_fh = tmpfile($give_res);
my $req_fh = tmpfile();
- my $http = HTTP::Tiny->new;
+ my $http = HTTP::Tiny->new( keep_alive => 0 );
set_socket_source($req_fh, $res_fh);
(my $url_basename = $url) =~ s{.*/}{};
diff --git a/cpan/HTTP-Tiny/t/104_post.t b/cpan/HTTP-Tiny/t/104_post.t
index 181261af29..8cb29836c2 100644
--- a/cpan/HTTP-Tiny/t/104_post.t
+++ b/cpan/HTTP-Tiny/t/104_post.t
@@ -45,7 +45,7 @@ for my $file ( dir_list("t/cases", qr/^post/ ) ) {
my $res_fh = tmpfile($give_res);
my $req_fh = tmpfile();
- my $http = HTTP::Tiny->new;
+ my $http = HTTP::Tiny->new( keep_alive => 0 );
set_socket_source($req_fh, $res_fh);
(my $url_basename = $url) =~ s{.*/}{};
diff --git a/cpan/HTTP-Tiny/t/110_mirror.t b/cpan/HTTP-Tiny/t/110_mirror.t
index 7a54bb7856..f8ef2abbc3 100644
--- a/cpan/HTTP-Tiny/t/110_mirror.t
+++ b/cpan/HTTP-Tiny/t/110_mirror.t
@@ -57,7 +57,7 @@ for my $file ( dir_list("t/cases", qr/^mirror/ ) ) {
my $res_fh = tmpfile($give_res);
my $req_fh = tmpfile();
- my $http = HTTP::Tiny->new;
+ my $http = HTTP::Tiny->new( keep_alive => 0 );
set_socket_source($req_fh, $res_fh);
my @call_args = %options ? ($url, $tempfile, \%options) : ($url, $tempfile);
diff --git a/cpan/HTTP-Tiny/t/130_redirect.t b/cpan/HTTP-Tiny/t/130_redirect.t
index 04e7a266c5..377891cac5 100644
--- a/cpan/HTTP-Tiny/t/130_redirect.t
+++ b/cpan/HTTP-Tiny/t/130_redirect.t
@@ -47,7 +47,7 @@ for my $file ( dir_list("t/cases", qr/^redirect/ ) ) {
clear_socket_source();
set_socket_source(@$_) for @socket_pairs;
- my $http = HTTP::Tiny->new(%new_args);
+ my $http = HTTP::Tiny->new(keep_alive => 0, %new_args);
my $response = $http->request(@$call_args);
my $calls = 0
diff --git a/cpan/HTTP-Tiny/t/140_proxy.t b/cpan/HTTP-Tiny/t/140_proxy.t
index 295d7cf46f..401f8ae23f 100644
--- a/cpan/HTTP-Tiny/t/140_proxy.t
+++ b/cpan/HTTP-Tiny/t/140_proxy.t
@@ -12,14 +12,14 @@ use HTTP::Tiny;
for my $proxy (undef, "", 0){
local $ENV{http_proxy} = $proxy;
my $c = HTTP::Tiny->new();
- ok(!defined $c->proxy);
+ ok(!defined $c->http_proxy);
}
# trailing / is optional
for my $proxy ("http://localhost:8080/", "http://localhost:8080"){
local $ENV{http_proxy} = $proxy;
my $c = HTTP::Tiny->new();
- is($c->proxy, $proxy);
+ is($c->http_proxy, $proxy);
}
# http_proxy must be http://<host>:<port> format
@@ -28,8 +28,8 @@ for my $proxy ("http://localhost:8080/", "http://localhost:8080"){
eval {
my $c = HTTP::Tiny->new();
};
- like($@, qr{Environment 'http_proxy' must be in format http://<host>:<port>/});
+ like($@, qr{http_proxy URL must be in format http\[s\]://\[auth\@\]<host>:<port>/});
}
-done_testing(); \ No newline at end of file
+done_testing();
diff --git a/cpan/HTTP-Tiny/t/150_post_form.t b/cpan/HTTP-Tiny/t/150_post_form.t
index c1c231848f..07d937bac9 100644
--- a/cpan/HTTP-Tiny/t/150_post_form.t
+++ b/cpan/HTTP-Tiny/t/150_post_form.t
@@ -55,7 +55,7 @@ for my $file ( dir_list("t/cases", qr/^form/ ) ) {
my $res_fh = tmpfile($give_res);
my $req_fh = tmpfile();
- my $http = HTTP::Tiny->new;
+ my $http = HTTP::Tiny->new( keep_alive => 0 );
set_socket_source($req_fh, $res_fh);
(my $url_basename = $url) =~ s{.*/}{};
diff --git a/cpan/HTTP-Tiny/t/160_cookies.t b/cpan/HTTP-Tiny/t/160_cookies.t
index 899a197a90..ecd5a6bb55 100644
--- a/cpan/HTTP-Tiny/t/160_cookies.t
+++ b/cpan/HTTP-Tiny/t/160_cookies.t
@@ -5,7 +5,6 @@ use warnings;
use File::Basename;
use Test::More 0.96;
-use t::SimpleCookieJar;
use t::Util qw[tmpfile rewind slurp monkey_patch dir_list parse_case
hashify connect_args clear_socket_source set_socket_source sort_headers
$CRLF $LF];
@@ -62,7 +61,7 @@ SKIP: for my $class ( qw/t::SimpleCookieJar HTTP::CookieJar/ ) {
my $res_fh = tmpfile($give_res);
my $req_fh = tmpfile();
- $http = HTTP::Tiny->new(%new_args) if !defined $http;
+ $http = HTTP::Tiny->new(keep_alive => 0, %new_args) if !defined $http;
clear_socket_source();
set_socket_source($req_fh, $res_fh);
diff --git a/cpan/HTTP-Tiny/t/161_basic_auth.t b/cpan/HTTP-Tiny/t/161_basic_auth.t
index 1d44934020..292b3365a4 100644
--- a/cpan/HTTP-Tiny/t/161_basic_auth.t
+++ b/cpan/HTTP-Tiny/t/161_basic_auth.t
@@ -47,7 +47,7 @@ for my $file ( dir_list("t/cases", qr/^auth/ ) ) {
clear_socket_source();
set_socket_source(@$_) for @socket_pairs;
- my $http = HTTP::Tiny->new(%new_args);
+ my $http = HTTP::Tiny->new(keep_alive => 0, %new_args);
my $response = $http->request(@$call_args);
my $calls = 0
diff --git a/cpan/HTTP-Tiny/t/162_proxy_auth.t b/cpan/HTTP-Tiny/t/162_proxy_auth.t
new file mode 100644
index 0000000000..bad44c4017
--- /dev/null
+++ b/cpan/HTTP-Tiny/t/162_proxy_auth.t
@@ -0,0 +1,75 @@
+#!perl
+
+use strict;
+use warnings;
+
+use File::Basename;
+use Test::More 0.88;
+use t::Util qw[tmpfile rewind slurp monkey_patch dir_list parse_case
+ hashify connect_args clear_socket_source set_socket_source sort_headers
+ $CRLF $LF];
+
+use HTTP::Tiny;
+BEGIN { monkey_patch() }
+
+for my $file ( dir_list("t/cases", qr/^proxy-auth/ ) ) {
+ my $label = basename($file);
+ my $data = do { local (@ARGV,$/) = $file; <> };
+ my ($params, @case_pairs) = split /--+\n/, $data;
+ my $case = parse_case($params);
+
+ my $url = $case->{url}[0];
+ my $method = $case->{method}[0] || 'GET';
+ my %headers = hashify( $case->{headers} );
+ my %new_args = hashify( $case->{new_args} );
+
+ my %options;
+ $options{headers} = \%headers if %headers;
+ my $call_args = %options ? [$method, $url, \%options] : [$method, $url];
+
+ my $version = HTTP::Tiny->VERSION || 0;
+ my $agent = $new_args{agent} || "HTTP-Tiny/$version";
+
+ my (@socket_pairs);
+ while ( @case_pairs ) {
+ my ($expect_req, $give_res) = splice( @case_pairs, 0, 2 );
+ # cleanup source data
+ $expect_req =~ s{HTTP-Tiny/VERSION}{$agent};
+ s{\n}{$CRLF}g for ($expect_req, $give_res);
+
+ # 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)");
+ $i++;
+ }
+
+ my $exp_content = $case->{expected}
+ ? join("$CRLF", @{$case->{expected}}) : '';
+
+ is ( $response->{content}, $exp_content, "$label content" );
+
+ if ( $case->{expected_url} ) {
+ is ( $response->{url}, $case->{expected_url}[0], "$label response URL" );
+ }
+
+}
+
+done_testing;
diff --git a/cpan/HTTP-Tiny/t/170_keepalive.t b/cpan/HTTP-Tiny/t/170_keepalive.t
new file mode 100644
index 0000000000..1ea1fd01df
--- /dev/null
+++ b/cpan/HTTP-Tiny/t/170_keepalive.t
@@ -0,0 +1,98 @@
+#!perl
+
+use strict;
+use warnings;
+use File::Basename;
+use Test::More 0.88;
+use t::Util qw[
+ tmpfile monkey_patch dir_list clear_socket_source set_socket_source
+ $CRLF
+];
+use HTTP::Tiny;
+our $can_read;
+
+BEGIN {
+ no warnings qw/redefine once/;
+ monkey_patch();
+ *HTTP::Tiny::Handle::can_read = sub { $can_read++ };
+}
+
+my $response = <<'RESPONSE';
+HTTP/1.1 200 OK
+Date: Thu, 03 Feb 1994 00:00:00 GMT
+Content-Type: text/html
+Content-Length: 10
+
+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' );
+
+new_ht();
+$h->timeout(30);
+test_ht( "Different timeout", 0, 'http://foo.com' );
+
+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}->close;
+test_ht( "Socket closed", 0, 'http://foo.com' );
+
+for my $file ( dir_list( "t/cases", 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";
+}
+
+sub test_ht {
+ my $title = shift;
+ my $result = !!shift();
+ my $url = shift;
+
+ 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;
+
diff --git a/cpan/HTTP-Tiny/t/Util.pm b/cpan/HTTP-Tiny/t/Util.pm
index 72b0770449..d3f3fa4dc5 100644
--- a/cpan/HTTP-Tiny/t/Util.pm
+++ b/cpan/HTTP-Tiny/t/Util.pm
@@ -152,8 +152,9 @@ sub sort_headers {
*HTTP::Tiny::Handle::can_write = sub {1};
*HTTP::Tiny::Handle::connect = sub {
my ($self, $scheme, $host, $port) = @_;
- $self->{host} = $monkey_host = $host;
- $self->{port} = $monkey_port = $port;
+ $self->{host} = $monkey_host = $host;
+ $self->{port} = $monkey_port = $port;
+ $self->{scheme} = $scheme;
$self->{fh} = shift @req_fh;
return $self;
};
@@ -164,7 +165,7 @@ sub sort_headers {
$self->{fh} = shift @res_fh;
};
*HTTP::Tiny::Handle::close = sub { 1 }; # don't close our temps
-
+
delete $ENV{http_proxy}; # don't try to proxy in mock-mode
}
}
diff --git a/cpan/HTTP-Tiny/t/cases/keepalive-01.txt b/cpan/HTTP-Tiny/t/cases/keepalive-01.txt
new file mode 100644
index 0000000000..085391265e
--- /dev/null
+++ b/cpan/HTTP-Tiny/t/cases/keepalive-01.txt
@@ -0,0 +1,9 @@
+No content length
+----------
+0
+----------
+HTTP/1.1 200 OK
+Date: Thu, 03 Feb 1994 00:00:00 GMT
+Content-Type: text/html
+
+0123456789
diff --git a/cpan/HTTP-Tiny/t/cases/keepalive-02.txt b/cpan/HTTP-Tiny/t/cases/keepalive-02.txt
new file mode 100644
index 0000000000..970360bead
--- /dev/null
+++ b/cpan/HTTP-Tiny/t/cases/keepalive-02.txt
@@ -0,0 +1,10 @@
+Wrong content length
+----------
+0
+----------
+HTTP/1.1 200 OK
+Date: Thu, 03 Feb 1994 00:00:00 GMT
+Content-Type: text/html
+Content-Length: 10
+
+01234567890123456789
diff --git a/cpan/HTTP-Tiny/t/cases/keepalive-03.txt b/cpan/HTTP-Tiny/t/cases/keepalive-03.txt
new file mode 100644
index 0000000000..1792b8c380
--- /dev/null
+++ b/cpan/HTTP-Tiny/t/cases/keepalive-03.txt
@@ -0,0 +1,11 @@
+Connection close
+----------
+0
+----------
+HTTP/1.1 200 OK
+Date: Thu, 03 Feb 1994 00:00:00 GMT
+Content-Type: text/html
+Content-Length: 10
+Connection: close
+
+0123456789
diff --git a/cpan/HTTP-Tiny/t/cases/keepalive-04.txt b/cpan/HTTP-Tiny/t/cases/keepalive-04.txt
new file mode 100644
index 0000000000..ef5e4d98c8
--- /dev/null
+++ b/cpan/HTTP-Tiny/t/cases/keepalive-04.txt
@@ -0,0 +1,10 @@
+Not HTTP/1.1
+----------
+0
+----------
+HTTP/1.0 200 OK
+Date: Thu, 03 Feb 1994 00:00:00 GMT
+Content-Type: text/html
+Content-Length: 10
+
+0123456789
diff --git a/cpan/HTTP-Tiny/t/cases/keepalive-05.txt b/cpan/HTTP-Tiny/t/cases/keepalive-05.txt
new file mode 100644
index 0000000000..75872c9e40
--- /dev/null
+++ b/cpan/HTTP-Tiny/t/cases/keepalive-05.txt
@@ -0,0 +1,11 @@
+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
diff --git a/cpan/HTTP-Tiny/t/cases/proxy-auth-01.txt b/cpan/HTTP-Tiny/t/cases/proxy-auth-01.txt
new file mode 100644
index 0000000000..548a599eb7
--- /dev/null
+++ b/cpan/HTTP-Tiny/t/cases/proxy-auth-01.txt
@@ -0,0 +1,21 @@
+url
+ http://example.com/index.html
+expected
+ abcdefghijklmnopqrstuvwxyz1234567890abcdef
+new_args
+ proxy: http://foo:bar@proxy.example.com/
+
+----------
+GET http://example.com/index.html HTTP/1.1
+Host: example.com
+Connection: close
+User-Agent: HTTP-Tiny/VERSION
+Proxy-Authorization: Basic Zm9vOmJhcg==
+
+----------
+HTTP/1.1 200 OK
+Date: Thu, 03 Feb 1994 00:00:00 GMT
+Content-Type: text/plain
+Content-Length: 42
+
+abcdefghijklmnopqrstuvwxyz1234567890abcdef