fix quick crypt_password bug when its passwd an empty param
[freeside.git] / FS / FS / svc_acct.pm
index 35596e3..a045193 100644 (file)
@@ -1,7 +1,7 @@
 package FS::svc_acct;
 
 use strict;
-use vars qw( @ISA $DEBUG $me $conf
+use vars qw( @ISA $DEBUG $me $conf $skip_fuzzyfiles
              $dir_prefix @shells $usernamemin
              $usernamemax $passwordmin $passwordmax
              $username_ampersand $username_letter $username_letterfirst
@@ -15,7 +15,7 @@ use vars qw( @ISA $DEBUG $me $conf
              @saltset @pw_set );
 use Carp;
 use Fcntl qw(:flock);
-use Crypt::PasswdMD5;
+use Crypt::PasswdMD5 1.2;
 use FS::UID qw( datasrc );
 use FS::Conf;
 use FS::Record qw( qsearch qsearchs fields dbh dbdef );
@@ -167,7 +167,9 @@ FS::svc_Common.  The following fields are currently supported:
 
 =item domsvc - svcnum from svc_domain
 
-=item radius_I<Radius_Attribute> - I<Radius-Attribute>
+=item radius_I<Radius_Attribute> - I<Radius-Attribute> (reply)
+
+=item rc_I<Radius_Attribute> - I<Radius-Attribute> (check)
 
 =back
 
@@ -197,7 +199,10 @@ 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.
+exports are run.  Each element of the array can also optionally be a
+two-element array reference containing the child object and the name of an
+alternate field to be filled in with the newly-inserted svcnum, for example
+C<[ $svc_forward, 'srcsvc' ]>
 
 Currently available options are: I<depend_jobnum>
 
@@ -271,15 +276,12 @@ sub insert {
     }
   }
 
-  #false laziness with sub replace (and cust_main)
-  my $queue = new FS::queue {
-    'svcnum' => $self->svcnum,
-    'job'    => 'FS::svc_acct::append_fuzzyfiles'
-  };
-  $error = $queue->insert($self->username);
-  if ( $error ) {
-    $dbh->rollback if $oldAutoCommit;
-    return "queueing job (transaction rolled back): $error";
+  unless ( $skip_fuzzyfiles ) {
+    $error = $self->queue_fuzzyfiles_update;
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "updating fuzzy search cache: $error";
+    }
   }
 
   my $cust_pkg = $self->cust_svc->cust_pkg;
@@ -296,7 +298,7 @@ sub insert {
     #welcome email
     my $to = '';
     if ( $welcome_template && $cust_pkg ) {
-      my $to = join(', ', grep { $_ ne 'POST' } $cust_main->invoicing_list );
+      my $to = join(', ', grep { $_ !~ /^(POST|FAX)$/ } $cust_main->invoicing_list );
       if ( $to ) {
         my $wqueue = new FS::queue {
           'svcnum' => $self->svcnum,
@@ -461,11 +463,6 @@ sub replace {
 
   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,
-                               'domsvc'   => $new->domsvc,
-                             } );
   {
     #no warnings 'numeric';  #alas, a 5.006-ism
     local($^W) = 0;
@@ -541,16 +538,11 @@ sub replace {
     return $error if $error;
   }
 
-  if ( $new->username ne $old->username ) {
-    #false laziness with sub insert (and cust_main)
-    my $queue = new FS::queue {
-      'svcnum' => $new->svcnum,
-      'job'    => 'FS::svc_acct::append_fuzzyfiles'
-    };
-    $error = $queue->insert($new->username);
+  if ( $new->username ne $old->username && ! $skip_fuzzyfiles ) {
+    $error = $new->queue_fuzzyfiles_update;
     if ( $error ) {
       $dbh->rollback if $oldAutoCommit;
-      return "queueing job (transaction rolled back): $error";
+      return "updating fuzzy search cache: $error";
     }
   }
 
@@ -558,6 +550,42 @@ sub replace {
   ''; #no error
 }
 
+=item queue_fuzzyfiles_update
+
+Used by insert & replace to update the fuzzy search cache
+
+=cut
+
+sub queue_fuzzyfiles_update {
+  my $self = shift;
+
+  local $SIG{HUP} = 'IGNORE';
+  local $SIG{INT} = 'IGNORE';
+  local $SIG{QUIT} = 'IGNORE';
+  local $SIG{TERM} = 'IGNORE';
+  local $SIG{TSTP} = 'IGNORE';
+  local $SIG{PIPE} = 'IGNORE';
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  my $queue = new FS::queue {
+    'svcnum' => $self->svcnum,
+    'job'    => 'FS::svc_acct::append_fuzzyfiles'
+  };
+  my $error = $queue->insert($self->username);
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return "queueing job (transaction rolled back): $error";
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+  '';
+
+}
+
+
 =item suspend
 
 Suspends this account by calling export-specific suspend hooks.  If there is
@@ -867,7 +895,7 @@ sub _check_duplicate {
     return 'unknown svcpart '. $self->svcpart;
   }
 
-  my $global_unique = $conf->config('global_unique-username');
+  my $global_unique = $conf->config('global_unique-username') || 'none';
 
   my @dup_user = grep { !$self->svcnum || $_->svcnum != $self->svcnum }
                  qsearch( 'svc_acct', { 'username' => $self->username } );
@@ -990,6 +1018,9 @@ sub radius_reply {
   if ( $self->slipip && $self->slipip ne '0e0' ) {
     $reply{$radius_ip} = $self->slipip;
   }
+  if ( $self->seconds !~ /^$/ ) {
+    $reply{'Session-Timeout'} = $self->seconds;
+  }
   %reply;
 }
 
@@ -1084,6 +1115,41 @@ sub acct_snarf {
   qsearch('acct_snarf', { 'svcnum' => $self->svcnum } );
 }
 
+=item decrement_seconds SECONDS
+
+Decrements the I<seconds> field of this record by the given amount.
+
+=cut
+
+sub decrement_seconds {
+  my( $self, $seconds ) = @_;
+
+  local $SIG{HUP} = 'IGNORE';
+  local $SIG{INT} = 'IGNORE';
+  local $SIG{QUIT} = 'IGNORE';
+  local $SIG{TERM} = 'IGNORE';
+  local $SIG{TSTP} = 'IGNORE';
+  local $SIG{PIPE} = 'IGNORE';
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+  
+  my $sth = dbh->prepare(
+    'UPDATE svc_acct SET seconds = seconds - ? WHERE svcnum = ?'
+  ) or die dbh->errstr;;
+  $sth->execute($seconds, $self->svcnum) or die $sth->errstr;
+  if ( $conf->exists('svc_acct-usage_suspend')
+       && $self->seconds - $seconds <= 0       ) {
+    #my $error = $self->suspend;
+    my $error = $self->cust_svc->cust_pkg->suspend;
+    die $error if $error;
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+}
+
 =item seconds_since TIMESTAMP
 
 Returns the number of seconds this account has been online since TIMESTAMP,
@@ -1237,25 +1303,43 @@ sub check_password {
 
 }
 
-=item crypt_password
+=item crypt_password [ DEFAULT_ENCRYPTION_TYPE ]
 
 Returns an encrypted password, either by passing through an encrypted password
 in the database or by encrypting a plaintext password from the database.
 
+The optional DEFAULT_ENCRYPTION_TYPE parameter can be set to I<crypt> (classic
+UNIX DES crypt), I<md5> (md5 crypt supported by most modern Linux and BSD
+distrubtions), or (eventually) I<blowfish> (blowfish hashing supported by
+OpenBSD, SuSE, other Linux distibutions with pam_unix2, etc.).  The default
+encryption type is only used if the password is not already encrypted in the
+database.
+
 =cut
 
 sub crypt_password {
   my $self = shift;
-  #false laziness w/shellcommands.pm
   #eventually should check a "password-encoding" field
   if ( length($self->_password) == 13
-       || $self->_password =~ /^\$(1|2a?)\$/ ) {
+       || $self->_password =~ /^\$(1|2a?)\$/
+       || $self->_password =~ /^(\*|NP|\*LK\*|!!?)$/
+     )
+  {
     $self->_password;
   } else {
-    crypt(
-      $self->_password,
-      $saltset[int(rand(64))].$saltset[int(rand(64))]
-    );
+    my $encryption = ( scalar(@_) && $_[0] ) ? shift : 'crypt';
+    if ( $encryption eq 'crypt' ) {
+      crypt(
+        $self->_password,
+        $saltset[int(rand(64))].$saltset[int(rand(64))]
+      );
+    } elsif ( $encryption eq 'md5' ) {
+      unix_md5_crypt( $self->_password );
+    } elsif ( $encryption eq 'blowfish' ) {
+      die "unknown encryption method $encryption";
+    } else {
+      die "unknown encryption method $encryption";
+    }
   }
 }