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