This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Update HTTP-Tiny to CPAN version 0.034
authorChris 'BinGOs' Williams <chris@bingosnet.co.uk>
Thu, 27 Jun 2013 10:04:53 +0000 (11:04 +0100)
committerChris 'BinGOs' Williams <chris@bingosnet.co.uk>
Thu, 27 Jun 2013 10:04:53 +0000 (11:04 +0100)
  [DELTA]

0.034     2013-06-26 19:02:25 America/New_York

  [ADDED]

  - Added support for 'Basic' authorization from
    user:password parameters in the URL

MANIFEST
Porting/Maintainers.pl
cpan/HTTP-Tiny/lib/HTTP/Tiny.pm
cpan/HTTP-Tiny/t/010_url.t
cpan/HTTP-Tiny/t/161_basic_auth.t [new file with mode: 0644]
cpan/HTTP-Tiny/t/cases/auth-01.txt [new file with mode: 0644]
cpan/HTTP-Tiny/t/cases/auth-02.txt [new file with mode: 0644]
cpan/HTTP-Tiny/t/cases/auth-03.txt [new file with mode: 0644]

index c4ff4f1..6483278 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1082,7 +1082,11 @@ cpan/HTTP-Tiny/t/140_proxy.t
 cpan/HTTP-Tiny/t/141_no_proxy.t
 cpan/HTTP-Tiny/t/150_post_form.t
 cpan/HTTP-Tiny/t/160_cookies.t
+cpan/HTTP-Tiny/t/161_basic_auth.t
 cpan/HTTP-Tiny/t/BrokenCookieJar.pm
+cpan/HTTP-Tiny/t/cases/auth-01.txt
+cpan/HTTP-Tiny/t/cases/auth-02.txt
+cpan/HTTP-Tiny/t/cases/auth-03.txt
 cpan/HTTP-Tiny/t/cases/cookies-01.txt
 cpan/HTTP-Tiny/t/cases/cookies-02.txt
 cpan/HTTP-Tiny/t/cases/cookies-03.txt
