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