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 changing 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') || 8;
  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   my $no_reuse = 3;
  71   # allow override here if we really must
  72
  73   if ( $no_reuse > 0 ) {
  74
  75     # "the last N" passwords includes the current password and the N-1
  76     # passwords before that.
  77     warn "$me checking password reuse limit of $no_reuse\n" if $DEBUG;
  78     my @latest = qsearch({
  79         'table'     => 'password_history',
  80         'hashref'   => { $self->password_history_key => $self->get($self->primary_key) },
  81         'order_by'  => " ORDER BY created DESC LIMIT $no_reuse",
  82     });
  83
  84     # don't check the first one; reusing the current password is allowed.
  85     shift @latest;
  86
  87     foreach my $history (@latest) {
  88       warn "$me previous password created ".$history->created."\n" if $DEBUG;
  89       if ( $history->password_equals($password) ) {
  90         my $message;
  91         if ( $no_reuse == 1 ) {
  92           $message = "This password is the same as your previous password.";
  93         } else {
  94           $message = "This password was one of the last $no_reuse passwords on this account.";
  95         }
  96         return $message;
  97       }
  98     } #foreach $history
  99
 100   } # end of no_reuse checking
 101
 102   '';
 103 }
 104
 105 =item password_svc_check
 106
 107 Override to run additional service-specific password checks.
 108
 109 =cut
 110
 111 sub password_svc_check {
 112   my ($self, $password) = @_;
 113   return '';
 114 }
 115
 116 =item password_history_key
 117
 118 Returns the name of the field in L<FS::password_history> that's the foreign
 119 key to this table.
 120
 121 =cut
 122
 123 sub password_history_key {
 124   my $self = shift;
 125   $self->table . '__' . $self->primary_key;
 126 }
 127
 128 =item insert_password_history
 129
 130 Creates a L<FS::password_history> record linked to this object, with its
 131 current password.
 132
 133 =cut
 134
 135 sub insert_password_history {
 136   my $self = shift;
 137   my $encoding = $self->_password_encoding;
 138   my $password = $self->_password;
 139   my $auth;
 140
 141   if ( $encoding eq 'bcrypt' ) {
 142     # our format, used for contact and access_user passwords
 143     my ($cost, $salt, $hash) = split(',', $password);
 144     $auth = Authen::Passphrase::BlowfishCrypt->new(
 145       cost        => $cost,
 146       salt_base64 => $salt,
 147       hash_base64 => $hash,
 148     );
 149
 150   } elsif ( $encoding eq 'crypt' ) {
 151
 152     # it's smart enough to figure this out
 153     $auth = Authen::Passphrase->from_crypt($password);
 154
 155   } elsif ( $encoding eq 'ldap' ) {
 156
 157     $password =~ s/^{PLAIN}/{CLEARTEXT}/i; # normalize
 158     $auth = Authen::Passphrase->from_rfc2307($password);
 159     if ( $auth->isa('Authen::Passphrase::Clear') ) {
 160       # then we've been given the password in cleartext
 161       $auth = $self->_blowfishcrypt( $auth->passphrase );
 162     }
 163
 164   } else {
 165     warn "unrecognized password encoding '$encoding'; treating as plain text"
 166       unless $encoding eq 'plain';
 167
 168     $auth = $self->_blowfishcrypt( $password );
 169
 170   }
 171
 172   my $password_history = FS::password_history->new({
 173       _password => $auth->as_rfc2307,
 174       created   => time,
 175       $self->password_history_key => $self->get($self->primary_key),
 176   });
 177
 178   my $error = $password_history->insert;
 179   return "recording password history: $error" if $error;
 180   '';
 181
 182 }
 183
 184 =item _blowfishcrypt PASSWORD
 185
 186 For internal use: takes PASSWORD and returns a new
 187 L<Authen::Passphrase::BlowfishCrypt> object representing it.
 188
 189 =cut
 190
 191 sub _blowfishcrypt {
 192   my $class = shift;
 193   my $passphrase = shift;
 194   return Authen::Passphrase::BlowfishCrypt->new(
 195     cost => $BLOWFISH_COST,
 196     salt_random => 1,
 197     passphrase => $passphrase,
 198   );
 199 }
 200
 201 =back
 202
 203 =head1 SEE ALSO
 204
 205 L<FS::password_history>
 206
 207 =cut
 208
 209 1;