--- AnyEvent-HTTP/HTTP.pm	2015/05/08 17:34:35	1.123
+++ AnyEvent-HTTP/HTTP.pm	2018/08/30 17:04:28	1.131
@@ -48,7 +48,7 @@
 
 use base Exporter::;
 
-our $VERSION = 2.21;
+our $VERSION = 2.24;
 
 our @EXPORT = qw(http_get http_post http_head http_request);
 
@@ -456,7 +456,7 @@
 sub cookie_jar_expire($;$) {
    my ($jar, $session_end) = @_;
 
-   %$jar = () if $jar->{version} != 1;
+   %$jar = () if $jar->{version} != 2;
 
    my $anow = AE::now;
 
@@ -486,20 +486,19 @@
 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 =~ /^\./) {
-         next unless $chost eq substr $host, -length $chost;
-      } elsif ($chost =~ /\./) {
-         next unless $chost eq $host;
-      } else {
-         next;
-      }
+      # exact match or suffix including . match
+      $chost eq $host or ".$chost" eq substr $host, -1 - length $chost
+         or next;
 
       while (my ($cpath, $cookies) = each %$paths) {
          next unless $cpath eq substr $path, 0, length $cpath;
@@ -531,6 +530,8 @@
 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
 
@@ -585,7 +586,7 @@
       my $cpath = (delete $kv{path}) || "/";
 
       if (exists $kv{domain}) {
-         $cdom = delete $kv{domain};
+         $cdom = $kv{domain};
 
          $cdom =~ s/^\.?/./; # make sure it starts with a "."
 
@@ -594,12 +595,14 @@
          # 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;
@@ -775,7 +778,7 @@
              : $uscheme eq "https" ? 443
              : return $cb->(undef, { @pseudo, Status => 599, Reason => "Only http and https URL schemes supported" });
 
-   $uauthority =~ /^(?: .*\@ )? ([^\@:]+) (?: : (\d+) )?$/x
+   $uauthority =~ /^(?: .*\@ )? ([^\@]+?) (?: : (\d+) )?$/x
       or return $cb->(undef, { @pseudo, Status => 599, Reason => "Unparsable URL" });
 
    my $uhost = lc $1;
@@ -897,7 +900,7 @@
             my $loc = $hdr{location};
 
             if ($loc =~ m%^//%) { # //
-               $loc = "$rscheme:$loc";
+               $loc = "$uscheme:$loc";
 
             } elsif ($loc eq "") {
                $loc = $url;
@@ -906,7 +909,7 @@
                $loc =~ s/^\.\/+//;
 
                if ($loc !~ m%^[.?#]%) {
-                  my $prefix = "$rscheme://$uhost:$uport";
+                  my $prefix = "$uscheme://$uauthority";
 
                   unless ($loc =~ s/^\///) {
                      $prefix .= $upath;
@@ -1033,7 +1036,7 @@
          } 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]+)/
@@ -1076,7 +1079,7 @@
 
             $_[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};
@@ -1125,10 +1128,10 @@
             %state = ();
             $state{recurse} =
                http_request (
-                  $method   => $url,
+                  $method    => $url,
                   %arg,
-                  recurse   => $recurse - 1,
-                  keepalive => 0,
+                  recurse    => $recurse - 1,
+                  persistent => 0,
                   sub {
                      %state = ();
                      &$cb
@@ -1219,11 +1222,11 @@
          $was_persistent = 1;
 
          $state{handle} = ka_fetch $ka_key;
-         $state{handle}->destroyed
-            and die "AnyEvent::HTTP: unexpectedly got a destructed handle (1), please report.";#d#
+#         $state{handle}->destroyed
+#            and die "AnyEvent::HTTP: unexpectedly got a destructed handle (1), please report.";#d#
          $prepare_handle->();
-         $state{handle}->destroyed
-            and die "AnyEvent::HTTP: unexpectedly got a destructed handle (2), please report.";#d#
+#         $state{handle}->destroyed
+#            and die "AnyEvent::HTTP: unexpectedly got a destructed handle (2), please report.";#d#
          $handle_actual_request->();
 
       } else {
@@ -1293,8 +1296,8 @@
 A cookie jar is initially an empty hash-reference that is managed by this
 module. Its format is subject to change, but currently it is as follows:
 
-The key C<version> has to contain C<1>, otherwise the hash gets
-emptied. All other keys are hostnames or IP addresses pointing to
+The key C<version> has to contain C<2>, otherwise the hash gets
+cleared. All other keys are hostnames or IP addresses pointing to
 hash-references. The key for these inner hash references is the
 server path for which this cookie is meant, and the values are again
 hash-references. Each key of those hash-references is a cookie name, and
@@ -1463,8 +1466,6 @@
       my %hdr;
       my $ofs = 0;
 
-      warn stat $fh;
-      warn -s _;
       if (stat $fh and -s _) {
          $ofs = -s _;
          warn "-s is ", $ofs;
@@ -1502,7 +1503,7 @@
             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) {