… | |
… | |
36 | |
36 | |
37 | =cut |
37 | =cut |
38 | |
38 | |
39 | package AnyEvent::HTTP; |
39 | package AnyEvent::HTTP; |
40 | |
40 | |
41 | use strict; |
41 | use common::sense; |
42 | no warnings; |
|
|
43 | |
42 | |
44 | use Errno (); |
43 | use Errno (); |
45 | |
44 | |
46 | use AnyEvent 5.0 (); |
45 | use AnyEvent 5.0 (); |
47 | use AnyEvent::Util (); |
46 | use AnyEvent::Util (); |
… | |
… | |
415 | } |
414 | } |
416 | |
415 | |
417 | # extract cookies from jar |
416 | # extract cookies from jar |
418 | sub cookie_jar_extract($$$$) { |
417 | sub 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) { |