proper self-service login supporting plaintext, crypt and MD5 passwords
[freeside.git] / FS / FS / svc_acct.pm
index f849556..991cedd 100644 (file)
@@ -14,9 +14,10 @@ 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 );
+use FS::Record qw( qsearch qsearchs fields dbh dbdef );
 use FS::svc_Common;
 use FS::cust_svc;
 use FS::part_svc;
@@ -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.
@@ -188,6 +190,17 @@ 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)
 
+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
+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!)
@@ -196,6 +209,7 @@ sqlradius export only)
 
 sub insert {
   my $self = shift;
+  my %options = @_;
   my $error;
 
   local $SIG{HUP} = 'IGNORE';
@@ -220,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;
@@ -319,7 +333,11 @@ sub insert {
   #see?  i told you it was more complicated
 
   my @jobnums;
-  $error = $self->SUPER::insert(\@jobnums);
+  $error = $self->SUPER::insert(
+    'jobnums'       => \@jobnums,
+    'child_objects' => $self->child_objects,
+    %options,
+  );
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
     return $error;
@@ -389,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 ) {
@@ -421,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 } );
 
@@ -509,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,
@@ -599,39 +637,26 @@ sub replace {
 
 =item suspend
 
-Suspends this account by prefixing *SUSPENDED* to the password.  If there is an
-error, returns the error, otherwise returns false.
+Suspends this account by calling export-specific suspend hooks.  If there is
+an error, returns the error, otherwise returns false.
 
 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 
-Calls any export-specific suspend hooks.
-
 =cut
 
 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;
 }
 
 =item unsuspend
 
-Unsuspends this account by removing *SUSPENDED* from the password.  If there is
-an error, returns the error, otherwise returns false.
+Unsuspends this account by by calling export-specific suspend hooks.  If there
+is an error, returns the error, otherwise returns false.
 
 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 
-Calls any export-specific unsuspend hooks.
-
 =cut
 
 sub unsuspend {
@@ -784,7 +809,7 @@ sub check {
       or return "Illegal finger: ". $self->getfield('finger');
   $self->setfield('finger', $1);
 
-  $recref->{quota} =~ /^(\d*)$/ or return "Illegal quota";
+  $recref->{quota} =~ /^(\w*)$/ or return "Illegal quota";
   $recref->{quota} = $1;
 
   unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) {
@@ -823,6 +848,8 @@ sub check {
     $recref->{_password} = $1.$3;
   } elsif ( $recref->{_password} eq '*' ) {
     $recref->{_password} = '*';
+  } elsif ( $recref->{_password} eq '!' ) {
+    $recref->{_password} = '!';
   } elsif ( $recref->{_password} eq '!!' ) {
     $recref->{_password} = '!!';
   } else {
@@ -835,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.
@@ -947,6 +985,22 @@ sub email {
   $self->username. '@'. $self->domain;
 }
 
+=item acct_snarf
+
+Returns an array of FS::acct_snarf records associated with the account.
+If the acct_snarf table does not exist or there are no associated records,
+an empty list is returned
+
+=cut
+
+sub acct_snarf {
+  my $self = shift;
+  return () unless dbdef->table('acct_snarf');
+  eval "use FS::acct_snarf;";
+  die $@ if $@;
+  qsearch('acct_snarf', { 'svcnum' => $self->svcnum } );
+}
+
 =item seconds_since TIMESTAMP
 
 Returns the number of seconds this account has been online since TIMESTAMP,
@@ -1005,6 +1059,18 @@ sub attribute_since_sqlradacct {
   $self->cust_svc->attribute_since_sqlradacct(@_);
 }
 
+=item get_session_history_sqlradacct TIMESTAMP_START TIMESTAMP_END
+
+Returns an array of hash references of this customers login history for the
+given time range.  (document this better)
+
+=cut
+
+sub get_session_history_sqlradacct {
+  my $self = shift;
+  $self->cust_svc->get_session_history_sqlradacct(@_);
+}
+
 =item radius_groups
 
 Returns all RADIUS groups for this account (see L<FS::radius_usergroup>).
@@ -1023,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
@@ -1198,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,