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.129 by root, Thu Aug 30 00:08:16 2018 UTC vs.
Revision 1.131 by root, Thu Aug 30 17:04:28 2018 UTC

… …
46use AnyEvent::Util (); 46use AnyEvent::Util ();
47use AnyEvent::Handle (); 47use AnyEvent::Handle ();
48 48
49use base Exporter::; 49use base Exporter::;
50 50
51our $VERSION = 2.25; 51our $VERSION = 2.24;
52 52
53our @EXPORT = qw(http_get http_post http_head http_request); 53our @EXPORT = qw(http_get http_post http_head http_request);
54 54
55our $USERAGENT = "Mozilla/5.0 (compatible; U; AnyEvent-HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)"; 55our $USERAGENT = "Mozilla/5.0 (compatible; U; AnyEvent-HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)";
56our $MAX_RECURSE = 10; 56our $MAX_RECURSE = 10;
… …
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}
… …
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>,

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines