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