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 4ea7734..991cedd 100644 (file)
--- a/FS/FS/svc_acct.pm
+++ b/FS/FS/svc_acct.pm
@@ -14,9 +14,10 @@ use vars qw( @ISA $DEBUG $me $conf
              @saltset @pw_set );
 use Carp;
 use Fcntl qw(:flock);
              @saltset @pw_set );
 use Carp;
 use Fcntl qw(:flock);

+use Crypt::PasswdMD5;

 use FS::UID qw( datasrc );
 use FS::Conf;
 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;
 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;
 @ISA = qw( FS::svc_Common );
 
 $DEBUG = 0;

+#$DEBUG = 1;

 $me = '[FS::svc_acct]';
 
 #ask FS::UID to run this stuff for us later
 $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'; }
 
 
 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.
 
 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.
 
 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!)
 
 (TODOC: L<FS::queue> and L<freeside-queued>)
 
 (TODOC: new exports!)
 

-

 =cut
 
 sub insert {
   my $self = shift;
 =cut
 
 sub insert {
   my $self = shift;

+  my %options = @_;

   my $error;
 
   local $SIG{HUP} = 'IGNORE';
   my $error;
 
   local $SIG{HUP} = 'IGNORE';


@@ -226,7 +234,7 @@ sub insert {
   #                             'domsvc'   => $self->domsvc,
   #                           } );
 
   #                             '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;
     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;
   #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;
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
     return $error;


@@ -395,6 +407,22 @@ sub insert {
           return "error queuing welcome email: $error";
         }
 
           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 ) {
         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;
 
 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 } );
 
   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;
 
   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,
   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;
 
 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;
 }
 
   $self->SUPER::suspend;
 }
 


@@ -786,7 +809,7 @@ sub check {
       or return "Illegal finger: ". $self->getfield('finger');
   $self->setfield('finger', $1);
 
       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' ) {
   $recref->{quota} = $1;
 
   unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) {


@@ -839,6 +862,17 @@ sub check {
   $self->SUPER::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.
 =item radius
 
 Depriciated, use radius_reply instead.


@@ -951,6 +985,22 @@ sub email {
   $self->username. '@'. $self->domain;
 }
 
   $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,
 =item seconds_since TIMESTAMP
 
 Returns the number of seconds this account has been online since TIMESTAMP,


@@ -1039,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
 =back
 
 =head1 SUBROUTINES


@@ -1214,6 +1322,9 @@ counterintuitive.
 radius_usergroup_selector?  putting web ui components in here?  they should
 probably live somewhere else...
 
 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,
 =head1 SEE ALSO
 
 L<FS::svc_Common>, edit/part_svc.cgi from an installed web interface,