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.84 by root, Sun Jan 2 05:13:27 2011 UTC

… …
415} 415}
416 416
417# extract cookies from jar 417# extract cookies from jar
418sub cookie_jar_extract($$$$) { 418sub cookie_jar_extract($$$$) {
419 my ($jar, $uscheme, $uhost, $upath) = @_; 419 my ($jar, $uscheme, $uhost, $upath) = @_;
420
421 $uhost = lc $uhost;
420 422
421 %$jar = () if $jar->{version} != 1; 423 %$jar = () if $jar->{version} != 1;
422 424
423 my @cookies; 425 my @cookies;
424 426
… …
530 $cdom = $uhost; 532 $cdom = $uhost;
531 } 533 }
532 534
533 # store it 535 # store it
534 $jar->{version} = 1; 536 $jar->{version} = 1;
535 $jar->{$cdom}{$cpath}{$name} = \%kv; 537 $jar->{lc $cdom}{$cpath}{$name} = \%kv;
536 538
537 redo if /\G\s*,/gc; 539 redo if /\G\s*,/gc;
538 } 540 }
539} 541}
540 542
… …
775 }; 777 };
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"};
782 warn "no content $redirect x<$len>$hdr{Status}\n";#d#
780 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)
781 if (!$redirect && $arg{on_header} && !$arg{on_header}(\%hdr)) { 790 if (!$redirect && $arg{on_header} && !$arg{on_header}(\%hdr)) {
782 $finish->(undef, 598 => "Request cancelled by on_header"); 791 $finish->(undef, 598 => "Request cancelled by on_header");
783 } elsif ( 792 } elsif (
784 $hdr{Status} =~ /^(?:1..|204|205|304)$/ 793 $hdr{Status} =~ /^(?:1..|204|205|304)$/
785 or $method eq "HEAD" 794 or $method eq "HEAD"
786 or (defined $len && !$len) 795 or (defined $len && $len == 0) # == 0, not !, because "0 " is true
787 ) { 796 ) {
788 # no body 797 # no body
789 $finish->("", undef, undef, 1); 798 $finish->("", undef, undef, 1);
790 } else { 799
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}) { 800 } elsif (!$redirect && $arg{want_body_handle}) {
798 $_[0]->on_eof (undef); 801 $_[0]->on_eof (undef);
799 $_[0]->on_error (undef); 802 $_[0]->on_error (undef);
800 $_[0]->on_read (undef); 803 $_[0]->on_read (undef);
801 804
802 $finish->(delete $state{handle}); 805 $finish->(delete $state{handle});
803 806
804 } elsif ($hdr{"transfer-encoding"} =~ /\bchunked\b/i) { 807 } elsif ($hdr{"transfer-encoding"} =~ /\bchunked\b/i) {
805 my $cl = 0; 808 my $cl = 0;
806 my $body = undef; 809 my $body = undef;
807 my $on_body = $arg{on_body} || sub { $body .= shift; 1 }; 810 my $on_body = $arg{on_body} || sub { $body .= shift; 1 };
808 811
809 $state{read_chunk} = sub { 812 $state{read_chunk} = sub {
810 $_[1] =~ /^([0-9a-fA-F]+)/ 813 $_[1] =~ /^([0-9a-fA-F]+)/
811 or $finish->(undef, $ae_error => "Garbled chunked transfer encoding"); 814 or $finish->(undef, $ae_error => "Garbled chunked transfer encoding");
812 815
813 my $len = hex $1; 816 my $len = hex $1;
814 817
815 if ($len) { 818 if ($len) {
816 $cl += $len; 819 $cl += $len;
817 820
818 $_[0]->push_read (chunk => $len, sub { 821 $_[0]->push_read (chunk => $len, sub {
819 $on_body->($_[1], \%hdr) 822 $on_body->($_[1], \%hdr)
820 or return $finish->(undef, 598 => "Request cancelled by on_body"); 823 or return $finish->(undef, 598 => "Request cancelled by on_body");
821 824
822 $_[0]->push_read (line => sub { 825 $_[0]->push_read (line => sub {
823 length $_[1] 826 length $_[1]
824 and return $finish->(undef, $ae_error => "Garbled chunked transfer encoding"); 827 and return $finish->(undef, $ae_error => "Garbled chunked transfer encoding");
825 $_[0]->push_read (line => $state{read_chunk}); 828 $_[0]->push_read (line => $state{read_chunk});
826 });
827 }); 829 });
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 }); 830 });
861 } else { 831 } else {
862 $_[0]->on_eof (sub { 832 $hdr{"content-length"} ||= $cl;
863 $finish->(""); 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 }
864 }); 844 }
865 $_[0]->on_read (sub { 845
866 $arg{on_body}(delete $_[0]{rbuf}, \%hdr) 846 $finish->($body, undef, undef, 1);
867 or $finish->(undef, 598 => "Request cancelled by on_body");
868 }); 847 });
869 } 848 }
849 };
850
851 $_[0]->push_read (line => $state{read_chunk});
852
853 } elsif ($arg{on_body}) {
854 if (defined $len) {
855 $_[0]->on_read (sub {
856 $len -= length $_[0]{rbuf};
857
858 $arg{on_body}(delete $_[0]{rbuf}, \%hdr)
859 or return $finish->(undef, 598 => "Request cancelled by on_body");
860
861 $len > 0
862 or $finish->("", undef, undef, 1);
863 });
870 } else { 864 } else {
871 $_[0]->on_eof (undef); 865 $_[0]->on_eof (sub {
872 866 $finish->("");
873 if ($len) { 867 });
874 $_[0]->on_read (sub { 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 }
873 } else {
874 $_[0]->on_eof (undef);
875
876 if (defined $len) {
877 $_[0]->on_read (sub {
875 $finish->((substr delete $_[0]{rbuf}, 0, $len, ""), undef, undef, 1) 878 $finish->((substr delete $_[0]{rbuf}, 0, $len, ""), undef, undef, 1)
876 if $len <= length $_[0]{rbuf}; 879 if $len <= length $_[0]{rbuf};
877 }); 880 });
878 } else { 881 } else {
879 $_[0]->on_error (sub { 882 $_[0]->on_error (sub {
880 ($! == Errno::EPIPE || !$!) 883 ($! == Errno::EPIPE || !$!)
881 ? $finish->(delete $_[0]{rbuf}) 884 ? $finish->(delete $_[0]{rbuf})
882 : $finish->(undef, $ae_error => $_[2]); 885 : $finish->(undef, $ae_error => $_[2]);
883 }); 886 });
884 $_[0]->on_read (sub { }); 887 $_[0]->on_read (sub { });
885 }
886 } 888 }
887 } 889 }
888 }; 890 };
889 891
890 $state{handle}->push_read (line => $qr_nlnl, $state{read_response}); 892 $state{handle}->push_read (line => $qr_nlnl, $state{read_response});

Diff Legend

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