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.51 by root, Fri Aug 14 15:21:33 2009 UTC vs.
Revision 1.59 by root, Wed Dec 29 23:59:36 2010 UTC

… …
43 43
44use Errno (); 44use Errno ();
45 45
46use AnyEvent 5.0 (); 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.43'; 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,
… …
199connect (for exmaple, to bind it on a given IP address). This parameter 210connect (for exmaple, to bind it on a given IP address). This parameter
200overrides the prepare callback passed to C<AnyEvent::Socket::tcp_connect> 211overrides the prepare callback passed to C<AnyEvent::Socket::tcp_connect>
201and behaves exactly the same way (e.g. it has to provide a 212and behaves exactly the same way (e.g. it has to provide a
202timeout). See the description for the C<$prepare_cb> argument of 213timeout). See the description for the C<$prepare_cb> argument of
203C<AnyEvent::Socket::tcp_connect> for details. 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.
222
223There are probably lots of weird uses for this function, starting from
224tracing the hosts C<http_request> actually tries to connect, to (inexact
225but fast) host => IP address caching or even socks protocol support.
204 226
205=item on_header => $callback->($headers) 227=item on_header => $callback->($headers)
206 228
207When specified, this callback will be called with the header hash as soon 229When specified, this callback will be called with the header hash as soon
208as headers have been successfully received from the remote server (not on 230as headers have been successfully received from the remote server (not on
… …
326 push @{ $CO_SLOT{$_[0]}[1] }, $_[1]; 348 push @{ $CO_SLOT{$_[0]}[1] }, $_[1];
327 349
328 _slot_schedule $_[0]; 350 _slot_schedule $_[0];
329} 351}
330 352
331our $qr_nl = qr{\015?\012};
332our $qr_nlnl = qr{(?<![^\012])\015?\012}; 353our $qr_nlnl = qr{(?<![^\012])\015?\012};
333 354
334our $TLS_CTX_LOW = { cache => 1, sslv2 => 1 }; 355our $TLS_CTX_LOW = { cache => 1, sslv2 => 1 };
335our $TLS_CTX_HIGH = { cache => 1, verify => 1, verify_peername => "https" }; 356our $TLS_CTX_HIGH = { cache => 1, verify => 1, verify_peername => "https" };
336 357
… …
349 while (my ($k, $v) = each %$hdr) { 370 while (my ($k, $v) = each %$hdr) {
350 $hdr{lc $k} = $v; 371 $hdr{lc $k} = $v;
351 } 372 }
352 } 373 }
353 374
375 # pseudo headers for all subsequent responses
376 my @pseudo = (URL => $url);
377 push @pseudo, Redirect => delete $arg{Redirect} if exists $arg{Redirect};
378
354 my $recurse = exists $arg{recurse} ? delete $arg{recurse} : $MAX_RECURSE; 379 my $recurse = exists $arg{recurse} ? delete $arg{recurse} : $MAX_RECURSE;
355 380
356 return $cb->(undef, { Status => 599, Reason => "Too many redirections", URL => $url }) 381 return $cb->(undef, { Status => 599, Reason => "Too many redirections", @pseudo })
357 if $recurse < 0; 382 if $recurse < 0;
358 383
359 my $proxy = $arg{proxy} || $PROXY; 384 my $proxy = $arg{proxy} || $PROXY;
360 my $timeout = $arg{timeout} || $TIMEOUT; 385 my $timeout = $arg{timeout} || $TIMEOUT;
361 386
362 my ($uscheme, $uauthority, $upath, $query, $fragment) = 387 my ($uscheme, $uauthority, $upath, $query, $fragment) =
363 $url =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|; 388 $url =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:(\?[^#]*))?(?:#(.*))?|;
364 389
365 $uscheme = lc $uscheme; 390 $uscheme = lc $uscheme;
366 391
367 my $uport = $uscheme eq "http" ? 80 392 my $uport = $uscheme eq "http" ? 80
368 : $uscheme eq "https" ? 443 393 : $uscheme eq "https" ? 443
369 : return $cb->(undef, { Status => 599, Reason => "Only http and https URL schemes supported", URL => $url }); 394 : return $cb->(undef, { Status => 599, Reason => "Only http and https URL schemes supported", @pseudo });
370 395
371 $uauthority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x 396 $uauthority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x
372 or return $cb->(undef, { Status => 599, Reason => "Unparsable URL", URL => $url }); 397 or return $cb->(undef, { Status => 599, Reason => "Unparsable URL", @pseudo });
373 398
374 my $uhost = $1; 399 my $uhost = $1;
375 $uport = $2 if defined $2; 400 $uport = $2 if defined $2;
376 401
377 $hdr{host} = defined $2 ? "$uhost:$2" : "$uhost"; 402 $hdr{host} = defined $2 ? "$uhost:$2" : "$uhost"
403 unless exists $hdr{host};
378 404
379 $uhost =~ s/^\[(.*)\]$/$1/; 405 $uhost =~ s/^\[(.*)\]$/$1/;
380 $upath .= "?$query" if length $query; 406 $upath .= $query if length $query;
381 407
382 $upath =~ s%^/?%/%; 408 $upath =~ s%^/?%/%;
383 409
384 # cookie processing 410 # cookie processing
385 if (my $jar = $arg{cookie_jar}) { 411 if (my $jar = $arg{cookie_jar}) {
… …
428 454
429 # leave out fragment and query string, just a heuristic 455 # leave out fragment and query string, just a heuristic
430 $hdr{referer} ||= "$uscheme://$uauthority$upath" unless exists $hdr{referer}; 456 $hdr{referer} ||= "$uscheme://$uauthority$upath" unless exists $hdr{referer};
431 $hdr{"user-agent"} ||= $USERAGENT unless exists $hdr{"user-agent"}; 457 $hdr{"user-agent"} ||= $USERAGENT unless exists $hdr{"user-agent"};
432 458
433 $hdr{"content-length"} = length $arg{body}; 459 $hdr{"content-length"} = length $arg{body}
460 if length $arg{body} || $method ne "GET";
434 461
435 my %state = (connect_guard => 1); 462 my %state = (connect_guard => 1);
436 463
437 _get_slot $uhost, sub { 464 _get_slot $uhost, sub {
438 $state{slot_guard} = shift; 465 $state{slot_guard} = shift;
439 466
440 return unless $state{connect_guard}; 467 return unless $state{connect_guard};
441 468
442 $state{connect_guard} = AnyEvent::Socket::tcp_connect $rhost, $rport, sub { 469 my $tcp_connect = $arg{tcp_connect}
470 || do { require AnyEvent::Socket; \&AnyEvent::Socket::tcp_connect };
471
472 $state{connect_guard} = $tcp_connect->(
473 $rhost,
474 $rport,
475 sub {
443 $state{fh} = shift 476 $state{fh} = shift
444 or do { 477 or do {
445 my $err = "$!"; 478 my $err = "$!";
446 %state = (); 479 %state = ();
447 return $cb->(undef, { Status => 599, Reason => $err, URL => $url }); 480 return $cb->(undef, { Status => 599, Reason => $err, @pseudo });
448 }; 481 };
449 482
450 pop; # free memory, save a tree 483 pop; # free memory, save a tree
451 484
452 return unless delete $state{connect_guard}; 485 return unless delete $state{connect_guard};
453 486
454 # get handle 487 # get handle
455 $state{handle} = new AnyEvent::Handle 488 $state{handle} = new AnyEvent::Handle
456 fh => $state{fh}, 489 fh => $state{fh},
490 peername => $rhost,
491 tls_ctx => $arg{tls_ctx},
492 # these need to be reconfigured on keepalive handles
457 timeout => $timeout, 493 timeout => $timeout,
458 peername => $rhost, 494 on_error => sub {
459 tls_ctx => $arg{tls_ctx}; 495 %state = ();
496 $cb->(undef, { Status => 599, Reason => $_[2], @pseudo });
497 },
498 on_eof => sub {
499 %state = ();
500 $cb->(undef, { Status => 599, Reason => "Unexpected end-of-file", @pseudo });
501 },
502 ;
460 503
461 # limit the number of persistent connections 504 # limit the number of persistent connections
462 # keepalive not yet supported 505 # keepalive not yet supported
463 if ($KA_COUNT{$_[1]} < $MAX_PERSISTENT_PER_HOST) { 506# if ($KA_COUNT{$_[1]} < $MAX_PERSISTENT_PER_HOST) {
464 ++$KA_COUNT{$_[1]}; 507# ++$KA_COUNT{$_[1]};
465 $state{handle}{ka_count_guard} = AnyEvent::Util::guard { 508# $state{handle}{ka_count_guard} = AnyEvent::Util::guard {
466 --$KA_COUNT{$_[1]} 509# --$KA_COUNT{$_[1]}
467 }; 510# };
468 $hdr{connection} = "keep-alive"; 511# $hdr{connection} = "keep-alive";
469 } else { 512# } else {
470 delete $hdr{connection}; 513 delete $hdr{connection};
471 } 514# }
472 515
473 # (re-)configure handle
474 $state{handle}->on_error (sub {
475 %state = ();
476 $cb->(undef, { Status => 599, Reason => $_[2], URL => $url });
477 });
478 $state{handle}->on_eof (sub {
479 %state = ();
480 $cb->(undef, { Status => 599, Reason => "Unexpected end-of-file", URL => $url });
481 });
482
483 $state{handle}->starttls ("connect") if $rscheme eq "https"; 516 $state{handle}->starttls ("connect") if $rscheme eq "https";
484 517
485 # handle actual, non-tunneled, request 518 # handle actual, non-tunneled, request
486 my $handle_actual_request = sub { 519 my $handle_actual_request = sub {
487 $state{handle}->starttls ("connect") if $uscheme eq "https" && !exists $state{handle}{tls}; 520 $state{handle}->starttls ("connect") if $uscheme eq "https" && !exists $state{handle}{tls};
488 521
489 # send request 522 # send request
490 $state{handle}->push_write ( 523 $state{handle}->push_write (
491 "$method $rpath HTTP/1.0\015\012" 524 "$method $rpath HTTP/1.0\015\012"
492 . (join "", map "\u$_: $hdr{$_}\015\012", grep defined $hdr{$_}, keys %hdr) 525 . (join "", map "\u$_: $hdr{$_}\015\012", grep defined $hdr{$_}, keys %hdr)
493 . "\015\012" 526 . "\015\012"
494 . (delete $arg{body}) 527 . (delete $arg{body})
495 );
496
497 %hdr = (); # reduce memory usage, save a kitten
498
499 # status line
500 $state{handle}->push_read (line => $qr_nl, sub {
501 $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )?/ix
502 or return (%state = (), $cb->(undef, { Status => 599, Reason => "Invalid server response ($_[1])", URL => $url }));
503
504 my %hdr = ( # response headers
505 HTTPVersion => ",$1",
506 Status => ",$2",
507 Reason => ",$3",
508 URL => ",$url"
509 ); 528 );
510 529
511 # headers, could be optimized a bit 530 # return if error occured during push_write()
531 return unless %state;
532
533 %hdr = (); # reduce memory usage, save a kitten, also make it possible to re-use
534
535 # status line and headers
512 $state{handle}->unshift_read (line => $qr_nlnl, sub { 536 $state{handle}->push_read (line => $qr_nlnl, sub {
513 for ("$_[1]") { 537 for ("$_[1]") {
514 y/\015//d; # weed out any \015, as they show up in the weirdest of places. 538 y/\015//d; # weed out any \015, as they show up in the weirdest of places.
539
540 /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )? \015?\012/igxc
541 or return (%state = (), $cb->(undef, { Status => 599, Reason => "Invalid server response", @pseudo }));
542
543 push @pseudo,
544 HTTPVersion => $1,
545 Status => $2,
546 Reason => $3,
547 ;
515 548
516 # things seen, not parsed: 549 # things seen, not parsed:
517 # p3pP="NON CUR OTPi OUR NOR UNI" 550 # p3pP="NON CUR OTPi OUR NOR UNI"
518 551
519 $hdr{lc $1} .= ",$2" 552 $hdr{lc $1} .= ",$2"
… …
523 ((?: [^\012]+ | \012[\011\040] )*) 556 ((?: [^\012]+ | \012[\011\040] )*)
524 \012 557 \012
525 /gxc; 558 /gxc;
526 559
527 /\G$/ 560 /\G$/
528 or return (%state = (), $cb->(undef, { Status => 599, Reason => "Garbled response headers", URL => $url })); 561 or return (%state = (), $cb->(undef, { Status => 599, Reason => "Garbled response headers", @pseudo }));
529 } 562 }
530 563
564 # remove the "," prefix we added to all headers above
531 substr $_, 0, 1, "" 565 substr $_, 0, 1, ""
532 for values %hdr; 566 for values %hdr;
567
568 # patch in all pseudo headers
569 %hdr = (%hdr, @pseudo);
533 570
534 # redirect handling 571 # redirect handling
535 # microsoft and other shitheads don't give a shit for following standards, 572 # microsoft and other shitheads don't give a shit for following standards,
536 # try to support some common forms of broken Location headers. 573 # try to support some common forms of broken Location headers.
537 if ($hdr{location} !~ /^(?: $ | [^:\/?\#]+ : )/x) { 574 if ($hdr{location} !~ /^(?: $ | [^:\/?\#]+ : )/x) {
… …
548 } 585 }
549 586
550 my $redirect; 587 my $redirect;
551 588
552 if ($recurse) { 589 if ($recurse) {
553 if ($hdr{Status} =~ /^30[12]$/ && $method ne "POST") { 590 my $status = $hdr{Status};
554 # apparently, mozilla et al. just change POST to GET here 591
555 # more research is needed before we do the same 592 # industry standard is to redirect POST as GET for
556 $redirect = 1; 593 # 301, 302 and 303, in contrast to http/1.0 and 1.1.
557 } elsif ($hdr{Status} == 303) { 594 # also, the UA should ask the user for 301 and 307 and POST,
595 # industry standard seems to be to simply follow.
596 # we go with the industry standard.
597 if ($status == 301 or $status == 302 or $status == 303) {
558 # even http/1.1 is unclear on how to mutate the method 598 # HTTP/1.1 is unclear on how to mutate the method
559 $method = "GET" unless $method eq "HEAD"; 599 $method = "GET" unless $method eq "HEAD";
560 $redirect = 1; 600 $redirect = 1;
561 } elsif ($hdr{Status} == 307 && $method =~ /^(?:GET|HEAD)$/) { 601 } elsif ($status == 307) {
562 $redirect = 1; 602 $redirect = 1;
563 } 603 }
564 } 604 }
565 605
566 my $finish = sub { 606 my $finish = sub {
… …
619 659
620 if ($redirect && exists $hdr{location}) { 660 if ($redirect && exists $hdr{location}) {
621 # we ignore any errors, as it is very common to receive 661 # we ignore any errors, as it is very common to receive
622 # Content-Length != 0 but no actual body 662 # Content-Length != 0 but no actual body
623 # we also access %hdr, as $_[1] might be an erro 663 # we also access %hdr, as $_[1] might be an erro
624 http_request ($method => $hdr{location}, %arg, recurse => $recurse - 1, $cb); 664 http_request (
665 $method => $hdr{location},
666 %arg,
667 recurse => $recurse - 1,
668 Redirect => \@_,
669 $cb);
625 } else { 670 } else {
626 $cb->($_[0], $_[1]); 671 $cb->($_[0], $_[1]);
627 } 672 }
628 }; 673 };
629 674
630 my $len = $hdr{"content-length"}; 675 my $len = $hdr{"content-length"};
631 676
632 if (!$redirect && $arg{on_header} && !$arg{on_header}(\%hdr)) { 677 if (!$redirect && $arg{on_header} && !$arg{on_header}(\%hdr)) {
633 $finish->(undef, { Status => 598, Reason => "Request cancelled by on_header", URL => $url }); 678 $finish->(undef, { Status => 598, Reason => "Request cancelled by on_header", @pseudo });
634 } elsif ( 679 } elsif (
635 $hdr{Status} =~ /^(?:1..|[23]04)$/ 680 $hdr{Status} =~ /^(?:1..|[23]04)$/
636 or $method eq "HEAD" 681 or $method eq "HEAD"
637 or (defined $len && !$len) 682 or (defined $len && !$len)
638 ) { 683 ) {
… …
641 } else { 686 } else {
642 # body handling, four different code paths 687 # body handling, four different code paths
643 # for want_body_handle, on_body (2x), normal (2x) 688 # for want_body_handle, on_body (2x), normal (2x)
644 # we might read too much here, but it does not matter yet (no pers. connections) 689 # we might read too much here, but it does not matter yet (no pers. connections)
645 if (!$redirect && $arg{want_body_handle}) { 690 if (!$redirect && $arg{want_body_handle}) {
646 $_[0]->on_eof (undef); 691 $_[0]->on_eof (undef);
647 $_[0]->on_error (undef); 692 $_[0]->on_error (undef);
648 $_[0]->on_read (undef); 693 $_[0]->on_read (undef);
649 694
650 $finish->(delete $state{handle}, \%hdr); 695 $finish->(delete $state{handle}, \%hdr);
651 696
652 } elsif ($arg{on_body}) { 697 } elsif ($arg{on_body}) {
653 $_[0]->on_error (sub { $finish->(undef, { Status => 599, Reason => $_[2], URL => $url }) }); 698 $_[0]->on_error (sub { $finish->(undef, { Status => 599, Reason => $_[2], @pseudo }) });
654 if ($len) { 699 if ($len) {
655 $_[0]->on_eof (undef); 700 $_[0]->on_eof (undef);
656 $_[0]->on_read (sub { 701 $_[0]->on_read (sub {
657 $len -= length $_[0]{rbuf}; 702 $len -= length $_[0]{rbuf};
658 703
659 $arg{on_body}(delete $_[0]{rbuf}, \%hdr) 704 $arg{on_body}(delete $_[0]{rbuf}, \%hdr)
660 or $finish->(undef, { Status => 598, Reason => "Request cancelled by on_body", URL => $url }); 705 or $finish->(undef, { Status => 598, Reason => "Request cancelled by on_body", @pseudo });
661 706
662 $len > 0 707 $len > 0
663 or $finish->("", \%hdr); 708 or $finish->("", \%hdr);
664 }); 709 });
665 } else { 710 } else {
666 $_[0]->on_eof (sub { 711 $_[0]->on_eof (sub {
667 $finish->("", \%hdr); 712 $finish->("", \%hdr);
668 }); 713 });
669 $_[0]->on_read (sub { 714 $_[0]->on_read (sub {
670 $arg{on_body}(delete $_[0]{rbuf}, \%hdr) 715 $arg{on_body}(delete $_[0]{rbuf}, \%hdr)
671 or $finish->(undef, { Status => 598, Reason => "Request cancelled by on_body", URL => $url }); 716 or $finish->(undef, { Status => 598, Reason => "Request cancelled by on_body", @pseudo });
672 }); 717 });
673 } 718 }
674 } else { 719 } else {
675 $_[0]->on_eof (undef); 720 $_[0]->on_eof (undef);
676 721
677 if ($len) { 722 if ($len) {
678 $_[0]->on_error (sub { $finish->(undef, { Status => 599, Reason => $_[2], URL => $url }) }); 723 $_[0]->on_error (sub { $finish->(undef, { Status => 599, Reason => $_[2], @pseudo }) });
679 $_[0]->on_read (sub { 724 $_[0]->on_read (sub {
680 $finish->((substr delete $_[0]{rbuf}, 0, $len, ""), \%hdr) 725 $finish->((substr delete $_[0]{rbuf}, 0, $len, ""), \%hdr)
681 if $len <= length $_[0]{rbuf}; 726 if $len <= length $_[0]{rbuf};
682 }); 727 });
683 } else { 728 } else {
684 $_[0]->on_error (sub { 729 $_[0]->on_error (sub {
685 $! == Errno::EPIPE || !$! 730 ($! == Errno::EPIPE || !$!)
686 ? $finish->(delete $_[0]{rbuf}, \%hdr) 731 ? $finish->(delete $_[0]{rbuf}, \%hdr)
687 : $finish->(undef, { Status => 599, Reason => $_[2], URL => $url }); 732 : $finish->(undef, { Status => 599, Reason => $_[2], @pseudo });
688 }); 733 });
689 $_[0]->on_read (sub { }); 734 $_[0]->on_read (sub { });
690 } 735 }
691 } 736 }
692 } 737 }
693 }); 738 });
694 }); 739 };
695 };
696 740
697 # now handle proxy-CONNECT method 741 # now handle proxy-CONNECT method
698 if ($proxy && $uscheme eq "https") { 742 if ($proxy && $uscheme eq "https") {
699 # oh dear, we have to wrap it into a connect request 743 # oh dear, we have to wrap it into a connect request
700 744
701 # maybe re-use $uauthority with patched port? 745 # maybe re-use $uauthority with patched port?
702 $state{handle}->push_write ("CONNECT $uhost:$uport HTTP/1.0\015\012Host: $uhost\015\012\015\012"); 746 $state{handle}->push_write ("CONNECT $uhost:$uport HTTP/1.0\015\012Host: $uhost\015\012\015\012");
703 $state{handle}->push_read (line => $qr_nlnl, sub { 747 $state{handle}->push_read (line => $qr_nlnl, sub {
704 $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )?/ix 748 $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )?/ix
705 or return (%state = (), $cb->(undef, { Status => 599, Reason => "Invalid proxy connect response ($_[1])", URL => $url })); 749 or return (%state = (), $cb->(undef, { Status => 599, Reason => "Invalid proxy connect response ($_[1])", @pseudo }));
706 750
707 if ($2 == 200) { 751 if ($2 == 200) {
708 $rpath = $upath; 752 $rpath = $upath;
709 &$handle_actual_request; 753 &$handle_actual_request;
710 } else { 754 } else {
711 %state = (); 755 %state = ();
712 $cb->(undef, { Status => $2, Reason => $3, URL => $url }); 756 $cb->(undef, { Status => $2, Reason => $3, @pseudo });
757 }
713 } 758 });
714 });
715 } else { 759 } else {
716 &$handle_actual_request; 760 &$handle_actual_request;
761 }
762
717 } 763 },
718
719 }, $arg{on_prepare} || sub { $timeout }; 764 $arg{on_prepare} || sub { $timeout }
765 );
720 }; 766 };
721 767
722 defined wantarray && AnyEvent::Util::guard { %state = () } 768 defined wantarray && AnyEvent::Util::guard { %state = () }
723} 769}
724 770
… …
738 &http_request 784 &http_request
739} 785}
740 786
741=back 787=back
742 788
789=head2 DNS CACHING
790
791AnyEvent::HTTP uses the AnyEvent::Socket::tcp_connect function for
792the actual connection, which in turn uses AnyEvent::DNS to resolve
793hostnames. The latter is a simple stub resolver and does no caching
794on its own. If you want DNS caching, you currently have to provide
795your own default resolver (by storing a suitable resolver object in
796C<$AnyEvent::DNS::RESOLVER>).
797
743=head2 GLOBAL FUNCTIONS AND VARIABLES 798=head2 GLOBAL FUNCTIONS AND VARIABLES
744 799
745=over 4 800=over 4
746 801
747=item AnyEvent::HTTP::set_proxy "proxy-url" 802=item AnyEvent::HTTP::set_proxy "proxy-url"
748 803
749Sets the default proxy server to use. The proxy-url must begin with a 804Sets the default proxy server to use. The proxy-url must begin with a
750string of the form C<http://host:port> (optionally C<https:...>). 805string of the form C<http://host:port> (optionally C<https:...>), croaks
806otherwise.
807
808To clear an already-set proxy, use C<undef>.
751 809
752=item $AnyEvent::HTTP::MAX_RECURSE 810=item $AnyEvent::HTTP::MAX_RECURSE
753 811
754The default value for the C<recurse> request parameter (default: C<10>). 812The default value for the C<recurse> request parameter (default: C<10>).
755 813
… …
776=back 834=back
777 835
778=cut 836=cut
779 837
780sub set_proxy($) { 838sub set_proxy($) {
839 if (length $_[0]) {
781 $PROXY = [$2, $3 || 3128, $1] if $_[0] =~ m%^(https?):// ([^:/]+) (?: : (\d*) )?%ix; 840 $_[0] =~ m%^(https?):// ([^:/]+) (?: : (\d*) )?%ix
841 or Carp::croak "$_[0]: invalid proxy URL";
842 $PROXY = [$2, $3 || 3128, $1]
843 } else {
844 undef $PROXY;
845 }
782} 846}
783 847
784# initialise proxy from environment 848# initialise proxy from environment
849eval {
785set_proxy $ENV{http_proxy}; 850 set_proxy $ENV{http_proxy};
851};
786 852
787=head1 SEE ALSO 853=head1 SEE ALSO
788 854
789L<AnyEvent>. 855L<AnyEvent>.
790 856

Diff Legend

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