--- AnyEvent-HTTP/HTTP.pm 2009/07/05 23:50:59 1.41 +++ AnyEvent-HTTP/HTTP.pm 2010/12/30 04:31:55 1.63 @@ -43,14 +43,13 @@ use Errno (); -use AnyEvent 4.452 (); +use AnyEvent 5.0 (); use AnyEvent::Util (); -use AnyEvent::Socket (); use AnyEvent::Handle (); use base Exporter::; -our $VERSION = '1.12'; +our $VERSION = '1.46'; our @EXPORT = qw(http_get http_post http_head http_request); @@ -61,7 +60,7 @@ our $TIMEOUT = 300; # changing these is evil -our $MAX_PERSISTENT_PER_HOST = 2; +our $MAX_PERSISTENT_PER_HOST = 0; our $MAX_PER_HOST = 4; our $PROXY; @@ -94,17 +93,29 @@ When called in void context, nothing is returned. In other contexts, C 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 callbakc is called, the request will be cancelled. +destroyed before the callback is called, the request will be cancelled. -The callback will be called with the response data as first argument -(or C if it wasn't available due to errors), and a hash-ref with -response headers as second argument. +The callback will be called with the response body data as first argument +(or C if an error occured), and a hash-ref with response headers as +second argument. All the headers in that hash are lowercased. In addition to the response -headers, the "pseudo-headers" C, C and C -contain the three parts of the HTTP Status-Line of the same name. The -pseudo-header C contains the original URL (which can differ from the -requested URL when following redirects). +headers, the "pseudo-headers" (uppercase to avoid clashing with possible +response headers) C, C and C contain the +three parts of the HTTP Status-Line of the same name. + +The pseudo-header C contains the actual URL (which can differ from +the requested URL when following redirects - for example, you might get +an error that your URL scheme is not supported even though your URL is a +valid http URL because it redirected to an ftp URL, in which case you can +look at the URL pseudo header). + +The pseudo-header C only exists when the request was a result +of an internal redirect. In that case it is an array reference with +the C<($data, $headers)> from the redirect response. Note that this +response could in turn be the result of a redirect itself, and C<< +$headers->{Redirect}[1]{Redirect} >> will then contain the original +response, and so on. If the server sends a header multiple times, then their contents will be joined together with a comma (C<,>), as per the HTTP spec. @@ -140,19 +151,24 @@ The request headers to use. Currently, C may provide its own C, C, C and C headers -and will provide defaults for C and C. +and will provide defaults for C and C (this can be +suppressed by using C 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 for HTTP, or C for +C<$scheme> must be either missing, C for HTTP or C for HTTPS. =item body => $string @@ -188,7 +204,28 @@ The default for this option is C, which could be interpreted as "give me the page, no matter what". -=item on_header => $callback->($hdr) +=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 +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 for details. + +=item tcp_connect => $callback->($host, $service, $connect_cb, $prepare_cb) + +In even rarer cases you want total control over how AnyEvent::HTTP +establishes connections. Normally it uses L +to do this, but you can provide your own C function - +obviously, it has to follow the same calling conventions, except that it +may always return a connection guard object. + +There are probably lots of weird uses for this function, starting from +tracing the hosts C actually tries to connect, to (inexact +but fast) host => IP address caching or even socks protocol support. + +=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 @@ -202,21 +239,31 @@ content, which, if it is supposed to be rare, can be faster than first doing a C request. -=item on_body => $callback->($data, $hdr) +Example: cancel the request unless the content-type is "text/html". -When specified, all body data will be "filtered" through this callback. + on_header => sub { + $_[0]{"content-type"} =~ /^text\/html\s*(?:;|$)/ + }, -The callback will incrementally receive body data, and is supposed to -return it or a modified version of it (empty strings are valid returns). +=item on_body => $callback->($partial_body, $headers) -If the callback returns C, then the request will be cancelled. +When specified, all body data will be passed to this callback instead of +to the completion callback. The completion callback will get the empty +string instead of the body data. -This callback is useful when you want to do some processing on the data, -or the data is too large to be held in memory (so the callback writes it -to a file and returns the empty string) and so on. +It has to return either true (in which case AnyEvent::HTTP will continue), +or false, in which case AnyEvent::HTTP will cancel the download (and call +the completion callback with an error code of C<598>). + +This callback is useful when the data is too large to be held in memory +(so the callback writes it to a file) or when only some information should +be extracted, or when the body should be processed incrementally. It is usually preferred over doing your own body handling via -C. +C, but in case of streaming APIs, where HTTP is +only used to create a connection, C is the better +alternative, as it allows you to install your own event handler, reducing +resource usage. =item want_body_handle => $enable @@ -238,7 +285,7 @@ push-style twitter API which starts a JSON/XML stream). If you think you need this, first have a look at C, to see if -that doesn'T solve your problem in a better way. +that doesn't solve your problem in a better way. =back @@ -304,8 +351,7 @@ _slot_schedule $_[0]; } -our $qr_nl = qr<\015?\012>; -our $qr_nlnl = qr<\015?\012\015?\012>; +our $qr_nlnl = qr{(? 1, sslv2 => 1 }; our $TLS_CTX_HIGH = { cache => 1, verify => 1, verify_peername => "https" }; @@ -327,31 +373,38 @@ } } + # pseudo headers for all subsequent responses + my @pseudo = (URL => $url); + push @pseudo, Redirect => delete $arg{Redirect} if exists $arg{Redirect}; + my $recurse = exists $arg{recurse} ? delete $arg{recurse} : $MAX_RECURSE; - return $cb->(undef, { Status => 599, Reason => "Too many redirections", URL => $url }) + return $cb->(undef, { Status => 599, Reason => "Too many redirections", @pseudo }) if $recurse < 0; my $proxy = $arg{proxy} || $PROXY; my $timeout = $arg{timeout} || $TIMEOUT; my ($uscheme, $uauthority, $upath, $query, $fragment) = - $url =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|; + $url =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:(\?[^#]*))?(?:#(.*))?|; $uscheme = lc $uscheme; my $uport = $uscheme eq "http" ? 80 : $uscheme eq "https" ? 443 - : return $cb->(undef, { Status => 599, Reason => "Only http and https URL schemes supported", URL => $url }); + : return $cb->(undef, { Status => 599, Reason => "Only http and https URL schemes supported", @pseudo }); $uauthority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x - or return $cb->(undef, { Status => 599, Reason => "Unparsable URL", URL => $url }); + or return $cb->(undef, { Status => 599, Reason => "Unparsable URL", @pseudo }); my $uhost = $1; $uport = $2 if defined $2; + $hdr{host} = defined $2 ? "$uhost:$2" : "$uhost" + unless exists $hdr{host}; + $uhost =~ s/^\[(.*)\]$/$1/; - $upath .= "?$query" if length $query; + $upath .= $query if length $query; $upath =~ s%^/?%/%; @@ -391,6 +444,8 @@ 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"; @@ -398,11 +453,12 @@ ($rhost, $rport, $rscheme, $rpath) = ($uhost, $uport, $uscheme, $upath); } - $hdr{"user-agent"} ||= $USERAGENT; - $hdr{referer} ||= "$uscheme://$uauthority$upath"; # leave out fragment and query string, just a heuristic + # 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{host} = "$uhost:$uport"; - $hdr{"content-length"} = length $arg{body}; + $hdr{"content-length"} = length $arg{body} + if length $arg{body} || $method ne "GET"; my %state = (connect_guard => 1); @@ -411,93 +467,108 @@ return unless $state{connect_guard}; - $state{connect_guard} = AnyEvent::Socket::tcp_connect $rhost, $rport, sub { - $state{fh} = shift - or return (%state = (), $cb->(undef, { Status => 599, Reason => "$!", URL => $url })); - pop; # free memory, save a tree - - return unless delete $state{connect_guard}; - - # get handle - $state{handle} = new AnyEvent::Handle - fh => $state{fh}, - timeout => $timeout, - peername => $rhost, - tls_ctx => $arg{tls_ctx}; - - # limit the number of persistent connections - # keepalive not yet supported - if ($KA_COUNT{$_[1]} < $MAX_PERSISTENT_PER_HOST) { - ++$KA_COUNT{$_[1]}; - $state{handle}{ka_count_guard} = AnyEvent::Util::guard { - --$KA_COUNT{$_[1]} - }; - $hdr{connection} = "keep-alive"; - } else { - delete $hdr{connection}; - } + my $tcp_connect = $arg{tcp_connect} + || do { require AnyEvent::Socket; \&AnyEvent::Socket::tcp_connect }; - # (re-)configure handle - $state{handle}->on_error (sub { - %state = (); - $cb->(undef, { Status => 599, Reason => $_[2], URL => $url }); - }); - $state{handle}->on_eof (sub { - %state = (); - $cb->(undef, { Status => 599, Reason => "Unexpected end-of-file", URL => $url }); - }); + $state{connect_guard} = $tcp_connect->( + $rhost, + $rport, + sub { + $state{fh} = shift + or do { + my $err = "$!"; + %state = (); + return $cb->(undef, { Status => 599, Reason => $err, @pseudo }); + }; + + pop; # free memory, save a tree - $state{handle}->starttls ("connect") if $rscheme eq "https"; + return unless delete $state{connect_guard}; - # handle actual, non-tunneled, request - my $handle_actual_request = sub { - $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) - . "\015\012" - . (delete $arg{body}) - ); - - %hdr = (); # reduce memory usage, save a kitten - - # status line - $state{handle}->push_read (line => $qr_nl, sub { - $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )?/ix - or return (%state = (), $cb->(undef, { Status => 599, Reason => "Invalid server response ($_[1])", URL => $url })); - - my %hdr = ( # response headers - HTTPVersion => ",$1", - Status => ",$2", - Reason => ",$3", - URL => ",$url" + # get handle + $state{handle} = new AnyEvent::Handle + fh => $state{fh}, + peername => $rhost, + tls_ctx => $arg{tls_ctx}, + # these need to be reconfigured on keepalive handles + timeout => $timeout, + on_error => sub { + %state = (); + $cb->(undef, { Status => 599, Reason => $_[2], @pseudo }); + }, + on_eof => sub { + %state = (); + $cb->(undef, { Status => 599, Reason => "Unexpected end-of-file", @pseudo }); + }, + ; + + # limit the number of persistent connections + # keepalive not yet supported +# if ($KA_COUNT{$_[1]} < $MAX_PERSISTENT_PER_HOST) { +# ++$KA_COUNT{$_[1]}; +# $state{handle}{ka_count_guard} = AnyEvent::Util::guard { +# --$KA_COUNT{$_[1]} +# }; +# $hdr{connection} = "keep-alive"; +# } else { + delete $hdr{connection}; +# } + + $state{handle}->starttls ("connect") if $rscheme eq "https"; + + # handle actual, non-tunneled, request + my $handle_actual_request = sub { + $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", grep defined $hdr{$_}, keys %hdr) + . "\015\012" + . (delete $arg{body}) ); - # headers, could be optimized a bit - $state{handle}->unshift_read (line => $qr_nlnl, sub { - for ("$_[1]\012") { + # return if error occured during push_write() + return unless %state; + + %hdr = (); # reduce memory usage, save a kitten, also make it possible to re-use + + # status line and headers + $state{handle}->push_read (line => $qr_nlnl, 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+ ([^\015\012]*) )? \015?\012/igxc + or return (%state = (), $cb->(undef, { Status => 599, Reason => "Invalid server response", @pseudo })); + + push @pseudo, + HTTPVersion => $1, + Status => $2, + Reason => $3, + ; + # things seen, not parsed: # p3pP="NON CUR OTPi OUR NOR UNI" $hdr{lc $1} .= ",$2" while /\G - ([^:\000-\037]+): + ([^:\000-\037]*): [\011\040]* ((?: [^\012]+ | \012[\011\040] )*) \012 /gxc; /\G$/ - or return (%state = (), $cb->(undef, { Status => 599, Reason => "Garbled response headers", URL => $url })); + or return (%state = (), $cb->(undef, { Status => 599, Reason => "Garbled response headers", @pseudo })); } + # remove the "," prefix we added to all headers above substr $_, 0, 1, "" for values %hdr; + # patch in all pseudo headers + %hdr = (%hdr, @pseudo); + # redirect handling # microsoft and other shitheads don't give a shit for following standards, # try to support some common forms of broken Location headers. @@ -517,15 +588,18 @@ my $redirect; if ($recurse) { - if ($hdr{Status} =~ /^30[12]$/ && $method ne "POST") { - # apparently, mozilla et al. just change POST to GET here - # more research is needed before we do the same - $redirect = 1; - } elsif ($hdr{Status} == 303) { - # even http/1.1 is unclear on how to mutate the method + 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. + # 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 $method = "GET" unless $method eq "HEAD"; $redirect = 1; - } elsif ($hdr{Status} == 307 && $method =~ /^(?:GET|HEAD)$/) { + } elsif ($status == 307) { $redirect = 1; } } @@ -584,11 +658,16 @@ } } - 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); + http_request ( + $method => $hdr{location}, + %arg, + recurse => $recurse - 1, + Redirect => \@_, + $cb); } else { $cb->($_[0], $_[1]); } @@ -597,9 +676,9 @@ my $len = $hdr{"content-length"}; if (!$redirect && $arg{on_header} && !$arg{on_header}(\%hdr)) { - $finish->(undef, { Status => 598, Reason => "Request cancelled by on_header", URL => $url }); + $finish->(undef, { Status => 598, Reason => "Request cancelled by on_header", @pseudo }); } elsif ( - $hdr{Status} =~ /^(?:1..|204|304)$/ + $hdr{Status} =~ /^(?:1..|[23]04)$/ or $method eq "HEAD" or (defined $len && !$len) ) { @@ -610,21 +689,21 @@ # for want_body_handle, on_body (2x), normal (2x) # we might read too much here, but it does not matter yet (no pers. connections) if (!$redirect && $arg{want_body_handle}) { - $_[0]->on_eof (undef); + $_[0]->on_eof (undef); $_[0]->on_error (undef); $_[0]->on_read (undef); $finish->(delete $state{handle}, \%hdr); } elsif ($arg{on_body}) { - $_[0]->on_error (sub { $finish->(undef, { Status => 599, Reason => $_[2], URL => $url }) }); + $_[0]->on_error (sub { $finish->(undef, { Status => 599, Reason => $_[2], @pseudo }) }); if ($len) { $_[0]->on_eof (undef); $_[0]->on_read (sub { $len -= length $_[0]{rbuf}; $arg{on_body}(delete $_[0]{rbuf}, \%hdr) - or $finish->(undef, { Status => 598, Reason => "Request cancelled by on_body", URL => $url }); + or $finish->(undef, { Status => 598, Reason => "Request cancelled by on_body", @pseudo }); $len > 0 or $finish->("", \%hdr); @@ -635,57 +714,56 @@ }); $_[0]->on_read (sub { $arg{on_body}(delete $_[0]{rbuf}, \%hdr) - or $finish->(undef, { Status => 598, Reason => "Request cancelled by on_body", URL => $url }); + or $finish->(undef, { Status => 598, Reason => "Request cancelled by on_body", @pseudo }); }); } } else { $_[0]->on_eof (undef); if ($len) { - $_[0]->on_error (sub { $finish->(undef, { Status => 599, Reason => $_[2], URL => $url }) }); + $_[0]->on_error (sub { $finish->(undef, { Status => 599, Reason => $_[2], @pseudo }) }); $_[0]->on_read (sub { $finish->((substr delete $_[0]{rbuf}, 0, $len, ""), \%hdr) if $len <= length $_[0]{rbuf}; }); } else { $_[0]->on_error (sub { - $! == Errno::EPIPE + ($! == Errno::EPIPE || !$!) ? $finish->(delete $_[0]{rbuf}, \%hdr) - : $finish->(undef, { Status => 599, Reason => $_[2], URL => $url }); + : $finish->(undef, { Status => 599, Reason => $_[2], @pseudo }); }); $_[0]->on_read (sub { }); } } } }); - }); - }; + }; - # now handle proxy-CONNECT method - if ($proxy && $uscheme eq "https") { - # oh dear, we have to wrap it into a connect request - - # maybe re-use $uauthority with patched port? - $state{handle}->push_write ("CONNECT $uhost:$uport HTTP/1.0\015\012Host: $uhost\015\012\015\012"); - $state{handle}->push_read (line => $qr_nlnl, sub { - $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )?/ix - or return (%state = (), $cb->(undef, { Status => 599, Reason => "Invalid proxy connect response ($_[1])", URL => $url })); - - if ($2 == 200) { - $rpath = $upath; - &$handle_actual_request; - } else { - %state = (); - $cb->(undef, { Status => $2, Reason => $3, URL => $url }); - } - }); - } else { - &$handle_actual_request; - } + # now handle proxy-CONNECT method + if ($proxy && $uscheme eq "https") { + # oh dear, we have to wrap it into a connect request + + # maybe re-use $uauthority with patched port? + $state{handle}->push_write ("CONNECT $uhost:$uport HTTP/1.0\015\012Host: $uhost\015\012\015\012"); + $state{handle}->push_read (line => $qr_nlnl, sub { + $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )?/ix + or return (%state = (), $cb->(undef, { Status => 599, Reason => "Invalid proxy connect response ($_[1])", @pseudo })); + + if ($2 == 200) { + $rpath = $upath; + &$handle_actual_request; + } else { + %state = (); + $cb->(undef, { Status => $2, Reason => $3, @pseudo }); + } + }); + } else { + &$handle_actual_request; + } - }, sub { - $timeout - }; + }, + $arg{on_prepare} || sub { $timeout } + ); }; defined wantarray && AnyEvent::Util::guard { %state = () } @@ -709,6 +787,15 @@ =back +=head2 DNS CACHING + +AnyEvent::HTTP uses the AnyEvent::Socket::tcp_connect function for +the actual connection, which in turn uses AnyEvent::DNS to resolve +hostnames. The latter is a simple stub resolver and does no caching +on its own. If you want DNS caching, you currently have to provide +your own default resolver (by storing a suitable resolver object in +C<$AnyEvent::DNS::RESOLVER>). + =head2 GLOBAL FUNCTIONS AND VARIABLES =over 4 @@ -716,7 +803,20 @@ =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 (optionally C). +string of the form C (optionally C), croaks +otherwise. + +To clear an already-set proxy, use C. + +=item $date = AnyEvent::HTTP::format_date $timestamp + +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) and returns the corresponding POSIX +timestamp, or C if the date cannot be parsed. =item $AnyEvent::HTTP::MAX_RECURSE @@ -727,17 +827,14 @@ The default value for the C header (the default is C). -=item $AnyEvent::HTTP::MAX_PERSISTENT - -The maximum number of persistent connections to keep open (default: 8). - -Not implemented currently. +=item $AnyEvent::HTTP::MAX_PER_HOST -=item $AnyEvent::HTTP::PERSISTENT_TIMEOUT +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 maximum time to cache a persistent connection, in seconds (default: 2). - -Not implemented currently. +The default value for this is C<4>, and it is highly advisable to not +increase it. =item $AnyEvent::HTTP::ACTIVE @@ -749,12 +846,119 @@ =cut +our @month = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); +our @weekday = qw(Sun Mon Tue Wed Thu Fri Sat); + +sub format_date($) { + my ($time) = @_; + + # RFC 822/1123 format + my ($S, $M, $H, $mday, $mon, $year, $wday, $yday, undef) = gmtime $time; + + sprintf "%s, %02d %s %04d %02d:%02d:%02d GMT", + $weekday[$wday], $mday, $month[$mon], $year + 1900, + $H, $M, $S; +} + +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$/) { + # RFC 822/1123, required by RFC 2616 + ($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$/) { + # 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])$/) { + # ISO C's asctime + ($d, $m, $y, $H, $M, $S) = ($2, $1, $6, $3, $4, $5); + } + # 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); + } + } + + undef +} + sub set_proxy($) { - $PROXY = [$2, $3 || 3128, $1] if $_[0] =~ m%^(https?):// ([^:/]+) (?: : (\d*) )?%ix; + if (length $_[0]) { + $_[0] =~ m%^(https?):// ([^:/]+) (?: : (\d*) )?%ix + or Carp::croak "$_[0]: invalid proxy URL"; + $PROXY = [$2, $3 || 3128, $1] + } else { + undef $PROXY; + } } # initialise proxy from environment -set_proxy $ENV{http_proxy}; +eval { + set_proxy $ENV{http_proxy}; +}; + +=head2 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 (dante) or F to make your program use a socks proxy +transparently. + +Alternatively, for AnyEvent::HTTP only, you can use your own +C function that does the proxy handshake - here is an example +that works with socks4a proxies: + + use Errno; + use AnyEvent::Util; + use AnyEvent::Socket; + use AnyEvent::Handle; + + # host, port and username of/for your socks4a proxy + my $socks_host = "10.0.0.23"; + my $socks_port = 9050; + my $socks_user = ""; + + sub socks4a_connect { + my ($host, $port, $connect_cb, $prepare_cb) = @_; + + my $hdl = new AnyEvent::Handle + connect => [$socks_host, $socks_port], + on_prepare => sub { $prepare_cb->($_[0]{fh}) }, + on_error => sub { $connect_cb->() }, + ; + + $hdl->push_write (pack "CCnNZ*Z*", 4, 1, $port, 1, $socks_user, $host); + + $hdl->push_read (chunk => 8, sub { + my ($hdl, $chunk) = @_; + my ($status, $port, $ipn) = unpack "xCna4", $chunk; + + if ($status == 0x5a) { + $connect_cb->($hdl->{fh}, (format_address $ipn) . ":$port"); + } else { + $! = Errno::ENXIO; $connect_cb->(); + } + }); + + $hdl + } + +Use C instead of C when doing Cs, +possibly after switching off other proxy types: + + AnyEvent::HTTP::set_proxy undef; # usually you do not want other proxies + + http_get 'http://www.google.com', tcp_connect => \&socks4a_connect, sub { + my ($data, $headers) = @_; + ... + }; =head1 SEE ALSO