Cookie
view release on metacpan or search on metacpan
lib/Cookie.pm view on Meta::CPAN
sub init
{
my $self = shift( @_ );
no overloading;
$self->{name} = undef;
$self->{value} = undef;
$self->{comment} = undef;
$self->{commentURL} = undef;
$self->{discard} = 0;
$self->{domain} = undef;
$self->{expires} = undef;
$self->{http_only} = 0;
# In the case of cookie sent from the server and no domain was set
# This domain, which we need anyway, was provided implicitly or explicitly
$self->{implicit} = 0;
$self->{max_age} = undef;
$self->{path} = undef;
$self->{port} = undef;
$self->{same_site} = undef;
$self->{secure} = 0;
$self->{accessed} = time();
$self->{created} = time();
# Ref: <https://stackoverflow.com/questions/41467012/what-is-the-difference-between-signed-and-encrypted-cookies-in-rails>
# Integrity protection with Message Authentication Code (MAC)
# e.g. Crypt::Mac::HMAC::hmac("SHA256","plop","Oh boy, this is cool")
$self->{sign} = 0;
# Crypt::Cipher::AES
# Crypt::Cipher
# one of 'AES', 'Anubis', 'Blowfish', 'CAST5', 'Camellia', 'DES', 'DES_EDE',
# 'KASUMI', 'Khazad', 'MULTI2', 'Noekeon', 'RC2', 'RC5', 'RC6',
# 'SAFERP', 'SAFER_K128', 'SAFER_K64', 'SAFER_SK128', 'SAFER_SK64',
# 'SEED', 'Skipjack', 'Twofish', 'XTEA', 'IDEA', 'Serpent'
# simply any <NAME> for which there exists Crypt::Cipher::<NAME>
# Encryption algorithm
# Ref: <https://stackoverflow.com/questions/4147451/aes-vs-blowfish-for-file-encryption>
$self->{algo} = 'AES';
$self->{encrypt} = 0;
$self->{initialisation_vector} = undef;
$self->{key} = undef;
# Should this API be strict about the cookie names?
# When true, this will reject cookie names with invalid characters.
$self->{strict} = 0;
# Needs to be an empty string or it would be overriden by Module::Generic who would put here the package version instead
$self->{version} = '';
$self->{_init_strict_use_sub} = 1;
$self->SUPER::init( @_ ) || return( $self->pass_error );
$self->{fields} = [qw( name value comment commentURL discard domain expires http_only implicit max_age path port same_site secure version )];
return( $self );
}
sub accessed_on { return( shift->_set_get_datetime( 'accessed', @_ ) ); }
sub algo
{
my $self = shift( @_ );
if( @_ )
{
my $algo = shift( @_ );
if( defined( $algo ) && CORE::length( $algo ) )
{
$self->_load_class( 'Crypt::Mode::CBC', { version => CRYPTX_VERSION } ) || return( $self->pass_error );
# try-catch
local $@;
eval
{
# Crypt::Mode::CBC dies when it is unhappy, but we catch a null return
# value anyway just in case
my $o = Crypt::Mode::CBC->new( $algo ) ||
die( "Unsupported algorithm \"$algo\"\n" );
$self->_set_get_scalar_as_object( 'algo', $algo );
$self->reset(1);
};
if( $@ )
{
return( $self->error( "Unsupported algorithm \"$algo\": $@" ) );
}
}
else
{
$self->{algo} = undef;
}
}
return( $self->_set_get_scalar_as_object( 'algo' ) );
}
sub apply
{
my $self = shift( @_ );
my $hash = $self->_get_args_as_hash( @_ );
return( $self ) if( !scalar( keys( %$hash ) ) );
if( !defined( $SUBS ) ||
ref( $SUBS ) ne 'ARRAY' ||
!scalar( @$SUBS ) )
{
$SUBS = [grep( /^(?!apply|as_hash|as_string|can|fields|import|init|reset)(?:[a-z][a-z\_]+)$/, keys( %Cookie:: ) )];
}
foreach( @$SUBS )
{
# Value could be undef
# Passing an empty string to Module::Generic::Number will trigger an error (undef)
# So if the value is empty, we simply set it directly.
if( $_ eq 'version' && !CORE::length( $hash->{ $_ } ) )
{
$self->{ $_ } = $hash->{ $_ };
next;
}
if( CORE::exists( $hash->{ $_ } ) )
{
if( !defined( $hash->{ $_ } ) )
{
$self->{ $_ } = undef;
}
else
{
$self->$_( $hash->{ $_ } );
}
}
}
return( $self );
}
sub as_hash
{
my $self = shift( @_ );
my $ref = {};
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 ) )
lib/Cookie.pm view on Meta::CPAN
my $code = $this->can( $f );
return(0) if( !$code );
my $v2 = $code->( $this );
if( ( !defined( $v ) && defined( $v2 ) ) ||
( defined( $v ) && !defined( $v2 ) ) ||
( defined( $v ) && length( "$v" ) != length( "$v2" ) ) ||
( defined( $v ) && defined( $v2 ) && "$v" ne "$v2" ) )
{
return(0);
}
}
return(1);
}
sub same_site { return( shift->reset(@_)->_set_get_scalar_as_object( 'same_site', @_ ) ); }
sub samesite { return( shift->same_site( @_ ) ); }
sub secure { return( shift->reset(@_)->_set_get_boolean( 'secure', @_ ) ); }
sub sign { return( shift->reset(@_)->_set_get_boolean( 'sign', @_ ) ); }
sub strict { return( shift->reset(@_)->_set_get_boolean( 'strict', @_ ) ); }
sub uri
{
my $self = shift( @_ );
if( @_ )
{
$self->reset( @_ );
my $uri = $self->_set_get_uri( 'uri', @_ ) || return;
$self->port( $uri->port );
$self->path( $uri->path );
$self->domain( $uri->host );
}
elsif( $self->domain )
{
my $uri =
( $self->secure ? 'https' : 'http' ) . '://' .
$self->domain .
( $self->port ? ':' . $self->port : '' ) .
( $self->path ? $self->path : '/' );
return( $self->_set_get_uri( 'uri' => $uri ) );
}
return( $self->_set_get_uri( 'uri' ) );
}
sub value { return( shift->reset(@_)->_set_get_scalar_as_object( 'value', @_ ) ); }
# Deprecated. Was a version 2 cookie spec: https://developer.mozilla.org/en-US/docs/Web/HTTP/Headers/Set-Cookie2
sub version { return( shift->_set_get_number( 'version', @_ ) ); }
sub _encrypt_objects
{
my $self = shift( @_ );
my( $key, $algo, $iv ) = @_;
return( $self->error( "Key provided is empty!" ) ) if( !defined( $key ) || !CORE::length( "$key" ) );
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" ) );
$iv //= '';
$self->_load_class( 'Crypt::Mode::CBC', { version => CRYPTX_VERSION } ) || return( $self->pass_error );
$self->_load_class( 'Bytes::Random::Secure' ) || return( $self->pass_error );
my $crypt = eval
{
Crypt::Mode::CBC->new( "$algo" );
};
if( $@ )
{
return( $self->error( "Error getting the encryption objects for algorithm \"$algo\": $@" ) );
}
$crypt or return( $self->error( "Unable to create a Crypt::Mode::CBC object." ) );
my $class = "Crypt::Cipher::${algo}";
$self->_load_class( $class ) || return( $self->pass_error );
my $key_len = $class->keysize;
my $block_len = $class->blocksize;
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 );
# Generate an "IV", i.e. Initialisation Vector based on the required block size
$iv ||= $self->initialisation_vector;
if( defined( $iv ) && CORE::length( "$iv" ) )
{
if( CORE::length( "$iv" ) != $block_len )
{
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 ...
}
}
else
{
$iv = eval
{
Bytes::Random::Secure::random_bytes( $block_len );
};
if( $@ )
{
return( $self->error( "Error getting $block_len random secure bytes for algorithm \"$algo\": $@" ) );
}
# Save it for decryption
$self->initialisation_vector( $iv );
}
my $key_pack = pack( 'H' x $key_len, $key );
my $iv_pack = pack( 'H' x $block_len, $iv );
return({ 'crypt' => $crypt, key => $key_pack, iv => $iv_pack });
}
sub _header_datetime
{
my $self = shift( @_ );
my $dt;
if( @_ )
{
return( $self->error( "Date time provided ($dt) is not an object." ) ) if( !$self->_is_object( $_[0] ) );
return( $self->error( "Object provided (", ref( $_[0] ), ") is not a DateTime object." ) ) if( !$_[0]->isa( 'DateTime' ) );
$dt = shift( @_ );
}
$dt = DateTime->now if( !defined( $dt ) );
$dt->set_time_zone( 'GMT' );
my $fmt = DateTime::Format::Strptime->new(
pattern => '%a, %d %b %Y %H:%M:%S GMT',
locale => 'en_GB',
time_zone => 'GMT',
);
$dt->set_formatter( $fmt );
return( $dt );
}
sub TO_JSON
{
my $self = shift( @_ );
my $fields = $self->fields;
my $ref = {};
foreach my $m ( @$fields )
{
lib/Cookie.pm view on Meta::CPAN
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...
my $cookie_value = "toc_ok=1";
my $key = "hard to guess key";
my $signature = Crypt::Mac::HMAC::hmac_b64( $key, $cookie_value );
# signature is I2M4/rh/TiNV5RZDSBJkhLblBvrN5k9448G6w/gp/jg=
# cookie resulting value before uri encoding:
# toc_ok%3D1.I2M4/rh/TiNV5RZDSBJkhLblBvrN5k9448G6w/gp/jg=
So, you need to have the module L<Crypt::Mac> installed to be able to use this feature.
Signature are used to ensure data integrity protection for content that are not secret.
For more secret content, use L</encrypt>.
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>
=head2 strict
Boolean. Should this API be strict about the cookie names?
When true, this will reject cookie names with invalid characters.
Cookie name can contain only US ASCII characters and exclude any separators such as C<< ( ) < > @ , ; : \ " / [ ] ? = { } >>
=head2 uri
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.
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>
$c->uri( 'https://www.example.com:8080/some/where?q=find+me' );
# sets host to www.example.com, port to 8080 and path to /some/where
my $uri = $c->uri;
# get an uri based on cookie properties value, such as:
# https://www.example.com:8080/some/where
=head2 value
Sets or gets the value for this cookie.
Returns a L<Module::Generic::Scalar> object.
=head2 version
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>.
Returns a L<Module::Generic::Number> object.
=head2 _header_datetime
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.
=head2 TO_JSON
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>
=head1 SIGNED COOKIES
As shown in the L</SYNOPSIS> you can sign cookies effortlessly. This package has taken all the hassle of doing it for you.
To use this feature you need to have installed L<Crypt::Mode::CBC> which is part of L<CryptX>
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.
Cookie signature is performed by L<CryptX>, which is an XS module, and thus very fast.
=head1 ENCRYPTED COOKIES
As shown in the L</SYNOPSIS> you can encrypt cookies effortlessly. This package has taken all the hassle of doing it for you.
To use this feature you need to have installed L<Crypt::Mode::CBC> which is part of L<CryptX>
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>.
Cookie encryption is performed by L<CryptX>, which is an XS module, and thus very fast.
=head1 INSTALLATION
As usual, to install this module, you can do:
perl Makefile.PL
make
make test
sudo make install
If you have Apache/modperl2 installed, this will also prepare the Makefile and run test under modperl.
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:
perl -MApache::TestConfig -le 'Apache::TestConfig::usage()'
For example:
perl Makefile.PL -apxs /usr/bin/apxs -port 1234
# which will also set the path to httpd_conf, otherwise
perl Makefile.PL -httpd_conf /etc/apache2/apache2.conf
# then
make
make test
sudo make install
See also L<modperl testing documentation|https://perl.apache.org/docs/general/testing/testing.html>
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:
NO_MOD_PERL=1 perl Makefile.PL
make
make test
sudo make install
=head1 AUTHOR
Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>
=head1 SEE ALSO
L<Cookie::Jar>, L<Apache2::Cookies>, L<APR::Request::Cookie>
L<rfc6265|https://datatracker.ietf.org/doc/html/rfc6265>
L<Latest tentative version of the cookie standard|https://datatracker.ietf.org/doc/html/draft-ietf-httpbis-rfc6265bis-09>
=head1 COPYRIGHT & LICENSE
Copyright (c) 2019-2021 DEGUEST Pte. Ltd.
You can use, copy, modify and redistribute this package and associated
files under the same terms as Perl itself.
=cut
( run in 0.963 second using v1.01-cache-2.11-cpan-e1769b4cff6 )