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.86 by root, Sun Jan 2 06:38:32 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) = @_;
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
… …
777 }; 777 };
778 778
779 $ae_error = 597; # body phase 779 $ae_error = 597; # body phase
780 780
781 my $len = $hdr{"content-length"}; 781 my $len = $hdr{"content-length"};
782 warn "no content $redirect x<$len>$hdr{Status}\n";#d#
783 782
784 # body handling, many different code paths 783 # body handling, many different code paths
785 # - no body expected 784 # - no body expected
786 # - want_body_handle 785 # - want_body_handle
787 # - te chunked 786 # - te chunked
… …
934 # now handle proxy-CONNECT method 933 # now handle proxy-CONNECT method
935 if ($proxy && $uscheme eq "https") { 934 if ($proxy && $uscheme eq "https") {
936 # oh dear, we have to wrap it into a connect request 935 # oh dear, we have to wrap it into a connect request
937 936
938 # maybe re-use $uauthority with patched port? 937 # 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"); 938 $state{handle}->push_write ("CONNECT $uhost:$uport HTTP/1.0\015\012\015\012");
940 $state{handle}->push_read (line => $qr_nlnl, sub { 939 $state{handle}->push_read (line => $qr_nlnl, sub {
941 $_[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
942 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])" }));
943 942
944 if ($2 == 200) { 943 if ($2 == 200) {

Diff Legend

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