[ViewVC] Diff of: cvs/AnyEvent-HTTP/HTTP.pm

Comparing AnyEvent-HTTP/HTTP.pm (file contents):
Revision 1.126 by root, Thu Jan 7 13:14:16 2016 UTC vs.
Revision 1.130 by root, Thu Aug 30 01:21:27 2018 UTC

 use AnyEvent::Util ();
 use AnyEvent::Handle ();
 use base Exporter::;
-our $VERSION = 2.22;
+our $VERSION = 2.24;
 our @EXPORT = qw(http_get http_post http_head http_request);
 our $USERAGENT          = "Mozilla/5.0 (compatible; U; AnyEvent-HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)";
 our $MAX_RECURSE        =  10;
 # expire cookies
 sub cookie_jar_expire($;$) {
    my ($jar, $session_end) = @_;
-   %$jar = () if $jar->{version} != 1;
+   %$jar = () if $jar->{version} != 2;
    my $anow = AE::now;
    while (my ($chost, $paths) = each %$jar) {
       next unless ref $paths;
 # extract cookies from jar
 sub cookie_jar_extract($$$$) {
    my ($jar, $scheme, $host, $path) = @_;
-   %$jar = () if $jar->{version} != 1;
+   %$jar = () if $jar->{version} != 2;
+   $host = AnyEvent::Util::idn_to_ascii $host
+      if $host =~ /[^\x00-\x7f]/;
    my @cookies;
    while (my ($chost, $paths) = each %$jar) {
       next unless ref $paths;
-      if ($chost =~ /^\./) {
+      # exact match or suffix including . match
-         next unless $chost eq substr $host, -length $chost;
+      $chost eq $host or ".$chost" eq substr $host, -1 - length $chost
-      } elsif ($chost =~ /\./) {
-         next unless $chost eq $host;
-      } else {
-         next;
+         or next;
-      }
       while (my ($cpath, $cookies) = each %$paths) {
          next unless $cpath eq substr $path, 0, length $cpath;
          while (my ($cookie, $kv) = each %$cookies) {
 }
 # parse set_cookie header into jar
 sub cookie_jar_set_cookie($$$$) {
    my ($jar, $set_cookie, $host, $date) = @_;
+   %$jar = () if $jar->{version} != 2;
    my $anow = int AE::now;
    my $snow; # server-now
    for ($set_cookie) {
       my $cdom;
       my $cpath = (delete $kv{path}) || "/";
       if (exists $kv{domain}) {
-         $cdom = delete $kv{domain};
+         $cdom = $kv{domain};
          $cdom =~ s/^\.?/./; # make sure it starts with a "."
          next if $cdom =~ /\.$/;
          # this is not rfc-like and not netscape-like. go figure.
          my $ndots = $cdom =~ y/.//;
          next if $ndots < ($cdom =~ /\.[^.][^.]\.[^.][^.]$/ ? 3 : 2);
+         $cdom = substr $cdom, 1; # remove initial .
       } else {
          $cdom = $host;
       }
       # store it
-      $jar->{version} = 1;
+      $jar->{version} = 2;
       $jar->{lc $cdom}{$cpath}{$name} = \%kv;
       redo if /\G\s*,/gc;
    }
 }
             } elsif ($loc !~ /^(?: $ | [^:\/?\#]+ : )/x) { # anything "simple"
                $loc =~ s/^\.\/+//;
                if ($loc !~ m%^[.?#]%) {
-                  my $prefix = "$uscheme://$uhost:$uport";
+                  my $prefix = "$uscheme://$uauthority";
                   unless ($loc =~ s/^\///) {
                      $prefix .= $upath;
                      $prefix =~ s/\/[^\/]*$//;
                   }
             $finish->(delete $state{handle});
          } elsif ($chunked) {
             my $cl = 0;
             my $body = "";
-            my $on_body = $arg{on_body} || sub { $body .= shift; 1 };
+            my $on_body = (!$redirect && $arg{on_body}) || sub { $body .= shift; 1 };
             $state{read_chunk} = sub {
                $_[1] =~ /^([0-9a-fA-F]+)/
                   or return $finish->(undef, $ae_error => "Garbled chunked transfer encoding");
                }
             };
             $_[0]->push_read (line => $state{read_chunk});
-         } elsif ($arg{on_body}) {
+         } elsif (!$redirect && $arg{on_body}) {
             if (defined $len) {
                $_[0]->on_read (sub {
                   $len -= length $_[0]{rbuf};
                   $arg{on_body}(delete $_[0]{rbuf}, \%hdr)
       # on a keepalive request (in theory, this should be a separate config option).
       if ($persistent && $KA_CACHE{$ka_key}) {
          $was_persistent = 1;
          $state{handle} = ka_fetch $ka_key;
-         $state{handle}->destroyed
+#         $state{handle}->destroyed
-            and die "AnyEvent::HTTP: unexpectedly got a destructed handle (1), please report.";#d#
+#            and die "AnyEvent::HTTP: unexpectedly got a destructed handle (1), please report.";#d#
          $prepare_handle->();
-         $state{handle}->destroyed
+#         $state{handle}->destroyed
-            and die "AnyEvent::HTTP: unexpectedly got a destructed handle (2), please report.";#d#
+#            and die "AnyEvent::HTTP: unexpectedly got a destructed handle (2), please report.";#d#
          $handle_actual_request->();
       } else {
          my $tcp_connect = $arg{tcp_connect}
                            || do { require AnyEvent::Socket; \&AnyEvent::Socket::tcp_connect };
          or die "$file: $!";
       my %hdr;
       my $ofs = 0;
-      warn stat $fh;
-      warn -s _;
       if (stat $fh and -s _) {
          $ofs = -s _;
          warn "-s is ", $ofs;
          $hdr{"if-unmodified-since"} = AnyEvent::HTTP::format_date +(stat _)[9];
          $hdr{"range"} = "bytes=$ofs-";
             my (undef, $hdr) = @_;
             my $status = $hdr->{Status};
             if (my $time = AnyEvent::HTTP::parse_date $hdr->{"last-modified"}) {
-               utime $fh, $time, $time;
+               utime $time, $time, $fh;
             }
             if ($status == 200 || $status == 206 || $status == 416) {
                # download ok || resume ok || file already fully downloaded
                $cb->(1, $hdr);

Diff Legend

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

Comparing AnyEvent-HTTP/HTTP.pm (file contents): Revision 1.126 by root, Thu Jan 7 13:14:16 2016 UTC vs. Revision 1.130 by root, Thu Aug 30 01:21:27 2018 UTC

Diff Legend

Comparing AnyEvent-HTTP/HTTP.pm (file contents):
Revision 1.126 by root, Thu Jan 7 13:14:16 2016 UTC vs.
Revision 1.130 by root, Thu Aug 30 01:21:27 2018 UTC