remove ugly workaround for Params::Classify bug, #32456
[freeside.git] / 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
10 our $DEBUG = 1;
11 our $conf;
12 FS::UID->install_callback( sub {
13     $conf = FS::Conf->new;
14     # this is safe
15     #eval "use Authen::Passphrase::BlowfishCrypt;";
16 });
17
18 our $me = '[' . __PACKAGE__ . ']';
19
20 our $BLOWFISH_COST = 10;
21
22 =head1 NAME
23
24 FS::Password_Mixin - Object methods for accounts that have passwords governed
25 by the password policy.
26
27 =head1 METHODS
28
29 =over 4
30
31 =item is_password_allowed PASSWORD
32
33 Checks the password against the system password policy. Returns an error
34 message on failure, an empty string on success.
35
36 This MUST NOT be called from check(). It should be called by the office UI,
37 self-service ClientAPI, or other I<user-interactive> code that processes a
38 password change, and only if the user has taken some action with the intent
39 of changing the password.
40
41 =cut
42
43 sub is_password_allowed {
44   my $self = shift;
45   my $password = shift;
46
47   # check length and complexity here
48
49   if ( $conf->config('password-no_reuse') =~ /^(\d+)$/ ) {
50
51     my $no_reuse = $1;
52
53     # "the last N" passwords includes the current password and the N-1
54     # passwords before that.
55     warn "$me checking password reuse limit of $no_reuse\n" if $DEBUG;
56     my @latest = qsearch({
57         'table'     => 'password_history',
58         'hashref'   => { $self->password_history_key => $self->get($self->primary_key) },
59         'order_by'  => " ORDER BY created DESC LIMIT $no_reuse",
60     });
61
62     # don't check the first one; reusing the current password is allowed.
63     shift @latest;
64
65     foreach my $history (@latest) {
66       warn "$me previous password created ".$history->created."\n" if $DEBUG;
67       if ( $history->password_equals($password) ) {
68         my $message;
69         if ( $no_reuse == 1 ) {
70           $message = "This password is the same as your previous password.";
71         } else {
72           $message = "This password was one of the last $no_reuse passwords on this account.";
73         }
74         return $message;
75       }
76     } #foreach $history
77
78   } # end of no_reuse checking
79
80   '';
81 }
82
83 =item password_history_key
84
85 Returns the name of the field in L<FS::password_history> that's the foreign
86 key to this table.
87
88 =cut
89
90 sub password_history_key {
91   my $self = shift;
92   $self->table . '__' . $self->primary_key;
93 }
94
95 =item insert_password_history
96
97 Creates a L<FS::password_history> record linked to this object, with its
98 current password.
99
100 =cut
101
102 sub insert_password_history {
103   my $self = shift;
104   my $encoding = $self->_password_encoding;
105   my $password = $self->_password;
106   my $auth;
107
108   if ( $encoding eq 'bcrypt' or $encoding eq 'crypt' ) {
109
110     # it's smart enough to figure this out
111     $auth = Authen::Passphrase->from_crypt($password);
112
113   } elsif ( $encoding eq 'ldap' ) {
114
115     $password =~ s/^{PLAIN}/{CLEARTEXT}/i; # normalize
116     $auth = Authen::Passphrase->from_rfc2307($password);
117     if ( $auth->isa('Authen::Passphrase::Clear') ) {
118       # then we've been given the password in cleartext
119       $auth = $self->_blowfishcrypt( $auth->passphrase );
120     }
121   
122   } elsif ( $encoding eq 'plain' ) {
123
124     $auth = $self->_blowfishcrypt( $password );
125
126   }
127
128   my $password_history = FS::password_history->new({
129       _password => $auth->as_rfc2307,
130       created   => time,
131       $self->password_history_key => $self->get($self->primary_key),
132   });
133
134   my $error = $password_history->insert;
135   return "recording password history: $error" if $error;
136   '';
137
138 }
139
140 =item _blowfishcrypt PASSWORD
141
142 For internal use: takes PASSWORD and returns a new
143 L<Authen::Passphrase::BlowfishCrypt> object representing it.
144
145 =cut
146
147 sub _blowfishcrypt {
148   my $class = shift;
149   my $passphrase = shift;
150   return Authen::Passphrase::BlowfishCrypt->new(
151     cost => $BLOWFISH_COST,
152     salt_random => 1,
153     passphrase => $passphrase,
154   );
155 }
156
157 =back
158
159 =head1 SEE ALSO
160
161 L<FS::password_history>
162
163 =cut
164
165 1;