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.76 by root, Sat Jan 1 02:20:49 2011 UTC vs.
Revision 1.77 by root, Sat Jan 1 19:13:41 2011 UTC

… …
122 122
123If the server sends a header multiple times, then their contents will be 123If the server sends a header multiple times, then their contents will be
124joined together with a comma (C<,>), as per the HTTP spec. 124joined together with a comma (C<,>), as per the HTTP spec.
125 125
126If an internal error occurs, such as not being able to resolve a hostname, 126If an internal error occurs, such as not being able to resolve a hostname,
127then C<$data> will be C<undef>, C<< $headers->{Status} >> will be C<59x> 127then C<$data> will be C<undef>, C<< $headers->{Status} >> will be
128(usually C<599>) and the C<Reason> pseudo-header will contain an error 128C<590>-C<599> and the C<Reason> pseudo-header will contain an error
129message. 129message. Currently the following status codes are used:
130
131=over 4
132
133=item 595 - errors during connection etsbalishment, proxy handshake.
134
135=item 596 - errors during TLS negotiation, request sending and header processing.
136
137=item 597 - errors during body receive or processing.
138
139=item 598 - user aborted request in C<on_header> or C<on_body>.
140
141=item 599 - other, usually nonretryable, errors (garbled URL etc.).
142
143=back
130 144
131A typical callback might look like this: 145A typical callback might look like this:
132 146
133 sub { 147 sub {
134 my ($body, $hdr) = @_; 148 my ($body, $hdr) = @_;
… …
600 _get_slot $uhost, sub { 614 _get_slot $uhost, sub {
601 $state{slot_guard} = shift; 615 $state{slot_guard} = shift;
602 616
603 return unless $state{connect_guard}; 617 return unless $state{connect_guard};
604 618
619 my $ae_error = 595; # connecting
620
605 my $connect_cb = sub { 621 my $connect_cb = sub {
606 $state{fh} = shift 622 $state{fh} = shift
607 or do { 623 or do {
608 my $err = "$!"; 624 my $err = "$!";
609 %state = (); 625 %state = ();
610 return $cb->(undef, { @pseudo, Status => 599, Reason => $err }); 626 return $cb->(undef, { @pseudo, Status => $ae_error, Reason => $err });
611 }; 627 };
612 628
613 return unless delete $state{connect_guard}; 629 return unless delete $state{connect_guard};
614 630
615 # get handle 631 # get handle
… …
619 tls_ctx => $arg{tls_ctx}, 635 tls_ctx => $arg{tls_ctx},
620 # these need to be reconfigured on keepalive handles 636 # these need to be reconfigured on keepalive handles
621 timeout => $timeout, 637 timeout => $timeout,
622 on_error => sub { 638 on_error => sub {
623 %state = (); 639 %state = ();
624 $cb->(undef, { @pseudo, Status => 599, Reason => $_[2] }); 640 $cb->(undef, { @pseudo, Status => $ae_error, Reason => $_[2] });
625 }, 641 },
626 on_eof => sub { 642 on_eof => sub {
627 %state = (); 643 %state = ();
628 $cb->(undef, { @pseudo, Status => 599, Reason => "Unexpected end-of-file" }); 644 $cb->(undef, { @pseudo, Status => $ae_error, Reason => "Unexpected end-of-file" });
629 }, 645 },
630 ; 646 ;
631 647
632 # limit the number of persistent connections 648 # limit the number of persistent connections
633 # keepalive not yet supported 649 # keepalive not yet supported
… …
641 657
642 $state{handle}->starttls ("connect") if $rscheme eq "https"; 658 $state{handle}->starttls ("connect") if $rscheme eq "https";
643 659
644 # handle actual, non-tunneled, request 660 # handle actual, non-tunneled, request
645 my $handle_actual_request = sub { 661 my $handle_actual_request = sub {
662 $ae_error = 596; # request phase
663
646 $state{handle}->starttls ("connect") if $uscheme eq "https" && !exists $state{handle}{tls}; 664 $state{handle}->starttls ("connect") if $uscheme eq "https" && !exists $state{handle}{tls};
647 665
648 # send request 666 # send request
649 $state{handle}->push_write ( 667 $state{handle}->push_write (
650 "$method $rpath HTTP/1.1\015\012" 668 "$method $rpath HTTP/1.1\015\012"
… …
749 $cb); 767 $cb);
750 } else { 768 } else {
751 $cb->($_[0], \%hdr); 769 $cb->($_[0], \%hdr);
752 } 770 }
753 }; 771 };
772
773 $ae_error = 597; # body phase
754 774
755 my $len = $hdr{"content-length"}; 775 my $len = $hdr{"content-length"};
756 776
757 if (!$redirect && $arg{on_header} && !$arg{on_header}(\%hdr)) { 777 if (!$redirect && $arg{on_header} && !$arg{on_header}(\%hdr)) {
758 $finish->(undef, 598 => "Request cancelled by on_header"); 778 $finish->(undef, 598 => "Request cancelled by on_header");
… …
780 } elsif ($hdr{"transfer-encoding"} =~ /\bchunked\b/i) { 800 } elsif ($hdr{"transfer-encoding"} =~ /\bchunked\b/i) {
781 my $cl = 0; 801 my $cl = 0;
782 my $body = undef; 802 my $body = undef;
783 my $on_body = $arg{on_body} || sub { $body .= shift; 1 }; 803 my $on_body = $arg{on_body} || sub { $body .= shift; 1 };
784 804
785 $_[0]->on_error (sub { $finish->(undef, 599 => $_[2]) });
786
787 my $read_chunk; $read_chunk = sub { 805 my $read_chunk; $read_chunk = sub {
788 $_[1] =~ /^([0-9a-fA-F]+)/ 806 $_[1] =~ /^([0-9a-fA-F]+)/
789 or $finish->(undef, 599 => "Garbled chunked transfer encoding"); 807 or $finish->(undef, $ae_error => "Garbled chunked transfer encoding");
790 808
791 my $len = hex $1; 809 my $len = hex $1;
792 810
793 if ($len) { 811 if ($len) {
794 $cl += $len; 812 $cl += $len;
… …
797 $on_body->($_[1], \%hdr) 815 $on_body->($_[1], \%hdr)
798 or return $finish->(undef, 598 => "Request cancelled by on_body"); 816 or return $finish->(undef, 598 => "Request cancelled by on_body");
799 817
800 $_[0]->push_read (line => sub { 818 $_[0]->push_read (line => sub {
801 length $_[1] 819 length $_[1]
802 and return $finish->(undef, 599 => "Garbled chunked transfer encoding"); 820 and return $finish->(undef, $ae_error => "Garbled chunked transfer encoding");
803 $_[0]->push_read (line => $read_chunk); 821 $_[0]->push_read (line => $read_chunk);
804 }); 822 });
805 }); 823 });
806 } else { 824 } else {
807 $hdr{"content-length"} ||= $cl; 825 $hdr{"content-length"} ||= $cl;
… …
810 if (length $_[1]) { 828 if (length $_[1]) {
811 for ("$_[1]") { 829 for ("$_[1]") {
812 y/\015//d; # weed out any \015, as they show up in the weirdest of places. 830 y/\015//d; # weed out any \015, as they show up in the weirdest of places.
813 831
814 my $hdr = parse_hdr 832 my $hdr = parse_hdr
815 or return $finish->(undef, 599 => "Garbled response trailers"); 833 or return $finish->(undef, $ae_error => "Garbled response trailers");
816 834
817 %hdr = (%hdr, %$hdr); 835 %hdr = (%hdr, %$hdr);
818 } 836 }
819 } 837 }
820 838
… …
824 }; 842 };
825 843
826 $_[0]->push_read (line => $read_chunk); 844 $_[0]->push_read (line => $read_chunk);
827 845
828 } elsif ($arg{on_body}) { 846 } elsif ($arg{on_body}) {
829 $_[0]->on_error (sub { $finish->(undef, 599 => $_[2]) });
830
831 if ($len) { 847 if ($len) {
832 $_[0]->on_read (sub { 848 $_[0]->on_read (sub {
833 $len -= length $_[0]{rbuf}; 849 $len -= length $_[0]{rbuf};
834 850
835 $arg{on_body}(delete $_[0]{rbuf}, \%hdr) 851 $arg{on_body}(delete $_[0]{rbuf}, \%hdr)
… …
849 } 865 }
850 } else { 866 } else {
851 $_[0]->on_eof (undef); 867 $_[0]->on_eof (undef);
852 868
853 if ($len) { 869 if ($len) {
854 $_[0]->on_error (sub { $finish->(undef, 599 => $_[2]) });
855 $_[0]->on_read (sub { 870 $_[0]->on_read (sub {
856 $finish->((substr delete $_[0]{rbuf}, 0, $len, ""), undef, undef, 1) 871 $finish->((substr delete $_[0]{rbuf}, 0, $len, ""), undef, undef, 1)
857 if $len <= length $_[0]{rbuf}; 872 if $len <= length $_[0]{rbuf};
858 }); 873 });
859 } else { 874 } else {
860 $_[0]->on_error (sub { 875 $_[0]->on_error (sub {
861 ($! == Errno::EPIPE || !$!) 876 ($! == Errno::EPIPE || !$!)
862 ? $finish->(delete $_[0]{rbuf}) 877 ? $finish->(delete $_[0]{rbuf})
863 : $finish->(undef, 599 => $_[2]); 878 : $finish->(undef, $ae_error => $_[2]);
864 }); 879 });
865 $_[0]->on_read (sub { }); 880 $_[0]->on_read (sub { });
866 } 881 }
867 } 882 }
868 } 883 }

Diff Legend

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