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.84 by root, Sun Jan 2 05:13:27 2011 UTC vs.
Revision 1.88 by root, Sun Jan 2 20:57:03 2011 UTC

… …
36 36
37=cut 37=cut
38 38
39package AnyEvent::HTTP; 39package AnyEvent::HTTP;
40 40
41use strict; 41use common::sense;
42no warnings;
43 42
44use Errno (); 43use Errno ();
45 44
46use AnyEvent 5.0 (); 45use AnyEvent 5.0 ();
47use AnyEvent::Util (); 46use AnyEvent::Util ();
… …
58our $MAX_PERSISTENT = 8; 57our $MAX_PERSISTENT = 8;
59our $PERSISTENT_TIMEOUT = 2; 58our $PERSISTENT_TIMEOUT = 2;
60our $TIMEOUT = 300; 59our $TIMEOUT = 300;
61 60
62# changing these is evil 61# changing these is evil
63our $MAX_PERSISTENT_PER_HOST = 0; 62our $MAX_PERSISTENT_PER_HOST = 2;
64our $MAX_PER_HOST = 4; 63our $MAX_PER_HOST = 4;
65 64
66our $PROXY; 65our $PROXY;
67our $ACTIVE = 0; 66our $ACTIVE = 0;
68 67
… …
415} 414}
416 415
417# extract cookies from jar 416# extract cookies from jar
418sub cookie_jar_extract($$$$) { 417sub cookie_jar_extract($$$$) {
419 my ($jar, $uscheme, $uhost, $upath) = @_; 418 my ($jar, $uscheme, $uhost, $upath) = @_;
420
421 $uhost = lc $uhost;
422 419
423 %$jar = () if $jar->{version} != 1; 420 %$jar = () if $jar->{version} != 1;
424 421
425 my @cookies; 422 my @cookies;
426 423
… …
609 : return $cb->(undef, { @pseudo, Status => 599, Reason => "Only http and https URL schemes supported" }); 606 : return $cb->(undef, { @pseudo, Status => 599, Reason => "Only http and https URL schemes supported" });
610 607
611 $uauthority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x 608 $uauthority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x
612 or return $cb->(undef, { @pseudo, Status => 599, Reason => "Unparsable URL" }); 609 or return $cb->(undef, { @pseudo, Status => 599, Reason => "Unparsable URL" });
613 610
614 my $uhost = $1; 611 my $uhost = lc $1;
615 $uport = $2 if defined $2; 612 $uport = $2 if defined $2;
616 613
617 $hdr{host} = defined $2 ? "$uhost:$2" : "$uhost" 614 $hdr{host} = defined $2 ? "$uhost:$2" : "$uhost"
618 unless exists $hdr{host}; 615 unless exists $hdr{host};
619 616
… …
638 $rscheme = "http" unless defined $rscheme; 635 $rscheme = "http" unless defined $rscheme;
639 636
640 # don't support https requests over https-proxy transport, 637 # don't support https requests over https-proxy transport,
641 # can't be done with tls as spec'ed, unless you double-encrypt. 638 # can't be done with tls as spec'ed, unless you double-encrypt.
642 $rscheme = "http" if $uscheme eq "https" && $rscheme eq "https"; 639 $rscheme = "http" if $uscheme eq "https" && $rscheme eq "https";
640
641 $rhost = lc $rhost;
642 $rscheme = lc $rscheme;
643 } else { 643 } else {
644 ($rhost, $rport, $rscheme, $rpath) = ($uhost, $uport, $uscheme, $upath); 644 ($rhost, $rport, $rscheme, $rpath) = ($uhost, $uport, $uscheme, $upath);
645 } 645 }
646 646
647 # leave out fragment and query string, just a heuristic 647 # leave out fragment and query string, just a heuristic
… …
649 $hdr{"user-agent"} = $USERAGENT unless exists $hdr{"user-agent"}; 649 $hdr{"user-agent"} = $USERAGENT unless exists $hdr{"user-agent"};
650 650
651 $hdr{"content-length"} = length $arg{body} 651 $hdr{"content-length"} = length $arg{body}
652 if length $arg{body} || $method ne "GET"; 652 if length $arg{body} || $method ne "GET";
653 653
654 $hdr{connection} = "close TE"; #1.1 654 $hdr{connection} = "close Te"; #1.1
655 $hdr{te} = "trailers" unless exists $hdr{te}; #1.1 655 $hdr{te} = "trailers" unless exists $hdr{te}; #1.1
656 656
657 my %state = (connect_guard => 1); 657 my %state = (connect_guard => 1);
658 658
659 _get_slot $uhost, sub {
660 $state{slot_guard} = shift;
661
662 return unless $state{connect_guard};
663
664 my $ae_error = 595; # connecting 659 my $ae_error = 595; # connecting
665 660
666 # handle actual, non-tunneled, request 661 # handle actual, non-tunneled, request
667 my $handle_actual_request = sub { 662 my $handle_actual_request = sub {
668 $ae_error = 596; # request phase 663 $ae_error = 596; # request phase
669 664
670 $state{handle}->starttls ("connect") if $uscheme eq "https" && !exists $state{handle}{tls}; 665 $state{handle}->starttls ("connect") if $uscheme eq "https" && !exists $state{handle}{tls};
671 666
672 # send request 667 # send request
673 $state{handle}->push_write ( 668 $state{handle}->push_write (
674 "$method $rpath HTTP/1.1\015\012" 669 "$method $rpath HTTP/1.1\015\012"
675 . (join "", map "\u$_: $hdr{$_}\015\012", grep defined $hdr{$_}, keys %hdr) 670 . (join "", map "\u$_: $hdr{$_}\015\012", grep defined $hdr{$_}, keys %hdr)
676 . "\015\012" 671 . "\015\012"
677 . (delete $arg{body}) 672 . (delete $arg{body})
678 ); 673 );
679 674
680 # return if error occured during push_write() 675 # return if error occured during push_write()
681 return unless %state; 676 return unless %state;
682 677
683 %hdr = (); # reduce memory usage, save a kitten, also make it possible to re-use 678 %hdr = (); # reduce memory usage, save a kitten, also make it possible to re-use
684 679
685 # status line and headers 680 # status line and headers
686 $state{read_response} = sub { 681 $state{read_response} = sub {
687 for ("$_[1]") { 682 for ("$_[1]") {
688 y/\015//d; # weed out any \015, as they show up in the weirdest of places. 683 y/\015//d; # weed out any \015, as they show up in the weirdest of places.
689 684
690 /^HTTP\/0*([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\012]*) )? \012/gxci 685 /^HTTP\/0*([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\012]*) )? \012/gxci
691 or return (%state = (), $cb->(undef, { @pseudo, Status => 599, Reason => "Invalid server response" })); 686 or return (%state = (), $cb->(undef, { @pseudo, Status => 599, Reason => "Invalid server response" }));
692 687
693 # 100 Continue handling 688 # 100 Continue handling
694 # should not happen as we don't send expect: 100-continue, 689 # should not happen as we don't send expect: 100-continue,
695 # but we handle it just in case. 690 # but we handle it just in case.
696 # since we send the request body regardless, if we get an error 691 # since we send the request body regardless, if we get an error
697 # we are out of-sync, which we currently do NOT handle correctly. 692 # we are out of-sync, which we currently do NOT handle correctly.
698 return $state{handle}->push_read (line => $qr_nlnl, $state{read_response}) 693 return $state{handle}->push_read (line => $qr_nlnl, $state{read_response})
699 if $2 eq 100; 694 if $2 eq 100;
700 695
701 push @pseudo, 696 push @pseudo,
702 HTTPVersion => $1, 697 HTTPVersion => $1,
703 Status => $2, 698 Status => $2,
704 Reason => $3, 699 Reason => $3,
705 ; 700 ;
706 701
707 my $hdr = parse_hdr 702 my $hdr = parse_hdr
708 or return (%state = (), $cb->(undef, { @pseudo, Status => 599, Reason => "Garbled response headers" })); 703 or return (%state = (), $cb->(undef, { @pseudo, Status => 599, Reason => "Garbled response headers" }));
709 704
710 %hdr = (%$hdr, @pseudo); 705 %hdr = (%$hdr, @pseudo);
706 }
707
708 # redirect handling
709 # microsoft and other shitheads don't give a shit for following standards,
710 # try to support some common forms of broken Location headers.
711 if ($hdr{location} !~ /^(?: $ | [^:\/?\#]+ : )/x) {
712 $hdr{location} =~ s/^\.\/+//;
713
714 my $url = "$rscheme://$uhost:$uport";
715
716 unless ($hdr{location} =~ s/^\///) {
717 $url .= $upath;
718 $url =~ s/\/[^\/]*$//;
711 } 719 }
712 720
713 # redirect handling
714 # microsoft and other shitheads don't give a shit for following standards,
715 # try to support some common forms of broken Location headers.
716 if ($hdr{location} !~ /^(?: $ | [^:\/?\#]+ : )/x) {
717 $hdr{location} =~ s/^\.\/+//;
718
719 my $url = "$rscheme://$uhost:$uport";
720
721 unless ($hdr{location} =~ s/^\///) {
722 $url .= $upath;
723 $url =~ s/\/[^\/]*$//;
724 }
725
726 $hdr{location} = "$url/$hdr{location}"; 721 $hdr{location} = "$url/$hdr{location}";
722 }
723
724 my $redirect;
725
726 if ($recurse) {
727 my $status = $hdr{Status};
728
729 # industry standard is to redirect POST as GET for
730 # 301, 302 and 303, in contrast to HTTP/1.0 and 1.1.
731 # also, the UA should ask the user for 301 and 307 and POST,
732 # industry standard seems to be to simply follow.
733 # we go with the industry standard.
734 if ($status == 301 or $status == 302 or $status == 303) {
735 # HTTP/1.1 is unclear on how to mutate the method
736 $method = "GET" unless $method eq "HEAD";
737 $redirect = 1;
738 } elsif ($status == 307) {
739 $redirect = 1;
727 } 740 }
728
729 my $redirect;
730
731 if ($recurse) {
732 my $status = $hdr{Status};
733
734 # industry standard is to redirect POST as GET for
735 # 301, 302 and 303, in contrast to HTTP/1.0 and 1.1.
736 # also, the UA should ask the user for 301 and 307 and POST,
737 # industry standard seems to be to simply follow.
738 # we go with the industry standard.
739 if ($status == 301 or $status == 302 or $status == 303) {
740 # HTTP/1.1 is unclear on how to mutate the method
741 $method = "GET" unless $method eq "HEAD";
742 $redirect = 1;
743 } elsif ($status == 307) {
744 $redirect = 1;
745 } 741 }
742
743 my $finish = sub { # ($data, $err_status, $err_reason[, $keepalive])
744 my $may_keep_alive = $_[3];
745
746 $state{handle}->destroy if $state{handle};
747 %state = ();
748
749 if (defined $_[1]) {
750 $hdr{OrigStatus} = $hdr{Status}; $hdr{Status} = $_[1];
751 $hdr{OrigReason} = $hdr{Reason}; $hdr{Reason} = $_[2];
746 } 752 }
747 753
748 my $finish = sub { # ($data, $err_status, $err_reason[, $keepalive])
749 my $may_keep_alive = $_[3];
750
751 $state{handle}->destroy if $state{handle};
752 %state = ();
753
754 if (defined $_[1]) {
755 $hdr{OrigStatus} = $hdr{Status}; $hdr{Status} = $_[1];
756 $hdr{OrigReason} = $hdr{Reason}; $hdr{Reason} = $_[2];
757 }
758
759 # set-cookie processing 754 # set-cookie processing
760 if ($arg{cookie_jar}) { 755 if ($arg{cookie_jar}) {
761 cookie_jar_set_cookie $arg{cookie_jar}, $hdr{"set-cookie"}, $uhost, $hdr{date}; 756 cookie_jar_set_cookie $arg{cookie_jar}, $hdr{"set-cookie"}, $uhost, $hdr{date};
762 } 757 }
763 758
764 if ($redirect && exists $hdr{location}) { 759 if ($redirect && exists $hdr{location}) {
765 # we ignore any errors, as it is very common to receive 760 # we ignore any errors, as it is very common to receive
766 # Content-Length != 0 but no actual body 761 # Content-Length != 0 but no actual body
767 # we also access %hdr, as $_[1] might be an erro 762 # we also access %hdr, as $_[1] might be an erro
768 http_request ( 763 http_request (
769 $method => $hdr{location}, 764 $method => $hdr{location},
770 %arg, 765 %arg,
771 recurse => $recurse - 1, 766 recurse => $recurse - 1,
772 Redirect => [$_[0], \%hdr], 767 Redirect => [$_[0], \%hdr],
773 $cb); 768 $cb);
769 } else {
770 $cb->($_[0], \%hdr);
771 }
772 };
773
774 $ae_error = 597; # body phase
775
776 my $len = $hdr{"content-length"};
777
778 # body handling, many different code paths
779 # - no body expected
780 # - want_body_handle
781 # - te chunked
782 # - 2x length known (with or without on_body)
783 # - 2x length not known (with or without on_body)
784 if (!$redirect && $arg{on_header} && !$arg{on_header}(\%hdr)) {
785 $finish->(undef, 598 => "Request cancelled by on_header");
786 } elsif (
787 $hdr{Status} =~ /^(?:1..|204|205|304)$/
788 or $method eq "HEAD"
789 or (defined $len && $len == 0) # == 0, not !, because "0 " is true
790 ) {
791 # no body
792 $finish->("", undef, undef, 1);
793
794 } elsif (!$redirect && $arg{want_body_handle}) {
795 $_[0]->on_eof (undef);
796 $_[0]->on_error (undef);
797 $_[0]->on_read (undef);
798
799 $finish->(delete $state{handle});
800
801 } elsif ($hdr{"transfer-encoding"} =~ /\bchunked\b/i) {
802 my $cl = 0;
803 my $body = undef;
804 my $on_body = $arg{on_body} || sub { $body .= shift; 1 };
805
806 $state{read_chunk} = sub {
807 $_[1] =~ /^([0-9a-fA-F]+)/
808 or $finish->(undef, $ae_error => "Garbled chunked transfer encoding");
809
810 my $len = hex $1;
811
812 if ($len) {
813 $cl += $len;
814
815 $_[0]->push_read (chunk => $len, sub {
816 $on_body->($_[1], \%hdr)
817 or return $finish->(undef, 598 => "Request cancelled by on_body");
818
819 $_[0]->push_read (line => sub {
820 length $_[1]
821 and return $finish->(undef, $ae_error => "Garbled chunked transfer encoding");
822 $_[0]->push_read (line => $state{read_chunk});
823 });
824 });
774 } else { 825 } else {
775 $cb->($_[0], \%hdr); 826 $hdr{"content-length"} ||= $cl;
827
828 $_[0]->push_read (line => $qr_nlnl, sub {
829 if (length $_[1]) {
830 for ("$_[1]") {
831 y/\015//d; # weed out any \015, as they show up in the weirdest of places.
832
833 my $hdr = parse_hdr
834 or return $finish->(undef, $ae_error => "Garbled response trailers");
835
836 %hdr = (%hdr, %$hdr);
837 }
838 }
839
840 $finish->($body, undef, undef, 1);
841 });
776 } 842 }
777 }; 843 };
778 844
779 $ae_error = 597; # body phase
780
781 my $len = $hdr{"content-length"};
782 warn "no content $redirect x<$len>$hdr{Status}\n";#d#
783
784 # body handling, many different code paths
785 # - no body expected
786 # - want_body_handle
787 # - te chunked
788 # - 2x length known (with or without on_body)
789 # - 2x length not known (with or without on_body)
790 if (!$redirect && $arg{on_header} && !$arg{on_header}(\%hdr)) {
791 $finish->(undef, 598 => "Request cancelled by on_header");
792 } elsif (
793 $hdr{Status} =~ /^(?:1..|204|205|304)$/
794 or $method eq "HEAD"
795 or (defined $len && $len == 0) # == 0, not !, because "0 " is true
796 ) {
797 # no body
798 $finish->("", undef, undef, 1);
799
800 } elsif (!$redirect && $arg{want_body_handle}) {
801 $_[0]->on_eof (undef);
802 $_[0]->on_error (undef);
803 $_[0]->on_read (undef);
804
805 $finish->(delete $state{handle});
806
807 } elsif ($hdr{"transfer-encoding"} =~ /\bchunked\b/i) {
808 my $cl = 0;
809 my $body = undef;
810 my $on_body = $arg{on_body} || sub { $body .= shift; 1 };
811
812 $state{read_chunk} = sub {
813 $_[1] =~ /^([0-9a-fA-F]+)/
814 or $finish->(undef, $ae_error => "Garbled chunked transfer encoding");
815
816 my $len = hex $1;
817
818 if ($len) {
819 $cl += $len;
820
821 $_[0]->push_read (chunk => $len, sub {
822 $on_body->($_[1], \%hdr)
823 or return $finish->(undef, 598 => "Request cancelled by on_body");
824
825 $_[0]->push_read (line => sub {
826 length $_[1]
827 and return $finish->(undef, $ae_error => "Garbled chunked transfer encoding");
828 $_[0]->push_read (line => $state{read_chunk});
829 });
830 });
831 } else {
832 $hdr{"content-length"} ||= $cl;
833
834 $_[0]->push_read (line => $qr_nlnl, sub {
835 if (length $_[1]) {
836 for ("$_[1]") {
837 y/\015//d; # weed out any \015, as they show up in the weirdest of places.
838
839 my $hdr = parse_hdr
840 or return $finish->(undef, $ae_error => "Garbled response trailers");
841
842 %hdr = (%hdr, %$hdr);
843 }
844 }
845
846 $finish->($body, undef, undef, 1);
847 });
848 }
849 };
850
851 $_[0]->push_read (line => $state{read_chunk}); 845 $_[0]->push_read (line => $state{read_chunk});
852 846
853 } elsif ($arg{on_body}) { 847 } elsif ($arg{on_body}) {
854 if (defined $len) { 848 if (defined $len) {
855 $_[0]->on_read (sub { 849 $_[0]->on_read (sub {
856 $len -= length $_[0]{rbuf}; 850 $len -= length $_[0]{rbuf};
857 851
858 $arg{on_body}(delete $_[0]{rbuf}, \%hdr) 852 $arg{on_body}(delete $_[0]{rbuf}, \%hdr)
859 or return $finish->(undef, 598 => "Request cancelled by on_body"); 853 or return $finish->(undef, 598 => "Request cancelled by on_body");
860 854
861 $len > 0 855 $len > 0
862 or $finish->("", undef, undef, 1); 856 or $finish->("", undef, undef, 1);
863 });
864 } else {
865 $_[0]->on_eof (sub {
866 $finish->("");
867 });
868 $_[0]->on_read (sub {
869 $arg{on_body}(delete $_[0]{rbuf}, \%hdr)
870 or $finish->(undef, 598 => "Request cancelled by on_body");
871 });
872 } 857 });
873 } else { 858 } else {
874 $_[0]->on_eof (undef); 859 $_[0]->on_eof (sub {
875 860 $finish->("");
876 if (defined $len) { 861 });
877 $_[0]->on_read (sub { 862 $_[0]->on_read (sub {
878 $finish->((substr delete $_[0]{rbuf}, 0, $len, ""), undef, undef, 1) 863 $arg{on_body}(delete $_[0]{rbuf}, \%hdr)
879 if $len <= length $_[0]{rbuf}; 864 or $finish->(undef, 598 => "Request cancelled by on_body");
880 });
881 } else {
882 $_[0]->on_error (sub {
883 ($! == Errno::EPIPE || !$!)
884 ? $finish->(delete $_[0]{rbuf})
885 : $finish->(undef, $ae_error => $_[2]);
886 });
887 $_[0]->on_read (sub { });
888 } 865 });
889 } 866 }
867 } else {
868 $_[0]->on_eof (undef);
869
870 if (defined $len) {
871 $_[0]->on_read (sub {
872 $finish->((substr delete $_[0]{rbuf}, 0, $len, ""), undef, undef, 1)
873 if $len <= length $_[0]{rbuf};
874 });
875 } else {
876 $_[0]->on_error (sub {
877 ($! == Errno::EPIPE || !$!)
878 ? $finish->(delete $_[0]{rbuf})
879 : $finish->(undef, $ae_error => $_[2]);
880 });
881 $_[0]->on_read (sub { });
882 }
883 }
884 };
885
886 $state{handle}->push_read (line => $qr_nlnl, $state{read_response});
887 };
888
889 my $connect_cb = sub {
890 $state{fh} = shift
891 or do {
892 my $err = "$!";
893 %state = ();
894 return $cb->(undef, { @pseudo, Status => $ae_error, Reason => $err });
890 }; 895 };
891 896
892 $state{handle}->push_read (line => $qr_nlnl, $state{read_response});
893 };
894
895 my $connect_cb = sub {
896 $state{fh} = shift
897 or do {
898 my $err = "$!";
899 %state = ();
900 return $cb->(undef, { @pseudo, Status => $ae_error, Reason => $err });
901 };
902
903 return unless delete $state{connect_guard}; 897 return unless delete $state{connect_guard};
904 898
905 # get handle 899 # get handle
906 $state{handle} = new AnyEvent::Handle 900 $state{handle} = new AnyEvent::Handle
907 fh => $state{fh}, 901 fh => $state{fh},
908 peername => $rhost, 902 peername => $rhost,
909 tls_ctx => $arg{tls_ctx}, 903 tls_ctx => $arg{tls_ctx},
910 # these need to be reconfigured on keepalive handles 904 # these need to be reconfigured on keepalive handles
911 timeout => $timeout, 905 timeout => $timeout,
912 on_error => sub { 906 on_error => sub {
913 %state = (); 907 %state = ();
914 $cb->(undef, { @pseudo, Status => $ae_error, Reason => $_[2] }); 908 $cb->(undef, { @pseudo, Status => $ae_error, Reason => $_[2] });
915 }, 909 },
916 on_eof => sub { 910 on_eof => sub {
917 %state = (); 911 %state = ();
918 $cb->(undef, { @pseudo, Status => $ae_error, Reason => "Unexpected end-of-file" }); 912 $cb->(undef, { @pseudo, Status => $ae_error, Reason => "Unexpected end-of-file" });
919 }, 913 },
920 ; 914 ;
921 915
922 # limit the number of persistent connections 916 # limit the number of persistent connections
923 # keepalive not yet supported 917 # keepalive not yet supported
924# if ($KA_COUNT{$_[1]} < $MAX_PERSISTENT_PER_HOST) { 918# if ($KA_COUNT{$_[1]} < $MAX_PERSISTENT_PER_HOST) {
925# ++$KA_COUNT{$_[1]}; 919# ++$KA_COUNT{$_[1]};
926# $state{handle}{ka_count_guard} = AnyEvent::Util::guard { 920# $state{handle}{ka_count_guard} = AnyEvent::Util::guard {
927# --$KA_COUNT{$_[1]} 921# --$KA_COUNT{$_[1]}
928# }; 922# };
929# $hdr{connection} = "keep-alive"; 923# $hdr{connection} = "keep-alive";
930# } 924# }
931 925
932 $state{handle}->starttls ("connect") if $rscheme eq "https"; 926 $state{handle}->starttls ("connect") if $rscheme eq "https";
933 927
934 # now handle proxy-CONNECT method 928 # now handle proxy-CONNECT method
935 if ($proxy && $uscheme eq "https") { 929 if ($proxy && $uscheme eq "https") {
936 # oh dear, we have to wrap it into a connect request 930 # oh dear, we have to wrap it into a connect request
937 931
938 # maybe re-use $uauthority with patched port? 932 # maybe re-use $uauthority with patched port?
939 $state{handle}->push_write ("CONNECT $uhost:$uport HTTP/1.0\015\012Host: $uhost\015\012\015\012"); 933 $state{handle}->push_write ("CONNECT $uhost:$uport HTTP/1.0\015\012\015\012");
940 $state{handle}->push_read (line => $qr_nlnl, sub { 934 $state{handle}->push_read (line => $qr_nlnl, sub {
941 $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )?/ix 935 $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )?/ix
942 or return (%state = (), $cb->(undef, { @pseudo, Status => 599, Reason => "Invalid proxy connect response ($_[1])" })); 936 or return (%state = (), $cb->(undef, { @pseudo, Status => 599, Reason => "Invalid proxy connect response ($_[1])" }));
943 937
944 if ($2 == 200) { 938 if ($2 == 200) {
945 $rpath = $upath; 939 $rpath = $upath;
946 $handle_actual_request->(); 940 $handle_actual_request->();
947 } else { 941 } else {
948 %state = (); 942 %state = ();
949 $cb->(undef, { @pseudo, Status => $2, Reason => $3 }); 943 $cb->(undef, { @pseudo, Status => $2, Reason => $3 });
950 }
951 }); 944 }
945 });
952 } else { 946 } else {
953 $handle_actual_request->(); 947 $handle_actual_request->();
954 }
955 }; 948 }
949 };
950
951 _get_slot $uhost, sub {
952 $state{slot_guard} = shift;
953
954 return unless $state{connect_guard};
956 955
957 my $tcp_connect = $arg{tcp_connect} 956 my $tcp_connect = $arg{tcp_connect}
958 || do { require AnyEvent::Socket; \&AnyEvent::Socket::tcp_connect }; 957 || do { require AnyEvent::Socket; \&AnyEvent::Socket::tcp_connect };
959 958
960 $state{connect_guard} = $tcp_connect->($rhost, $rport, $connect_cb, $arg{on_prepare} || sub { $timeout }); 959 $state{connect_guard} = $tcp_connect->($rhost, $rport, $connect_cb, $arg{on_prepare} || sub { $timeout });

Diff Legend

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