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 setting 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 = 0;   # minimum length of disallowed words, false value disables dictionary checking
  49   $MINLEN = $conf->config('passwordmin') || 8;
  50   $MAXLEN = $conf->config('passwordmax') || 12;
  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   # first, no dictionary checking but require 4 char groups
  59   my $error = IsBadPassword($password);
  60
  61   # but they can get away with 3 char groups, so long as they're not using a word
  62   if ($error eq 'contains less than 4 character groups') {
  63     $DICTIONARY = 4; # default from Data::Password is 5
  64     $GROUPS = 3;
  65     $error = IsBadPassword($password);
  66     # take note--we never actually report dictionary word errors;
  67     # 4 char groups is the rule, 3 char groups and no dictionary words is an acceptable exception
  68     $error = 'should contain at least one each of numbers, symbols, lowercase and uppercase letters'
  69       if $error;
  70   }
  71
  72   # maybe also at some point add an exception for any passwords of sufficient length,
  73   # see https://xkcd.com/936/
  74
  75   $error = 'Invalid password - ' . $error if $error;
  76   return $error if $error;
  77
  78   #check against service fields
  79   $error = $self->password_svc_check($password);
  80   return $error if $error;
  81
  82   return '' unless $self->get($self->primary_key); # for validating new passwords pre-insert
  83
  84   #check against customer fields
  85   my $cust_main = $self->table eq 'access_user'
  86                     ? $self->user_cust_main
  87                     : $self->cust_main;
  88   if ($cust_main) {
  89     my @words;
  90     # words from cust_main
  91     foreach my $field ( qw( last first daytime night fax mobile ) ) {
  92         push @words, split(/\W/,$cust_main->get($field));
  93     }
  94     # words from cust_location
  95     foreach my $loc ($cust_main->cust_location) {
  96       foreach my $field ( qw(address1 address2 city county state zip) ) {
  97         push @words, split(/\W/,$loc->get($field));
  98       }
  99     }
 100     # words from cust_contact & contact_phone
 101     foreach my $contact (map { $_->contact } $cust_main->cust_contact) {
 102       foreach my $field ( qw(last first) ) {
 103         push @words, split(/\W/,$contact->get($field));
 104       }
 105       # not hugely useful right now, hyphenless stored values longer than password max,
 106       # but max will probably be increased eventually...
 107       foreach my $phone ( qsearch('contact_phone', {'contactnum' => $contact->contactnum}) ) {
 108         push @words, split(/\W/,$phone->get('phonenum'));
 109       }
 110     }
 111     # do the actual checking
 112     foreach my $word (@words) {
 113       next unless length($word) > 2;
 114       if ($password =~ /$word/i) {
 115         return qq(Password contains account information '$word');
 116       }
 117     }
 118   }
 119
 120   my $no_reuse = 3;
 121   # allow override here if we really must
 122
 123   if ( $no_reuse > 0 ) {
 124
 125     # "the last N" passwords includes the current password and the N-1
 126     # passwords before that.
 127     warn "$me checking password reuse limit of $no_reuse\n" if $DEBUG;
 128     my @latest = qsearch({
 129         'table'     => 'password_history',
 130         'hashref'   => { $self->password_history_key => $self->get($self->primary_key) },
 131         'order_by'  => " ORDER BY created DESC LIMIT $no_reuse",
 132     });
 133
 134     # don't check the first one; reusing the current password is allowed.
 135     shift @latest;
 136
 137     foreach my $history (@latest) {
 138       warn "$me previous password created ".$history->created."\n" if $DEBUG;
 139       if ( $history->password_equals($password) ) {
 140         my $message;
 141         if ( $no_reuse == 1 ) {
 142           $message = "This password is the same as your previous password.";
 143         } else {
 144           $message = "This password was one of the last $no_reuse passwords on this account.";
 145         }
 146         return $message;
 147       }
 148     } #foreach $history
 149
 150   } # end of no_reuse checking
 151
 152   '';
 153 }
 154
 155 =item password_svc_check
 156
 157 Override to run additional service-specific password checks.
 158
 159 =cut
 160
 161 sub password_svc_check {
 162   my ($self, $password) = @_;
 163   return '';
 164 }
 165
 166 =item password_history_key
 167
 168 Returns the name of the field in L<FS::password_history> that's the foreign
 169 key to this table.
 170
 171 =cut
 172
 173 sub password_history_key {
 174   my $self = shift;
 175   $self->table . '__' . $self->primary_key;
 176 }
 177
 178 =item insert_password_history
 179
 180 Creates a L<FS::password_history> record linked to this object, with its
 181 current password.
 182
 183 =cut
 184
 185 sub insert_password_history {
 186   my $self = shift;
 187   my $encoding = $self->_password_encoding;
 188   my $password = $self->_password;
 189   my $auth;
 190
 191   if ( $encoding eq 'bcrypt' ) {
 192     # our format, used for contact and access_user passwords
 193     my ($cost, $salt, $hash) = split(',', $password);
 194     $auth = Authen::Passphrase::BlowfishCrypt->new(
 195       cost        => $cost,
 196       salt_base64 => $salt,
 197       hash_base64 => $hash,
 198     );
 199
 200   } elsif ( $encoding eq 'crypt' ) {
 201
 202     # it's smart enough to figure this out
 203     $auth = Authen::Passphrase->from_crypt($password);
 204
 205   } elsif ( $encoding eq 'ldap' ) {
 206
 207     $password =~ s/^{PLAIN}/{CLEARTEXT}/i; # normalize
 208     $auth = Authen::Passphrase->from_rfc2307($password);
 209     if ( $auth->isa('Authen::Passphrase::Clear') ) {
 210       # then we've been given the password in cleartext
 211       $auth = $self->_blowfishcrypt( $auth->passphrase );
 212     }
 213
 214   } else {
 215     warn "unrecognized password encoding '$encoding'; treating as plain text"
 216       unless $encoding eq 'plain';
 217
 218     $auth = $self->_blowfishcrypt( $password );
 219
 220   }
 221
 222   my $password_history = FS::password_history->new({
 223       _password => $auth->as_rfc2307,
 224       created   => time,
 225       $self->password_history_key => $self->get($self->primary_key),
 226   });
 227
 228   my $error = $password_history->insert;
 229   return "recording password history: $error" if $error;
 230   '';
 231
 232 }
 233
 234 =item delete_password_history;
 235
 236 Removes all password history records attached to this object, in preparation
 237 to delete the object.
 238
 239 =cut
 240
 241 sub delete_password_history {
 242   my $self = shift;
 243   my @records = qsearch('password_history', {
 244       $self->password_history_key => $self->get($self->primary_key)
 245   });
 246   my $error = '';
 247   foreach (@records) {
 248     $error ||= $_->delete;
 249   }
 250   return $error . ' (clearing password history)' if $error;
 251   '';
 252 }
 253
 254 =item _blowfishcrypt PASSWORD
 255
 256 For internal use: takes PASSWORD and returns a new
 257 L<Authen::Passphrase::BlowfishCrypt> object representing it.
 258
 259 =cut
 260
 261 sub _blowfishcrypt {
 262   my $class = shift;
 263   my $passphrase = shift;
 264   return Authen::Passphrase::BlowfishCrypt->new(
 265     cost => $BLOWFISH_COST,
 266     salt_random => 1,
 267     passphrase => $passphrase,
 268   );
 269 }
 270
 271 =back
 272
 273 =head1 CLASS METHODS
 274
 275 =over 4
 276
 277 =item pw_set
 278
 279 Returns the list of characters allowed in random passwords. This is now
 280 hardcoded.
 281
 282 =cut
 283
 284 sub pw_set {
 285
 286   # ASCII alphabet, minus easily confused stuff (l, o, O, 0, 1)
 287   # and plus some "safe" punctuation
 288   split('',
 289     'abcdefghijkmnpqrstuvwxyzABCDEFGHIJKLMNPQRSTUVWXYZ23456789#.,[]-_=+'
 290   );
 291
 292 }
 293
 294 =back
 295
 296 =head1 SEE ALSO
 297
 298 L<FS::password_history>
 299
 300 =cut
 301
 302 1;