File Coverage

blib/lib/Cookie.pm
Criterion Covered Total %
statement 229 393 58.2
branch 76 206 36.8
condition 42 165 25.4
subroutine 45 64 70.3
pod 46 46 100.0
total 438 874 50.1


line stmt bran cond sub pod time code
1             ##----------------------------------------------------------------------------
2             ## Cookies API for Server & Client - ~/lib/Cookie.pm
3             ## Version v0.3.2
4             ## Copyright(c) 2023 DEGUEST Pte. Ltd.
5             ## Author: Jacques Deguest <jack@deguest.jp>
6             ## Created 2019/10/08
7             ## Modified 2023/09/19
8             ## You can use, copy, modify and redistribute this package and associated
9             ## files under the same terms as Perl itself.
10             ##----------------------------------------------------------------------------
11             package Cookie;
12             BEGIN
13 0         0 {
14 3     3   1264451 use strict;
  3         21  
  3         93  
15 3     3   15 use warnings;
  3         5  
  3         71  
16 3     3   14 use warnings::register;
  3         4  
  3         399  
17 3     3   554 use parent qw( Module::Generic );
  3         311  
  3         15  
18 3     3   244998 use vars qw( $VERSION $SUBS $COOKIE_DEBUG );
  3         10  
  3         191  
19 3     3   2091 use DateTime;
  3         1083171  
  3         157  
20 3     3   1377 use DateTime::Format::Strptime;
  3         416976  
  3         24  
21 3     3   2408 use Module::Generic::DateTime;
  3         478595  
  3         50  
22 3     3   1880 use URI::Escape ();
  3         1869  
  3         258  
23             use overload (
24             '""' => \&as_string,
25 59     59   3096 bool => sub{ return( $_[0] ) },
26             # '""' => sub{ $_[0]->as_string },
27 3         37 'eq' => \&same_as,
28             '==' => \&same_as,
29             fallback => 1,
30 3     3   35 );
  3         7  
31 3     3   9 our $VERSION = 'v0.3.2';
32 3         6 our $SUBS;
33 3         69 our $COOKIE_DEBUG = 0;
34 3     3   425 use constant CRYPTX_VERSION => '0.074';
  3         8  
  3         237  
35             };
36              
37 3     3   23 use strict;
  3         7  
  3         66  
38 3     3   16 use warnings;
  3         7  
  3         174  
