Deprecate HTTP::Session2::ClientStore. Added new

HTTP::Session2::ClientStore2. It's even better than previous.
tokuhirom · Aug 1, 2014 · 8cbf776 · 8cbf776
1 parent 2719028
commit 8cbf776
Show file tree

Hide file tree

Showing 4 changed files with 346 additions and 159 deletions.
diff --git a/cpanfile b/cpanfile
@@ -8,6 +8,7 @@ requires 'parent';
 requires 'Digest::SHA';
 requires 'MIME::Base64';
 requires 'Time::HiRes';
+requires 'Data::MessagePack';
 
 on 'test' => sub {
     requires 'Test::More', '0.98';

diff --git a/lib/HTTP/Session2/ClientStore.pm b/lib/HTTP/Session2/ClientStore.pm
@@ -4,18 +4,15 @@ 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 Mouse;
 
-extends 'HTTP::Session2::Base';
+extends 'HTTP::Session2::ClientStore2';
 
-has serializer => (
+# Backward compatibility.
+
+has '+serializer' => (
     is => 'ro',
     default => sub {
         sub {
@@ -24,171 +21,22 @@ has serializer => (
     },
 );
 
-has deserializer => (
-    is => 'ro',
+has '+deserializer' => (
     default => sub {
         sub {Storable::thaw(MIME::Base64::decode($_[0]))}
     },
 );
 
-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 ($time, $id, $serialized, $sig) = split /:/, $session_cookie, 4;
-        _compare($self->sig($serialized), $sig) or do {
-            return;
-        };
-
-        if (defined $self->ignore_old) {
-            if ($time < $self->ignore_old()) {
-                return;
-            }
-        }
-
-        my $data = $self->deserializer->($serialized);
-        $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->($data);
-    join ":", time(), $id, $serialized, $self->sig($serialized);
-}
-
 1;
 __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.