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 0ee7a72..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.


@@ -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)
 
 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!)
 (TODOC: L<FS::queue> and L<freeside-queued>)
 
 (TODOC: new exports!)


@@ -196,6 +209,7 @@ sqlradius export only)
 
 sub insert {
   my $self = shift;
 
 sub insert {
   my $self = shift;

+  my %options = @_;

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


@@ -220,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;


@@ -319,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);
+  $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;


@@ -389,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 ) {


@@ -421,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 } );
 


@@ -509,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,


@@ -599,39 +637,26 @@ sub replace {
 
 =item suspend
 
 
 =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>).
 
 
 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;
 =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
 
   $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>).
 
 
 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 

-Calls any export-specific unsuspend hooks.
-

 =cut
 
 sub unsuspend {
 =cut
 
 sub unsuspend {


@@ -784,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' ) {


@@ -819,10 +844,12 @@ sub check {
     #$recref->{password} = $1.
     #  crypt($3,$saltset[int(rand(64))].$saltset[int(rand(64))]
     #;
     #$recref->{password} = $1.
     #  crypt($3,$saltset[int(rand(64))].$saltset[int(rand(64))]
     #;

-  } elsif ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([\w\.\/\$\;\+]{13,34})$/ ) {
+  } elsif ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([\w\.\/\$\;\+]{13,60})$/ ) {

     $recref->{_password} = $1.$3;
   } elsif ( $recref->{_password} eq '*' ) {
     $recref->{_password} = '*';
     $recref->{_password} = $1.$3;
   } elsif ( $recref->{_password} eq '*' ) {
     $recref->{_password} = '*';

+  } elsif ( $recref->{_password} eq '!' ) {
+    $recref->{_password} = '!';

   } elsif ( $recref->{_password} eq '!!' ) {
     $recref->{_password} = '!!';
   } else {
   } elsif ( $recref->{_password} eq '!!' ) {
     $recref->{_password} = '!!';
   } else {


@@ -835,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.


@@ -947,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,


@@ -1005,6 +1059,18 @@ sub attribute_since_sqlradacct {
   $self->cust_svc->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>).
 =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
 =back
 
 =head1 SUBROUTINES


@@ -1198,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,