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

Comparing AnyEvent-HTTP/HTTP.pm (file contents):
Revision 1.92 by root, Tue Jan 4 08:17:59 2011 UTC vs.
Revision 1.134 by root, Fri Sep 7 22:11:31 2018 UTC

 This module is an L<AnyEvent> user, you need to make sure that you use and
 run a supported event loop.
 This module implements a simple, stateless and non-blocking HTTP
 client. It supports GET, POST and other request methods, cookies and more,
-all on a very low level. It can follow redirects supports proxies and
+all on a very low level. It can follow redirects, supports proxies, and
 automatically limits the number of connections to the values specified in
 the RFC.
 It should generally be a "good client" that is enough for most HTTP
 tasks. Simple tasks should be simple, but complex tasks should still be
 use AnyEvent::Util ();
 use AnyEvent::Handle ();
 use base Exporter::;
-our $VERSION = '2.0';
+our $VERSION = 2.24;
 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<http_request> returns a "cancellation guard" - you have to keep the
 object at least alive until the callback get called. If the object gets
 destroyed before the callback is called, the request will be cancelled.
 The callback will be called with the response body data as first argument
-(or C<undef> if an error occured), and a hash-ref with response headers
+(or C<undef> if an error occurred), and a hash-ref with response headers
 (and trailers) as second argument.
 All the headers in that hash are lowercased. In addition to the response
 headers, the "pseudo-headers" (uppercase to avoid clashing with possible
 response headers) C<HTTPVersion>, C<Status> and C<Reason> contain the
 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.
+Only redirects to http and https URLs are supported. While most common
+redirection forms are handled entirely within this module, some require
+the use of the optional L<URI> module. If it is required but missing, then
+the request will fail with an error.
 =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>).
+Currently, if your proxy requires authorization, you have to specify an
+appropriate "Proxy-Authorization" header in every request.
 =item body => $string
 The request body, usually empty. Will be sent as-is (future versions of
 this module might offer more options).
 context) - only connections using the same unique ID will be reused.
 =item on_prepare => $callback->($fh)
 In rare cases you need to "tune" the socket before it is used to
-connect (for exmaple, to bind it on a given IP address). This parameter
+connect (for example, to bind it on a given IP address). This parameter
 overrides the prepare callback passed to C<AnyEvent::Socket::tcp_connect>
 and behaves exactly the same way (e.g. it has to provide a
 timeout). See the description for the C<$prepare_cb> argument of
 C<AnyEvent::Socket::tcp_connect> for details.
 In even rarer cases you want total control over how AnyEvent::HTTP
 establishes connections. Normally it uses L<AnyEvent::Socket::tcp_connect>
 to do this, but you can provide your own C<tcp_connect> function -
 obviously, it has to follow the same calling conventions, except that it
 may always return a connection guard object.
+The connections made by this hook will be treated as equivalent to
+connecitons made the built-in way, specifically, they will be put into
+and taken from the persistent conneciton cache. If your C<$tcp_connect>
+function is incompatible with this kind of re-use, consider switching off
+C<persistent> connections and/or providing a C<session> identifier.
 There are probably lots of weird uses for this function, starting from
 tracing the hosts C<http_request> actually tries to connect, to (inexact
 but fast) host => IP address caching or even socks protocol support.
 =item persistent => $boolean
 Try to create/reuse a persistent connection. When this flag is set
 (default: true for idempotent requests, false for all others), then
 C<http_request> tries to re-use an existing (previously-created)
