Feature: bcrypted passwords
This implements using properly bcrypted passwords with unique salts, per best practices. This change has a couple of sharp edges: 1) ATOM posting and digest-auth will break. Unclear how impactful this is or what we should consider doing (if anything) about it. 2) Renames used to verify that the accounts being merged shared a password. We think that having validated email accounts that match is good enough, though. 3) Probably some bugs, I've only tested that I can still log in/out, haven't gone wild testing every flow. The implementation leverages our dversion system so that users can be on the 'old style' passwords and we can upgrade them when we are confident and ready to roll.
This commit is contained in:
Mark Smith
Mark Smith
parent
5cc786dee0
commit
94990c69cb
|
|
@ -66,10 +66,6 @@ unless ( $args{force} ) {
|
|||
print " " . $acct[1]->email_raw . "\n";
|
||||
exit 1;
|
||||
}
|
||||
unless ( $acct[0]->password eq $acct[1]->password ) {
|
||||
print "Passwords don't match.\n";
|
||||
exit 1;
|
||||
}
|
||||
unless ( $acct[0]->{'status'} eq "A" || $acct[1]->{'status'} eq "A" ) {
|
||||
print "At least one account isn't verified.\n";
|
||||
exit 1;
|
||||
|
|
|
|||
|
|
@ -0,0 +1,59 @@
|
|||
#!/usr/bin/perl
|
||||
#
|
||||
# d10-passwords.pl
|
||||
#
|
||||
# Migration tool to migrate users to dversion 10, with bcrypted passwords.
|
||||
#
|
||||
# Authors:
|
||||
# Mark Smith <mark@dreamwidth.org>
|
||||
#
|
||||
# Copyright (c) 2020 by Dreamwidth Studios, LLC.
|
||||
#
|
||||
# This program is free software; you may redistribute it and/or modify it under
|
||||
# the same terms as Perl itself. For a copy of the license, please reference
|
||||
# 'perldoc perlartistic' or 'perldoc perlgpl'.
|
||||
#
|
||||
#
|
||||
use v5.10;
|
||||
use strict;
|
||||
BEGIN { require "$ENV{LJHOME}/cgi-bin/ljlib.pl"; }
|
||||
|
||||
my $dbh = LJ::get_db_writer();
|
||||
|
||||
while (1) {
|
||||
sleep(1);
|
||||
print "FINDING_USERS\n";
|
||||
|
||||
# Get 1000 users at a time to do the migration.
|
||||
my $sth = $dbh->prepare(q{SELECT userid FROM user WHERE dversion = 9 LIMIT 1000});
|
||||
$sth->execute;
|
||||
die $sth->errstr if $sth->err;
|
||||
|
||||
# Iterate each user, load, update, save
|
||||
while ( my ($uid) = $sth->fetchrow_array ) {
|
||||
my $u = LJ::load_userid($uid)
|
||||
or die "Invalid userid: $uid\n";
|
||||
|
||||
# If this is not a person, there's nothing to do, so just upgrade their dversion
|
||||
# and move on.
|
||||
unless ( $u->is_person ) {
|
||||
$u->update_self( { dversion => 10 } );
|
||||
print "UPGRADED $u->{user}($uid) NOT_PERSON\n";
|
||||
continue;
|
||||
}
|
||||
|
||||
# If they're expunged, we also just auto-upgrade.
|
||||
if ( $u->is_expunged ) {
|
||||
$u->update_self( { dversion => 10 } );
|
||||
print "UPGRADED $u->{user}($uid) EXPUNGED\n";
|
||||
continue;
|
||||
}
|
||||
|
||||
# Valid user, get their password, set it, move on.
|
||||
my $password = $u->password
|
||||
or die "Failed to get password on $u->{user}($uid)!\n";
|
||||
$u->set_password( $password, force_bcrypt => 1 );
|
||||
$u->update_self( { dversion => 10 } );
|
||||
print "UPGRADED $u->{user}($uid) MIGRATED\n";
|
||||
}
|
||||
}
|
||||
|
|
@ -2215,6 +2215,15 @@ CREATE TABLE password (
|
|||
)
|
||||
EOC
|
||||
|
||||
register_tablecreate( "password_bcrypt", <<'EOC');
|
||||
CREATE TABLE password_bcrypt (
|
||||
userid INT UNSIGNED NOT NULL PRIMARY KEY,
|
||||
bcrypt_cost SMALLINT UNSIGNED NOT NULL,
|
||||
bcrypt_salt CHAR(22) NOT NULL,
|
||||
bcrypt_hash CHAR(31) NOT NULL
|
||||
)
|
||||
EOC
|
||||
|
||||
register_tablecreate( "email", <<'EOC');
|
||||
CREATE TABLE email (
|
||||
userid INT UNSIGNED NOT NULL PRIMARY KEY,
|
||||
|
|
|
|||
|
|
@ -4,6 +4,11 @@
|
|||
#
|
||||
# Alternate authentication styles
|
||||
#
|
||||
# BIG NOTE: These authentication mechanisms break as soon as we move to storing
|
||||
# bcrypted passwords, which are not compatible with schemes like digest auth that
|
||||
# require us to be able to reverse the user's password. Do we care? Do we need to
|
||||
# generate app passwords?
|
||||
#
|
||||
# Authors:
|
||||
# Andrea Nall <anall@andreanall.com>
|
||||
# Afuna <coder.dw@afunamatata.com>
|
||||
|
|
|
|||
|
|
@ -89,7 +89,9 @@ sub changeemail_handler {
|
|||
push @errors, LJ::Lang::ml('/changeemail.tt.error.nospace');
|
||||
}
|
||||
|
||||
if ( !$remote->is_identity && ( !defined $password || $password ne $remote->password ) ) {
|
||||
if ( !$remote->is_identity
|
||||
&& ( !defined $password || !$remote->check_password($password) ) )
|
||||
{
|
||||
push @errors, LJ::Lang::ml('/changeemail.tt.error.invalidpassword');
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -296,8 +296,8 @@ sub changepassword_handler {
|
|||
if ( LJ::login_ip_banned($u) ) {
|
||||
$errors->add( "user", "error.ipbanned" );
|
||||
}
|
||||
elsif ( !$authu
|
||||
&& ( $u->password eq "" || $u->password ne $password ) )
|
||||
elsif (!$authu
|
||||
&& !$u->check_password($password) )
|
||||
{
|
||||
$errors->add( "password", ".error.badoldpassword" );
|
||||
LJ::handle_bad_login($u);
|
||||
|
|
@ -326,14 +326,9 @@ sub changepassword_handler {
|
|||
|
||||
# now let's change the password
|
||||
unless ( $errors->exist ) {
|
||||
## make note of changed password
|
||||
my $dbh = LJ::get_db_writer();
|
||||
my $oldval = Digest::MD5::md5_hex( $u->password . "change" );
|
||||
$u->infohistory_add( 'password', $oldval );
|
||||
|
||||
$u->infohistory_add( 'password', 'changed' );
|
||||
$u->log_event( 'password_change', { remote => $remote } );
|
||||
|
||||
$u->update_self( { password => $post->{newpass1} } );
|
||||
$u->set_password( $post->{newpass1} );
|
||||
|
||||
# if we used an authcode, we'll need to expire it now
|
||||
LJ::mark_authaction_used($aa) if $authu;
|
||||
|
|
@ -370,15 +365,6 @@ sub changepassword_handler {
|
|||
}
|
||||
);
|
||||
|
||||
LJ::Hooks::run_hooks(
|
||||
"post_changepassword",
|
||||
{
|
||||
"u" => $u,
|
||||
"newpassword" => $post->{newpass1},
|
||||
"oldpassword" => $u->password,
|
||||
}
|
||||
);
|
||||
|
||||
LJ::Hooks::run_hook( 'user_login', $u );
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -329,7 +329,6 @@ sub _are_same_person {
|
|||
# may be able to do this more elegantly once we are able to associate accounts
|
||||
# right now: two valid accounts, same email address, same password, and at least one must be validated
|
||||
return 0 unless $p1->has_same_email_as($p2);
|
||||
return 0 unless $p1->password eq $p2->password;
|
||||
return 0 unless $p1->is_validated || $p2->is_validated;
|
||||
|
||||
return 1;
|
||||
|
|
|
|||
|
|
@ -171,7 +171,7 @@ sub auth_okay {
|
|||
};
|
||||
|
||||
## LJ default authorization:
|
||||
return 1 if $password eq $u->password;
|
||||
return 1 if $u->check_password($password);
|
||||
return $bad_login->();
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -46,8 +46,7 @@ sub execute {
|
|||
unless $u;
|
||||
|
||||
my $newpass = LJ::rand_chars(8);
|
||||
my $oldpass = Digest::MD5::md5_hex( $u->password . "change" );
|
||||
my $rval = $u->infohistory_add( 'passwordreset', $oldpass );
|
||||
my $rval = $u->infohistory_add( 'passwordreset', 'reset' );
|
||||
return $self->error("Failed to insert old password into infohistory.")
|
||||
unless $rval;
|
||||
|
||||
|
|
|
|||
|
|
@ -62,7 +62,7 @@ sub verify_username {
|
|||
# brute-force possibly going on
|
||||
}
|
||||
else {
|
||||
if ( $u->password eq $post->{password1} ) {
|
||||
if ( $u->check_password( $post->{password1} ) ) {
|
||||
|
||||
# okay either they double-clicked the submit button
|
||||
# or somebody entered an account name that already exists
|
||||
|
|
@ -96,7 +96,6 @@ sub verify_password {
|
|||
my ( $password, $username, $email, $name );
|
||||
my $u = $opts{u};
|
||||
if ( LJ::isu($u) ) {
|
||||
$password = $u->password;
|
||||
$username = $u->user;
|
||||
$email = $u->email_raw;
|
||||
$name = $u->name_raw;
|
||||
|
|
|
|||
|
|
@ -342,8 +342,12 @@ no strict "vars";
|
|||
# Selective screening limit. No user can have more than this.
|
||||
$LJ::SEL_SCREEN_LIMIT ||= 500;
|
||||
|
||||
# maximum length of a username (NB do not change without changing width of database fields to match. And perhaps other stuff.
|
||||
# Maximum length of a username (NB do not change without changing width
|
||||
# of database fields to match. And perhaps other stuff.
|
||||
$USERNAME_MAXLENGTH = 25;
|
||||
|
||||
# Cost to set for bcrypt password hash calculations.
|
||||
$BCRYPT_COST = 12;
|
||||
}
|
||||
|
||||
1;
|
||||
|
|
|
|||
|
|
@ -183,7 +183,7 @@ sub save {
|
|||
'setting.emailposting.error.pin.invalidaccount',
|
||||
{ sitename => $LJ::SITENAMESHORT }
|
||||
)
|
||||
) if $pin_val eq $u->password || $pin_val eq $u->user;
|
||||
) if $pin_val eq $u->user;
|
||||
|
||||
$u->set_prop( emailpost_pin => $pin_val );
|
||||
|
||||
|
|
|
|||
|
|
@ -15,6 +15,9 @@ package LJ::User;
|
|||
use strict;
|
||||
no warnings 'uninitialized';
|
||||
|
||||
use Crypt::Eksblowfish::Bcrypt qw/ bcrypt_hash en_base64 de_base64 /;
|
||||
use Math::Random::Secure qw/ irand /;
|
||||
|
||||
use LJ::Session;
|
||||
|
||||
########################################################################
|
||||
|
|
@ -319,8 +322,8 @@ sub can_receive_password {
|
|||
return 0 unless $u && $email;
|
||||
return 1 if lc($email) eq lc( $u->email_raw );
|
||||
|
||||
my $dbh = LJ::get_db_reader();
|
||||
return $dbh->selectrow_array(
|
||||
my $dbr = LJ::get_db_reader();
|
||||
return $dbr->selectrow_array(
|
||||
"SELECT COUNT(*) FROM infohistory "
|
||||
. "WHERE userid=? AND what='email' "
|
||||
. "AND oldvalue=? AND other='A'",
|
||||
|
|
@ -331,6 +334,13 @@ sub can_receive_password {
|
|||
sub password {
|
||||
my $u = shift;
|
||||
return unless $u->is_person;
|
||||
|
||||
# This is only valid on dversion <= 9. Otherwise, we are using encrypted
|
||||
# passwords and this is meaningless.
|
||||
croak('User password is unavailable.')
|
||||
unless $u->dversion <= 9;
|
||||
|
||||
# TODO: Remove when everybody is upgraded.
|
||||
my $userid = $u->userid;
|
||||
$u->{_password} ||= LJ::MemCache::get_or_set(
|
||||
[ $userid, "pw:$userid" ],
|
||||
|
|
@ -343,21 +353,82 @@ sub password {
|
|||
return $u->{_password};
|
||||
}
|
||||
|
||||
sub password_bcrypt {
|
||||
my $u = $_[0];
|
||||
croak('User is not using bcrypted passwords yet.') unless $u->dversion >= 10;
|
||||
|
||||
# TODO: memcache?
|
||||
my $dbh = LJ::get_db_writer()
|
||||
or croak('Unable to get db master.');
|
||||
my ( $cost, $salt, $hash ) = $dbh->selectrow_array(
|
||||
q{SELECT bcrypt_cost, bcrypt_salt, bcrypt_hash FROM password_bcrypt WHERE userid = ?},
|
||||
undef, $u->id );
|
||||
|
||||
croak('User has no bcrypted password?!') unless $cost && defined $salt && defined $hash;
|
||||
|
||||
return ( $cost, $salt, $hash );
|
||||
}
|
||||
|
||||
sub set_password {
|
||||
my ( $u, $password ) = @_;
|
||||
my ( $u, $password, %opts ) = @_;
|
||||
my $userid = $u->id;
|
||||
|
||||
my $dbh = LJ::get_db_writer();
|
||||
if ( $LJ::DEBUG{'write_passwords_to_user_table'} ) {
|
||||
$dbh->do( "UPDATE user SET password=? WHERE userid=?", undef, $password, $userid );
|
||||
}
|
||||
$dbh->do( "REPLACE INTO password (userid, password) VALUES (?, ?)", undef, $userid, $password );
|
||||
my $dbh = LJ::get_db_writer()
|
||||
or croak('Unable to get db master.');
|
||||
|
||||
# update caches
|
||||
LJ::memcache_kill( $userid, "userid" );
|
||||
$u->memc_delete('pw');
|
||||
my $cache = $LJ::REQ_CACHE_USER_ID{$userid} or return;
|
||||
$cache->{'_password'} = $password;
|
||||
if ( $u->dversion <= 9 && !exists $opts{force_bcrypt} ) {
|
||||
|
||||
# Old style: Write raw password to the database and store it in the user
|
||||
# object. This is quite dumb, but it was the late 90s when this was written?
|
||||
$dbh->do( "REPLACE INTO password (userid, password) VALUES (?, ?)",
|
||||
undef, $userid, $password )
|
||||
or croak('Failed to set password.');
|
||||
|
||||
# update caches
|
||||
LJ::memcache_kill( $userid, "userid" );
|
||||
$u->memc_delete('pw');
|
||||
my $cache = $LJ::REQ_CACHE_USER_ID{$userid} or return;
|
||||
$cache->{'_password'} = $password;
|
||||
}
|
||||
else {
|
||||
# New style: calculate a new salt and bcrypt and store into the database.
|
||||
# Password is never saved anywhere.
|
||||
|
||||
# Salt is constructed with 16 bytes of cryptographically secure PRNG. And is
|
||||
# unique per password set.
|
||||
my $salt = pack( 'LLLL', map { irand() } 1 .. 4 );
|
||||
|
||||
# Bcrypt hash, so it's hard to brute force.
|
||||
my $cost = $LJ::BCRYPT_COST || 12;
|
||||
my $hash = bcrypt_hash( { key_nul => 1, cost => $cost, salt => $salt }, $password );
|
||||
|
||||
# Replace into database.
|
||||
$dbh->do(
|
||||
q{REPLACE INTO password_bcrypt (userid, bcrypt_cost, bcrypt_salt, bcrypt_hash) VALUES (?, ?, ?, ?)},
|
||||
undef,
|
||||
$userid,
|
||||
$cost,
|
||||
en_base64($salt),
|
||||
en_base64($hash)
|
||||
) or croak('Failed to set password hash.');
|
||||
|
||||
# TODO: memcache:
|
||||
}
|
||||
}
|
||||
|
||||
sub check_password {
|
||||
my ( $u, $password ) = @_;
|
||||
|
||||
if ( $u->dversion <= 9 ) {
|
||||
return $u->password eq $password;
|
||||
}
|
||||
|
||||
# This is a modern password, we have to do the hash anew and check.
|
||||
my ( $cost, $salt, $hash ) = $u->password_bcrypt;
|
||||
my $check_hash =
|
||||
bcrypt_hash( { key_nul => 1, cost => $cost, salt => de_base64($salt) }, $password );
|
||||
|
||||
return en_base64($check_hash) eq $hash ? 1 : 0;
|
||||
}
|
||||
|
||||
########################################################################
|
||||
|
|
|
|||
|
|
@ -7,6 +7,7 @@ Class::Data::Inheritable
|
|||
Class::Trigger
|
||||
Compress::Zlib
|
||||
Crypt::DH
|
||||
Crypt::Eksblowfish::Bcrypt
|
||||
Danga::Socket
|
||||
Data::ObjectDriver
|
||||
Digest::HMAC_SHA1
|
||||
|
|
@ -30,6 +31,7 @@ MIME::Lite
|
|||
MIME::Words
|
||||
Mail::GnuPG
|
||||
Math::BigInt::GMP
|
||||
Math::Random::Secure
|
||||
MogileFS::Client@1.17
|
||||
Moose
|
||||
Mozilla::CA
|
||||
|
|
|
|||
|
|
@ -39,7 +39,7 @@ body<=
|
|||
push @errors, BML::ml( '.error.invaliduser', { user => LJ::ehtml( $POST{username} ) } ) unless $u;
|
||||
|
||||
my $password = $POST{password};
|
||||
push @errors, $ML{'.error.invalidpassword'} unless $password && $password eq $remote->password;
|
||||
push @errors, $ML{'.error.invalidpassword'} unless $password && $remote->check_password( $password );
|
||||
|
||||
my $reason = LJ::ehtml( LJ::trim( $POST{reason} ) );
|
||||
push @errors, $ML{'.error.emptyreason'} unless $reason;
|
||||
|
|
|
|||
|
|
@ -107,8 +107,7 @@ body<=
|
|||
return $err->( $ML{'.error.syndicated'} );
|
||||
}
|
||||
|
||||
if ( $u->is_community && ! length $u->password ) {
|
||||
# community with no password
|
||||
if ( $u->is_community ) {
|
||||
return $err->( $ML{'.error.commnopassword'} );
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -284,7 +284,7 @@ body<=
|
|||
unless $pin =~ /^([a-z0-9]){4,20}$/i or $pin eq '';
|
||||
|
||||
push @errors, BML::ml('.error.invalidpinaccount', {'sitename' => $LJ::SITENAMESHORT})
|
||||
if $pin eq $u->password or $pin eq $u->user;
|
||||
if $pin eq $u->user;
|
||||
|
||||
# Check email, add flags if needed.
|
||||
my %allowed;
|
||||
|
|
|
|||
Loading…
Reference in New Issue