Commit c6eae9e1 authored by Edward Zborowski's avatar Edward Zborowski

Added cookie support to HTTP::Tiny

parent 6d19dc21
......@@ -16,6 +16,8 @@ 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 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>
......@@ -70,6 +72,10 @@ sub new {
$args{agent} .= $default_agent
if defined $args{agent} && $args{agent} =~ / $/;
if( exists $args{cookie_jar} ) {
$class->_validate_cookie_jar( $args{cookie_jar} );
}
for my $key ( @attributes ) {
$self->{$key} = $args{$key} if exists $args{$key}
}
......@@ -388,6 +394,11 @@ sub _request {
do { $response = $handle->read_response_header }
until (substr($response->{status},0,1) ne '1');
### Update the cookie jar if there is one
if( defined $self->cookie_jar() ) {
$self->_update_cookie_jar( $url, $response );
}
if ( my @redir_args = $self->_maybe_redirect($request, $response, $args) ) {
$handle->close;
return $self->_request(@redir_args, $args);
......@@ -442,6 +453,16 @@ sub _prepare_headers_and_cb {
$request->{trailer_cb} = $args->{trailer_callback}
if ref $args->{trailer_callback} eq 'CODE';
}
### If we have a cookie jar
if (defined $self->cookie_jar()) {
### Then create cookie headers
my %hdrs = $self->_prepare_cookie_headers( $request );
### Add the cookie headers (if any) to the request)
@{$request->{headers}}{keys %hdrs} = values %hdrs;
}
return;
}
......@@ -465,6 +486,52 @@ sub _prepare_data_cb {
return $data_cb;
}
sub _prepare_cookie_headers {
my ($self, $request) = @_;
### Get any cookies for this URL
my %headers = ();
my $url = sprintf('%s://%s%s', @{$request}{qw (scheme host_port uri)});
my $cookies = $self->cookie_jar->cookie_header( $url );
if( defined $cookies && $cookies ne '' ) {
### Create the cookies header
$headers{'cookies'} = $cookies;
}
return %headers;
}
sub _update_cookie_jar {
my ($self, $url, $response) = @_;
### If there are cookies
return unless exists $response->{headers}->{'set-cookie'};
my $cookies = $response->{headers}->{'set-cookie'};
return unless defined $cookies && $cookies ne '';
### Then add them to the cookie jar
$self->cookie_jar->add( $url, $cookies );
return;
}
sub _validate_cookie_jar {
my ($proto, $jar) = @_;
### If a jar was supplied
if( defined $jar ) {
### Ensure it adheres to the HTTP::CookieJar signature
UNIVERSAL::can( $jar, 'add' )
or die(qq/Supplied cookie jar does not support the add method\n/);
UNIVERSAL::can( $jar, 'cookie_header' )
or die(qq/Supplied cookie jar does not support the cookie_header method\n/);
}
return;
}
sub _maybe_redirect {
my ($self, $request, $response, $args) = @_;
my $headers = $response->{headers};
......
......@@ -7,7 +7,7 @@ use Test::More tests => 2;
use HTTP::Tiny;
my @accessors = qw(
agent default_headers local_address max_redirect max_size proxy timeout SSL_options verify_SSL
agent default_headers local_address max_redirect max_size proxy timeout SSL_options verify_SSL cookie_jar
);
my @methods = qw(
new get head put post delete post_form request mirror www_form_urlencode
......
#!perl
use strict;
use warnings;
use Test::More tests => 4;
use t::SimpleCookieJar;
use t::BrokenCookieJar;
use HTTP::Tiny;
### a couple tests to ensure that:
### * by default there is no cookie jar defined
### * the correct cookie jar is returned when specified
### * error when cookie jar does not support the add and cookie_header methods
my $default = undef;
my $jar = t::SimpleCookieJar->new();
my $mug = t::BrokenCookieJar->new();
my $dog = t::BrokenCookieJar2->new();
{
my $ua = HTTP::Tiny->new();
is $ua->cookie_jar, $default, 'default cookie jar is as expected';
}
{
my $ua = HTTP::Tiny->new(cookie_jar => $jar);
is $ua->cookie_jar, $jar, 'cookie_jar is as expected';
}
{
my $ua = eval { HTTP::Tiny->new(cookie_jar => $mug) };
my $err = $@;
like( $err, qr/not support .* add method/
=> 'invalid jar does not support add method' );
$ua = eval { HTTP::Tiny->new(cookie_jar => $dog) };
$err = $@;
like( $err, qr/not support .* cookie_header method/
=> 'invalid jar does not support cookie_header method' );
}
#!perl
use strict;
use warnings;
use File::Basename;
use Test::More 0.88;
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];
use HTTP::Tiny;
BEGIN { monkey_patch() }
for my $file ( dir_list("t/cases", qr/^cookies/ ) ) {
my $label = basename($file);
my $data = do { local (@ARGV,$/) = $file; <> };
my @cases = split /--+\n/, $data;
my $jar = t::SimpleCookieJar->new();
my $http = undef;
while (@cases) {
my ($params, $expect_req, $give_res) = splice( @cases, 0, 3 );
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} );
if( exists $headers{Cookies} ) {
my $cookies = delete $headers{Cookies};
$jar->add( $url, $cookies );
}
if( exists $headers{'No-Cookie-Jar'} ) {
delete $headers{'No-Cookie-Jar'};
$jar = undef;
}
my %options;
$options{headers} = \%headers if %headers;
my $version = HTTP::Tiny->VERSION || 0;
my $agent = $new_args{agent} || "HTTP-Tiny/$version";
$new_args{cookie_jar} = $jar;
# cleanup source data
$expect_req =~ s{HTTP-Tiny/VERSION}{$agent};
s{\n}{$CRLF}g for ($expect_req, $give_res);
# setup mocking and test
my $res_fh = tmpfile($give_res);
my $req_fh = tmpfile();
$http = HTTP::Tiny->new(%new_args) if !defined $http;
clear_socket_source();
set_socket_source($req_fh, $res_fh);
my @call_args = %options ? ($url, \%options) : ($url);
my $response = $http->get(@call_args);
my $got_req = slurp($req_fh);
is( sort_headers($got_req), sort_headers($expect_req), "$label request data");
}
}
done_testing;
package t::BrokenCookieJar;
use strict;
use warnings;
sub new {
my $class = shift;
return bless {} => $class;
}
package t::BrokenCookieJar2;
use strict;
use warnings;
sub new {
my $class = shift;
return bless {} => $class;
}
sub add {
}
1;
package t::SimpleCookieJar;
use strict;
use warnings;
sub new {
my $class = shift;
return bless {} => $class;
}
sub add {
my ($self, $url, $cookies) = @_;
$self->{$url} = $cookies;
}
sub cookie_header {
my ($self, $url) = @_;
return $self->{$url};
}
1;
url
http://example.com/index.html
----------
GET /index.html HTTP/1.1
Host: example.com
Connection: close
User-Agent: HTTP-Tiny/VERSION
----------
HTTP/1.1 200 OK
Date: Sat, 02 Mar 2013 00:00:00 GMT
Set-Cookie: cname=cvalue; domain=example.com; path=/
Content-Type: text/plain
Content-Length: 44
abcdefghijklmnopqrstuvwxyz1234567890abcdef
----------
url
http://example.com/index.html
----------
GET /index.html HTTP/1.1
Host: example.com
Connection: close
User-Agent: HTTP-Tiny/VERSION
Cookies: cname=cvalue; domain=example.com; path=/
----------
HTTP/1.1 200 OK
Date: Sat, 02 Mar 2013 00:00:00 GMT
Set-Cookie: cname=cvalue; domain=example.com; path=/
Content-Type: text/plain
Content-Length: 44
abcdefghijklmnopqrstuvwxyz1234567890abcdef
url
http://example.com/index.html
----------
GET /index.html HTTP/1.1
Host: example.com
Connection: close
User-Agent: HTTP-Tiny/VERSION
----------
HTTP/1.1 200 OK
Date: Sat, 02 Mar 2013 00:00:00 GMT
Set-Cookie: cname=cvalue01; domain=example.com; path=/
Content-Type: text/plain
Content-Length: 44
abcdefghijklmnopqrstuvwxyz1234567890abcdef
----------
url
http://example.com/index.html
----------
GET /index.html HTTP/1.1
Host: example.com
Connection: close
User-Agent: HTTP-Tiny/VERSION
Cookies: cname=cvalue01; domain=example.com; path=/
----------
HTTP/1.1 200 OK
Date: Sat, 02 Mar 2013 00:00:00 GMT
Set-Cookie: cname=cvalue02; domain=example.com; path=/
Content-Type: text/plain
Content-Length: 44
abcdefghijklmnopqrstuvwxyz1234567890abcdef
----------
url
http://example.com/index.html
----------
GET /index.html HTTP/1.1
Host: example.com
Connection: close
User-Agent: HTTP-Tiny/VERSION
Cookies: cname=cvalue02; domain=example.com; path=/
----------
HTTP/1.1 200 OK
Date: Sat, 02 Mar 2013 00:00:00 GMT
Set-Cookie: cname=cvalue02; domain=example.com; path=/
Content-Type: text/plain
Content-Length: 44
abcdefghijklmnopqrstuvwxyz1234567890abcdef
url
http://example.com/index.html
----------
GET /index.html HTTP/1.1
Host: example.com
Connection: close
User-Agent: HTTP-Tiny/VERSION
----------
HTTP/1.1 200 OK
Date: Sat, 02 Mar 2013 00:00:00 GMT
Set-Cookie: cname=cvalue01; domain=example.com; path=/
Content-Type: text/plain
Content-Length: 44
abcdefghijklmnopqrstuvwxyz1234567890abcdef
----------
url
http://example.com/index.html
----------
GET /index.html HTTP/1.1
Host: example.com
Connection: close
User-Agent: HTTP-Tiny/VERSION
Cookies: cname=cvalue01; domain=example.com; path=/
----------
HTTP/1.1 200 OK
Date: Sat, 02 Mar 2013 00:00:00 GMT
Set-Cookie: cname=cvalue02; domain=example.com; path=/
Content-Type: text/plain
Content-Length: 44
abcdefghijklmnopqrstuvwxyz1234567890abcdef
----------
url
http://example.com/index02.html
----------
GET /index02.html HTTP/1.1
Host: example.com
Connection: close
User-Agent: HTTP-Tiny/VERSION
----------
HTTP/1.1 200 OK
Date: Sat, 02 Mar 2013 00:00:00 GMT
Set-Cookie: cname=cvalue03; domain=example.com; path=/
Content-Type: text/plain
Content-Length: 44
abcdefghijklmnopqrstuvwxyz1234567890abcdef
----------
url
http://example.com/index.html
----------
GET /index.html HTTP/1.1
Host: example.com
Connection: close
User-Agent: HTTP-Tiny/VERSION
Cookies: cname=cvalue02; domain=example.com; path=/
----------
HTTP/1.1 200 OK
Date: Sat, 02 Mar 2013 00:00:00 GMT
Set-Cookie: cname=cvalue02; domain=example.com; path=/
Content-Type: text/plain
Content-Length: 44
abcdefghijklmnopqrstuvwxyz1234567890abcdef
----------
url
http://example.com/index02.html
----------
GET /index02.html HTTP/1.1
Host: example.com
Connection: close
User-Agent: HTTP-Tiny/VERSION
Cookies: cname=cvalue03; domain=example.com; path=/
----------
HTTP/1.1 200 OK
Date: Sat, 02 Mar 2013 00:00:00 GMT
Set-Cookie: cname=cvalue03; domain=example.com; path=/
Content-Type: text/plain
Content-Length: 44
abcdefghijklmnopqrstuvwxyz1234567890abcdef
url
http://example.com/index.html
headers
Cookies: cname=cvalue05; domain=example.com; path=/
----------
GET /index.html HTTP/1.1
Host: example.com
Connection: close
User-Agent: HTTP-Tiny/VERSION
Cookies: cname=cvalue05; domain=example.com; path=/
----------
HTTP/1.1 200 OK
Date: Sat, 02 Mar 2013 00:00:00 GMT
Set-Cookie: cname=cvalue06; domain=example.com; path=/
Content-Type: text/plain
Content-Length: 44
abcdefghijklmnopqrstuvwxyz1234567890abcdef
----------
url
http://example.com/index.html
----------
GET /index.html HTTP/1.1
Host: example.com
Connection: close
User-Agent: HTTP-Tiny/VERSION
Cookies: cname=cvalue06; domain=example.com; path=/
----------
HTTP/1.1 200 OK
Date: Sat, 02 Mar 2013 00:00:00 GMT
Set-Cookie: cname=cvalue06; domain=example.com; path=/
Content-Type: text/plain
Content-Length: 44
abcdefghijklmnopqrstuvwxyz1234567890abcdef
url
http://example.com/index.html
headers
No-Cookie-Jar: 1
----------
GET /index.html HTTP/1.1
Host: example.com
Connection: close
User-Agent: HTTP-Tiny/VERSION
----------
HTTP/1.1 200 OK
Date: Sat, 02 Mar 2013 00:00:00 GMT
Set-Cookie: cname=cvalue06; domain=example.com; path=/
Content-Type: text/plain
Content-Length: 44
abcdefghijklmnopqrstuvwxyz1234567890abcdef
----------
url
http://example.com/index.html
----------
GET /index.html HTTP/1.1
Host: example.com
Connection: close
User-Agent: HTTP-Tiny/VERSION
----------
HTTP/1.1 200 OK
Date: Sat, 02 Mar 2013 00:00:00 GMT
Set-Cookie: cname=cvalue06; domain=example.com; path=/
Content-Type: text/plain
Content-Length: 44
abcdefghijklmnopqrstuvwxyz1234567890abcdef
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment