diff options
author | Chris 'BinGOs' Williams <chris@bingosnet.co.uk> | 2014-02-17 20:30:07 +0000 |
---|---|---|
committer | Chris 'BinGOs' Williams <chris@bingosnet.co.uk> | 2014-02-17 20:30:07 +0000 |
commit | 91e4447ad17c1687664c3d73092318aa84d013a3 (patch) | |
tree | d3a0f0291822a32440b77e5e07aca67d4065998f /cpan/HTTP-Tiny | |
parent | 7dcac5f6a5195002b55c935ee1d67f67e1df280b (diff) | |
download | perl-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.pm | 671 | ||||
-rw-r--r-- | cpan/HTTP-Tiny/t/001_api.t | 3 | ||||
-rw-r--r-- | cpan/HTTP-Tiny/t/100_get.t | 2 | ||||
-rw-r--r-- | cpan/HTTP-Tiny/t/101_head.t | 2 | ||||
-rw-r--r-- | cpan/HTTP-Tiny/t/102_put.t | 2 | ||||
-rw-r--r-- | cpan/HTTP-Tiny/t/103_delete.t | 2 | ||||
-rw-r--r-- | cpan/HTTP-Tiny/t/104_post.t | 2 | ||||
-rw-r--r-- | cpan/HTTP-Tiny/t/110_mirror.t | 2 | ||||
-rw-r--r-- | cpan/HTTP-Tiny/t/130_redirect.t | 2 | ||||
-rw-r--r-- | cpan/HTTP-Tiny/t/140_proxy.t | 8 | ||||
-rw-r--r-- | cpan/HTTP-Tiny/t/150_post_form.t | 2 | ||||
-rw-r--r-- | cpan/HTTP-Tiny/t/160_cookies.t | 3 | ||||
-rw-r--r-- | cpan/HTTP-Tiny/t/161_basic_auth.t | 2 | ||||
-rw-r--r-- | cpan/HTTP-Tiny/t/162_proxy_auth.t | 75 | ||||
-rw-r--r-- | cpan/HTTP-Tiny/t/170_keepalive.t | 98 | ||||
-rw-r--r-- | cpan/HTTP-Tiny/t/Util.pm | 7 | ||||
-rw-r--r-- | cpan/HTTP-Tiny/t/cases/keepalive-01.txt | 9 | ||||
-rw-r--r-- | cpan/HTTP-Tiny/t/cases/keepalive-02.txt | 10 | ||||
-rw-r--r-- | cpan/HTTP-Tiny/t/cases/keepalive-03.txt | 11 | ||||
-rw-r--r-- | cpan/HTTP-Tiny/t/cases/keepalive-04.txt | 10 | ||||
-rw-r--r-- | cpan/HTTP-Tiny/t/cases/keepalive-05.txt | 11 | ||||
-rw-r--r-- | cpan/HTTP-Tiny/t/cases/proxy-auth-01.txt | 21 |
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 |