From: Peter Palfrader <peter@palfrader.org>
Date: Sat, 3 Jan 2015 12:30:36 +0000 (+0100)
Subject: Various fixes for XSS and bad crypto.  No claim to completeness.
X-Git-Tag: release-0.3.40~25
X-Git-Url: https://git.adam-barratt.org.uk/?p=mirror%2Fuserdir-ldap-cgi.git;a=commitdiff_plain;h=b33011c65aeb65e4b06b127077d6a225f764d042

Various fixes for XSS and bad crypto.  No claim to completeness.

* Fix a XSS reported in
  https://trac.torproject.org/projects/tor/ticket/14037
* Fix horrible use of crypto primitives.
* Add HMAC authentication to authtoken.
* Verify that the uid passed as a get parameters matches the
  one stored in authtoken.
---

diff --git a/Util.pm b/Util.pm
index 3a98416..92974b3 100644
--- a/Util.pm
+++ b/Util.pm
@@ -9,6 +9,8 @@ use strict;
 use Date::Manip qw(ParseDate);
 use Net::LDAP qw(LDAP_SUCCESS LDAP_PROTOCOL_ERROR);
 use English;
+use Crypt::CBC;
+use Digest::HMAC_SHA1 qw(hmac_sha1_hex);
 
 my $blocksize = 8; # A blowfish block is 8 bytes
 my $configfile = "/etc/userdir-ldap/userdir-ldap.conf";
@@ -16,19 +18,13 @@ my $configfile = "/etc/userdir-ldap/userdir-ldap.conf";
 
 my %config = &ReadConfigFile;
 
-my $hascryptix = 1;
-eval 'use Crypt::Blowfish';
-if ($@) {
-  $hascryptix = undef;
-}
-
 sub CreateKey {
   my $keysize = shift;
   my $input;
-  open (F, "</dev/urandom") || die &HTMLError("No /dev/urandom found!");
+  open (F, "<", "/dev/urandom") || die &HTMLError("No /dev/urandom found!");
   read(F, $input, $keysize); # key length is 8 bytes
   close F;
-  
+
   return $input;
 }
 
@@ -55,123 +51,184 @@ sub CreateCryptSalt {
   return $out
 }
 