-persistent connection to the host and, failing that, tries to create a new
+persistent connection to same host (i.e. identical URL scheme, hostname,
-one.
+port and session) and, failing that, tries to create a new one.
 Requests failing in certain ways will be automatically retried once, which
 is dangerous for non-idempotent requests, which is why it defaults to off
 for them. The reason for this is because the bozos who designed HTTP/1.1
 made it impossible to distinguish between a fatal error and a normal
 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;
 # expire cookies
 sub cookie_jar_expire($;$) {
    my ($jar, $session_end) = @_;
-   %$jar = () if $jar->{version} != 1;
+   %$jar = () if $jar->{version} != 2;
    my $anow = AE::now;
    while (my ($chost, $paths) = each %$jar) {
       next unless ref $paths;
 # extract cookies from jar
 sub cookie_jar_extract($$$$) {
    my ($jar, $scheme, $host, $path) = @_;
-   %$jar = () if $jar->{version} != 1;
+   %$jar = () if $jar->{version} != 2;
+   $host = AnyEvent::Util::idn_to_ascii $host
+      if $host =~ /[^\x00-\x7f]/;
    my @cookies;
    while (my ($chost, $paths) = each %$jar) {
       next unless ref $paths;
-      if ($chost =~ /^\./) {
+      # exact match or suffix including . match
-         next unless $chost eq substr $host, -length $chost;
+      $chost eq $host or ".$chost" eq substr $host, -1 - length $chost
-      } elsif ($chost =~ /\./) {
-         next unless $chost eq $host;
-      } else {
-         next;
+         or next;
-      }
       while (my ($cpath, $cookies) = each %$paths) {
          next unless $cpath eq substr $path, 0, length $cpath;
          while (my ($cookie, $kv) = each %$cookies) {
 }
 # parse set_cookie header into jar
 sub cookie_jar_set_cookie($$$$) {
    my ($jar, $set_cookie, $host, $date) = @_;
+   %$jar = () if $jar->{version} != 2;
    my $anow = int AE::now;
    my $snow; # server-now
    for ($set_cookie) {
       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;
       my $cdom;
       my $cpath = (delete $kv{path}) || "/";
       if (exists $kv{domain}) {
-         $cdom = delete $kv{domain};
+         $cdom = $kv{domain};
          $cdom =~ s/^\.?/./; # make sure it starts with a "."
          next if $cdom =~ /\.$/;
          # this is not rfc-like and not netscape-like. go figure.
          my $ndots = $cdom =~ y/.//;
          next if $ndots < ($cdom =~ /\.[^.][^.]\.[^.][^.]$/ ? 3 : 2);
+         $cdom = substr $cdom, 1; # remove initial .
       } else {
          $cdom = $host;
       }
       # store it
-      $jar->{version} = 1;
+      $jar->{version} = 2;
       $jar->{lc $cdom}{$cpath}{$name} = \%kv;
       redo if /\G\s*,/gc;
    }
 }
    $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
              : return $cb->(undef, { @pseudo, Status => 599, Reason => "Only http and https URL schemes supported" });
-   $uauthority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x
+   $uauthority =~ /^(?: .*\@ )? ([^\@]+?) (?: : (\d+) )?$/x
       or return $cb->(undef, { @pseudo, Status => 599, Reason => "Unparsable URL" });
    my $uhost = lc $1;
    $uport = $2 if defined $2;
    $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
       # send request
       $hdl->push_write (
          "$method $rpath HTTP/1.1\015\012"
          . (join "", map "\u$_: $hdr{$_}\015\012", grep defined $hdr{$_}, keys %hdr)
          . "\015\012"
-         . (delete $arg{body})
+         . $arg{body}
       );
-      # return if error occured during push_write()
+      # return if error occurred during push_write()
       return unless %state;
       # reduce memory usage, save a kitten, also re-use it for the response headers.
       %hdr = ();
             %hdr = (%$hdr, @pseudo);
          }
          # redirect handling
-         # microsoft and other shitheads don't give a shit for following standards,
+         # relative uri handling forced by microsoft and other shitheads.
-         # try to support some common forms of broken Location headers.
+         # we give our best and fall back to URI if available.
-         if ($hdr{location} !~ /^(?: $ | [^:\/?\#]+ : )/x) {
+         if (exists $hdr{location}) {
+            my $loc = $hdr{location};
+            if ($loc =~ m%^//%) { # //
+               $loc = "$uscheme:$loc";
+            } elsif ($loc eq "") {
+               $loc = $url;
+            } elsif ($loc !~ /^(?: $ | [^:\/?\#]+ : )/x) { # anything "simple"
-            $hdr{location} =~ s/^\.\/+//;
+               $loc =~ s/^\.\/+//;
-            my $url = "$rscheme://$uhost:$uport";
+               if ($loc !~ m%^[.?#]%) {
+                  my $prefix = "$uscheme://$uauthority";
-            unless ($hdr{location} =~ s/^\///) {
+                  unless ($loc =~ s/^\///) {
-               $url .= $upath;
+                     $prefix .= $upath;
-               $url =~ s/\/[^\/]*$//;
+                     $prefix =~ s/\/[^\/]*$//;
+                  }
+                  $loc = "$prefix/$loc";
+               } elsif (eval { require URI }) { # uri
+                  $loc = URI->new_abs ($loc, $url)->as_string;
+               } else {
+                  return _error %state, $cb, { @pseudo, Status => 599, Reason => "Cannot parse Location (URI module missing)" };
+                  #$hdr{Status} = 599;
+                  #$hdr{Reason} = "Unparsable Redirect (URI module missing)";
+                  #$recurse = 0;
+               }
             }
-            $hdr{location} = "$url/$hdr{location}";
+            $hdr{location} = $loc;
          }
          my $redirect;
          if ($recurse) {
             # industry standard is to redirect POST as GET for
             # 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.
+            # we go with the industry standard. 308 is defined
+            # by rfc7538
             if ($status == 301 or $status == 302 or $status == 303) {
+               $redirect = 1;
                # HTTP/1.1 is unclear on how to mutate the method
-               $method = "GET" unless $method eq "HEAD";
+               unless ($method eq "HEAD") {
-               $redirect = 1;
+                  $method = "GET";
+                  delete $arg{body};
+               }
-            } elsif ($status == 307) {
+            } elsif ($status == 307 or $status == 308) {
                $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);
             }
          };
             $finish->(delete $state{handle});
          } elsif ($chunked) {
             my $cl = 0;
             my $body = "";
-            my $on_body = $arg{on_body} || sub { $body .= shift; 1 };
+            my $on_body = (!$redirect && $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;
                }
             };
             $_[0]->push_read (line => $state{read_chunk});
-         } elsif ($arg{on_body}) {
+         } elsif (!$redirect && $arg{on_body}) {
             if (defined $len) {
                $_[0]->on_read (sub {
                   $len -= length $_[0]{rbuf};
                   $arg{on_body}(delete $_[0]{rbuf}, \%hdr)
          }
       };
       # 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,
-               keepalive => 0,
+                  recurse    => $recurse - 1,
+                  persistent => 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
       # now handle proxy-CONNECT method
       if ($proxy && $uscheme eq "https") {
          # oh dear, we have to wrap it into a connect request
+         my $auth = exists $hdr{"proxy-authorization"}
+            ? "proxy-authorization: " . (delete $hdr{"proxy-authorization"}) . "\015\012"
+            : "";
          # maybe re-use $uauthority with patched port?
-         $state{handle}->push_write ("CONNECT $uhost:$uport HTTP/1.0\015\012\015\012");
+         $state{handle}->push_write ("CONNECT $uhost:$uport HTTP/1.0\015\012$auth\015\012");
          $state{handle}->push_read (line => $qr_nlnl, sub {
             $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )?/ix
                or return _error %state, $cb, { @pseudo, Status => 599, Reason => "Invalid proxy connect response ($_[1])" };
             if ($2 == 200) {
             } else {
                _error %state, $cb, { @pseudo, Status => $2, Reason => $3 };
             }
          });
       } else {
+         delete $hdr{"proxy-authorization"} unless $proxy;
          $handle_actual_request->();
       }
    };
    _get_slot $uhost, sub {
       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.
 You should call this function (with a true C<$session_end>) before you
 save cookies to disk, and you should call this function after loading them
-again. If you have a long-running program you can additonally call this
+again. If you have a long-running program you can additionally call this
 function from time to time.
 A cookie jar is initially an empty hash-reference that is managed by this
-module. It's format is subject to change, but currently it is like this:
+module. Its format is subject to change, but currently it is as follows:
-The key C<version> has to contain C<1>, otherwise the hash gets
+The key C<version> has to contain C<2>, otherwise the hash gets
-emptied. All other keys are hostnames or IP addresses pointing to
+cleared. 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:
    {
-      version    => 1,
+      version    => 2,
       "10.0.0.1" => {
          "/" => {
             "mythweb_id" => {
               _expires => 1293917923,
               value    => "ooRung9dThee3ooyXooM1Ohm",
 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)>).
 =item $AnyEvent::HTTP::MAX_PER_HOST
 The maximum number of concurrent connections to the same host (identified
-by the hostname). If the limit is exceeded, then the additional requests
+by the hostname). If the limit is exceeded, then additional requests
 are queued until previous connections are closed. Both persistent and
 non-persistent connections are counted in this limit.
 The default value for this is C<4>, and it is highly advisable to not
 increase it much.
 For comparison: the RFC's recommend 4 non-persistent or 2 persistent
-connections, older browsers used 2, newers (such as firefox 3) typically
+connections, older browsers used 2, newer ones (such as firefox 3)
-use 6, and Opera uses 8 because like, they have the fastest browser and
+typically use 6, and Opera uses 8 because like, they have the fastest
-give a shit for everybody else on the planet.
+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
 }
 # initialise proxy from environment
 eval {
    set_proxy $ENV{http_proxy};
 };
+=head2 SHOWCASE
+This section contains some more elaborate "real-world" examples or code
+snippets.
+=head2 HTTP/1.1 FILE DOWNLOAD
+Downloading files with HTTP can be quite tricky, especially when something
+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.
+It calls the completion callback with either C<undef>, which means a
+nonretryable error occurred, C<0> when the download was partial and should
+be retried, and C<1> if it was successful.
+   use AnyEvent::HTTP;
+   sub download($$$) {
+      my ($url, $file, $cb) = @_;
+      open my $fh, "+<", $file
+         or die "$file: $!";
+      my %hdr;
+      my $ofs = 0;
+      if (stat $fh and -s _) {
+         $ofs = -s _;
+         warn "-s is ", $ofs;
+         $hdr{"if-unmodified-since"} = AnyEvent::HTTP::format_date +(stat _)[9];
+         $hdr{"range"} = "bytes=$ofs-";
+      }
+      http_get $url,
+         headers   => \%hdr,
+         on_header => sub {
+            my ($hdr) = @_;
+            if ($hdr->{Status} == 200 && $ofs) {
+               # resume failed
+               truncate $fh, $ofs = 0;
+            }
+            sysseek $fh, $ofs, 0;
+            1
+         },
+         on_body   => sub {
+            my ($data, $hdr) = @_;
+            if ($hdr->{Status} =~ /^2/) {
+               length $data == syswrite $fh, $data
+                  or return; # abort on write errors
+            }
+            1
+         },
+         sub {
+            my (undef, $hdr) = @_;
+            my $status = $hdr->{Status};
+            if (my $time = AnyEvent::HTTP::parse_date $hdr->{"last-modified"}) {
+               utime $time, $time, $fh;
+            }
+            if ($status == 200 || $status == 206 || $status == 416) {
+               # download ok || resume ok || file already fully downloaded
+               $cb->(1, $hdr);
+            } elsif ($status == 412) {
+               # file has changed while resuming, delete and retry
+               unlink $file;
+               $cb->(0, $hdr);
+            } elsif ($status == 500 or $status == 503 or $status =~ /^59/) {
+               # retry later
+               $cb->(0, $hdr);
+            } else {
+               $cb->(undef, $hdr);
+            }
+         }
+      ;
+   }
+   download "http://server/somelargefile", "/tmp/somelargefile", sub {
+      if ($_[0]) {
+         print "OK!\n";
+      } elsif (defined $_[0]) {
+         print "please retry later\n";
+      } else {
+         print "ERROR\n";
+      }
+   };
-=head2 SOCKS PROXIES
+=head3 SOCKS PROXIES
 Socks proxies are not directly supported by AnyEvent::HTTP. You can
 compile your perl to support socks, or use an external program such as
 F<socksify> (dante) or F<tsocks> to make your program use a socks proxy
 transparently.

Diff Legend

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

Comparing AnyEvent-HTTP/HTTP.pm (file contents): Revision 1.92 by root, Tue Jan 4 08:17:59 2011 UTC vs. Revision 1.134 by root, Fri Sep 7 22:11:31 2018 UTC

Diff Legend

Comparing AnyEvent-HTTP/HTTP.pm (file contents):
Revision 1.92 by root, Tue Jan 4 08:17:59 2011 UTC vs.
Revision 1.134 by root, Fri Sep 7 22:11:31 2018 UTC