From 72a65ceaa28155e8c1c3c1328dd76587b35e089a Mon Sep 17 00:00:00 2001 From: ivan Date: Wed, 17 Mar 2004 21:47:56 +0000 Subject: [PATCH] proper self-service login supporting plaintext, crypt and MD5 passwords --- FS/FS/ClientAPI/MyAccount.pm | 23 +++++++++-------------- FS/FS/ClientAPI/passwd.pm | 20 ++++++++------------ FS/FS/svc_acct.pm | 31 +++++++++++++++++++++++++++++++ httemplate/docs/install.html | 1 + httemplate/docs/upgrade-1.4.2.html | 1 + 5 files changed, 50 insertions(+), 26 deletions(-) diff --git a/FS/FS/ClientAPI/MyAccount.pm b/FS/FS/ClientAPI/MyAccount.pm index 445f0ece8..a865a22d5 100644 --- a/FS/FS/ClientAPI/MyAccount.pm +++ b/FS/FS/ClientAPI/MyAccount.pm @@ -44,24 +44,19 @@ my $cache = new Cache::SharedMemoryCache( { '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, diff --git a/FS/FS/ClientAPI/passwd.pm b/FS/FS/ClientAPI/passwd.pm index 016ebff79..96110ef3a 100644 --- a/FS/FS/ClientAPI/passwd.pm +++ b/FS/FS/ClientAPI/passwd.pm @@ -24,18 +24,14 @@ sub passwd { 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 ); diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm index d84240f36..991cedd21 100644 --- a/FS/FS/svc_acct.pm +++ b/FS/FS/svc_acct.pm @@ -14,6 +14,7 @@ use vars qw( @ISA $DEBUG $me $conf @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 ); @@ -1116,6 +1117,36 @@ sub clone_kludge_unsuspend { 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 diff --git a/httemplate/docs/install.html b/httemplate/docs/install.html index ed306f2d3..0217c9085 100644 --- a/httemplate/docs/install.html +++ b/httemplate/docs/install.html @@ -56,6 +56,7 @@ Before installing, you need:
  • NetAddr-IP
  • Chart +
  • Crypt::PasswdMD5
  • Apache::DBI (optional but recommended for better webinterface performance) diff --git a/httemplate/docs/upgrade-1.4.2.html b/httemplate/docs/upgrade-1.4.2.html index 3c9ac9c6d..b8c5fcf7e 100644 --- a/httemplate/docs/upgrade-1.4.2.html +++ b/httemplate/docs/upgrade-1.4.2.html @@ -13,6 +13,7 @@
  • Install DBD::Pg 1.32.
  • Install Cache::Cache.
  • Install Net::SSH 0.08. +
  • Install Crypt::PasswdMD5
  • 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.
  • If using Apache::ASP, add PerlSetVar RequestBinaryRead Off to your Apache configuration and make sure you are using Apache::ASP minimum version 2.55.
  • Run make aspdocs or make masondocs. -- 2.11.0