[ViewVC] Diff of: cvs/AnyEvent-HTTP/HTTP.pm

Comparing AnyEvent-HTTP/HTTP.pm (file contents):
Revision 1.72 by root, Fri Dec 31 20:59:19 2010 UTC vs.
Revision 1.79 by root, Sat Jan 1 20:01:07 2011 UTC

 If the server sends a header multiple times, then their contents will be
 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<undef>, C<< $headers->{Status} >> will be C<59x>
+then C<$data> will be C<undef>, C<< $headers->{Status} >> will be
-(usually C<599>) and the C<Reason> pseudo-header will contain an error
+C<590>-C<599> and the C<Reason> pseudo-header will contain an error
-message.
+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<on_header> or C<on_body>.
+=item 599 - other, usually nonretryable, errors (garbled URL etc.).
+=back
 A typical callback might look like this:
    sub {
       my ($body, $hdr) = @_;
    \@cookies
 }
 # parse set_cookie header into jar
-sub cookie_jar_set_cookie($$) {
+sub cookie_jar_set_cookie($$$) {
-   my ($jar, $set_cookie) = @_;
+   my ($jar, $set_cookie, $uhost) = @_;
    for ($set_cookie) {
       # parse NAME=VALUE
       my @kv;
+      # expires is not http-compliant in the original cookie-spec,
+      # we support the official date format and some extensions
       while (
          m{
             \G\s*
             (?:
-               expires \s*=\s* ([A-Z][a-z][a-z],\ [^,;]+)
+               expires \s*=\s* ([A-Z][a-z][a-z]+,\ [^,;]+)
                | ([^=;,[:space:]]+) \s*=\s* (?: "((?:[^\\"]+|\\.)*)" | ([^=;,[:space:]]*) )
             )
          }gcxsi
       ) {
          my $name = $2;
       } else {
          $cdom = $uhost;
       }
       # store it
-      $arg{cookie_jar}{version} = 1;
+      $jar->{version} = 1;
-      $arg{cookie_jar}{$cdom}{$cpath}{$name} = \%kv;
+      $jar->{$cdom}{$cpath}{$name} = \%kv;
       redo if /\G\s*,/gc;
    }
-}
 }
 # continue to parse $_ for headers and place them into the arg
 sub parse_hdr() {
    my %hdr;
    _get_slot $uhost, sub {
       $state{slot_guard} = shift;
       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
          $state{handle} = new AnyEvent::Handle
             tls_ctx  => $arg{tls_ctx},
             # these need to be reconfigured on keepalive handles
             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" });
             },
          ;
          # limit the number of persistent connections
          # keepalive not yet supported
          $state{handle}->starttls ("connect") if $rscheme eq "https";
          # 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
             $state{handle}->push_write (
                "$method $rpath HTTP/1.1\015\012"
             # status line and headers
             $state{read_response} = sub {
                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
                   # should not happen as we don't send expect: 100-continue,
                   # but we handle it just in case.
                if ($recurse) {
                   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.
                   if ($status == 301 or $status == 302 or $status == 303) {
                      # HTTP/1.1 is unclear on how to mutate the method
                      $redirect = 1;
                   }
                }
                my $finish = sub { # ($data, $err_status, $err_reason[, $keepalive])
-                  my $keepalive = pop;
+                  my $may_keep_alive = $_[3];
                   $state{handle}->destroy if $state{handle};
                   %state = ();
                   if (defined $_[1]) {
                      $hdr{OrigReason} = $hdr{Reason}; $hdr{Reason} = $_[2];
                   }
                   # 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
                      # Content-Length != 0 but no actual body
                      # we also access %hdr, as $_[1] might be an erro
                         $cb);
                   } else {
                      $cb->($_[0], \%hdr);
                   }
                };
+               $ae_error = 597; # body phase
                my $len = $hdr{"content-length"};
                if (!$redirect && $arg{on_header} && !$arg{on_header}(\%hdr)) {
                   $finish->(undef, 598 => "Request cancelled by on_header");
                   } elsif ($hdr{"transfer-encoding"} =~ /\bchunked\b/i) {
                      my $cl = 0;
                      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;
                         if ($len) {
                            $cl += $len;
                               $on_body->($_[1], \%hdr)
                                  or return $finish->(undef, 598 => "Request cancelled by on_body");
                               $_[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);
                               });
                            });
                         } else {
                            $hdr{"content-length"} ||= $cl;
                               if (length $_[1]) {
                                  for ("$_[1]") {
                                     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);
                                  }
                               }
                      };
                      $_[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};
                            $arg{on_body}(delete $_[0]{rbuf}, \%hdr)
                      }
                   } else {
                      $_[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};
                         });
                      } else {
                         $_[0]->on_error (sub {
                            ($! == Errno::EPIPE || !$!)
                               ? $finish->(delete $_[0]{rbuf})
-                              : $finish->(undef, 599 => $_[2]);
+                              : $finish->(undef, $ae_error => $_[2]);
                         });
                         $_[0]->on_read (sub { });
                      }
                   }
                }
 Takes a POSIX timestamp (seconds since the epoch) and formats it as a HTTP
 Date (RFC 2616).
 =item $timestamp = AnyEvent::HTTP::parse_date $date
