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     # this is safe
  16     #eval "use Authen::Passphrase::BlowfishCrypt;";
  17 });
  18
  19 our @pw_set;
  20
  21 our $me = '[' . __PACKAGE__ . ']';
  22
  23 our $BLOWFISH_COST = 10;
  24
  25 =head1 NAME
  26
  27 FS::Password_Mixin - Object methods for accounts that have passwords governed
  28 by the password policy.
  29
  30 =head1 METHODS
  31
  32 =over 4
  33
  34 =item is_password_allowed PASSWORD
  35
  36 Checks the password against the system password policy. Returns an error
  37 message on failure, an empty string on success.
  38
  39 This MUST NOT be called from check(). It should be called by the office UI,
  40 self-service ClientAPI, or other I<user-interactive> code that processes a
  41 password change, and only if the user has taken some action with the intent
  42 of setting the password.
  43
  44 =cut
  45
  46 sub is_password_allowed {
  47   my $self = shift;
  48   my $password = shift;
  49
  50   my $cust_main = $self->table eq 'access_user'
  51                     ? $self->user_cust_main
  52                     : $self->cust_main;
  53
  54   # workaround for non-inserted services
  55   if ( !$cust_main and $self->get('pkgnum') ) {
  56     my $cust_pkg = FS::cust_pkg->by_key($self->get('pkgnum'));
  57     $cust_main = $cust_pkg->cust_main if $cust_pkg;
  58   }
  59   # selfservice signup invokes this without customer, but it checks this conf separately
  60   warn "is_password_allowed: no customer could be identified" if !$cust_main;
  61   return '' if $cust_main && $conf->config_bool('password-insecure', $cust_main->agentnum);
  62
  63   # basic checks using Data::Password;
  64   # options for Data::Password
  65   $DICTIONARY = 0;   # minimum length of disallowed words, false value disables dictionary checking
  66   $MINLEN = $conf->config('passwordmin') || 6;
  67   $MAXLEN = $conf->config('passwordmax') || 8;
  68   $GROUPS = 4;       # must have all 4 'character groups': numbers, symbols, uppercase, lowercase
  69   # other options use the defaults listed below:
  70   # $FOLLOWING = 3;    # disallows more than 3 chars in a row, by alphabet or keyboard (ie abcd or asdf)
  71   # $SKIPCHAR = undef; # set to true to skip checking for bad characters
  72   # # lists of disallowed words
  73   # @DICTIONARIES = qw( /usr/share/dict/web2 /usr/share/dict/words /usr/share/dict/linux.words );
  74
  75   # first, no dictionary checking but require 4 char groups
  76   my $error = IsBadPassword($password);
  77
  78   # but they can get away with 3 char groups, so long as they're not using a word
  79   if ($error eq 'contains less than 4 character groups') {
  80     $DICTIONARY = 4; # default from Data::Password is 5
  81     $GROUPS = 3;
  82     $error = IsBadPassword($password);
  83     # take note--we never actually report dictionary word errors;
  84     # 4 char groups is the rule, 3 char groups and no dictionary words is an acceptable exception
  85     $error = 'should contain at least one each of numbers, symbols, lowercase and uppercase letters'
  86       if $error;
  87   }
  88
  89   # maybe also at some point add an exception for any passwords of sufficient length,
  90   # see https://xkcd.com/936/
  91
  92   $error = 'Invalid password - ' . $error if $error;
  93   return $error if $error;
  94
  95   #check against service fields
  96   $error = $self->password_svc_check($password);
  97   return $error if $error;
  98
  99   return '' unless $self->get($self->primary_key); # for validating new passwords pre-insert
 100
 101   #check against customer fields
 102   if ($cust_main) {
 103     my @words;
 104     # words from cust_main
 105     foreach my $field ( qw( last first daytime night fax mobile ) ) {
 106         push @words, split(/\W/,$cust_main->get($field));
 107     }
 108     # words from cust_location
 109     foreach my $loc ($cust_main->cust_location) {
 110       foreach my $field ( qw(address1 address2 city county state zip) ) {
 111         push @words, split(/\W/,$loc->get($field));
 112       }
 113     }
 114     # do the actual checking
 115     foreach my $word (@words) {
 116       next unless length($word) > 2;
 117       if ($password =~ /$word/i) {
 118         return qq(Password contains account information '$word');
 119       }
 120     }
 121   }
 122
 123   if ( $conf->config('password-no_reuse') =~ /^(\d+)$/ ) {
 124
 125     my $no_reuse = $1;
 126
 127     # "the last N" passwords includes the current password and the N-1
 128     # passwords before that.
 129     warn "$me checking password reuse limit of $no_reuse\n" if $DEBUG;
 130     my @latest = qsearch({
 131         'table'     => 'password_history',
 132         'hashref'   => { $self->password_history_key => $self->get($self->primary_key) },
 133         'order_by'  => " ORDER BY created DESC LIMIT $no_reuse",
 134     });
 135
 136     # don't check the first one; reusing the current password is allowed.
 137     shift @latest;
 138
 139     foreach my $history (@latest) {
 140       warn "$me previous password created ".$history->created."\n" if $DEBUG;
 141       if ( $history->password_equals($password) ) {
 142         my $message;
 143         if ( $no_reuse == 1 ) {
 144           $message = "This password is the same as your previous password.";
 145         } else {
 146           $message = "This password was one of the last $no_reuse passwords on this account.";
 147         }
 148         return $message;
 149       }
 150     } #foreach $history
 151
 152   } # end of no_reuse checking
 153
 154   '';
 155 }
 156
 157 =item password_svc_check
 158
 159 Override to run additional service-specific password checks.
 160
 161 =cut
 162
 163 sub password_svc_check {
 164   my ($self, $password) = @_;
 165   return '';
 166 }
 167
 168 =item password_history_key
 169
 170 Returns the name of the field in L<FS::password_history> that's the foreign
 171 key to this table.
 172
 173 =cut
 174
 175 sub password_history_key {
 176   my $self = shift;
 177   $self->table . '__' . $self->primary_key;
 178 }
 179
 180 =item insert_password_history
 181
 182 Creates a L<FS::password_history> record linked to this object, with its
 183 current password.
 184
 185 =cut
 186
 187 sub insert_password_history {
 188   my $self = shift;
 189   my $encoding = $self->_password_encoding;
 190   my $password = $self->_password;
 191   my $auth;
 192
 193   if ( $encoding eq 'bcrypt' ) {
 194     # our format, used for contact and access_user passwords
 195     my ($cost, $salt, $hash) = split(',', $password);
 196     $auth = Authen::Passphrase::BlowfishCrypt->new(
 197       cost        => $cost,
 198       salt_base64 => $salt,
 199       hash_base64 => $hash,
 200     );
 201
 202   } elsif ( $encoding eq 'crypt' ) {
 203
 204     # it's smart enough to figure this out
 205     $auth = Authen::Passphrase->from_crypt($password);
 206
 207   } elsif ( $encoding eq 'ldap' ) {
 208
 209     $password =~ s/^{PLAIN}/{CLEARTEXT}/i; # normalize
 210     $auth = Authen::Passphrase->from_rfc2307($password);
 211     if ( $auth->isa('Authen::Passphrase::Clear') ) {
 212       # then we've been given the password in cleartext
 213       $auth = $self->_blowfishcrypt( $auth->passphrase );
 214     }
 215
 216   } else {
 217     if ($encoding and $encoding ne 'plain') {
 218       warn "unrecognized password encoding '$encoding'; treating as plain text";
 219     }
 220
 221     $auth = $self->_blowfishcrypt( $password );
 222
 223   }
 224
 225   my $password_history = FS::password_history->new({
 226       _password => $auth->as_rfc2307,
 227       created   => time,
 228       $self->password_history_key => $self->get($self->primary_key),
 229   });
 230
 231   my $error = $password_history->insert;
 232   return "recording password history: $error" if $error;
 233   '';
 234
 235 }
 236
 237 =item delete_password_history;
 238
 239 Removes all password history records attached to this object, in preparation
 240 to delete the object.
 241
 242 =cut
 243
 244 sub delete_password_history {
 245   my $self = shift;
 246   my @records = qsearch('password_history', {
 247       $self->password_history_key => $self->get($self->primary_key)
 248   });
 249   my $error = '';
 250   foreach (@records) {
 251     $error ||= $_->delete;
 252   }
 253   return $error . ' (clearing password history)' if $error;
 254   '';
 255 }
 256
 257 =item _blowfishcrypt PASSWORD
 258
 259 For internal use: takes PASSWORD and returns a new
 260 L<Authen::Passphrase::BlowfishCrypt> object representing it.
 261
 262 =cut
 263
 264 sub _blowfishcrypt {
 265   my $class = shift;
 266   my $passphrase = shift;
 267   return Authen::Passphrase::BlowfishCrypt->new(
 268     cost => $BLOWFISH_COST,
 269     salt_random => 1,
 270     passphrase => $passphrase,
 271   );
 272 }
 273
 274 =back
 275
 276 =head1 CLASS METHODS
 277
 278 =over 4
 279
 280 =item pw_set
 281
 282 Returns the list of characters allowed in random passwords (from the
 283 C<password-generated-characters> config).
 284
 285 =cut
 286
 287 sub pw_set {
 288   my $class = shift;
 289   if (!@pw_set) {
 290     my $pw_set = $conf->config('password-generated-characters');
 291     $pw_set =~ s/\s//g; # don't ever allow whitespace
 292     if ( $pw_set =~ /[[:lower:]]/
 293       && $pw_set =~ /[[:upper:]]/
 294       && $pw_set =~ /[[:digit:]]/
 295       && $pw_set =~ /[[:punct:]]/ ) {
 296       @pw_set = split('', $pw_set);
 297     } else {
 298       warn "password-generated-characters set is insufficient; using default.";
 299       @pw_set = split('', 'abcdefghijkmnpqrstuvwxyzABCDEFGHIJKLMNPQRSTUVWXYZ23456789()#.,');
 300     }
 301   }
 302   return @pw_set;
 303 }
 304
 305 =back
 306
 307 =head1 SEE ALSO
 308
 309 L<FS::password_history>
 310
 311 =cut
 312
 313 1;