[interchange-cvs] interchange - markj modified lib/Vend/UserDB.pm

interchange-cvs at icdevgroup.org interchange-cvs at icdevgroup.org
Wed Mar 18 00:39:21 UTC 2009


User:      markj
Date:      2009-03-18 00:39:21 GMT
Modified:  lib/Vend UserDB.pm
Log:
* Add support for SHA1 encrypted userdb passwords.

* Add new "promote" feature. When active, and passwords
  of any of the other algorithms are present, on next
  login the user's password will be promoted to the
  target hashing algorithm. This way, password strength
  can be increased organically.

Use of SHA1 passwords can be specified in the same manner
as currently MD5 can be:

UserDB  ui  sha1  1

To utilize the promotion feature, you add a similar line
for the UserDB definition:

UserDB  ui  promote 1

Promote implies that strength is increased, but in reality
promotion will move in any direction desired. The requested
hashing algorithm is the target, and whatever the form of the
passwords in the database, they will be converted to the target.

E.g., if neither sha1 nor md5 is specified, and the database
currently has md5 passwords, if promote is added, it will have
the effect of promoting to crypt(), the target hashing algorithm
(which happens to be the default).

If promote is not used, the change is fully backward compatible.
Whatever method is specified will be used, and if the database
has passwords of a different algorithm, authentication will fail.

You should not specify more than 1 hashing type. If you specify
both md5 and sha1, you'll be subject to the whims of hash
ordering from keys().

Also note that, before promoting to a stronger hash, you should
ensure your database's password field is long enough to hold the
new, longer datum.

Original work from Steven Jenkins <steven at endpoint.com> for
framework of promotion code.

Revision  Changes    Path
2.65                 interchange/lib/Vend/UserDB.pm


rev 2.65, prev_rev 2.64
Index: UserDB.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/UserDB.pm,v
retrieving revision 2.64
retrieving revision 2.65
diff -u -r2.64 -r2.65
--- UserDB.pm	2 Mar 2009 17:33:36 -0000	2.64
+++ UserDB.pm	18 Mar 2009 00:39:21 -0000	2.65
@@ -1,6 +1,6 @@
 # Vend::UserDB - Interchange user database functions
 #
-# $Id: UserDB.pm,v 2.64 2009-03-02 17:33:36 mheins Exp $
+# $Id: UserDB.pm,v 2.65 2009-03-18 00:39:21 markj Exp $
 #
 # Copyright (C) 2002-2008 Interchange Development Group
 # Copyright (C) 1996-2002 Red Hat, Inc.
@@ -17,7 +17,7 @@
 
 package Vend::UserDB;
 
-$VERSION = substr(q$Revision: 2.64 $, 10);
+$VERSION = substr(q$Revision: 2.65 $, 10);
 
 use vars qw!
 	$VERSION
@@ -29,11 +29,53 @@
 use Vend::Data;
 use Vend::Util;
 use Safe;
+use Digest::MD5;
 use strict;
 no warnings qw(uninitialized numeric);
 
 my $ready = new Safe;
 
+my $HAVE_SHA1;
+
+eval {
+    require Digest::SHA1;
+    import Digest::SHA1;
+    $HAVE_SHA1 = 1;
+};
+
+if ($@) {
+    ::logGlobal("SHA1 passwords disabled: $@");
+}
+
+my %enc_subs = (
+    default => sub {
+        my $obj = shift;
+        my ($pwd, $salt) = @_;
+        return crypt($pwd, $salt);
+    },
+    md5 => sub {
+        my $obj = shift;
+        return Digest::MD5::md5_hex(shift);
+    },
+    sha1 => sub {
+        my $obj = shift;
+        unless ($HAVE_SHA1) {
+            $obj->log_either('SHA1 passwords unavailable. Is Digest::SHA1 installed?');
+            return;
+        }
+        return Digest::SHA1::sha1_hex(shift);
+    },
+);
+
+# 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.
+my %enc_id = qw/
+    13  default
+    32  md5
+    40  sha1
+/;
+
 =head1 NAME
 
 UserDB.pm -- Interchange User Database Functions
@@ -90,10 +132,10 @@
 
     $obj->get_shipping();
     $obj->set_shipping();
- 
+
     $obj->get_billing();
     $obj->set_billing();
- 
+
     $obj->get_preferences();
     $obj->set_preferences();
 
@@ -1347,13 +1389,10 @@
 				}
 				my $test;
 				if($Global::Variable->{MV_NO_CRYPT}) {
-					 $test = $self->{PASSWORD}
-				}
-				elsif ($self->{OPTIONS}{md5}) {
-					 $test = generate_key($self->{PASSWORD});
+					$test = $self->{PASSWORD};
 				}
 				else {
-					 $test = crypt($self->{PASSWORD}, $adminpass);
+					$test = $self->do_crypt($self->{PASSWORD}, $adminpass);
 				}
 				if ($test eq $adminpass) {
 					$user_data = {};
@@ -1410,14 +1449,52 @@
 				die $stock_error, "\n";
 			}
 			$pw = $self->{PASSWORD};
