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   warn "is_password_allowed: no customer could be identified" if !$cust_main;
  58   return '' if $cust_main && $conf->config_bool('password-insecure', $cust_main->agentnum);
  59
  60   # basic checks using Data::Password;
  61   # options for Data::Password
  62   $DICTIONARY = 4;   # minimum length of disallowed words
  63   $MINLEN = $conf->config('passwordmin') || 6;
  64   $MAXLEN = $conf->config('passwordmax') || 8;
  65   $GROUPS = 4;       # must have all 4 'character groups': numbers, symbols, uppercase, lowercase
  66   # other options use the defaults listed below:
  67   # $FOLLOWING = 3;    # disallows more than 3 chars in a row, by alphabet or keyboard (ie abcd or asdf)
  68   # $SKIPCHAR = undef; # set to true to skip checking for bad characters
  69   # # lists of disallowed words
  70   # @DICTIONARIES = qw( /usr/share/dict/web2 /usr/share/dict/words /usr/share/dict/linux.words );
  71
  72   my $error = IsBadPassword($password);
  73   $error = 'must contain at least one each of numbers, symbols, and lowercase and uppercase letters'
  74     if $error eq 'contains less than 4 character groups'; # avoid confusion
  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   if ($cust_main) {
  86     my @words;
  87     # words from cust_main
  88     foreach my $field ( qw( last first daytime night fax mobile ) ) {
  89         push @words, split(/\W/,$cust_main->get($field));
  90     }
  91     # words from cust_location
  92     foreach my $loc ($cust_main->cust_location) {
  93       foreach my $field ( qw(address1 address2 city county state zip) ) {
  94         push @words, split(/\W/,$loc->get($field));
  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   if ( $conf->config('password-no_reuse') =~ /^(\d+)$/ ) {
 107
 108     my $no_reuse = $1;
 109
 110     # "the last N" passwords includes the current password and the N-1
 111     # passwords before that.
 112     warn "$me checking password reuse limit of $no_reuse\n" if $DEBUG;
 113     my @latest = qsearch({
 114         'table'     => 'password_history',
 115         'hashref'   => { $self->password_history_key => $self->get($self->primary_key) },
 116         'order_by'  => " ORDER BY created DESC LIMIT $no_reuse",
 117     });
 118
 119     # don't check the first one; reusing the current password is allowed.
 120     shift @latest;
 121
 122     foreach my $history (@latest) {
 123       warn "$me previous password created ".$history->created."\n" if $DEBUG;
 124       if ( $history->password_equals($password) ) {
 125         my $message;
 126         if ( $no_reuse == 1 ) {
 127           $message = "This password is the same as your previous password.";
 128         } else {
 129           $message = "This password was one of the last $no_reuse passwords on this account.";
 130         }
 131         return $message;
 132       }
 133     } #foreach $history
 134
 135   } # end of no_reuse checking
 136
 137   '';
 138 }
 139
 140 =item password_svc_check
 141
 142 Override to run additional service-specific password checks.
 143
 144 =cut
 145
 146 sub password_svc_check {
 147   my ($self, $password) = @_;
 148   return '';
 149 }
 150
 151 =item password_history_key
 152
 153 Returns the name of the field in L<FS::password_history> that's the foreign
 154 key to this table.
 155
 156 =cut
 157
 158 sub password_history_key {
 159   my $self = shift;
 160   $self->table . '__' . $self->primary_key;
 161 }
 162
 163 =item insert_password_history
 164
 165 Creates a L<FS::password_history> record linked to this object, with its
 166 current password.
 167
 168 =cut
 169
 170 sub insert_password_history {
 171   my $self = shift;
 172   my $encoding = $self->_password_encoding;
 173   my $password = $self->_password;
 174   my $auth;
 175
 176   if ( $encoding eq 'bcrypt' ) {
 177     # our format, used for contact and access_user passwords
 178     my ($cost, $salt, $hash) = split(',', $password);
 179     $auth = Authen::Passphrase::BlowfishCrypt->new(
 180       cost        => $cost,
 181       salt_base64 => $salt,
 182       hash_base64 => $hash,
 183     );
 184
 185   } elsif ( $encoding eq 'crypt' ) {
 186
 187     # it's smart enough to figure this out
 188     $auth = Authen::Passphrase->from_crypt($password);
 189
 190   } elsif ( $encoding eq 'ldap' ) {
 191
 192     $password =~ s/^{PLAIN}/{CLEARTEXT}/i; # normalize
 193     $auth = Authen::Passphrase->from_rfc2307($password);
 194     if ( $auth->isa('Authen::Passphrase::Clear') ) {
 195       # then we've been given the password in cleartext
 196       $auth = $self->_blowfishcrypt( $auth->passphrase );
 197     }
 198
 199   } else {
 200     warn "unrecognized password encoding '$encoding'; treating as plain text"
 201       unless $encoding eq 'plain';
 202
 203     $auth = $self->_blowfishcrypt( $password );
 204
 205   }
 206
 207   my $password_history = FS::password_history->new({
 208       _password => $auth->as_rfc2307,
 209       created   => time,
 210       $self->password_history_key => $self->get($self->primary_key),
 211   });
 212
 213   my $error = $password_history->insert;
 214   return "recording password history: $error" if $error;
 215   '';
 216
 217 }
 218
 219 =item delete_password_history;
 220
 221 Removes all password history records attached to this object, in preparation
 222 to delete the object.
 223
 224 =cut
 225
 226 sub delete_password_history {
 227   my $self = shift;
 228   my @records = qsearch('password_history', {
 229       $self->password_history_key => $self->get($self->primary_key)
 230   });
 231   my $error = '';
 232   foreach (@records) {
 233     $error ||= $_->delete;
 234   }
 235   return $error . ' (clearing password history)' if $error;
 236   '';
 237 }
 238
 239 =item _blowfishcrypt PASSWORD
 240
 241 For internal use: takes PASSWORD and returns a new
 242 L<Authen::Passphrase::BlowfishCrypt> object representing it.
 243
 244 =cut
 245
 246 sub _blowfishcrypt {
 247   my $class = shift;
 248   my $passphrase = shift;
 249   return Authen::Passphrase::BlowfishCrypt->new(
 250     cost => $BLOWFISH_COST,
 251     salt_random => 1,
 252     passphrase => $passphrase,
 253   );
 254 }
 255
 256 =back
 257
 258 =head1 CLASS METHODS
 259
 260 =over 4
 261
 262 =item pw_set
 263
 264 Returns the list of characters allowed in random passwords (from the
 265 C<password-generated-characters> config).
 266
 267 =cut
 268
 269 sub pw_set {
 270   my $class = shift;
 271   if (!@pw_set) {
 272     my $pw_set = $conf->config('password-generated-characters');
 273     $pw_set =~ s/\s//g; # don't ever allow whitespace
 274     if ( $pw_set =~ /[[:lower:]]/
 275       && $pw_set =~ /[[:upper:]]/
 276       && $pw_set =~ /[[:digit:]]/
 277       && $pw_set =~ /[[:punct:]]/ ) {
 278       @pw_set = split('', $pw_set);
 279     } else {
 280       warn "password-generated-characters set is insufficient; using default.";
 281       @pw_set = split('', 'abcdefghijkmnpqrstuvwxyzABCDEFGHIJKLMNPQRSTUVWXYZ23456789()#.,');
 282     }
 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;