diff --git a/lib/HTTP/Cookies/Netscape.pm b/lib/HTTP/Cookies/Netscape.pm index 34055e26..07d6eecb 100644 --- a/lib/HTTP/Cookies/Netscape.pm +++ b/lib/HTTP/Cookies/Netscape.pm @@ -30,9 +30,14 @@ sub load { my ( $domain, $bool1, $path, $secure, $expires, $key, $val ) = split( /\t/, $line ); $secure = ( $secure eq "TRUE" ); + + # An expiry of 0 means a session cookie (no expiration), per the + # curl/cookies.txt convention. Pass undef max-age so set_cookie() keeps + # it instead of reading 0-$now as an already-expired cookie. + my $maxage = $expires ? $expires - $now : undef; $self->set_cookie( - undef, $key, $val, $path, $domain, undef, 0, - $secure, $expires - $now, 0 + undef, $key, $val, $path, $domain, undef, 0, + $secure, $maxage, 0 ); } 1; @@ -64,11 +69,19 @@ EOT sub { my ( $version, $key, $val, $path, $domain, $port, $path_spec, - $secure, $expires, $discard, $rest + $secure, $expires, $discard ) = @_; return if $discard && !$args{'ignore_discard'}; - $expires = $expires ? $expires - $HTTP::Cookies::EPOCH_OFFSET : 0; - return if $now > $expires; + + # A session cookie (no expiry) is written with an expiry of 0 and kept, + # matching curl. Only drop a cookie that has a real, past expiry. + if ($expires) { + $expires = $expires - $HTTP::Cookies::EPOCH_OFFSET; + return if $now > $expires; + } + else { + $expires = 0; + } $secure = $secure ? "TRUE" : "FALSE"; my $bool = $domain =~ /^\./ ? "TRUE" : "FALSE"; print {$fh} join( diff --git a/t/cookies.t b/t/cookies.t index 4c23beab..723b0276 100644 --- a/t/cookies.t +++ b/t/cookies.t @@ -5,7 +5,7 @@ use HTTP::Request (); use HTTP::Response (); use URI (); -use Test::More tests => 79; +use Test::More tests => 80; #------------------------------------------------------------------- # First we check that it works for the original example at @@ -453,9 +453,13 @@ $c->save; undef($c); $c = HTTP::Cookies::Netscape->new( file => $file ); -is( count_cookies($c), 1 ); # 2 of them discarded on save + +# foo2 (Discard) dropped on save; foo1 (max-age) and foo3 (session cookie, +# no expiry) are kept, matching curl +is( count_cookies($c), 2 ); like( $c->as_string, qr/foo1=bar/ ); +like( $c->as_string, qr/foo3=bar/ ); # session cookie survives save/load undef($c); unlink($file); diff --git a/t/netscape.t b/t/netscape.t new file mode 100644 index 00000000..5741cea3 --- /dev/null +++ b/t/netscape.t @@ -0,0 +1,92 @@ +#!perl -w + +# Session cookies (no expiry) must round-trip through the Netscape/cookies.txt +# format the same way curl and yt-dlp treat them: written with an expiry of 0, +# and read back as a session cookie (not as an ancient/expired cookie). + +use strict; +use warnings; + +use Test::More tests => 6; + +use File::Temp qw(tempdir); +use File::Spec (); + +use HTTP::Cookies::Netscape; + +my $dir = tempdir( CLEANUP => 1 ); +my $file = File::Spec->catfile( $dir, 'cookies.txt' ); + +sub cookie_names { + my $jar = shift; + my %names; + $jar->scan( sub { $names{ $_[1] } = 1 } ); + return \%names; +} + +# A session cookie has no Max-Age/Expires, so set_cookie() gets an undef maxage. +my $jar = HTTP::Cookies::Netscape->new; +$jar->set_cookie( + undef, 'sessionid', 'abc123', '/', '.example.com', undef, + 0, 0, undef, 0 +); + +# A normal persistent cookie, far in the future. +$jar->set_cookie( + undef, 'persistent', 'xyz789', '/', '.example.com', undef, + 0, 0, 10 * 365 * 24 * 3600, 0 +); + +is_deeply( + cookie_names($jar), { sessionid => 1, persistent => 1 }, + 'jar holds both cookies before saving' +); + +$jar->save($file); + +my $content = do { + open my $fh, '<', $file or die "open $file: $!"; + local $/; + <$fh>; +}; + +like( + $content, + qr/^\.example\.com\t.*\t0\tsessionid\tabc123$/m, + 'session cookie is written with an expiry of 0 (curl convention)' +); +like( + $content, + qr/\tpersistent\txyz789$/m, + 'persistent cookie is written' +); + +my $loaded = HTTP::Cookies::Netscape->new( file => $file ); + +ok( + cookie_names($loaded)->{sessionid}, + 'session cookie survives a save/load round-trip' +); +ok( + cookie_names($loaded)->{persistent}, + 'persistent cookie survives a save/load round-trip' +); + +# Regression guard: a cookie whose expiry is already in the past must NOT be +# saved. (maxage of 1s, then we doctor the stored expiry into the past.) +my $expired = HTTP::Cookies::Netscape->new; +$expired->set_cookie( + undef, 'stale', 'old', '/', '.example.com', undef, + 0, 0, 1, 0 +); +$expired->scan( sub { } ); # no-op, keeps API parallel + +# Force the stored absolute expiry into the past. +$expired->{COOKIES}{'.example.com'}{'/'}{stale}[5] = time - 3600; +my $expfile = File::Spec->catfile( $dir, 'expired.txt' ); +$expired->save($expfile); +my $expired_loaded = HTTP::Cookies::Netscape->new( file => $expfile ); +ok( + !cookie_names($expired_loaded)->{stale}, + 'already-expired cookie is not saved' +);