@@ -12,8 +12,6 @@ use utf8;
use Module::Build;
use File::Basename;
use File::Spec;
-use CPAN::Meta;
-use CPAN::Meta::Prereqs;
my %args = (
license => 'perl',
@@ -25,12 +23,16 @@ my %args = (
name => 'Furl',
module_name => 'Furl',
- allow_pure_perl => 0,
+ allow_pureperl => 0,
script_files => [glob('script/*'), glob('bin/*')],
+ c_source => [qw()],
+ PL_files => {},
test_files => ((-d '.git' || $ENV{RELEASE_TESTING}) && -d 'xt') ? 't/ xt/' : 't/',
recursive_test_files => 1,
+
+
);
if (-d 'share') {
$args{share_dir} = 'share';
@@ -49,20 +51,15 @@ my $builder = Module::Build->subclass(
)->new(%args);
$builder->create_build_script();
-my $mbmeta = CPAN::Meta->load_file('MYMETA.json');
-my $meta = CPAN::Meta->load_file('META.json');
-my $prereqs_hash = CPAN::Meta::Prereqs->new(
- $meta->prereqs
-)->with_merged_prereqs(
- CPAN::Meta::Prereqs->new($mbmeta->prereqs)
-)->as_string_hash;
-my $mymeta = CPAN::Meta->new(
- {
- %{$meta->as_struct},
- prereqs => $prereqs_hash
- }
-);
-print "Merging cpanfile prereqs to MYMETA.yml\n";
-$mymeta->save('MYMETA.yml', { version => 1.4 });
-print "Merging cpanfile prereqs to MYMETA.json\n";
-$mymeta->save('MYMETA.json', { version => 2 });
+use File::Copy;
+
+print "cp META.json MYMETA.json\n";
+copy("META.json","MYMETA.json") or die "Copy failed(META.json): $!";
+
+if (-f 'META.yml') {
+ print "cp META.yml MYMETA.yml\n";
+ copy("META.yml","MYMETA.yml") or die "Copy failed(META.yml): $!";
+} else {
+ print "There is no META.yml... You may install this module from the repository...\n";
+}
+
@@ -1,5 +1,34 @@
Revision history for Perl module Furl
+3.05 2014-09-24T03:47:02Z
+
+ - Validate content-length before processing.
+ (Implemented by tokuhirom)
+ (Reviewed by kazuho++)
+
+3.04 2014-09-22T10:08:04Z
+
+ - remove trailing whitespace of Authorization header
+ (kazeburo++)
+
+3.03 2014-07-09T23:33:51Z
+
+ commit 8da0f43f2a6b3f04806288ce63a7bdc4df7f9a46
+ Author: Toshio Ito <debug.ito@gmail.com>
+ Date: Sat Jun 7 10:34:13 2014 +0900
+
+ t/100_low/07_timeout.t: iteratively increase content size instead of guessing the size of the se
+ c.f: gh #71, gh #56
+
+3.02 2014-03-18T20:52:07Z
+
+ - Added new experimental cookie_jar support.
+ (tokuhirom)
+
+3.01 2014-02-13T06:19:47Z
+
+ - Fixed documentation bug(Reported by Yappo++)
+
3.00 2013-11-13T09:39:38Z
- implement inactivity_timeout (for read / write), requested by autarch++
@@ -53,11 +53,13 @@ t/100_low/33_basic_auth.t
t/100_low/34_keep_request.t
t/100_low/35_get_address.t
t/100_low/36_inactivity_timeout.t
+t/100_low/37_bad_content_length.t
t/300_high/01_simple.t
t/300_high/02_agent.t
t/300_high/04_http_request.t
t/300_high/05_suppress_dup_host_header.t
t/300_high/06_keep_request.t
+t/300_high/07_cookie.t
t/300_high/99_error.t
t/400_components/001_response-coding/01-file.t
t/400_components/001_response-coding/t-euc-jp.html
@@ -4,8 +4,10 @@
"Tokuhiro Matsuno <tokuhirom@gmail.com>"
],
"dynamic_config" : 0,
- "generated_by" : "Minilla/v0.4.2",
- "license" : "perl_5",
+ "generated_by" : "Minilla/v2.1.1",
+ "license" : [
+ "perl_5"
+ ],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
"version" : "2"
@@ -19,34 +21,38 @@
"share",
"eg",
"examples",
- "author"
+ "author",
+ "builder"
]
},
"prereqs" : {
"configure" : {
"requires" : {
- "CPAN::Meta" : "0",
- "CPAN::Meta::Prereqs" : "0",
"Module::Build" : "0.38"
}
},
"develop" : {
"requires" : {
"Test::CPAN::Meta" : "0",
- "Test::MinimumVersion" : "0.10108",
+ "Test::MinimumVersion::Fast" : "0.04",
+ "Test::PAUSE::Permissions" : "0.04",
"Test::Pod" : "1.41",
- "Test::Spellunker" : "v0.2.2"
+ "Test::Spellunker" : "v0.2.7"
},
"suggests" : {
"Child" : "0",
"Getopt::Long" : "0",
"HTTP::Lite" : "0",
+ "IO::Callback" : "0",
"LWP::UserAgent" : "0",
+ "Net::DNS::Lite" : "0",
+ "Net::IDN::Encode" : "0",
"Plack::Loader" : "0",
"Starman" : "0",
+ "Test::LeakTrace" : "0",
"Test::More" : "0",
+ "Test::Requires" : "0",
"Test::TCP" : "0",
- "Test::suggests" : "0",
"URI" : "0",
"WWW::Curl::Easy" : "4.14",
"autodie" : "0",
@@ -56,6 +62,7 @@
"runtime" : {
"recommends" : {
"Compress::Raw::Zlib" : "0",
+ "HTTP::CookieJar" : "0",
"IO::Socket::SSL" : "0",
"Net::IDN::Encode" : "0"
},
@@ -84,6 +91,7 @@
"Test::TCP" : "1.06"
},
"suggests" : {
+ "HTTP::CookieJar" : "0",
"HTTP::Proxy" : "0",
"HTTP::Server::PSGI" : "0",
"Plack" : "0",
@@ -101,14 +109,14 @@
"provides" : {
"Furl" : {
"file" : "lib/Furl.pm",
- "version" : "3.00"
+ "version" : "3.05"
},
"Furl::ConnectionCache" : {
"file" : "lib/Furl/ConnectionCache.pm"
},
"Furl::HTTP" : {
"file" : "lib/Furl/HTTP.pm",
- "version" : "3.00"
+ "version" : "3.05"
},
"Furl::Headers" : {
"file" : "lib/Furl/Headers.pm"
@@ -134,7 +142,7 @@
"web" : "https://github.com/tokuhirom/Furl"
}
},
- "version" : "3.00",
+ "version" : "3.05",
"x_contributors" : [
"Keiji, Yoshimi <walf443@gmail.com>",
"Fuji, Goro <gfuji@cpan.org>",
@@ -142,14 +150,15 @@
"Audrey Tang <audreyt@audreyt.org>",
"mattn <mattn.jp@gmail.com>",
"Fuji Goro <fuji.goro@dena.jp>",
- "bayashi <bayashi@cpan.org>",
"Fuji, Goro <g.psy.va@gmail.com>",
"s-aska <s.aska.org@gmail.com>",
"ikasam_a <masaki.nakagawa@gmail.com>",
"xaicron <xaicron@gmail.com>",
"Syohei YOSHIDA <syohex@gmail.com>",
- "Masahiro Nagano <kazeburo@gmail.com>",
"Neil Bowers <neil@bowers.com>",
- "Kazuho Oku <kazuhooku@gmail.com>"
+ "Kazuho Oku <kazuhooku@gmail.com>",
+ "Toshio Ito <debug.ito@gmail.com>",
+ "bayashi <bayashi@cpan.org>",
+ "Masahiro Nagano <kazeburo@gmail.com>"
]
}
@@ -3,20 +3,18 @@ abstract: 'Lightning-fast URL fetcher'
author:
- 'Tokuhiro Matsuno <tokuhirom@gmail.com>'
build_requires:
- File::Temp: 0
- Test::More: 0.96
- Test::Requires: 0
- Test::TCP: 1.06
+ File::Temp: '0'
+ Test::More: '0.96'
+ Test::Requires: '0'
+ Test::TCP: '1.06'
configure_requires:
- CPAN::Meta: 0
- CPAN::Meta::Prereqs: 0
- Module::Build: 0.38
+ Module::Build: '0.38'
dynamic_config: 0
-generated_by: 'Minilla/v0.4.2, CPAN::Meta::Converter version 2.120921'
+generated_by: 'Minilla/v2.1.1, CPAN::Meta::Converter version 2.141520'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: 1.4
+ version: '1.4'
name: Furl
no_index:
directory:
@@ -27,47 +25,44 @@ no_index:
- eg
- examples
- author
+ - builder
provides:
Furl:
file: lib/Furl.pm
- version: 3.00
+ version: '3.05'
Furl::ConnectionCache:
file: lib/Furl/ConnectionCache.pm
- version: 0
Furl::HTTP:
file: lib/Furl/HTTP.pm
- version: 3.00
+ version: '3.05'
Furl::Headers:
file: lib/Furl/Headers.pm
- version: 0
Furl::Request:
file: lib/Furl/Request.pm
- version: 0
Furl::Response:
file: lib/Furl/Response.pm
- version: 0
Furl::ZlibStream:
file: lib/Furl/ZlibStream.pm
- version: 0
recommends:
- Compress::Raw::Zlib: 0
- IO::Socket::SSL: 0
- Net::IDN::Encode: 0
+ Compress::Raw::Zlib: '0'
+ HTTP::CookieJar: '0'
+ IO::Socket::SSL: '0'
+ Net::IDN::Encode: '0'
requires:
- Class::Accessor::Lite: 0
- Encode: 0
- HTTP::Parser::XS: 0.11
- MIME::Base64: 0
- Mozilla::CA: 0
- Scalar::Util: 0
- Socket: 0
- Time::HiRes: 0
- perl: 5.008001
+ Class::Accessor::Lite: '0'
+ Encode: '0'
+ HTTP::Parser::XS: '0.11'
+ MIME::Base64: '0'
+ Mozilla::CA: '0'
+ Scalar::Util: '0'
+ Socket: '0'
+ Time::HiRes: '0'
+ perl: '5.008001'
resources:
bugtracker: https://github.com/tokuhirom/Furl/issues
homepage: https://github.com/tokuhirom/Furl
repository: git://github.com/tokuhirom/Furl.git
-version: 3.00
+version: '3.05'
x_contributors:
- 'Keiji, Yoshimi <walf443@gmail.com>'
- 'Fuji, Goro <gfuji@cpan.org>'
@@ -75,12 +70,13 @@ x_contributors:
- 'Audrey Tang <audreyt@audreyt.org>'
- 'mattn <mattn.jp@gmail.com>'
- 'Fuji Goro <fuji.goro@dena.jp>'
- - 'bayashi <bayashi@cpan.org>'
- 'Fuji, Goro <g.psy.va@gmail.com>'
- 's-aska <s.aska.org@gmail.com>'
- 'ikasam_a <masaki.nakagawa@gmail.com>'
- 'xaicron <xaicron@gmail.com>'
- 'Syohei YOSHIDA <syohex@gmail.com>'
- - 'Masahiro Nagano <kazeburo@gmail.com>'
- 'Neil Bowers <neil@bowers.com>'
- 'Kazuho Oku <kazuhooku@gmail.com>'
+ - 'Toshio Ito <debug.ito@gmail.com>'
+ - 'bayashi <bayashi@cpan.org>'
+ - 'Masahiro Nagano <kazeburo@gmail.com>'
@@ -48,18 +48,23 @@ _%args_ might be:
- max\_redirects :Int = 7
- capture\_request :Bool = false
- If this parameter is true, [Furl::HTTP](http://search.cpan.org/perldoc?Furl::HTTP) captures raw request string.
+ If this parameter is true, [Furl::HTTP](https://metacpan.org/pod/Furl::HTTP) captures raw request string.
You can get it by `$res->captured_req_headers` and `$res->captured_req_content`.
- proxy :Str
- no\_proxy :Str
- headers :ArrayRef
+- cookie\_jar :Object
+
+ (EXPERIMENTAL)
+
+ An instance of HTTP::CookieJar or equivalent class that supports the add and cookie\_header methods
## Instance Methods
### `$furl->request([$request,] %args) :Furl::Response`
-Sends an HTTP request to a specified URL and returns a instance of [Furl::Response](http://search.cpan.org/perldoc?Furl::Response).
+Sends an HTTP request to a specified URL and returns a instance of [Furl::Response](https://metacpan.org/pod/Furl::Response).
_%args_ might be:
@@ -154,18 +159,18 @@ Loads proxy settings from `$ENV{HTTP_PROXY}` and `$ENV{NO_PROXY}`.
- I need more speed.
- See [Furl::HTTP](http://search.cpan.org/perldoc?Furl::HTTP), which provides the low level interface of [Furl](http://search.cpan.org/perldoc?Furl).
- It is faster than `Furl.pm` since [Furl::HTTP](http://search.cpan.org/perldoc?Furl::HTTP) does not create response objects.
+ See [Furl::HTTP](https://metacpan.org/pod/Furl::HTTP), which provides the low level interface of [Furl](https://metacpan.org/pod/Furl).
+ It is faster than `Furl.pm` since [Furl::HTTP](https://metacpan.org/pod/Furl::HTTP) does not create response objects.
- How do you use cookie\_jar?
- Furl does not directly support the cookie\_jar option available in LWP. You can use [HTTP::Cookies](http://search.cpan.org/perldoc?HTTP::Cookies), [HTTP::Request](http://search.cpan.org/perldoc?HTTP::Request), [HTTP::Response](http://search.cpan.org/perldoc?HTTP::Response) like following.
+ Furl does not directly support the cookie\_jar option available in LWP. You can use [HTTP::Cookies](https://metacpan.org/pod/HTTP::Cookies), [HTTP::Request](https://metacpan.org/pod/HTTP::Request), [HTTP::Response](https://metacpan.org/pod/HTTP::Response) like following.
my $f = Furl->new();
my $cookies = HTTP::Cookies->new();
my $req = HTTP::Request->new(...);
$cookies->add_cookie_header($req);
- my $res = H$f->request_with_http_request($req)->as_http_response;
+ my $res = $f->request($req)->as_http_response;
$res->request($req);
$cookies->extract_cookies($res);
# and use $res.
@@ -224,6 +229,7 @@ Loads proxy settings from `$ENV{HTTP_PROXY}` and `$ENV{NO_PROXY}`.
if $received_size >= $next_update;
}
);
+
- HTTPS requests claims warnings!
When you make https requests, IO::Socket::SSL may complain about it like:
@@ -245,9 +251,9 @@ Loads proxy settings from `$ENV{HTTP_PROXY}` and `$ENV{NO_PROXY}`.
ssl_opts => {
SSL_verify_mode => SSL_VERIFY_PEER(),
},
- });
+ );
- See [IO::Socket::SSL](http://search.cpan.org/perldoc?IO::Socket::SSL) for details.
+ See [IO::Socket::SSL](https://metacpan.org/pod/IO::Socket::SSL) for details.
# AUTHOR
@@ -273,13 +279,13 @@ audreyt
# SEE ALSO
-[LWP](http://search.cpan.org/perldoc?LWP)
+[LWP](https://metacpan.org/pod/LWP)
-[IO::Socket::SSL](http://search.cpan.org/perldoc?IO::Socket::SSL)
+[IO::Socket::SSL](https://metacpan.org/pod/IO::Socket::SSL)
-[Furl::HTTP](http://search.cpan.org/perldoc?Furl::HTTP)
+[Furl::HTTP](https://metacpan.org/pod/Furl::HTTP)
-[Furl::Response](http://search.cpan.org/perldoc?Furl::Response)
+[Furl::Response](https://metacpan.org/pod/Furl::Response)
# LICENSE
@@ -16,6 +16,7 @@ suggests 'HTTP::Response'; # Furl::Response
recommends 'Net::IDN::Encode'; # for International Domain Name
recommends 'IO::Socket::SSL'; # for SSL
recommends 'Compress::Raw::Zlib'; # for Content-Encoding
+recommends 'HTTP::CookieJar';
on test => sub {
requires 'Test::More' => 0.96; # done_testing, subtest
@@ -33,6 +34,7 @@ on test => sub {
suggests 'parent';
suggests 'Plack';
suggests 'Test::Valgrind';
+ suggests 'HTTP::CookieJar';
};
on develop => sub {
@@ -43,11 +45,15 @@ on develop => sub {
suggests 'Plack::Loader';
suggests 'Starman';
suggests 'Test::More';
- suggests 'Test::suggests';
+ suggests 'Test::Requires';
suggests 'Test::TCP';
suggests 'URI';
suggests 'WWW::Curl::Easy', '4.14';
+ suggests 'IO::Callback';
suggests 'autodie';
suggests 'parent';
+ suggests 'Net::IDN::Encode';
+ suggests 'Test::LeakTrace';
+ suggests 'Net::DNS::Lite';
};
@@ -4,7 +4,7 @@ use warnings;
use base qw/Exporter/;
use 5.008001;
-our $VERSION = '3.00';
+our $VERSION = '3.05';
use Carp ();
use Furl::ConnectionCache;
@@ -276,7 +276,7 @@ sub request {
if (defined $proxy_user) {
_requires('MIME/Base64.pm',
'Basic auth');
- $proxy_authorization = 'Basic ' . MIME::Base64::encode_base64("$proxy_user:$proxy_pass");
+ $proxy_authorization = 'Basic ' . MIME::Base64::encode_base64("$proxy_user:$proxy_pass","");
}
if ($scheme eq 'http') {
($sock, $err_reason)
@@ -327,7 +327,7 @@ sub request {
}
if (defined $username) {
_requires('MIME/Base64.pm', 'Basic auth');
- push @headers, 'Authorization', 'Basic ' . MIME::Base64::encode_base64("${username}:${password}");
+ push @headers, 'Authorization', 'Basic ' . MIME::Base64::encode_base64("${username}:${password}","");
}
my $content = $args{content};
@@ -493,6 +493,9 @@ sub request {
my $chunked = ($special_headers->{'transfer-encoding'} eq 'chunked');
my $content_length = $special_headers->{'content-length'};
+ if (defined($content_length) && $content_length !~ /\A[0-9]+\z/) {
+ return $self->_r500("Bad Content-Length: ${content_length}");
+ }
unless ($method eq 'HEAD'
|| ($res_status < 200 && $res_status >= 100)
@@ -564,7 +567,7 @@ sub request {
return (
$res_minor_version, $res_status, $res_msg, $res_headers, $res_content,
- $req_headers, $req_content,
+ $req_headers, $req_content, undef, undef, [$scheme, $username, $password, $host, $port, $path_query],
);
}
@@ -1297,7 +1300,7 @@ The example below sends all requests to 127.0.0.1:8080.
my $ua = Furl::HTTP->new(
get_address => sub {
my ($host, $port, $timeout) = @_;
- sockaddr_in(8080, inet_aton("127.0.0.1"));
+ pack_sockaddr_in(8080, inet_aton("127.0.0.1"));
},
);
@@ -6,7 +6,7 @@ use Furl::HTTP;
use Furl::Request;
use Furl::Response;
use Carp ();
-our $VERSION = '3.00';
+our $VERSION = '3.05';
use 5.008001;
@@ -100,6 +100,25 @@ sub request {
$args{headers} = $headers;
}
+ my $cookie_jar = ${$self}->{cookie_jar};
+
+ if ($cookie_jar) {
+ my $url;
+ if ($args{url}) {
+ $url = $args{url};
+ } else {
+ $url = join(
+ '',
+ $args{scheme},
+ '://',
+ $args{host},
+ (exists($args{port}) ? ":$args{port}" : ()),
+ exists($args{path_query}) ? $args{path_query} : '/',
+ );
+ }
+ push @{$args{headers}}, 'Cookie' => $cookie_jar->cookie_header($url);
+ }
+
my (
$res_minor_version,
$res_status,
@@ -107,10 +126,30 @@ sub request {
$res_headers,
$res_content,
$captured_req_headers,
- $captured_req_content ) = ${$self}->request(%args);
+ $captured_req_content,
+ $captured_res_headers,
+ $captured_res_content,
+ $request_info,
+ ) = ${$self}->request(%args);
my $res = Furl::Response->new($res_minor_version, $res_status, $res_msg, $res_headers, $res_content);
$res->set_request_info(\%args, $captured_req_headers, $captured_req_content);
+
+ if ($cookie_jar) {
+ my ($scheme, $username, $password, $host, $port, $path_query) = @$request_info;
+ my $req_url = join(
+ '',
+ $scheme,
+ '://',
+ (defined($username) && defined($password) ? "${username}:${password}@" : ()),
+ "$host:${port}${path_query}",
+ );
+ for my $cookie ($res->header('Set-Cookie')) {
+ # Do not use $args{url} as a url. Because the server may redirected.
+ $cookie_jar->add($req_url, $cookie);
+ }
+ }
+
return $res;
}
@@ -183,6 +222,12 @@ You can get it by C<< $res->captured_req_headers >> and C<< $res->captured_req_c
=item headers :ArrayRef
+=item cookie_jar :Object
+
+(EXPERIMENTAL)
+
+An instance of HTTP::CookieJar or equivalent class that supports the add and cookie_header methods
+
=back
=head2 Instance Methods
@@ -308,7 +353,7 @@ Furl does not directly support the cookie_jar option available in LWP. You can u
my $cookies = HTTP::Cookies->new();
my $req = HTTP::Request->new(...);
$cookies->add_cookie_header($req);
- my $res = H$f->request_with_http_request($req)->as_http_response;
+ my $res = $f->request($req)->as_http_response;
$res->request($req);
$cookies->extract_cookies($res);
# and use $res.
@@ -389,7 +434,7 @@ You should set C<SSL_verify_mode> explicitly with Furl's C<ssl_opts>.
ssl_opts => {
SSL_verify_mode => SSL_VERIFY_PEER(),
},
- });
+ );
See L<IO::Socket::SSL> for details.
@@ -38,22 +38,38 @@ test_tcp(
$furl = Furl::HTTP->new(timeout => 0.5);
note 'write_timeout';
- for (1 .. $n) {
- my $start_at = time;
- my ( undef, $code, $msg, $headers, $content ) =
- $furl->request(
- host => '127.0.0.1',
- port => $port,
- method => 'POST',
- path_query => '/foo',
- content => do {
- # should be larger than SO_SNDBUF (we use 2MB)
- my $content = "0123456789abcdef" x 64 x 2048;
- open my $fh, '<', \$content or die "oops";
- $fh;
- },
- );
- my $elapsed = time - $start_at;
+ my $CONTENT_SIZE_MB_MAX = 256;
+ WRITE_TIMEOUT_TEST: for (1 .. $n) {
+ my $content_size_mb = 1;
+ my ($elapsed, $code, $msg, $headers, $content);
+ while(1) {
+ note "Try sending $content_size_mb MiB content.";
+ my $start_at = time;
+ ( undef, $code, $msg, $headers, $content ) =
+ $furl->request(
+ host => '127.0.0.1',
+ port => $port,
+ method => 'POST',
+ path_query => '/foo',
+ content => do {
+ # should be larger than SO_SNDBUF + SO_RCVBUF + TCP_window_size
+ my $content = "0123456789abcdef" x 64 x 1024 x $content_size_mb;
+ open my $fh, '<', \$content or die "oops";
+ $fh;
+ },
+ );
+ $elapsed = time - $start_at;
+ if($msg !~ qr/Internal Response: Cannot read response header: timeout/) {
+ ## It's not read timeout. It seems OK.
+ last;
+ }
+ if($content_size_mb >= $CONTENT_SIZE_MB_MAX) {
+ fail "send $content_size_mb MiB but still write timeout did not occur.";
+ next WRITE_TIMEOUT_TEST;
+ }
+ note "Read timeout. Retry with more POST content";
+ $content_size_mb *= 2;
+ }
is $code, 500, "request()/$_";
like $msg, qr/Internal Response: Failed to send content: timeout/;
is ref($headers), "ARRAY";
@@ -71,4 +87,3 @@ test_tcp(
});
}
);
-
@@ -65,14 +65,12 @@ test_tcp(
server => sub { # proxy server
my $proxy_port = shift;
my $proxy = Test::HTTP::Proxy->new(port => $proxy_port, via => $via);
- my $token = "Basic " . encode_base64( "dankogai:kogaidan" );
+ my $token = "Basic " . encode_base64( "dankogai:kogaidan", "" );
$proxy->push_filter(
request => HTTP::Proxy::HeaderFilter::simple->new(
sub {
my ( $self, $headers, $request ) = @_;
my $auth = $self->proxy->hop_headers->header('Proxy-Authorization') || '';
- $auth =~ s/\s*$//;
- $token =~ s/\s*$//;
# check the credentials
if ( $auth ne $token ) {
@@ -28,7 +28,7 @@ test_tcp(
my $port = shift;
t::HTTPServer->new(port => $port)->run(sub {;
my $env = shift;
- is($env->{HTTP_AUTHORIZATION}, 'Basic ZGFua29nYWk6a29nYWlkYW4= ');
+ is($env->{HTTP_AUTHORIZATION}, 'Basic ZGFua29nYWk6a29nYWlkYW4=');
return [ 200,
[ 'Content-Length' => length($env->{REQUEST_URI}) ],
[$env->{REQUEST_URI}]
@@ -14,9 +14,19 @@ test_tcp(
my $furl = Furl::HTTP->new(capture_request => 1);
my @res = $furl->request( url => "http://127.0.0.1:$port/1", );
- my $content = pop @res;
- my $headers = pop @res;
- my $req = Furl::Request->parse($headers . $content);
+ my (
+ $res_minor_version,
+ $res_status,
+ $res_msg,
+ $res_headers,
+ $res_content,
+ $captured_req_headers,
+ $captured_req_content,
+ $captured_res_headers,
+ $captured_res_content,
+ $request_info,
+ ) = @res;
+ my $req = Furl::Request->parse($captured_req_headers . $captured_req_content);
is $req->method, 'GET';
is $req->uri, "http://127.0.0.1:$port/1";
@@ -0,0 +1,50 @@
+use strict;
+use warnings;
+use utf8;
+use Furl::HTTP;
+use Test::TCP;
+use Test::More;
+use t::HTTPServer;
+
+# Scenario: The server returns bad content-length.
+# RFC 2616 says Content-Length header's format is:
+#
+# Content-Length = "Content-Length" ":" 1*DIGIT
+#
+# But some server returns invalid format.
+# It makes mysterious error message by Perl interpreter.
+#
+# Then, Furl validates content-length header before processing.
+#
+# ref. https://www.ietf.org/rfc/rfc2616.txt
+
+my $n = shift(@ARGV) || 3;
+test_tcp(
+ client => sub {
+ my $port = shift;
+ my $furl = Furl::HTTP->new(bufsize => 10, timeout => 3);
+ my ( undef, $code, $msg, $headers, $content ) =
+ $furl->request(
+ port => $port,
+ path_query => '/foo',
+ host => '127.0.0.1',
+ headers => [ "X-Foo" => "ppp" ]
+ );
+ is $code, 500, "request()/$_";
+ like $msg, qr/Internal Response/;
+ like $content, qr/Bad Content-Length: 5963,5963/
+ or do{ require Devel::Peek; Devel::Peek::Dump($content) };
+
+ done_testing;
+ },
+ server => sub {
+ my $port = shift;
+ t::HTTPServer->new(port => $port)->run(sub {;
+ my $env = shift;
+ return [ 200,
+ [ 'Content-Length' => '5963,5963' ],
+ [$env->{REQUEST_URI}]
+ ];
+ });
+ }
+);
@@ -0,0 +1,101 @@
+use strict;
+use warnings;
+use utf8;
+use Test::More;
+use Test::Requires 'HTTP::CookieJar', 'Plack::Request', 'Plack::Loader', 'Plack::Builder', 'Plack::Response';
+use Test::TCP;
+use Furl;
+
+subtest 'Simple case', sub {
+ test_tcp(
+ client => sub {
+ my $port = shift;
+ my $furl = Furl->new(
+ cookie_jar => HTTP::CookieJar->new()
+ );
+ my $url = "http://127.0.0.1:$port";
+
+ subtest 'first time access', sub {
+ my $res = $furl->get("${url}/");
+
+ note "Then, response should be 200 OK";
+ is $res->status, 200;
+ note "And, content should be 'OK 1'";
+ is $res->content, 'OK 1';
+ };
+
+ subtest 'Second time access', sub {
+ my $res = $furl->get("${url}/");
+
+ note "Then, response should be 200 OK";
+ is $res->status, 200;
+ note "And, content should be 'OK 2'";
+ is $res->content, 'OK 2';
+ };
+ },
+ server => \&session_server,
+ );
+};
+
+subtest '->request(host => ...) style simple interface', sub {
+ test_tcp(
+ client => sub {
+ my $port = shift;
+ my $furl = Furl->new(
+ cookie_jar => HTTP::CookieJar->new()
+ );
+
+ subtest 'first time access', sub {
+ my $res = $furl->request(
+ method => 'GET',
+ scheme => 'http',
+ host => '127.0.0.1',
+ port => $port,
+ );
+
+ note "Then, response should be 200 OK";
+ is $res->status, 200;
+ note "And, content should be 'OK 1'";
+ is $res->content, 'OK 1';
+ };
+
+ subtest 'Second time access', sub {
+ my $res = $furl->request(
+ method => 'GET',
+ scheme => 'http',
+ host => '127.0.0.1',
+ port => $port,
+ );
+
+ note "Then, response should be 200 OK";
+ is $res->status, 200;
+ note "And, content should be 'OK 2'";
+ is $res->content, 'OK 2';
+ };
+ },
+ server => \&session_server,
+ );
+};
+
+done_testing;
+
+sub session_server {
+ my $port = shift;
+ my %SESSION_STORE;
+ Plack::Loader->auto( port => $port )->run(builder {
+ enable 'ContentLength';
+
+ sub {
+ my $env = shift;
+ my $req = Plack::Request->new($env);
+ my $session_key = $req->cookies->{session_key} || rand();
+ my $cnt = ++$SESSION_STORE{$session_key};
+ note "CNT: $cnt";
+ my $res = Plack::Response->new(
+ 200, [], ["OK ${cnt}"]
+ );
+ $res->cookies->{'session_key'} = $session_key;
+ return $res->finalize;
+ };
+ });
+}
@@ -26,7 +26,7 @@ my @RELIABLE_HTTP = (
# The regex are case-sensitive to at least
# deal with the "couldn't get site.com case".
'http://google.com/' => sub { /About Google/ },
- 'http://yahoo.com/' => sub { /Yahoo!/ },
+ 'http://yahoo.com/' => sub { $_ =~ /Yahoo!/ },
'http://amazon.com/' => sub { /Amazon/ and /Cart/ },
'http://cnn.com/' => sub { /CNN/ },
);