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
'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',
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 ();
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,
$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;
}
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;
$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;
}
$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
=head1 VERSION
-version 0.033
+version 0.034
=head1 SYNOPSIS
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:
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;
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;
}
--- /dev/null
+#!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;
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
+
projects / platform / upstream / perl.git / commitdiff