'namespace' => 'FS::ClientAPI::MyAccount',
} );
-#false laziness w/FS::ClientAPI::passwd::passwd (needs to handle encrypted pw)
+#false laziness w/FS::ClientAPI::passwd::passwd
sub login {
my $p = shift;
my $svc_domain = qsearchs('svc_domain', { 'domain' => $p->{'domain'} } )
- or return { error => "Domain not found" };
-
- my $svc_acct =
- ( length($p->{'password'}) < 13
- && qsearchs( 'svc_acct', { 'username' => $p->{'username'},
- 'domsvc' => $svc_domain->svcnum,
- '_password' => $p->{'password'} } )
- )
- || qsearchs( 'svc_acct', { 'username' => $p->{'username'},
- 'domsvc' => $svc_domain->svcnum,
- '_password' => $p->{'password'} } );
-
- unless ( $svc_acct ) { return { error => 'Incorrect password.' } }
+ or return { error => 'Domain '. $p->{'domain'}. ' not found' };
+
+ my $svc_acct = qsearchs( 'svc_acct', { 'username' => $p->{'username'},
+ 'domsvc' => $svc_domain->svcnum, }
+ );
+ return { error => 'User not found.' } unless $svc_acct;
+ return { error => 'Incorrect password.' }
+ unless $svc_acct->check_password($p->{'password'});
my $session = {
'svcnum' => $svc_acct->svcnum,
my $new_gecos = $packet->{'new_gecos'};
my $new_shell = $packet->{'new_shell'};
-#false laziness w/FS::ClientAPI::MyAccount::login (needs to handle encrypted pw)
- my $svc_acct =
- ( length($old_password) < 13
- && qsearchs( 'svc_acct', { 'username' => $packet->{'username'},
- 'domsvc' => $svc_domain->svcnum,
- '_password' => $old_password } )
- )
- || qsearchs( 'svc_acct', { 'username' => $packet->{'username'},
- 'domsvc' => $svc_domain->svcnum,
- '_password' => $old_password } );
-
- unless ( $svc_acct ) { return { error => 'Incorrect password.' } }
+ #false laziness w/FS::ClientAPI::MyAccount::login
+
+ my $svc_acct = qsearchs( 'svc_acct', { 'username' => $packet->{'username'},
+ 'domsvc' => $svc_domain->svcnum, }
+ );
+ return { error => 'User not found.' } unless $svc_acct;
+ return { error => 'Incorrect password.' }
+ unless $svc_acct->check_password($old_password);
my %hash = $svc_acct->hash;
my $new_svc_acct = new FS::svc_acct ( \%hash );
@saltset @pw_set );
use Carp;
use Fcntl qw(:flock);
+use Crypt::PasswdMD5;
use FS::UID qw( datasrc );
use FS::Conf;
use FS::Record qw( qsearch qsearchs fields dbh dbdef );
new FS::svc_acct \%hash;
}
+=item check_password
+
+Checks the supplied password against the (possibly encrypted) password in the
+database. Returns true for a sucessful authentication, false for no match.
+
+Currently supported encryptions are: classic DES crypt() and MD5
+
+=cut
+
+sub check_password {
+ my($self, $check_password) = @_;
+ #eventually should check a "password-encoding" field
+ if ( length($self->_password) < 13 ) { #plaintext
+ $check_password eq $self->_password;
+ } elsif ( length($self->_password) == 13 ) { #traditional DES crypt
+ crypt($check_password, $self->_password) eq $self->_password;
+ } elsif ( $self->_password =~ /^\$1\$/ ) { #MD5 crypt
+ unix_md5_crypt($check_password, $self->_password) eq $self->_password;
+ } elsif ( $self->_password =~ /^\$2a?\$/ ) { #Blowfish
+ warn "Can't check password: Blowfish encryption not yet supported, svcnum".
+ $self->svcnum. "\n";
+ 0;
+ } else {
+ warn "Can't check password: Unrecognized encryption for svcnum ".
+ $self->svcnum. "\n";
+ 0;
+ }
+
+}
+
=back
=head1 SUBROUTINES
<!-- MyAccounts, maybe only for dev <li><a href="http://search.cpan.org/search?dist=Cache-Cache">Cache::Cache</a> -->
<li><a href="http://search.cpan.org/search?dist=NetAddr-IP">NetAddr-IP</a>
<li><a href="http://search.cpan.org/search?dist=Chart">Chart</a>
+ <li><a href="http://search.cpan.org/search?dist=Crypt-PasswdMD5">Crypt::PasswdMD5</a>
<li><a href="http://search.cpan.org/search?dist=ApacheDBI">Apache::DBI</a> <i>(optional but recommended for better webinterface performance)</i>
</ul>
</ul>
<li>Install <a href="http://search.cpan.org/search?dist=DBD-Pg">DBD::Pg</a> 1.32.
<li>Install <a href="http://search.cpan.org/search?dist=Cache-Cache">Cache::Cache</a>.
<li>Install <a href="http://search.cpan.org/search?dist=Net-SSH">Net::SSH</a> 0.08.
+ <li>Install <a href="http://search.cpan.org/search?dist=Crypt-PasswdMD5">Crypt::PasswdMD5</a>
<li>CGI.pm minimum version 2.47 is required. You will probably need to install a current CGI.pm from CPAN if you are using Perl 5.005 or earlier.
<li>If using Apache::ASP, add <code>PerlSetVar RequestBinaryRead Off</code> to your Apache configuration and make sure you are using Apache::ASP minimum version 2.55.
<li>Run <code>make aspdocs</code> or <code>make masondocs</code>.