Commit cb085b2511c5a2afceeec48d60363667c69d4782 - libhttp-cookiejar-perl

Update last-access-time per RFC Also clarifies that times are absolute epoch seconds. Fixes #12. David Golden 1 year, 9 months ago

3 changed file(s) with 61 addition(s) and 6 deletion(s). Raw diff Collapse all Expand all

-0

Changes less more

0	0	Revision history for HTTP-CookieJar
1	1
2	2	{{$NEXT}}
	3
	4	[FIXED]
	5
	6	- Cookie last access time is updated when a cookie is retrieved; this has
	7	no functional effect but is consistent with RFC 6265.
3	8
4	9	0.012 2021-06-16 05:34:31-04:00 America/New_York
5	10

+12

-6

lib/HTTP/CookieJar.pm less more

123	123	* secure -- if present, the cookie was set C<Secure>
124	124	* httponly -- if present, the cookie was set C<HttpOnly>
125	125	* hostonly -- if present, the cookie may only be used with the domain as a host
126		* creation_time -- epoch seconds since the cookie was first stored
127		* last_access_time -- epoch seconds since the cookie was last stored
	126	* creation_time -- epoch time when the cookie was first stored
	127	* last_access_time -- epoch time when the cookie was last accessed (i.e. "now")
128	128
129	129	Keep in mind that C<httponly> means it should only be used in requests and not
130	130	made available via Javascript, etc. This is pretty meaningless for Perl user

137	137	=cut
138	138
139	139	sub cookies_for {
	140	my ( $self, $request ) = @_;
	141	my @found = $self->_cookies_for($request);
	142	return map { {%$_} } @found;
	143	}
	144
	145	# _cookies_for returns originals, not copies, which helps in testing
	146	sub _cookies_for {
140	147	my ( $self, $request ) = @_;
141	148	my ( $scheme, $host, $port, $request_path ) = eval { _split_url($request) };
142	149	Carp::croak($@) if $@;

149	156	next if defined( $cookie->{expires} ) && $cookie->{expires} < $now;
150	157	next unless _domain_match( $host, $cookie->{domain} );
151	158	next unless _path_match( $request_path, $cookie->{path} );
	159	$cookie->{last_access_time} = time;
152	160	push @found, $cookie;
153	161	}
154	162	@found = sort {

255	263	# private methods
256	264	#--------------------------------------------------------------------------#
257	265
258		# return a copy of all cookies
	266	# return flattened list of all cookies
259	267	sub _all_cookies {
260		return map {
261		{ %$_ }
262		} map { values %$_ } map { values %$_ } values %{ $_[0]->{store} };
	268	return map { values %$_ } map { values %$_ } values %{ $_[0]->{store} };
263	269	}
264	270
265	271	#--------------------------------------------------------------------------#

+44

-0

t/cookies_for.t less more

	0	use 5.008001;
	1	use strict;
	2	use warnings;
	3	use Test::More 0.96;
	4	use Test::Deep '!blessed';
	5	use lib 't/lib';
	6	use MockTime;
	7
	8	use HTTP::CookieJar;
	9
	10	my $url = "http://example.com/foo/bar/";
	11	my @input = (
	12	[ $url, "SID=2; Path=/" ],
	13	[ $url, "SID=1; Path=/foo" ],
	14	[ $url, "SID=0; Path=/foo/bar" ],
	15	);
	16
	17	# MockTime keeps this constant
	18	my $creation_time = time;
	19
	20	my $jar = HTTP::CookieJar->new;
	21	$jar->add(@$_) for @input;
	22
	23	# Move up the clock for access time
	24	MockTime->offset(10);
	25	my $last_access_time = time;
	26
	27	# Check that cookies_for has expected times
	28	for my $c ( $jar->cookies_for($url) ) {
	29	is( $c->{creation_time}, $creation_time, "$c->{name}=$c->{value} creation_time" );
	30	is( $c->{last_access_time}, $last_access_time, "$c->{name}=$c->{value} last_access_time" );
	31	}
	32
	33	# Modify cookies from cookies_for and verify they aren't changed
	34	# from private originals.
	35	for my $c ( $jar->cookies_for($url) ) {
	36	$c->{creation_time} = 0;
	37	}
	38	for my $c ( $jar->_cookies_for($url) ) {
	39	is( $c->{creation_time}, $creation_time, "$c->{name}=$c->{value} creation_time" );
	40	}
	41
	42	done_testing;
	43	# COPYRIGHT