… | |
… | |
374 | |
374 | |
375 | my $proxy = $arg{proxy} || $PROXY; |
375 | my $proxy = $arg{proxy} || $PROXY; |
376 | my $timeout = $arg{timeout} || $TIMEOUT; |
376 | my $timeout = $arg{timeout} || $TIMEOUT; |
377 | |
377 | |
378 | my ($uscheme, $uauthority, $upath, $query, $fragment) = |
378 | my ($uscheme, $uauthority, $upath, $query, $fragment) = |
379 | $url =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|; |
379 | $url =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:(\?[^#]*))?(?:#(.*))?|; |
380 | |
380 | |
381 | $uscheme = lc $uscheme; |
381 | $uscheme = lc $uscheme; |
382 | |
382 | |
383 | my $uport = $uscheme eq "http" ? 80 |
383 | my $uport = $uscheme eq "http" ? 80 |
384 | : $uscheme eq "https" ? 443 |
384 | : $uscheme eq "https" ? 443 |
… | |
… | |
392 | |
392 | |
393 | $hdr{host} = defined $2 ? "$uhost:$2" : "$uhost" |
393 | $hdr{host} = defined $2 ? "$uhost:$2" : "$uhost" |
394 | unless exists $hdr{host}; |
394 | unless exists $hdr{host}; |
395 | |
395 | |
396 | $uhost =~ s/^\[(.*)\]$/$1/; |
396 | $uhost =~ s/^\[(.*)\]$/$1/; |
397 | $upath .= "?$query" if length $query; |
397 | $upath .= $query if length $query; |
398 | |
398 | |
399 | $upath =~ s%^/?%/%; |
399 | $upath =~ s%^/?%/%; |
400 | |
400 | |
401 | # cookie processing |
401 | # cookie processing |
402 | if (my $jar = $arg{cookie_jar}) { |
402 | if (my $jar = $arg{cookie_jar}) { |
… | |
… | |
470 | return unless delete $state{connect_guard}; |
470 | return unless delete $state{connect_guard}; |
471 | |
471 | |
472 | # get handle |
472 | # get handle |
473 | $state{handle} = new AnyEvent::Handle |
473 | $state{handle} = new AnyEvent::Handle |
474 | fh => $state{fh}, |
474 | fh => $state{fh}, |
|
|
475 | peername => $rhost, |
|
|
476 | tls_ctx => $arg{tls_ctx}, |
|
|
477 | # these need to be reconfigured on keepalive handles |
475 | timeout => $timeout, |
478 | timeout => $timeout, |
476 | peername => $rhost, |
479 | on_error => sub { |
477 | tls_ctx => $arg{tls_ctx}; |
480 | %state = (); |
|
|
481 | $cb->(undef, { Status => 599, Reason => $_[2], @pseudo }); |
|
|
482 | }, |
|
|
483 | on_eof => sub { |
|
|
484 | %state = (); |
|
|
485 | $cb->(undef, { Status => 599, Reason => "Unexpected end-of-file", @pseudo }); |
|
|
486 | }, |
|
|
487 | ; |
478 | |
488 | |
479 | # limit the number of persistent connections |
489 | # limit the number of persistent connections |
480 | # keepalive not yet supported |
490 | # keepalive not yet supported |
481 | if ($KA_COUNT{$_[1]} < $MAX_PERSISTENT_PER_HOST) { |
491 | # if ($KA_COUNT{$_[1]} < $MAX_PERSISTENT_PER_HOST) { |
482 | ++$KA_COUNT{$_[1]}; |
492 | # ++$KA_COUNT{$_[1]}; |
483 | $state{handle}{ka_count_guard} = AnyEvent::Util::guard { |
493 | # $state{handle}{ka_count_guard} = AnyEvent::Util::guard { |
484 | --$KA_COUNT{$_[1]} |
494 | # --$KA_COUNT{$_[1]} |
485 | }; |
495 | # }; |
486 | $hdr{connection} = "keep-alive"; |
496 | # $hdr{connection} = "keep-alive"; |
487 | } else { |
497 | # } else { |
488 | delete $hdr{connection}; |
498 | delete $hdr{connection}; |
489 | } |
499 | # } |
490 | |
|
|
491 | # (re-)configure handle |
|
|
492 | $state{handle}->on_error (sub { |
|
|
493 | %state = (); |
|
|
494 | $cb->(undef, { Status => 599, Reason => $_[2], @pseudo }); |
|
|
495 | }); |
|
|
496 | $state{handle}->on_eof (sub { |
|
|
497 | %state = (); |
|
|
498 | $cb->(undef, { Status => 599, Reason => "Unexpected end-of-file", @pseudo }); |
|
|
499 | }); |
|
|
500 | |
500 | |
501 | $state{handle}->starttls ("connect") if $rscheme eq "https"; |
501 | $state{handle}->starttls ("connect") if $rscheme eq "https"; |
502 | |
502 | |
503 | # handle actual, non-tunneled, request |
503 | # handle actual, non-tunneled, request |
504 | my $handle_actual_request = sub { |
504 | my $handle_actual_request = sub { |