39              
40             sub init
41             {
42 46     46 1 71756 my $self = shift( @_ );
43 3     3   19 no overloading;
  3         8  
  3         17009  
44 46         137 $self->{name} = undef;
45 46         126 $self->{value} = undef;
46 46         145 $self->{comment} = undef;
47 46         135 $self->{commentURL} = undef;
48 46         141 $self->{discard} = 0;
49 46         161 $self->{domain} = undef;
50 46         143 $self->{expires} = undef;
51 46         222 $self->{http_only} = 0;
52             # In the case of cookie sent from the server and no domain was set
53             # This domain, which we need anyway, was provided implicitly or explicitly
54 46         121 $self->{implicit} = 0;
55 46         80 $self->{max_age} = undef;
56 46         110 $self->{path} = undef;
57 46         156 $self->{port} = undef;
58 46         93 $self->{same_site} = undef;
59 46         81 $self->{secure} = 0;
60 46         289 $self->{accessed} = time();
61 46         408 $self->{created} = time();
62             # Ref: <https://stackoverflow.com/questions/41467012/what-is-the-difference-between-signed-and-encrypted-cookies-in-rails>
63             # Integrity protection with Message Authentication Code (MAC)
64             # e.g. Crypt::Mac::HMAC::hmac("SHA256","plop","Oh boy, this is cool")
65 46         331 $self->{sign} = 0;
66             # Crypt::Cipher::AES
67             # Crypt::Cipher
68             # one of 'AES', 'Anubis', 'Blowfish', 'CAST5', 'Camellia', 'DES', 'DES_EDE',
69             # 'KASUMI', 'Khazad', 'MULTI2', 'Noekeon', 'RC2', 'RC5', 'RC6',
70             # 'SAFERP', 'SAFER_K128', 'SAFER_K64', 'SAFER_SK128', 'SAFER_SK64',
71             # 'SEED', 'Skipjack', 'Twofish', 'XTEA', 'IDEA', 'Serpent'
72             # simply any <NAME> for which there exists Crypt::Cipher::<NAME>
73             # Encryption algorithm
74             # Ref: <https://stackoverflow.com/questions/4147451/aes-vs-blowfish-for-file-encryption>
75 46         162 $self->{algo} = 'AES';
76 46         88 $self->{encrypt} = 0;
77 46         76 $self->{initialisation_vector} = undef;
78 46         126 $self->{key} = undef;
79             # Should this API be strict about the cookie names?
80             # When true, this will reject cookie names with invalid characters.
81 46         116 $self->{strict} = 0;
82             # Needs to be an empty string or it would be overriden by Module::Generic who would put here the package version instead
83 46         92 $self->{version} = '';
84 46         90 $self->{_init_strict_use_sub} = 1;
85 46 100       184 $self->SUPER::init( @_ ) || return( $self->pass_error );
86 45         86531 $self->{fields} = [qw( name value comment commentURL discard domain expires http_only implicit max_age path port same_site secure version )];
87 45         134 return( $self );
88             }
89              
90 19     19 1 651 sub accessed_on { return( shift->_set_get_datetime( 'accessed', @_ ) ); }
91              
92             sub algo
93             {
94 0     0 1 0 my $self = shift( @_ );
95 0 0       0 if( @_ )
96             {
97 0         0 my $algo = shift( @_ );
98 0 0 0     0 if( defined( $algo ) && CORE::length( $algo ) )
99             {
100 0 0       0 $self->_load_class( 'Crypt::Mode::CBC', { version => CRYPTX_VERSION } ) || return( $self->pass_error );
101             # try-catch
102 0         0 local $@;
103             eval
104 0         0 {
105             # Crypt::Mode::CBC dies when it is unhappy, but we catch a null return
106             # value anyway just in case
107 0   0     0 my $o = Crypt::Mode::CBC->new( $algo ) ||
108             die( "Unsupported algorithm \"$algo\"\n" );
109 0         0 $self->_set_get_scalar_as_object( 'algo', $algo );
110 0         0 $self->reset(1);
111             };
112 0 0       0 if( $@ )
113             {
114 0         0 return( $self->error( "Unsupported algorithm \"$algo\": $@" ) );
115             }
116             }
117             else
118             {
119 0         0 $self->{algo} = undef;
120             }
121             }
122 0         0 return( $self->_set_get_scalar_as_object( 'algo' ) );
123             }
124              
125             sub apply
126             {
127 15     15 1 49 my $self = shift( @_ );
128 15         57 my $hash = $self->_get_args_as_hash( @_ );
129 15 50       1866 return( $self ) if( !scalar( keys( %$hash ) ) );
130 15 50 66     245 if( !defined( $SUBS ) ||
      66        
131             ref( $SUBS ) ne 'ARRAY' ||
132             !scalar( @$SUBS ) )
133             {
134 1         57 $SUBS = [grep( /^(?!apply|as_hash|as_string|can|fields|import|init|reset)(?:[a-z][a-z\_]+)$/, keys( %Cookie:: ) )];
135             }
136            
137 15         60 foreach( @$SUBS )
138             {
139             # Value could be undef
140             # Passing an empty string to Module::Generic::Number will trigger an error (undef)
141             # So if the value is empty, we simply set it directly.
142 600 100 100     207016 if( $_ eq 'version' && !CORE::length( $hash->{ $_ } ) )
143             {
144 12         31 $self->{ $_ } = $hash->{ $_ };
145 12         26 next;
146             }
147            
148 588 100       1076 if( CORE::exists( $hash->{ $_ } ) )
149             {
150 107 100       255 if( !defined( $hash->{ $_ } ) )
151             {
152 30         89 $self->{ $_ } = undef;
153             }
154             else
155             {
156 77         442 $self->$_( $hash->{ $_ } );
157             }
158             }
159             }
160 15         124 return( $self );
161             }
162              
163             sub as_hash
164             {
165 6     6 1 20 my $self = shift( @_ );
166 6         24 my $ref = {};
167 6         46 foreach my $m ( qw( name value comment commentURL domain expires http_only implicit max_age path port same_site secure version created_on accessed_on ) )
168             {
169 96         85413 $ref->{ $m } = $self->$m;
170             }
171 6         13856 return( $ref );
172             }
173              
174             # sub as_string { return( shift->APR::Request::Cookie::as_string ); }
175             # https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Set-Cookie
176             sub as_string
177             {
178 38     38 1 10899 my $self = shift( @_ );
179             # If is_request is true, we only send the name and value
180 38         148 my $opts = $self->_get_args_as_hash( @_ );
181 38   100     1720 $opts->{is_request} //= 0;
182 38 0 33     162 return( $self->{_cache_value} ) if( $self->{_cache_value} && !CORE::length( $self->{_reset} ) && !$opts->{is_request} );
      33        
183 38         124 my $name = $self->name;
184 38 50 33     30608 return( $self->error( "No cookie is name in this cookie object." ) ) if( !defined( $name ) || !length( $name ) );
185 38 50       387 if( $name =~ m/[^a-zA-Z\-\.\_\~]/ )
186             {
187 0         0 $name = URI::Escape::uri_escape( $name );
188             }
189 38         396 my $value = $self->value;
190            
191 38 50 33     29937 if( $self->sign || $self->encrypt )
192             {
193 0   0     0 my $key = $self->key ||
194             return( $self->error( "Signature or encryption has been enabled, but no key was provided." ) );
195 0 0       0 if( $self->sign->is_true )
    0          
196             {
197 0 0       0 $self->_load_class( 'Crypt::Mac::HMAC', { version => CRYPTX_VERSION } ) || return( $self->pass_error );
198             # try-catch
199 0         0 local $@;
200             my $signature = eval
201 0         0 {
202 0         0 Crypt::Mac::HMAC::hmac_b64( "SHA256", "$key", "$value" );
203             };
204 0 0       0 if( $@ )
205             {
206 0 0       0 return( $self->error( "An error occurred while trying to ", ( $self->sign ? 'sign' : 'encrypt' ), " cookie value: $@" ) );
207             }
208 0         0 $value = "$value.$signature";
209             }
210             elsif( $self->encrypt )
211             {
212 0 0       0 $self->_load_class( 'Crypt::Misc', { version => CRYPTX_VERSION } ) || return( $self->pass_error );
213 0         0 my $algo = $self->algo;
214 0   0     0 my $p = $self->_encrypt_objects( $key => $algo ) || return( $self->pass_error );
215 0         0 my $crypt = $p->{crypt};
216             # $value = Crypt::Misc::encode_b64( $crypt->encrypt( "$value", $p->{key}, $p->{iv} ) );
217             # try-catch
218 0         0 local $@;
219             my $encrypted = eval
220 0         0 {
221 0         0 $crypt->encrypt( "$value", $p->{key}, $p->{iv} );
222             };
223 0 0       0 if( $@ )
224             {
225 0 0       0 return( $self->error( "An error occurred while trying to ", ( $self->sign ? 'sign' : 'encrypt' ), " cookie value: $@" ) );
226             }
227 0         0 $value = Crypt::Misc::encode_b64( $encrypted );
228             }
229             }
230            
231             # Not necessary to encode, but customary and practical
232 38 50       26080 if( CORE::length( $value ) )
233             {
234 38         253 my $wrapped_in_double_quotes = 0;
235 38 50       72 if( $value =~ /^\"([^\"]+)\"$/ )
236             {
237 0         0 $value = $1;
238 0         0 $wrapped_in_double_quotes = 1;
239             }
240 38         360 $value = URI::Escape::uri_escape( $value );
241 38 50       994 $value = sprintf( '"%s"', $value ) if( $wrapped_in_double_quotes );
242             }
243 38         105 my @parts = ( "${name}=${value}" );
244 38 100       422 return( $parts[0] ) if( $opts->{is_request} );
245 28 50       78 push( @parts, sprintf( 'Domain=%s', $self->domain ) ) if( $self->domain );
246 28 50       18654 push( @parts, sprintf( 'Port=%d', $self->port ) ) if( $self->port );
247 28 100       18053 push( @parts, sprintf( 'Path=%s', $self->path ) ) if( $self->path );
248             # Could be empty. If not specified, it would be a session cookie
249 28 100 100     16692 if( ( my $t = $self->expires ) && !$self->max_age->length )
250             {
251 14         7625 ( my $dt_str = "$t" ) =~ s/\bUTC\b/GMT/;
252 14         3579 push( @parts, sprintf( 'Expires=%s', $dt_str ) );
253             }
254             # Number of seconds until the cookie expires
255             # A zero or negative number will expire the cookie immediately.
256             # If both Expires and Max-Age are set, Max-Age has precedence.
257 28 100       12853 push( @parts, sprintf( 'Max-Age=%d', $self->max_age ) ) if( CORE::length( $self->max_age ) );
258 28 100 100     20054 if( $self->same_site->defined && $self->same_site =~ /^(?:lax|strict|none)/i )
259             {
260 3         2370 push( @parts, sprintf( 'SameSite=%s', ucfirst( lc( $self->same_site ) ) ) );
261             }
262 28 100       15456 push( @parts, 'Secure' ) if( $self->secure );
263 28 100       18360 push( @parts, 'HttpOnly' ) if( $self->http_only );
264 28         18671 my $c = join( '; ', @parts );
265 28         98 $self->{_cache_value} = $c;
266 28         55 CORE::delete( $self->{_reset} );
267 28         154 return( $c );
268             }
269              
270             # A Version 2 cookie, which has been deprecated by protocol
271             # https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Set-Cookie2
272 12     12 1 57 sub comment { return( shift->_set_get_scalar_as_object( 'comment', @_ ) ); }
273              
274             # A Version 2 cookie, which has been deprecated by protocol
275             # https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Set-Cookie2
276 12     12 1 87 sub commentURL { return( shift->_set_get_uri( 'commentURL', @_ ) ); }
277              
278 18     18 1 119640 sub created_on { return( shift->_set_get_datetime( 'created', @_ ) ); }
279              
280             sub decrypt
281             {
282 0     0 1 0 my $self = shift( @_ );
283 0         0 my $opts = $self->_get_args_as_hash( @_ );
284 0         0 my $value = $self->value;
285 0 0       0 return( $value ) if( !$value->length );
286 0   0     0 $opts->{key} //= '';
287 0   0     0 $opts->{algo} //= '';
288 0   0     0 $opts->{iv} //= '';
289 0   0     0 my $key = $opts->{key} || $self->key;
290 0   0     0 my $algo = $opts->{algo} || $self->algo;
291 0 0 0     0 return( $self->error( "Cookie encryption was enabled, but no key was set to decrypt it." ) ) if( !defined( $key ) || !CORE::length( "$key" ) );
292 0 0 0     0 return( $self->error( "Cookie encryption was enabled, but no algorithm was set to decrypt it." ) ) if( !defined( $algo ) || !CORE::length( "$algo" ) );
293 0 0       0 $self->_load_class( 'Crypt::Misc', { version => CRYPTX_VERSION } ) || return( $self->pass_error );
294             # If IV is not provided, _encrypt_objects will generate one and save it for next time
295 0   0     0 my $p = $self->_encrypt_objects( $key => $algo, $opts->{iv} ) || return( $self->pass_error );
296 0         0 my $crypt = $p->{crypt};
297             # try-catch
298 0         0 local $@;
299             my $rv = eval
300 0         0 {
301 0         0 my $bin = Crypt::Misc::decode_b64( "$value" );
302 0         0 return( $crypt->decrypt( "$bin", $p->{key}, $p->{iv} ) );
303             };
304 0 0       0 if( $@ )
305             {
306 0         0 return( $self->error( "An error occurred while trying to decrypt cookie value: $@" ) );
307             }
308 0         0 return( $rv );
309             }
310              
311 9     9 1 50 sub discard { return( shift->_set_get_boolean( 'discard', @_ ) ); }
312              
313 121     121 1 14332 sub domain { return( shift->reset(@_)->_set_get_scalar_as_object( 'domain', @_ ) ); }
314              
315             # To expire a cookie, the domain and path must match that was previously set
316             # <https://datatracker.ietf.org/doc/html/rfc6265#section-3.1>
317             sub elapse
318             {
319 1     1 1 637 my $self = shift( @_ );
320 1         13 $self->expires(0);
321 1         969 return( $self );
322             }
323              
324 38     38 1 26198 sub encrypt { return( shift->reset(@_)->_set_get_boolean( 'encrypt', @_ ) ); }
325              
326             # sub expires { return( shift->APR::Request::Cookie::expires( @_ ) ); }
327             # https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Date
328             # Example: Fri, 13 Dec 2019 02:27:28 GMT
329             sub expires
330             {
331 82     82 1 27349 my $self = shift( @_ );
332 82 100       284 if( @_ )
333             {
334 21         76 $self->reset(1);
335 21         45 my $exp = shift( @_ );
336 21         29 my $tz;
337             # DateTime::TimeZone::Local will die ungracefully if the local timezone is not set with the error:
338             # "Cannot determine local time zone"
339             # try-catch
340 21         36 local $@;
341             $tz = eval
342 21         37 {
343 21         159 DateTime::TimeZone->new( name => 'local' );
344             };
345 21 50       24358 if( $@ )
346             {
347 0         0 $tz = DateTime::TimeZone->new( name => 'UTC' );
348             }
349 21         36 my $dt;
350             # unsets the value
351 21 100 33     201 if( !defined( $exp ) )
    100 66        
    100 33        
    100          
    100          
    50          
352             {
353 1         4 $self->{expires} = undef;
354             }
355             elsif( $exp =~ /^\d{1,10}$/ )
356             {
357             # try-catch
358 3         19 local $@;
359             $dt = eval
360 3         12 {
361             # Unexpectedly, DateTime sets the time zone ONLY after having instantiated the
362             # object and set its time zone to UTC.
363             # Thus, here setting to 'local' (e.g. corresponding to Asia/Tokyo) would
364             # actually set the epoch to GMT+9 instead of treating the epoch time provided
365             # to being in Asia/Tokyo time zone!
366             # Issue #126
367             # <https://github.com/houseabsolute/DateTime.pm/issues/126>
368 3         37 DateTime->from_epoch( epoch => $exp, time_zone => $tz );
369             };
370 3 50       1009 if( $@ )
371             {
372 0         0 return( $self->error( "An error occurred while setting the cookie expiration date time based on the unix timestamp '$exp': $@" ) );
373             }
374             }
375             elsif( $self->_is_object( $exp ) && ( $exp->isa( 'DateTime' ) || $exp->isa( 'Module::Generic::Datetime' ) ) )
376             {
377 2         157 $dt = $exp;
378             }
379             elsif( $exp =~ /^([\+\-]?\d+)([YyMDdhms])?$/ )
380             {
381 9         114 my( $num, $unit ) = ( $1, $2 );
382 9 100       21 $unit = 's' if( !length( $unit ) );
383 9         49 my $interval =
384             {
385             's' => 1,
386             'm' => 60,
387             'h' => 3600,
388             'D' => 86400,
389             'd' => 86400,
390             'M' => 86400 * 30,
391             'Y' => 86400 * 365,
392             'y' => 86400 * 365,
393             };
394 9   50     40 my $offset = ( $interval->{ $unit } || 1 ) * int( $num );
395 9         29 my $ts = time() + $offset;
396 9         90 $dt = DateTime->from_epoch( epoch => $ts, time_zone => $tz );
397             }
398             elsif( lc( $exp ) eq 'now' )
399             {
400 1         27 $dt = DateTime->now( time_zone => $tz );
401             }
402             elsif( defined( $exp ) && CORE::length( $exp ) )
403             {
404 5         384 $dt = $self->_parse_timestamp( $exp );
405 5 50       3749986 return( $self->pass_error ) if( !defined( $dt ) );
406 5 100 50     52 return( $self->error( "Provided expires value '$exp' (", overload::StrVal( $exp // 'undef' ), ") is an invalid expression." ) ) if( !CORE::length( $dt ) );
407             }
408             else
409             {
410             # Don't know what to do with '$exp'.
411             }
412            
413 20 100       5960 if( defined( $dt ) )
414             {
415 19 50       121 $dt = $self->_header_datetime( $dt ) if( $self->_is_a( $dt, 'DateTime' ) );
416 19 50       290 $self->{expires} = $dt->isa( 'Module::Generic::DateTime' ) ? $dt : Module::Generic::DateTime->new( $dt );
417             }
418             }
419 81         10461 return( $self->_set_get_datetime( 'expires' ) );
420             }
421              
422 3     3 1 30 sub fields { return( shift->_set_get_array_as_object( 'fields', @_ ) ); }
423              
424 0     0 1 0 sub host { return( shift->domain( @_ ) ); }
425              
426 12     12 1 82 sub host_only { return( shift->implicit( @_ ) ); }
427              
428 46     46 1 1739 sub http_only { return( shift->reset(@_)->_set_get_boolean( 'http_only', @_ ) ); }
429              
430 0     0 1 0 sub httponly { return( shift->http_only( @_ ) ); }
431              
432 32     32 1 130 sub implicit { return( shift->reset(@_)->_set_get_boolean( 'implicit', @_ ) ); }
433              
434             # For cookie encryption
435 0     0 1 0 sub initialisation_vector { return( shift->_set_get_scalar_as_object( 'initialisation_vector', @_ ) ); }
436              
437             sub is_expired
438             {
439 0     0 1 0 my $self = shift( @_ );
440 0         0 my $exp = $self->expires;
441 0         0 my $max_age = $self->max_age;
442 0 0 0     0 return( $self->false ) if( !defined( $exp ) && !defined( $max_age ) );
443 0 0 0     0 if( ( defined( $exp ) && !$self->_is_a( $exp, 'Module::Generic::DateTime' ) && !$self->_is_a( $exp, 'DateTime' ) ) ||
      0        
      0        
      0        
444             ( defined( $max_age ) && $max_age !~ /\-?\d+$/ ) )
445             {
446 0         0 return( $self->false );
447             }
448 0         0 my $now = DateTime->now;
449 0 0 0     0 if( ( defined( $max_age ) && $max_age <= 0 ) ||
      0        
      0        
450             ( defined( $exp ) && $exp < $now ) )
451             {
452 0         0 return( $self->true );
453             }
454             else
455             {
456 0         0 return( $self->false );
457             }
458             }
459              
460 0     0 1 0 sub is_persistent { return( !shift->is_session ); }
461              
462             sub is_session
463             {
464 0     0 1 0 my $self = shift( @_ );
465 0 0 0     0 return( defined( $self->expires ) || defined( $self->max_age ) ? $self->false : $self->true );
466             }
467              
468 0     0 1 0 sub is_tainted { return( shift->_set_get_boolean( 'is_tainted', @_ ) ); }
469              
470             sub is_valid
471             {
472 0     0 1 0 my $self = shift( @_ );
473 0         0 my $opts = $self->_get_args_as_hash( @_ );
474 0   0     0 $opts->{key} ||= $self->key || '';
      0        
475 0 0 0     0 return( $self->true ) if( !$self->sign && !CORE::length( $opts->{key} ) );
476 0 0 0     0 return( $self->error( "Signature validation is required, but no key has been set." ) ) if( !$self->key->length && !CORE::exists( $opts->{key} ) || ( CORE::exists( $opts->{key} ) && !CORE::length( $opts->{key} ) ) );
      0        
      0        
477 0         0 my $value = $self->value;
478 0 0       0 return( $self->true ) if( !$value->length );
479 0 0       0 if( $value->index( '.' ) == -1 )
480             {
481             # Not an error, so we only issue a warning if warnings are enabled
482 0 0       0 warnings::warn( "The cookie does not have a signature attached to it." ) if( warnings::enabled() );
483 0         0 return( $self->false );
484             }
485 0         0 my @parts = $value->split( '.' );
486             # We take the last one, because the cookie name, itself, could potentially contain dots.
487             # The value must be an uri unescaped value
488 0         0 my $sig = pop( @parts );
489 0         0 my $orig = join( '.', @parts );
490 0         0 my $key = $opts->{key};
491 0 0       0 $self->_load_class( 'Crypt::Mac::HMAC', { version => CRYPTX_VERSION } ) || return( $self->pass_error );
492             # try-catch
493 0         0 local $@;
494             my $check = eval
495 0         0 {
496 0         0 Crypt::Mac::HMAC::hmac_b64( 'SHA256', "$key", "$orig" );
497             };
498 0 0       0 if( $@ )
499             {
500 0         0 return( $self->error( "An error occurred while trying to check the cookie signature validation: $@" ) );
501             }
502 0         0 return( "$check" eq "$sig" );
503             }
504              
505 0     0 1 0 sub iv { return( shift->initialisation_vector( @_ ) ); }
506              
507 0     0 1 0 sub key { return( shift->_set_get_scalar_as_object( 'key', @_ ) ); }
508              
509             # Check if the cookie domain is within the host provided, i.e.
510             # wether this cookie should be sent as part of the request
511             sub match_host
512             {
513 0     0 1 0 my $self = shift( @_ );
514             # e.g. www.example.com
515 0   0     0 my $host = shift( @_ ) || return(0);
516 0         0 $host = lc( $host );
517             # and ours could be just example.com
518 0         0 my $dom = $self->domain;
519 0 0       0 return(1) if( $host eq $dom );
520             # if our domain is longer than $host, then we are not a match as we should be a subset
521             # e.g. ours www.ja.example.com vs $host ja.example.com
522 0 0       0 return(0) if( CORE::length( $dom ) > CORE::length( $host ) );
523             # our cookie domain has been set implicitly and since we are not an exact match,
524             # no need to go further.
525 0 0       0 unless( $self->implicit )
526             {
527 0 0       0 return( $host =~ /\.${dom}$/ ? 1 : 0 );
528             }
529 0         0 return(0);
530             }
531              
532             # sub max_age { return( shift->reset(@_)->_set_get_scalar( 'max_age', @_ ) ); }
533             sub max_age
534             {
535 60     60 1 17483 my $self = shift( @_ );
536 60 100       159 if( @_ )
537             {
538 2         8 $self->reset( @_ );
539 2         5 my $v = shift( @_ );
540 2 50       11 if( !defined( $v ) )
541             {
542 0         0 $self->{max_age} = undef;
543             }
544             else
545             {
546 2 50       21 return( $self->error( "Invalid max-age value '$v'" ) ) if( $v !~ /^\-?\d+$/ );
547 2         10 $v = int( $v );
548             # "If both Expires and Max-Age are set, Max-Age has precedence"
549             # <https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Set-Cookie>
550 2         4 my $exp;
551 2 100       6 if( $v <= 0 )
552             {
553 1         16 $exp = DateTime->new(
554             year => 1970,
555             month => 1,
556             day => 1,
557             hour => 0,
558             minute => 0,
559             second => 0,
560             time_zone => 'GMT',
561             );
562             }
563             else
564             {
565 1         13 my $tz;
566             # DateTime::TimeZone::Local will die ungracefully if the local timezeon is not set with the error:
567             # "Cannot determine local time zone"
568             # try-catch
569 1         7 local $@;
570             $tz = eval
571 1         2 {
572 1         10 DateTime::TimeZone->new( name => 'local' );
573             };
574 1 50       671 if( $@ )
575             {
576 0         0 $tz = DateTime::TimeZone->new( name => 'UTC' );
577             }
578 1         17 $exp = DateTime->now( time_zone => $tz );
579 1         610 $exp->add( seconds => $v );
580             }
581 2         1993 $self->expires( $exp );
582 2         1929 return( $self->_set_get_number( 'max_age' => $v ) );
583             }
584             }
585 58         205 return( $self->_set_get_number( 'max_age' ) );
586             }
587              
588 0     0 1 0 sub maxage { return( shift->max_age( @_ ) ); }
589              
590             sub name
591             {
592 160     160 1 54977 my $self = shift( @_ );
593 160 100       619 if( @_ )
594             {
595 44         184 $self->reset( @_ );
596 44         94 my $name = shift( @_ );
597             # https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Set-Cookie
598 44 50 33     320 if( $name =~ /[\(\)\<\>\@\,\;\:\\\"\/\[\]\?\=\{\}]/ && $self->strict )
599             {
600 0         0 return( $self->error( "A cookie name can only contain US ascii characters. Cookie name provided was '$name'." ) );
601             }
602 44 50       330 if( $name =~ s/^__Secure\-// )
    50          
603             {
604 0         0 $self->secure(1);
605             }
606             elsif( $name =~ s/^__Host\-// )
607             {
608 0         0 $self->secure(1);
609 0 0       0 $self->path( '/' ) if( !$self->path->length );
610             }
611 44         190 $self->_set_get_scalar_as_object( 'name' => $name );
612             }
613 160         81375 return( $self->_set_get_scalar_as_object( 'name' ) );
614             }
615              
616 148     148 1 200240 sub path { return( shift->reset(@_)->_set_get_scalar_as_object( 'path', @_ ) ); }
617              
618 66     66 1 19674 sub port { return( shift->reset(@_)->_set_get_number( 'port', @_ ) ); }
619              
620             sub reset
621             {
622 754     754 1 1299 my $self = shift( @_ );
623 754 50 100     2367 $self->{_reset} = scalar( @_ ) if( !CORE::length( $self->{_reset} ) && scalar( @_ ) );
624 754         2450 return( $self );
625             }
626              
627             sub same_as
628             {
629 3     3 1 14 my $self = shift( @_ );
630 3         14 my $this = shift( @_ );
631 3 50 33     14 return(0) if( !$this || !$self->_is_object( $this ) );
632 3         44 my $fields = $self->fields;
633 3         2442 foreach my $f ( @$fields )
634             {
635 45         692 my $v = $self->$f;
636 45         35993 my $code = $this->can( $f );
637 45 50       131 return(0) if( !$code );
638 45         79 my $v2 = $code->( $this );
639 45 50 66     36084 if( ( !defined( $v ) && defined( $v2 ) ) ||
      66        
      33        
      66        
      33        
      66        
      66        
      33        
640             ( defined( $v ) && !defined( $v2 ) ) ||
641             ( defined( $v ) && length( "$v" ) != length( "$v2" ) ) ||
642             ( defined( $v ) && defined( $v2 ) && "$v" ne "$v2" ) )
643             {
644 0         0 return(0);
645             }
646             }
647 3         26 return(1);
648             }
649              
650 51     51 1 3340 sub same_site { return( shift->reset(@_)->_set_get_scalar_as_object( 'same_site', @_ ) ); }
651              
652 0     0 1 0 sub samesite { return( shift->same_site( @_ ) ); }
653              
654 51     51 1 1816 sub secure { return( shift->reset(@_)->_set_get_boolean( 'secure', @_ ) ); }
655              
656 38     38 1 111 sub sign { return( shift->reset(@_)->_set_get_boolean( 'sign', @_ ) ); }
657              
658 0     0 1 0 sub strict { return( shift->reset(@_)->_set_get_boolean( 'strict', @_ ) ); }
659              
660             sub uri
661             {
662 0     0 1 0 my $self = shift( @_ );
663 0 0       0 if( @_ )
    0          
664             {
665 0         0 $self->reset( @_ );
666 0   0     0 my $uri = $self->_set_get_uri( 'uri', @_ ) || return;
667 0         0 $self->port( $uri->port );
668 0         0 $self->path( $uri->path );
669 0         0 $self->domain( $uri->host );
670             }
671             elsif( $self->domain )
672             {
673 0 0       0 my $uri =
    0          
    0          
674             ( $self->secure ? 'https' : 'http' ) . '://' .
675             $self->domain .
676             ( $self->port ? ':' . $self->port : '' ) .
677             ( $self->path ? $self->path : '/' );
678 0         0 return( $self->_set_get_uri( 'uri' => $uri ) );
679             }
680 0         0 return( $self->_set_get_uri( 'uri' ) );
681             }
682              
683 96     96 1 17219 sub value { return( shift->reset(@_)->_set_get_scalar_as_object( 'value', @_ ) ); }
684              
685             # Deprecated. Was a version 2 cookie spec: https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Set-Cookie2
686 15     15 1 94 sub version { return( shift->_set_get_number( 'version', @_ ) ); }
687              
688             sub _encrypt_objects
689             {
690 0     0   0 my $self = shift( @_ );
691 0         0 my( $key, $algo, $iv ) = @_;
692 0 0 0     0 return( $self->error( "Key provided is empty!" ) ) if( !defined( $key ) || !CORE::length( "$key" ) );
693 0 0 0     0 return( $self->error( "No algorithm was provided to encrypt cookie value. You can choose any <NAME> for which there exists Crypt::Cipher::<NAME>" ) ) if( !defined( $algo ) || !CORE::length( "$algo" ) );
694 0   0     0 $iv //= '';
695              
696 0 0       0 $self->_load_class( 'Crypt::Mode::CBC', { version => CRYPTX_VERSION } ) || return( $self->pass_error );
697 0 0       0 $self->_load_class( 'Bytes::Random::Secure' ) || return( $self->pass_error );
698             my $crypt = eval
699 0         0 {
700 0         0 Crypt::Mode::CBC->new( "$algo" );
701             };
702 0 0       0 if( $@ )
703             {
704 0         0 return( $self->error( "Error getting the encryption objects for algorithm \"$algo\": $@" ) );
705             }
706 0 0       0 $crypt or return( $self->error( "Unable to create a Crypt::Mode::CBC object." ) );
707 0         0 my $class = "Crypt::Cipher::${algo}";
708 0 0       0 $self->_load_class( $class ) || return( $self->pass_error );
709 0         0 my $key_len = $class->keysize;
710 0         0 my $block_len = $class->blocksize;
711 0 0       0 return( $self->error( "The size of the key provided (", CORE::length( $key ), ") does not match the minimum key size required for this algorithm \"$algo\" (${key_len})." ) ) if( CORE::length( $key ) < $key_len );
712             # Generate an "IV", i.e. Initialisation Vector based on the required block size
713 0   0     0 $iv ||= $self->initialisation_vector;
714 0 0 0     0 if( defined( $iv ) && CORE::length( "$iv" ) )
715             {
716 0 0       0 if( CORE::length( "$iv" ) != $block_len )
717             {
718 0         0 return( $self->error( "The Initialisation Vector provided for cookie encryption has a length (", CORE::length( "$iv" ), ") which does not match the algorithm ($algo) size requirement ($block_len). Please refer to the cookie documentation Cookie" ) );
719             }
720             }
721             else
722             {
723             $iv = eval
724 0         0 {
725 0         0 Bytes::Random::Secure::random_bytes( $block_len );
726             };
727 0 0       0 if( $@ )
728             {
729 0         0 return( $self->error( "Error getting $block_len random secure bytes for algorithm \"$algo\": $@" ) );
730             }
731             # Save it for decryption
732 0         0 $self->initialisation_vector( $iv );
733             }
734 0         0 my $key_pack = pack( 'H' x $key_len, $key );
735 0         0 my $iv_pack = pack( 'H' x $block_len, $iv );
736 0         0 return({ 'crypt' => $crypt, key => $key_pack, iv => $iv_pack });
737             }
738              
739             sub _header_datetime
740             {
741 19     19   847 my $self = shift( @_ );
742 19         28 my $dt;
743 19 50       50 if( @_ )
744             {
745 19 50       62 return( $self->error( "Date time provided ($dt) is not an object." ) ) if( !$self->_is_object( $_[0] ) );
746 19 50       214 return( $self->error( "Object provided (", ref( $_[0] ), ") is not a DateTime object." ) ) if( !$_[0]->isa( 'DateTime' ) );
747 19         32 $dt = shift( @_ );
748             }
749 19 50       59 $dt = DateTime->now if( !defined( $dt ) );
750 19         66 $dt->set_time_zone( 'GMT' );
751 19         4444 my $fmt = DateTime::Format::Strptime->new(
752             pattern => '%a, %d %b %Y %H:%M:%S GMT',
753             locale => 'en_GB',
754             time_zone => 'GMT',
755             );
756 19         32175 $dt->set_formatter( $fmt );
757 19         1313 return( $dt );
758             }
759              
760             sub TO_JSON
761             {
762 0     0 1   my $self = shift( @_ );
763 0           my $fields = $self->fields;
764 0           my $ref = {};
765 0           foreach my $m ( @$fields )
766             {
767 0           $ref->{ $m } = $self->$m;
768             }
769 0           return( $ref );
770             }
771              
772             1;
773             # NOTE: POD
774             __END__
775              
776             =encoding utf8
777              
778             =head1 NAME
779              
780             Cookie - Cookie Object with Encryption or Signature
781              
782             =head1 SYNOPSIS
783              
784             use Cookie;
785             my $c = Cookie->new(
786             name => 'my-cookie',
787             domain => 'example.com',
788             value => 'sid1234567',
789             path => '/',
790             expires => '+10D',
791             # or alternatively
792             maxage => 864000
793             # to make it exclusively accessible by regular http request and not javascript
794             http_only => 1,
795             same_site => 'Lax',
796             # should it be used under ssl only?
797             secure => 1,
798             );
799             # make the cookie expired
800             # Sets the expiration datetime to Thu, 01 Jan 1970 09:00:00 GMT
801             $c->elapse;
802             # Get cookie as an hash reference
803             my $hash = $c->as_hash;
804             print $c->as_string, "\n";
805             # or
806             print "$c\n";
807             # If expires is set, we can use its underlying DateTime object
808             my $now = DateTime->now;
809             if( $c->expires && $c->expires > $now )
810             {
811             # ok, we're good
812             }
813             # Unset expiration, effectively transforming it into a session cookie
814             $c->expires( undef );
815             print "Is session cookie? ", $c->is_session ? 'yes' : 'no', "\n";
816             $c->match_host( 'www.example.com' );
817             # Set max-age (in seconds) that takes precedence over expiration
818             $c->max_age( 86400 );
819             # Make it expired to tell the http client to remove it:
820             $c->max_age(0) # or $c->max_age(-1)
821             # Unset max-age
822             $c->max_age( undef );
823             print "Is it same? ", $c->same_as( $other ) ? 'yes' : 'no', "\n";
824             # Conveniently set port, path and domain in one go, but not the secure flag
825             $c->uri( 'https://www.example.com:8080/some/where' );
826              
827             # Create encrypted cookie
828             # You can generate a key or type one as long as it meets the size requirement
829             use Bytes::Random::Secure ();
830             my $c = Cookie->new(
831             name => 'my-cookie',
832             domain => 'example.com',
833             value => 'sid1234567',
834             path => '/',
835             expires => '+10D',
836             # or alternatively
837             maxage => 864000
838             # to make it exclusively accessible by regular http request and not ajax
839             http_only => 1,
840             same_site => 'Lax',
841             # should it be used under ssl only?
842             secure => 1,
843             # Encryption parameters
844             key => Bytes::Random::Secure::random_bytes(32),
845             algo => 'AES',
846             encrypt => 1,
847             );
848             print( "My encrypted cookie: $c\n" );
849              
850             # Sign cookie only
851             my $c = Cookie->new(
852             name => 'my-cookie',
853             domain => 'example.com',
854             value => 'sid1234567',
855             path => '/',
856             expires => '+10D',
857             # or alternatively
858             maxage => 864000
859             # to make it exclusively accessible by regular http request and not ajax
860             http_only => 1,
861             same_site => 'Lax',
862             # should it be used under ssl only?
863             secure => 1,
864             # Encryption parameters
865             # No size constraint for signature, but obviously the longer the better
866             key => Bytes::Random::Secure::random_bytes(32),
867             sign => 1,
868             );
869             print( "My signed cookie: $c\n" );
870              
871             =head1 VERSION
872              
873             v0.3.2
874              
875             =head1 DESCRIPTION
876              
877             This is a powerful and versatile package to create and represent a cookie compliant with the latest standard as set by L<rfc6265|https://datatracker.ietf.org/doc/html/rfc6265>. This can be used as a standalone module, or can be managed as part of the cookie jar L<Cookie::Jar>
878              
879             The object is overloaded and will call L</as_string> upon stringification and can also be used in comparison with other cookie object:
880              
881             if( $cookie1 eq $cookie2 )
882             {
883             # do something
884             }
885              
886             This module does not die upon error, but instead returns C<undef> and sets an L<error|Module::Generic/error>, so you should always check the return value of a method.
887              
888             See also the L<Cookie::Jar> package to manage server and client side handling of cookies:
889              
890             use Cookie::Jar;
891             # Possibly passing the cookie repository the Apache2::RequestRec object
892             my $jar = Cookie::Jar->new( $r );
893             my $c = $jar->make(
894             name => 'my_cookie',
895             value => 'some value',
896             domain => 'example.org',
897             path => '/',
898             secure => 1,
899             http_only => 1,
900             ) || die( $jar->error );
901             # Set it in the server response C<Set-Cookie> header:
902             $jar->set( $c ) || die( $jar->error );
903              
904             =head1 METHODS
905              
906             =head2 new
907              
908             Provided with an hash or hash reference of parameters, and this initiates a new cookie object and return it. Each of the following parameters has a corresponding method.
909              
910             =over 4
911              
912             =item * C<debug>
913              
914             Optional. If set with a positive integer, this will activate verbose debugging message
915              
916             =item * C<name>
917              
918             String.
919              
920             See also L</name>
921              
922             =item * C<value>
923              
924             String.
925              
926             See also L</value>
927              
928             =item * C<comment>
929              
930             String.
931              
932             See also L</comment>
933              
934             =item * C<commentURL>
935              
936             URI string or object.
937              
938             See also L</commentURL>
939              
940             =item * C<discard>
941              
942             Boolean.
943              
944             See also L</discard>
945              
946             =item * C<domain>
947              
948             String.
949              
950             See also L</domain>
951              
952             =item * C<expires>
953              
954             Datetime str | DateTime object | integer
955              
956             See also L</expires>
957              
958             =item * C<http_only>
959              
960             Boolean,
961              
962             See also L</http_only>
963              
964             =item * C<implicit>
965              
966             Boolean.
967              
968             See also L</implicit>
969              
970             =item * C<max_age>
971              
972             Integer.
973              
974             See also L</max_age>
975              
976             =item * C<path>
977              
978             String.
979              
980             See also L</path>
981              
982             =item * C<port>
983              
984             Integer.
985              
986             See also L</port>
987              
988             =item * C<same_site>
989              
990             String.
991              
992             See also L</same_site>
993              
994             =item * C<secure>
995              
996             Boolean.
997              
998             See also L</secure>
999              
1000             =item * C<version>
1001              
1002             Integer.
1003              
1004             See also L</version>
1005              
1006             =back
1007              
1008             Other extra parameters not directly related to the cookie standard:
1009              
1010             =over 4
1011              
1012             =item * C<accessed_on>
1013              
1014             Datetime.
1015              
1016             See also L</accessed_on>
1017              
1018             =item * C<algo>
1019              
1020             String.
1021              
1022             See also L</algo>
1023              
1024             =item * C<created_on>
1025              
1026             Datetime.
1027              
1028             See also L</created_on>
1029              
1030             =item * C<encrypt>
1031              
1032             Boolean.
1033              
1034             See also L</encrypt>
1035              
1036             =item * C<key>
1037              
1038             String.
1039              
1040             See also L</key>
1041              
1042             =item * C<sign>
1043              
1044             Boolean.
1045              
1046             See also L</sign>
1047              
1048             =back
1049              
1050             =head2 accessed_on
1051              
1052             Set or get the datetime of the cookie object last accessed.
1053              
1054             According to L<rfc6265, section 5.3.12.3|https://datatracker.ietf.org/doc/html/rfc6265#section-5.3>, when deciding which cookies to remove, for those who have equal removal priority:
1055              
1056             "If two cookies have the same removal priority, the user agent MUST evict the cookie with the earliest last-access date first."
1057              
1058             =head2 algo
1059              
1060             This set or get the the algorithm used to encrypt the cookie value.
1061              
1062             It can be any of L<AES|Crypt::Cipher::AES>, L<Anubis|Crypt::Cipher::Anubis>, L<Blowfish|Crypt::Cipher::Blowfish>, L<CAST5|Crypt::Cipher::CAST5>, L<Camellia|Crypt::Cipher::Camellia>, L<DES|Crypt::Cipher::DES>, L<DES_EDE|Crypt::Cipher::DES_EDE>, L<KASUMI|Crypt::Cipher::KASUMI>, L<Khazad|Crypt::Cipher::Khazad>, L<MULTI2|Crypt::Cipher::MULTI2>, L<Noekeon|Crypt::Cipher::Noekeon>, L<RC2|Crypt::Cipher::RC2>, L<RC5|Crypt::Cipher::RC5>, L<RC6|Crypt::Cipher::RC6>, L<SAFERP|Crypt::Cipher::SAFERP>, L<SAFER_K128|Crypt::Cipher::SAFER_K128>, L<SAFER_K64|Crypt::Cipher::SAFER_K64>, L<SAFER_SK128|Crypt::Cipher::SAFER_SK128>, L<SAFER_SK64|Crypt::Cipher::SAFER_SK64>, L<SEED|Crypt::Cipher::SEED>, L<Skipjack|Crypt::Cipher::Skipjack>, L<Twofish|Crypt::Cipher::Twofish>, L<XTEA|Crypt::Cipher::XTEA>, L<IDEA|Crypt::Cipher::IDEA>, L<Serpent|Crypt::Cipher::Serpent> or simply any <NAME> for which there exists Crypt::Cipher::<NAME>
1063              
1064             See also L<Stackoverflow on the choice of encryption algorithm|https://stackoverflow.com/questions/4147451/aes-vs-blowfish-for-file-encryption>
1065              
1066             By default, the algorithm is set to C<AES>
1067              
1068             If the algorithm set is unsupported, this method returns an L<error|Module::Generic/error>
1069              
1070             It returns the current value as a L<scalar object|Module::Generic::Scalar>
1071              
1072             =head2 apply
1073              
1074             Provided with an hash ore hash reference of cookie parameter, and this will apply them to each of their equivalent method.
1075              
1076             $c->apply(
1077             expires => 'now',
1078             secure => 1,
1079             http_only => 1,
1080             );
1081              
1082             In the example above, this will call methods L</expires>, L</secure> and L</http_only> passing them the relevant values.
1083              
1084             It returns the current object.
1085              
1086             =head2 as_hash
1087              
1088             Returns an hash reference of the cookie value.
1089              
1090             The hash reference returned will contain the following keys: C<name> C<value> C<comment> C<commentURL> C<domain> C<expires> C<http_only> C<implicit> C<max_age> C<path> C<port> C<same_site> C<secure> C<version>
1091              
1092             =head2 as_string
1093              
1094             Returns a string representation of the object.
1095              
1096             my $cookie_string = $cookie->as_string;
1097             # or
1098             my $cookie_string = "$cookie";
1099             my-cookie="sid1234567"; Domain=example.com; Path=/; Expires=Mon, 09 Jan 2020 12:17:30 GMT; Secure; HttpOnly
1100              
1101             If encryption is enabled with L</encrypt>, the cookie value will be encrypted using the key provided with L</key> and the L<Initialisation Vector|/initialisation_vector>. If the latter was not provided, it will be generated automatically. The resulting encrypted value is then encoded in base64 and escaped. For example:
1102              
1103             my $cookie_value = "toc_ok=1";
1104             my $key = Bytes::Random::Secure::random_bytes(32);
1105             # result:
1106             # session=PyJTlRJniAYVJJF6%2FswuPw%3D%3D; Path=/; SameSite=Lax; Secure; HttpOnly
1107              
1108             If cookie signature is enabled for integrity protection with L</sign>, an sha256 hmac will be generated using the key provided with L</key> and the resulting hash appended to the cookie value separated by a dot. For example:
1109              
1110             my $cookie_value = "toc_ok=1";
1111             my $key = "hard to guess key";
1112             # I2M4/rh/TiNV5RZDSBJkhLblBvrN5k9448G6w/gp/jg=
1113             my $signature = Crypt::Mac::HMAC::hmac_b64( $key, $cookie_value );
1114             # result: toc_ok=1.I2M4/rh/TiNV5RZDSBJkhLblBvrN5k9448G6w/gp/jg=
1115             # ultimately the cookie value sent will be:
1116             # toc_ok%3D1.I2M4%2Frh%2FTiNV5RZDSBJkhLblBvrN5k9448G6w%2Fgp%2Fjg%3D
1117              
1118             The returned value is cached so the next time, it simply return the cached version and not re-process it. You can reset it by calling L</reset>.
1119              
1120             =head2 comment
1121              
1122             $cookie->comment( 'Some comment' );
1123             my $comment = $cookie->comment;
1124              
1125             Sets or gets the optional comment for this cookie. This was used in version 2 of cookies but has since been deprecated.
1126              
1127             Returns a L<Module::Generic::Scalar> object.
1128              
1129             =head2 commentURL
1130              
1131             $cookie->commentURL( 'https://example.com/some/where.html' );
1132             my $comment = $cookie->commentURL;
1133              
1134             Sets or gets the optional comment URL for this cookie. This was used in version 2 of cookies but has since been deprecated.
1135              
1136             Returns an L<URI> object.
1137              
1138             =head2 created_on
1139              
1140             Set or get the datetime of the cookie object created. This value is primarily used by L<Cookie::Jar>, as per the rfc6265, when setting the http request header C<Cookie> to differentiate two cookies that share the same domain and path. The cookie that has their creation datetime earlier are set first:
1141              
1142             "Among cookies that have equal-length path fields, cookies with earlier creation-times are listed before cookies with later creation-times." (L<rfc6265, section 5.4.2|https://datatracker.ietf.org/doc/html/rfc6265#section-5.4>)
1143              
1144             =head2 decrypt
1145              
1146             This returns the cookie decrypted value. If it used on a non-encrypted cookie, this would return C<undef> and set an L<error|Module::Generic/error>
1147              
1148             It takes an optional hash or hash reference of parameters:
1149              
1150             =over 4
1151              
1152             =item I<algo> string
1153              
1154             The algorithm to use for encryption. Defaults to the value set with L</algo>. See this method for more information on acceptable values.
1155              
1156             =item I<iv> string
1157              
1158             The Initialisation Vector used for encryption and decryption. Default to the value set with L</initialisation_vector>
1159              
1160             =item I<key> string
1161              
1162             The encryption key. Defaults to the value set with L</key>
1163              
1164             =back
1165              
1166             =head2 discard
1167              
1168             Boolean. Set or get this value to true to flag this cookie to be discarded, whatever that means to you the user. This is not a standard protocol property.
1169              
1170             This method is used in L<Cookie::Jar/save_as_lwp> and L<Cookie::Jar/save_as_netscape> with the option C<skip_discard>
1171              
1172             It returns the current value as a L<Module::Generic::Boolean> object.
1173              
1174             =head2 domain
1175              
1176             $cookie->domain( 'example.com' );
1177             my $dom = $cookie->domain;
1178              
1179             Sets or gets the domain for this cookie.
1180              
1181             Returns the current value as a L<Module::Generic::Scalar> object.
1182              
1183             Note that you can also call it using the alias method C<host>
1184              
1185             =head2 elapse
1186              
1187             Set the C<expires> value for this cookie to C<0>, which, in turn, will set it to C<Thu, 01 Jan 1970 09:00:00 GMT>
1188              
1189             When sent to the http client, this will have the effect of removing the cookie.
1190              
1191             See L<rfc6265|https://datatracker.ietf.org/doc/html/rfc6265#section-3.1> for more information.
1192              
1193             =head2 encrypt
1194              
1195             Set or get the boolean value. If true, the this will tell L</as_string> to encrypt the cookie value.
1196              
1197             To use this feature, an encryption L<key|/key> must be set and the module L<Crypt::Cipher> must be installed.
1198              
1199             You can read more about the differences between L<sign and encryption at Stackoverflow|https://stackoverflow.com/questions/41467012/what-is-the-difference-between-signed-and-encrypted-cookies-in-rails>
1200              
1201             =head2 expires
1202              
1203             Sets or gets the expiration date and time for this cookie.
1204              
1205             The value provided can be one of:
1206              
1207             =over 4
1208              
1209             =item A date compliant with L<rfc7231|https://datatracker.ietf.org/doc/html/rfc7231#section-7.1.1.1>
1210              
1211             For example: C<01 Nov 2021 08:42:17 GMT>
1212              
1213             =item unix timestamp.
1214              
1215             For example: C<1631099228>
1216              
1217             =item variable time.
1218              
1219             For example: C<30s> (30 seconds), C<5m> (5 minutes), C<12h> (12 hours), C<30D> (30 days), C<2M> (2 months), C<1Y> (1 year)
1220              
1221             However, this is not sprintf, so you cannot combine them, thus B<you cannot do this>: C<5m1D>
1222              
1223             =item C<now>
1224              
1225             Special keyword
1226              
1227             =item In last resort, the value provided will be parsed using L<Module::Generic/_parse_timestamp>. If parsing fails, it will return C<undef> and set an error.
1228              
1229             =back
1230              
1231             Ultimately, a L<DateTime> will be derived from those values, or C<undef> will be returned and an error will be set.
1232              
1233             The L<DateTime> object will be set with a formatter to allow a stringification that is compliant with rfc6265.
1234              
1235             And you can use L</max_age> alternatively.
1236              
1237             See also L<https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Date>
1238              
1239             Note that a cookie without an expiration datetime is referred as a C<session cookie>, so setting the cookie expiration change a cookie from being a session cookie to being a more permanent cookie.
1240              
1241             As L<documented|https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Set-Cookie>, if expiration is "unspecified, the cookie becomes a session cookie. A session finishes when the client shuts down, after which the session cookie is removed."
1242              
1243             =head2 fields
1244              
1245             Returns an L<array object|Module::Generic::Array> of cookie fields available. This is essentially used by L</apply>
1246              
1247             =head2 host
1248              
1249             Alias for L</domain>
1250              
1251             =head2 host_only
1252              
1253             This is an alias for L</implicit>. It has been added to comply with the language of L<rfc6265, section 5.3.6|https://datatracker.ietf.org/doc/html/rfc6265#section-5.3>
1254              
1255             If the domain attribute was not provided by the server for this cookie, then:
1256             "set the cookie's host-only-flag to true." and "set the cookie's domain to the canonicalized request-host"
1257              
1258             Returns the current value as a L<Module::Generic::Boolean> object (that is stringifyable).
1259              
1260             =head2 http_only
1261              
1262             Sets or gets the boolean for C<httpOnly>
1263              
1264             Returns a L<Module::Generic::Boolean> object.
1265              
1266             =head2 httponly
1267              
1268             Alias for L</http_only>
1269              
1270             =head2 implicit
1271              
1272             This boolean is set to true if the L<domain|/domain> was not initially set and has been derived from the current host.
1273              
1274             Returns a L<Module::Generic::Boolean> object.
1275              
1276             =head2 initialisation_vector
1277              
1278             Set or get the L<Initialisation Vector|https://en.wikipedia.org/wiki/Initialization_vector> used for cookie encryption. If you do not provide one, it will be automatically generated. If you want to provide your own, make sure the size meets the encryption algorithm size requirement.
1279              
1280             To find the right size for the Initialisation Vector, for example for algorithm C<AES>, you could do:
1281              
1282             perl -MCrypt::Cipher::AES -lE 'say Crypt::Cipher::AES->blocksize'
1283              
1284             which would yield C<16>
1285              
1286             =head2 is_expired
1287              
1288             Returns true if this cookie has an expiration datetime set and it has expired, i.e. the expiration datetime is in the past. Otherwise, it returns false.
1289              
1290             Return value is in the form of a L<Module::Generic::Boolean> object that stringifies to 1 or 0;
1291              
1292             =head2 is_persistent
1293              
1294             Boolean. This returns true if the cookie sent from the server is not a session cookie, i.e. it has an L</expires> value set.
1295              
1296             See L<rfc62655, section 5.3.3|https://datatracker.ietf.org/doc/html/rfc6265#section-5.3>
1297              
1298             =head2 is_session
1299              
1300             Returns true if this is a session cookie, i.e. it has no expiration datetime nor any L</max_age> set, otherwise, it returns false.
1301              
1302             Return value is in the form of a L<Module::Generic::Boolean> object that stringifies to 1 or 0;
1303              
1304             =head2 is_tainted
1305              
1306             Sets or gets the boolean value. This is a legacy method of old cookie module, but not used anymore.
1307              
1308             Returns a L<Module::Generic::Boolean> object.
1309              
1310             =head2 is_valid
1311              
1312             This takes an optional hash or hash reference of parameters.
1313              
1314             It returns true if the cookie was signed and the signature is valid, or false otherwise.
1315              
1316             If an error occurred, this method returns C<undef> and sets an L<error|Module::Generic/error> instead, so check the return value.
1317              
1318             my $rv = $c->is_valid;
1319             die( $c->error ) if( !defined( $rv ) );
1320             print( "Cookie is valid? ", $rv ? 'yes' : 'no', "\n" );
1321              
1322             Return value is in the form of a L<Module::Generic::Boolean> object that stringifies to 1 or 0;
1323              
1324             Possible parameters are:
1325              
1326             =over 4
1327              
1328             =item I<key> string
1329              
1330             The encryption key to use to sign and verify the cookie signature. Defaults to the value set with L</key>
1331              
1332             =back
1333              
1334             =head2 iv
1335              
1336             This is an alias for L</initialisation_vector>
1337              
1338             =head2 key
1339              
1340             Set or get the encryption key used to encrypt the cookie value. This is used when L</encrypt> or L</sign> are set to true.
1341              
1342             When used for cookie encryption, make sure the key size is big enough to satisfy the encryption algorithm requirement, which you can check with, say for C<AES>:
1343              
1344             perl -MCrypt::Cipher::AES -lE 'say Crypt::Cipher::AES->keysize'
1345              
1346             In this case, it will yield C<32>. Replace above C<AES>, byt whatever algorithm you have chosen.
1347              
1348             perl -MCrypt::Cipher::Blowfish -lE 'say Crypt::Cipher::Blowfish->keysize'
1349              
1350             would yield C<56> for C<Blowfish>
1351              
1352             You can use L<Bytes::Random::Secure/random_bytes> to generate a random key:
1353              
1354             # will generate a 32 bytes-long key
1355             my $key = Bytes::Random::Secure::random_bytes(32);
1356              
1357             =head2 match_host
1358              
1359             Provided with an host name and this returns true if this cookie domain either is a perfect match or if the L</implicit> flag is on and the cookie domain is a subset of the host provided.
1360              
1361             Otherwise this returns false.
1362              
1363             =head2 max_age
1364              
1365             Sets or gets the integer value for C<Max-Age>
1366              
1367             This value should be an integer representing the number of seconds until this cookie expires.
1368              
1369             As per the rfc6265, C<Max-Age> takes precedence over C<Expires> when set, so if you set this, any value set with L</expires> will be discarded.
1370              
1371             Returns a L<Module::Generic::Number> object.
1372              
1373             =head2 maxage
1374              
1375             Alias for L</max_age>
1376              
1377             =head2 name
1378              
1379             Sets or gets the cookie name.
1380              
1381             As per the L<Mozilla documentation|https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Set-Cookie>, a cookie name cannot contain any of the following charadcters:
1382              
1383             \(\)\<\>\@\,\;\:\\\"\/\[\]\?\=\{\}
1384              
1385             Returns a L<Module::Generic::Scalar> object.
1386              
1387             =head2 path
1388              
1389             Sets or gets the path.
1390              
1391             Returns a L<Module::Generic::Scalar> object.
1392              
1393             =head2 port
1394              
1395             Sets or gets the port number.
1396              
1397             Returns a L<Module::Generic::Number> object.
1398              
1399             =head2 reset
1400              
1401             Set the reset flag to true, which will force L</as_string> to recompute the string value of the cookie.
1402              
1403             =head2 same_as
1404              
1405             Provided with another object and this returns true if it has the same property values, false otherwise.
1406              
1407             This is used in overloaded object comparison, such as:
1408              
1409             print( "Same cookie\n" ) if( $c1 eq $c2 );
1410             # or
1411             print( "Same cookie\n" ) if( $c1 == $c2 );
1412              
1413             =head2 same_site
1414              
1415             Sets or gets the boolean value for C<Same-Site>.
1416              
1417             The proper values should be C<Relaxed>, C<Strict> or C<None>, but this module does not enforce the value you set. Setting a proper value is your responsibility.
1418              
1419             See L<Mozilla documentation|https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Set-Cookie/SameSite> for more information.
1420              
1421             If set to C<None>, L<secure> should be set to true.
1422              
1423             See L<rfc 6265|https://datatracker.ietf.org/doc/html/draft-west-first-party-cookies-07> for more information.
1424              
1425             See also L<CanIUse|https://caniuse.com/same-site-cookie-attribute>
1426              
1427             Returns a L<Module::Generic::Scalar> object.
1428              
1429             =head2 samesite
1430              
1431             Alias for L</same_site>.
1432              
1433             =head2 secure
1434              
1435             Sets or gets the boolean value for C<Secure>.
1436              
1437             Returns a L<Module::Generic::Boolean> object.
1438              
1439             =head2 sign
1440              
1441             Set or get the boolean value. If true, then the cookie value will be signed. The way this works, is that L<Crypt::Mac::HMAC/hmac_b64> will create a C<SHA256> encrypted digest using the encryption key you provided with L</key> and attach the signature to the cookie value separated by a dot. For example:
1442              
1443             my $cookie_value = "toc_ok=1";
1444             my $key = "hard to guess key";
1445             my $signature = Crypt::Mac::HMAC::hmac_b64( $key, $cookie_value );
1446             # signature is I2M4/rh/TiNV5RZDSBJkhLblBvrN5k9448G6w/gp/jg=
1447             # cookie resulting value before uri encoding:
1448             # toc_ok%3D1.I2M4/rh/TiNV5RZDSBJkhLblBvrN5k9448G6w/gp/jg=
1449              
1450             So, you need to have the module L<Crypt::Mac> installed to be able to use this feature.
1451              
1452             Signature are used to ensure data integrity protection for content that are not secret.
1453              
1454             For more secret content, use L</encrypt>.
1455              
1456             You can read more about the difference between L<sign and encryption at Stackoverflow|https://stackoverflow.com/questions/41467012/what-is-the-difference-between-signed-and-encrypted-cookies-in-rails>
1457              
1458             =head2 strict
1459              
1460             Boolean. Should this API be strict about the cookie names?
1461             When true, this will reject cookie names with invalid characters.
1462              
1463             Cookie name can contain only US ASCII characters and exclude any separators such as C<< ( ) < > @ , ; : \ " / [ ] ? = { } >>
1464              
1465             =head2 uri
1466              
1467             If a value is provided, it will be transformed into a L<URI> object, and its C<port>, C<path> and C<host> components will be used to set the values for L</port>, L</path> and L</domain> respectively.
1468              
1469             Otherwise, with no value provided, this will form an L<URI> object based on the cookie secure flag, C<domain>, C<port>, and C<path>
1470              
1471             $c->uri( 'https://www.example.com:8080/some/where?q=find+me' );
1472             # sets host to www.example.com, port to 8080 and path to /some/where
1473             my $uri = $c->uri;
1474             # get an uri based on cookie properties value, such as:
1475             # https://www.example.com:8080/some/where
1476              
1477             =head2 value
1478              
1479             Sets or gets the value for this cookie.
1480              
1481             Returns a L<Module::Generic::Scalar> object.
1482              
1483             =head2 version
1484              
1485             Sets or gets the cookie version. This was used in version 2 of the cookie standard, but has since been deprecated by L<rfc6265|https://datatracker.ietf.org/doc/html/rfc6265>.
1486              
1487             Returns a L<Module::Generic::Number> object.
1488              
1489             =head2 _header_datetime
1490              
1491             Given a L<DateTime> object, or by default will instantiate a new one, and this will set its formatter to L<DateTime::Format::Strptime> with the appropriate format to ensure the stringification produces a rfc6265 compliant datetime string.
1492              
1493             =head2 TO_JSON
1494              
1495             This method is used so that if the cookie object is part of some data encoded into json, this will convert the cookie data properly to be used by L<JSON>
1496              
1497             =head1 SIGNED COOKIES
1498              
1499             As shown in the L</SYNOPSIS> you can sign cookies effortlessly. This package has taken all the hassle of doing it for you.
1500              
1501             To use this feature you need to have installed L<Crypt::Mode::CBC> which is part of L<CryptX>
1502              
1503             The methods available to use for cookie integrity protection are: L</key>, L</sign> to enable cookie signature, L</is_valid> to check if the signature is valid.
1504              
1505             Cookie signature is performed by L<CryptX>, which is an XS module, and thus very fast.
1506              
1507             =head1 ENCRYPTED COOKIES
1508              
1509             As shown in the L</SYNOPSIS> you can encrypt cookies effortlessly. This package has taken all the hassle of doing it for you.
1510              
1511             To use this feature you need to have installed L<Crypt::Mode::CBC> which is part of L<CryptX>
1512              
1513             The methods available to use for cookie encryption are: L</algo> to set the desired algorithm, L</key>, L</encrypt> to enable encryption, L</decrypt> to decrypt the cookie value, and optionally L</initialisation_vector>.
1514              
1515             Cookie encryption is performed by L<CryptX>, which is an XS module, and thus very fast.
1516              
1517             =head1 INSTALLATION
1518              
1519             As usual, to install this module, you can do:
1520              
1521             perl Makefile.PL
1522             make
1523             make test
1524             sudo make install
1525              
1526             If you have Apache/modperl2 installed, this will also prepare the Makefile and run test under modperl.
1527              
1528             The Makefile.PL tries hard to find your Apache configuration, but you can give it a hand by specifying some command line parameters. See L<Apache::TestMM> for available parameters or you can type on the command line:
1529              
1530             perl -MApache::TestConfig -le 'Apache::TestConfig::usage()'
1531              
1532             For example:
1533              
1534             perl Makefile.PL -apxs /usr/bin/apxs -port 1234
1535             # which will also set the path to httpd_conf, otherwise
1536             perl Makefile.PL -httpd_conf /etc/apache2/apache2.conf
1537              
1538             # then
1539             make
1540             make test
1541             sudo make install
1542              
1543             See also L<modperl testing documentation|https://perl.apache.org/docs/general/testing/testing.html>
1544              
1545             But, if for some reason, you do not want to perform the mod_perl tests, you can use C<NO_MOD_PERL=1> when calling C<perl Makefile.PL>, such as:
1546              
1547             NO_MOD_PERL=1 perl Makefile.PL
1548             make
1549             make test
1550             sudo make install
1551              
1552             =head1 AUTHOR
1553              
1554             Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>
1555              
1556             =head1 SEE ALSO
1557              
1558             L<Cookie::Jar>, L<Apache2::Cookies>, L<APR::Request::Cookie>
1559              
1560             L<rfc6265|https://datatracker.ietf.org/doc/html/rfc6265>
1561              
1562             L<Latest tentative version of the cookie standard|https://datatracker.ietf.org/doc/html/draft-ietf-httpbis-rfc6265bis-09>
1563              
1564             =head1 COPYRIGHT & LICENSE
1565              
1566             Copyright (c) 2019-2021 DEGUEST Pte. Ltd.
1567              
1568             You can use, copy, modify and redistribute this package and associated
1569             files under the same terms as Perl itself.
1570              
1571             =cut