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