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

Comparing AnyEvent-HTTP/HTTP.pm (file contents):
Revision 1.94 by root, Tue Jan 11 23:49:37 2011 UTC vs.
Revision 1.116 by root, Fri May 17 07:19:23 2013 UTC

 use AnyEvent::Util ();
 use AnyEvent::Handle ();
 use base Exporter::;
-our $VERSION = '2.01';
+our $VERSION = '2.15';
 our @EXPORT = qw(http_get http_post http_head http_request);
 our $USERAGENT          = "Mozilla/5.0 (compatible; U; AnyEvent-HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)";
 our $MAX_RECURSE        =  10;
 C<590>-C<599> and the C<Reason> 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 595 - errors during connection establishment, proxy handshake.
 =item 596 - errors during TLS negotiation, request sending and header processing.
 =item 597 - errors during body receiving or processing.
 =over 4
 =item recurse => $count (default: $MAX_RECURSE)
-Whether to recurse requests or not, e.g. on redirects, authentication
+Whether to recurse requests or not, e.g. on redirects, authentication and
-retries and so on, and how often to do so.
+other retries and so on, and how often to do so.
 =item headers => hashref
 The request headers to use. Currently, C<http_request> may provide its own
 C<Host:>, C<Content-Length:>, C<Connection:> and C<Cookie:> headers and
 You really should provide your own C<User-Agent:> header value that is
 appropriate for your program - I wouldn't be surprised if the default
 AnyEvent string gets blocked by webservers sooner or later.
+Also, make sure that your headers names and values do not contain any
+embedded newlines.
 =item timeout => $seconds
 The time-out to use for various stages - each connect attempt will reset
 the timeout, as will read or write activity, i.e. this is not an overall
 timeout.
 Default timeout is 5 minutes.
 =item proxy => [$host, $port[, $scheme]] or undef
-Use the given http proxy for all requests. If not specified, then the
+Use the given http proxy for all requests, or no proxy if C<undef> is
-default proxy (as specified by C<$ENV{http_proxy}>) is used.
+used.
 C<$scheme> must be either missing or must be C<http> for HTTP.
+If not specified, then the default proxy is used (see
+C<AnyEvent::HTTP::set_proxy>).
 =item body => $string
 The request body, usually empty. Will be sent as-is (future versions of
 this module might offer more options).
 Example: do a HTTP HEAD request on https://www.google.com/, use a
 timeout of 30 seconds.
    http_request
-      GET     => "https://www.google.com",
+      HEAD    => "https://www.google.com",
       headers => { "user-agent" => "MySearchClient 1.0" },
       timeout => 30,
       sub {
          my ($body, $hdr) = @_;
          use Data::Dumper;
       while (
          m{
             \G\s*
             (?:
                expires \s*=\s* ([A-Z][a-z][a-z]+,\ [^,;]+)
-               | ([^=;,[:space:]]+) (?: \s*=\s* (?: "((?:[^\\"]+|\\.)*)" | ([^=;,[:space:]]*) ) )?
+               | ([^=;,[:space:]]+) (?: \s*=\s* (?: "((?:[^\\"]+|\\.)*)" | ([^;,[:space:]]*) ) )?
             )
          }gcxsi
       ) {
          my $name = $2;
          my $value = $4;
             # quoted
             $value = $3;
             $value =~ s/\\(.)/$1/gs;
          }
-         push @kv, lc $name, $value;
+         push @kv, @kv ? lc $name : $name, $value;
          last unless /\G\s*;/gc;
       }
       last unless @kv;
    $cb->(undef, $hdr);
    ()
 }
