[libhijk-perl] 03/06: Add support for HEAD requests
Robin Sheat
eythian-guest at moszumanska.debian.org
Thu Feb 12 21:55:28 UTC 2015
This is an automated email from the git hooks/post-receive script.
eythian-guest pushed a commit to annotated tag 0.18
in repository libhijk-perl.
commit 38294dc917d88f6d2065e79d09a687c24cae2b05
Author: Ævar Arnfjörð Bjarmason <avarab at gmail.com>
Date: Wed Dec 10 13:19:08 2014 +0000
Add support for HEAD requests
We support ignoring the Content-Length here and also HEAD requests with
$no_content_len, although due to the TODO noted in the commit we can't
test that.
---
Changes | 5 +++++
lib/Hijk.pm | 8 ++++----
t/bin/head-request.psgi | 18 +++++++++++++++++
t/build_http_message.t | 3 +++
t/live-google.t | 16 +++++++++++++++
t/live-head-request.t | 54 +++++++++++++++++++++++++++++++++++++++++++++++++
6 files changed, 100 insertions(+), 4 deletions(-)
diff --git a/Changes b/Changes
index 653d414..17d170d 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,8 @@
+0.18: # 2014-12-10T14:00:00+000
+- We now do the right thing on "method => 'HEAD'". I.e. ignore the
+ Content-Length parameter, previously we'd just hang trying to slurp
+ up the body.
+
0.17: # 2014-08-31T18:30:00+000
- Minor documentation changes, no functional changes.
- The version number for the last release was incorrect in this
diff --git a/lib/Hijk.pm b/lib/Hijk.pm
index 87218bd..8d5e384 100644
--- a/lib/Hijk.pm
+++ b/lib/Hijk.pm
@@ -19,7 +19,7 @@ sub Hijk::Error::RESPONSE_BAD_READ_VALUE () { 1 << 6 } # 64
sub Hijk::Error::RESPONSE_ERROR () { Hijk::Error::RESPONSE_READ_ERROR | Hijk::Error::RESPONSE_BAD_READ_VALUE } # 96
sub _read_http_message {
- my ($fd, $read_length, $read_timeout, $parse_chunked, $head_as_array) = @_;
+ my ($fd, $read_length, $read_timeout, $parse_chunked, $head_as_array, $method) = @_;
$read_timeout = undef if defined($read_timeout) && $read_timeout <= 0;
my ($body,$buf,$decapitated,$nbytes,$proto);
@@ -27,6 +27,7 @@ sub _read_http_message {
my $header = $head_as_array ? [] : {};
my $no_content_len = 0;
my $head = "";
+ my $method_is_head = do { no warnings qw(uninitialized); $method eq "HEAD" };
vec(my $rin = '', $fd, 1) = 1;
do {
return (undef,undef,0,undef,undef, Hijk::Error::READ_TIMEOUT)
@@ -122,8 +123,7 @@ sub _read_http_message {
}
}
}
-
- } while( !$decapitated || $read_length > 0 || $no_content_len);
+ } while( !$decapitated || (!$method_is_head && ($read_length > 0 || $no_content_len)) );
return (undef, $proto, $status_code, $header, $body);
}
@@ -339,7 +339,7 @@ sub request {
my ($proto,$close_connection,$status,$head,$body,$error,$error_message,$errno_number,$errno_string);
eval {
($close_connection,$proto,$status,$head,$body,$error,$error_message,$errno_number,$errno_string) =
- _read_http_message(fileno($soc), @$args{qw(read_length read_timeout parse_chunked head_as_array)});
+ _read_http_message(fileno($soc), @$args{qw(read_length read_timeout parse_chunked head_as_array method)});
1;
} or do {
my $err = $@ || "zombie error";
diff --git a/t/bin/head-request.psgi b/t/bin/head-request.psgi
new file mode 100644
index 0000000..1c4a16e
--- /dev/null
+++ b/t/bin/head-request.psgi
@@ -0,0 +1,18 @@
+#!/usr/bin/env perl
+use strict;
+use warnings;
+
+sub {
+ my $env = shift;
+ my ($gimme_content_length) = $env->{QUERY_STRING} =~ m/\Agimme_content_length=([01])\z/;
+ my $hello_world = "Hello world";
+ return [
+ 200,
+ [
+ ($gimme_content_length
+ ? ()
+ : ()),
+ ],
+ [$hello_world],
+ ];
+}
diff --git a/t/build_http_message.t b/t/build_http_message.t
index 993866b..ce199f0 100644
--- a/t/build_http_message.t
+++ b/t/build_http_message.t
@@ -11,6 +11,9 @@ for my $protocol ("HTTP/1.0", "HTTP/1.1") {
is Hijk::_build_http_message({ protocol => $protocol, host => "example.com" }),
"GET / $protocol\x0d\x0aHost: example.com\x0d\x0a\x0d\x0a";
+ is Hijk::_build_http_message({ method => "HEAD", protocol => $protocol, host => "example.com" }),
+ "HEAD / $protocol\x0d\x0aHost: example.com\x0d\x0a\x0d\x0a";
+
is Hijk::_build_http_message({ protocol => $protocol, host => "www.example.com", port => "8080" }),
"GET / $protocol\x0d\x0aHost: www.example.com\x0d\x0a\x0d\x0a";
diff --git a/t/live-google.t b/t/live-google.t
index 512162b..f368ff4 100644
--- a/t/live-google.t
+++ b/t/live-google.t
@@ -60,6 +60,22 @@ subtest "timeout and cache" => sub {
ok !exists($res->{error}), '$res->{error} does not exist, because we do not expect connect timeout to happen';
cmp_ok scalar(keys %{$Hijk::SOCKET_CACHE}), '==', 0, "We have nothing in the global socket cache";
+ cmp_ok $res->{body}, "ne", "", "We a body with a GET requests";
+ } "We could make the request";
+
+ lives_ok {
+ my %socket_cache;
+ my $res = Hijk::request({
+ method => "HEAD",
+ host => 'google.com',
+ port => 80,
+ timeout => 0,
+ socket_cache => undef,
+ });
+
+ ok !exists($res->{error}), '$res->{error} does not exist, because we do not expect connect timeout to happen';
+ cmp_ok scalar(keys %{$Hijk::SOCKET_CACHE}), '==', 0, "We have nothing in the global socket cache";
+ cmp_ok $res->{body}, "eq", "", "We have no body from HEAD requests";
} "We could make the request";
};
diff --git a/t/live-head-request.t b/t/live-head-request.t
new file mode 100644
index 0000000..0416921
--- /dev/null
+++ b/t/live-head-request.t
@@ -0,0 +1,54 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+use FindBin;
+
+use Hijk;
+
+use Test::More;
+
+unless ($ENV{TEST_LIVE}) {
+ plan skip_all => "Enable live testing by setting env: TEST_LIVE=1";
+}
+
+my $pid = fork;
+die "Fail to fork then start a plack server" unless defined $pid;
+
+if ($pid == 0) {
+ require Plack::Runner;
+ my $runner = Plack::Runner->new;
+ $runner->parse_options("--port", "5002", "$FindBin::Bin/bin/head-request.psgi");
+ $runner->run;
+ exit;
+}
+
+sleep 5; # hopfully this is enough to launch that psgi.
+
+my %args = (
+ timeout => 1,
+ host => "localhost",
+ port => "5002",
+ method => "HEAD",
+);
+
+subtest "expect HEAD response with a Content-Length" => sub {
+ my $res = Hijk::request({%args, query_string => "gimme_content_length=1"});
+ ok !exists $res->{error}, '$res->{error} should not exist because this request should have been successful';
+ cmp_ok $res->{head}->{"Content-Length"}, "==", 11, "Got a Content-Length";
+ cmp_ok $res->{body}, "eq", "", "Got no body even though we had a Content-Length";
+};
+
+subtest "expect HEAD response without a Content-Length" => sub {
+ my $res = Hijk::request({%args, query_string => "gimme_content_length="});
+ ok !exists $res->{error}, '$res->{error} should not exist because this request should have been successful';
+ TODO: {
+ local $TODO = "I can't figure out how to get plackup(1) not to implicitly add Content-Length";
+ ok !exists $res->{head}->{"Content-Length"}, "We should get no Content-Length";
+ }
+ cmp_ok $res->{body}, "eq", "", "Got no body wit the HEAD response, also have no Content-Length";
+};
+
+END { kill INT => $pid }
+
+done_testing;
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libhijk-perl.git
More information about the Pkg-perl-cvs-commits
mailing list