-			if($self->{CRYPT}) {
-				if($self->{OPTIONS}{md5}) {
-					$self->{PASSWORD} = generate_key($pw);
-				}
-				else {
-					$self->{PASSWORD} = crypt($pw, $db_pass);
+
+			if ( $self->{CRYPT} && $self->{OPTIONS}{promote} ) {
+				my ($cur_method) = grep { $self->{OPTIONS}{ $_ } } keys %enc_subs;
+				$cur_method ||= 'default';
+
+				my $stored_by = $enc_id{ length($db_pass) };
+
+				if (
+					$cur_method ne $stored_by
+					&&
+					$db_pass eq $enc_subs{$stored_by}->($self, $pw, $db_pass)
+				) {
+
+					my $newpass = $enc_subs{$cur_method}->($self, $pw, $db_pass);
+					my $db_newpass = eval {
+						$self->{DB}->set_field(
+							$self->{USERNAME},
+							$self->{LOCATION}{PASSWORD},
+							$newpass,
+						);
+					};
+
+					if ($db_newpass ne $newpass) {
+						# Usually, an error in the update will cause $db_newpass to be set to a
+						# useful error string. The usefulness is dependent on DB store itself, though.
+						my $err_msg = qq{Could not update database "%s" field "%s" with promoted password due to error:\n}
+							. "%s\n"
+							. qq{Check that field "%s" is at least %s characters wide.\n};
+						$err_msg = ::errmsg(
+							$err_msg,
+							$self->{DB_ID},
+							$self->{LOCATION}{PASSWORD},
+							$DBI::errstr,
+							$self->{LOCATION}{PASSWORD},
+							length($newpass),
+						);
+						::logError($err_msg);
+						die $err_msg;
+					} 
+					$db_pass = $newpass;
 				}
 			}
+
+			if ($self->{CRYPT}) {
+				$self->{PASSWORD} = $self->do_crypt($pw, $db_pass);
+			}
 			unless ($self->{PASSWORD} eq $db_pass) {
 				$self->log_either(errmsg("Denied attempted login by user '%s' with incorrect password",
 					$self->{USERNAME}));
@@ -1635,13 +1712,8 @@
 
 		unless ($super and $self->{USERNAME} ne $Vend::username) {
 			my $db_pass = $self->{DB}->field($self->{USERNAME}, $self->{LOCATION}{PASSWORD});
-			if($self->{CRYPT}) {
-				if($self->{OPTIONS}{md5}) {
-					$self->{OLDPASS} = generate_key($self->{OLDPASS});
-				}
-				else {
-					$self->{OLDPASS} = crypt($self->{OLDPASS}, $db_pass);
-				}
+			if ($self->{CRYPT}) {
+				$self->{OLDPASS} = $self->do_crypt($self->{OLDPASS}, $db_pass);
 			}
 			die errmsg("Must have old password.") . "\n"
 				if $self->{OLDPASS} ne $db_pass;
@@ -1653,16 +1725,11 @@
 		die errmsg("Password and check value don't match.") . "\n"
 			unless $self->{PASSWORD} eq $self->{VERIFY};
 
-		if($self->{CRYPT}) {
-				if($self->{OPTIONS}{md5}) {
-					$self->{PASSWORD} = generate_key($self->{PASSWORD});
-				}
-				else {
-					$self->{PASSWORD} = crypt(
-											$self->{PASSWORD},
-											Vend::Util::random_string(2)
-										);
-				}
+		if ( $self->{CRYPT} ) {
+			$self->{PASSWORD} = $self->do_crypt(
+				$self->{PASSWORD},
+				Vend::Util::random_string(2),
+			);
 		}
 		
 		my $pass = $self->{DB}->set_field(
@@ -1770,12 +1837,7 @@
 		my $pw = $self->{PASSWORD};
 		if($self->{CRYPT}) {
 			eval {
-				if($self->{OPTIONS}{md5}) {
-					$pw = generate_key($pw);
-				}
-				else {
-					$pw = crypt( $pw, Vend::Util::random_string(2));
-				}
+				$pw = $self->do_crypt($pw, Vend::Util::random_string(2));
 			};
 		}
 	
@@ -2176,4 +2238,17 @@
 	return;
 }
 
+sub do_crypt {
+	my ($self, $password, $salt) = @_;
+	my $sub = $self->{ENCSUB};
+	unless ($sub) {
+		for (grep { $self->{OPTIONS}{$_} } keys %enc_subs) {
+			$sub = $enc_subs{$_};
+			last;
+		}
+		$self->{ENCSUB} = $sub ||= $enc_subs{default};
+	}
+	return $sub->($self, $password, $salt);
+}
+
 1;







More information about the interchange-cvs mailing list