fix deletion of accounts connected to virtual hosts

[freeside.git] / FS / FS / svc_acct.pm

diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm
index 9ff26b8..0824fbe 100644 (file)
--- a/FS/FS/svc_acct.pm
+++ b/FS/FS/svc_acct.pm
@@ -15,6 +15,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 );
@@ -32,6 +33,8 @@ use FS::radius_usergroup;
 use FS::export_svc;
 use FS::part_export;
 use FS::Msgcat qw(gettext);
+use FS::svc_forward;
+use FS::svc_www;
 
 @ISA = qw( FS::svc_Common );
 
@@ -190,8 +193,7 @@ The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
 defined.  An FS::cust_svc record will be created and inserted.
 
 The additional field I<usergroup> can optionally be defined; if so it should
-contain an arrayref of group names.  See L<FS::radius_usergroup>.  (used in
-sqlradius export only)
+contain an arrayref of group names.  See L<FS::radius_usergroup>.
 
 The additional field I<child_objects> can optionally be defined; if so it
 should contain an arrayref of FS::tablename objects.  They will have their
@@ -472,7 +474,7 @@ sub delete {
     if qsearch( 'svc_forward', { 'dstsvc' => $self->svcnum } );
 
   return "Can't delete an account with (svc_www) web service!"
-    if qsearch( 'svc_www', { 'usersvc' => $self->usersvc } );
+    if qsearch( 'svc_www', { 'usersvc' => $self->svcnum } );
 
   # what about records in session ? (they should refer to history table)
 
@@ -543,8 +545,8 @@ Replaces OLD_RECORD with this one in the database.  If there is an error,
 returns the error, otherwise returns false.
 
 The additional field I<usergroup> can optionally be defined; if so it should
-contain an arrayref of group names.  See L<FS::radius_usergroup>.  (used in
-sqlradius export only)
+contain an arrayref of group names.  See L<FS::radius_usergroup>.
+
 
 =cut
 
@@ -816,6 +818,15 @@ sub check {
 
   #  $error = $self->ut_textn('finger');
   #  return $error if $error;
+  if ( $self->getfield('finger') eq '' ) {
+    my $cust_pkg = $self->svcnum
+      ? $self->cust_svc->cust_pkg
+      : qsearchs('cust_pkg', { 'pkgnum' => $self->getfield('pkgnum') } );
+    if ( $cust_pkg ) {
+      my $cust_main = $cust_pkg->cust_main;
+      $self->setfield('finger', $cust_main->first.' '.$cust_main->get('last') );
+    }
+  }
   $self->getfield('finger') =~
     /^([\w \t\!\@\#\$\%\&\(\)\-\+\;\'\"\,\.\?\/\*\<\>]*)$/
       or return "Illegal finger: ". $self->getfield('finger');
@@ -1135,6 +1146,43 @@ 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) = @_;
+
+  #remove old-style SUSPENDED kludge, they should be allowed to login to
+  #self-service and pay up
+  ( my $password = $self->_password ) =~ s/^\*SUSPENDED\* //;
+
+  #eventually should check a "password-encoding" field
+  if ( $password =~ /^(\*|!!?)$/ ) { #no self-service login
+    return 0;
+  } elsif ( length($password) < 13 ) { #plaintext
+    $check_password eq $password;
+  } elsif ( length($password) == 13 ) { #traditional DES crypt
+    crypt($check_password, $password) eq $password;
+  } elsif ( $password =~ /^\$1\$/ ) { #MD5 crypt
+    unix_md5_crypt($check_password, $password) eq $password;
+  } elsif ( $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