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 = 4;   # minimum length of disallowed words
  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   my $error = IsBadPassword($password);
  74   $error = 'must contain at least one each of numbers, symbols, and lowercase and uppercase letters'
  75     if $error eq 'contains less than 4 character groups'; # avoid confusion
  76   $error = 'Invalid password - ' . $error if $error;
  77   return $error if $error;
  78
  79   #check against service fields
  80   $error = $self->password_svc_check($password);
  81   return $error if $error;
  82
  83   return '' unless $self->get($self->primary_key); # for validating new passwords pre-insert
  84
  85   #check against customer fields
  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     # do the actual checking
  99     foreach my $word (@words) {
 100       next unless length($word) > 2;
 101       if ($password =~ /$word/i) {
 102         return qq(Password contains account information '$word');
 103       }
 104     }
 105   }
 106
 107   if ( $conf->config('password-no_reuse') =~ /^(\d+)$/ ) {
 108
 109     my $no_reuse = $1;
 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     } else {
 281       warn "password-generated-characters set is insufficient; using default.";
 282       @pw_set = split('', 'abcdefghijkmnpqrstuvwxyzABCDEFGHIJKLMNPQRSTUVWXYZ23456789()#.,');
 283     }
 284   }
 285   return @pw_set;
 286 }
 287
 288 =back
 289
 290 =head1 SEE ALSO
 291
 292 L<FS::password_history>
 293
 294 =cut
 295
 296 1;