ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent-HTTP/HTTP.pm
(Generate patch)

Comparing AnyEvent-HTTP/HTTP.pm (file contents):
Revision 1.128 by root, Sat Nov 26 03:45:33 2016 UTC vs.
Revision 1.133 by root, Sat Sep 1 03:16:43 2018 UTC

342=item persistent => $boolean 342=item persistent => $boolean
343 343
344Try to create/reuse a persistent connection. When this flag is set 344Try to create/reuse a persistent connection. When this flag is set
345(default: true for idempotent requests, false for all others), then 345(default: true for idempotent requests, false for all others), then
346C<http_request> tries to re-use an existing (previously-created) 346C<http_request> tries to re-use an existing (previously-created)
347persistent connection to the host and, failing that, tries to create a new 347persistent connection to same host (i.e. identical URL scheme, hostname,
348one. 348port and session) and, failing that, tries to create a new one.
349 349
350Requests failing in certain ways will be automatically retried once, which 350Requests failing in certain ways will be automatically retried once, which
351is dangerous for non-idempotent requests, which is why it defaults to off 351is dangerous for non-idempotent requests, which is why it defaults to off
352for them. The reason for this is because the bozos who designed HTTP/1.1 352for them. The reason for this is because the bozos who designed HTTP/1.1
353made it impossible to distinguish between a fatal error and a normal 353made it impossible to distinguish between a fatal error and a normal
454 454
455# expire cookies 455# expire cookies
456sub cookie_jar_expire($;$) { 456sub cookie_jar_expire($;$) {
457 my ($jar, $session_end) = @_; 457 my ($jar, $session_end) = @_;
458 458
459 %$jar = () if $jar->{version} != 1; 459 %$jar = () if $jar->{version} != 2;
460 460
461 my $anow = AE::now; 461 my $anow = AE::now;
462 462
463 while (my ($chost, $paths) = each %$jar) { 463 while (my ($chost, $paths) = each %$jar) {
464 next unless ref $paths; 464 next unless ref $paths;
484 484
485# extract cookies from jar 485# extract cookies from jar
486sub cookie_jar_extract($$$$) { 486sub cookie_jar_extract($$$$) {
487 my ($jar, $scheme, $host, $path) = @_; 487 my ($jar, $scheme, $host, $path) = @_;
488 488
489 %$jar = () if $jar->{version} != 1; 489 %$jar = () if $jar->{version} != 2;
490
491 $host = AnyEvent::Util::idn_to_ascii $host
492 if $host =~ /[^\x00-\x7f]/;
490 493
491 my @cookies; 494 my @cookies;
492 495
493 while (my ($chost, $paths) = each %$jar) { 496 while (my ($chost, $paths) = each %$jar) {
494 next unless ref $paths; 497 next unless ref $paths;
495 498
496 if ($chost =~ /^\./) { 499 # exact match or suffix including . match
497 next unless $chost eq substr $host, -length $chost; 500 $chost eq $host or ".$chost" eq substr $host, -1 - length $chost
498 } elsif ($chost =~ /\./) {
499 next unless $chost eq $host;
500 } else {
501 next; 501 or next;
502 }
503 502
504 while (my ($cpath, $cookies) = each %$paths) { 503 while (my ($cpath, $cookies) = each %$paths) {
505 next unless $cpath eq substr $path, 0, length $cpath; 504 next unless $cpath eq substr $path, 0, length $cpath;
506 505
507 while (my ($cookie, $kv) = each %$cookies) { 506 while (my ($cookie, $kv) = each %$cookies) {
528} 527}
529 528
530# parse set_cookie header into jar 529# parse set_cookie header into jar
531sub cookie_jar_set_cookie($$$$) { 530sub cookie_jar_set_cookie($$$$) {
532 my ($jar, $set_cookie, $host, $date) = @_; 531 my ($jar, $set_cookie, $host, $date) = @_;
532
533 %$jar = () if $jar->{version} != 2;
533 534
534 my $anow = int AE::now; 535 my $anow = int AE::now;
535 my $snow; # server-now 536 my $snow; # server-now
536 537
537 for ($set_cookie) { 538 for ($set_cookie) {
583 584
584 my $cdom; 585 my $cdom;
585 my $cpath = (delete $kv{path}) || "/"; 586 my $cpath = (delete $kv{path}) || "/";
586 587
587 if (exists $kv{domain}) { 588 if (exists $kv{domain}) {
588 $cdom = delete $kv{domain}; 589 $cdom = $kv{domain};
589 590
590 $cdom =~ s/^\.?/./; # make sure it starts with a "." 591 $cdom =~ s/^\.?/./; # make sure it starts with a "."
591 592
592 next if $cdom =~ /\.$/; 593 next if $cdom =~ /\.$/;
593 594
594 # this is not rfc-like and not netscape-like. go figure. 595 # this is not rfc-like and not netscape-like. go figure.
595 my $ndots = $cdom =~ y/.//; 596 my $ndots = $cdom =~ y/.//;
596 next if $ndots < ($cdom =~ /\.[^.][^.]\.[^.][^.]$/ ? 3 : 2); 597 next if $ndots < ($cdom =~ /\.[^.][^.]\.[^.][^.]$/ ? 3 : 2);
598
599 $cdom = substr $cdom, 1; # remove initial .
597 } else { 600 } else {
598 $cdom = $host; 601 $cdom = $host;
599 } 602 }
600 603
601 # store it 604 # store it
602 $jar->{version} = 1; 605 $jar->{version} = 2;
603 $jar->{lc $cdom}{$cpath}{$name} = \%kv; 606 $jar->{lc $cdom}{$cpath}{$name} = \%kv;
604 607
605 redo if /\G\s*,/gc; 608 redo if /\G\s*,/gc;
606 } 609 }
607} 610}
904 907
905 } elsif ($loc !~ /^(?: $ | [^:\/?\#]+ : )/x) { # anything "simple" 908 } elsif ($loc !~ /^(?: $ | [^:\/?\#]+ : )/x) { # anything "simple"
906 $loc =~ s/^\.\/+//; 909 $loc =~ s/^\.\/+//;
907 910
908 if ($loc !~ m%^[.?#]%) { 911 if ($loc !~ m%^[.?#]%) {
909 my $prefix = "$uscheme://$uhost:$uport"; 912 my $prefix = "$uscheme://$uauthority";
910 913
911 unless ($loc =~ s/^\///) { 914 unless ($loc =~ s/^\///) {
912 $prefix .= $upath; 915 $prefix .= $upath;
913 $prefix =~ s/\/[^\/]*$//; 916 $prefix =~ s/\/[^\/]*$//;
914 } 917 }
1217 # on a keepalive request (in theory, this should be a separate config option). 1220 # on a keepalive request (in theory, this should be a separate config option).
1218 if ($persistent && $KA_CACHE{$ka_key}) { 1221 if ($persistent && $KA_CACHE{$ka_key}) {
1219 $was_persistent = 1; 1222 $was_persistent = 1;
1220 1223
1221 $state{handle} = ka_fetch $ka_key; 1224 $state{handle} = ka_fetch $ka_key;
1222 $state{handle}->destroyed 1225# $state{handle}->destroyed
1223 and die "AnyEvent::HTTP: unexpectedly got a destructed handle (1), please report.";#d# 1226# and die "AnyEvent::HTTP: unexpectedly got a destructed handle (1), please report.";#d#
1224 $prepare_handle->(); 1227 $prepare_handle->();
1225 $state{handle}->destroyed 1228# $state{handle}->destroyed
1226 and die "AnyEvent::HTTP: unexpectedly got a destructed handle (2), please report.";#d# 1229# and die "AnyEvent::HTTP: unexpectedly got a destructed handle (2), please report.";#d#
1227 $handle_actual_request->(); 1230 $handle_actual_request->();
1228 1231
1229 } else { 1232 } else {
1230 my $tcp_connect = $arg{tcp_connect} 1233 my $tcp_connect = $arg{tcp_connect}
1231 || do { require AnyEvent::Socket; \&AnyEvent::Socket::tcp_connect }; 1234 || do { require AnyEvent::Socket; \&AnyEvent::Socket::tcp_connect };
1291function from time to time. 1294function from time to time.
1292 1295
1293A cookie jar is initially an empty hash-reference that is managed by this 1296A cookie jar is initially an empty hash-reference that is managed by this
1294module. Its format is subject to change, but currently it is as follows: 1297module. Its format is subject to change, but currently it is as follows:
1295 1298
1296The key C<version> has to contain C<1>, otherwise the hash gets 1299The key C<version> has to contain C<2>, otherwise the hash gets
1297emptied. All other keys are hostnames or IP addresses pointing to 1300cleared. All other keys are hostnames or IP addresses pointing to
1298hash-references. The key for these inner hash references is the 1301hash-references. The key for these inner hash references is the
1299server path for which this cookie is meant, and the values are again 1302server path for which this cookie is meant, and the values are again
1300hash-references. Each key of those hash-references is a cookie name, and 1303hash-references. Each key of those hash-references is a cookie name, and
1301the value, you guessed it, is another hash-reference, this time with the 1304the value, you guessed it, is another hash-reference, this time with the
1302key-value pairs from the cookie, except for C<expires> and C<max-age>, 1305key-value pairs from the cookie, except for C<expires> and C<max-age>,
1306 1309
1307Here is an example of a cookie jar with a single cookie, so you have a 1310Here is an example of a cookie jar with a single cookie, so you have a
1308chance of understanding the above paragraph: 1311chance of understanding the above paragraph:
1309 1312
1310 { 1313 {
1311 version => 1, 1314 version => 2,
1312 "10.0.0.1" => { 1315 "10.0.0.1" => {
1313 "/" => { 1316 "/" => {
1314 "mythweb_id" => { 1317 "mythweb_id" => {
1315 _expires => 1293917923, 1318 _expires => 1293917923,
1316 value => "ooRung9dThee3ooyXooM1Ohm", 1319 value => "ooRung9dThee3ooyXooM1Ohm",

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines