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

Comparing AnyEvent-HTTP/HTTP.pm (file contents):
Revision 1.45 by root, Fri Jul 17 16:56:36 2009 UTC vs.
Revision 1.53 by root, Sat Dec 5 15:37:07 2009 UTC

 use strict;
 no warnings;
 use Errno ();
-use AnyEvent 4.8 ();
+use AnyEvent 5.0 ();
 use AnyEvent::Util ();
 use AnyEvent::Socket ();
 use AnyEvent::Handle ();
 use base Exporter::;
-our $VERSION = '1.4';
+our $VERSION = '1.44';
 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;
 =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 will provide defaults for C<User-Agent:> and C<Referer:>.
+and will provide defaults for C<User-Agent:> and C<Referer:> (this can be
+suppressed by using C<undef> for these headers in which case they won't be
+sent at all).
 =item timeout => $seconds
 The time-out to use for various stages - each connect attempt will reset
-the timeout, as will read or write activity. Default timeout is 5 minutes.
+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
 default proxy (as specified by C<$ENV{http_proxy}>) is used.
-C<$scheme> must be either missing or C<http> for HTTP, or C<https> for
+C<$scheme> must be either missing, C<http> for HTTP or C<https> for
 HTTPS.
 =item body => $string
 The request body, usually empty. Will be-sent as-is (future versions of
 verification, highest compatibility) and high-security (CA and common-name
 verification) TLS context.
 The default for this option is C<low>, which could be interpreted as "give
 me the page, no matter what".
+=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
+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.
 =item on_header => $callback->($headers)
 When specified, this callback will be called with the header hash as soon
 as headers have been successfully received from the remote server (not on
    push @{ $CO_SLOT{$_[0]}[1] }, $_[1];
    _slot_schedule $_[0];
 }
-our $qr_nl   = qr<\015?\012>;
+our $qr_nl   = qr{\015?\012};
-our $qr_nlnl = qr<\015?\012\015?\012>;
+our $qr_nlnl = qr{(?<![^\012])\015?\012};
 our $TLS_CTX_LOW  = { cache => 1, sslv2 => 1 };
 our $TLS_CTX_HIGH = { cache => 1, verify => 1, verify_peername => "https" };
 sub http_request($$@) {
       or return $cb->(undef, { Status => 599, Reason => "Unparsable URL", URL => $url });
    my $uhost = $1;
    $uport = $2 if defined $2;
-   $hdr{host} = defined $2 ? "$uhost:$2" : "$uhost";
+   $hdr{host} = defined $2 ? "$uhost:$2" : "$uhost"
+      unless exists $hdr{host};
    $uhost =~ s/^\[(.*)\]$/$1/;
    $upath .= "?$query" if length $query;
    $upath =~ s%^/?%/%;
    my ($rhost, $rport, $rscheme, $rpath); # request host, port, path
    if ($proxy) {
       ($rpath, $rhost, $rport, $rscheme) = ($url, @$proxy);
+      $rscheme = "http" unless defined $rscheme;
       # don't support https requests over https-proxy transport,
       # can't be done with tls as spec'ed, unless you double-encrypt.
       $rscheme = "http" if $uscheme eq "https" && $rscheme eq "https";
    } else {
       ($rhost, $rport, $rscheme, $rpath) = ($uhost, $uport, $uscheme, $upath);
    }
-   $hdr{"user-agent"} ||= $USERAGENT;
+   # leave out fragment and query string, just a heuristic
-   $hdr{referer}      ||= "$uscheme://$uauthority$upath"; # leave out fragment and query string, just a heuristic
+   $hdr{referer}      ||= "$uscheme://$uauthority$upath" unless exists $hdr{referer};
+   $hdr{"user-agent"} ||= $USERAGENT                     unless exists $hdr{"user-agent"};
-   $hdr{"content-length"} = length $arg{body};
+   $hdr{"content-length"} = length $arg{body}
+      if length $arg{body} || $method ne "GET";
    my %state = (connect_guard => 1);
    _get_slot $uhost, sub {
       $state{slot_guard} = shift;
             $state{handle}->starttls ("connect") if $uscheme eq "https" && !exists $state{handle}{tls};
             # send request
             $state{handle}->push_write (
                "$method $rpath HTTP/1.0\015\012"
-               . (join "", map "\u$_: $hdr{$_}\015\012", keys %hdr)
+               . (join "", map "\u$_: $hdr{$_}\015\012", grep defined $hdr{$_}, keys %hdr)
                . "\015\012"
                . (delete $arg{body})
             );
             %hdr = (); # reduce memory usage, save a kitten
                   URL         => ",$url"
                );
                # headers, could be optimized a bit
                $state{handle}->unshift_read (line => $qr_nlnl, sub {
-                  for ("$_[1]\012") {
+                  for ("$_[1]") {
                      y/\015//d; # weed out any \015, as they show up in the weirdest of places.
                      # things seen, not parsed:
                      # p3pP="NON CUR OTPi OUR NOR UNI"
                            redo if /\G\s*,/gc;
                         }
                      }
-                     if ($redirect) {
+                     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
                         http_request ($method => $hdr{location}, %arg, recurse => $recurse - 1, $cb);
                      } else {
             });
          } else {
             &$handle_actual_request;
          }
-      }, sub {
+      }, $arg{on_prepare} || sub { $timeout };
-         $timeout
-      };
    };
    defined wantarray && AnyEvent::Util::guard { %state = () }
 }
 =over 4
 =item AnyEvent::HTTP::set_proxy "proxy-url"
 Sets the default proxy server to use. The proxy-url must begin with a
-string of the form C<http://host:port> (optionally C<https:...>).
+string of the form C<http://host:port> (optionally C<https:...>), croaks
+otherwise.
+To clear an already-set proxy, use C<undef>.
 =item $AnyEvent::HTTP::MAX_RECURSE
 The default value for the C<recurse> request parameter (default: C<10>).
 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 conenctions to the same host (identified
+The maximum number of concurrent connections to the same host (identified
 by the hostname). If the limit is exceeded, then the additional requests
 are queued until previous connections are closed.
 The default value for this is C<4>, and it is highly advisable to not
 increase it.
 =back
 =cut
 sub set_proxy($) {
+   if (length $_[0]) {
-   $PROXY = [$2, $3 || 3128, $1] if $_[0] =~ m%^(https?):// ([^:/]+) (?: : (\d*) )?%ix;
+      $_[0] =~ m%^(https?):// ([^:/]+) (?: : (\d*) )?%ix
+         or Carp::croak "$_[0]: invalid proxy URL";
+      $PROXY = [$2, $3 || 3128, $1]
+   } else {
+      undef $PROXY;
+   }
 }
 # initialise proxy from environment
+eval {
-set_proxy $ENV{http_proxy};
+   set_proxy $ENV{http_proxy};
+};
 =head1 SEE ALSO
 L<AnyEvent>.

Diff Legend

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

Comparing AnyEvent-HTTP/HTTP.pm (file contents): Revision 1.45 by root, Fri Jul 17 16:56:36 2009 UTC vs. Revision 1.53 by root, Sat Dec 5 15:37:07 2009 UTC

Diff Legend

Comparing AnyEvent-HTTP/HTTP.pm (file contents):
Revision 1.45 by root, Fri Jul 17 16:56:36 2009 UTC vs.
Revision 1.53 by root, Sat Dec 5 15:37:07 2009 UTC