acquire a database lock to prevent race conditions in duplicate checking

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

diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm
index e49c2eb..da3571e 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);
              @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 );
 use FS::UID qw( datasrc );
 use FS::Conf;
 use FS::Record qw( qsearch qsearchs fields dbh dbdef );


@@ -32,10 +33,13 @@ use FS::radius_usergroup;
 use FS::export_svc;
 use FS::part_export;
 use FS::Msgcat qw(gettext);
 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 );
 
 $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


@@ -180,7 +184,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.


@@ -189,23 +193,28 @@ 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
 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
 svcnum fields set and will be inserted after this record, but before any
 exports are run.
 
 
 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!)
 

-

 =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';


@@ -240,7 +249,14 @@ sub insert {
     $self->svcpart($cust_svc->svcpart);
   }
 
     $self->svcpart($cust_svc->svcpart);
   }
 

-  #new duplicate username checking
+  #new duplicate username/username@domain/uid checking
+
+  #this is Pg-specific.  what to do for mysql etc?
+  # ( mysql LOCK TABLES certainly isn't equivalent or useful here :/ )
+  warn "$me locking svc_acct table for duplicate search" if $DEBUG;
+  dbh->do("LOCK TABLE svc_acct IN SHARE ROW EXCLUSIVE MODE")
+    or die dbh->errstr;
+  warn "$me acquired svc_acct table lock for duplicate search" if $DEBUG;

 
   my $part_svc = qsearchs('part_svc', { 'svcpart' => $self->svcpart } );
   unless ( $part_svc ) {
 
   my $part_svc = qsearchs('part_svc', { 'svcpart' => $self->svcpart } );
   unless ( $part_svc ) {


@@ -267,8 +283,7 @@ sub insert {
     foreach my $part_export ( $part_svc->part_export ) {
 
       #this will catch to the same exact export
     foreach my $part_export ( $part_svc->part_export ) {
 
       #this will catch to the same exact export

-      my @svcparts = map { $_->svcpart }
-        qsearch('export_svc', { 'exportnum' => $part_export->exportnum });
+      my @svcparts = map { $_->svcpart } $part_export->export_svc;

 
       #this will catch to exports w/same exporthost+type ???
       #my @other_part_export = qsearch('part_export', {
 
       #this will catch to exports w/same exporthost+type ???
       #my @other_part_export = qsearch('part_export', {


@@ -329,7 +344,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;


@@ -399,6 +418,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 ) {


@@ -445,7 +480,7 @@ sub delete {
     if qsearch( 'svc_forward', { 'dstsvc' => $self->svcnum } );
 
   return "Can't delete an account with (svc_www) web service!"
     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)
 
 
   # what about records in session ? (they should refer to history table)
 


@@ -516,8 +551,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
 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
 
 
 =cut
 


@@ -789,6 +824,15 @@ sub check {
 
   #  $error = $self->ut_textn('finger');
   #  return $error if $error;
 
   #  $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');
   $self->getfield('finger') =~
     /^([\w \t\!\@\#\$\%\&\(\)\-\+\;\'\"\,\.\?\/\*\<\>]*)$/
       or return "Illegal finger: ". $self->getfield('finger');


@@ -1108,6 +1152,43 @@ sub clone_kludge_unsuspend {
   new FS::svc_acct \%hash;
 }
 
   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
 =back
 
 =head1 SUBROUTINES


@@ -1291,6 +1372,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,