--- AnyEvent-HTTP/HTTP.pm 2010/12/31 20:59:19 1.72 +++ AnyEvent-HTTP/HTTP.pm 2011/01/01 19:32:41 1.78 @@ -124,9 +124,23 @@ joined together with a comma (C<,>), as per the HTTP spec. If an internal error occurs, such as not being able to resolve a hostname, -then C<$data> will be C, C<< $headers->{Status} >> will be C<59x> -(usually C<599>) and the C pseudo-header will contain an error -message. +then C<$data> will be C, C<< $headers->{Status} >> will be +C<590>-C<599> and the C pseudo-header will contain an error +message. Currently the following status codes are used: + +=over 4 + +=item 595 - errors during connection etsbalishment, proxy handshake. + +=item 596 - errors during TLS negotiation, request sending and header processing. + +=item 597 - errors during body receiving or processing. + +=item 598 - user aborted request via C or C. + +=item 599 - other, usually nonretryable, errors (garbled URL etc.). + +=back A typical callback might look like this: @@ -414,8 +428,8 @@ } # parse set_cookie header into jar -sub cookie_jar_set_cookie($$) { - my ($jar, $set_cookie) = @_; +sub cookie_jar_set_cookie($$$) { + my ($jar, $set_cookie, $uhost) = @_; for ($set_cookie) { # parse NAME=VALUE @@ -474,13 +488,12 @@ } # store it - $arg{cookie_jar}{version} = 1; - $arg{cookie_jar}{$cdom}{$cpath}{$name} = \%kv; + $jar->{version} = 1; + $jar->{$cdom}{$cpath}{$name} = \%kv; redo if /\G\s*,/gc; } } -} # continue to parse $_ for headers and place them into the arg sub parse_hdr() { @@ -603,16 +616,16 @@ return unless $state{connect_guard}; + my $ae_error = 595; # connecting + my $connect_cb = sub { $state{fh} = shift or do { my $err = "$!"; %state = (); - return $cb->(undef, { @pseudo, Status => 599, Reason => $err }); + return $cb->(undef, { @pseudo, Status => $ae_error, Reason => $err }); }; - pop; # free memory, save a tree - return unless delete $state{connect_guard}; # get handle @@ -624,11 +637,11 @@ timeout => $timeout, on_error => sub { %state = (); - $cb->(undef, { @pseudo, Status => 599, Reason => $_[2] }); + $cb->(undef, { @pseudo, Status => $ae_error, Reason => $_[2] }); }, on_eof => sub { %state = (); - $cb->(undef, { @pseudo, Status => 599, Reason => "Unexpected end-of-file" }); + $cb->(undef, { @pseudo, Status => $ae_error, Reason => "Unexpected end-of-file" }); }, ; @@ -646,6 +659,8 @@ # handle actual, non-tunneled, request my $handle_actual_request = sub { + $ae_error = 596; # request phase + $state{handle}->starttls ("connect") if $uscheme eq "https" && !exists $state{handle}{tls}; # send request @@ -666,7 +681,7 @@ for ("$_[1]") { y/\015//d; # weed out any \015, as they show up in the weirdest of places. - /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\012]*) )? \012/igxc + /^HTTP\/0*([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\012]*) )? \012/gxci or return (%state = (), $cb->(undef, { @pseudo, Status => 599, Reason => "Invalid server response" })); # 100 Continue handling @@ -711,7 +726,7 @@ my $status = $hdr{Status}; # industry standard is to redirect POST as GET for - # 301, 302 and 303, in contrast to http/1.0 and 1.1. + # 301, 302 and 303, in contrast to HTTP/1.0 and 1.1. # also, the UA should ask the user for 301 and 307 and POST, # industry standard seems to be to simply follow. # we go with the industry standard. @@ -725,7 +740,7 @@ } my $finish = sub { # ($data, $err_status, $err_reason[, $keepalive]) - my $keepalive = pop; + my $may_keep_alive = $_[3]; $state{handle}->destroy if $state{handle}; %state = (); @@ -737,7 +752,8 @@ # set-cookie processing if ($arg{cookie_jar}) { - cookie_jar_set_cookie $arg{cookie_jar}, $hdr{"set-cookie"}; + cookie_jar_set_cookie $arg{cookie_jar}, $hdr{"set-cookie"}, $uhost; + } if ($redirect && exists $hdr{location}) { # we ignore any errors, as it is very common to receive @@ -754,6 +770,8 @@ } }; + $ae_error = 597; # body phase + my $len = $hdr{"content-length"}; if (!$redirect && $arg{on_header} && !$arg{on_header}(\%hdr)) { @@ -784,11 +802,9 @@ my $body = undef; my $on_body = $arg{on_body} || sub { $body .= shift; 1 }; - $_[0]->on_error (sub { $finish->(undef, 599 => $_[2]) }); - my $read_chunk; $read_chunk = sub { $_[1] =~ /^([0-9a-fA-F]+)/ - or $finish->(undef, 599 => "Garbled chunked transfer encoding"); + or $finish->(undef, $ae_error => "Garbled chunked transfer encoding"); my $len = hex $1; @@ -801,7 +817,7 @@ $_[0]->push_read (line => sub { length $_[1] - and return $finish->(undef, 599 => "Garbled chunked transfer encoding"); + and return $finish->(undef, $ae_error => "Garbled chunked transfer encoding"); $_[0]->push_read (line => $read_chunk); }); }); @@ -814,7 +830,7 @@ y/\015//d; # weed out any \015, as they show up in the weirdest of places. my $hdr = parse_hdr - or return $finish->(undef, 599 => "Garbled response trailers"); + or return $finish->(undef, $ae_error => "Garbled response trailers"); %hdr = (%hdr, %$hdr); } @@ -828,8 +844,6 @@ $_[0]->push_read (line => $read_chunk); } elsif ($arg{on_body}) { - $_[0]->on_error (sub { $finish->(undef, 599 => $_[2]) }); - if ($len) { $_[0]->on_read (sub { $len -= length $_[0]{rbuf}; @@ -853,7 +867,6 @@ $_[0]->on_eof (undef); if ($len) { - $_[0]->on_error (sub { $finish->(undef, 599 => $_[2]) }); $_[0]->on_read (sub { $finish->((substr delete $_[0]{rbuf}, 0, $len, ""), undef, undef, 1) if $len <= length $_[0]{rbuf}; @@ -862,7 +875,7 @@ $_[0]->on_error (sub { ($! == Errno::EPIPE || !$!) ? $finish->(delete $_[0]{rbuf}) - : $finish->(undef, 599 => $_[2]); + : $finish->(undef, $ae_error => $_[2]); }); $_[0]->on_read (sub { }); }