X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fsvc_acct.pm;h=4963120622aab218ab719df47809c70f30dfacdd;hb=04cc48bd2a049909af54b9e58afebffe51cdd1b2;hp=267116a5547893d5d54f34f34a94693be5ad712f;hpb=7a1b41c76d4eaa1fdbdda7a1e5d76aab122b207f;p=freeside.git

diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm
index 267116a55..496312062 100644
--- a/FS/FS/svc_acct.pm
+++ b/FS/FS/svc_acct.pm
@@ -15,7 +15,7 @@ use vars qw( @ISA $DEBUG $me $conf $skip_fuzzyfiles
              @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 );
@@ -37,7 +37,6 @@ use FS::svc_www;
 @ISA = qw( FS::svc_Common );
 
 $DEBUG = 0;
-#$DEBUG = 1;
 $me = '[FS::svc_acct]';
 
 #ask FS::UID to run this stuff for us later
@@ -463,11 +462,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;
@@ -1120,6 +1114,93 @@ 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.  If there
+is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub decrement_seconds {
+  shift->_op_seconds('-', @_);
+}
+
+=item increment_seconds SECONDS
+
+Increments the I<seconds> field of this record by the given amount.  If there
+is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub increment_seconds {
+  shift->_op_seconds('+', @_);
+}
+
+
+my %op2action = (
+  '-' => 'suspend',
+  '+' => 'unsuspend',
+);
+my %op2condition = (
+  '-' => sub { my($self, $seconds) = @_;
+               $self->seconds - $seconds <= 0;
+             },
+  '+' => sub { my($self, $seconds) = @_;
+               $self->seconds + $seconds > 0;
+             },
+);
+
+sub _op_seconds {
+  my( $self, $op, $seconds ) = @_;
+  warn "$me _op_seconds called for svcnum ". $self->svcnum.
+       ' ('. $self->email. "): $op $seconds\n"
+    if $DEBUG;
+
+  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 $sql = "UPDATE svc_acct SET seconds = ".
+            " CASE WHEN seconds IS NULL THEN 0 ELSE seconds END ". #$seconds||0
+            " $op ? WHERE svcnum = ?";
+  warn "$me $sql\n"
+    if $DEBUG;
+
+  my $sth = $dbh->prepare( $sql )
+    or die "Error preparing $sql: ". $dbh->errstr;
+  my $rv = $sth->execute($seconds, $self->svcnum);
+  die "Error executing $sql: ". $sth->errstr
+    unless defined($rv);
+  die "Can't update seconds for svcnum". $self->svcnum
+    if $rv == 0;
+
+  my $action = $op2action{$op};
+
+  if ( $conf->exists("svc_acct-usage_$action")
+       && &{$op2condition{$op}}($self, $seconds)    ) {
+    #my $error = $self->$action();
+    my $error = $self->cust_svc->cust_pkg->$action();
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "Error ${action}ing: $error";
+    }
+  }
+
+  warn "$me update sucessful; committing\n"
+    if $DEBUG;
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+  '';
+
+}
+
+
 =item seconds_since TIMESTAMP
 
 Returns the number of seconds this account has been online since TIMESTAMP,
@@ -1273,25 +1354,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";
+    }
   }
 }