… | |
… | |
414 | } |
414 | } |
415 | |
415 | |
416 | # extract cookies from jar |
416 | # extract cookies from jar |
417 | sub cookie_jar_extract($$$$) { |
417 | sub cookie_jar_extract($$$$) { |
418 | my ($jar, $uscheme, $uhost, $upath) = @_; |
418 | my ($jar, $uscheme, $uhost, $upath) = @_; |
419 | |
|
|
420 | $uhost = lc $uhost; |
|
|
421 | |
419 | |
422 | %$jar = () if $jar->{version} != 1; |
420 | %$jar = () if $jar->{version} != 1; |
423 | |
421 | |
424 | my @cookies; |
422 | my @cookies; |
425 | |
423 | |
… | |
… | |
608 | : 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" }); |
609 | |
607 | |
610 | $uauthority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x |
608 | $uauthority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x |
611 | or return $cb->(undef, { @pseudo, Status => 599, Reason => "Unparsable URL" }); |
609 | or return $cb->(undef, { @pseudo, Status => 599, Reason => "Unparsable URL" }); |
612 | |
610 | |
613 | my $uhost = $1; |
611 | my $uhost = lc $1; |
614 | $uport = $2 if defined $2; |
612 | $uport = $2 if defined $2; |
615 | |
613 | |
616 | $hdr{host} = defined $2 ? "$uhost:$2" : "$uhost" |
614 | $hdr{host} = defined $2 ? "$uhost:$2" : "$uhost" |
617 | unless exists $hdr{host}; |
615 | unless exists $hdr{host}; |
618 | |
616 | |
… | |
… | |
637 | $rscheme = "http" unless defined $rscheme; |
635 | $rscheme = "http" unless defined $rscheme; |
638 | |
636 | |
639 | # don't support https requests over https-proxy transport, |
637 | # don't support https requests over https-proxy transport, |
640 | # 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. |
641 | $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; |
642 | } else { |
643 | } else { |
643 | ($rhost, $rport, $rscheme, $rpath) = ($uhost, $uport, $uscheme, $upath); |
644 | ($rhost, $rport, $rscheme, $rpath) = ($uhost, $uport, $uscheme, $upath); |
644 | } |
645 | } |
645 | |
646 | |
646 | # leave out fragment and query string, just a heuristic |
647 | # leave out fragment and query string, just a heuristic |
… | |
… | |
932 | # now handle proxy-CONNECT method |
933 | # now handle proxy-CONNECT method |
933 | if ($proxy && $uscheme eq "https") { |
934 | if ($proxy && $uscheme eq "https") { |
934 | # oh dear, we have to wrap it into a connect request |
935 | # oh dear, we have to wrap it into a connect request |
935 | |
936 | |
936 | # maybe re-use $uauthority with patched port? |
937 | # maybe re-use $uauthority with patched port? |
937 | $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"); |
938 | $state{handle}->push_read (line => $qr_nlnl, sub { |
939 | $state{handle}->push_read (line => $qr_nlnl, sub { |
939 | $_[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 |
940 | 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])" })); |
941 | |
942 | |
942 | if ($2 == 200) { |
943 | if ($2 == 200) { |