ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent-HTTP/HTTP.pm
(Generate patch)

Comparing AnyEvent-HTTP/HTTP.pm (file contents):
Revision 1.44 by root, Tue Jul 7 00:15:32 2009 UTC vs.
Revision 1.60 by root, Thu Dec 30 02:56:28 2010 UTC

… …
41use strict; 41use strict;
42no warnings; 42no warnings;
43 43
44use Errno (); 44use Errno ();
45 45
46use AnyEvent 4.8 (); 46use AnyEvent 5.0 ();
47use AnyEvent::Util (); 47use AnyEvent::Util ();
48use AnyEvent::Socket ();
49use AnyEvent::Handle (); 48use AnyEvent::Handle ();
50 49
51use base Exporter::; 50use base Exporter::;
52 51
53our $VERSION = '1.4'; 52our $VERSION = '1.46';
54 53
55our @EXPORT = qw(http_get http_post http_head http_request); 54our @EXPORT = qw(http_get http_post http_head http_request);
56 55
57our $USERAGENT = "Mozilla/5.0 (compatible; U; AnyEvent-HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)"; 56our $USERAGENT = "Mozilla/5.0 (compatible; U; AnyEvent-HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)";
58our $MAX_RECURSE = 10; 57our $MAX_RECURSE = 10;
… …
92must be an absolute http or https URL. 91must be an absolute http or https URL.
93 92
94When called in void context, nothing is returned. In other contexts, 93When called in void context, nothing is returned. In other contexts,
95C<http_request> returns a "cancellation guard" - you have to keep the 94C<http_request> returns a "cancellation guard" - you have to keep the
96object at least alive until the callback get called. If the object gets 95object at least alive until the callback get called. If the object gets
97destroyed before the callbakc is called, the request will be cancelled. 96destroyed before the callback is called, the request will be cancelled.
98 97
99The callback will be called with the response body data as first argument 98The callback will be called with the response body data as first argument
100(or C<undef> if an error occured), and a hash-ref with response headers as 99(or C<undef> if an error occured), and a hash-ref with response headers as
101second argument. 100second argument.
102 101
103All the headers in that hash are lowercased. In addition to the response 102All the headers in that hash are lowercased. In addition to the response
104headers, the "pseudo-headers" C<HTTPVersion>, C<Status> and C<Reason> 103headers, the "pseudo-headers" (uppercase to avoid clashing with possible
104response headers) C<HTTPVersion>, C<Status> and C<Reason> contain the
105contain the three parts of the HTTP Status-Line of the same name. The 105three parts of the HTTP Status-Line of the same name.
106
106pseudo-header C<URL> contains the original URL (which can differ from the 107The pseudo-header C<URL> contains the actual URL (which can differ from
107requested URL when following redirects). 108the requested URL when following redirects - for example, you might get
109an error that your URL scheme is not supported even though your URL is a
110valid http URL because it redirected to an ftp URL, in which case you can
111look at the URL pseudo header).
112
113The pseudo-header C<Redirect> only exists when the request was a result
114of an internal redirect. In that case it is an array reference with
115the C<($data, $headers)> from the redirect response. Note that this
116response could in turn be the result of a redirect itself, and C<<
117$headers->{Redirect}[1]{Redirect} >> will then contain the original
118response, and so on.
108 119
109If the server sends a header multiple times, then their contents will be 120If the server sends a header multiple times, then their contents will be
110joined together with a comma (C<,>), as per the HTTP spec. 121joined together with a comma (C<,>), as per the HTTP spec.
111 122
112If an internal error occurs, such as not being able to resolve a hostname, 123If an internal error occurs, such as not being able to resolve a hostname,
… …
138 149
139=item headers => hashref 150=item headers => hashref
140 151
141The request headers to use. Currently, C<http_request> may provide its 152The request headers to use. Currently, C<http_request> may provide its
142own C<Host:>, C<Content-Length:>, C<Connection:> and C<Cookie:> headers 153own C<Host:>, C<Content-Length:>, C<Connection:> and C<Cookie:> headers
143and will provide defaults for C<User-Agent:> and C<Referer:>. 154and will provide defaults for C<User-Agent:> and C<Referer:> (this can be
155suppressed by using C<undef> for these headers in which case they won't be
156sent at all).
144 157
145=item timeout => $seconds 158=item timeout => $seconds
146 159
147The time-out to use for various stages - each connect attempt will reset 160The time-out to use for various stages - each connect attempt will reset
148the timeout, as will read or write activity. Default timeout is 5 minutes. 161the timeout, as will read or write activity, i.e. this is not an overall
162timeout.
163
164Default timeout is 5 minutes.
149 165
150=item proxy => [$host, $port[, $scheme]] or undef 166=item proxy => [$host, $port[, $scheme]] or undef
151 167
152Use the given http proxy for all requests. If not specified, then the 168Use the given http proxy for all requests. If not specified, then the
153default proxy (as specified by C<$ENV{http_proxy}>) is used. 169default proxy (as specified by C<$ENV{http_proxy}>) is used.
154 170
155C<$scheme> must be either missing or C<http> for HTTP, or C<https> for 171C<$scheme> must be either missing, C<http> for HTTP or C<https> for
156HTTPS. 172HTTPS.
157 173
158=item body => $string 174=item body => $string
159 175
160The request body, usually empty. Will be-sent as-is (future versions of 176The request body, usually empty. Will be-sent as-is (future versions of
… …
186verification) TLS context. 202verification) TLS context.
187 203
188The default for this option is C<low>, which could be interpreted as "give 204The default for this option is C<low>, which could be interpreted as "give
189me the page, no matter what". 205me the page, no matter what".
190 206
207=item on_prepare => $callback->($fh)
208
209In rare cases you need to "tune" the socket before it is used to
210connect (for exmaple, to bind it on a given IP address). This parameter
211overrides the prepare callback passed to C<AnyEvent::Socket::tcp_connect>
212and behaves exactly the same way (e.g. it has to provide a
213timeout). See the description for the C<$prepare_cb> argument of
214C<AnyEvent::Socket::tcp_connect> for details.
215
216=item tcp_connect => $callback->($host, $service, $connect_cb, $prepare_cb)
217
218In even rarer cases you want total control over how AnyEvent::HTTP
219establishes connections. Normally it uses L<AnyEvent::Socket::tcp_connect>
220to do this, but you can provide your own C<tcp_connect> function -
221obviously, it has to follow the same calling conventions, except that it
222may always return a connection guard object.
223
224There are probably lots of weird uses for this function, starting from
225tracing the hosts C<http_request> actually tries to connect, to (inexact
226but fast) host => IP address caching or even socks protocol support.
227
191=item on_header => $callback->($headers) 228=item on_header => $callback->($headers)
192 229
193When specified, this callback will be called with the header hash as soon 230When specified, this callback will be called with the header hash as soon
194as headers have been successfully received from the remote server (not on 231as headers have been successfully received from the remote server (not on
195locally-generated errors). 232locally-generated errors).
… …
221This callback is useful when the data is too large to be held in memory 258This callback is useful when the data is too large to be held in memory
222(so the callback writes it to a file) or when only some information should 259(so the callback writes it to a file) or when only some information should
223be extracted, or when the body should be processed incrementally. 260be extracted, or when the body should be processed incrementally.
224 261
225It is usually preferred over doing your own body handling via 262It is usually preferred over doing your own body handling via
226C<want_body_handle>. 263C<want_body_handle>, but in case of streaming APIs, where HTTP is
264only used to create a connection, C<want_body_handle> is the better
265alternative, as it allows you to install your own event handler, reducing
266resource usage.
227 267
228=item want_body_handle => $enable 268=item want_body_handle => $enable
229 269
230When enabled (default is disabled), the behaviour of AnyEvent::HTTP 270When enabled (default is disabled), the behaviour of AnyEvent::HTTP
231changes considerably: after parsing the headers, and instead of 271changes considerably: after parsing the headers, and instead of
… …
243This is useful with some push-type services, where, after the initial 283This is useful with some push-type services, where, after the initial
244headers, an interactive protocol is used (typical example would be the 284headers, an interactive protocol is used (typical example would be the
245push-style twitter API which starts a JSON/XML stream). 285push-style twitter API which starts a JSON/XML stream).
246 286
247If you think you need this, first have a look at C<on_body>, to see if 287If you think you need this, first have a look at C<on_body>, to see if
248that doesn'T solve your problem in a better way. 288that doesn't solve your problem in a better way.
249 289
250=back 290=back
251 291
252Example: make a simple HTTP GET request for http://www.nethype.de/ 292Example: make a simple HTTP GET request for http://www.nethype.de/
253 293
… …
309 push @{ $CO_SLOT{$_[0]}[1] }, $_[1]; 349 push @{ $CO_SLOT{$_[0]}[1] }, $_[1];
310 350
311 _slot_schedule $_[0]; 351 _slot_schedule $_[0];
312} 352}
313 353
314our $qr_nl = qr<\015?\012>; 354our $qr_nlnl = qr{(?<![^\012])\015?\012};
315our $qr_nlnl = qr<\015?\012\015?\012>;
316 355
317our $TLS_CTX_LOW = { cache => 1, sslv2 => 1 }; 356our $TLS_CTX_LOW = { cache => 1, sslv2 => 1 };
318our $TLS_CTX_HIGH = { cache => 1, verify => 1, verify_peername => "https" }; 357our $TLS_CTX_HIGH = { cache => 1, verify => 1, verify_peername => "https" };
319 358
320sub http_request($$@) { 359sub http_request($$@) {
… …
332 while (my ($k, $v) = each %$hdr) { 371 while (my ($k, $v) = each %$hdr) {
333 $hdr{lc $k} = $v; 372 $hdr{lc $k} = $v;
334 } 373 }
335 } 374 }
336 375
376 # pseudo headers for all subsequent responses
377 my @pseudo = (URL => $url);
378 push @pseudo, Redirect => delete $arg{Redirect} if exists $arg{Redirect};
379
337 my $recurse = exists $arg{recurse} ? delete $arg{recurse} : $MAX_RECURSE; 380 my $recurse = exists $arg{recurse} ? delete $arg{recurse} : $MAX_RECURSE;
338 381
339 return $cb->(undef, { Status => 599, Reason => "Too many redirections", URL => $url }) 382 return $cb->(undef, { Status => 599, Reason => "Too many redirections", @pseudo })
340 if $recurse < 0; 383 if $recurse < 0;
341 384
342 my $proxy = $arg{proxy} || $PROXY; 385 my $proxy = $arg{proxy} || $PROXY;
343 my $timeout = $arg{timeout} || $TIMEOUT; 386 my $timeout = $arg{timeout} || $TIMEOUT;
344 387
345 my ($uscheme, $uauthority, $upath, $query, $fragment) = 388 my ($uscheme, $uauthority, $upath, $query, $fragment) =
346 $url =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|; 389 $url =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:(\?[^#]*))?(?:#(.*))?|;
347 390
348 $uscheme = lc $uscheme; 391 $uscheme = lc $uscheme;
349 392
350 my $uport = $uscheme eq "http" ? 80 393 my $uport = $uscheme eq "http" ? 80
351 : $uscheme eq "https" ? 443 394 : $uscheme eq "https" ? 443
352 : return $cb->(undef, { Status => 599, Reason => "Only http and https URL schemes supported", URL => $url }); 395 : return $cb->(undef, { Status => 599, Reason => "Only http and https URL schemes supported", @pseudo });
353 396
354 $uauthority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x 397 $uauthority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x
355 or return $cb->(undef, { Status => 599, Reason => "Unparsable URL", URL => $url }); 398 or return $cb->(undef, { Status => 599, Reason => "Unparsable URL", @pseudo });
356 399
357 my $uhost = $1; 400 my $uhost = $1;
358 $uport = $2 if defined $2; 401 $uport = $2 if defined $2;
359 402
360 $hdr{host} = defined $2 ? "$uhost:$2" : "$uhost"; 403 $hdr{host} = defined $2 ? "$uhost:$2" : "$uhost"
404 unless exists $hdr{host};
361 405
362 $uhost =~ s/^\[(.*)\]$/$1/; 406 $uhost =~ s/^\[(.*)\]$/$1/;
363 $upath .= "?$query" if length $query; 407 $upath .= $query if length $query;
364 408
365 $upath =~ s%^/?%/%; 409 $upath =~ s%^/?%/%;
366 410
367 # cookie processing 411 # cookie processing
368 if (my $jar = $arg{cookie_jar}) { 412 if (my $jar = $arg{cookie_jar}) {
… …
398 my ($rhost, $rport, $rscheme, $rpath); # request host, port, path 442 my ($rhost, $rport, $rscheme, $rpath); # request host, port, path
399 443
400 if ($proxy) { 444 if ($proxy) {
401 ($rpath, $rhost, $rport, $rscheme) = ($url, @$proxy); 445 ($rpath, $rhost, $rport, $rscheme) = ($url, @$proxy);
402 446
447 $rscheme = "http" unless defined $rscheme;
448
403 # don't support https requests over https-proxy transport, 449 # don't support https requests over https-proxy transport,
404 # can't be done with tls as spec'ed, unless you double-encrypt. 450 # can't be done with tls as spec'ed, unless you double-encrypt.
405 $rscheme = "http" if $uscheme eq "https" && $rscheme eq "https"; 451 $rscheme = "http" if $uscheme eq "https" && $rscheme eq "https";
406 } else { 452 } else {
407 ($rhost, $rport, $rscheme, $rpath) = ($uhost, $uport, $uscheme, $upath); 453 ($rhost, $rport, $rscheme, $rpath) = ($uhost, $uport, $uscheme, $upath);
408 } 454 }
409 455
410 $hdr{"user-agent"} ||= $USERAGENT; 456 # leave out fragment and query string, just a heuristic
411 $hdr{referer} ||= "$uscheme://$uauthority$upath"; # leave out fragment and query string, just a heuristic 457 $hdr{referer} ||= "$uscheme://$uauthority$upath" unless exists $hdr{referer};
458 $hdr{"user-agent"} ||= $USERAGENT unless exists $hdr{"user-agent"};
412 459
413 $hdr{"content-length"} = length $arg{body}; 460 $hdr{"content-length"} = length $arg{body}
461 if length $arg{body} || $method ne "GET";
414 462
415 my %state = (connect_guard => 1); 463 my %state = (connect_guard => 1);
416 464
417 _get_slot $uhost, sub { 465 _get_slot $uhost, sub {
418 $state{slot_guard} = shift; 466 $state{slot_guard} = shift;
419 467
420 return unless $state{connect_guard}; 468 return unless $state{connect_guard};
421 469
422 $state{connect_guard} = AnyEvent::Socket::tcp_connect $rhost, $rport, sub { 470 my $tcp_connect = $arg{tcp_connect}
471 || do { require AnyEvent::Socket; \&AnyEvent::Socket::tcp_connect };
472
473 $state{connect_guard} = $tcp_connect->(
474 $rhost,
475 $rport,
476 sub {
423 $state{fh} = shift 477 $state{fh} = shift
424 or do { 478 or do {
425 my $err = "$!"; 479 my $err = "$!";
426 %state = (); 480 %state = ();
427 return $cb->(undef, { Status => 599, Reason => $err, URL => $url }); 481 return $cb->(undef, { Status => 599, Reason => $err, @pseudo });
428 }; 482 };
429 483
430 pop; # free memory, save a tree 484 pop; # free memory, save a tree
431 485
432 return unless delete $state{connect_guard}; 486 return unless delete $state{connect_guard};
433 487
434 # get handle 488 # get handle
435 $state{handle} = new AnyEvent::Handle 489 $state{handle} = new AnyEvent::Handle
436 fh => $state{fh}, 490 fh => $state{fh},
491 peername => $rhost,
492 tls_ctx => $arg{tls_ctx},
493 # these need to be reconfigured on keepalive handles
437 timeout => $timeout, 494 timeout => $timeout,
438 peername => $rhost, 495 on_error => sub {
439 tls_ctx => $arg{tls_ctx}; 496 %state = ();
497 $cb->(undef, { Status => 599, Reason => $_[2], @pseudo });
498 },
499 on_eof => sub {
500 %state = ();
501 $cb->(undef, { Status => 599, Reason => "Unexpected end-of-file", @pseudo });
502 },
503 ;
440 504
441 # limit the number of persistent connections 505 # limit the number of persistent connections
442 # keepalive not yet supported 506 # keepalive not yet supported
443 if ($KA_COUNT{$_[1]} < $MAX_PERSISTENT_PER_HOST) { 507# if ($KA_COUNT{$_[1]} < $MAX_PERSISTENT_PER_HOST) {
444 ++$KA_COUNT{$_[1]}; 508# ++$KA_COUNT{$_[1]};
445 $state{handle}{ka_count_guard} = AnyEvent::Util::guard { 509# $state{handle}{ka_count_guard} = AnyEvent::Util::guard {
446 --$KA_COUNT{$_[1]} 510# --$KA_COUNT{$_[1]}
447 }; 511# };
448 $hdr{connection} = "keep-alive"; 512# $hdr{connection} = "keep-alive";
449 } else { 513# } else {
450 delete $hdr{connection}; 514 delete $hdr{connection};
451 } 515# }
452 516
453 # (re-)configure handle
454 $state{handle}->on_error (sub {
455 %state = ();
456 $cb->(undef, { Status => 599, Reason => $_[2], URL => $url });
457 });
458 $state{handle}->on_eof (sub {
459 %state = ();
460 $cb->(undef, { Status => 599, Reason => "Unexpected end-of-file", URL => $url });
461 });
462
463 $state{handle}->starttls ("connect") if $rscheme eq "https"; 517 $state{handle}->starttls ("connect") if $rscheme eq "https";
464 518
465 # handle actual, non-tunneled, request 519 # handle actual, non-tunneled, request
466 my $handle_actual_request = sub { 520 my $handle_actual_request = sub {
467 $state{handle}->starttls ("connect") if $uscheme eq "https" && !exists $state{handle}{tls}; 521 $state{handle}->starttls ("connect") if $uscheme eq "https" && !exists $state{handle}{tls};
468 522
469 # send request 523 # send request
470 $state{handle}->push_write ( 524 $state{handle}->push_write (
471 "$method $rpath HTTP/1.0\015\012" 525 "$method $rpath HTTP/1.0\015\012"
472 . (join "", map "\u$_: $hdr{$_}\015\012", keys %hdr) 526 . (join "", map "\u$_: $hdr{$_}\015\012", grep defined $hdr{$_}, keys %hdr)
473 . "\015\012" 527 . "\015\012"
474 . (delete $arg{body}) 528 . (delete $arg{body})
475 );
476
477 %hdr = (); # reduce memory usage, save a kitten
478
479 # status line
480 $state{handle}->push_read (line => $qr_nl, sub {
481 $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )?/ix
482 or return (%state = (), $cb->(undef, { Status => 599, Reason => "Invalid server response ($_[1])", URL => $url }));
483
484 my %hdr = ( # response headers
485 HTTPVersion => ",$1",
486 Status => ",$2",
487 Reason => ",$3",
488 URL => ",$url"
489 ); 529 );
490 530
491 # headers, could be optimized a bit 531 # return if error occured during push_write()
532 return unless %state;
533
534 %hdr = (); # reduce memory usage, save a kitten, also make it possible to re-use
535
536 # status line and headers
492 $state{handle}->unshift_read (line => $qr_nlnl, sub { 537 $state{handle}->push_read (line => $qr_nlnl, sub {
493 for ("$_[1]\012") { 538 for ("$_[1]") {
494 y/\015//d; # weed out any \015, as they show up in the weirdest of places. 539 y/\015//d; # weed out any \015, as they show up in the weirdest of places.
540
541 /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )? \015?\012/igxc
542 or return (%state = (), $cb->(undef, { Status => 599, Reason => "Invalid server response", @pseudo }));
543
544 push @pseudo,
545 HTTPVersion => $1,
546 Status => $2,
547 Reason => $3,
548 ;
495 549
496 # things seen, not parsed: 550 # things seen, not parsed:
497 # p3pP="NON CUR OTPi OUR NOR UNI" 551 # p3pP="NON CUR OTPi OUR NOR UNI"
498 552
499 $hdr{lc $1} .= ",$2" 553 $hdr{lc $1} .= ",$2"
… …
503 ((?: [^\012]+ | \012[\011\040] )*) 557 ((?: [^\012]+ | \012[\011\040] )*)
504 \012 558 \012
505 /gxc; 559 /gxc;
506 560
507 /\G$/ 561 /\G$/
508 or return (%state = (), $cb->(undef, { Status => 599, Reason => "Garbled response headers", URL => $url })); 562 or return (%state = (), $cb->(undef, { Status => 599, Reason => "Garbled response headers", @pseudo }));
509 } 563 }
510 564
565 # remove the "," prefix we added to all headers above
511 substr $_, 0, 1, "" 566 substr $_, 0, 1, ""
512 for values %hdr; 567 for values %hdr;
568
569 # patch in all pseudo headers
570 %hdr = (%hdr, @pseudo);
513 571
514 # redirect handling 572 # redirect handling
515 # microsoft and other shitheads don't give a shit for following standards, 573 # microsoft and other shitheads don't give a shit for following standards,
516 # try to support some common forms of broken Location headers. 574 # try to support some common forms of broken Location headers.
517 if ($hdr{location} !~ /^(?: $ | [^:\/?\#]+ : )/x) { 575 if ($hdr{location} !~ /^(?: $ | [^:\/?\#]+ : )/x) {
… …
528 } 586 }
529 587
530 my $redirect; 588 my $redirect;
531 589
532 if ($recurse) { 590 if ($recurse) {
533 if ($hdr{Status} =~ /^30[12]$/ && $method ne "POST") { 591 my $status = $hdr{Status};
534 # apparently, mozilla et al. just change POST to GET here 592
535 # more research is needed before we do the same 593 # industry standard is to redirect POST as GET for
536 $redirect = 1; 594 # 301, 302 and 303, in contrast to http/1.0 and 1.1.
537 } elsif ($hdr{Status} == 303) { 595 # also, the UA should ask the user for 301 and 307 and POST,
596 # industry standard seems to be to simply follow.
597 # we go with the industry standard.
598 if ($status == 301 or $status == 302 or $status == 303) {
538 # even http/1.1 is unclear on how to mutate the method 599 # HTTP/1.1 is unclear on how to mutate the method
539 $method = "GET" unless $method eq "HEAD"; 600 $method = "GET" unless $method eq "HEAD";
540 $redirect = 1; 601 $redirect = 1;
541 } elsif ($hdr{Status} == 307 && $method =~ /^(?:GET|HEAD)$/) { 602 } elsif ($status == 307) {
542 $redirect = 1; 603 $redirect = 1;
543 } 604 }
544 } 605 }
545 606
546 my $finish = sub { 607 my $finish = sub {
… …
595 656
596 redo if /\G\s*,/gc; 657 redo if /\G\s*,/gc;
597 } 658 }
598 } 659 }
599 660
600 if ($redirect) { 661 if ($redirect && exists $hdr{location}) {
601 # we ignore any errors, as it is very common to receive 662 # we ignore any errors, as it is very common to receive
602 # Content-Length != 0 but no actual body 663 # Content-Length != 0 but no actual body
603 # we also access %hdr, as $_[1] might be an erro 664 # we also access %hdr, as $_[1] might be an erro
604 http_request ($method => $hdr{location}, %arg, recurse => $recurse - 1, $cb); 665 http_request (
666 $method => $hdr{location},
667 %arg,
668 recurse => $recurse - 1,
669 Redirect => \@_,
670 $cb);
605 } else { 671 } else {
606 $cb->($_[0], $_[1]); 672 $cb->($_[0], $_[1]);
607 } 673 }
608 }; 674 };
609 675
610 my $len = $hdr{"content-length"}; 676 my $len = $hdr{"content-length"};
611 677
612 if (!$redirect && $arg{on_header} && !$arg{on_header}(\%hdr)) { 678 if (!$redirect && $arg{on_header} && !$arg{on_header}(\%hdr)) {
613 $finish->(undef, { Status => 598, Reason => "Request cancelled by on_header", URL => $url }); 679 $finish->(undef, { Status => 598, Reason => "Request cancelled by on_header", @pseudo });
614 } elsif ( 680 } elsif (
615 $hdr{Status} =~ /^(?:1..|[23]04)$/ 681 $hdr{Status} =~ /^(?:1..|[23]04)$/
616 or $method eq "HEAD" 682 or $method eq "HEAD"
617 or (defined $len && !$len) 683 or (defined $len && !$len)
618 ) { 684 ) {
… …
621 } else { 687 } else {
622 # body handling, four different code paths 688 # body handling, four different code paths
623 # for want_body_handle, on_body (2x), normal (2x) 689 # for want_body_handle, on_body (2x), normal (2x)
624 # we might read too much here, but it does not matter yet (no pers. connections) 690 # we might read too much here, but it does not matter yet (no pers. connections)
625 if (!$redirect && $arg{want_body_handle}) { 691 if (!$redirect && $arg{want_body_handle}) {
626 $_[0]->on_eof (undef); 692 $_[0]->on_eof (undef);
627 $_[0]->on_error (undef); 693 $_[0]->on_error (undef);
628 $_[0]->on_read (undef); 694 $_[0]->on_read (undef);
629 695
630 $finish->(delete $state{handle}, \%hdr); 696 $finish->(delete $state{handle}, \%hdr);
631 697
632 } elsif ($arg{on_body}) { 698 } elsif ($arg{on_body}) {
633 $_[0]->on_error (sub { $finish->(undef, { Status => 599, Reason => $_[2], URL => $url }) }); 699 $_[0]->on_error (sub { $finish->(undef, { Status => 599, Reason => $_[2], @pseudo }) });
634 if ($len) { 700 if ($len) {
635 $_[0]->on_eof (undef); 701 $_[0]->on_eof (undef);
636 $_[0]->on_read (sub { 702 $_[0]->on_read (sub {
637 $len -= length $_[0]{rbuf}; 703 $len -= length $_[0]{rbuf};
638 704
639 $arg{on_body}(delete $_[0]{rbuf}, \%hdr) 705 $arg{on_body}(delete $_[0]{rbuf}, \%hdr)
640 or $finish->(undef, { Status => 598, Reason => "Request cancelled by on_body", URL => $url }); 706 or $finish->(undef, { Status => 598, Reason => "Request cancelled by on_body", @pseudo });
641 707
642 $len > 0 708 $len > 0
643 or $finish->("", \%hdr); 709 or $finish->("", \%hdr);
644 }); 710 });
645 } else { 711 } else {
646 $_[0]->on_eof (sub { 712 $_[0]->on_eof (sub {
647 $finish->("", \%hdr); 713 $finish->("", \%hdr);
648 }); 714 });
649 $_[0]->on_read (sub { 715 $_[0]->on_read (sub {
650 $arg{on_body}(delete $_[0]{rbuf}, \%hdr) 716 $arg{on_body}(delete $_[0]{rbuf}, \%hdr)
651 or $finish->(undef, { Status => 598, Reason => "Request cancelled by on_body", URL => $url }); 717 or $finish->(undef, { Status => 598, Reason => "Request cancelled by on_body", @pseudo });
652 }); 718 });
653 } 719 }
654 } else { 720 } else {
655 $_[0]->on_eof (undef); 721 $_[0]->on_eof (undef);
656 722
657 if ($len) { 723 if ($len) {
658 $_[0]->on_error (sub { $finish->(undef, { Status => 599, Reason => $_[2], URL => $url }) }); 724 $_[0]->on_error (sub { $finish->(undef, { Status => 599, Reason => $_[2], @pseudo }) });
659 $_[0]->on_read (sub { 725 $_[0]->on_read (sub {
660 $finish->((substr delete $_[0]{rbuf}, 0, $len, ""), \%hdr) 726 $finish->((substr delete $_[0]{rbuf}, 0, $len, ""), \%hdr)
661 if $len <= length $_[0]{rbuf}; 727 if $len <= length $_[0]{rbuf};
662 }); 728 });
663 } else { 729 } else {
664 $_[0]->on_error (sub { 730 $_[0]->on_error (sub {
665 $! == Errno::EPIPE || !$! 731 ($! == Errno::EPIPE || !$!)
666 ? $finish->(delete $_[0]{rbuf}, \%hdr) 732 ? $finish->(delete $_[0]{rbuf}, \%hdr)
667 : $finish->(undef, { Status => 599, Reason => $_[2], URL => $url }); 733 : $finish->(undef, { Status => 599, Reason => $_[2], @pseudo });
668 }); 734 });
669 $_[0]->on_read (sub { }); 735 $_[0]->on_read (sub { });
670 } 736 }
671 } 737 }
672 } 738 }
673 }); 739 });
674 }); 740 };
675 };
676 741
677 # now handle proxy-CONNECT method 742 # now handle proxy-CONNECT method
678 if ($proxy && $uscheme eq "https") { 743 if ($proxy && $uscheme eq "https") {
679 # oh dear, we have to wrap it into a connect request 744 # oh dear, we have to wrap it into a connect request
680 745
681 # maybe re-use $uauthority with patched port? 746 # maybe re-use $uauthority with patched port?
682 $state{handle}->push_write ("CONNECT $uhost:$uport HTTP/1.0\015\012Host: $uhost\015\012\015\012"); 747 $state{handle}->push_write ("CONNECT $uhost:$uport HTTP/1.0\015\012Host: $uhost\015\012\015\012");
683 $state{handle}->push_read (line => $qr_nlnl, sub { 748 $state{handle}->push_read (line => $qr_nlnl, sub {
684 $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )?/ix 749 $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )?/ix
685 or return (%state = (), $cb->(undef, { Status => 599, Reason => "Invalid proxy connect response ($_[1])", URL => $url })); 750 or return (%state = (), $cb->(undef, { Status => 599, Reason => "Invalid proxy connect response ($_[1])", @pseudo }));
686 751
687 if ($2 == 200) { 752 if ($2 == 200) {
688 $rpath = $upath; 753 $rpath = $upath;
689 &$handle_actual_request; 754 &$handle_actual_request;
690 } else { 755 } else {
691 %state = (); 756 %state = ();
692 $cb->(undef, { Status => $2, Reason => $3, URL => $url }); 757 $cb->(undef, { Status => $2, Reason => $3, @pseudo });
758 }
693 } 759 });
694 });
695 } else { 760 } else {
696 &$handle_actual_request; 761 &$handle_actual_request;
762 }
763
697 } 764 },
698 765 $arg{on_prepare} || sub { $timeout }
699 }, sub {
700 $timeout
701 }; 766 );
702 }; 767 };
703 768
704 defined wantarray && AnyEvent::Util::guard { %state = () } 769 defined wantarray && AnyEvent::Util::guard { %state = () }
705} 770}
706 771
… …
720 &http_request 785 &http_request
721} 786}
722 787
723=back 788=back
724 789
790=head2 DNS CACHING
791
792AnyEvent::HTTP uses the AnyEvent::Socket::tcp_connect function for
793the actual connection, which in turn uses AnyEvent::DNS to resolve
794hostnames. The latter is a simple stub resolver and does no caching
795on its own. If you want DNS caching, you currently have to provide
796your own default resolver (by storing a suitable resolver object in
797C<$AnyEvent::DNS::RESOLVER>).
798
725=head2 GLOBAL FUNCTIONS AND VARIABLES 799=head2 GLOBAL FUNCTIONS AND VARIABLES
726 800
727=over 4 801=over 4
728 802
729=item AnyEvent::HTTP::set_proxy "proxy-url" 803=item AnyEvent::HTTP::set_proxy "proxy-url"
730 804
731Sets the default proxy server to use. The proxy-url must begin with a 805Sets the default proxy server to use. The proxy-url must begin with a
732string of the form C<http://host:port> (optionally C<https:...>). 806string of the form C<http://host:port> (optionally C<https:...>), croaks
807otherwise.
808
809To clear an already-set proxy, use C<undef>.
733 810
734=item $AnyEvent::HTTP::MAX_RECURSE 811=item $AnyEvent::HTTP::MAX_RECURSE
735 812
736The default value for the C<recurse> request parameter (default: C<10>). 813The default value for the C<recurse> request parameter (default: C<10>).
737 814
… …
740The default value for the C<User-Agent> header (the default is 817The default value for the C<User-Agent> header (the default is
741C<Mozilla/5.0 (compatible; U; AnyEvent-HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)>). 818C<Mozilla/5.0 (compatible; U; AnyEvent-HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)>).
742 819
743=item $AnyEvent::HTTP::MAX_PER_HOST 820=item $AnyEvent::HTTP::MAX_PER_HOST
744 821
745The maximum number of concurrent conenctions to the same host (identified 822The maximum number of concurrent connections to the same host (identified
746by the hostname). If the limit is exceeded, then the additional requests 823by the hostname). If the limit is exceeded, then the additional requests
747are queued until previous connections are closed. 824are queued until previous connections are closed.
748 825
749The default value for this is C<4>, and it is highly advisable to not 826The default value for this is C<4>, and it is highly advisable to not
750increase it. 827increase it.
… …
758=back 835=back
759 836
760=cut 837=cut
761 838
762sub set_proxy($) { 839sub set_proxy($) {
840 if (length $_[0]) {
763 $PROXY = [$2, $3 || 3128, $1] if $_[0] =~ m%^(https?):// ([^:/]+) (?: : (\d*) )?%ix; 841 $_[0] =~ m%^(https?):// ([^:/]+) (?: : (\d*) )?%ix
842 or Carp::croak "$_[0]: invalid proxy URL";
843 $PROXY = [$2, $3 || 3128, $1]
844 } else {
845 undef $PROXY;
846 }
764} 847}
765 848
766# initialise proxy from environment 849# initialise proxy from environment
850eval {
767set_proxy $ENV{http_proxy}; 851 set_proxy $ENV{http_proxy};
852};
853
854=head2 SOCKS PROXIES
855
856Socks proxies are not directly supported by AnyEvent::HTTP. You can
857compile your perl to support socks, or use an external program such as
858F<socksify> (dante) or F<tsocks> to make your program use a socks proxy
859transparently.
860
861Alternatively, for AnyEvent::HTTP only, you can use your own
862C<tcp_connect> function that does the proxy handshake - here is an example
863that works with socks4a proxies:
864
865 use Errno;
866 use AnyEvent::Util;
867 use AnyEvent::Socket;
868 use AnyEvent::Handle;
869
870 # host, port and username of/for your socks4a proxy
871 my $socks_host = "10.0.0.23";
872 my $socks_port = 9050;
873 my $socks_user = "";
874
875 sub socks4a_connect {
876 my ($host, $port, $connect_cb, $prepare_cb) = @_;
877
878 my $hdl = new AnyEvent::Handle
879 connect => [$socks_host, $socks_port],
880 on_prepare => sub { $prepare_cb->($_[0]{fh}) },
881 on_error => sub { $connect_cb->() },
882 ;
883
884 $hdl->push_write (pack "CCnNZ*Z*", 4, 1, $port, 1, $socks_user, $host);
885
886 $hdl->push_read (chunk => 8, sub {
887 my ($hdl, $chunk) = @_;
888 my ($status, $port, $ipn) = unpack "xCna4", $chunk;
889
890 if ($status == 0x5a) {
891 $connect_cb->($hdl->{fh}, (format_address $ipn) . ":$port");
892 } else {
893 $! = Errno::ENXIO; $connect_cb->();
894 }
895 });
896
897 $hdl
898 }
899
900Use C<socks4a_connect> instead of C<tcp_connect> when doing C<http_request>s,
901possibly after switching off other proxy types:
902
903 AnyEvent::HTTP::set_proxy undef; # usually you do not want other proxies
904
905 http_get 'http://www.google.com', tcp_connect => \&socks4a_connect, sub {
906 my ($data, $headers) = @_;
907 ...
908 };
768 909
769=head1 SEE ALSO 910=head1 SEE ALSO
770 911
771L<AnyEvent>. 912L<AnyEvent>.
772 913

Diff Legend

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