Furl
view release on metacpan or search on metacpan
https://github.com/tokuhirom/Test-TCP/issues/31#issuecomment-94378132
3.06 2015-02-09T23:05:09Z
commit 8a7786905c101eeab9db1d7baa8c4ec2076f9514
Author: Jari Salmela <bissei@users.noreply.github.com>
Date: Fri Feb 6 08:36:55 2015 +0200
Update HTTP.pm
fix for keep-alive as zmmail proposed.
"In line 526 of Furl/HTTP.pm, FURL checks the HTTP response headers it gets from the server. It will read the C
onnection from the response header there, and compare the header value with the string keep-alive. The problem is t
hat this does not take into account a different case of the response header. Some HTTP server returns a header value
e of Keep-Alive (mind the caps), so FURL does not recognize it properly.
I think the following change to Furl/HTTP.pm is more robust.
if ($connection_header eq 'keep-alive') {
if (lc($connection_header) eq 'keep-alive') {"
commit 91ebdf86693c5bfbda497df167977813e2ad75aa
Author: Kazuho Oku <kazuhooku@gmail.com>
Date: Wed Dec 24 16:26:07 2014 +0900
fix incorrect regex used for testing the response line (amends #80)
commit 65d0bc170a6344ebd24e0726a44260f3771fda0b
Author: HIROSE Masaaki <hirose31@gmail.com>
Date: Wed Dec 24 13:49:43 2014 +0900
- properly implement Furl::env_proxy as
a delegate to Furl::HTTP::env_proxy (as was already documented)
(lestrrat)
0.22 2011-01-25
- Remove default ports from the Host header
0.21 2011-01-11
- use keep-alive on redirection, do not activate the "write_code"
or the "write_func" feature when redirection(kazuho)
- silently try to resend a request only when the server returned
no respnose at all(kazuho)
0.20 2010-12-20
- add internal error response message to status message
(tokuhirom)
0.19 2010-12-20
- fixed testing issue(reported by many people)
0.17 2010-12-03
- only send the connection header with the highest precedence
(Furl::request => Furl::new)
(Kazuho Oku)
- close the connection when furl requested as such,
even if the server sent "connection: keep-alive"
(Kazuho Oku)
- support keep-alive for
$furl->request(method => 'HEAD', headers => [ qw(connection keep-alive) ])
(Kazuho Oku)
- always send the connection header
(support for automatic keep-alive with HTTP/1.0 servers)
(Kazuho Oku)
0.16 2010-12-01
- support for status codes wo. content(kazuho oku)
0.15 2010-11-28
- doc enhancements(tokuhirom)
0.07 2010-11-01
- Do not use reference_from, it makes installing issue(reported by y).
http://github.com/tokuhirom/Furl/issues#issue/4
0.06 2010-10-31
- now Perl 5.8.1 or later is required.(tokuhirom)
- High level interface is now available(tokuhirom)
- Keep alive on HTTP/1.0(kazuho, gfx)
- Retry requests if the connection is closed while in keep-alive(gfx)
0.05 2010-10-30
- use HTTP::Parser::XS
- optimization
- users can be set your own special headers.
- fixed Deep recursion when redirect over max_redirects.
- now, header_get is not public api.
0.04 2010-10-26
- fixed retval handling around Compress::Raw::Zlib(gfx)
- Change chuked tests not to use Starman(gfx)
- use binmode() for fucking win32(gfx)
0.03 2010-10-25
- support no_proxy
- fixed keep-alive issue
- fix ppport issue for perl < 5.12
- THX fix
- doc fix
- micro optimization
- a lot of tweaks
[0.02 not released]
- doc enhancements
- micro optimization
t/100_low/05_slowloris.t
t/100_low/06_errors.t
t/100_low/07_timeout.t
t/100_low/08_proxy.t
t/100_low/09_body.t
t/100_low/11_write_file.t
t/100_low/12_write_code.t
t/100_low/13_deflate.t
t/100_low/15_multiline_header.t
t/100_low/16_read_callback.t
t/100_low/17_keep_alive.t
t/100_low/18_no_proxy.t
t/100_low/19_special_headers.t
t/100_low/20_header_format_none.t
t/100_low/21_keep_alive_timedout.t
t/100_low/22_keep_alive.t
t/100_low/22_keep_alive_http10.t
t/100_low/23_redirect_relative.t
t/100_low/24_no_content.t
t/100_low/25_signal.t
t/100_low/26_headers_only.t
t/100_low/27_close_on_eof.t
t/100_low/28_idn.t
t/100_low/29_completion_slash.t
t/100_low/30_user_agent.t
t/100_low/31_chunked_unexpected_eof.t
t/100_low/32_proxy_auth.t
author/benchmark/byown.pl view on Meta::CPAN
use Test::TCP qw/empty_port/;
use Plack::Loader;
use Config;
use HTTP::Lite;
printf "Perl/%vd on %s\n", $^V, $Config{archname};
printf "Furl/$Furl::VERSION, LWP/$LWP::VERSION, WWW::Curl/$WWW::Curl::VERSION, HTTP::Lite/$HTTP::Lite::VERSION, libcurl[@{[ WWW::Curl::Easy::version() ]}]\n";
my $port = empty_port();
my $ua = LWP::UserAgent->new(parse_head => 0, keep_alive => 1);
my $curl = WWW::Curl::Easy->new();
my $furl = Furl::HTTP->new(parse_header => 0);
my $url = "http://127.0.0.1:$port/foo/bar";
my $child = Child->new(
sub {
Plack::Loader->load( 'Starman', port => $port )
->run(
sub { [ 200, ['Content-Length' => length('Hi')], ['Hi'] ] } );
}
author/benchmark/note.mkdn view on Meta::CPAN
http_lite 196/s 165% -- -26% -74%
furl 265/s 258% 35% -- -65%
curl 760/s 926% 287% 187% --
### useragent branch.
fbe216421eaa343ed86a8a3636a9ac3925018f61
Perl/5.12.1 on x86_64-linux
Furl/0.04, LWP/5.837, WWW::Curl/4.14, HTTP::Lite/2.2, libcurl[libcurl/7.21.0 OpenSSL/0.9.8o zlib/1.2.3.4 libidn/1.18]
--
Connection: keep-alive
Date: Mon, 01 Nov 2010 03:16:02 GMT
Accept-Ranges: bytes
Server: nginx/0.8.48
Content-Length: 2947
Content-Type: text/html
Last-Modified: Sat, 05 Jun 2010 23:53:36 GMT
Client-Date: Mon, 01 Nov 2010 03:16:02 GMT
Client-Peer: 192.168.1.3:80
Client-Response-Num: 1
--
author/benchmark/note.mkdn view on Meta::CPAN
furl_low 6762/s 746% 540% 44% -- -22%
curl 8650/s 982% 719% 84% 28% --
### 0.07
58868db2dbe06394ac6b8344fbbf47acf334daf1
Perl/5.12.1 on x86_64-linux
Furl/0.07, LWP/5.837, WWW::Curl/4.14, HTTP::Lite/2.2, libcurl[libcurl/7.21.0 OpenSSL/0.9.8o zlib/1.2.3.4 libidn/1.18]
--
Connection: keep-alive
Date: Tue, 02 Nov 2010 00:24:44 GMT
Accept-Ranges: bytes
Server: nginx/0.8.48
Content-Length: 2947
Content-Type: text/html
Last-Modified: Sat, 05 Jun 2010 23:53:36 GMT
Client-Date: Tue, 02 Nov 2010 00:24:44 GMT
Client-Peer: 192.168.1.3:80
Client-Response-Num: 1
--
author/benchmark/note.mkdn view on Meta::CPAN
furl_low 6342/s 701% 506% 33% -- -27%
curl 8650/s 993% 727% 82% 36% --
### kazuho
perl -Ilib benchmperl -Ilib benchmark/simple.pl [~/dev/Furl] æ°´ 17 19:05
65d1df9882c8f5330f9cc93a03722887867e303c
Perl/5.12.1 on x86_64-linux
Furl/0.13, LWP/5.837, WWW::Curl/4.14, HTTP::Lite/2.2, libcurl[libcurl/7.21.0 OpenSSL/0.9.8o zlib/1.2.3.4 libidn/1.18]
--
Connection: keep-alive
Date: Wed, 17 Nov 2010 10:05:52 GMT
Accept-Ranges: bytes
Server: nginx/0.8.48
Content-Length: 2947
Content-Type: text/html
Last-Modified: Sat, 05 Jun 2010 23:53:36 GMT
Client-Date: Wed, 17 Nov 2010 10:05:52 GMT
Client-Peer: 192.168.1.3:80
Client-Response-Num: 1
--
author/benchmark/simple.pl view on Meta::CPAN
GetOptions(
'busize=i' => \my $bufsize,
);
printf `git rev-parse HEAD`;
printf "Perl/%vd on %s\n", $^V, $Config{archname};
printf "Furl/$Furl::VERSION, LWP/$LWP::VERSION, WWW::Curl/$WWW::Curl::VERSION, HTTP::Lite/$HTTP::Lite::VERSION, libcurl[@{[ WWW::Curl::Easy::version() ]}]\n";
my $url = shift @ARGV || 'http://192.168.1.3:80/';
my $ua = LWP::UserAgent->new(parse_head => 0, keep_alive => 1);
my $curl = WWW::Curl::Easy->new();
my $furl_low = Furl::HTTP->new(header_format => HEADERS_NONE);
my $furl_high = Furl->new();
$furl_high->{bufsize} = $bufsize if defined $bufsize;
$furl_low->{bufsize} = $bufsize if defined $bufsize;
my $uri = URI->new($url);
my $host = $uri->host;
my $scheme = $uri->scheme;
my $port = $uri->port;
my $path_query = $uri->path_query;
lib/Furl/HTTP.pm view on Meta::CPAN
my $HTTP_TOKEN = '[^\x00-\x31\x7F]+';
my $HTTP_QUOTED_STRING = q{"([^"]+|\\.)*"};
sub new {
my $class = shift;
my %args = @_ == 1 ? %{$_[0]} : @_;
my @headers = (
'User-Agent' => (delete($args{agent}) || __PACKAGE__ . '/' . $Furl::HTTP::VERSION),
);
my $connection_header = 'keep-alive';
if(defined $args{headers}) {
my $in_headers = delete $args{headers};
for (my $i = 0; $i < @$in_headers; $i += 2) {
my $name = $in_headers->[$i];
if (lc($name) eq 'connection') {
$connection_header = $in_headers->[$i + 1];
} else {
push @headers, $name, $in_headers->[$i + 1];
}
}
lib/Furl/HTTP.pm view on Meta::CPAN
my $proxy = $self->{proxy};
my $no_proxy = $self->{no_proxy};
if ($proxy && $no_proxy) {
if ($self->match_no_proxy($no_proxy, $host)) {
undef $proxy;
}
}
local $SIG{PIPE} = 'IGNORE';
my $sock = $self->{connection_pool}->steal($host, $port);
my $in_keepalive;
if (defined $sock) {
if ($self->_do_select(0, $sock, 0)) {
close $sock;
undef $sock;
} else {
$in_keepalive = 1;
}
}
if(!$in_keepalive) {
my $err_reason;
if ($proxy) {
my (undef, $proxy_user, $proxy_pass, $proxy_host, $proxy_port, undef)
= $self->_parse_url($proxy);
my $proxy_authorization;
if (defined $proxy_user) {
_requires('URI/Escape.pm',
'Basic auth');
my($unescape_proxy_user) = URI::Escape::uri_unescape($proxy_user);
my($unescape_proxy_pass) = URI::Escape::uri_unescape($proxy_pass);
lib/Furl/HTTP.pm view on Meta::CPAN
my $special_headers = $args{special_headers} || +{};
$special_headers->{'connection'} = '';
$special_headers->{'content-length'} = undef;
$special_headers->{'location'} = '';
$special_headers->{'content-encoding'} = '';
$special_headers->{'transfer-encoding'} = '';
LOOP: while (1) {
my $n = $self->read_timeout($sock,
\$buf, $self->{bufsize}, length($buf), $timeout_at);
if(!$n) { # error or eof
if ($in_keepalive && length($buf) == 0
&& (defined($n) || $!==ECONNRESET || (WIN32 && $! == ECONNABORTED))) {
# the server closes the connection (maybe because of keep-alive timeout)
return $self->request(%args);
}
return $self->_r500(
!defined($n)
? "Cannot read response header: " . _strerror_or_timeout()
: "Unexpected EOF while reading response header"
);
}
else {
my $ret;
lib/Furl/HTTP.pm view on Meta::CPAN
@err = $self->_read_body_normal_to_string_buffer($sock,
\$res_content, length($rest_header),
$content_length, $timeout_at);
}
}
if(@err) {
return @err;
}
}
# manage connection cache (i.e. keep-alive)
if (lc($connection_header) eq 'keep-alive') {
my $connection = lc $special_headers->{'connection'};
if (($res_minor_version == 0
? $connection eq 'keep-alive' # HTTP/1.0 needs explicit keep-alive
: $connection ne 'close') # HTTP/1.1 can keep alive by default
&& ( defined $content_length or $chunked)) {
$self->{connection_pool}->push($host, $port, $sock);
}
}
# explicitly close here, just after returning the socket to the pool,
# since it might be reused in the upcoming recursive call
undef $sock;
# process 'Set-Cookie' header.
if (defined $cookie_jar) {
lib/Furl/HTTP.pm view on Meta::CPAN
This option choose return value format of C<< $furl->request >>.
This option allows HEADERS_NONE or HEADERS_AS_ARRAYREF.
B<HEADERS_AS_ARRAYREF> is a default value. This makes B<$headers> as ArrayRef.
B<HEADERS_NONE> makes B<$headers> as undef. Furl does not return parsing result of headers. You should take needed headers from B<special_headers>.
=item connection_pool :Object
This is the connection pool object for keep-alive requests. By default, it is a instance of L<Furl::ConnectionCache>.
You may not customize this variable otherwise to use L<Coro>. This attribute requires a duck type object. It has two methods, C<< $obj->steal($host, $port >> and C<< $obj->push($host, $port, $sock) >>.
=item stop_if :CodeRef
A callback function that is called by Furl after when a blocking function call returns EINTR. Furl will abort the HTTP request and return immediately if the callback returns true. Otherwise the operation is continued (the default behaviour).
=item get_address :CodeRef
A callback function to override the default address resolution logic. Takes three arguments: ($hostname, $port, $timeout_in_seconds) and returns: ($sockaddr, $errReason). If the returned $sockaddr is undef, then the resolution is considered as a fai...
t/100_low/08_proxy.t view on Meta::CPAN
my $content = "Hello, foo";
return [ 200,
[ 'Content-Length' => length($content) ],
[ $content ]
];
});
});
sub client (%) {
my (%args) = @_;
for (1..3) { # run some times for testing keep-alive.
my $furl = Furl::HTTP->new(proxy => $args{proxy});
my ( undef, $code, $msg, $headers, $content ) =
$furl->request(
url => $args{request},
headers => [ "X-Foo" => "ppp" ]
);
is $code, 200, "request()";
is $msg, "OK";
is Furl::HTTP::_header_get($headers, 'Content-Length'), 10;
is Furl::HTTP::_header_get($headers, 'Via'), $args{via};
is $content, 'Hello, foo'
or do{ require Devel::Peek; Devel::Peek::Dump($content) };
}
}
sub test_agent () {
return Test::UserAgent->new(
env_proxy => 1,
keep_alive => 2,
parse_head => 0,
);
}
local $ENV{'HTTP_PROXY'} = '';
# Request target with non-default port
test_tcp(
client => sub {
t/100_low/18_no_proxy.t view on Meta::CPAN
}
my $via = "VIA!VIA!VIA!";
test_tcp(
client => sub {
my $proxy_port = shift;
test_tcp(
client => sub { # http client
my $httpd_port = shift;
for (1..3) { # run some times for testing keep-alive.
my $furl = Furl::HTTP->new(proxy => "http://127.0.0.1:$proxy_port", no_proxy => "127.0.0.1");
my ( undef,$code, $msg, $headers, $content ) =
$furl->request(
url => "http://127.0.0.1:$httpd_port/foo",
headers => [ "X-Foo" => "ppp" ]
);
is $code, 200, "request()";
is $msg, "OK";
is Furl::HTTP::_header_get($headers, 'Content-Length'), 10;
isnt Furl::HTTP::_header_get($headers, 'Via'), "1.0 $via", "passing through the proxy";
t/100_low/21_keep_alive_timedout.t view on Meta::CPAN
my ( undef, $code, $msg, $headers, $content ) =
$furl->request(
port => $port,
path_query => '/foo',
host => '127.0.0.1',
);
is $code, 200, "request()/$_";
is $msg, "OK";
is Furl::HTTP::_header_get($headers, 'Content-Length'), 2, 'header'
or diag(explain($headers));
is Furl::HTTP::_header_get($headers, 'Connection'), 'keep-alive';
is $content, 'OK'
or do{ require Devel::Peek; Devel::Peek::Dump($content) };
}
done_testing;
},
server => sub {
my $port = shift;
t::HTTPServer->new( port => $port )->add_trigger(
"AFTER_HANDLE_REQUEST" => sub {
my ( $s, $csock ) = @_;
$csock->close();
}
)->run(
sub {
+[
200,
[ 'Content-Length' => 2, 'Connection' => 'keep-alive' ],
['OK']
];
}
);
}
);
t/100_low/22_keep_alive.t view on Meta::CPAN
is $msg, 'OK';
sleep 2;
(undef, $code, $msg) = $furl->request(port => $port, host => '127.0.0.1');
is $code, 200;
is $msg, 'OK';
},
server => sub {
my $port = shift;
my %args = (
port => $port,
keepalive_timeout => 1,
max_keepalive_reqs => 100,
max_reqs_per_child => 100,
max_workers => 1,
);
my $app = sub { [200, ['Content-Length' => 2], ['ok']] };
Plack::Loader->load('Starlet', %args)->run($app);
exit;
},
);
done_testing;
t/100_low/22_keep_alive_http10.t view on Meta::CPAN
my ( undef, $code, $msg, $headers, $content ) =
$furl->request(
host => $host,
port => $port,
path_query => '/foo',
);
is $code, 200, "request()/$_";
is $msg, "OK";
is Furl::HTTP::_header_get($headers, 'Content-Length'), 4, 'header'
or diag(explain($headers));
is Furl::HTTP::_header_get($headers, 'Connection'), 'keep-alive'
or diag(explain($headers));
is $content, '/foo'
or do{ require Devel::Peek; Devel::Peek::Dump($content) };
ok defined( $furl->{connection_pool}->steal($host, $port) ), 'in keep-alive';
}
done_testing;
},
server => sub {
my $port = shift;
Starlet::Server->new(
host => $host,
port => $port,
max_keepalive_reqs => 10,
)->run(sub {
my $env = shift;
$env->{SERVER_PROTOCOL} = 'HTTP/1.0'; #force response HTTP/1.0
return [ 200,
[ 'Content-Length' => length($env->{REQUEST_URI}) ],
[$env->{REQUEST_URI}]
];
});
}
);
t/100_low/32_proxy_auth.t view on Meta::CPAN
my $via = "VIA!VIA!VIA!";
local $ENV{'HTTP_PROXY'} = '';
test_tcp(
client => sub {
my $proxy_port = shift;
test_tcp(
client => sub { # http client
my $httpd_port = shift;
for (1..3) { # run some times for testing keep-alive.
my $furl = Furl::HTTP->new(proxy => "http://dankogai:kogaidan\@127.0.0.1:$proxy_port");
my ( undef, $code, $msg, $headers, $content ) =
$furl->request(
url => "http://127.0.0.1:$httpd_port/foo",
headers => [ "X-Foo" => "ppp" ]
);
is $code, 200, "request()";
is $msg, "OK";
is Furl::HTTP::_header_get($headers, 'Content-Length'), 10;
is Furl::HTTP::_header_get($headers, 'Via'), "1.0 $via";
is $content, 'Hello, foo'
or do{ require Devel::Peek; Devel::Peek::Dump($content) };
}
for (4..6) { # run some times for testing keep-alive.
my $furl = Furl::HTTP->new(proxy => "http://dan%40kogai:kogai%2Fdan\@127.0.0.1:$proxy_port");
my ( undef, $code, $msg, $headers, $content ) =
$furl->request(
url => "http://127.0.0.1:$httpd_port/escape",
headers => [ "X-Foo" => "qqq" ]
);
is $code, 200, "request()";
is $msg, "OK";
is Furl::HTTP::_header_get($headers, 'Content-Length'), 10;
is Furl::HTTP::_header_get($headers, 'Via'), "1.0 $via";
t/HTTPServer.pm view on Meta::CPAN
sub handle_connection {
my ($self, $csock, $app) = @_;
$self->call_trigger( "BEFORE_HANDLE_CONNECTION", $csock );
HANDLE_LOOP: while (1) {
$self->call_trigger( "BEFORE_HANDLE_REQUEST", $csock );
my %env;
my $buf = '';
PARSE_HTTP_REQUEST: while (1) {
my $nread = sysread( $csock, $buf, $self->{bufsize}, length($buf) );
$buf =~ s!^(\015\012)*!! if defined($buf); # for keep-alive
if ( !defined $nread ) {
die "cannot read HTTP request header: $!";
}
if ( $nread == 0 ) {
# unexpected EOF while reading HTTP request header
last HANDLE_LOOP;
}
my $ret = parse_http_request( $buf, \%env );
if ( $ret == -2 ) { # incomplete.
next;
( run in 1.175 second using v1.01-cache-2.11-cpan-39bf76dae61 )