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->cust_main;
  51
  52   # workaround for non-inserted services
  53   if ( !$cust_main and $self->get('pkgnum') ) {
  54     my $cust_pkg = FS::cust_pkg->by_key($self->get('pkgnum'));
  55     $cust_main = $cust_pkg->cust_main if $cust_pkg;
  56   }
  57   # selfservice signup invokes this without customer, but it checks this conf separately
  58   warn "is_password_allowed: no customer could be identified" if !$cust_main;
  59   return '' if $cust_main && $conf->config_bool('password-insecure', $cust_main->agentnum);
  60
  61   # basic checks using Data::Password;
  62   # options for Data::Password
  63   $DICTIONARY = 0;   # minimum length of disallowed words, false value disables dictionary checking
  64   $MINLEN = $conf->config('passwordmin') || 6;
  65   $MAXLEN = $conf->config('passwordmax') || 8;
  66   $GROUPS = 4;       # must have all 4 'character groups': numbers, symbols, uppercase, lowercase
  67   # other options use the defaults listed below:
  68   # $FOLLOWING = 3;    # disallows more than 3 chars in a row, by alphabet or keyboard (ie abcd or asdf)
  69   # $SKIPCHAR = undef; # set to true to skip checking for bad characters
  70   # # lists of disallowed words
  71   # @DICTIONARIES = qw( /usr/share/dict/web2 /usr/share/dict/words /usr/share/dict/linux.words );
  72
  73   # first, no dictionary checking but require 4 char groups
  74   my $error = IsBadPassword($password);
  75
  76   # but they can get away with 3 char groups, so long as they're not using a word
  77   if ($error eq 'contains less than 4 character groups') {
  78     $DICTIONARY = 4; # default from Data::Password is 5
  79     $GROUPS = 3;
  80     $error = IsBadPassword($password);
  81     # take note--we never actually report dictionary word errors;
  82     # 4 char groups is the rule, 3 char groups and no dictionary words is an acceptable exception
  83     $error = 'should contain at least one each of numbers, symbols, lowercase and uppercase letters'
  84       if $error;
  85   }
  86
  87   # maybe also at some point add an exception for any passwords of sufficient length,
  88   # see https://xkcd.com/936/
  89
  90   $error = 'Invalid password - ' . $error if $error;
  91   return $error if $error;
  92
  93   #check against service fields
  94   $error = $self->password_svc_check($password);
  95   return $error if $error;
  96
  97   return '' unless $self->get($self->primary_key); # for validating new passwords pre-insert
  98
  99   #check against customer fields
 100   if ($cust_main) {
 101     my @words;
 102     # words from cust_main
 103     foreach my $field ( qw( last first daytime night fax mobile ) ) {
 104         push @words, split(/\W/,$cust_main->get($field));
 105     }
 106     # words from cust_location
 107     foreach my $loc ($cust_main->cust_location) {
 108       foreach my $field ( qw(address1 address2 city county state zip) ) {
 109         push @words, split(/\W/,$loc->get($field));
 110       }
 111     }
 112     # do the actual checking
 113     foreach my $word (@words) {
 114       next unless length($word) > 2;
 115       if ($password =~ /$word/i) {
 116         return qq(Password contains account information '$word');
 117       }
 118     }
 119   }
 120
 121   if ( $conf->config('password-no_reuse') =~ /^(\d+)$/ ) {
 122
 123     my $no_reuse = $1;
 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     if ($encoding and $encoding ne 'plain') {
 216       warn "unrecognized password encoding '$encoding'; treating as plain text";
 217     }
 218
 219     $auth = $self->_blowfishcrypt( $password );
 220
 221   }
 222
 223   my $password_history = FS::password_history->new({
 224       _password => $auth->as_rfc2307,
 225       created   => time,
 226       $self->password_history_key => $self->get($self->primary_key),
 227   });
 228
 229   my $error = $password_history->insert;
 230   return "recording password history: $error" if $error;
 231   '';
 232
 233 }
 234
 235 =item delete_password_history;
 236
 237 Removes all password history records attached to this object, in preparation
 238 to delete the object.
 239
 240 =cut
 241
 242 sub delete_password_history {
 243   my $self = shift;
 244   my @records = qsearch('password_history', {
 245       $self->password_history_key => $self->get($self->primary_key)
 246   });
 247   my $error = '';
 248   foreach (@records) {
 249     $error ||= $_->delete;
 250   }
 251   return $error . ' (clearing password history)' if $error;
 252   '';
 253 }
 254
 255 =item _blowfishcrypt PASSWORD
 256
 257 For internal use: takes PASSWORD and returns a new
 258 L<Authen::Passphrase::BlowfishCrypt> object representing it.
 259
 260 =cut
 261
 262 sub _blowfishcrypt {
 263   my $class = shift;
 264   my $passphrase = shift;
 265   return Authen::Passphrase::BlowfishCrypt->new(
 266     cost => $BLOWFISH_COST,
 267     salt_random => 1,
 268     passphrase => $passphrase,
 269   );
 270 }
 271
 272 =back
 273
 274 =head1 CLASS METHODS
 275
 276 =over 4
 277
 278 =item pw_set
 279
 280 Returns the list of characters allowed in random passwords (from the
 281 C<password-generated-characters> config).
 282
 283 =cut
 284
 285 sub pw_set {
 286   my $class = shift;
 287   if (!@pw_set) {
 288     my $pw_set = $conf->config('password-generated-characters');
 289     $pw_set =~ s/\s//g; # don't ever allow whitespace
 290     if ( $pw_set =~ /[[:lower:]]/
 291       && $pw_set =~ /[[:upper:]]/
 292       && $pw_set =~ /[[:digit:]]/
 293       && $pw_set =~ /[[:punct:]]/ ) {
 294       @pw_set = split('', $pw_set);
 295     } else {
 296       warn "password-generated-characters set is insufficient; using default.";
 297       @pw_set = split('', 'abcdefghijkmnpqrstuvwxyzABCDEFGHIJKLMNPQRSTUVWXYZ23456789()#.,');
 298     }
 299   }
 300   return @pw_set;
 301 }
 302
 303 =back
 304
 305 =head1 SEE ALSO
 306
 307 L<FS::password_history>
 308
 309 =cut
 310
 311 1;