| … | |
… | |
| 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) { |
