X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fsvc_acct.pm;h=a9cdfb3df73759737542c3442d53027e9ab97b7b;hb=673b9a458d9138523026963df6fa3b4683e09bae;hp=6e4213d02ee45a95452317ba1e7b3f6180971d44;hpb=477cd9f54b609a7a2a94b25544e1e8eb5dda1b67;p=freeside.git

diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm
index 6e4213d02..a9cdfb3df 100644
--- a/FS/FS/svc_acct.pm
+++ b/FS/FS/svc_acct.pm
@@ -6,7 +6,7 @@ use vars qw( @ISA $DEBUG $me $conf $skip_fuzzyfiles
              $usernamemax $passwordmin $passwordmax
              $username_ampersand $username_letter $username_letterfirst
              $username_noperiod $username_nounderscore $username_nodash
-             $username_uppercase
+             $username_uppercase $username_percent
              $password_noampersand $password_noexclamation
              $welcome_template $welcome_from $welcome_subject $welcome_mimetype
              $smtpmachine
@@ -15,6 +15,7 @@ use vars qw( @ISA $DEBUG $me $conf $skip_fuzzyfiles
              @saltset @pw_set );
 use Carp;
 use Fcntl qw(:flock);
+use Date::Format;
 use Crypt::PasswdMD5 1.2;
 use FS::UID qw( datasrc );
 use FS::Conf;
@@ -37,7 +38,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
@@ -56,6 +56,7 @@ $FS::UID::callback{'FS::svc_acct'} = sub {
   $username_nodash = $conf->exists('username-nodash');
   $username_uppercase = $conf->exists('username-uppercase');
   $username_ampersand = $conf->exists('username-ampersand');
+  $username_percent = $conf->exists('username-percent');
   $password_noampersand = $conf->exists('password-noexclamation');
   $password_noexclamation = $conf->exists('password-noexclamation');
   $dirhash = $conf->config('dirhash') || 0;
@@ -466,7 +467,15 @@ sub replace {
   {
     #no warnings 'numeric';  #alas, a 5.006-ism
     local($^W) = 0;
-    return "Can't change uid!" if $old->uid != $new->uid;
+
+    foreach my $xid (qw( uid gid )) {
+
+      return "Can't change $xid!"
+        if ! $conf->exists("svc_acct-edit_$xid")
+           && $old->$xid() != $new->$xid()
+           && $new->cust_svc->part_svc->part_svc_column($xid)->columnflag ne 'F'
+    }
+
   }
 
   #change homdir when we change username
@@ -688,11 +697,11 @@ sub check {
 
   my $ulen = $usernamemax || $self->dbdef_table->column('username')->length;
   if ( $username_uppercase ) {
-    $recref->{username} =~ /^([a-z0-9_\-\.\&]{$usernamemin,$ulen})$/i
+    $recref->{username} =~ /^([a-z0-9_\-\.\&\%]{$usernamemin,$ulen})$/i
       or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username};
     $recref->{username} = $1;
   } else {
-    $recref->{username} =~ /^([a-z0-9_\-\.\&]{$usernamemin,$ulen})$/
+    $recref->{username} =~ /^([a-z0-9_\-\.\&\%]{$usernamemin,$ulen})$/
       or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username};
     $recref->{username} = $1;
   }
@@ -720,6 +729,9 @@ sub check {
   if ( $password_noexclamation ) {
     $recref->{_password} =~ /\!/ and return gettext('illegal_password');
   }
+  unless ( $username_percent ) {
+    $recref->{username} =~ /\%/ and return gettext('illegal_username');
+  }
 
   $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum};
   $recref->{popnum} = $1;
@@ -1008,6 +1020,7 @@ expected to change in the future.
 
 sub radius_reply { 
   my $self = shift;
+
   my %reply =
     map {
       /^(radius_(.*))$/;
@@ -1015,12 +1028,15 @@ sub radius_reply {
       #$attrib =~ s/_/\-/g;
       ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
     } grep { /^radius_/ && $self->getfield($_) } fields( $self->table );
+
   if ( $self->slipip && $self->slipip ne '0e0' ) {
     $reply{$radius_ip} = $self->slipip;
   }
+
   if ( $self->seconds !~ /^$/ ) {
     $reply{'Session-Timeout'} = $self->seconds;
   }
+
   %reply;
 }
 
@@ -1037,16 +1053,25 @@ expected to change in the future.
 
 sub radius_check {
   my $self = shift;
-  my $password = $self->_password;
-  my $pw_attrib = length($password) <= 12 ? $radius_password : 'Crypt-Password';
-  ( $pw_attrib => $password,
+
+  my %check = 
     map {
       /^(rc_(.*))$/;
       my($column, $attrib) = ($1, $2);
       #$attrib =~ s/_/\-/g;
       ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
-    } grep { /^rc_/ && $self->getfield($_) } fields( $self->table )
-  );
+    } grep { /^rc_/ && $self->getfield($_) } fields( $self->table );
+
+  my $password = $self->_password;
+  my $pw_attrib = length($password) <= 12 ? $radius_password : 'Crypt-Password';  $check{$pw_attrib} = $password;
+
+  my $cust_pkg = $self->cust_svc->cust_pkg;
+  if ( $cust_pkg && $cust_pkg->part_pkg->is_prepaid && $cust_pkg->bill ) {
+    $check{'Expiration'} = time2str('%B %e %Y %T', $cust_pkg->bill ); #http://lists.cistron.nl/pipermail/freeradius-users/2005-January/040184.html
+  }
+
+  %check;
+
 }
 
 =item domain
@@ -1083,10 +1108,7 @@ Returns the FS::cust_svc record for this account (see L<FS::cust_svc>).
 
 =cut
 
-sub cust_svc {
-  my $self = shift;
-  qsearchs( 'cust_svc', { 'svcnum' => $self->svcnum } );
-}
+#inherited from svc_Common
 
 =item email
 
@@ -1117,12 +1139,45 @@ sub acct_snarf {
 
 =item decrement_seconds SECONDS
 
-Decrements the I<seconds> field of this record by the given amount.
+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 {
-  my( $self, $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';
@@ -1134,22 +1189,41 @@ sub decrement_seconds {
   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;
+
+  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,
@@ -1327,7 +1401,7 @@ sub crypt_password {
   {
     $self->_password;
   } else {
-    my $encryption = scalar(@_) ? shift : 'crypt';
+    my $encryption = ( scalar(@_) && $_[0] ) ? shift : 'crypt';
     if ( $encryption eq 'crypt' ) {
       crypt(
         $self->_password,