Commit 551855b2 authored by Jacques Deguest's avatar Jacques Deguest

Working on new version 0.1.5

parent b4ce9291
Revision history for Perl module Cookie
v0.1.5 2021-11-25T07:27:14+0900
- Corrected test units version requirement for testing with CryptX
v0.1.4 2021-11-22T11:10:49+0900
- Minor correction in expires() in Cookie and related test units
v0.1.3 2021-11-18T12:24:20+0900
- Improvement on is_expired in Cookie
v0.1.2 2021-11-18T11:34:17+0900
- Documentation corrections
v0.1.1 2021-11-17T17:00:54+0900
- Change of distribution name from Cookies to Cookie
- Improvements on handling of same cookie name for a given domain and path
......
......@@ -43,7 +43,7 @@ Issues are currently reported using CPAN [bug tracker](https://git.deguest.jp/ja
## More information
Please refer to the [README](https://metacpan.org/source/JDEGUEST/Cookie-v0.1.0/README.md)
Please refer to the [README](https://metacpan.org/source/JDEGUEST/Cookie-v0.1.4/README.md)
## Author
......
......@@ -20,7 +20,7 @@ my %WriteMakefileArgs = (
'DateTime' => '1.52',
'DateTime::Format::Strptime' => '1.77',
'JSON' => '4.03',
'Module::Generic' => 'v0.17.0',
'Module::Generic' => 'v0.17.3',
'Net::IDN::Encode' => '2.500',
'Nice::Try' => 'v1.1.2',
'Scalar::Util' => '1.50',
......@@ -70,7 +70,7 @@ eval
my @scripts = ();
my $MY_DEBUG = $ENV{COOKIES_DEBUG};
if( !$@ )
if( !$@ && !$ENV{NO_MOD_PERL} )
{
print( STDERR "Generating Makefile including modperl\n" ) if( $MY_DEBUG );
Apache::TestMM->import( qw(test clean) ); #enable 'make test'
......
......@@ -261,18 +261,18 @@ METHODS
no other attribute.
The http client, when receiving those cookies will derive the missing
cookie path to be "/my/path", i.e. the current uri path, and will
override the previously stored cookie with the same name for that host
that had the path set to "/"
cookie path to be "/my/path", i.e. the current uri path, and will create
a duplicate cookie from the previously stored cookie with the same name
for that host, but that had the path set to "/"
So you can create a repository and use it to store the cookies sent by
the http client using "fetch", but in preparation of the server
response, either use a separate repository with, for example, "my
$jar_out = Cookie::Jar-"new> or use "set" which will still add the
cookie to the repository, but also before set the "Set-Cookie" header
for that cookie.
$jar_out = Cookie::Jar-"new> or use "set" which will not add the cookie
to the repository, but rather only set the "Set-Cookie" header for that
cookie.
# Add Set-Cookie header for that cookie and add cookie to repository
# Add Set-Cookie header for that cookie, but do not add cookie to repository
$jar->set( $cookie_object );
delete
......@@ -385,13 +385,13 @@ METHODS
Ultimately, if none of those are available, it will use the environment
variable "HTTP_COOKIE"
In void context, this method, will add the fetched cookies to its
repository.
If the option *store* is true, this method will add the fetched cookies
to the repository.
It returns an hash reference of cookie key => cookie object
A cookie key is made of the host (possibly empty) and the cookie name
separated by ";"
A cookie key is made of the host (possibly empty), the path and the
cookie name separated by ";"
# Cookies added to the repository
$jar->fetch || die( $jar->error );
......@@ -860,11 +860,21 @@ INSTALLATION
See also 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 call use "NO_MOD_PERL=1" when calling "perl Makefile.PL", such
as:
NO_MOD_PERL=1 perl Makefile.PL
make
make test
sudo make install
AUTHOR
Jacques Deguest <jack@deguest.jp>
SEE ALSO
Apache2::Cookies, APR::Request::Cookie, Cookie::Baker
Cookie, Cookie::Domain, Apache2::Cookies, APR::Request::Cookie,
Cookie::Baker
Latest tentative version of the cookie standard
<https://datatracker.ietf.org/doc/html/draft-ietf-httpbis-rfc6265bis-09>
......
......@@ -306,18 +306,18 @@ called, it stringifies the cookies and create a `Set-Cookie` header for
each one, but only with their value and no other attribute.
The http client, when receiving those cookies will derive the missing
cookie path to be `/my/path`, i.e. the current uri path, and will
override the previously stored cookie with the same name for that host
that had the path set to `/`
cookie path to be `/my/path`, i.e. the current uri path, and will create
a duplicate cookie from the previously stored cookie with the same name
for that host, but that had the path set to `/`
So you can create a repository and use it to store the cookies sent by
the http client using [\"fetch\"](#fetch){.perl-module}, but in
preparation of the server response, either use a separate repository
with, for example, `my $jar_out = Cookie::Jar-`new\> or use
[\"set\"](#set){.perl-module} which will still add the cookie to the
repository, but also before set the `Set-Cookie` header for that cookie.
[\"set\"](#set){.perl-module} which will not add the cookie to the
repository, but rather only set the `Set-Cookie` header for that cookie.
# Add Set-Cookie header for that cookie and add cookie to repository
# Add Set-Cookie header for that cookie, but do not add cookie to repository
$jar->set( $cookie_object );
delete
......@@ -458,14 +458,14 @@ You can also provide the `Cookie` string to parse by providing the
Ultimately, if none of those are available, it will use the environment
variable `HTTP_COOKIE`
In void context, this method, will add the fetched cookies to its
[repository](#repo){.perl-module}.
If the option *store* is true, this method will add the fetched cookies
to the [repository](#repo){.perl-module}.
It returns an hash reference of cookie key =\> [cookie
object](https://metacpan.org/pod/Cookie){.perl-module}
A cookie key is made of the host (possibly empty) and the cookie name
separated by `;`
A cookie key is made of the host (possibly empty), the path and the
cookie name separated by `;`
# Cookies added to the repository
$jar->fetch || die( $jar->error );
......@@ -1079,14 +1079,25 @@ For example:
See also [modperl testing
documentation](https://perl.apache.org/docs/general/testing/testing.html){.perl-module}
But, if for some reason, you do not want to perform the mod\_perl tests,
you can call use `NO_MOD_PERL=1` when calling `perl Makefile.PL`, such
as:
NO_MOD_PERL=1 perl Makefile.PL
make
make test
sudo make install
AUTHOR
======
Jacques Deguest \<`jack@deguest.jp`{classes="ARRAY(0x5622724b6bf8)"}\>
Jacques Deguest \<`jack@deguest.jp`{classes="ARRAY(0x5577dce5f858)"}\>
SEE ALSO
========
[Cookie](https://metacpan.org/pod/Cookie){.perl-module},
[Cookie::Domain](https://metacpan.org/pod/Cookie::Domain){.perl-module},
[Apache2::Cookies](https://metacpan.org/pod/Apache2::Cookies){.perl-module},
[APR::Request::Cookie](https://metacpan.org/pod/APR::Request::Cookie){.perl-module},
[Cookie::Baker](https://metacpan.org/pod/Cookie::Baker){.perl-module}
......
This diff is collapsed.
......@@ -926,7 +926,7 @@ Jacques Deguest E<lt>F<jack@deguest.jp>E<gt>
=head1 SEE ALSO
L<Mozilla::PublicSuffix>, L<Domain::PublicSuffix>, L<Net::PublicSuffixList>
L<Cookie>, L<Cookie::Jar>, L<Mozilla::PublicSuffix>, L<Domain::PublicSuffix>, L<Net::PublicSuffixList>
L<https://publicsuffix.org/list/>
......
......@@ -41,7 +41,8 @@ BEGIN
use URI::Escape ();
our $VERSION = 'v0.1.1';
# This flag to allow extensive debug message to be enabled
our $COOKIES_DEBUG = 1;
our $COOKIES_DEBUG = 0;
use constant CRYPTX_VERSION => '0.074';
};
sub init
......@@ -873,7 +874,7 @@ sub load
$self->message( 4, "Value to decrypt is ", CORE::length( $json ), " bytes big." ) if( $COOKIES_DEBUG );
try
{
$self->_load_class( 'Crypt::Misc' ) || return( $self->pass_error );
$self->_load_class( 'Crypt::Misc', { version => CRYPTX_VERSION } ) || return( $self->pass_error );
my $p = $self->_encrypt_objects( @$opts{qw( key algo iv )} ) || return( $self->pass_error );
my $crypt = $p->{crypt};
my $bin = Crypt::Misc::decode_b64( "$json" );
......@@ -965,7 +966,7 @@ sub load_as_lwp
$self->message( 4, "Value to decrypt is ", CORE::length( $raw ), " bytes big." ) if( $COOKIES_DEBUG );
try
{
$self->_load_class( 'Crypt::Misc' ) || return( $self->pass_error );
$self->_load_class( 'Crypt::Misc', { version => CRYPTX_VERSION } ) || return( $self->pass_error );
my $p = $self->_encrypt_objects( @$opts{qw( key algo iv )} ) || return( $self->pass_error );
my $crypt = $p->{crypt};
my $bin = Crypt::Misc::decode_b64( "$raw" );
......@@ -1268,7 +1269,7 @@ sub save
return( $self->pass_error( $f->error ) );
if( $opts->{encrypt} )
{
$self->_load_class( 'Crypt::Misc' ) || return( $self->pass_error );
$self->_load_class( 'Crypt::Misc', { version => CRYPTX_VERSION } ) || return( $self->pass_error );
my $p = $self->_encrypt_objects( @$opts{qw( key algo iv )} ) || return( $self->pass_error );
my $crypt = $p->{crypt};
# $value = Crypt::Misc::encode_b64( $crypt->encrypt( "$value", $p->{key}, $p->{iv} ) );
......@@ -1306,7 +1307,7 @@ sub save_as_lwp
my $p = {};
if( $opts->{encrypt} )
{
$self->_load_class( 'Crypt::Misc' ) || return( $self->pass_error );
$self->_load_class( 'Crypt::Misc', { version => CRYPTX_VERSION } ) || return( $self->pass_error );
$p = $self->_encrypt_objects( @$opts{qw( key algo iv )} ) || return( $self->pass_error );
$self->message( 4, "Key size '", CORE::length( $p->{key} ), " and IV size '", CORE::length( $p->{iv} ), "'." ) if( $COOKIES_DEBUG );
}
......@@ -1436,7 +1437,7 @@ sub _encrypt_objects
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" ) );
try
{
$self->_load_class( 'Crypt::Mode::CBC' ) || return( $self->pass_error );
$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 = Crypt::Mode::CBC->new( "$algo" ) || return( $self->error( "Unable to create a Crypt::Mode::CBC object." ) );
my $class = "Crypt::Cipher::${algo}";
......@@ -1728,11 +1729,11 @@ As you can see, 3 cookies were sent: C<session_token>, C<csrf_token> and C<site_
So, when L</fetch> creates an object for each one and store them, those cookies have no C<path> value and no other attribute, and when L</add_response_header> is then called, it stringifies the cookies and create a C<Set-Cookie> header for each one, but only with their value and no other attribute.
The http client, when receiving those cookies will derive the missing cookie path to be C</my/path>, i.e. the current uri path, and will override the previously stored cookie with the same name for that host that had the path set to C</>
The http client, when receiving those cookies will derive the missing cookie path to be C</my/path>, i.e. the current uri path, and will create a duplicate cookie from the previously stored cookie with the same name for that host, but that had the path set to C</>
So you can create a repository and use it to store the cookies sent by the http client using L</fetch>, but in preparation of the server response, either use a separate repository with, for example, C<my $jar_out = Cookie::Jar->new> or use L</set> which will still add the cookie to the repository, but also before set the C<Set-Cookie> header for that cookie.
So you can create a repository and use it to store the cookies sent by the http client using L</fetch>, but in preparation of the server response, either use a separate repository with, for example, C<my $jar_out = Cookie::Jar->new> or use L</set> which will not add the cookie to the repository, but rather only set the C<Set-Cookie> header for that cookie.
# Add Set-Cookie header for that cookie and add cookie to repository
# Add Set-Cookie header for that cookie, but do not add cookie to repository
$jar->set( $cookie_object );
=head2 delete
......@@ -1819,11 +1820,11 @@ You can also provide the C<Cookie> string to parse by providing the C<string> op
Ultimately, if none of those are available, it will use the environment variable C<HTTP_COOKIE>
In void context, this method, will add the fetched cookies to its L<repository|/repo>.
If the option I<store> is true, this method will add the fetched cookies to the L<repository|/repo>.
It returns an hash reference of cookie key => L<cookie object|Cookie>
A cookie key is made of the host (possibly empty) and the cookie name separated by C<;>
A cookie key is made of the host (possibly empty), the path and the cookie name separated by C<;>
# Cookies added to the repository
$jar->fetch || die( $jar->error );
......@@ -2243,13 +2244,20 @@ For example:
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 call 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<Apache2::Cookies>, L<APR::Request::Cookie>, L<Cookie::Baker>
L<Cookie>, L<Cookie::Domain>, L<Apache2::Cookies>, L<APR::Request::Cookie>, L<Cookie::Baker>
L<Latest tentative version of the cookie standard|https://datatracker.ietf.org/doc/html/draft-ietf-httpbis-rfc6265bis-09>
......
......@@ -5,9 +5,12 @@ BEGIN
use warnings;
use lib './lib';
use Test::More;
# 2021-11-1T167:12:10+0900
# 2021-11-01T08:12:10
use Test::Time time => 1635754330;
use DateTime;
use DateTime::Format::Strptime;
use Module::Generic::HeaderValue;
our $CRYPTX_REQUIRED_VERSION = '0.074';
our $DEBUG = exists( $ENV{AUTHOR_TESTING} ) ? $ENV{AUTHOR_TESTING} : 0;
};
......@@ -75,18 +78,18 @@ subtest 'cookie make' => sub
[{ name => 'foo', value => 'val', path => '/' }, 'foo=val; Path=/' ],
[{ name => 'foo', value => 'val', path => '/', secure => 1, http_only => 0 }, 'foo=val; Path=/; Secure' ],
[{ name => 'foo', value => 'val', path => '/', secure => 0, http_only => 1 }, 'foo=val; Path=/; HttpOnly' ],
[{ name => 'foo', value => 'val', expires => 'now' }, 'foo=val; Expires=Mon, 01 Nov 2021 08:12:10 GMT' ],
[{ name => 'foo', value => 'val', expires => $now + 24*60*60 }, 'foo=val; Expires=Tue, 02 Nov 2021 17:12:10 GMT' ],
[{ name => 'foo', value => 'val', expires => '1s' }, 'foo=val; Expires=Mon, 01 Nov 2021 17:12:11 GMT' ],
[{ name => 'foo', value => 'val', expires => '+10' }, 'foo=val; Expires=Mon, 01 Nov 2021 17:12:20 GMT' ],
[{ name => 'foo', value => 'val', expires => '+1m' }, 'foo=val; Expires=Mon, 01 Nov 2021 17:13:10 GMT' ],
[{ name => 'foo', value => 'val', expires => '+1h' }, 'foo=val; Expires=Mon, 01 Nov 2021 18:12:10 GMT' ],
[{ name => 'foo', value => 'val', expires => '+1d' }, 'foo=val; Expires=Tue, 02 Nov 2021 17:12:10 GMT' ],
[{ name => 'foo', value => 'val', expires => '-1d' }, 'foo=val; Expires=Sun, 31 Oct 2021 17:12:10 GMT' ],
[{ name => 'foo', value => 'val', expires => '+1M' }, 'foo=val; Expires=Wed, 01 Dec 2021 17:12:10 GMT' ],
[{ name => 'foo', value => 'val', expires => '+1y' }, 'foo=val; Expires=Tue, 01 Nov 2022 17:12:10 GMT' ],
[{ name => 'foo', value => 'val', expires => '0' }, 'foo=val; Expires=Thu, 01 Jan 1970 09:00:00 GMT' ],
[{ name => 'foo', value => 'val', expires => '-1' }, 'foo=val; Expires=Mon, 01 Nov 2021 17:12:09 GMT' ],
[{ name => 'foo', value => 'val', expires => 'now' }, 'foo=val; Expires=_DATETIME_', { year => 2021, month => 11, day => 1, hour => 8, minute => 12, second => 10 } ],
[{ name => 'foo', value => 'val', expires => $now + 24*60*60 }, 'foo=val; Expires=_DATETIME_', { year => 2021, month => 11, day => 2, hour => 8, minute => 12, second => 10, time_zone => 'UTC' } ],
[{ name => 'foo', value => 'val', expires => '1s' }, 'foo=val; Expires=_DATETIME_', { year => 2021, month => 11, day => 1, hour => 8, minute => 12, second => 11 } ],
[{ name => 'foo', value => 'val', expires => '+10' }, 'foo=val; Expires=_DATETIME_', { year => 2021, month => 11, day => 1, hour => 8, minute => 12, second => 20 } ],
[{ name => 'foo', value => 'val', expires => '+1m' }, 'foo=val; Expires=_DATETIME_', { year => 2021, month => 11, day => 1, hour => 8, minute => 13, second => 10 } ],
[{ name => 'foo', value => 'val', expires => '+1h' }, 'foo=val; Expires=_DATETIME_', { year => 2021, month => 11, day => 1, hour => 9, minute => 12, second => 10 } ],
[{ name => 'foo', value => 'val', expires => '+1d' }, 'foo=val; Expires=_DATETIME_', { year => 2021, month => 11, day => 2, hour => 8, minute => 12, second => 10 } ],
[{ name => 'foo', value => 'val', expires => '-1d' }, 'foo=val; Expires=_DATETIME_', { year => 2021, month => 10, day => 31, hour => 8, minute => 12, second => 10 } ],
[{ name => 'foo', value => 'val', expires => '+1M' }, 'foo=val; Expires=_DATETIME_', { year => 2021, month => 12, day => 1, hour => 8, minute => 12, second => 10 } ],
[{ name => 'foo', value => 'val', expires => '+1y' }, 'foo=val; Expires=_DATETIME_', { year => 2022, month => 11, day => 1, hour => 8, minute => 12, second => 10 } ],
[{ name => 'foo', value => 'val', expires => '0' }, 'foo=val; Expires=_DATETIME_', { year => 1970, month => 1, day => 1, hour => 0, minute => 0, second => 0 } ],
[{ name => 'foo', value => 'val', expires => '-1' }, 'foo=val; Expires=_DATETIME_', { year => 2021, month => 11, day => 1, hour => 8, minute => 12, second => 9 } ],
[{ name => 'foo', value => 'val', expires => 'foo' }, undef ],
[{ name => 'foo', value => 'val', max_age => '1000' }, 'foo=val; Max-Age=1000' ],
[{ name => 'foo', value => 'val', max_age => '0' }, 'foo=val; Max-Age=0' ],
......@@ -96,6 +99,11 @@ subtest 'cookie make' => sub
[{ name => 'foo', value => 'val', same_site => 'invalid value' }, 'foo=val' ],
);
my $fmt = DateTime::Format::Strptime->new(
pattern => '%a, %d %b %Y %H:%M:%S GMT',
locale => 'en_GB',
time_zone => 'GMT',
);
foreach my $test ( @tests )
{
# $test->[0]->{debug} = $DEBUG;
......@@ -113,6 +121,16 @@ subtest 'cookie make' => sub
}
next;
}
if( scalar( @$test ) == 3 )
{
my $def = $test->[2];
$def->{time_zone} = 'GMT' unless( $def->{time_zone} );
my $d = DateTime->new( %$def );
$d->set_time_zone( 'GMT' );
$d->set_formatter( $fmt );
my $datestr = "$d";
$test->[1] =~ s/_DATETIME_/$datestr/g;
}
is( $c->as_string, $test->[1] );
}
};
......@@ -121,7 +139,7 @@ subtest 'encrypted cookie' => sub
{
SKIP:
{
eval( "use Crypt::Cipher" );
eval( "use Crypt::Cipher ${CRYPTX_REQUIRED_VERSION}" );
my $algos = [qw( 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 )];
if( $@ )
{
......
......@@ -5,10 +5,11 @@ BEGIN
use warnings;
use lib './lib';
use Test::More;
# 2021-11-1T167:12:10+0900
# 2021-11-01T08:12:10
use Test::Time time => 1635754330;
use HTTP::Request ();
use HTTP::Response ();
our $CRYPTX_REQUIRED_VERSION = '0.074';
our $DEBUG = exists( $ENV{AUTHOR_TESTING} ) ? $ENV{AUTHOR_TESTING} : 0;
};
......
......@@ -20,6 +20,7 @@ BEGIN
}
# 2021-11-1T167:12:10+0900
use Test::Time time => 1635754330;
our $CRYPTX_REQUIRED_VERSION = '0.074';
our $DEBUG = exists( $ENV{COOKIES_DEBUG} ) ? $ENV{COOKIES_DEBUG} : exists( $ENV{AUTHOR_TESTING} ) ? $ENV{AUTHOR_TESTING} : 0;
our( $hostport, $host, $port, $mp_host, $proto );
};
......@@ -186,7 +187,7 @@ subtest 'encrypted' => sub
{
SKIP:
{
eval( "use Crypt::Cipher" );
eval( "use Crypt::Cipher ${CRYPTX_REQUIRED_VERSION}" );
if( $@ )
{
skip( "Crypt::Cipher is not installed on your system", 4 );
......@@ -239,7 +240,7 @@ subtest 'signed' => sub
{
SKIP:
{
eval( "use Crypt::Cipher" );
eval( "use Crypt::Cipher ${CRYPTX_REQUIRED_VERSION}" );
if( $@ )
{
skip( "Crypt::Cipher is not installed on your system", 4 );
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment