[interchange] Add bcrypt encryption option to Vend::UserDB

Mark Johnson interchange-cvs at icdevgroup.org
Thu Jun 19 15:05:21 UTC 2014


commit 3cd3b3700db21610d617a9d8d5db9a0c4b73045e
Author: Mark Johnson <mark at endpoint.com>
Date:   Thu Jun 19 11:04:30 2014 -0400

    Add bcrypt encryption option to Vend::UserDB
    
    * Full bcrypt support
      + Requires modules Digest::Bcrypt and Crypt::Random.
      + Enabled with "bcrypt" key in catalog UserDB setting.
        - Ex: UserDB  default  bcrypt  1
      + Pads out passwords to 72-character limit of bcrypt to
        increase difficulty of brute-forcing weak passwords.
        - Optional "pepper" (highly recommended) to make padding
          pattern unique per catalog.
      + Defaults to cost of 13.
    
    * Storage follows general guidelines of modular crypt format
      (MCF), both weaning it from the length-based cipher
      identification, but also allowing it to identify a "pre digest"
      against the password (discussed below).
      + Example storage structure:
        $2y$14$F4PQQ6QTuRFo0FBAYP1rhQIqJSTg7iHSS619fmiAOhvk5b5Ui8o6o
    
    * Uses a "more complex than usual" approach to manage the
      identifier than the standard MCF. This complexity is used to
      specify which algorithm "pre digested" the raw password. They
      are as follows:
    
      + $2y$ - standard, default identifier. Means bcrypt processed
        the raw password directly.
    
      + $2s$ - s => SHA1. Indicates bcrypt process first runs the raw
        password through the SHA1 algorithm before encrypting. If you
        update passwords originally stored as SHA1 as a background
        process, the resulting bcrypt structures should all have this
        identifier.
        - Example storage structure:
          $2s$14$F4PQQ6QTuRFo0FBAYP1rhQIqJSTg7iHSS619fmiAOhvk5b5Ui8o6o
    
      + $2m$ - m => MD5. Same as $2s$ but for passwords that are
        originally stored MD5.
        - Example storage structure:
          $2m$14$iJ7kMcGiNXRvBTRBIHVrmw1Rfq224SXd0QzSsKOupop4nZTVhEotA
    
      + $2n$..$ - n => md5_salted encryption algorithm. '..' are the 2
        salt characters in the original stored password, made available
        so that the "pre digest" step can accurately reproduce the
        salted MD5 structure before bcrypting and comparing.
        - Example storage structure:
          $2n$jQ$14$MZjidwOjuROki9TXdJofsgp2ne2Vrm6JJtLcF+0f51mE1ncee0XZk
    
      + $2c$..$ - c => crypt(). Same as md5_salted, but with crypt()
        instead.
        - Example storage structure:
          $2c$m4$14$QeCj3irfIJOWoWKHUtNpUQVxwXl8Sl4zRo79d7BRPQpDTSlaCTJv0
    
      The "pre digested" feature allows a site developer to create
      a background process for updating an existing user table with
      bcrypted passwords even if the table is already encrypted by
      one of the previously supported ciphers. Thus, in a matter of
      minutes to weeks (depending on the size of your user table and
      chosen bcrypt cost) your passwords can be fully upgraded to
      bcrypt without having to wait on the organic process "promote"
      allows, or having to know any of your users' original
      passwords.
    
    * New routine construct_bcrypt() in Vend::UserDB. Takes a
      single hash ref argument with keys "password", "type"
      (optional), and "profile" (optional). Returns a
      properly-formatted bcrypt structure suitable for being stored
      in the password field of the user table of interest.
    
      Anticipated usage scenario would be for a developer with an
      already encrypted user table (sha1, md5, md5_salted, or crypt)
      to create an Interchange job that slurps in all the encrypted
      passwords, passes them along with the type of encryption that
      created them (described below), and gets in return the
      appropriate bcrypt structure reflecting that original
      encryption type to write back to the user table's password
      field.
    
      + If "type" is left off, assumes code is encrypting against
        the raw password. Returns structure with identifier $2y$.
        Otherwise, "type" is any of the supported Interchange
        encryption options:
    
        - sha1 (identifier returned is $2s$)
        - md5 (identifier returned is $2m$)
        - md5_salted (identifier returned is $2n$..$)
        - crypt (identifier returned is $2c$..$)
    
      + If "profile" is left off, uses "default" profile, which
        is typically the definition for the userdb table. Common
        other profile is "ui", which defines the access table for
        the admin.
    
      Whatever profile is being used, it must have been set to use
      bcrypt before executing code that calls construct_bcrypt().
      If it's set to anything other than bcrypt, the routine dies
      with an error.
    
      + Example usage: if my "ui" profile is configured with
        "crypt" (as it is by default), I have crypt() passwords in
        the access table:
    
        UserDB  ui  crypt 1
    
        I first change and promote to bcrypt by replacing the above
        with:
    
        UserDB  ui  promote 1
        UserDB  ui  bcrypt  1
        UserDB  ui  bcrypt_pepper {some reasonably long random string}
    
        Then, rather than wait for every user to eventually log
        in, I run all my crypt passwords through construct_bcrypt().
        If I have, for example, a password of cWNLm21WqgOKU:
    
        my $bcrypt_password = Vend::UserDB::construct_bcrypt(
            {
                password => 'cWNLm21WqgOKU',
                type => 'crypt',
                profile => 'ui',
            }
        )
    
        and $bcrypt_password now holds something like:
        $2c$cW$14$QeCj3irfIJOWoWKHUtNpUQVxwXl8Sl4zRo79d7BRPQpDTSlaCTJv0
    
        which can directly overwrite cWNLm21WqgOKU in the password
        field.
    
    * "promote" flag has been expanded to recognize intra-bcrypt
      config changes between the cost of a stored password and the
      current cost being used for encryption. E.g., if the current
      cost setting for bcrypt is 14, but the storage structure
      indicates $2y$13$..., promote catches that and updates the
      password in the database to the calculated structure for cost
      14.

 lib/Vend/UserDB.pm |  212 ++++++++++++++++++++++++++++++++++++++++++++++++++--
 1 files changed, 204 insertions(+), 8 deletions(-)
---
diff --git a/lib/Vend/UserDB.pm b/lib/Vend/UserDB.pm
index 2d7c154..4068408 100644
--- a/lib/Vend/UserDB.pm
+++ b/lib/Vend/UserDB.pm
@@ -24,6 +24,7 @@ use vars qw!
 	@S_FIELDS @B_FIELDS @P_FIELDS @I_FIELDS
 	%S_to_B %B_to_S
 	$USERNAME_GOOD_CHARS
+	$Has_Bcrypt
 !;
 
 use Vend::Data;
@@ -32,6 +33,27 @@ use Vend::Safe;
 use strict;
 no warnings qw(uninitialized numeric);
 
+{
+    local $@;
+    eval {
+        require Digest::Bcrypt;
+        require Crypt::Random;
+    };
+    unless ($@) {
+        $Has_Bcrypt = 1;
+    }
+}
+
+use constant BCOST => 13;
+
+# Map between bcrypt identifier letter and "pre-digested" encryption type
+my %cipher_map = qw/
+    s   sha1
+    m   md5
+    n   md5_salted
+    c   default
+/;
+
 my $ready = new Vend::Safe;
 
 # The object encryption methods take three arguments: object, password, and
@@ -44,6 +66,7 @@ my %enc_subs = (
     md5 => \&enc_md5,
     md5_salted => \&enc_md5_salted,
     sha1 => \&enc_sha1,
+    bcrypt => \&enc_bcrypt,
 );
 
 sub enc_default {
@@ -95,16 +118,185 @@ sub enc_sha1 {
     return Vend::Util::sha1_hex(shift);
 }
 
+sub enc_bcrypt {
+    my $obj = shift;
+    unless ($Has_Bcrypt) {
+        $obj->log_either('Bcrypt passwords unavailable. Are Digest::Bcrypt and Crypt::Random installed?');
+        return;
+    }
+    my ($password, $salt) = @_;
+    my $store = bmarshal($salt);
+    my $opt = $obj->{OPTIONS} || {};
+
+    my $bcrypt = Digest::Bcrypt->new;
+
+    my $salt =
+        $store->{salt}
+        ||
+        Crypt::Random::makerandom_octet(
+            Length   => 16, # bcrypt requirement
+            Strength =>  0, # /dev/urandom instead of /dev/random
+        )
+    ;
+    my $cost = bcost($opt, $store);
+
+    $bcrypt->cost($cost);
+    $bcrypt->salt($salt);
+    $bcrypt->add($obj->brpad($password, $opt, $store->{cipher}));
+
+    return bserialize($bcrypt, $store->{cipher});
+}
+
+sub bcost {
+    my $opt = shift;
+    my $store = shift || {};
+    return $store->{cost} || $opt->{cost} || BCOST;
+}
+
+sub brpad {
+    my $obj = shift;
+    my ($data, $opt, $cipher) = @_;
+
+    # If passwords are already stored SHA1, MD5, or crypt(),
+    # and there is no desire to allow promote to organically
+    # update them, the existing encrypted passwords can be
+    # bcrypted wholesale and future submission by users will
+    # "pre-digest" to the original encrypted structure
+    # for comparison against the bcrypt hashes.
+    #
+    # This is indicated by the structure of the cipher:
+    # * $2c$XX$ - original crypt() password with XX salt
+    # * $2m$ - plain MD5 digest on password
+    # * $2n$XX$ - salted MD5 digest on password
+    # * $2s$ - plain SHA1 digest on password
+
+    $data = $obj->pre_digest($data, $cipher);
+
+    # Increase difficulty to brute force passwords by right padding out
+    # to at least 72 character length. Most effective with "pepper" set
+    # in catalog config.
+
+    while (length ($data) < 72) {
+        my $md5 = Digest::MD5->new;
+        $md5->add($opt->{bcrypt_pepper})
+            if $opt->{bcrypt_pepper};
+        $data .= $md5->add($data)->b64digest;
+    }
+    return $data;
+}
+
+sub bserialize {
+    my $bcrypt = shift;
+    my $cipher = shift || '$2y$';
+
+    my $encoded_salt = substr (MIME::Base64::encode_base64($bcrypt->salt,''),0,-2);
+
+    return $cipher .
+        join (
+            '$',
+            sprintf ('%02d', $bcrypt->cost),
+            $encoded_salt . $bcrypt->b64digest,
+        )
+    ;
+}
+
+sub bmarshal {
+    local $_ = shift;
+
+    my $cipher = '';
+    s/^(\$2(?:[yms]|[nc]\$..)\$)//
+        and $cipher = $1;
+
+    return {} unless $cipher;
+
+    my ($cost, $combined) = grep { /\S/ } split /\$/;
+    my ($encoded_salt, $hash) = $combined =~ /^(.{22})(.*)$/;
+
+    return {} if
+        $cost < 1
+        ||
+        $cost > 31
+        ||
+        $encoded_salt =~ m{[^a-z0-9+/]}i
+        ||
+        ($hash || '-') =~ m{[^a-z0-9+/]}i
+    ;
+
+    return {
+        cipher => $cipher,
+        salt => MIME::Base64::decode_base64("$encoded_salt=="),
+        cost => $cost,
+        hash => $hash,
+    };
+}
+
+sub pre_digest {
+    my $obj = shift;
+    my $data = shift;
+    my $cipher = shift || '';
+    my ($id, $salt) = grep { /\S/ } split /\$/, $cipher;
+
+    # Starts with "2" or not bcrypt
+    $id =~ s/^2//
+        or return $data;
+
+    # Must have routine key defined in %cipher_map
+    my $key = $cipher_map{$id}
+        or return $data;
+
+    return $enc_subs{$key}->($obj, $data, $salt);
+}
+
+sub construct_bcrypt {
+    my $opt = shift;
+
+    my $bstruct =
+        __PACKAGE__
+            -> new(profile => $opt->{profile})
+            -> do_crypt($opt->{password})
+    ;
+
+    die sprintf (
+        q{Encryption type for profile '%s' must be bcrypt},
+        $opt->{profile} || 'default'
+    )
+        unless substr ($bstruct, 0, 4) eq '$2y$';
+
+    return $bstruct unless my $type = $opt->{type};
+
+    my %type_map = (crypt => 'c', reverse %cipher_map);
+    my $cipher = $type_map{ $type }
+        or die "$type is an unrecognized crypt type";
+
+    my $salt =
+        $cipher eq 'n' ? substr ($opt->{password}, -2) :
+        $cipher eq 'c' ? substr ($opt->{password}, 0, 2)
+                       : ''
+    ;
+    $salt &&= '$' . $salt;
+
+    $bstruct =~ s/y/$cipher$salt/;
+
+    return $bstruct;
+}
+
 # Maps the length of the encrypted data to the algorithm that
-# produces it. This method will have to be re-evaluated if competing
-# algorithms are introduced which produce the same-length value.
+# produces it, or the identifier of the format from modular
+# crypt format (MCF) in the case of bcrypt.
 my %enc_id = qw/
-    13  default
-    32  md5
-    35  md5_salted
-    40  sha1
+    13      default
+    32      md5
+    35      md5_salted
+    40      sha1
+    $2      bcrypt
 /;
 
+sub determine_cipher {
+    my $hash = shift;
+    my ($cipher) = $hash =~ /^(\$\d+)/;
+    return $cipher || length ($hash);
+}
+
 =head1 NAME
 
 UserDB.pm -- Interchange User Database Functions
@@ -1550,15 +1742,19 @@ sub login {
 				my ($cur_method) = grep { $self->{OPTIONS}{ $_ } } keys %enc_subs;
 				$cur_method ||= 'default';
 
-				my $stored_by = $enc_id{ length($db_pass) };
+				my $stored_by = $enc_id{ determine_cipher($db_pass) };
 
 				if (
 					$cur_method ne $stored_by
+					||
+					$cur_method eq 'bcrypt'
 					&&
+					bcost($self->{OPTIONS}) != bcost($self->{OPTIONS}, bmarshal($db_pass))
+					and
 					$db_pass eq $enc_subs{$stored_by}->($self, $pw, $db_pass)
 				) {
 
-					my $newpass = $enc_subs{$cur_method}->($self, $pw, $db_pass);
+					my $newpass = $enc_subs{$cur_method}->($self, $pw, Vend::Util::random_string(2));
 					my $db_newpass = eval {
 						$self->{DB}->set_field(
 							$self->{USERNAME},



More information about the interchange-cvs mailing list