--- AnyEvent-HTTP/HTTP.pm 2010/06/16 19:17:30 1.55 +++ AnyEvent-HTTP/HTTP.pm 2010/12/30 02:56:28 1.60 @@ -45,12 +45,11 @@ use AnyEvent 5.0 (); use AnyEvent::Util (); -use AnyEvent::Socket (); use AnyEvent::Handle (); use base Exporter::; -our $VERSION = '1.45'; +our $VERSION = '1.46'; our @EXPORT = qw(http_get http_post http_head http_request); @@ -94,7 +93,7 @@ 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 body data as first argument (or C if an error occured), and a hash-ref with response headers as @@ -214,6 +213,18 @@ 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 @@ -340,7 +351,6 @@ _slot_schedule $_[0]; } -our $qr_nl = qr{\015?\012}; our $qr_nlnl = qr{(? 1, sslv2 => 1 }; @@ -376,7 +386,7 @@ my $timeout = $arg{timeout} || $TIMEOUT; my ($uscheme, $uauthority, $upath, $query, $fragment) = - $url =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|; + $url =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:(\?[^#]*))?(?:#(.*))?|; $uscheme = lc $uscheme; @@ -394,7 +404,7 @@ unless exists $hdr{host}; $uhost =~ s/^\[(.*)\]$/$1/; - $upath .= "?$query" if length $query; + $upath .= $query if length $query; $upath =~ s%^/?%/%; @@ -457,82 +467,86 @@ return unless $state{connect_guard}; - $state{connect_guard} = AnyEvent::Socket::tcp_connect $rhost, $rport, sub { - $state{fh} = shift - or do { - my $err = "$!"; - %state = (); - return $cb->(undef, { Status => 599, Reason => $err, @pseudo }); - }; + my $tcp_connect = $arg{tcp_connect} + || do { require AnyEvent::Socket; \&AnyEvent::Socket::tcp_connect }; - pop; # free memory, save a tree + $state{connect_guard} = $tcp_connect->( + $rhost, + $rport, + sub { + $state{fh} = shift + or do { + my $err = "$!"; + %state = (); + return $cb->(undef, { Status => 599, Reason => $err, @pseudo }); + }; - return unless delete $state{connect_guard}; + pop; # free memory, save a tree - # 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}; - } + return unless delete $state{connect_guard}; - # (re-)configure handle - $state{handle}->on_error (sub { - %state = (); - $cb->(undef, { Status => 599, Reason => $_[2], @pseudo }); - }); - $state{handle}->on_eof (sub { - %state = (); - $cb->(undef, { Status => 599, Reason => "Unexpected end-of-file", @pseudo }); - }); + # 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}) + ); - $state{handle}->starttls ("connect") if $rscheme eq "https"; + # return if error occured during push_write() + return unless %state; - # 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}) - ); - - # 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 - $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])", @pseudo })); - - push @pseudo, - HTTPVersion => $1, - Status => $2, - Reason => $3, - ; + %hdr = (); # reduce memory usage, save a kitten, also make it possible to re-use - # headers, could be optimized a bit - $state{handle}->unshift_read (line => $qr_nlnl, sub { + # 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" @@ -576,15 +590,16 @@ if ($recurse) { my $status = $hdr{Status}; - if (($status == 301 || $status == 302) && $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 ($status == 303) { - # even http/1.1 is unclear on how to mutate the method + # 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 ($status == 307 && $method =~ /^(?:GET|HEAD)$/) { + } elsif ($status == 307) { $redirect = 1; } } @@ -674,7 +689,7 @@ # 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); @@ -713,7 +728,7 @@ }); } else { $_[0]->on_error (sub { - $! == Errno::EPIPE || !$! + ($! == Errno::EPIPE || !$!) ? $finish->(delete $_[0]{rbuf}, \%hdr) : $finish->(undef, { Status => 599, Reason => $_[2], @pseudo }); }); @@ -722,32 +737,33 @@ } } }); - }); - }; + }; - # 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; - } + # 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; + } - }, $arg{on_prepare} || sub { $timeout }; + }, + $arg{on_prepare} || sub { $timeout } + ); }; defined wantarray && AnyEvent::Util::guard { %state = () } @@ -835,6 +851,62 @@ 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 L.