proper self-service login supporting plaintext, crypt and MD5 passwords

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

diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm
index 4c943a7..991cedd 100644 (file)
--- 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 );
@@ -33,6 +34,7 @@ use FS::Msgcat qw(gettext);
 @ISA = qw( FS::svc_Common );
 
 $DEBUG = 0;
+#$DEBUG = 1;
 $me = '[FS::svc_acct]';
 
 #ask FS::UID to run this stuff for us later
@@ -176,7 +178,7 @@ Creates a new account.  To add the account to the database, see L<"insert">.
 
 sub table { 'svc_acct'; }
 
-=item insert
+=item insert [ , OPTION => VALUE ... ]
 
 Adds this account to the database.  If there is an error, returns the error,
 otherwise returns false.
@@ -193,15 +195,21 @@ should contain an arrayref of FS::tablename objects.  They will have their
 svcnum fields set and will be inserted after this record, but before any
 exports are run.
 
+Currently available options are: I<depend_jobnum>
+
+If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
+jobnums), all provisioning jobs will have a dependancy on the supplied
+jobnum(s) (they will not run until the specific job(s) complete(s)).
+
 (TODOC: L<FS::queue> and L<freeside-queued>)
 
 (TODOC: new exports!)
 
-
 =cut
 
 sub insert {
   my $self = shift;
+  my %options = @_;
   my $error;
 
   local $SIG{HUP} = 'IGNORE';
@@ -226,7 +234,7 @@ sub insert {
   #                             'domsvc'   => $self->domsvc,
   #                           } );
 
-  if ( $self->svcnum ) {
+  if ( $self->svcnum && qsearchs('cust_svc',{'svcnum'=>$self->svcnum}) ) {
     my $cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum});
     unless ( $cust_svc ) {
       $dbh->rollback if $oldAutoCommit;
@@ -325,7 +333,11 @@ sub insert {
   #see?  i told you it was more complicated
 
   my @jobnums;
-  $error = $self->SUPER::insert(\@jobnums, $self->child_objects || [] );
+  $error = $self->SUPER::insert(
+    'jobnums'       => \@jobnums,
+    'child_objects' => $self->child_objects,
+    %options,
+  );
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
     return $error;
@@ -395,6 +407,22 @@ sub insert {
           return "error queuing welcome email: $error";
         }
 
+        if ( $options{'depend_jobnum'} ) {
+          warn "$me depend_jobnum found; adding to welcome email dependancies"
+            if $DEBUG;
+          if ( ref($options{'depend_jobnum'}) ) {
+            warn "$me adding jobs ". join(', ', @{$options{'depend_jobnum'}} ).
+                 "to welcome email dependancies"
+              if $DEBUG;
+            push @jobnums, @{ $options{'depend_jobnum'} };
+          } else {
+            warn "$me adding job $options{'depend_jobnum'} ".
+                 "to welcome email dependancies"
+              if $DEBUG;
+            push @jobnums, $options{'depend_jobnum'};
+          }
+        }
+
         foreach my $jobnum ( @jobnums ) {
           my $error = $wqueue->depend_insert($jobnum);
           if ( $error ) {
@@ -427,6 +455,8 @@ The corresponding FS::cust_svc record will be deleted as well.
 sub delete {
   my $self = shift;
 
+  return "can't delete system account" if $self->_check_system;
+
   return "Can't delete an account which is a (svc_forward) source!"
     if qsearch( 'svc_forward', { 'srcsvc' => $self->svcnum } );
 
@@ -515,6 +545,8 @@ sub replace {
   my $error;
   warn "$me replacing $old with $new\n" if $DEBUG;
 
+  return "can't modify system account" if $old->_check_system;
+
   return "Username in use"
     if $old->username ne $new->username &&
       qsearchs( 'svc_acct', { 'username' => $new->username,
@@ -614,16 +646,7 @@ Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 
 sub suspend {
   my $self = shift;
-  my %hash = $self->hash;
-  unless ( $hash{_password} =~ /^\*SUSPENDED\* /
-           || $hash{_password} eq '*'
-         ) {
-    $hash{_password} = '*SUSPENDED* '.$hash{_password};
-    my $new = new FS::svc_acct ( \%hash );
-    my $error = $new->replace($self);
-    return $error if $error;
-  }
-
+  return "can't suspend system account" if $self->_check_system;
   $self->SUPER::suspend;
 }
 
@@ -839,6 +862,17 @@ sub check {
   $self->SUPER::check;
 }
 
+=item _check_system
+
+=cut
+
+sub _check_system {
+  my $self = shift;
+  scalar( grep { $self->username eq $_ || $self->email eq $_ }
+               $conf->config('system_usernames')
+        );
+}
+
 =item radius
 
 Depriciated, use radius_reply instead.
@@ -1055,6 +1089,64 @@ sub radius_groups {
   }
 }
 
+=item clone_suspended
+
+Constructor used by FS::part_export::_export_suspend fallback.  Document
+better.
+
+=cut
+
+sub clone_suspended {
+  my $self = shift;
+  my %hash = $self->hash;
+  $hash{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) );
+  new FS::svc_acct \%hash;
+}
+
+=item clone_kludge_unsuspend 
+
+Constructor used by FS::part_export::_export_unsuspend fallback.  Document
+better.
+
+=cut
+
+sub clone_kludge_unsuspend {
+  my $self = shift;
+  my %hash = $self->hash;
+  $hash{_password} = '';
+  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
@@ -1230,6 +1322,9 @@ counterintuitive.
 radius_usergroup_selector?  putting web ui components in here?  they should
 probably live somewhere else...
 
+insertion of RADIUS group stuff in insert could be done with child_objects now
+(would probably clean up export of them too)
+
 =head1 SEE ALSO
 
 L<FS::svc_Common>, edit/part_svc.cgi from an installed web interface,