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     warn "unrecognized password encoding '$encoding'; treating as plain text"
 216       unless $encoding eq 'plain';
 217
 218     $auth = $self->_blowfishcrypt( $password );
 219
 220   }
 221
 222   my $password_history = FS::password_history->new({
 223       _password => $auth->as_rfc2307,
 224       created   => time,
 225       $self->password_history_key => $self->get($self->primary_key),
 226   });
 227
 228   my $error = $password_history->insert;
 229   return "recording password history: $error" if $error;
 230   '';
 231
 232 }
 233
 234 =item delete_password_history;
 235
 236 Removes all password history records attached to this object, in preparation
 237 to delete the object.
 238
 239 =cut
 240
 241 sub delete_password_history {
 242   my $self = shift;
 243   my @records = qsearch('password_history', {
 244       $self->password_history_key => $self->get($self->primary_key)
 245   });
 246   my $error = '';
 247   foreach (@records) {
 248     $error ||= $_->delete;
 249   }
 250   return $error . ' (clearing password history)' if $error;
 251   '';
 252 }
 253
 254 =item _blowfishcrypt PASSWORD
 255
 256 For internal use: takes PASSWORD and returns a new
 257 L<Authen::Passphrase::BlowfishCrypt> object representing it.
 258
 259 =cut
 260
 261 sub _blowfishcrypt {
 262   my $class = shift;
 263   my $passphrase = shift;
 264   return Authen::Passphrase::BlowfishCrypt->new(
 265     cost => $BLOWFISH_COST,
 266     salt_random => 1,
 267     passphrase => $passphrase,
 268   );
 269 }
 270
 271 =back
 272
 273 =head1 CLASS METHODS
 274
 275 =over 4
 276
 277 =item pw_set
 278
 279 Returns the list of characters allowed in random passwords (from the
 280 C<password-generated-characters> config).
 281
 282 =cut
 283
 284 sub pw_set {
 285   my $class = shift;
 286   if (!@pw_set) {
 287     my $pw_set = $conf->config('password-generated-characters');
 288     $pw_set =~ s/\s//g; # don't ever allow whitespace
 289     if ( $pw_set =~ /[[:lower:]]/
 290       && $pw_set =~ /[[:upper:]]/
 291       && $pw_set =~ /[[:digit:]]/
 292       && $pw_set =~ /[[:punct:]]/ ) {
 293       @pw_set = split('', $pw_set);
 294     } else {
 295       warn "password-generated-characters set is insufficient; using default.";
 296       @pw_set = split('', 'abcdefghijkmnpqrstuvwxyzABCDEFGHIJKLMNPQRSTUVWXYZ23456789()#.,');
 297     }
 298   }
 299   return @pw_set;
 300 }
 301
 302 =back
 303
 304 =head1 SEE ALSO
 305
 306 L<FS::password_history>
 307
 308 =cut
 309
 310 1;