Add support for encrypted sessions with CryptX

.github/workflows/linux.yml

@@ -32,7 +32,7 @@ jobs:
       - name: Install dependencies
         run: |
           cpanm -n --installdeps .
-          cpanm -n Cpanel::JSON::XS EV Role::Tiny
+          cpanm -n Cpanel::JSON::XS EV Role::Tiny CryptX
           cpanm -n Test::Pod Test::Pod::Coverage TAP::Formatter::GitHubActions
       - name: Run tests
         run: prove --merge --formatter TAP::Formatter::GitHubActions -l t t/mojo t/mojolicious

lib/Mojo/Util.pm

@@ -21,6 +21,17 @@ use Symbol             qw(delete_package);
 use Time::HiRes        ();
 use Unicode::Normalize ();
 
+# Encryption support requires CryptX 0.080+
+use constant CRYPTX => $ENV{MOJO_NO_CRYPTX} ? 0 : !!(eval {
+  require CryptX;
+  require Crypt::AuthEnc::ChaCha20Poly1305;
+  require Crypt::KeyDerivation;
+  require Crypt::Misc;
+  require Crypt::PRNG;
+  CryptX->VERSION('0.080');
+  1;
+});
+
 # Check for monotonic clock support
 use constant MONOTONIC => !!eval { Time::HiRes::clock_gettime(Time::HiRes::CLOCK_MONOTONIC()) };
 
@@ -64,15 +75,15 @@ my $UNQUOTED_VALUE_RE = qr/\G=\s*([^;, ]*)/;
 # HTML entities
 my $ENTITY_RE = qr/&(?:\#((?:[0-9]{1,7}|x[0-9a-fA-F]{1,6}));|(\w+[;=]?))/;
 
-# Encoding and pattern cache
-my (%ENCODING, %PATTERN);
+# Encoding, encryption and pattern caches
+my (%ENCODING, %ENCRYPTION, %PATTERN);
 
 our @EXPORT_OK = (
-  qw(b64_decode b64_encode camelize class_to_file class_to_path decamelize decode deprecated dumper encode),
-  qw(extract_usage getopt gunzip gzip header_params hmac_sha1_sum html_attr_unescape html_unescape humanize_bytes),
-  qw(md5_bytes md5_sum monkey_patch network_contains punycode_decode punycode_encode quote scope_guard secure_compare),
-  qw(sha1_bytes sha1_sum slugify split_cookie_header split_header steady_time tablify term_escape trim unindent),
-  qw(unquote url_escape url_unescape xml_escape xor_encode)
+  qw(b64_decode b64_encode camelize class_to_file class_to_path decamelize decode decrypt_cookie deprecated dumper),
+  qw(encode encrypt_cookie extract_usage generate_secret getopt gunzip gzip header_params hmac_sha1_sum),
+  qw(html_attr_unescape html_unescape humanize_bytes md5_bytes md5_sum monkey_patch network_contains punycode_decode),
+  qw(punycode_encode quote scope_guard secure_compare sha1_bytes sha1_sum slugify split_cookie_header split_header),
+  qw(steady_time tablify term_escape trim unindent unquote url_escape url_unescape xml_escape xor_encode)
 );
 
 # Aliases
@@ -115,6 +126,18 @@ sub decamelize {
   } split /::/, $str;
 }
 
