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.85 by root, Sun Jan 2 05:31:56 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 ();
… …
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) = @_;
419
420 $uhost = lc $uhost;
420 421
421 %$jar = () if $jar->{version} != 1; 422 %$jar = () if $jar->{version} != 1;
422 423
423 my @cookies; 424 my @cookies;
424 425
… …
530 $cdom = $uhost; 531 $cdom = $uhost;
531 } 532 }
532 533
533 # store it 534 # store it
534 $jar->{version} = 1; 535 $jar->{version} = 1;
535 $jar->{$cdom}{$cpath}{$name} = \%kv; 536 $jar->{lc $cdom}{$cpath}{$name} = \%kv;
536 537
537 redo if /\G\s*,/gc; 538 redo if /\G\s*,/gc;
538 } 539 }
539} 540}
540 541
… …
776 777
777 $ae_error = 597; # body phase 778 $ae_error = 597; # body phase
778 779
779 my $len = $hdr{"content-length"}; 780 my $len = $hdr{"content-length"};
780 781
782 # body handling, many different code paths
783 # - no body expected
784 # - want_body_handle
785 # - te chunked
786 # - 2x length known (with or without on_body)
787 # - 2x length not known (with or without on_body)
781 if (!$redirect && $arg{on_header} && !$arg{on_header}(\%hdr)) { 788 if (!$redirect && $arg{on_header} && !$arg{on_header}(\%hdr)) {
782 $finish->(undef, 598 => "Request cancelled by on_header"); 789 $finish->(undef, 598 => "Request cancelled by on_header");
783 } elsif ( 790 } elsif (
784 $hdr{Status} =~ /^(?:1..|204|205|304)$/ 791 $hdr{Status} =~ /^(?:1..|204|205|304)$/
785 or $method eq "HEAD" 792 or $method eq "HEAD"
786 or (defined $len && !$len) 793 or (defined $len && $len == 0) # == 0, not !, because "0 " is true
787 ) { 794 ) {
788 # no body 795 # no body
789 $finish->("", undef, undef, 1); 796 $finish->("", undef, undef, 1);
790 } else { 797
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}) { 798 } elsif (!$redirect && $arg{want_body_handle}) {
798 $_[0]->on_eof (undef); 799 $_[0]->on_eof (undef);
799 $_[0]->on_error (undef); 800 $_[0]->on_error (undef);
800 $_[0]->on_read (undef); 801 $_[0]->on_read (undef);
801 802
802 $finish->(delete $state{handle}); 803 $finish->(delete $state{handle});
803 804
804 } elsif ($hdr{"transfer-encoding"} =~ /\bchunked\b/i) { 805 } elsif ($hdr{"transfer-encoding"} =~ /\bchunked\b/i) {
805 my $cl = 0; 806 my $cl = 0;
806 my $body = undef; 807 my $body = undef;
807 my $on_body = $arg{on_body} || sub { $body .= shift; 1 }; 808 my $on_body = $arg{on_body} || sub { $body .= shift; 1 };
808 809
809 $state{read_chunk} = sub { 810 $state{read_chunk} = sub {
810 $_[1] =~ /^([0-9a-fA-F]+)/ 811 $_[1] =~ /^([0-9a-fA-F]+)/
811 or $finish->(undef, $ae_error => "Garbled chunked transfer encoding"); 812 or $finish->(undef, $ae_error => "Garbled chunked transfer encoding");
812 813
813 my $len = hex $1; 814 my $len = hex $1;
814 815
815 if ($len) { 816 if ($len) {
816 $cl += $len; 817 $cl += $len;
817 818
818 $_[0]->push_read (chunk => $len, sub { 819 $_[0]->push_read (chunk => $len, sub {
819 $on_body->($_[1], \%hdr) 820 $on_body->($_[1], \%hdr)
820 or return $finish->(undef, 598 => "Request cancelled by on_body"); 821 or return $finish->(undef, 598 => "Request cancelled by on_body");
821 822
822 $_[0]->push_read (line => sub { 823 $_[0]->push_read (line => sub {
823 length $_[1] 824 length $_[1]
824 and return $finish->(undef, $ae_error => "Garbled chunked transfer encoding"); 825 and return $finish->(undef, $ae_error => "Garbled chunked transfer encoding");
825 $_[0]->push_read (line => $state{read_chunk}); 826 $_[0]->push_read (line => $state{read_chunk});
826 });
827 }); 827 });
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 }); 828 });
861 } else { 829 } else {
862 $_[0]->on_eof (sub { 830 $hdr{"content-length"} ||= $cl;
863 $finish->(""); 831
832 $_[0]->push_read (line => $qr_nlnl, sub {
833 if (length $_[1]) {
834 for ("$_[1]") {
835 y/\015//d; # weed out any \015, as they show up in the weirdest of places.
836
837 my $hdr = parse_hdr
838 or return $finish->(undef, $ae_error => "Garbled response trailers");
839
840 %hdr = (%hdr, %$hdr);
841 }
864 }); 842 }
865 $_[0]->on_read (sub { 843
866 $arg{on_body}(delete $_[0]{rbuf}, \%hdr) 844 $finish->($body, undef, undef, 1);
867 or $finish->(undef, 598 => "Request cancelled by on_body");
868 }); 845 });
869 } 846 }
847 };
848
849 $_[0]->push_read (line => $state{read_chunk});
850
851 } elsif ($arg{on_body}) {
852 if (defined $len) {
853 $_[0]->on_read (sub {
854 $len -= length $_[0]{rbuf};
855
856 $arg{on_body}(delete $_[0]{rbuf}, \%hdr)
857 or return $finish->(undef, 598 => "Request cancelled by on_body");
858
859 $len > 0
860 or $finish->("", undef, undef, 1);
861 });
870 } else { 862 } else {
871 $_[0]->on_eof (undef); 863 $_[0]->on_eof (sub {
872 864 $finish->("");
873 if ($len) { 865 });
874 $_[0]->on_read (sub { 866 $_[0]->on_read (sub {
867 $arg{on_body}(delete $_[0]{rbuf}, \%hdr)
868 or $finish->(undef, 598 => "Request cancelled by on_body");
869 });
870 }
871 } else {
872 $_[0]->on_eof (undef);
873
874 if (defined $len) {
875 $_[0]->on_read (sub {
875 $finish->((substr delete $_[0]{rbuf}, 0, $len, ""), undef, undef, 1) 876 $finish->((substr delete $_[0]{rbuf}, 0, $len, ""), undef, undef, 1)
876 if $len <= length $_[0]{rbuf}; 877 if $len <= length $_[0]{rbuf};
877 }); 878 });
878 } else { 879 } else {
879 $_[0]->on_error (sub { 880 $_[0]->on_error (sub {
880 ($! == Errno::EPIPE || !$!) 881 ($! == Errno::EPIPE || !$!)
881 ? $finish->(delete $_[0]{rbuf}) 882 ? $finish->(delete $_[0]{rbuf})
882 : $finish->(undef, $ae_error => $_[2]); 883 : $finish->(undef, $ae_error => $_[2]);
883 }); 884 });
884 $_[0]->on_read (sub { }); 885 $_[0]->on_read (sub { });
885 }
886 } 886 }
887 } 887 }
888 }; 888 };
889 889
890 $state{handle}->push_read (line => $qr_nlnl, $state{read_response}); 890 $state{handle}->push_read (line => $qr_nlnl, $state{read_response});

Diff Legend

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