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