diff options
Diffstat (limited to 'FS')
| -rw-r--r-- | FS/FS/ClientAPI/MyAccount.pm | 6 | ||||
| -rw-r--r-- | FS/FS/Password_Mixin.pm | 45 | ||||
| -rw-r--r-- | FS/FS/svc_acct.pm | 25 |
3 files changed, 69 insertions, 7 deletions
diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm index a6bde824a..9847e5f90 100644 --- a/FS/FS/ClientAPI/MyAccount.pm +++ b/FS/FS/ClientAPI/MyAccount.pm @@ -2995,12 +2995,6 @@ sub myaccount_passwd { ) && ! $svc_acct->check_password($p->{'old_password'}); - # should move password length checks into is_password_allowed - $error = 'Password too short.' - if length($p->{'new_password'}) < ($conf->config('passwordmin') || 6); - $error = 'Password too long.' - if length($p->{'new_password'}) > ($conf->config('passwordmax') || 8); - $error ||= $svc_acct->is_password_allowed($p->{'new_password'}) || $svc_acct->set_password($p->{'new_password'}) || $svc_acct->replace(); diff --git a/FS/FS/Password_Mixin.pm b/FS/FS/Password_Mixin.pm index 990f73595..bcad54637 100644 --- a/FS/FS/Password_Mixin.pm +++ b/FS/FS/Password_Mixin.pm @@ -6,8 +6,13 @@ use FS::password_history; use Authen::Passphrase; use Authen::Passphrase::BlowfishCrypt; # https://rt.cpan.org/Ticket/Display.html?id=72743 +use Data::Password qw(:all); our $DEBUG = 0; +our $conf; +FS::UID->install_callback( sub { + $conf = FS::Conf->new; +}); our $me = '[' . __PACKAGE__ . ']'; @@ -38,7 +43,34 @@ sub is_password_allowed { my $self = shift; my $password = shift; - # check length and complexity here + # basic checks using Data::Password; + # options for Data::Password + $DICTIONARY = 4; # minimum length of disallowed words + $MINLEN = $conf->config('passwordmin') || 6; + $MAXLEN = $conf->config('passwordmax') || 8; + $GROUPS = 4; # must have all 4 'character groups': numbers, symbols, uppercase, lowercase + # other options use the defaults listed below: + # $FOLLOWING = 3; # disallows more than 3 chars in a row, by alphabet or keyboard (ie abcd or asdf) + # $SKIPCHAR = undef; # set to true to skip checking for bad characters + # # lists of disallowed words + # @DICTIONARIES = qw( /usr/share/dict/web2 /usr/share/dict/words /usr/share/dict/linux.words ); + + my $error = IsBadPassword($password); + $error = 'must contain at least one each of numbers, symbols, and lowercase and uppercase letters' + if $error eq 'contains less than 4 character groups'; # avoid confusion + $error = 'Invalid password - ' . $error if $error; + return $error if $error; + + #check against known usernames + my @disallowed_names = $self->password_disallowed_names; + foreach my $noname (@disallowed_names) { + if ($password =~ /$noname/i) { + #keeping message ambiguous to avoid leaking personal info + return 'Password contains a disallowed word'; + } + } + + return '' unless $self->get($self->primary_key); # for validating new passwords pre-insert my $no_reuse = 3; # allow override here if we really must @@ -75,6 +107,17 @@ sub is_password_allowed { ''; } +=item password_disallowed_names + +Override to return a list additional words (eg usernames) not +to be used by passwords on this service. + +=cut + +sub password_disallowed_names { + return (); +} + =item password_history_key Returns the name of the field in L<FS::password_history> that's the foreign diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index 9323976cb..e7ec4a231 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -2676,6 +2676,31 @@ sub virtual_maildir { $self->domain. '/maildirs/'. $self->username. '/'; } +=item password_disallowed_names + +Override, for L<FS::Password_Mixin>. Not really intended for other use. + +=cut + +sub password_disallowed_names { + my $self = shift; + my $dbh = dbh; + my $results = {}; + foreach my $field ( qw( username finger ) ) { + my $sql = 'SELECT DISTINCT '.$field.' FROM svc_acct'; + my $sth = $dbh->prepare($sql) + or die "Error preparing $sql: ". $dbh->errstr; + $sth->execute() + or die "Error executing $sql: ". $sth->errstr; + foreach my $row (@{$sth->fetchall_arrayref}, $self->get($field)) { + foreach my $word (split(/\s+/,$$row[0])) { + $results->{lc($word)} = 1; + } + } + } + return keys %$results; +} + =back =head1 CLASS METHODS |