index e520f5b..9feba57 100755 (executable)
@@ -929,7 +929,7 @@ use File::Glob qw(:case);
 
     'HTTP::Tiny' => {
         'MAINTAINER'   => 'dagolden',
-        'DISTRIBUTION' => 'DAGOLDEN/HTTP-Tiny-0.033.tar.gz',
+        'DISTRIBUTION' => 'DAGOLDEN/HTTP-Tiny-0.034.tar.gz',
         'FILES'        => q[cpan/HTTP-Tiny],
         'EXCLUDED'     => [
             't/00-report-prereqs.t',
index 2b9b703..30ef26c 100644 (file)
@@ -3,7 +3,7 @@ package HTTP::Tiny;
 use strict;
 use warnings;
 # ABSTRACT: A small, simple, correct HTTP/1.1 client
-our $VERSION = '0.033'; # VERSION
+our $VERSION = '0.034'; # VERSION
 
 use Carp ();
 
@@ -210,7 +210,7 @@ sub _agent {
 sub _request {
     my ($self, $method, $url, $args) = @_;
 
-    my ($scheme, $host, $port, $path_query) = $self->_split_url($url);
+    my ($scheme, $host, $port, $path_query, $auth) = $self->_split_url($url);
 
     my $request = {
         method    => $method,
@@ -237,7 +237,7 @@ sub _request {
         $handle->connect($scheme, $host, $port);
     }
 
-    $self->_prepare_headers_and_cb($request, $args, $url);
+    $self->_prepare_headers_and_cb($request, $args, $url, $auth);
     $handle->write_request($request);
 
     my $response;
@@ -266,7 +266,7 @@ sub _request {
 }
 
 sub _prepare_headers_and_cb {
-    my ($self, $request, $args, $url) = @_;
+    my ($self, $request, $args, $url, $auth) = @_;
 
     for ($self->{default_headers}, $args->{headers}) {
         next unless defined;
@@ -308,6 +308,13 @@ sub _prepare_headers_and_cb {
         $request->{headers}{cookie} = $cookies if length $cookies;
     }
 
+    # if we have Basic auth parameters, add them
+    if ( length $auth && ! defined $request->{headers}{authentication} ) {
+        require MIME::Base64;
+        $request->{headers}{authorization} =
+            "Basic " . MIME::Base64::encode_base64($auth, "");
+    }
+
     return;
 }
 
@@ -382,15 +389,23 @@ sub _split_url {
     $scheme     = lc $scheme;
     $path_query = "/$path_query" unless $path_query =~ m<\A/>;
 
-    my $host = (length($authority)) ? lc $authority : 'localhost';
-       $host =~ s/\A[^@]*@//;   # userinfo
+    my ($auth,$host);
+    $authority = (length($authority)) ? $authority : 'localhost';
+    if ( $authority =~ /@/ ) {
+        ($auth,$host) = $authority =~ m/\A([^@]*)@(.*)\z/;   # user:pass@host
+    }
+    else {
+        $host = $authority;
+        $auth = '';
+    }
+    $host = lc $host;
     my $port = do {
        $host =~ s/:([0-9]*)\z// && length $1
          ? $1
          : ($scheme eq 'http' ? 80 : $scheme eq 'https' ? 443 : undef);
     };
 
-    return ($scheme, $host, $port, $path_query);
+    return ($scheme, $host, $port, $path_query, $auth);
 }
 
 # Date conversions adapted from HTTP::Date
@@ -993,7 +1008,7 @@ HTTP::Tiny - A small, simple, correct HTTP/1.1 client
 
 =head1 VERSION
 
-version 0.033
+version 0.034
 
 =head1 SYNOPSIS
 
@@ -1164,8 +1179,15 @@ be updated accordingly.
 
 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.  A hashref of options may be appended to
-modify the request.
+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/');
+
+A hashref of options may be appended to modify the request.
 
 Valid options are:
 
index ed63396..bbaf14e 100644 (file)
@@ -3,23 +3,24 @@
 use strict;
 use warnings;
 
-use Test::More;
+use Test::More 0.86;
 use HTTP::Tiny;
 
 my @tests = (
-    [ 'HtTp://Example.COM/',                 'http',  'example.com',    80, '/'          ],
-    [ 'HtTp://Example.com:1024/',            'http',  'example.com',  1024, '/'          ],
-    [ 'http://example.com',                  'http',  'example.com',    80, '/'          ],
-    [ 'http://example.com:',                 'http',  'example.com',    80, '/'          ],
-    [ 'http://foo@example.com:',             'http',  'example.com',    80, '/'          ],
-    [ 'http://@example.com:',                'http',  'example.com',    80, '/'          ],
-    [ 'http://example.com?foo=bar',          'http',  'example.com',    80, '/?foo=bar'  ],
-    [ 'http://example.com?foo=bar#fragment', 'http',  'example.com',    80, '/?foo=bar'  ],
-    [ 'http://example.com/path?foo=bar',     'http',  'example.com',    80, '/path?foo=bar'  ],
-    [ 'http:///path?foo=bar',                'http',  'localhost',      80, '/path?foo=bar'  ],
-    [ 'HTTPS://example.com/',                'https', 'example.com',   443, '/'          ],
-    [ 'http://[::]:1024',                    'http',  '[::]',         1024, '/'          ],
-    [ 'xxx://foo/',                          'xxx',   'foo',         undef, '/'          ],
+    [ 'HtTp://Example.COM/',                 'http',  'example.com',    80, '/', '',          ],
+    [ 'HtTp://Example.com:1024/',            'http',  'example.com',  1024, '/', '',          ],
+    [ 'http://example.com',                  'http',  'example.com',    80, '/', '',          ],
+    [ 'http://example.com:',                 'http',  'example.com',    80, '/', '',          ],
+    [ 'http://foo@example.com:',             'http',  'example.com',    80, '/', 'foo',          ],
+    [ 'http://foo:pass@example.com:',        'http',  'example.com',    80, '/', 'foo:pass',          ],
+    [ 'http://@example.com:',                'http',  'example.com',    80, '/', '',          ],
+    [ 'http://example.com?foo=bar',          'http',  'example.com',    80, '/?foo=bar', '',  ],
+    [ 'http://example.com?foo=bar#fragment', 'http',  'example.com',    80, '/?foo=bar', '',  ],
+    [ 'http://example.com/path?foo=bar',     'http',  'example.com',    80, '/path?foo=bar', '',  ],
+    [ 'http:///path?foo=bar',                'http',  'localhost',      80, '/path?foo=bar', '',  ],
+    [ 'HTTPS://example.com/',                'https', 'example.com',   443, '/', '',          ],
+    [ 'http://[::]:1024',                    'http',  '[::]',         1024, '/', '',          ],
+    [ 'xxx://foo/',                          'xxx',   'foo',         undef, '/', '',          ],
 );
 
 plan tests => scalar @tests;
@@ -28,7 +29,7 @@ for my $test (@tests) {
     my $url = shift(@$test);
     my $got = [ HTTP::Tiny->_split_url($url) ];
     my $exp = $test;
-    is_deeply($got, $exp, "->split_url('$url')");
+    is_deeply($got, $exp, "->split_url('$url')") or diag explain $got;
 }
 
 
diff --git a/cpan/HTTP-Tiny/t/161_basic_auth.t b/cpan/HTTP-Tiny/t/161_basic_auth.t
new file mode 100644 (file)
index 0000000..1d44934
--- /dev/null
@@ -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/^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(%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/cases/auth-01.txt b/cpan/HTTP-Tiny/t/cases/auth-01.txt
new file mode 100644 (file)
index 0000000..e4a97c8
--- /dev/null
@@ -0,0 +1,18 @@
+url
+  http://foo:bar@example.com/index.html
+expected
+  abcdefghijklmnopqrstuvwxyz1234567890abcdef
+----------
+GET /index.html HTTP/1.1
+Host: example.com
+Connection: close
+User-Agent: HTTP-Tiny/VERSION
+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
diff --git a/cpan/HTTP-Tiny/t/cases/auth-02.txt b/cpan/HTTP-Tiny/t/cases/auth-02.txt
new file mode 100644 (file)
index 0000000..9b9a0fa
--- /dev/null
@@ -0,0 +1,18 @@
+url
+  http://Aladdin:open sesame@example.com/index.html
+expected
+  abcdefghijklmnopqrstuvwxyz1234567890abcdef
+----------
+GET /index.html HTTP/1.1
+Host: example.com
+Connection: close
+User-Agent: HTTP-Tiny/VERSION
+Authorization: Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==
+
+----------
+HTTP/1.1 200 OK
+Date: Thu, 03 Feb 1994 00:00:00 GMT
+Content-Type: text/plain
+Content-Length: 42
+
+abcdefghijklmnopqrstuvwxyz1234567890abcdef
diff --git a/cpan/HTTP-Tiny/t/cases/auth-03.txt b/cpan/HTTP-Tiny/t/cases/auth-03.txt
new file mode 100644 (file)
index 0000000..8852e9a
--- /dev/null
@@ -0,0 +1,36 @@
+url
+  http://foo:bar@example.com/index.html
+expected
+  abcdefghijklmnopqrstuvwxyz1234567890abcdef
+expected_url
+  http://example.com/index2.html
+----------
+GET /index.html HTTP/1.1
+Host: example.com
+Connection: close
+User-Agent: HTTP-Tiny/VERSION
+Authorization: Basic Zm9vOmJhcg==
+
+----------
+HTTP/1.1 302 Found
+Date: Thu, 03 Feb 1994 00:00:00 GMT
+Content-Type: text/html
+Content-Length: 53
+Location: http://example.com/index2.html
+
+<a href="http://example.com/index2.html">redirect</a>
+
+----------
+GET /index2.html HTTP/1.1
+Host: example.com
+Connection: close
+User-Agent: HTTP-Tiny/VERSION
+
+----------
+HTTP/1.1 200 OK
+Date: Thu, 03 Feb 1994 00:00:00 GMT
+Content-Type: text/plain
+Content-Length: 42
+
+abcdefghijklmnopqrstuvwxyz1234567890abcdef
+