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.82 by root, Sun Jan 2 04:50:40 2011 UTC vs.
Revision 1.87 by root, Sun Jan 2 08:51:53 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 ();
… …
530 $cdom = $uhost; 529 $cdom = $uhost;
531 } 530 }
532 531
533 # store it 532 # store it
534 $jar->{version} = 1; 533 $jar->{version} = 1;
535 $jar->{$cdom}{$cpath}{$name} = \%kv; 534 $jar->{lc $cdom}{$cpath}{$name} = \%kv;
536 535
537 redo if /\G\s*,/gc; 536 redo if /\G\s*,/gc;
538 } 537 }
539} 538}
540 539
… …
607 : 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" });
608 607
609 $uauthority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x 608 $uauthority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x
610 or return $cb->(undef, { @pseudo, Status => 599, Reason => "Unparsable URL" }); 609 or return $cb->(undef, { @pseudo, Status => 599, Reason => "Unparsable URL" });
611 610
612 my $uhost = $1; 611 my $uhost = lc $1;
613 $uport = $2 if defined $2; 612 $uport = $2 if defined $2;
614 613
615 $hdr{host} = defined $2 ? "$uhost:$2" : "$uhost" 614 $hdr{host} = defined $2 ? "$uhost:$2" : "$uhost"
616 unless exists $hdr{host}; 615 unless exists $hdr{host};
617 616
… …
636 $rscheme = "http" unless defined $rscheme; 635 $rscheme = "http" unless defined $rscheme;
637 636
638 # don't support https requests over https-proxy transport, 637 # don't support https requests over https-proxy transport,
639 # 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.
640 $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;
641 } else { 643 } else {
642 ($rhost, $rport, $rscheme, $rpath) = ($uhost, $uport, $uscheme, $upath); 644 ($rhost, $rport, $rscheme, $rpath) = ($uhost, $uport, $uscheme, $upath);
643 } 645 }
644 646
645 # leave out fragment and query string, just a heuristic 647 # leave out fragment and query string, just a heuristic
… …
647 $hdr{"user-agent"} = $USERAGENT unless exists $hdr{"user-agent"}; 649 $hdr{"user-agent"} = $USERAGENT unless exists $hdr{"user-agent"};
648 650
649 $hdr{"content-length"} = length $arg{body} 651 $hdr{"content-length"} = length $arg{body}
650 if length $arg{body} || $method ne "GET"; 652 if length $arg{body} || $method ne "GET";
651 653
652 $hdr{connection} = "close TE"; #1.1 654 $hdr{connection} = "close Te"; #1.1
653 $hdr{te} = "trailers" unless exists $hdr{te}; #1.1 655 $hdr{te} = "trailers" unless exists $hdr{te}; #1.1
654 656
655 my %state = (connect_guard => 1); 657 my %state = (connect_guard => 1);
656 658
657 _get_slot $uhost, sub { 659 _get_slot $uhost, sub {
… …
776 778
777 $ae_error = 597; # body phase 779 $ae_error = 597; # body phase
778 780
779 my $len = $hdr{"content-length"}; 781 my $len = $hdr{"content-length"};
780 782
783 # body handling, many different code paths
784 # - no body expected
785 # - want_body_handle
786 # - te chunked
787 # - 2x length known (with or without on_body)
788 # - 2x length not known (with or without on_body)
781 if (!$redirect && $arg{on_header} && !$arg{on_header}(\%hdr)) { 789 if (!$redirect && $arg{on_header} && !$arg{on_header}(\%hdr)) {
782 $finish->(undef, 598 => "Request cancelled by on_header"); 790 $finish->(undef, 598 => "Request cancelled by on_header");
783 } elsif ( 791 } elsif (
784 $hdr{Status} =~ /^(?:1..|204|205|304)$/ 792 $hdr{Status} =~ /^(?:1..|204|205|304)$/
785 or $method eq "HEAD" 793 or $method eq "HEAD"
786 or (defined $len && !$len) 794 or (defined $len && $len == 0) # == 0, not !, because "0 " is true
787 ) { 795 ) {
788 # no body 796 # no body
789 $finish->("", undef, undef, 1); 797 $finish->("", undef, undef, 1);
790 } else { 798
791 # body handling, many different code paths
792 # - no body expected
793 # - want_body_handle
794 # - te chunked
795 # - 2x length known (with or without on_body)
796 # - 2x length not known (with or without on_body)
797 if (!$redirect && $arg{want_body_handle}) { 799 } elsif (!$redirect && $arg{want_body_handle}) {
798 $_[0]->on_eof (undef); 800 $_[0]->on_eof (undef);
799 $_[0]->on_error (undef); 801 $_[0]->on_error (undef);
800 $_[0]->on_read (undef); 802 $_[0]->on_read (undef);
801 803
802 $finish->(delete $state{handle}); 804 $finish->(delete $state{handle});
803 805
804 } elsif ($hdr{"transfer-encoding"} =~ /\bchunked\b/i) { 806 } elsif ($hdr{"transfer-encoding"} =~ /\bchunked\b/i) {
805 my $cl = 0; 807 my $cl = 0;
806 my $body = undef; 808 my $body = undef;
807 my $on_body = $arg{on_body} || sub { $body .= shift; 1 }; 809 my $on_body = $arg{on_body} || sub { $body .= shift; 1 };
808 810
809 $state{read_chunk} = sub { 811 $state{read_chunk} = sub {
810 $_[1] =~ /^([0-9a-fA-F]+)/ 812 $_[1] =~ /^([0-9a-fA-F]+)/
811 or $finish->(undef, $ae_error => "Garbled chunked transfer encoding"); 813 or $finish->(undef, $ae_error => "Garbled chunked transfer encoding");
812 814
813 my $len = hex $1; 815 my $len = hex $1;
814 816
815 if ($len) { 817 if ($len) {
816 $cl += $len; 818 $cl += $len;
817 819
818 $_[0]->push_read (chunk => $len, sub { 820 $_[0]->push_read (chunk => $len, sub {
819 $on_body->($_[1], \%hdr) 821 $on_body->($_[1], \%hdr)
820 or return $finish->(undef, 598 => "Request cancelled by on_body"); 822 or return $finish->(undef, 598 => "Request cancelled by on_body");
821 823
822 $_[0]->push_read (line => sub { 824 $_[0]->push_read (line => sub {
823 length $_[1] 825 length $_[1]
824 and return $finish->(undef, $ae_error => "Garbled chunked transfer encoding"); 826 and return $finish->(undef, $ae_error => "Garbled chunked transfer encoding");
825 $_[0]->push_read (line => $state{read_chunk}); 827 $_[0]->push_read (line => $state{read_chunk});
826 });
827 }); 828 });
828 } else {
829 $hdr{"content-length"} ||= $cl;
830
831 $_[0]->push_read (line => $qr_nlnl, sub {
832 if (length $_[1]) {
833 for ("$_[1]") {
834 y/\015//d; # weed out any \015, as they show up in the weirdest of places.
835
836 my $hdr = parse_hdr
837 or return $finish->(undef, $ae_error => "Garbled response trailers");
838
839 %hdr = (%hdr, %$hdr);
840 }
841 }
842
843 $finish->($body, undef, undef, 1);
844 });
845 }
846 };
847
848 $_[0]->push_read (line => $state{read_chunk});
849
850 } elsif ($arg{on_body}) {
851 if ($len) {
852 $_[0]->on_read (sub {
853 $len -= length $_[0]{rbuf};
854
855 $arg{on_body}(delete $_[0]{rbuf}, \%hdr)
856 or return $finish->(undef, 598 => "Request cancelled by on_body");
857
858 $len > 0
859 or $finish->("", undef, undef, 1);
860 }); 829 });
861 } else { 830 } else {
862 $_[0]->on_eof (sub { 831 $hdr{"content-length"} ||= $cl;
863 $finish->(""); 832
833 $_[0]->push_read (line => $qr_nlnl, sub {
834 if (length $_[1]) {
835 for ("$_[1]") {
836 y/\015//d; # weed out any \015, as they show up in the weirdest of places.
837
838 my $hdr = parse_hdr
839 or return $finish->(undef, $ae_error => "Garbled response trailers");
840
841 %hdr = (%hdr, %$hdr);
842 }
864 }); 843 }
865 $_[0]->on_read (sub { 844
866 $arg{on_body}(delete $_[0]{rbuf}, \%hdr) 845 $finish->($body, undef, undef, 1);
867 or $finish->(undef, 598 => "Request cancelled by on_body");
868 }); 846 });
869 } 847 }
848 };
849
850 $_[0]->push_read (line => $state{read_chunk});
851
852 } elsif ($arg{on_body}) {
853 if (defined $len) {
854 $_[0]->on_read (sub {
855 $len -= length $_[0]{rbuf};
856
857 $arg{on_body}(delete $_[0]{rbuf}, \%hdr)
858 or return $finish->(undef, 598 => "Request cancelled by on_body");
859
860 $len > 0
861 or $finish->("", undef, undef, 1);
862 });
870 } else { 863 } else {
871 $_[0]->on_eof (undef); 864 $_[0]->on_eof (sub {
872 865 $finish->("");
873 if ($len) { 866 });
874 $_[0]->on_read (sub { 867 $_[0]->on_read (sub {
868 $arg{on_body}(delete $_[0]{rbuf}, \%hdr)
869 or $finish->(undef, 598 => "Request cancelled by on_body");
870 });
871 }
872 } else {
873 $_[0]->on_eof (undef);
874
875 if (defined $len) {
876 $_[0]->on_read (sub {
875 $finish->((substr delete $_[0]{rbuf}, 0, $len, ""), undef, undef, 1) 877 $finish->((substr delete $_[0]{rbuf}, 0, $len, ""), undef, undef, 1)
876 if $len <= length $_[0]{rbuf}; 878 if $len <= length $_[0]{rbuf};
877 }); 879 });
878 } else { 880 } else {
879 $_[0]->on_error (sub { 881 $_[0]->on_error (sub {
880 ($! == Errno::EPIPE || !$!) 882 ($! == Errno::EPIPE || !$!)
881 ? $finish->(delete $_[0]{rbuf}) 883 ? $finish->(delete $_[0]{rbuf})
882 : $finish->(undef, $ae_error => $_[2]); 884 : $finish->(undef, $ae_error => $_[2]);
883 }); 885 });
884 $_[0]->on_read (sub { }); 886 $_[0]->on_read (sub { });
885 }
886 } 887 }
887 } 888 }
888 }; 889 };
889 890
890 $state{handle}->push_read (line => $qr_nlnl, $state{read_response}); 891 $state{handle}->push_read (line => $qr_nlnl, $state{read_response});
… …
932 # now handle proxy-CONNECT method 933 # now handle proxy-CONNECT method
933 if ($proxy && $uscheme eq "https") { 934 if ($proxy && $uscheme eq "https") {
934 # oh dear, we have to wrap it into a connect request 935 # oh dear, we have to wrap it into a connect request
935 936
936 # maybe re-use $uauthority with patched port? 937 # maybe re-use $uauthority with patched port?
937 $state{handle}->push_write ("CONNECT $uhost:$uport HTTP/1.0\015\012Host: $uhost\015\012\015\012"); 938 $state{handle}->push_write ("CONNECT $uhost:$uport HTTP/1.0\015\012\015\012");
938 $state{handle}->push_read (line => $qr_nlnl, sub { 939 $state{handle}->push_read (line => $qr_nlnl, sub {
939 $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )?/ix 940 $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )?/ix
940 or return (%state = (), $cb->(undef, { @pseudo, Status => 599, Reason => "Invalid proxy connect response ($_[1])" })); 941 or return (%state = (), $cb->(undef, { @pseudo, Status => 599, Reason => "Invalid proxy connect response ($_[1])" }));
941 942
942 if ($2 == 200) { 943 if ($2 == 200) {

Diff Legend

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