+sub decrypt_cookie {
+  my ($value, $key, $salt) = @_;
+  croak 'CryptX 0.080+ required for encrypted cookie support' unless CRYPTX;
+
+  return undef unless $value =~ /^([^-]+)--([^-]+)--([^-]+)$/;
+  my ($ct, $iv, $tag) = ($1, $2, $3);
+  ($ct, $iv, $tag) = (Crypt::Misc::decode_b64($ct), Crypt::Misc::decode_b64($iv), Crypt::Misc::decode_b64($tag));
+
+  my $dk = $ENCRYPTION{$key}{$salt} ||= Crypt::KeyDerivation::pbkdf2($key, $salt);
+  return Crypt::AuthEnc::ChaCha20Poly1305::chacha20poly1305_decrypt_verify($dk, $iv, '', $ct, $tag);
+}
+
 sub decode {
   my ($encoding, $bytes) = @_;
   return undef unless eval { $bytes = _encoding($encoding)->decode("$bytes", 1); 1 };
@@ -130,6 +153,17 @@ sub dumper { Data::Dumper->new([@_])->Indent(1)->Sortkeys(1)->Terse(1)->Useqq(1)
 
 sub encode { _encoding($_[0])->encode("$_[1]", 0) }
 
+sub encrypt_cookie {
+  my ($value, $key, $salt) = @_;
+  croak 'CryptX 0.080+ required for encrypted cookie support' unless CRYPTX;
+
+  my $dk = $ENCRYPTION{$key}{$salt} ||= Crypt::KeyDerivation::pbkdf2($key, $salt);
+  my $iv = Crypt::PRNG::random_bytes(12);
+  my ($ct, $tag) = Crypt::AuthEnc::ChaCha20Poly1305::chacha20poly1305_encrypt_authenticate($dk, $iv, '', $value);
+
+  return join '--', Crypt::Misc::encode_b64($ct), Crypt::Misc::encode_b64($iv), Crypt::Misc::encode_b64($tag);
+}
+
 sub extract_usage {
   my $file = @_ ? "$_[0]" : (caller)[1];
 
@@ -141,6 +175,12 @@ sub extract_usage {
   return unindent($output);
 }
 
+sub generate_secret {
+  return Crypt::Misc::encode_b64u(Crypt::PRNG::random_bytes(128)) if CRYPTX;
+  srand;
+  return sha1_sum($$ . steady_time() . rand);
+}
+
 sub getopt {
   my ($array, $opts) = map { ref $_[0] eq 'ARRAY' ? shift : $_ } \@ARGV, [];
 
@@ -634,6 +674,13 @@ Convert C<CamelCase> string to C<snake_case> and replace C<::> with C<->.
 
 Decode bytes to characters with L<Encode>, or return C<undef> if decoding failed.
 
+=head2 decrypt_cookie
+
+  my $value = decrypt_cookie $encrypted, 'passw0rd', 'salt';
+
+Decrypt cookie value encrypted with L</encrypt_cookie>, returns the decrypted value or C<undef>. Note that this
+function is B<EXPERIMENTAL> and might change without warning!
+
 =head2 deprecated
 
   deprecated 'foo is DEPRECATED in favor of bar';
@@ -653,6 +700,12 @@ Dump a Perl data structure with L<Data::Dumper>.
 
 Encode characters to bytes with L<Encode>.
 
+=head2 encrypt_cookie
+
+  my $encrypted = encrypt_cookie $value, 'passw0rd', 'salt';
+
+Encrypt cookie value. Note that this function is B<EXPERIMENTAL> and might change without warning!
+
 =head2 extract_usage
 
   my $usage = extract_usage;
@@ -670,6 +723,13 @@ function was called from.
 
   =cut
 
+=head2 generate_secret
+
+  my $secret = generate_secret;
+
+Generate a random secret with a cryptographically secure random number generator if available, and a less secure
+fallback if not. Note that this function is B<EXPERIMENTAL> and might change without warning!
+
 =head2 getopt
 
   getopt

lib/Mojolicious.pm

@@ -513,6 +513,9 @@ rotating passphrases, just add new ones to the front and remove old ones from th
 Signed cookie based session manager, defaults to a L<Mojolicious::Sessions> object. You can usually leave this alone,
 see L<Mojolicious::Controller/"session"> for more information about working with session data.
 
+  # Enable encrypted sessions
+  $app->sessions->encrypted(1);
+
   # Change name of cookie used for all sessions
   $app->sessions->cookie_name('mysession');
 

lib/Mojolicious/Command/Author/generate/app.pm

@@ -196,7 +196,7 @@ done_testing();
 </p>
 
 @@ config
-% use Mojo::Util qw(sha1_sum steady_time);
+% use Mojo::Util qw(generate_secret);
 ---
 secrets:
-  - <%= sha1_sum $$ . steady_time . rand  %>
+  - <%= generate_secret() %>

lib/Mojolicious/Command/version.pm

@@ -4,6 +4,7 @@ use Mojo::Base 'Mojolicious::Command';
 use Mojo::IOLoop::Client;
 use Mojo::IOLoop::TLS;
 use Mojo::JSON;
+use Mojo::Util;
 use Mojolicious;
 
 has description => 'Show versions of available modules';
@@ -12,13 +13,14 @@ has usage       => sub { shift->extract_usage };
 sub run {
   my $self = shift;
 
-  my $json  = Mojo::JSON->JSON_XS                   ? $Cpanel::JSON::XS::VERSION   : 'n/a';
-  my $ev    = eval { require Mojo::Reactor::EV; 1 } ? $EV::VERSION                 : 'n/a';
-  my $socks = Mojo::IOLoop::Client->can_socks       ? $IO::Socket::Socks::VERSION  : 'n/a';
-  my $tls   = Mojo::IOLoop::TLS->can_tls            ? $IO::Socket::SSL::VERSION    : 'n/a';
-  my $nnr   = Mojo::IOLoop::Client->can_nnr         ? $Net::DNS::Native::VERSION   : 'n/a';
-  my $roles = Mojo::Base->ROLES                     ? $Role::Tiny::VERSION         : 'n/a';
-  my $async = Mojo::Base->ASYNC                     ? $Future::AsyncAwait::VERSION : 'n/a';
+  my $json   = Mojo::JSON->JSON_XS                   ? $Cpanel::JSON::XS::VERSION   : 'n/a';
+  my $cryptx = Mojo::Util->CRYPTX                    ? $CryptX::VERSION             : 'n/a';
+  my $ev     = eval { require Mojo::Reactor::EV; 1 } ? $EV::VERSION                 : 'n/a';
+  my $socks  = Mojo::IOLoop::Client->can_socks       ? $IO::Socket::Socks::VERSION  : 'n/a';
+  my $tls    = Mojo::IOLoop::TLS->can_tls            ? $IO::Socket::SSL::VERSION    : 'n/a';
+  my $nnr    = Mojo::IOLoop::Client->can_nnr         ? $Net::DNS::Native::VERSION   : 'n/a';
+  my $roles  = Mojo::Base->ROLES                     ? $Role::Tiny::VERSION         : 'n/a';
+  my $async  = Mojo::Base->ASYNC                     ? $Future::AsyncAwait::VERSION : 'n/a';
 
   print <<EOF;
 CORE
@@ -27,6 +29,7 @@ CORE
 
 OPTIONAL
   Cpanel::JSON::XS 4.09+   ($json)
+  CryptX 0.080+            ($cryptx)
   EV 4.32+                 ($ev)
   IO::Socket::Socks 0.64+  ($socks)
   IO::Socket::SSL 2.009+   ($tls)

lib/Mojolicious/Controller.pm

@@ -49,8 +49,41 @@ sub cookie {
   return $cookie->value;
 }
 
+sub encrypted_cookie {
+  my ($self, $name, $value, $options) = @_;
+
+  # Request cookie
+  return $self->every_encrypted_cookie($name)->[-1] unless defined $value;
+
+  # Response cookie
+  my $app     = $self->app;
+  my $secret  = $app->secrets->[0];
+  my $moniker = $app->moniker;
+  return $self->cookie($name, Mojo::Util::encrypt_cookie($value, $secret, $moniker), $options);
+}
+
 sub every_cookie { [map { $_->value } @{shift->req->every_cookie(shift)}] }
 
+sub every_encrypted_cookie {
+  my ($self, $name) = @_;
+
+  my $app     = $self->app;
+  my $secrets = $app->secrets;
+  my $moniker = $app->moniker;
+  my @results;
+  for my $value (@{$self->every_cookie($name)}) {
+    my $decrypted;
+    for my $secret (@$secrets) {
+      last if defined($decrypted = Mojo::Util::decrypt_cookie($value, $secret, $moniker));
+    }
+    if (defined $decrypted) { push @results, $decrypted }
+
+    else { $self->helpers->log->trace(qq{Cookie "$name" is not encrypted}) }
+  }
+
+  return \@results;
+}
+
 sub every_param {
   my ($self, $name) = @_;
 
@@ -399,6 +432,17 @@ you want to access more than just the last one, you can use L</"every_cookie">.
   # Create secure response cookie
   $c->cookie(secret => 'I <3 Mojolicious', {secure => 1, httponly => 1});
 
+=head2 encrypted_cookie
+
+  my $value = $c->encrypted_cookie('foo');
+  $c        = $c->encrypted_cookie(foo => 'bar');
+  $c        = $c->encrypted_cookie(foo => 'bar', {path => '/'});
+
+Access encrypted request cookie values and create new encrypted response cookies. If there are multiple values sharing
+the same name, and you want to access more than just the last one, you can use L</"every_encrypted_cookie">. Cookies
+are encrypted with ChaCha20-Poly1305, to prevent tampering, and the ones failing decryption will be automatically
+discarded. Note that this method is B<EXPERIMENTAL> and might change without warning!
+
 =head2 every_cookie
 
   my $values = $c->every_cookie('foo');
@@ -408,6 +452,16 @@ Similar to L</"cookie">, but returns all request cookie values sharing the same
   $ Get first cookie value
   my $first = $c->every_cookie('foo')->[0];
 
+=head2 every_encrypted_cookie
+
+  my $values = $c->every_encrypted_cookie('foo');
+
+Similar to L</"encrypted_cookie">, but returns all encrypted request cookie values sharing the same name as an array
+reference. Note that this method is B<EXPERIMENTAL> and might change without warning!
+
+  # Get first encrypted cookie value
+  my $first = $c->every_encrypted_cookie('foo')->[0];
+
 =head2 every_param
 
   my $values = $c->every_param('foo');

lib/Mojolicious/Guides/FAQ.pod

@@ -27,8 +27,8 @@ frameworks, it is more of a web toolkit and can even be used as the foundation f
 We are optimizing L<Mojolicious> for user-friendliness and development speed, without compromises. While there are no
 rules in L<Mojolicious::Guides::Contributing> that forbid dependencies, we do currently discourage adding non-optional
 ones in favor of a faster and more painless installation process. And we do in fact already use several optional CPAN
-modules such as L<Cpanel::JSON::XS>, L<EV>, L<IO::Socket::Socks>, L<IO::Socket::SSL>, L<Net::DNS::Native>, L<Plack> and
-L<Role::Tiny> to provide advanced functionality if possible.
+modules such as L<Cpanel::JSON::XS>, L<CryptX>, L<EV>, L<IO::Socket::Socks>, L<IO::Socket::SSL>, L<Net::DNS::Native>,
+L<Plack> and L<Role::Tiny> to provide advanced functionality if possible.
 
 =head2 Why reinvent wheels?
 

lib/Mojolicious/Guides/Growing.pod

@@ -104,8 +104,8 @@ web server in the form of cookies.
   Set-Cookie: session=hmac-sha256(base64(json($session)))
 
 In L<Mojolicious> however we are taking this concept one step further by storing everything JSON serialized and Base64
-encoded in HMAC-SHA256 signed cookies, which is more compatible with the REST philosophy and reduces infrastructure
-requirements.
+encoded in HMAC-SHA256 signed, or ChaCha20-Poly1305 encrypted cookies, which is more compatible with the REST
+philosophy and reduces infrastructure requirements.
 
 =head2 Test-Driven Development
 

lib/Mojolicious/Sessions.pm

@@ -4,7 +4,7 @@ use Mojo::Base -base;
 use Mojo::JSON;
 use Mojo::Util qw(b64_decode b64_encode);
 
-has [qw(cookie_domain secure)];
+has [qw(cookie_domain encrypted secure)];
 has cookie_name        => 'mojolicious';
 has cookie_path        => '/';
 has default_expiration => 3600;
@@ -15,7 +15,8 @@ has serialize          => sub { \&_serialize };
 sub load {
   my ($self, $c) = @_;
 
-  return unless my $value = $c->signed_cookie($self->cookie_name);
+  my $method = $self->encrypted ? 'encrypted_cookie' : 'signed_cookie';
+  return unless my $value = $c->$method($self->cookie_name);
   $value =~ y/-/=/;
   return unless my $session = $self->deserialize->(b64_decode $value);
 
@@ -58,16 +59,14 @@ sub store {
     samesite => $self->samesite,
     secure   => $self->secure
   };
-  $c->signed_cookie($self->cookie_name, $value, $options);
+  my $method = $self->encrypted ? 'encrypted_cookie' : 'signed_cookie';
+  $c->$method($self->cookie_name, $value, $options);
 }
 
+# DEPRECATED! (Remove once old sessions with padding are no longer a concern)
 sub _deserialize { Mojo::JSON::decode_json($_[0] =~ s/\}\KZ*$//r) }
 
-sub _serialize {
-  no warnings 'numeric';
-  my $out = Mojo::JSON::encode_json($_[0]);
-  return $out . 'Z' x (1025 - length $out);
-}
+sub _serialize { Mojo::JSON::encode_json($_[0]) }
 
 1;
 
@@ -143,6 +142,14 @@ A callback used to deserialize sessions, defaults to L<Mojo::JSON/"j">.
 
   $sessions->deserialize(sub ($bytes) { return {} });
 
+=head2 encrypted
+
+  my $bool  = $sessions->encrypted;
+  $sessions = $sessions->encrypted($bool);
+
+Use encrypted session cookies instead of merely cryptographically signed ones. Note that this attribute is
+B<EXPERIMENTAL> and might change without warning!
+
 =head2 samesite
 
   my $samesite = $sessions->samesite;

t/mojo/util.t

@@ -8,11 +8,11 @@ use Mojo::ByteStream qw(b);
 use Mojo::DeprecationTest;
 use Sub::Util qw(subname);
 
-use Mojo::Util qw(b64_decode b64_encode camelize class_to_file class_to_path decamelize decode dumper encode),
-  qw(extract_usage getopt gunzip gzip header_params hmac_sha1_sum html_unescape html_attr_unescape humanize_bytes),
-  qw(md5_bytes md5_sum monkey_patch network_contains punycode_decode punycode_encode quote scope_guard secure_compare),
-  qw(sha1_bytes sha1_sum slugify split_cookie_header split_header steady_time tablify term_escape trim unindent),
-  qw(unquote url_escape url_unescape xml_escape xor_encode);
+use Mojo::Util qw(b64_decode b64_encode camelize class_to_file class_to_path decamelize decode decrypt_cookie dumper),
+  qw(encode encrypt_cookie extract_usage generate_secret getopt gunzip gzip header_params hmac_sha1_sum html_unescape),
+  qw(html_attr_unescape humanize_bytes md5_bytes md5_sum monkey_patch network_contains punycode_decode),
+  qw(punycode_encode quote scope_guard secure_compare sha1_bytes sha1_sum slugify split_cookie_header split_header),
+  qw(steady_time tablify term_escape trim unindent unquote url_escape url_unescape xml_escape xor_encode);
 
 subtest 'camelize' => sub {
   is camelize('foo_bar_baz'), 'FooBarBaz', 'right camelized result';
@@ -656,6 +656,27 @@ subtest 'humanize_bytes' => sub {
   is humanize_bytes( 245760),                   '240KiB',  'less than a MiB';
 };
 
+subtest 'encrypt_cookie/decrypt_cookie' => sub {
+  plan skip_all => 'CryptX required!' unless Mojo::Util->CRYPTX;
+
+  subtest 'Roundtrip' => sub {
+    my $encrypted = encrypt_cookie('test', 'foo', 'salt');
+    isnt $encrypted,                              'test', 'encrypted';
+    is decrypt_cookie($encrypted, 'foo', 'salt'), 'test', 'decrypted';
+  };
+
+  is decrypt_cookie('test',                                                 'foo', 'salt'), undef, 'not encrypted';
+  is decrypt_cookie('6Y+LKA==--ROhxLDrUBVkXRKTM--v7Qm+Xgoi1t94GLSHYGkaW==', 'foo', 'salt'), undef, 'wrong tag';
+  is decrypt_cookie('6Y+LKA==--ROhxLDrUBVkXRKTm--v7Qm+Xgoi1t94GLSHYGkaw==', 'foo', 'salt'), undef, 'wrong random bytes';
+  is decrypt_cookie('6Y+LKA==--ROhxLDrUBVkXRKTM--v7Qm+Xgoi1t94GLSHYGkaw==', 'bar', 'salt'), undef, 'wrong password';
+  is decrypt_cookie('6Y+LKA==--ROhxLDrUBVkXRKTM--v7Qm+Xgoi1t94GLSHYGkaw==', 'foo', 'bar'),  undef, 'wrong salt';
+  is decrypt_cookie('6Y+LKA==--ROhxLDrUBVkXRKTM--v7Qm+Xgoi1t94GLSHYGkaw==', 'foo', 'salt'), 'test', 'decrypted';
+};
+
+subtest 'generate_secret' => sub {
+  like generate_secret, qr/^[A-Za-z0-9_-]{32,}$/, 'right format';
+};
+
 subtest 'Hide DATA usage from error messages' => sub {
   eval { die 'whatever' };
   unlike $@, qr/DATA/, 'DATA has been hidden';