Make stateless.

MulkyID does not use session state stored in /tmp anymore.  Instead, it
uses a cookie encrypted with the private part of the MulkyID
instance's RSA key.

6 files changed, 62 insertions, 62 deletions

diff --git a/README.md b/README.md
index ff74a38..c2f9f1a 100644
--- a/README.md
+++ b/README.md
@@ -33,7 +33,6 @@ The following CPAN modules need to be installed:
 
  * `CGI`
  * `CGI::Fast`
- * `CGI::Session`
  * `common::sense`
  * `Crypt::OpenSSL::RSA`
  * `Crypt::OpenSSL::Bignum`
diff --git a/www/authenticate.pl b/www/authenticate.pl
index d73869d..ed0fb95 100755
--- a/www/authenticate.pl
+++ b/www/authenticate.pl
@@ -9,44 +9,23 @@ use JSON;
 
 use CGI;
 use CGI::Fast;
-use CGI::Session;
 
 use Net::Google::FederatedLogin;
 
 do "common.pl";
 
-sub redirect_with_cookie($$$$) {
-  my ($cgi, $uri, $session, $cookie) = @_;
-  if ($cookie) {
-    print $cgi->redirect(-url => $uri);
-  } else {
-    my $cookie = $cgi->cookie(-name     => 'mulkid_session',
-                              -value    => $session->id,
-                              -expires  => '+1d',
-                              -secure   => 1,
-                              -httponly => 1,
-                              #-domain   => '.'.$::MULKONF->{realm}
-                             );
-    print $cgi->redirect(-cookie => $cookie, -url => $uri);
-  }
-}
-
 while (my $cgi = new CGI::Fast) {
   load_config();
 
-  my $claimed_email = $cgi->param('email');
-  my $cookie = $cgi->cookie('mulkid_session');
-  my $session = new CGI::Session("driver:File", $cookie, {Directory=>"/tmp"});
-
   my $fakedomain = $::MULKONF->{fake_domain};
   my $realdomain = $::MULKONF->{real_domain};
-  $claimed_email =~ s/\@$fakedomain/\@$realdomain/ if $fakedomain;
 
-  $session->param('claimed_email', $claimed_email);
+  my $claimed_email = $cgi->param('email');
+  $claimed_email =~ s/\@$fakedomain/\@$realdomain/ if $fakedomain;
 
   given (my $_ = $::MULKONF->{auth_type}) {
     when ('imap') {
-      redirect_with_cookie($cgi, reluri($cgi, "authenticate-with-password.html?email=$claimed_email"), $session, $cookie);
+      print $cgi->redirect(reluri($cgi, "authenticate-with-password.html?email=$claimed_email"));
     }
     when ('google') {
       my $g = Net::Google::FederatedLogin->new(
@@ -58,7 +37,7 @@ while (my $cgi = new CGI::Fast) {
                                         required    => 'email',
                                         type        => {email => 'http://axschema.org/contact/email'}}}]
       );
-      redirect_with_cookie($cgi, $g->get_auth_url(), $session, $cookie);
+      print $cgi->redirect($g->get_auth_url());
     }
     default {
       die "Invalid auth_type! " . $::MULKONF->{auth_type};
diff --git a/www/common.pl b/www/common.pl
index 736bf00..a094442 100644
--- a/www/common.pl
+++ b/www/common.pl
@@ -7,6 +7,7 @@ use Modern::Perl;
 
 use Mail::ExpandAliases;
 use URI;
+use MIME::Base64 qw(encode_base64 decode_base64);
 
 sub load_config() {
   $::MULKONF = { };
@@ -41,3 +42,19 @@ sub reluri($$) {
   $uri->path_segments(@path);
   return "$uri";
 }
+
+sub decode_base64_url($) {
+  # From: https://github.com/ptarjan/base64url/blob/master/perl.pl
+  (my $s = shift) =~ tr{-_}{+/};
+  $s .= '=' x (4 - length($s));
+  return decode_base64($s);
+}
+
+sub encode_base64_url($) {
+  my ($s) = shift;
+  $s = encode_base64($s);
+  $s =~ tr{+/}{-_};
+  $s =~ s/=*$//;
+  $s =~ s/\n//g;
+  return $s;
+}
diff --git a/www/logged_in_p.pl b/www/logged_in_p.pl
index 73c9d1c..b076618 100755
--- a/www/logged_in_p.pl
+++ b/www/logged_in_p.pl
@@ -10,6 +10,8 @@ use JSON;
 
 use File::Slurp;
 
+use Crypt::OpenSSL::RSA;
+
 use CGI;
 use CGI::Fast;
 use CGI::Session;
@@ -18,24 +20,32 @@ do "common.pl";
 
 
 while (my $cgi = new CGI::Fast) {
+  $::MULKONF = {};   # to silence a warning
   load_config();
 
   print $cgi->header(-content_type => 'application/json; charset=UTF-8');
 
-  my $cookie = $cgi->cookie('mulkid_session');
+  my $cookie = $cgi->cookie('mulkyid_session');
+
   unless ($cookie) {
     say encode_json({logged_in_p => 0});
     exit(0);
   }
 
-  my $session = new CGI::Session("driver:File", $cookie, {Directory=>"/tmp"});
-  unless ($session) {
+  my $key = Crypt::OpenSSL::RSA->new_private_key(scalar read_file($::MULKONF->{pemfile}));
+  $key->use_pkcs1_padding();
+  $key->use_sha256_hash();
+
+  my $reverse_encrypted_user_session = decode_base64_url($cookie);
+  my $plain_user_session = $key->public_decrypt($reverse_encrypted_user_session);
+  my ($session_user, $timestamp) = split /#/, $plain_user_session;
+
+  if ($timestamp < time - 24*3600) {
     say encode_json({logged_in_p => 0});
     exit(0);
   }
 
-  my $email        = $cgi->param('email')    or die "No email address supplied";
-  my $session_user = $session->param('user');
+  my $email = $cgi->param('email')    or die "No email address supplied";
   if (any(email_users($email)) eq $session_user) {
     say encode_json({logged_in_p => 1});
   } else {
diff --git a/www/login.pl b/www/login.pl
index 1b196fa..2be2b77 100755
--- a/www/login.pl
+++ b/www/login.pl
@@ -7,9 +7,13 @@ use Modern::Perl;
 
 use JSON;
 
+use File::Slurp;
+
+use Crypt::OpenSSL::RSA;
+
 use CGI;
 use CGI::Fast;
-use CGI::Session;
+use CGI::Cookie;
 
 use Mail::IMAPTalk ;
 use Net::Google::FederatedLogin;
@@ -37,12 +41,21 @@ sub check_imap_password($$) {
   }
 }
 
+sub cookie_for_user {
+  my ($user) = @_;
+
+  my $key = Crypt::OpenSSL::RSA->new_private_key(scalar read_file($::MULKONF->{pemfile}));
+  $key->use_pkcs1_padding();
+  $key->use_sha256_hash();
+
+  my $plain_user_session = $user . '#' . time;
+  my $reverse_encrypted_user_session = $key->private_encrypt($plain_user_session);
+  my $cookie = CGI::Cookie->new(-name => 'mulkyid_session', -value =>encode_base64_url($reverse_encrypted_user_session));
+}
 
 while (my $cgi = new CGI::Fast) {
   load_config();
 
-  my $cookie = $cgi->cookie('mulkid_session');
-  my $session = new CGI::Session("driver:File", $cookie, {Directory=>"/tmp"});
   given (my $_ = $::MULKONF->{auth_type}) {
     when ('imap') {
       my $email = $cgi->param('email') or die "No email address provided";
@@ -50,8 +63,8 @@ while (my $cgi = new CGI::Fast) {
       for my $user (email_users($email)) {
         #say STDERR "Trying user: $user";
         if (check_imap_password($user, $password)) {
-          $session->param('user', $user);
           print $cgi->header(-content_type => 'application/json; charset=UTF-8');
+          print $cgi->header(-cookie=>cookie_for_user($user));
           say encode_json({user => $user});
           exit 0;
         }
@@ -69,8 +82,7 @@ while (my $cgi = new CGI::Fast) {
       my $fakedomain = $::MULKONF->{fake_domain};
       my $realdomain = $::MULKONF->{real_domain};
       $verified_email =~ s/\@$realdomain/\@$fakedomain/ if $fakedomain;
-      $session->param('user', $verified_email);
-      print $cgi->redirect(-url => reluri($cgi, 'successful-login.html'));
+      print $cgi->redirect(-cookie => cookie_for_user($verified_email), -url => reluri($cgi, 'successful-login.html'));
       exit 0;
     }
     default {
diff --git a/www/sign.pl b/www/sign.pl
index 9da1216..0a8332f 100755
--- a/www/sign.pl
+++ b/www/sign.pl
@@ -14,32 +14,12 @@ use File::Slurp;
 
 use CGI;
 use CGI::Fast;
-use CGI::Session;
-
-use MIME::Base64 qw(encode_base64 decode_base64);
 
 use Time::HiRes qw(time);
 
 do "common.pl";
 
 
-sub decode_base64_url($) {
-  # From: https://github.com/ptarjan/base64url/blob/master/perl.pl
-  (my $s = shift) =~ tr{-_}{+/};
-  $s .= '=' x (4 - length($s));
-  return decode_base64($s);
-}
-
-sub encode_base64_url($) {
-  my ($s) = shift;
-  $s = encode_base64($s);
-  $s =~ tr{+/}{-_};
-  $s =~ s/=*$//;
-  $s =~ s/\n//g;
-  return $s;
-}
-
-
 sub sign($$$$$) {
   # NB.  Treating the jwcrypto code as the spec here.
   my ($key, $client_pubkey, $email, $duration, $domain) = @_;
@@ -70,18 +50,21 @@ while (my $cgi = new CGI::Fast) {
   $::MULKONF = {};   # to silence a warning
   load_config();
 
-  my $cookie = $cgi->cookie('mulkid_session') or die "No session cookie";
-  my $session = new CGI::Session("driver:File", $cookie, {Directory=>"/tmp"}) or die "Invalid session cookie";
-  print $cgi->header(-content_type => 'application/json; charset=UTF-8');
-
   my $key = Crypt::OpenSSL::RSA->new_private_key(scalar read_file($::MULKONF->{pemfile}));
   $key->use_pkcs1_padding();
   $key->use_sha256_hash();
 
+  my $cookie = $cgi->cookie('mulkyid_session') or die "No session cookie";
+  my $reverse_encrypted_user_session = decode_base64_url($cookie);
+  my $plain_user_session = $key->public_decrypt($reverse_encrypted_user_session);
+  my ($session_user, $timestamp) = split /#/, $plain_user_session;
+  die "User cookie too old" if $timestamp < time - 24*3600;
+
+  print $cgi->header(-content_type => 'application/json; charset=UTF-8');
+
   my $user_pubkey  = $cgi->param('pubkey')   or die "Nothing to sign";
   my $duration     = $cgi->param('duration') || 24*3600;
   my $email        = $cgi->param('email')    or die "No email address supplied";
-  my $session_user = $session->param('user');
 
   die "User $session_user is not authorized to use this email address ($email)"
     unless any(email_users($email)) eq $session_user;