+our %IDEMPOTENT = (
+   DELETE		=> 1,
+   GET			=> 1,
+   HEAD			=> 1,
+   OPTIONS		=> 1,
+   PUT			=> 1,
+   TRACE		=> 1,
+   ACL			=> 1,
+   "BASELINE-CONTROL"	=> 1,
+   BIND			=> 1,
+   CHECKIN		=> 1,
+   CHECKOUT		=> 1,
+   COPY			=> 1,
+   LABEL		=> 1,
+   LINK			=> 1,
+   MERGE		=> 1,
+   MKACTIVITY		=> 1,
+   MKCALENDAR		=> 1,
+   MKCOL		=> 1,
+   MKREDIRECTREF	=> 1,
+   MKWORKSPACE		=> 1,
+   MOVE			=> 1,
+   ORDERPATCH		=> 1,
+   PROPFIND		=> 1,
+   PROPPATCH		=> 1,
+   REBIND		=> 1,
+   REPORT		=> 1,
+   SEARCH		=> 1,
+   UNBIND		=> 1,
+   UNCHECKOUT		=> 1,
+   UNLINK		=> 1,
+   UNLOCK		=> 1,
+   UPDATE		=> 1,
+   UPDATEREDIRECTREF	=> 1,
+   "VERSION-CONTROL"	=> 1,
+);
 sub http_request($$@) {
    my $cb = pop;
    my ($method, $url, %arg) = @_;
    my %hdr;
    my $recurse = exists $arg{recurse} ? delete $arg{recurse} : $MAX_RECURSE;
    return $cb->(undef, { @pseudo, Status => 599, Reason => "Too many redirections" })
       if $recurse < 0;
-   my $proxy   = $arg{proxy}   || $PROXY;
+   my $proxy   = exists $arg{proxy} ? $arg{proxy} : $PROXY;
    my $timeout = $arg{timeout} || $TIMEOUT;
    my ($uscheme, $uauthority, $upath, $query, undef) = # ignore fragment
-      $url =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:(\?[^#]*))?(?:#(.*))?|;
+      $url =~ m|^([^:]+):(?://([^/?#]*))?([^?#]*)(?:(\?[^#]*))?(?:#(.*))?$|;
    $uscheme = lc $uscheme;
    my $uport = $uscheme eq "http"  ?  80
              : $uscheme eq "https" ? 443
    $hdr{"user-agent"} = $USERAGENT                     unless exists $hdr{"user-agent"};
    $hdr{"content-length"} = length $arg{body}
       if length $arg{body} || $method ne "GET";
-   my $idempotent = $method =~ /^(?:GET|HEAD|PUT|DELETE|OPTIONS|TRACE)$/;
+   my $idempotent = $IDEMPOTENT{$method};
    # default value for keepalive is true iff the request is for an idempotent method
-   my $keepalive = exists $arg{keepalive} ? !!$arg{keepalive} : $idempotent;
+   my $persistent = exists $arg{persistent} ? !!$arg{persistent} : $idempotent;
-   my $keepalive10 = exists $arg{keepalive10} ? $arg{keepalive10} : !$proxy;
+   my $keepalive  = exists $arg{keepalive}  ? !!$arg{keepalive}  : !$proxy;
-   my $keptalive; # true if this is actually a recycled connection
+   my $was_persistent; # true if this is actually a recycled connection
    # the key to use in the keepalive cache
-   my $ka_key = "$uhost\x00$arg{sessionid}";
+   my $ka_key = "$uscheme\x00$uhost\x00$uport\x00$arg{sessionid}";
-   $hdr{connection} = ($keepalive ? $keepalive10 ? "keep-alive " : "" : "close ") . "Te"; #1.1
+   $hdr{connection} = ($persistent ? $keepalive ? "keep-alive " : "" : "close ") . "Te"; #1.1
    $hdr{te}         = "trailers" unless exists $hdr{te}; #1.1
    my %state = (connect_guard => 1);
    my $ae_error = 595; # connecting
             } elsif ($status == 307) {
                $redirect = 1;
             }
          }
-         my $finish = sub { # ($data, $err_status, $err_reason[, $keepalive])
+         my $finish = sub { # ($data, $err_status, $err_reason[, $persistent])
             if ($state{handle}) {
                # handle keepalive
                if (
-                  $keepalive
+                  $persistent
                   && $_[3]
                   && ($hdr{HTTPVersion} < 1.1
                       ? $hdr{connection} =~ /\bkeep-?alive\b/i
                       : $hdr{connection} !~ /\bclose\b/i)
                ) {
             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
+               $state{recurse} =
-               http_request (
+                  http_request (
-                  $method  => $hdr{location},
+                     $method  => $hdr{location},
-                  %arg,
+                     %arg,
-                  recurse  => $recurse - 1,
+                     recurse  => $recurse - 1,
-                  Redirect => [$_[0], \%hdr],
+                     Redirect => [$_[0], \%hdr],
+                     sub {
+                        %state = ();
-                  $cb
+                        &$cb
+                     },
-               );
+                  );
             } else {
                $cb->($_[0], \%hdr);
             }
          };
             my $body = "";
             my $on_body = $arg{on_body} || sub { $body .= shift; 1 };
             $state{read_chunk} = sub {
                $_[1] =~ /^([0-9a-fA-F]+)/
-                  or $finish->(undef, $ae_error => "Garbled chunked transfer encoding");
+                  or return $finish->(undef, $ae_error => "Garbled chunked transfer encoding");
                my $len = hex $1;
                if ($len) {
                   $cl += $len;
          }
       };
       # if keepalive is enabled, then the server closing the connection
       # before a response can happen legally - we retry on idempotent methods.
-      if ($keptalive && $idempotent) {
+      if ($was_persistent && $idempotent) {
          my $old_eof = $hdl->{on_eof};
          $hdl->{on_eof} = sub {
             _destroy_state %state;
+            %state = ();
+            $state{recurse} =
-            http_request (
+               http_request (
-               $method => $url,
+                  $method   => $url,
-               %arg,
+                  %arg,
+                  recurse   => $recurse - 1,
-               keepalive => 0,
+                  keepalive => 0,
+                  sub {
+                     %state = ();
-               $cb
+                     &$cb
+                  }
-            );
+               );
          };
          $hdl->on_read (sub {
             return unless %state;
             # as soon as we receive something, a connection close
    };
    my $prepare_handle = sub {
       my ($hdl) = $state{handle};
-      $hdl->timeout ($timeout);
       $hdl->on_error (sub {
          _error %state, $cb, { @pseudo, Status => $ae_error, Reason => $_[2] };
       });
       $hdl->on_eof (sub {
          _error %state, $cb, { @pseudo, Status => $ae_error, Reason => "Unexpected end-of-file" };
       });
+      $hdl->timeout_reset;
+      $hdl->timeout ($timeout);
    };
    # connected to proxy (or origin server)
    my $connect_cb = sub {
       my $fh = shift
       return unless $state{connect_guard};
       # try to use an existing keepalive connection, but only if we, ourselves, plan
       # on a keepalive request (in theory, this should be a separate config option).
-      if ($keepalive && $KA_CACHE{$ka_key}) {
+      if ($persistent && $KA_CACHE{$ka_key}) {
-         $keptalive = 1;
+         $was_persistent = 1;
          $state{handle} = ka_fetch $ka_key;
+         $state{handle}->destroyed
+            and die "AnyEvent::HTTP: unexpectedly got a destructed handle (1), please report.";#d#
          $prepare_handle->();
+         $state{handle}->destroyed
+            and die "AnyEvent::HTTP: unexpectedly got a destructed handle (2), please report.";#d#
          $handle_actual_request->();
       } else {
          my $tcp_connect = $arg{tcp_connect}
                            || do { require AnyEvent::Socket; \&AnyEvent::Socket::tcp_connect };
 Sets the default proxy server to use. The proxy-url must begin with a
 string of the form C<http://host:port>, croaks otherwise.
 To clear an already-set proxy, use C<undef>.
+When AnyEvent::HTTP is loaded for the first time it will query the
+default proxy from the operating system, currently by looking at
+C<$ENV{http_proxy>}.
 =item AnyEvent::HTTP::cookie_jar_expire $jar[, $session_end]
 Remove all cookies from the cookie jar that have been expired. If
 C<$session_end> is given and true, then additionally remove all session
 cookies.
 The key C<version> has to contain C<1>, otherwise the hash gets
 emptied. All other keys are hostnames or IP addresses pointing to
 hash-references. The key for these inner hash references is the
 server path for which this cookie is meant, and the values are again
-hash-references. The keys of those hash-references is the cookie name, and
+hash-references. Each key of those hash-references is a cookie name, and
 the value, you guessed it, is another hash-reference, this time with the
 key-value pairs from the cookie, except for C<expires> and C<max-age>,
 which have been replaced by a C<_expires> key that contains the cookie
-expiry timestamp.
+expiry timestamp. Session cookies are indicated by not having an
+C<_expires> key.
 Here is an example of a cookie jar with a single cookie, so you have a
 chance of understanding the above paragraph:
    {
 The default value for the C<recurse> request parameter (default: C<10>).
 =item $AnyEvent::HTTP::TIMEOUT
-The default timeout for conenction operations (default: C<300>).
+The default timeout for connection operations (default: C<300>).
 =item $AnyEvent::HTTP::USERAGENT
 The default value for the C<User-Agent> header (the default is
 C<Mozilla/5.0 (compatible; U; AnyEvent-HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)>).
 use 6, and Opera uses 8 because like, they have the fastest browser and
 give a shit for everybody else on the planet.
 =item $AnyEvent::HTTP::PERSISTENT_TIMEOUT
-The time after which idle persistent conenctions get closed by
+The time after which idle persistent connections get closed by
 AnyEvent::HTTP (default: C<3>).
 =item $AnyEvent::HTTP::ACTIVE
 The number of active connections. This is not the number of currently
    # other formats fail in the loop below
    for (0..11) {
       if ($m eq $month[$_]) {
          require Time::Local;
-         return Time::Local::timegm ($S, $M, $H, $d, $_, $y);
+         return eval { Time::Local::timegm ($S, $M, $H, $d, $_, $y) };
       }
    }
    undef
 }
 This section contaisn some more elaborate "real-world" examples or code
 snippets.
 =head2 HTTP/1.1 FILE DOWNLOAD
-Downloading files with HTTP cna be quite tricky, especially when something
+Downloading files with HTTP can be quite tricky, especially when something
-goes wrong and you want tor esume.
+goes wrong and you want to resume.
 Here is a function that initiates and resumes a download. It uses the
 last modified time to check for file content changes, and works with many
 HTTP/1.0 servers as well, and usually falls back to a complete re-download
 on older servers.
       warn stat $fh;
       warn -s _;
       if (stat $fh and -s _) {
          $ofs = -s _;
-         warn "-s is ", $ofs;#d#
+         warn "-s is ", $ofs;
          $hdr{"if-unmodified-since"} = AnyEvent::HTTP::format_date +(stat _)[9];
          $hdr{"range"} = "bytes=$ofs-";
       }
       http_get $url,

Diff Legend

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

Comparing AnyEvent-HTTP/HTTP.pm (file contents): Revision 1.94 by root, Tue Jan 11 23:49:37 2011 UTC vs. Revision 1.116 by root, Fri May 17 07:19:23 2013 UTC

Diff Legend

Comparing AnyEvent-HTTP/HTTP.pm (file contents):
Revision 1.94 by root, Tue Jan 11 23:49:37 2011 UTC vs.
Revision 1.116 by root, Fri May 17 07:19:23 2013 UTC