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