@@ -12,8 +12,6 @@ use utf8;
use Module::Build;
use File::Basename;
use File::Spec;
-use CPAN::Meta;
-use CPAN::Meta::Prereqs;
my %args = (
license => 'perl',
@@ -33,7 +31,8 @@ my %args = (
test_files => ((-d '.git' || $ENV{RELEASE_TESTING}) && -d 'xt') ? 't/ xt/' : 't/',
recursive_test_files => 1,
-
+
+
);
if (-d 'share') {
$args{share_dir} = 'share';
@@ -52,20 +51,15 @@ my $builder = Module::Build->subclass(
)->new(%args);
$builder->create_build_script();
-my $mbmeta = CPAN::Meta->load_file('MYMETA.json');
-my $meta = CPAN::Meta->load_file('META.json');
-my $prereqs_hash = CPAN::Meta::Prereqs->new(
- $meta->prereqs
-)->with_merged_prereqs(
- CPAN::Meta::Prereqs->new($mbmeta->prereqs)
-)->as_string_hash;
-my $mymeta = CPAN::Meta->new(
- {
- %{$meta->as_struct},
- prereqs => $prereqs_hash
- }
-);
-print "Merging cpanfile prereqs to MYMETA.yml\n";
-$mymeta->save('MYMETA.yml', { version => 1.4 });
-print "Merging cpanfile prereqs to MYMETA.json\n";
-$mymeta->save('MYMETA.json', { version => 2 });
+use File::Copy;
+
+print "cp META.json MYMETA.json\n";
+copy("META.json","MYMETA.json") or die "Copy failed(META.json): $!";
+
+if (-f 'META.yml') {
+ print "cp META.yml MYMETA.yml\n";
+ copy("META.yml","MYMETA.yml") or die "Copy failed(META.yml): $!";
+} else {
+ print "There is no META.yml... You may install this module from the repository...\n";
+}
+
@@ -1,5 +1,69 @@
Revision history for Perl extension HTTP-Session2
+1.08 2014-08-03T07:21:44Z
+
+ - ClientStore2: Encrypt sig, too.
+
+1.07 2014-08-01T14:06:49Z
+
+ [BROKEN. YOU SHOULDN't USE THIS VERSION]
+ - Fixed deps
+
+1.06 2014-08-01T14:00:33Z
+
+ [BROKEN. YOU SHOULDN't USE THIS VERSION]
+ [BUG FIX]
+ - Random string generator doesn't works if /dev/urandom is not available.
+ This issue was introduced at 1.02.
+
+1.05 2014-08-01T11:20:13Z
+
+ [BROKEN. YOU SHOULDN't USE THIS VERSION]
+ - Show warnings if the secret string is too short.
+
+1.04 2014-08-01T11:09:52Z
+
+ [BROKEN. YOU SHOULDN't USE THIS VERSION]
+ - Documentation updated.
+
+1.03 2014-08-01T11:03:19Z
+
+ [BROKEN. YOU SHOULDN't USE THIS VERSION]
+ - Added HTTP::Session2::ClientStore2
+
+1.02 2014-07-31T21:14:50Z
+
+ - Better session id generation using /dev/urandom.
+
+1.01 2014-07-28T11:43:10Z
+
+ - Revert HMAC strategy...
+ It breaks our code...
+
+1.00 2014-07-28T04:09:47Z
+
+ [INCOMPATIBLE CHANGE]
+ - I changed HMAC strategy on ServerSide mode.
+ Previous version uses
+
+ hmac_hex(data: $session_id, key: $secret)
+
+ New version is:
+
+ hmac_hex(data: $secret, key: $session)
+
+ This version is even secure. But, it's not a critical issue.
+
+ I think this change won't break your code.
+
+0.05 2014-03-18T18:52:37Z
+
+ - use Cookie::Baker for generating cookie string for Plack response object.
+ Because the document says HTTP::Session supports Cookie::Baker's expiration format like "-1d".
+ But it's not supported in previous version!!
+ https://github.com/tokuhirom/HTTP-Session2/pull/1
+ (magai)
+
0.04 2013-11-01T01:00:09Z
- Revert validate_empty_session flag introduced at 0.03.
@@ -9,7 +9,9 @@ js/xsrf-token.js
lib/HTTP/Session2.pm
lib/HTTP/Session2/Base.pm
lib/HTTP/Session2/ClientStore.pm
+lib/HTTP/Session2/ClientStore2.pm
lib/HTTP/Session2/Expired.pm
+lib/HTTP/Session2/Random.pm
lib/HTTP/Session2/ServerStore.pm
minil.toml
t/00_compile.t
@@ -21,6 +23,11 @@ t/05_keep_me_signed_in.t
t/06_base_abstract.t
t/07_client_store.t
t/08_expired.t
+t/09_random.t
+t/11_secret_string.t
+t/client_store2/01_basic.t
+t/client_store2/02_mech.t
+t/client_store2/03_colon.t
t/lib/Cache.pm
META.yml
MANIFEST
\ No newline at end of file
@@ -4,7 +4,7 @@
"tokuhirom <tokuhirom@gmail.com>"
],
"dynamic_config" : 0,
- "generated_by" : "Minilla/v0.7.5",
+ "generated_by" : "Minilla/v2.1.1",
"license" : [
"perl_5"
],
@@ -28,15 +28,14 @@
"prereqs" : {
"configure" : {
"requires" : {
- "CPAN::Meta" : "0",
- "CPAN::Meta::Prereqs" : "0",
"Module::Build" : "0.38"
}
},
"develop" : {
"requires" : {
"Test::CPAN::Meta" : "0",
- "Test::MinimumVersion" : "0.10108",
+ "Test::MinimumVersion::Fast" : "0.04",
+ "Test::PAUSE::Permissions" : "0.04",
"Test::Pod" : "1.41",
"Test::Spellunker" : "v0.2.7"
}
@@ -44,17 +43,22 @@
"runtime" : {
"requires" : {
"Cookie::Baker" : "0",
+ "Crypt::CBC" : "0",
+ "Data::MessagePack" : "0",
"Digest::HMAC" : "0",
"Digest::SHA" : "0",
"Digest::SHA1" : "0",
- "MIME::Base64" : "0",
+ "MIME::Base64" : "3.11",
"Mouse" : "0",
+ "Time::HiRes" : "0",
"parent" : "0",
"perl" : "5.008005"
}
},
"test" : {
"requires" : {
+ "Crypt::Rijndael" : "0",
+ "Plack::Request" : "0",
"Plack::Response" : "0",
"Test::More" : "0.98",
"Test::WWW::Mechanize::PSGI" : "0"
@@ -64,7 +68,7 @@
"provides" : {
"HTTP::Session2" : {
"file" : "lib/HTTP/Session2.pm",
- "version" : "0.04"
+ "version" : "1.08"
},
"HTTP::Session2::Base" : {
"file" : "lib/HTTP/Session2/Base.pm"
@@ -72,12 +76,18 @@
"HTTP::Session2::ClientStore" : {
"file" : "lib/HTTP/Session2/ClientStore.pm"
},
+ "HTTP::Session2::ClientStore2" : {
+ "file" : "lib/HTTP/Session2/ClientStore2.pm"
+ },
"HTTP::Session2::Expired" : {
"file" : "lib/HTTP/Session2/Expired.pm"
},
+ "HTTP::Session2::Random" : {
+ "file" : "lib/HTTP/Session2/Random.pm"
+ },
"HTTP::Session2::ServerStore" : {
"file" : "lib/HTTP/Session2/ServerStore.pm",
- "version" : "0.04"
+ "version" : "1.08"
}
},
"release_status" : "stable",
@@ -91,5 +101,8 @@
"web" : "https://github.com/tokuhirom/HTTP-Session2"
}
},
- "version" : "0.04"
+ "version" : "1.08",
+ "x_contributors" : [
+ "magai <xxmagai@gmail.com>"
+ ]
}
@@ -3,19 +3,19 @@ abstract: 'HTTP session management'
author:
- 'tokuhirom <tokuhirom@gmail.com>'
build_requires:
- Plack::Response: 0
- Test::More: 0.98
- Test::WWW::Mechanize::PSGI: 0
+ Crypt::Rijndael: '0'
+ Plack::Request: '0'
+ Plack::Response: '0'
+ Test::More: '0.98'
+ Test::WWW::Mechanize::PSGI: '0'
configure_requires:
- CPAN::Meta: 0
- CPAN::Meta::Prereqs: 0
- Module::Build: 0.38
+ Module::Build: '0.38'
dynamic_config: 0
-generated_by: 'Minilla/v0.7.5, CPAN::Meta::Converter version 2.132510'
+generated_by: 'Minilla/v2.1.1, CPAN::Meta::Converter version 2.141520'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: 1.4
+ version: '1.4'
name: HTTP-Session2
no_index:
directory:
@@ -30,27 +30,36 @@ no_index:
provides:
HTTP::Session2:
file: lib/HTTP/Session2.pm
- version: 0.04
+ version: '1.08'
HTTP::Session2::Base:
file: lib/HTTP/Session2/Base.pm
HTTP::Session2::ClientStore:
file: lib/HTTP/Session2/ClientStore.pm
+ HTTP::Session2::ClientStore2:
+ file: lib/HTTP/Session2/ClientStore2.pm
HTTP::Session2::Expired:
file: lib/HTTP/Session2/Expired.pm
+ HTTP::Session2::Random:
+ file: lib/HTTP/Session2/Random.pm
HTTP::Session2::ServerStore:
file: lib/HTTP/Session2/ServerStore.pm
- version: 0.04
+ version: '1.08'
requires:
- Cookie::Baker: 0
- Digest::HMAC: 0
- Digest::SHA: 0
- Digest::SHA1: 0
- MIME::Base64: 0
- Mouse: 0
- parent: 0
- perl: 5.008005
+ Cookie::Baker: '0'
+ Crypt::CBC: '0'
+ Data::MessagePack: '0'
+ Digest::HMAC: '0'
+ Digest::SHA: '0'
+ Digest::SHA1: '0'
+ MIME::Base64: '3.11'
+ Mouse: '0'
+ Time::HiRes: '0'
+ parent: '0'
+ perl: '5.008005'
resources:
bugtracker: https://github.com/tokuhirom/HTTP-Session2/issues
homepage: https://github.com/tokuhirom/HTTP-Session2
repository: git://github.com/tokuhirom/HTTP-Session2.git
-version: 0.04
+version: '1.08'
+x_contributors:
+ - 'magai <xxmagai@gmail.com>'
@@ -8,10 +8,20 @@ HTTP::Session2 - HTTP session management
package MyApp;
use HTTP::Session2;
+ my $cipher = Crypt::CBC->new(
+ {
+ key => 'abcdefghijklmnop',
+ cipher => 'Rijndael',
+ }
+ );
sub session {
my $self = shift;
if (!exists $self->{session}) {
- $self->{session} = HTTP::Session2::ClientStore->new(env => $env, secret => 'very long secret string');
+ $self->{session} = HTTP::Session2::ClientStore2->new(
+ env => $env,
+ secret => 'very long secret string'
+ cipher => $cipher,
+ );
}
$self->{session};
}
@@ -53,8 +63,6 @@ Then, we need to support query parameter based session management.
But today, Japanese people are using smart phone :)
We don't have to support legacy phones on new project.
-
-
# Automatic XSRF token sending.
This is an example code for filling XSRF token.
@@ -113,7 +121,7 @@ You need to call XSRF validator.
}
);
-# pros/cons for ServerStore/ClientStore
+# pros/cons for ServerStore/ClientStore2
## ServerStore
@@ -129,7 +137,7 @@ You need to call XSRF validator.
You need to setup some configuration for your application.
-## ClientStore
+## ClientStore2
### pros
@@ -147,10 +155,6 @@ You need to call XSRF validator.
I hope this module is secure. Because the data was signed by HMAC. But security thing is hard.
-- Session data is readable by users
-
- You can't store the any secret data to the session. Because this library signed to the data, but not encrypted.
-
- Bandwidth
If you store the large data to the session, your session data is send to the server per every request.
@@ -189,3 +193,7 @@ it under the same terms as Perl itself.
# AUTHOR
tokuhirom <tokuhirom@gmail.com>
+
+# CONTRIBUTORS
+
+magai
@@ -6,11 +6,16 @@ requires 'Digest::SHA1';
requires 'Mouse';
requires 'parent';
requires 'Digest::SHA';
-requires 'MIME::Base64';
+requires 'MIME::Base64', '3.11';
+requires 'Time::HiRes';
+requires 'Data::MessagePack';
+requires 'Crypt::CBC';
on 'test' => sub {
requires 'Test::More', '0.98';
requires 'Test::WWW::Mechanize::PSGI';
requires 'Plack::Response';
+ requires 'Crypt::Rijndael';
+ requires 'Plack::Request';
};
@@ -1,29 +1,31 @@
-$(function () {
- "use strict";
+(function (document, $) {
+ $(function () {
+ "use strict";
- var xsrf_token = getXSRFToken();
- $("form").each(function () {
- var form = $(this);
- var method = form.attr('method');
- if (method === 'get' || method === 'GET') {
- return;
- }
+ var xsrf_token = getXSRFToken();
+ $("form").each(function () {
+ var form = $(this);
+ var method = form.attr('method');
+ if (method === 'get' || method === 'GET') {
+ return;
+ }
- var input = $(document.createElement('input'));
- input.attr('type', 'hidden');
- input.attr('name', 'XSRF-TOKEN');
- input.attr('value', xsrf_token);
- form.prepend(input);
- });
+ var input = $(document.createElement('input'));
+ input.attr('type', 'hidden');
+ input.attr('name', 'XSRF-TOKEN');
+ input.attr('value', xsrf_token);
+ form.prepend(input);
+ });
- function getXSRFToken() {
- var cookies = document.cookie.split(/\s*;\s*/);
- for (var i=0,l=cookies.length; i<l; i++) {
- var matched = cookies[i].match(/^XSRF-TOKEN=(.*)$/);
- if (matched) {
- return matched[1];
+ function getXSRFToken() {
+ var cookies = document.cookie.split(/\s*;\s*/);
+ for (var i=0,l=cookies.length; i<l; i++) {
+ var matched = cookies[i].match(/^XSRF-TOKEN=(.*)$/);
+ if (matched) {
+ return matched[1];
+ }
}
+ return undefined;
}
- return undefined;
- }
-});
+ });
+})(document, jQuery);
@@ -5,6 +5,7 @@ use utf8;
use 5.008_001;
use Digest::SHA;
+use Carp ();
use Mouse;
@@ -73,6 +74,12 @@ has necessary_to_send => (
has secret => (
is => 'ro',
required => 1,
+ trigger => sub {
+ my ($self, $secret) = @_;
+ if (length($secret) < 20) {
+ Carp::cluck("Secret string too short");
+ }
+ },
);
no Mouse;
@@ -133,7 +140,8 @@ sub finalize_plack_response {
my @cookies = $self->finalize();
while (my ($name, $cookie) = splice @cookies, 0, 2) {
- $res->cookies->{$name} = $cookie;
+ my $baked = Cookie::Baker::bake_cookie( $name, $cookie );
+ $res->headers->push_header('Set-Cookie' => $baked);
}
}
@@ -4,29 +4,37 @@ use warnings;
use utf8;
use 5.008_001;
-use Cookie::Baker ();
use Storable ();
-use MIME::Base64 ();
-use Digest::HMAC ();
+use Carp ();
+use Cookie::Baker;
+use MIME::Base64;
+use HTTP::Session2::Random;
+use Digest::HMAC;
use HTTP::Session2::Expired;
use Mouse;
extends 'HTTP::Session2::Base';
-has serializer => (
+# Backward compatibility.
+
+has 'serializer' => (
is => 'ro',
default => sub {
sub {
+ warn("Do not use HTTP::Session2::ClientStore. Use HTTP::Session2::ServerStore or HTTP::Session2::ClientStore2 instead.");
MIME::Base64::encode(Storable::nfreeze($_[0]), '' )
}
},
);
-has deserializer => (
+has 'deserializer' => (
is => 'ro',
default => sub {
- sub {Storable::thaw(MIME::Base64::decode($_[0]))}
+ sub {
+ warn("Do not use HTTP::Session2::ClientStore. Use HTTP::Session2::ServerStore or HTTP::Session2::ClientStore2 instead.");
+ Storable::thaw(MIME::Base64::decode($_[0]))
+ }
},
);
@@ -84,14 +92,10 @@ sub load_session {
sub create_session {
my $self = shift;
- $self->{id} = $self->_generate_session_id();
+ $self->{id} = HTTP::Session2::Random::generate_session_id();
$self->{_data} = +{};
}
-sub _generate_session_id {
- substr(Digest::SHA::sha1_hex(rand() . $$ . {} . time),int(rand(4)),31);
-}
-
sub regenerate_id {
my ($self) = @_;
@@ -99,7 +103,7 @@ sub regenerate_id {
$self->load_session();
# Create new session.
- $self->{id} = $self->_generate_session_id();
+ $self->{id} = HTTP::Session2::Random::generate_session_id();
$self->is_dirty(1);
$self->necessary_to_send(1);
}
@@ -164,34 +168,9 @@ __END__
=head1 NAME
-HTTP::Session2::ClientStore - Client store
+HTTP::Session2::ClientStore - (Deprecated)Client store
=head1 DESCRIPTION
-This is a part of L<HTTP::Session2> library.
-
-This module stores the data to the cookie value.
-
-=head1 ClientStore specific constructor parameters
-
-=over 4
-
-=item C<< serializer: CodeRef >>
-
-Serializer callback function.
-
-Default: C<< MIME::Base64::encode(Storable::nfreeze($_[0]), '' ) >>
-
-=item C<< deserializer: CodeRef >>
-
-Deserializer callback function.
-
-Default: C<< Storable::thaw(MIME::Base64::decode($_[0])) >>
-
-=item C<< ignore_old: Int >>
-
-Ignore session data older than C<ignore_old> value.
-You can specify this value in epoch time.
-
-=back
+Use L<HTTP::Session2::ClientStore2> instead.
@@ -0,0 +1,227 @@
+package HTTP::Session2::ClientStore2;
+use strict;
+use warnings;
+use utf8;
+use 5.008_001;
+
+use Cookie::Baker ();
+use Storable ();
+use MIME::Base64 ();
+use Digest::HMAC ();
+use HTTP::Session2::Expired;
+use HTTP::Session2::Random;
+use Data::MessagePack;
+use Crypt::CBC;
+
+use Mouse;
+
+extends 'HTTP::Session2::Base';
+
+our $MESSAGE_PACK = Data::MessagePack->new();
+
+has serializer => (
+ is => 'ro',
+ default => sub {
+ sub {
+ $MESSAGE_PACK->pack($_[0]);
+ }
+ },
+);
+
+has deserializer => (
+ is => 'ro',
+ default => sub {
+ sub {
+ $MESSAGE_PACK->unpack($_[0])
+ }
+ },
+);
+
+has cipher => (
+ is => 'ro',
+ isa => 'Crypt::CBC',
+ required => 1,
+);
+
+has ignore_old => (
+ is => 'ro',
+);
+
+no Mouse;
+
+# HMAC timing attack
+sub _compare {
+ my ( $s1, $s2 ) = @_;
+
+ return unless defined $s2;
+ return if length $s1 != length $s2;
+ my $r = 0;
+ for my $i ( 0 .. length($s1) - 1 ) {
+ $r |= ord( substr $s1, $i ) ^ ord( substr $s2, $i );
+ }
+
+ return $r == 0;
+}
+
+sub sig {
+ my($self, $b64) = @_;
+ $self->secret or die "Missing secret. ABORT";
+ Digest::HMAC::hmac_hex($b64, $self->secret, $self->hmac_function);
+}
+
+sub load_session {
+ my $self = shift;
+
+ # Load from cookie.
+ my $cookies = Cookie::Baker::crush_cookie($self->env->{HTTP_COOKIE});
+ my $session_cookie = $cookies->{$self->session_cookie->{name}};
+ if (defined $session_cookie) {
+ my $textified = $session_cookie;
+ my $encrypted = MIME::Base64::decode_base64url($textified);
+ my $serialized_and_sig = eval { $self->cipher->decrypt($encrypted) };
+ if ($@) {
+ warn $@;
+ return;
+ }
+ my ($sig, $serialized) = @{$self->deserializer->($serialized_and_sig)};
+ _compare($self->sig($serialized), $sig) or do {
+ return;
+ };
+ my ($time, $id, $data) = @{$self->deserializer->($serialized)};
+
+ if (defined $self->ignore_old) {
+ if ($time < $self->ignore_old()) {
+ return;
+ }
+ }
+
+ $self->{id} = $id;
+ $self->{_data} = $data;
+ return 1;
+ }
+}
+
+sub create_session {
+ my $self = shift;
+
+ $self->{id} = HTTP::Session2::Random::generate_session_id();
+ $self->{_data} = +{};
+}
+
+sub regenerate_id {
+ my ($self) = @_;
+
+ # Load original session first.
+ $self->load_session();
+
+ # Create new session.
+ $self->{id} = HTTP::Session2::Random::generate_session_id();
+ $self->is_dirty(1);
+ $self->necessary_to_send(1);
+}
+
+sub xsrf_token {
+ my $self = shift;
+ return $self->id;
+}
+
+sub expire {
+ my $self = shift;
+
+ # Load original session first.
+ $self->load_session();
+
+ # Rebless to expired object.
+ bless $self, 'HTTP::Session2::Expired';
+
+ return;
+}
+
+sub finalize {
+ my ($self) = @_;
+
+ return () unless $self->necessary_to_send || $self->is_dirty;
+
+ my @cookies;
+
+ # Finalize session cookie
+ {
+ my %cookie = %{$self->session_cookie};
+ my $name = delete $cookie{name};
+ my $value = $self->_serialize($self->id, $self->_data);
+ push @cookies, $name => +{
+ %cookie,
+ value => $value,
+ };
+ }
+
+ # Finalize XSRF cookie
+ {
+ my %cookie = %{$self->xsrf_cookie};
+ my $name = delete $cookie{name};
+ push @cookies, $name => +{
+ %cookie,
+ value => $self->id,
+ };
+ }
+
+ return @cookies;
+}
+
+sub _serialize {
+ my ($self, $id, $data) = @_;
+
+ my $serialized = $self->serializer->([time(), $id, $data]);
+ my $sig = $self->sig($serialized);
+ my $joined = $self->serializer->([$sig, $serialized]);
+ my $encrypted = $self->cipher->encrypt($joined);
+ $encrypted = MIME::Base64::encode_base64url($encrypted);
+ return $encrypted;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+HTTP::Session2::ClientStore2 - Client store
+
+=head1 DESCRIPTION
+
+This is a part of L<HTTP::Session2> library.
+
+This module stores the data to the cookie value with encryption.
+
+Normally, you should use L<HTTP::Session2::ServerStore>.
+
+=head1 ClientStore specific constructor parameters
+
+=over 4
+
+=item C<< serializer: CodeRef >>
+
+Serializer callback function.
+
+Default: C<< MIME::Base64::encode(Storable::nfreeze($_[0]), '' ) >>
+
+=item C<< deserializer: CodeRef >>
+
+Deserializer callback function.
+
+Default: C<< Storable::thaw(MIME::Base64::decode($_[0])) >>
+
+=item C<< ignore_old: Int >>
+
+Ignore session data older than C<ignore_old> value.
+You can specify this value in epoch time.
+
+=item C<< cipher: Crypt::CBC >> : Required
+
+Cipher for the session data.
+
+=back
+
+=head1 BACKWARD COMPATIBILITY
+
+1.03 ~ 1.07 was broken. Do not use these version.
+
@@ -0,0 +1,39 @@
+package HTTP::Session2::Random;
+use strict;
+use warnings;
+use utf8;
+use 5.008_001;
+
+# DO NOT USE THIS DIRECTLY.
+
+use MIME::Base64 ();
+use Digest::SHA ();
+use Time::HiRes;
+
+our $URANDOM_FH;
+
+# $URANDOM_FH is undef if there is no /dev/urandom
+open $URANDOM_FH, '<:raw', '/dev/urandom'
+ or do {
+ undef $URANDOM_FH;
+ warn "Cannot open /dev/urandom: $!.";
+};
+
+sub generate_session_id {
+ if ($URANDOM_FH) {
+ my $length = 24;
+ # Generate session id from /dev/urandom.
+ my $read = read($URANDOM_FH, my $buf, $length);
+ if ($read != $length) {
+ die "Cannot read bytes from /dev/urandom: $!";
+ }
+ my $result = MIME::Base64::encode_base64($buf, '');
+ $result =~ tr|+/=|\-_|d; # make it url safe
+ return substr($result, 0, 31);
+ } else {
+ # It's weaker than above. But it's portable.
+ substr(Digest::SHA::sha1_hex(rand() . $$ . {} . Time::HiRes::time()),int(rand(4)),31);
+ }
+}
+
+1;
@@ -4,13 +4,14 @@ use warnings;
use utf8;
use 5.008_001;
-our $VERSION = "0.04";
+our $VERSION = "1.08";
use Carp ();
use Digest::HMAC;
use Digest::SHA ();
use Cookie::Baker ();
use HTTP::Session2::Expired;
+use HTTP::Session2::Random;
use Mouse;
@@ -60,15 +61,11 @@ sub load_session {
sub create_session {
my $self = shift;
- $self->{id} = $self->_generate_session_id();
+ $self->{id} = HTTP::Session2::Random::generate_session_id();
$self->{_data} = +{};
$self->is_fresh(1);
}
-sub _generate_session_id {
- substr(Digest::SHA::sha1_hex(rand() . $$ . {} . time),int(rand(4)),31);
-}
-
sub regenerate_id {
my ($self) = @_;
@@ -85,7 +82,7 @@ sub regenerate_id {
delete $self->{xsrf_token};
# Create new session.
- $self->{id} = $self->_generate_session_id();
+ $self->{id} = HTTP::Session2::Random::generate_session_id();
$self->necessary_to_send(1);
$self->is_dirty(1);
}
@@ -111,6 +108,10 @@ sub expire {
sub _build_xsrf_token {
my $self = shift;
+
+ # @kazuho san recommend to change this code as `hmax(secret, id, hmac_function)`.
+ # It makes secure. But we can't change this code for backward compatibility.
+ # We should change this code at HTTP::Session3.
Digest::HMAC::hmac_hex($self->id, $self->secret, $self->hmac_function);
}
@@ -3,7 +3,7 @@ use 5.008005;
use strict;
use warnings;
-our $VERSION = "0.04";
+our $VERSION = "1.08";
1;
__END__
@@ -21,10 +21,20 @@ HTTP::Session2 - HTTP session management
package MyApp;
use HTTP::Session2;
+ my $cipher = Crypt::CBC->new(
+ {
+ key => 'abcdefghijklmnop',
+ cipher => 'Rijndael',
+ }
+ );
sub session {
my $self = shift;
if (!exists $self->{session}) {
- $self->{session} = HTTP::Session2::ClientStore->new(env => $env, secret => 'very long secret string');
+ $self->{session} = HTTP::Session2::ClientStore2->new(
+ env => $env,
+ secret => 'very long secret string'
+ cipher => $cipher,
+ );
}
$self->{session};
}
@@ -125,7 +135,7 @@ You need to call XSRF validator.
}
);
-=head1 pros/cons for ServerStore/ClientStore
+=head1 pros/cons for ServerStore/ClientStore2
=head2 ServerStore
@@ -151,7 +161,7 @@ You need to setup some configuration for your application.
=back
-=head2 ClientStore
+=head2 ClientStore2
=head3 pros
@@ -175,10 +185,6 @@ It helps your wallet.
I hope this module is secure. Because the data was signed by HMAC. But security thing is hard.
-=item Session data is readable by users
-
-You can't store the any secret data to the session. Because this library signed to the data, but not encrypted.
-
=item Bandwidth
If you store the large data to the session, your session data is send to the server per every request.
@@ -224,5 +230,9 @@ it under the same terms as Perl itself.
tokuhirom E<lt>tokuhirom@gmail.comE<gt>
+=head1 CONTRIBUTORS
+
+magai
+
=cut
@@ -7,21 +7,41 @@ use Plack::Response;
use HTTP::Session2::ClientStore;
use Test::WWW::Mechanize::PSGI;
-my $app = sub {
- my $env = shift;
+{
+ my $app = sub {
+ my $env = shift;
- my $session = HTTP::Session2::ClientStore->new(env => $env, secret => 'yes. i am secret man.');
- $session->set(foo => 'bar');
+ my $session = HTTP::Session2::ClientStore->new(env => $env, secret => 'yes. i am secret man.');
+ $session->set(foo => 'bar');
- my $res = Plack::Response->new(200);
- $session->finalize_plack_response($res);
- return $res->finalize;
-};
+ my $res = Plack::Response->new(200);
+ $session->finalize_plack_response($res);
+ return $res->finalize;
+ };
-my $mech = Test::WWW::Mechanize::PSGI->new(app => $app, max_redirect => 0);
-$mech->get('/');
-note $mech->response->headers->as_string;
-is cookie_count($mech), 2;
+ my $mech = Test::WWW::Mechanize::PSGI->new(app => $app, max_redirect => 0);
+ $mech->get('/');
+ note $mech->response->headers->as_string;
+ is cookie_count($mech), 2;
+}
+
+{
+ my $app = sub {
+ my $env = shift;
+
+ my $session = HTTP::Session2::ClientStore->new(env => $env, secret => 'yes. i am secret man.');
+ $session->expire;
+
+ my $res = Plack::Response->new(200);
+ $session->finalize_plack_response($res);
+ return $res->finalize;
+ };
+
+ my $mech = Test::WWW::Mechanize::PSGI->new(app => $app, max_redirect => 0);
+ $mech->get('/');
+ note $mech->response->headers->as_string;
+ is cookie_count($mech), 0;
+}
done_testing;
@@ -0,0 +1,30 @@
+use strict;
+use warnings;
+use Test::More;
+use HTTP::Session2::Random;
+
+if ($HTTP::Session2::Random::URANDOM_FH) {
+ diag "/dev/urandom available";
+ my $token_urandom1 = HTTP::Session2::Random::generate_session_id();
+ my $token_urandom2 = HTTP::Session2::Random::generate_session_id();
+ my $token_perl = sub {
+ local $HTTP::Session2::Random::URANDOM_FH; # Use original mode.
+ HTTP::Session2::Random::generate_session_id();
+ }->();
+ diag "/dev/urandom(1): " . $token_urandom1;
+ diag "/dev/urandom(2): " . $token_urandom2;
+ diag "perl: " . $token_perl;
+ is length($token_urandom1), length($token_perl);
+
+ isnt $token_urandom1, $token_urandom2;
+} else {
+ diag "No /dev/urandom";
+}
+
+subtest 'perl random test', sub {
+ local $HTTP::Session2::Random::URANDOM_FH; # Use original mode.
+ my $token = HTTP::Session2::Random::generate_session_id();
+ is length($token), 31;
+};
+
+done_testing;
@@ -0,0 +1,41 @@
+use strict;
+use warnings;
+use Crypt::CBC;
+use HTTP::Session2::ClientStore2;
+use Test::More;
+
+my $cipher = Crypt::CBC->new(
+ {
+ key => 'abcdefghijklmnop',
+ cipher => 'Rijndael',
+ }
+);
+
+{
+ my $warn = '';
+ local $SIG{__WARN__} = sub {
+ $warn .= "@_";
+ };
+ my $session = HTTP::Session2::ClientStore2->new(
+ env => {
+ },
+ secret => 's3cret',
+ cipher => $cipher,
+ );
+ like $warn, qr/Secret string too short/;
+}
+{
+ my $warn = '';
+ local $SIG{__WARN__} = sub {
+ $warn .= "@_";
+ };
+ my $session = HTTP::Session2::ClientStore2->new(
+ env => {
+ },
+ secret => 's3cretooooooooooooooooooo',
+ cipher => $cipher,
+ );
+ unlike $warn, qr/Secret string too short/;
+}
+
+done_testing;
@@ -0,0 +1,146 @@
+use strict;
+use warnings;
+use utf8;
+use Test::More;
+use lib 't/lib';
+use HTTP::Session2::ClientStore2;
+
+sub scenario {
+ subtest(@_);
+}
+sub step { note $_[0]; goto $_[1] }
+sub empty_res { [200, [], []] }
+
+my $cipher = Crypt::CBC->new(
+ {
+ key => 'abcdefghijklmnop',
+ cipher => 'Rijndael',
+ }
+);
+
+scenario 'First request' => sub {
+ my $session;
+ step 'client -> server: request without cookie' => sub {
+ $session = HTTP::Session2::ClientStore2->new(
+ env => {
+ },
+ secret => 's3cret',
+ cipher => $cipher,
+ );
+ };
+ step 'server -> client: response without cookie' => sub {
+ my $res = empty_res();
+ $session->finalize_psgi_response($res);
+ is_deeply $res->[1], [];
+ };
+};
+
+scenario 'Store something without login' => sub {
+ my $session;
+ step 'client -> server: request without cookie' => sub {
+ $session = HTTP::Session2::ClientStore2->new(
+ env => {
+ },
+ secret => 's3cret',
+ cipher => $cipher,
+ );
+ };
+ step 'server -> store: save data' => sub {
+ $session->set('foo' => 'bar');
+ };
+ step 'server -> client: response with session/xsrf cookie' => sub {
+ my $res = empty_res();
+ $session->finalize_psgi_response($res);
+ is $res->[1]->[0], 'Set-Cookie';
+ my ($session) = ($res->[1]->[1] =~ qr{\Ahss_session=([^;]*); path=/; HttpOnly\z});
+ ok $session or diag $res->[1]->[1];
+ is $res->[1]->[2], 'Set-Cookie';
+ like $res->[1]->[3], qr{\AXSRF-TOKEN=([^;]*); path=/\z};
+ my $xsrf_token = $1;
+
+ note $session;
+ };
+};
+
+
+scenario 'Login' => sub {
+ my $session;
+ step 'client -> server: request without cookie' => sub {
+ $session = HTTP::Session2::ClientStore2->new(
+ env => {
+ HTTP_COOKIE => 'hss_session=1406890754%3As4qlg6vKuD1l0WJac2Epbk4m6wWFcmv%3AU2FsdGVkX19IMvx9Dwd_G2ZwMEdILVVdlQK_GocHsIo%3A38313236366131636465383263616565633230303264326566633739356636363139326130363730',
+ },
+ secret => 's3cret',
+ cipher => $cipher,
+ );
+ };
+ step 'server -> server: regenerate_id' => sub {
+ $session->regenerate_id();
+ };
+ step 'server -> store: save data' => sub {
+ $session->set('user_id' => '5963');
+ };
+ step 'server -> client: response with session/xsrf cookie' => sub {
+ my $res = empty_res();
+ $session->finalize_psgi_response($res);
+ is 0+@{$res->[1]}, 4;
+ is $res->[1]->[0], 'Set-Cookie';
+ my ($sess_id) = ($res->[1]->[1] =~ qr{\Ahss_session=([^;]*); path=/; HttpOnly\z});
+ ok $sess_id;
+ is $res->[1]->[2], 'Set-Cookie';
+ like $res->[1]->[3], qr{\AXSRF-TOKEN=([^;]*); path=/\z};
+ my $xsrf_token = $1;
+
+ note $sess_id;
+ };
+};
+
+
+scenario 'In a login session' => sub {
+ my $session;
+ step 'client -> server: request without cookie' => sub {
+ $session = HTTP::Session2::ClientStore2->new(
+ env => {
+ HTTP_COOKIE => 'hss_session=1406890754%3As4qlg6vKuD1l0WJac2Epbk4m6wWFcmv%3AU2FsdGVkX19IMvx9Dwd_G2ZwMEdILVVdlQK_GocHsIo%3A38313236366131636465383263616565633230303264326566633739356636363139326130363730',
+ },
+ secret => 's3cret',
+ cipher => $cipher,
+ );
+ };
+ step 'server -> store: set more data' => sub {
+ $session->set('foo' => 'bar');
+ };
+ step 'server -> client: response without session/xsrf cookie' => sub {
+ my $res = empty_res();
+ $session->finalize_psgi_response($res);
+ is 0+@{$res->[1]}, 4;
+ };
+};
+
+scenario 'Logout' => sub {
+ my $session;
+ step 'client -> server: request without cookie' => sub {
+ $session = HTTP::Session2::ClientStore2->new(
+ env => {
+ HTTP_COOKIE => 'hss_session=SsEeSsIiOoNn',
+ },
+ secret => 's3cret',
+ cipher => $cipher,
+ );
+ };
+ step 'server -> server: expire' => sub {
+ $session->expire();
+ };
+ step 'server -> client: response with expiration session/xsrf cookie' => sub {
+ my $res = empty_res();
+ $session->finalize_psgi_response($res);
+ is $res->[1]->[0], 'Set-Cookie';
+ like $res->[1]->[1], qr{\Ahss_session=; path=/; expires=[^;]+; HttpOnly\z};
+ is $res->[1]->[2], 'Set-Cookie';
+ like $res->[1]->[3], qr{\AXSRF-TOKEN=; path=/; expires=[^;]*\z};
+ my $xsrf_token = $1;
+ };
+};
+
+done_testing;
+
@@ -0,0 +1,34 @@
+use strict;
+use warnings;
+use Test::More;
+use HTTP::Session2::ClientStore2;
+use Crypt::CBC;
+use Crypt::Rijndael;
+use Test::WWW::Mechanize::PSGI;
+
+my $cipher = Crypt::CBC->new(
+ {
+ key => 'abcdefghijklmnop',
+ cipher => 'Rijndael',
+ }
+);
+my $app = sub {
+ my $env = shift;
+ my $session = HTTP::Session2::ClientStore2->new(
+ env => $env,
+ secret => 'very long secret string',
+ cipher => $cipher,
+ );
+ my $cnt = $session->get('cnt') || 0;
+ $cnt++;
+ $session->set('cnt' => $cnt);
+ my $res = [200, [], [$cnt]];
+ $session->finalize_psgi_response($res);
+ return $res;
+};
+my $mech = Test::WWW::Mechanize::PSGI->new(app => $app);
+is $mech->get('/')->content, 1;
+is $mech->get('/')->content, 2;
+is $mech->get('/')->content, 3;
+
+done_testing;
@@ -0,0 +1,42 @@
+use strict;
+use warnings;
+use Test::More;
+use HTTP::Session2::ClientStore2;
+use Crypt::CBC;
+use Crypt::Rijndael;
+use Test::WWW::Mechanize::PSGI;
+
+my $cipher = Crypt::CBC->new(
+ {
+ key => 'abcdefghijklmnop',
+ cipher => 'Rijndael',
+ }
+);
+my $app = sub {
+ my $env = shift;
+ my $session = HTTP::Session2::ClientStore2->new(
+ env => $env,
+ secret => 'very long secret string',
+ cipher => $cipher,
+ );
+ my $res = sub {
+ if ($env->{PATH_INFO} eq '/get') {
+ my $data = $session->get('data') || 'NO DATA';
+ return [200, [], [$data]];
+ } elsif ($env->{PATH_INFO} eq '/set') {
+ my $data = do { local $/; my $fh = $env->{'psgi.input'}; <$fh> };
+ $session->set('data', $data);
+ return [200, [], [$data]];
+ } else {
+ return [404, [], []];
+ }
+ }->();
+ $session->finalize_psgi_response($res);
+ return $res;
+};
+my $mech = Test::WWW::Mechanize::PSGI->new(app => $app);
+is $mech->get('/get')->content, 'NO DATA';
+is $mech->post('/set', Content => 'hoge:hoge')->content, 'hoge:hoge';
+is $mech->get('/get')->content, 'hoge:hoge';
+
+done_testing;