Use Crypt::SysRandom to generate session ids

Makefile.PL

@@ -20,7 +20,9 @@ my %META = (
       requires => {
         'Catalyst::Runtime' => '5.71001',
         'namespace::clean' => '0.10',
-        'Digest' => 0,
+        'Crypt::SysRandom' => '0.007',
+        'Digest'           => 0,
+        'Digest::SHA'      => 0,
         'File::Spec' => 0,
         'File::Temp' => 0,
         'List::Util' => 0,
@@ -32,6 +34,9 @@ my %META = (
         'Test::More' => '0.88',
         'perl' => '5.008',
       },
+      recommends => {
+        'Crypt::SysRandom::XS' => '0.009',
+      },
     },
     develop => {
       requires => {

lib/Catalyst/Plugin/Session.pm

@@ -4,6 +4,7 @@ use Moose;
 with 'MooseX::Emulate::Class::Accessor::Fast';
 use MRO::Compat;
 use Catalyst::Exception ();
+use Crypt::SysRandom    ();
 use Digest              ();
 use overload            ();
 use Object::Signature   ();
@@ -82,6 +83,9 @@ sub setup_session {
         verify_address => 0,
         verify_user_agent => 0,
         expiry_threshold => 0,
+        hash_seed_size => 20,
+        use_raw_hash_seed => 0,
+        digest            => "SHA-1",
         %$cfg,
     );
 
@@ -597,12 +601,17 @@ sub initialize_session_data {
     );
 }
 
+
 sub generate_session_id {
     my $c = shift;
-
-    my $digest = $c->_find_digest();
-    $digest->add( $c->session_hash_seed() );
-    return $digest->hexdigest;
+    my $cfg = $c->_session_plugin_config;
+    my $data = $c->session_hash_seed;
+    if ( $cfg->{use_raw_hash_seed} ) {
+        return unpack( "H*", $data );
+    }
+    my $digest = Digest->new( $cfg->{digest} );
+    $digest->add($data);
+    return $digest->hexdigest();
 }
 
 sub create_session_id_if_needed {
@@ -624,33 +633,14 @@ sub create_session_id {
     return $sid;
 }
 
-my $counter;
-
 sub session_hash_seed {
     my $c = shift;
-
-    return join( "", ++$counter, time, rand, $$, {}, overload::StrVal($c), );
+    my $cfg = $c->_session_plugin_config;
+    return Crypt::SysRandom::random_bytes( $c->{hash_seed_size} || 20 );
 }
 
 my $usable;
 
-sub _find_digest () {
-    unless ($usable) {
-        foreach my $alg (qw/SHA-1 SHA-256 MD5/) {
-            if ( eval { Digest->new($alg) } ) {
-                $usable = $alg;
-                last;
-            }
-        }
-        Catalyst::Exception->throw(
-                "Could not find a suitable Digest module. Please install "
-              . "Digest::SHA1, Digest::SHA, or Digest::MD5" )
-          unless $usable;
-    }
-
-    return Digest->new($usable);
-}
-
 sub dump_these {
     my $c = shift;
 
@@ -973,53 +963,26 @@ insensitive hexadecimal characters.
 
 =item generate_session_id
 
-This method will return a string that can be used as a session ID. It is
-supposed to be a reasonably random string with enough bits to prevent
-collision. It basically takes C<session_hash_seed> and hashes it using SHA-1,
-MD5 or SHA-256, depending on the availability of these modules.
-
-=item session_hash_seed
-
-This method is actually rather internal to generate_session_id, but should be
-overridable in case you want to provide more random data.
-
-Currently it returns a concatenated string which contains:
-
-=over 4
-
-=item * A counter
-
-=item * The current time
-
-=item * One value from C<rand>.
+This method will return a string that can be used as a session ID.
 
-=item * The stringified value of a newly allocated hash reference
+If the L</use_raw_hash_seed> option is true, then it will return raw random bytes from L</session_hash_seed> transformed into a hex string.
 
-=item * The stringified value of the Catalyst context object
-
-=back
+Otherwise (default) it will return message L</digest> hex string of the data from C<session_hash_seed>.
 
-in the hopes that those combined values are entropic enough for most uses. If
-this is not the case you can replace C<session_hash_seed> with e.g.
+If you have not overridden the L</session_hash_seed> method then it is recommended that you set C<use_raw_hash_seed> to true.
 
-    sub session_hash_seed {
-        open my $fh, "<", "/dev/random";
-        read $fh, my $bytes, 20;
-        close $fh;
-        return $bytes;
-    }
+You can override this if you prefer to use a different source of randomness or different format of session ids:
 
-Or even more directly, replace C<generate_session_id>:
+    use Crypt::URandom::Token ();
 
     sub generate_session_id {
-        open my $fh, "<", "/dev/random";
-        read $fh, my $bytes, 20;
-        close $fh;
-        return unpack("H*", $bytes);
+        state $tok = Crypt::URandom::Token->new();
+        return $tok->get;
     }
 
-Also have a look at L<Crypt::Random> and the various openssl bindings - these
-modules provide APIs for cryptographically secure random data.
+=item session_hash_seed
+
+This method returns L</hash_seed_size> raw bytes from the system randomness source using L<Crypt::SysRandom>.
 
 =item finalize_session
 
@@ -1091,6 +1054,12 @@ C<Plugin::Session> key in the configuration hash.
 
 =over 4
 
+=item digest
+
+This is the message digest algorithm for processing the L</session_hash_seed>, when L</use_raw_hash_seed> is false.
+
+It defaults to "SHA-1".
+
 =item expires
 
 The time-to-live of each session, expressed in seconds. Defaults to 7200 (two
@@ -1106,6 +1075,18 @@ when nothing else in the session is updated.
 
 Defaults to 0 (in which case, the expiration will always be updated).
 
+=item hash_seed_size
+
+This is the number of bytes retrieved from system randomness source by the L</session_hash_seed> method.
+
+Defaults to 20.
+
+=item use_raw_hash_seed
+
+When true, the L</generate_session_id> method will simply convert the L</session_hash_seed> into a string of hex digits.
+
+Defaults to false for backwards compatability.
+
 =item verify_address
 
 When true, C<< $c->request->address >> will be checked at prepare time. If it is
@@ -1249,5 +1230,3 @@ Robert Rothenberg <[email protected]> (on behalf of Foxtons Ltd.)
     it and/or modify it under the same terms as Perl itself.
 
 =cut
-
-

t/01_setup.t

@@ -62,7 +62,7 @@ is( $calls, 0, "no fatal error logged either" );
 
 cmp_deeply(
     [ keys %{ $config{'Plugin::Session'} } ],
-    bag(qw/expires verify_address verify_user_agent expiry_threshold/),
+    bag(qw/expires verify_address verify_user_agent expiry_threshold hash_seed_size use_raw_hash_seed digest /),
     "default values for config were populated in successful setup",
 );