-Takes a HTTP Date (RFC 2616) or a Cookie date (netscape cookie spec) and
+Takes a HTTP Date (RFC 2616) or a Cookie date (netscape cookie spec) or a
-returns the corresponding POSIX timestamp, or C<undef> if the date cannot
+bunch of minor variations of those, and returns the corresponding POSIX
-be parsed.
+timestamp, or C<undef> if the date cannot be parsed.
 =item $AnyEvent::HTTP::MAX_RECURSE
 The default value for the C<recurse> request parameter (default: C<10>).
 sub parse_date($) {
    my ($date) = @_;
    my ($d, $m, $y, $H, $M, $S);
-   if ($date =~ /^[A-Z][a-z][a-z], ([0-9][0-9])[\- ]([A-Z][a-z][a-z])[\- ]([0-9][0-9][0-9][0-9]) ([0-9][0-9]):([0-9][0-9]):([0-9][0-9]) GMT$/) {
+   if ($date =~ /^[A-Z][a-z][a-z]+, ([0-9][0-9]?)[\- ]([A-Z][a-z][a-z])[\- ]([0-9][0-9][0-9][0-9]) ([0-9][0-9]?):([0-9][0-9]?):([0-9][0-9]?) GMT$/) {
       # RFC 822/1123, required by RFC 2616 (with " ")
       # cookie dates (with "-")
       ($d, $m, $y, $H, $M, $S) = ($1, $2, $3, $4, $5, $6);
-   } elsif ($date =~ /^[A-Z][a-z]+, ([0-9][0-9])-([A-Z][a-z][a-z])-([0-9][0-9]) ([0-9][0-9]):([0-9][0-9]):([0-9][0-9]) GMT$/) {
+   } elsif ($date =~ /^[A-Z][a-z][a-z]+, ([0-9][0-9]?)-([A-Z][a-z][a-z])-([0-9][0-9]) ([0-9][0-9]?):([0-9][0-9]?):([0-9][0-9]?) GMT$/) {
       # RFC 850
       ($d, $m, $y, $H, $M, $S) = ($1, $2, $3 < 69 ? $3 + 2000 : $3 + 1900, $4, $5, $6);
-   } elsif ($date =~ /^[A-Z][a-z][a-z] ([A-Z][a-z][a-z]) ([0-9 ][0-9]) ([0-9][0-9]):([0-9][0-9]):([0-9][0-9]) ([0-9][0-9][0-9][0-9])$/) {
+   } elsif ($date =~ /^[A-Z][a-z][a-z]+ ([A-Z][a-z][a-z]) ([0-9 ]?[0-9]) ([0-9][0-9]?):([0-9][0-9]?):([0-9][0-9]?) ([0-9][0-9][0-9][0-9])$/) {
       # ISO C's asctime
       ($d, $m, $y, $H, $M, $S) = ($2, $1, $6, $3, $4, $5);
    }
    # other formats fail in the loop below

Diff Legend

-–
+Removed lines
-+
+Added lines
-<
+Changed lines
->
+Changed lines

Comparing AnyEvent-HTTP/HTTP.pm (file contents): Revision 1.72 by root, Fri Dec 31 20:59:19 2010 UTC vs. Revision 1.79 by root, Sat Jan 1 20:01:07 2011 UTC

Diff Legend

Comparing AnyEvent-HTTP/HTTP.pm (file contents):
Revision 1.72 by root, Fri Dec 31 20:59:19 2010 UTC vs.
Revision 1.79 by root, Sat Jan 1 20:01:07 2011 UTC