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.130 by root, Thu Aug 30 01:21:27 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}

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines