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