Updated HTTP-Tiny to CPAN version 0.021

  [DELTA]

  0.021     2012-05-15 22:38:57 America/New_York

  [TESTING]

  - Skip live SSL testing if $ENV{http_proxy} is set

  0.020     2012-05-14 15:24:37 America/New_York

  [TESTING]

  - Capture prerequisite versions under AUTOMATED_TESTING to help
    chase down some failures from CPAN Testers

  0.019     2012-05-14 07:14:00 America/New_York

  [ADDED]

  - Require IO::Socket::SSL 1.56 (which added SSL_hostname support) when
    doing HTTPS.  [Mike Doherty]

  [TESTING]

  - Provide better diagnostic output in t/210_live_ssl.t [Mike
    Doherty]

  0.018     2012-04-18 09:39:50 America/New_York

  [ADDED]

  - Add verify_SSL option to do more secure SSL operations, incl.
    attempting to validate against a CA bundle (Mozilla::CA
    recommended, but will attempt to find some OS bundles). Also
    add SSL_opts, which passes through IO::Socket::SSL's SSL_*
    options to control SSL verification. (GH #6, #9) [Mike Doherty]

  - Reponse hashref includes final URL (including any redirections)
    [Lukas Eklund]

13 files changed, 226 insertions, 39 deletions

diff --git a/cpan/HTTP-Tiny/lib/HTTP/Tiny.pm b/cpan/HTTP-Tiny/lib/HTTP/Tiny.pm
index 46dce742e3..d69435e122 100644
--- a/cpan/HTTP-Tiny/lib/HTTP/Tiny.pm
+++ b/cpan/HTTP-Tiny/lib/HTTP/Tiny.pm
@@ -3,14 +3,14 @@ package HTTP::Tiny;
 use strict;
 use warnings;
 # ABSTRACT: A small, simple, correct HTTP/1.1 client
-our $VERSION = '0.017'; # VERSION
+our $VERSION = '0.021'; # VERSION
 
 use Carp ();
 
 
 my @attributes;
 BEGIN {
-    @attributes = qw(agent default_headers max_redirect max_size proxy timeout);
+    @attributes = qw(agent default_headers max_redirect max_size proxy timeout SSL_options verify_SSL);
     no strict 'refs';
     for my $accessor ( @attributes ) {
         *{$accessor} = sub {
@@ -26,6 +26,7 @@ sub new {
         agent        => $agent . "/" . ($class->VERSION || 0),
         max_redirect => 5,
         timeout      => 60,
+        verify_SSL   => $args{verify_SSL} || $args{verify_ssl} || 0, # no verification by default
     };
     for my $key ( @attributes ) {
         $self->{$key} = $args{$key} if exists $args{$key}
@@ -129,6 +130,7 @@ sub request {
 
     if (my $e = "$@") {
         $response = {
+            url     => $url,
             success => q{},
             status  => 599,
             reason  => 'Internal Exception',
@@ -190,7 +192,11 @@ sub _request {
         headers   => {},
     };
 
-    my $handle  = HTTP::Tiny::Handle->new(timeout => $self->{timeout});
+    my $handle  = HTTP::Tiny::Handle->new(
+        timeout     => $self->{timeout},
+        SSL_options => $self->{SSL_options},
+        verify_SSL  => $self->{verify_SSL},
+    );
 
     if ($self->{proxy}) {
         $request->{uri} = "$scheme://$request->{host_port}$path_query";
@@ -224,6 +230,7 @@ sub _request {
 
     $handle->close;
     $response->{success} = substr($response->{status},0,1) eq '2';
+    $response->{url} = $url;
     return $response;
 }
 
@@ -402,25 +409,19 @@ sub new {
         timeout          => 60,
         max_line_size    => 16384,
         max_header_lines => 64,
+        verify_SSL       => 0,
+        SSL_options      => {},
         %args
     }, $class;
 }
 
-my $ssl_verify_args = {
-    check_cn => "when_only",
-    wildcards_in_alt => "anywhere",
-    wildcards_in_cn => "anywhere"
-};
-
 sub connect {
     @_ == 4 || die(q/Usage: $handle->connect(scheme, host, port)/ . "\n");
     my ($self, $scheme, $host, $port) = @_;
 
     if ( $scheme eq 'https' ) {
-        eval "require IO::Socket::SSL"
-            unless exists $INC{'IO/Socket/SSL.pm'};
-        die(qq/IO::Socket::SSL must be installed for https support\n/)
-            unless $INC{'IO/Socket/SSL.pm'};
+        die(qq/IO::Socket::SSL 1.56 must be installed for https support\n/)
+            unless eval {require IO::Socket::SSL; IO::Socket::SSL->VERSION(1.56)};
     }
     elsif ( $scheme ne 'http' ) {
       die(qq/Unsupported URL scheme '$scheme'\n/);
@@ -438,11 +439,12 @@ sub connect {
       or die(qq/Could not binmode() socket: '$!'\n/);
 
     if ( $scheme eq 'https') {
-        IO::Socket::SSL->start_SSL($self->{fh});
-        ref($self->{fh}) eq 'IO::Socket::SSL'
-            or die(qq/SSL connection failed for $host\n/);
-        $self->{fh}->verify_hostname( $host, $ssl_verify_args )
-            or die(qq/SSL certificate not valid for $host\n/);
+        my $ssl_args = $self->_ssl_args($host);
+        IO::Socket::SSL->start_SSL($self->{fh}, %$ssl_args);
+        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/);
+        }
     }
 
     $self->{host} = $host;
@@ -827,6 +829,51 @@ sub can_write {
     return $self->_do_timeout('write', @_)
 }
 
+# Try to find a CA bundle to validate the SSL cert,
+# prefer Mozilla::CA or fallback to a system file
+sub _find_CA_file {
+    return Mozilla::CA::SSL_ca_file()
+        if eval { require Mozilla::CA };
+
+    foreach my $ca_bundle (qw{
+        /etc/ssl/certs/ca-certificates.crt
+        /etc/pki/tls/certs/ca-bundle.crt
+        /etc/ssl/ca-bundle.pem
+        }
+    ) {
+        return $ca_bundle if -e $ca_bundle;
+    }
+
+    die qq/Couldn't find a CA bundle with which to verify the SSL certificate.\n/
+      . qq/Try installing Mozilla::CA from CPAN\n/;
+}
+
+sub _ssl_args {
+    my ($self, $host) = @_;
+
+    my %ssl_args = (
+        SSL_hostname        => $host,  # SNI
+    );
+
+    if ($self->{verify_SSL}) {
+        $ssl_args{SSL_verifycn_scheme}  = 'http'; # enable CN validation
+        $ssl_args{SSL_verifycn_name}    = $host;  # set validation hostname
+        $ssl_args{SSL_verify_mode}      = 0x01;   # enable cert validation
+        $ssl_args{SSL_ca_file}          = $self->_find_CA_file;
+    }
+    else {
+        $ssl_args{SSL_verifycn_scheme}  = 'none'; # disable CN validation
+        $ssl_args{SSL_verify_mode}      = 0x00;   # disable cert validation
+    }
+
+    # user options override settings from verify_SSL
+    for my $k ( keys %{$self->{SSL_options}} ) {
+        $ssl_args{$k} = $self->{SSL_options}{$k} if $k =~ m/^SSL_/;
+    }
+
+    return \%ssl_args;
+}
+
 1;
 
 
@@ -840,7 +887,7 @@ HTTP::Tiny - A small, simple, correct HTTP/1.1 client
 
 =head1 VERSION
 
-version 0.017
+version 0.021
 
 =head1 SYNOPSIS
 
@@ -916,12 +963,27 @@ C<timeout>
 
 Request timeout in seconds (default is 60)
 
+=item *
+
+C<verify_SSL>
+
+A boolean that indicates whether to validate the SSL certificate of an C<https>
+connection (default is false)
+
+=item *
+
+C<SSL_options>
+
+A hashref of C<SSL_*> options to pass through to L<IO::Socket::SSL>
+
 =back
 
 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.
 
+See L</SSL SUPPORT> for more on the C<verify_SSL> and C<SSL_options> attributes.
+
 =head2 get|head|put|post|delete
 
     $response = $http->get($url);
@@ -987,7 +1049,7 @@ Valid options are:
 
 =item *
 
-headers
+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
@@ -995,21 +1057,21 @@ each value in the array.  These headers over-write any default headers.
 
 =item *
 
-content
+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 response
+that will be called iteratively to produce the body of the request
 
 =item *
 
-trailer_callback
+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)
 
 =item *
 
-data_callback
+C<data_callback>
 
 A code reference that will be called for each chunks of the response
 body received.
@@ -1034,25 +1096,33 @@ will have the following keys:
 
 =item *
 
-success
+C<success>
 
 Boolean indicating whether the operation returned a 2XX status code
 
 =item *
 
-status
+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
+
+=item *
+
+C<status>
 
 The HTTP status code of the response
 
 =item *
 
-reason
+C<reason>
 
 The response phrase returned by the server
 
 =item *
 
-content
+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,
@@ -1060,7 +1130,7 @@ this will be the empty string
 
 =item *
 
-headers
+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;
@@ -1089,6 +1159,90 @@ max_redirect
 max_size
 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 is installed. An exception will be thrown if a new enough
+IO::Socket::SSL is not installed or if the SSL encryption fails. There is no
+support for C<https> connections via proxy (i.e. RFC 2817).
+
+SSL provides two distinct capabilities:
+
+=over 4
+
+=item *
+
+Encrypted communication channel
+
+=item *
+
+Verification of server identity
+
+=back
+
+B<By default, HTTP::Tiny does not verify server identity>.
+
+Server identity verification is controversial and potentially tricky because it
+depends on a (usually paid) third-party Certificate Authority (CA) trust model
+to validate a certificate as legitimate.  This discriminates against servers
+with self-signed certificates or certificates signed by free, community-driven
+CA's such as L<CAcert.org|http://cacert.org>.
+
+By default, HTTP::Tiny does not make any assumptions about your trust model,
+threat level or risk tolerance.  It just aims to give you an encrypted channel
+when you need one.
+
+Setting the C<verify_SSL> attribute to a true value will make HTTP::Tiny verify
+that an SSL connection has a valid SSL certificate corresponding to the host
+name of the connection and that the SSL certificate has been verified by a CA.
+Assuming you trust the CA, this will protect against a L<man-in-the-middle
+attack|http://en.wikipedia.org/wiki/Man-in-the-middle_attack>.  If you are
+concerned about security, you should enable this option.
+
+Certificate verification requires a file containing trusted CA certificates.
+If the L<Mozilla::CA> module is installed, HTTP::Tiny will use the CA file
+included with it as a source of trusted CA's.  (This means you trust Mozilla,
+the author of Mozilla::CA, the CPAN mirror where you got Mozilla::CA, the
+toolchain used to install it, and your operating system security, right?)
+
+If that module is not available, then HTTP::Tiny will search several
+system-specific default locations for a CA certificate file:
+
+=over 4
+
+=item *
+
+/etc/ssl/certs/ca-certificates.crt
+
+=item *
+
+/etc/pki/tls/certs/ca-bundle.crt
+
+=item *
+
+/etc/ssl/ca-bundle.pem
+
+=back
+
+An exception will be raised if C<verify_SSL> is true and no CA certificate file
+is available.
+
+If you desire complete control over SSL connections, the C<SSL_options> attribute
+lets you provide a hash reference that will be passed through to
+C<IO::Socket::SSL::start_SSL()>, overriding any options set by HTTP::Tiny. For
+example, to provide your own trusted CA file:
+
+    SSL_options => {
+        SSL_ca_file => $file_path,
+    }
+
+The C<SSL_options> attribute could also be used for such things as providing a
+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 LIMITATIONS
 
@@ -1128,13 +1282,6 @@ always be set to C<close>.
 
 =item *
 
-Direct C<https> connections are supported only if L<IO::Socket::SSL> is
-installed.  There is no support for C<https> connections via proxy.
-Any SSL certificate that matches the host is accepted -- SSL certificates
-are not verified against certificate authorities.
-
-=item *
-
 Cookies are not directly supported.  Users that set a C<Cookie> header
 should also set C<max_redirect> to zero to ensure cookies are not
 inappropriately re-transmitted.
@@ -1168,9 +1315,17 @@ There is no support for a Request-URI of '*' for the 'OPTIONS' request.
 
 L<LWP::UserAgent>
 
+=item *
+
+L<IO::Socket::SSL>
+
+=item *
+
+L<Mozilla::CA>
+
 =back
 
-=for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders
+=for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan
 
 =head1 SUPPORT
 
@@ -1201,6 +1356,10 @@ Christian Hansen <chansen@cpan.org>
 
 David Golden <dagolden@cpan.org>
 
+=item *
+
+Mike Doherty <doherty@cpan.org>
+
 =back
 
 =head1 COPYRIGHT AND LICENSE
diff --git a/cpan/HTTP-Tiny/t/001_api.t b/cpan/HTTP-Tiny/t/001_api.t
index 8b3168313f..94b20a5659 100644
--- a/cpan/HTTP-Tiny/t/001_api.t
+++ b/cpan/HTTP-Tiny/t/001_api.t
@@ -6,7 +6,9 @@ use warnings;
 use Test::More tests => 2;
 use HTTP::Tiny;
 
-my @accessors = qw(agent default_headers max_redirect max_size proxy timeout);
+my @accessors = qw(
+  agent default_headers max_redirect max_size proxy timeout SSL_options verify_SSL
+);
 my @methods   = qw(
   new get head put post delete post_form request mirror www_form_urlencode
 );
@@ -25,4 +27,3 @@ my @extra =
 
 ok( ! scalar @extra, "No unexpected subroutines defined" )
   or diag "Found: @extra";
-
diff --git a/cpan/HTTP-Tiny/t/100_get.t b/cpan/HTTP-Tiny/t/100_get.t
index 35251e0f12..ff645a3d9a 100644
--- a/cpan/HTTP-Tiny/t/100_get.t
+++ b/cpan/HTTP-Tiny/t/100_get.t
@@ -75,6 +75,8 @@ for my $file ( dir_list("t/cases", qr/^get/ ) ) {
     ok( ! $response->{success}, "$label success flag false" );
   }
 
+  is ( $response->{url}, $url, "$label response URL" );
+
   if (defined $case->{expected_headers}) {
     my %expected = hashify( $case->{expected_headers} );
     is_deeply($response->{headers}, \%expected, "$label expected headers");
@@ -93,6 +95,8 @@ for my $file ( dir_list("t/cases", qr/^get/ ) ) {
       }
     ;
 
+
+
   if ( $options{data_callback} ) {
     $check_expected->( $main::data, "$label cb got content" );
     is ( $response->{content}, '', "$label resp content empty" );
diff --git a/cpan/HTTP-Tiny/t/130_redirect.t b/cpan/HTTP-Tiny/t/130_redirect.t
index 68d92557d7..04e7a266c5 100644
--- a/cpan/HTTP-Tiny/t/130_redirect.t
+++ b/cpan/HTTP-Tiny/t/130_redirect.t
@@ -65,6 +65,11 @@ for my $file ( dir_list("t/cases", qr/^redirect/ ) ) {
                   ? 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/cases/redirect-01.txt b/cpan/HTTP-Tiny/t/cases/redirect-01.txt
index 25e2ff2628..c6ed575482 100644
--- a/cpan/HTTP-Tiny/t/cases/redirect-01.txt
+++ b/cpan/HTTP-Tiny/t/cases/redirect-01.txt
@@ -2,6 +2,8 @@ url
   http://example.com/index.html
 expected
   abcdefghijklmnopqrstuvwxyz1234567890abcdef
+expected_url
+  http://example.com/index2.html
 ----------
 GET /index.html HTTP/1.1
 Host: example.com
diff --git a/cpan/HTTP-Tiny/t/cases/redirect-02.txt b/cpan/HTTP-Tiny/t/cases/redirect-02.txt
index 5035879ff4..b2a296796e 100644
--- a/cpan/HTTP-Tiny/t/cases/redirect-02.txt
+++ b/cpan/HTTP-Tiny/t/cases/redirect-02.txt
@@ -4,6 +4,8 @@ url
   http://example.com/index.html
 expected
   <a href="http://example.com/index2.html">redirect</a>
+expected_url
+  http://example.com/index.html
 ----------
 GET /index.html HTTP/1.1
 Host: example.com
diff --git a/cpan/HTTP-Tiny/t/cases/redirect-03.txt b/cpan/HTTP-Tiny/t/cases/redirect-03.txt
index 0a7df722a7..8fc84beeb4 100644
--- a/cpan/HTTP-Tiny/t/cases/redirect-03.txt
+++ b/cpan/HTTP-Tiny/t/cases/redirect-03.txt
@@ -4,6 +4,8 @@ url
   http://example.com/index.html
 expected
   <a href="http://example.com/index3.html">redirect</a>
+expected_url
+  http://example.com/index2.html
 ----------
 GET /index.html HTTP/1.1
 Host: example.com
diff --git a/cpan/HTTP-Tiny/t/cases/redirect-04.txt b/cpan/HTTP-Tiny/t/cases/redirect-04.txt
index c07412bdc3..3c19ada352 100644
--- a/cpan/HTTP-Tiny/t/cases/redirect-04.txt
+++ b/cpan/HTTP-Tiny/t/cases/redirect-04.txt
@@ -4,6 +4,8 @@ url
   http://example.com/index.html
 expected
   abcdefghijklmnopqrstuvwxyz1234567890abcdef
+expected_url
+  http://example.com/index3.html
 ----------
 GET /index.html HTTP/1.1
 Host: example.com
diff --git a/cpan/HTTP-Tiny/t/cases/redirect-05.txt b/cpan/HTTP-Tiny/t/cases/redirect-05.txt
index 0691a80758..5ffce1838f 100644
--- a/cpan/HTTP-Tiny/t/cases/redirect-05.txt
+++ b/cpan/HTTP-Tiny/t/cases/redirect-05.txt
@@ -2,6 +2,8 @@ url
   http://example.com/index.html
 expected
   abcdefghijklmnopqrstuvwxyz1234567890abcdef
+expected_url
+  http://example.com/index3.html
 ----------
 GET /index.html HTTP/1.1
 Host: example.com
diff --git a/cpan/HTTP-Tiny/t/cases/redirect-06.txt b/cpan/HTTP-Tiny/t/cases/redirect-06.txt
index b5a6a49762..27e3e4ad72 100644
--- a/cpan/HTTP-Tiny/t/cases/redirect-06.txt
+++ b/cpan/HTTP-Tiny/t/cases/redirect-06.txt
@@ -2,6 +2,8 @@ url
   http://example.com/index.html
 expected
   abcdefghijklmnopqrstuvwxyz1234567890abcdef
+expected_url
+  http://example.com/index2.html
 ----------
 GET /index.html HTTP/1.1
 Host: example.com
diff --git a/cpan/HTTP-Tiny/t/cases/redirect-07.txt b/cpan/HTTP-Tiny/t/cases/redirect-07.txt
index 3320c6ce3c..11b448090c 100644
--- a/cpan/HTTP-Tiny/t/cases/redirect-07.txt
+++ b/cpan/HTTP-Tiny/t/cases/redirect-07.txt
@@ -2,6 +2,8 @@ url
   http://example.com/index.html
 expected
   abcdefghijklmnopqrstuvwxyz1234567890abcdef
+expected_url
+  http://example.com/index2.html
 ----------
 GET /index.html HTTP/1.1
 Host: example.com
diff --git a/cpan/HTTP-Tiny/t/cases/redirect-08.txt b/cpan/HTTP-Tiny/t/cases/redirect-08.txt
index 3f983b8402..67a59da502 100644
--- a/cpan/HTTP-Tiny/t/cases/redirect-08.txt
+++ b/cpan/HTTP-Tiny/t/cases/redirect-08.txt
@@ -2,6 +2,8 @@ url
   http://example.com/index.html
 expected
   <a href="http://example.com/index2.html">redirect</a>
+expected_url
+  http://example.com/index.html
 ----------
 GET /index.html HTTP/1.1
 Host: example.com
diff --git a/cpan/HTTP-Tiny/t/cases/redirect-09.txt b/cpan/HTTP-Tiny/t/cases/redirect-09.txt
index 02a75aa63b..afb0ec2f06 100644
--- a/cpan/HTTP-Tiny/t/cases/redirect-09.txt
+++ b/cpan/HTTP-Tiny/t/cases/redirect-09.txt
@@ -4,6 +4,8 @@ method
   POST
 expected
   abcdefghijklmnopqrstuvwxyz1234567890abcdef
+expected_url
+  http://example.com/index2.html
 ----------
 POST /index.html HTTP/1.1
 Host: example.com