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