-sub Encrypt { 
-  # blowfish only encrypts things in blocks of 8 bytes, so we
-  # need a custom routine that handles longer strings....
-  my $cipher = shift;
-  my $input = shift;
-  my ($pos, $output);
+sub Encrypt {
+  my $hexkey = shift;
+  my $plaintext = shift;
 
-  # prepend a length byte */
-  $input = chr(length($input)).$input;
-  $input .= "\001" x ($blocksize - (length($input) % $blocksize)) if (length($input % $blocksize));
+  my $cipher = Crypt::CBC->new( -key    => $hexkey, -cipher => 'Blowfish');
+  my $ciphertext_hex = $cipher->encrypt_hex($plaintext);
 
-  for ($pos = 0; $pos < length($input); $pos += $blocksize) {    
-    $output .= unpack("H16", $cipher->encrypt(substr($input, $pos, $blocksize))) if ($hascryptix);
-  }
-  return $output;
+  return $ciphertext_hex;
 }
 
 sub Decrypt {
-  # like encrypt, needs to deal with big blocks. Note that we assume
-  # trailing spaces are unimportant.
-  my $cipher = shift;
-  my $input = shift;
-  my ($pos, $portion, $output, $len);
-  
-  ((length($input) % $blocksize) == 0) || &HTMLError("Password corrupted"); # should always be true...
+  my $hexkey = shift;
+  my $ciphertext_hex = shift;
 
-  for ($pos = 0; $pos < length($input); $pos += $blocksize*2) {
-    $portion = pack("H16", substr($input, $pos, $blocksize*2));
-    $output .= $cipher->decrypt($portion) if ($hascryptix);
-  }
-  
-  # check length byte, discard junk
-  $len = substr($output, 0, 1);
-  $output = substr($output, 1, ord($len));
-  return $output;
+  my $cipher = Crypt::CBC->new( -key    => $hexkey, -cipher => 'Blowfish');
+  my $plaintext = $cipher->decrypt_hex($ciphertext_hex);
+
+  return $plaintext;
 }
 
 sub SavePasswordToFile {
   my $userid = shift;
   my $password = shift;
-  my $cipher = shift;
 
-  my $cryptuser = crypt($userid, &CreateCryptSalt);
-  my $secret = Encrypt($cipher, $password);
-  $cryptuser =~ y/\//_/; # translate slashes to underscores...
-  
-  my $fn = "$config{authtokenpath}/$cryptuser";
-  open (F, ">$fn") || &HTMLError("$fn: $!");
-  print F "$secret\n";
-  print F time."\n";
-  close F;
-  chmod 0600, $fn;
-  return $cryptuser;
+  my $authtoken = CreateAuthToken($userid);
+  UpdateAuthToken($authtoken, $password);
+  return $authtoken;
 }
 
 sub ReadPasswordFromFile {
-  my $userid = shift;
-  my $cipher = shift;
+  my $authtoken = shift;
+
+  my (undef, $hexkey) = ParseAuthToken($authtoken);
+  my $fn = GetFNfromAuthToken($authtoken);
+
   my $passwd;
   my $time;
-  
-  $userid =~ y/\//_/; # translate slashes to underscores...
 
   # if we couldn't read the password file, assume user is unauthenticated. is this ok?
-  open (F, "<$config{authtokenpath}/$userid") || return undef; 
+  open (F, "<", $fn) || return undef;
   chomp($passwd = <F>);
   chomp($time = <F>);
   close F; 
 
   # check to make sure we read something
   return undef if (!$passwd || !$time);
-  
+
   # check to make sure the time is positive, and that the auth token
   # has not expired
   my $tdiff = (time - $time);
   &HTMLError("Your authentication token has expired. Please <a href=\"https://$ENV{SERVER_NAME}/$config{webloginhtml}\">relogin</a>") if (($tdiff < 0) || ($tdiff > $config{authexpires}));
-  
-  return Decrypt($cipher, $passwd);
+
+  return Decrypt($hexkey, $passwd);
 }
 
-sub CheckAuthToken {
-  my ($id, $hrkey) = split(/,/, shift, 2);
-  return undef if (!$id || !$hrkey);
-  my $key = pack("H".(length($hrkey)), $hrkey);
-  my $cipher = new Crypt::Blowfish $key;
-  my $r = ReadPasswordFromFile($id, $cipher);
+# given an authtoken and an unencoded username, check that the username matches the
+# encoded and maced username in the authtoken
+sub VerifyCryptedUserMatches {
+  my $authtoken = shift;
+  my $userid = shift;
+
+  my ($crypteduserid, undef) = ParseAuthToken($authtoken);
+
+  $crypteduserid =~ y,_,/,; # reversee translation from slashes to underscores
+  my $res = crypt($userid, $crypteduserid);
+
+  HTMLError("Failed to validate user authtoken\n") unless ($res eq $crypteduserid);
+}
+
+# given an authtoken and username, update lifetime of the authtoken, if it validates.
+sub TouchAuthToken {
+  my $authtoken = shift;
+  my $userid = shift;
+
+  VerifyCryptedUserMatches($authtoken, $userid);
+
+  my $r = ReadPasswordFromFile($authtoken);
   if ($r) {
-    UpdateAuthToken("$id,$hrkey", $r);
-  } else {    
-    ClearAuthToken("$id,$hrkey")
+    UpdateAuthToken($authtoken, $r);
+  } else {
+    ClearAuthToken($authtoken);
   }
   return $r;
 }
 
+# clear an authtoken's file from disk, if it validates.
 sub ClearAuthToken {
-  my ($id, $hrkey) = split(/,/, shift, 2);
-  $id =~ y/\//_/; # switch / to _
-  unlink "$config{authtokenpath}/$id" || &HTMLError("Error removing authtoken: $!");
+  my $authtoken = shift;
+
+  my $fn = GetFNfromAuthToken($authtoken);
+
+  unlink $fn || &HTMLError("Error removing authtoken: $!");
+}
+
+# Load the base key for our keyed hash function from disk and
+# compute a derived key for use in our HMAC function.
+sub getAuthTokenHMACkey {
+  open (F, "<$config{passdir}/key-hmac-$UID") || &Util::HTMLError($!);
+  my $base_hmac_key = <F>;
+  close(F);
+  chomp($base_hmac_key);
+
+  my $derived_key_hmac = hmac_sha1_hex("authtoken hmac key", $base_hmac_key);
+  return $derived_key_hmac;
+}
+
+# return a Mac (Message Authentication Code) for data.
+sub getDataMac {
+  my $data = shift;
+
+  my $hmac_key = getAuthTokenHMACkey();
+  my $hmac = hmac_sha1_hex($data, $hmac_key);
+
+  return $hmac;
+}
+
+# Given a userid, create an authtoken.
+#
+# The authtoken consists of the encoded username and a key to decrypt the
+# password stored on disk.  the authtoken is protected from modification
+# by an hmac.
+sub CreateAuthToken {
+  my $userid = shift;
+
+  my $cryptuser = crypt($userid, CreateCryptSalt(1));
+  $cryptuser =~ y,/,_,; # translate slashes to underscores
+
+  my $key = &Util::CreateKey($config{blowfishkeylen});
+  my $hexkey = unpack("H".($config{blowfishkeylen}*2), $key);
+
+  my $data = "$cryptuser,$hexkey";
+  my $hmac = getDataMac($data);
+  my $authtoken = "$hmac,$data";
+
+  return $authtoken;
+}
+
+# Parse an authtoken into encoded userid and key information and validate its mac.
+sub ParseAuthToken {
+  my $authtoken = shift;
+  my ($hmac_got, $data) = split(/,/, $authtoken, 2);
+  my $hmac_want = getDataMac($data);
+
+  HTMLError("Failed to validate authtoken\n") unless ($hmac_got eq $hmac_want);
+
+  my ($cryptuserid, $hexkey) = split(/,/, $data, 2);
+  return ($cryptuserid, $hexkey);
 }
 
+# Given an authtoken, return the path to the on-disk encrypted session file
+sub GetFNfromAuthToken {
+  my $authtoken = shift;
+  my ($cryptuserid, undef) = ParseAuthToken($authtoken);
+
+  my $fn = "$config{authtokenpath}/$cryptuserid";
+  return $fn;
+}
+
+# Given an authtoken and a password, write the password to disk encrypted by the authtoken's key.
 sub UpdateAuthToken {
-  my ($id, $hrkey) = split(/,/, shift, 2);
+  my $authtoken = shift;
   my $password = shift;
-  my $key = pack("H".(length($hrkey)), $hrkey);
-  $id =~ y/\//_/; # switch / to _
-  my $cipher = new Crypt::Blowfish $key;
-  my $secret = Encrypt($cipher, $password);
-  
-  my $fn = "$config{authtokenpath}/$id";
-  open (F, ">$fn") || &HTMLError("$fn: $!");
+  my (undef, $hexkey) = ParseAuthToken($authtoken);
+
+  my $secret = Encrypt($hexkey, $password);
+  my $fn = GetFNfromAuthToken($authtoken);
+
+  my $saveumask = umask 077;
+  open (F, ">", $fn) || &HTMLError("$fn: $!");
   print F "$secret\n";
   print F time."\n";
   close F;
-  chmod 0600, "$fn" || &HTMLError("$fn: $!");
+  umask $saveumask;
+
   return 1;
 }
 
+
 sub FormatFingerPrint {
   my $in = shift;
   my $out;
diff --git a/debian/changelog b/debian/changelog
index 6b2f8fc..fa915a1 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,14 +1,20 @@
-userdir-ldap-cgi (0.3.39) UNRELEASED; urgency=medium
+userdir-ldap-cgi (0.3.39) unstable; urgency=medium
 
   [ Peter Palfrader ]
   * Fix changelog entries.  The previos "UNRELEASED" version
     was actually released.
   * Use new CA root cert in Util.pm.
+  * Fix a XSS reported in
+    https://trac.torproject.org/projects/tor/ticket/14037
+  * Fix horrible use of crypto primitives.
+  * Add HMAC authentication to authtoken.
+  * Verify that the uid passed as a get parameters matches the
+    one stored in authtoken.
 
   [ Hector Oron ]
   * machines.cgi: add description field, more informative.
 
- -- Peter Palfrader <weasel@debian.org>  Sun, 21 Dec 2014 10:13:44 +0100
+ -- Peter Palfrader <weasel@debian.org>  Sat, 03 Jan 2015 13:30:18 +0100
 
 userdir-ldap-cgi (0.3.38~20130906+1+nmu1) UNRELEASED; urgency=low
 
diff --git a/login.cgi b/login.cgi
index d820af2..aa9df4a 100755
--- a/login.cgi
+++ b/login.cgi
@@ -10,7 +10,6 @@ use strict;
 use CGI;
 use Util;
 use URI::Escape;
-use Crypt::Blowfish;
 use Net::LDAP qw(LDAP_SUCCESS LDAP_PROTOCOL_ERROR);
 
 my %config = &Util::ReadConfigFile;
@@ -23,10 +22,6 @@ if ($proto eq "http" || !($query->param('username')) || !($query->param('passwor
   exit;
 }
 
-my $key = &Util::CreateKey($config{blowfishkeylen}); # human-readable version of the key
-my $hrkey = unpack("H".($config{blowfishkeylen}*2), $key);
-my $cipher = new Crypt::Blowfish $key;
-
 my $ldap = Net::LDAP->new($config{ldaphost}) || &Util::HTMLError($!);
 &Util::UpgradeConnection($ldap) unless $config{usessl} eq 'False';
 
@@ -57,14 +52,13 @@ if ($mesg->code == LDAP_SUCCESS) {
   }
   ## END HACK HACK HACK
   
-  my $cryptid = &Util::SavePasswordToFile($username, $password, $cipher);
+  my $authtoken = &Util::SavePasswordToFile($username, $password);
 
   if ($query->param('update')) {
-    my $url = "$proto://$ENV{SERVER_NAME}/$config{webupdateurl}?id=$username&authtoken=$cryptid,$hrkey&editdn=";
-    $url .= uri_escape("uid=$username,$config{basedn}", "\x00-\x40\x7f-\xff");
+    my $url = "$proto://$ENV{SERVER_NAME}/$config{webupdateurl}?id=$username;authtoken=$authtoken";
     print "Location: $url\n\n";
   } else {
-    my $url = "$proto://$ENV{SERVER_NAME}/$config{websearchurl}?id=$username&authtoken=$cryptid,$hrkey";
+    my $url = "$proto://$ENV{SERVER_NAME}/$config{websearchurl}?id=$username;authtoken=$authtoken";
     print "Location: $url\n\n";
   }
 
diff --git a/logout.cgi b/logout.cgi
index 585fd69..b181aac 100755
--- a/logout.cgi
+++ b/logout.cgi
@@ -14,11 +14,8 @@ my %config = &Util::ReadConfigFile;
 my $proto = ($ENV{HTTPS} ? "https" : "http");
 
 my $query = new CGI;
-my $id = $query->param('id');
 my $authtoken = $query->param('authtoken');
-&Util::ClearAuthToken($authtoken);
-my $doneurl = $query->param('done') || "$config{websearchurl}";
-
 &Util::ClearAuthToken($authtoken);
 
+my $doneurl = $config{websearchurl};
 print "Location: $proto://$ENV{SERVER_NAME}/$doneurl\n\n";
diff --git a/search.cgi b/search.cgi
index 3769538..59b6471 100755
--- a/search.cgi
+++ b/search.cgi
@@ -17,12 +17,21 @@ use Net::LDAP qw(LDAP_SUCCESS LDAP_PROTOCOL_ERROR);
 my %config = &Util::ReadConfigFile;
 
 my $query = new CGI;
-my $id = uri_escape($query->param('id'));
+my $id = $query->param('id');
 my $authtoken = $query->param('authtoken');
-my $password = &Util::CheckAuthToken($authtoken);
 my $dosearch = uri_escape($query->param('dosearch'));
 my $searchdn = uri_escape($query->param('searchdn'));
+
 my $ldap = undef;
+my $password = undef;
+
+if ($authtoken || $id) {
+  $password = Util::TouchAuthToken($authtoken, $id);
+} else {
+  $password = '';
+  $id = '';
+  $authtoken = '';
+}
 
 my $proto = ($ENV{HTTPS} ? "https" : "http");
 
@@ -236,7 +245,7 @@ if (!$dosearch) {
     
     # If this is ourselves, present a link to do mods
     if ($auth && ($id eq $data->{uid}->[0])) { #TODO: extract this string into a url for translation...
-      $outsub{searchresults} .= "<a href=\"$proto://$ENV{SERVER_NAME}/$config{webupdateurl}?id=$id&authtoken=$authtoken&editdn=".uri_escape($dn, "\x00-\x40\x7f-\xff")."\">Edit my settings</a>\n";
+      $outsub{searchresults} .= "<a href=\"$proto://$ENV{SERVER_NAME}/$config{webupdateurl}?id=$id;authtoken=$authtoken\">Edit my settings</a>\n";
     }
     
     $outsub{searchresults} .= "<br><br><br>\n";
diff --git a/update.cgi b/update.cgi
index ddb8052..d109bf7 100755
--- a/update.cgi
+++ b/update.cgi
@@ -25,8 +25,16 @@ my $proto = ($ENV{HTTPS} ? "https" : "http");
 
 my $id = $query->param('id');
 my $authtoken = $query->param('authtoken');
-my $password = &Util::CheckAuthToken($authtoken);
-my $editdn = $query->param('editdn');
+
+my $password = undef;
+
+if ($authtoken || $id) {
+  $password = Util::TouchAuthToken($authtoken, $id);
+} else {
+  $password = '';
+  $id = '';
+  $authtoken = '';
+}
 
 if ($proto eq "http" || !($id && $password)) {
   print "Location: https://$ENV{SERVER_NAME}/$config{webloginhtml}\n\n";
@@ -45,6 +53,7 @@ sub DieHandler {
 }
 
 #$SIG{__DIE__} = \&DieHandler;
+my $editdn = "uid=$id,$config{basedn}";
 
 $ldap = Net::LDAP->new($config{ldaphost});
 &Util::UpgradeConnection($ldap) unless $config{usessl} eq 'False';
@@ -399,8 +408,7 @@ if (!($query->param('doupdate'))) {
   &Util::LDAPUpdate($ldap, $editdn, 'sudoPassword', \@keepsudo);
 
   # when we are done, reload the page with the updated details.
-  my $url = "https://$ENV{SERVER_NAME}/$config{webupdateurl}?id=$id&authtoken=$authtoken&editdn=";
-  $url .= uri_escape($editdn, "\x00-\x40\x7f-\xff");
+  my $url = "https://$ENV{SERVER_NAME}/$config{webupdateurl}?id=$id;authtoken=$authtoken";
   print "Location: $url\n\n";  
 }