FS/FS/Password_Mixin.pm

   1 package FS::Password_Mixin;
   2
   3 use FS::Record qw(qsearch);
   4 use FS::Conf;
   5 use FS::password_history;
   6 use Authen::Passphrase;
   7 use Authen::Passphrase::BlowfishCrypt;
   8 # https://rt.cpan.org/Ticket/Display.html?id=72743
   9 use Data::Password qw(:all);
  10
  11 our $DEBUG = 0;
  12 our $conf;
  13 FS::UID->install_callback( sub {
  14   $conf = FS::Conf->new;
  15 });
  16
  17 our $me = '[' . __PACKAGE__ . ']';
  18
  19 our $BLOWFISH_COST = 10;
  20
  21 =head1 NAME
  22
  23 FS::Password_Mixin - Object methods for accounts that have passwords governed
  24 by the password policy.
  25
  26 =head1 METHODS
  27
  28 =over 4
  29
  30 =item is_password_allowed PASSWORD
  31
  32 Checks the password against the system password policy. Returns an error
  33 message on failure, an empty string on success.
  34
  35 This MUST NOT be called from check(). It should be called by the office UI,
  36 self-service ClientAPI, or other I<user-interactive> code that processes a
  37 password change, and only if the user has taken some action with the intent
  38 of changing the password.
  39
  40 =cut
  41
  42 sub is_password_allowed {
  43   my $self = shift;
  44   my $password = shift;
  45
  46   # basic checks using Data::Password;
  47   # options for Data::Password
  48   $DICTIONARY = 4;   # minimum length of disallowed words
  49   $MINLEN = $conf->config('passwordmin') || 6;
  50   $MAXLEN = $conf->config('passwordmax') || 8;
  51   $GROUPS = 4;       # must have all 4 'character groups': numbers, symbols, uppercase, lowercase
  52   # other options use the defaults listed below:
  53   # $FOLLOWING = 3;    # disallows more than 3 chars in a row, by alphabet or keyboard (ie abcd or asdf)
  54   # $SKIPCHAR = undef; # set to true to skip checking for bad characters
  55   # # lists of disallowed words
  56   # @DICTIONARIES = qw( /usr/share/dict/web2 /usr/share/dict/words /usr/share/dict/linux.words );
  57
  58   my $error = IsBadPassword($password);
  59   $error = 'must contain at least one each of numbers, symbols, and lowercase and uppercase letters'
  60     if $error eq 'contains less than 4 character groups'; # avoid confusion
  61   $error = 'Invalid password - ' . $error if $error;
  62   return $error if $error;
  63
  64   #check against known usernames
  65   my @disallowed_names = $self->password_disallowed_names;
  66   foreach my $noname (@disallowed_names) {
  67     if ($password =~ /$noname/i) {
  68       #keeping message ambiguous to avoid leaking personal info
  69       return 'Password contains a disallowed word';
  70     }
  71   }
  72
  73   return '' unless $self->get($self->primary_key); # for validating new passwords pre-insert
  74
  75   my $no_reuse = 3;
  76   # allow override here if we really must
  77
  78   if ( $no_reuse > 0 ) {
  79
  80     # "the last N" passwords includes the current password and the N-1
  81     # passwords before that.
  82     warn "$me checking password reuse limit of $no_reuse\n" if $DEBUG;
  83     my @latest = qsearch({
  84         'table'     => 'password_history',
  85         'hashref'   => { $self->password_history_key => $self->get($self->primary_key) },
  86         'order_by'  => " ORDER BY created DESC LIMIT $no_reuse",
  87     });
  88
  89     # don't check the first one; reusing the current password is allowed.
  90     shift @latest;
  91
  92     foreach my $history (@latest) {
  93       warn "$me previous password created ".$history->created."\n" if $DEBUG;
  94       if ( $history->password_equals($password) ) {
  95         my $message;
  96         if ( $no_reuse == 1 ) {
  97           $message = "This password is the same as your previous password.";
  98         } else {
  99           $message = "This password was one of the last $no_reuse passwords on this account.";
 100         }
 101         return $message;
 102       }
 103     } #foreach $history
 104
 105   } # end of no_reuse checking
 106
 107   '';
 108 }
 109
 110 =item password_disallowed_names
 111
 112 Override to return a list additional words (eg usernames) not
 113 to be used by passwords on this service.
 114
 115 =cut
 116
 117 sub password_disallowed_names {
 118   return ();
 119 }
 120
 121 =item password_history_key
 122
 123 Returns the name of the field in L<FS::password_history> that's the foreign
 124 key to this table.
 125
 126 =cut
 127
 128 sub password_history_key {
 129   my $self = shift;
 130   $self->table . '__' . $self->primary_key;
 131 }
 132
 133 =item insert_password_history
 134
 135 Creates a L<FS::password_history> record linked to this object, with its
 136 current password.
 137
 138 =cut
 139
 140 sub insert_password_history {
 141   my $self = shift;
 142   my $encoding = $self->_password_encoding;
 143   my $password = $self->_password;
 144   my $auth;
 145
 146   if ( $encoding eq 'bcrypt' ) {
 147     # our format, used for contact and access_user passwords
 148     my ($cost, $salt, $hash) = split(',', $password);
 149     $auth = Authen::Passphrase::BlowfishCrypt->new(
 150       cost        => $cost,
 151       salt_base64 => $salt,
 152       hash_base64 => $hash,
 153     );
 154
 155   } elsif ( $encoding eq 'crypt' ) {
 156
 157     # it's smart enough to figure this out
 158     $auth = Authen::Passphrase->from_crypt($password);
 159
 160   } elsif ( $encoding eq 'ldap' ) {
 161
 162     $password =~ s/^{PLAIN}/{CLEARTEXT}/i; # normalize
 163     $auth = Authen::Passphrase->from_rfc2307($password);
 164     if ( $auth->isa('Authen::Passphrase::Clear') ) {
 165       # then we've been given the password in cleartext
 166       $auth = $self->_blowfishcrypt( $auth->passphrase );
 167     }
 168
 169   } else {
 170     warn "unrecognized password encoding '$encoding'; treating as plain text"
 171       unless $encoding eq 'plain';
 172
 173     $auth = $self->_blowfishcrypt( $password );
 174
 175   }
 176
 177   my $password_history = FS::password_history->new({
 178       _password => $auth->as_rfc2307,
 179       created   => time,
 180       $self->password_history_key => $self->get($self->primary_key),
 181   });
 182
 183   my $error = $password_history->insert;
 184   return "recording password history: $error" if $error;
 185   '';
 186
 187 }
 188
 189 =item _blowfishcrypt PASSWORD
 190
 191 For internal use: takes PASSWORD and returns a new
 192 L<Authen::Passphrase::BlowfishCrypt> object representing it.
 193
 194 =cut
 195
 196 sub _blowfishcrypt {
 197   my $class = shift;
 198   my $passphrase = shift;
 199   return Authen::Passphrase::BlowfishCrypt->new(
 200     cost => $BLOWFISH_COST,
 201     salt_random => 1,
 202     passphrase => $passphrase,
 203   );
 204 }
 205
 206 =back
 207
 208 =head1 SEE ALSO
 209
 210 L<FS::password_history>
 211
 212 =cut
 213
 214 1;