make RADIUS password exports _password_encoding-aware so we export Password-With...

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

diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm
index f26b210..41fe1ea 100644 (file)
--- a/FS/FS/svc_acct.pm
+++ b/FS/FS/svc_acct.pm
@@ -14,6 +14,7 @@ use vars qw( @ISA $DEBUG $me $conf $skip_fuzzyfiles
              $radius_password $radius_ip
              $dirhash
              @saltset @pw_set );
+use Scalar::Util qw( blessed );
 use Carp;
 use Fcntl qw(:flock);
 use Date::Format;
@@ -368,15 +369,6 @@ sub _lastlog {
          ' ('. $self->email. "): $time\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 last_log$op = ? WHERE svcnum = ?";
@@ -391,9 +383,6 @@ sub _lastlog {
     die "Can't update last_log$op for svcnum". $self->svcnum
       if $rv == 0;
 
-    warn "$me update successful; committing\n"
-      if $DEBUG;
-    $dbh->commit or die $dbh->errstr if $oldAutoCommit;
     $self->{'Hash'}->{"last_log$op"} = $time;
   }else{
     $self->getfield("last_log$op");
@@ -746,14 +735,15 @@ contain an arrayref of group names.  See L<FS::radius_usergroup>.
 =cut
 
 sub replace {
-  my ( $new, $old ) = ( shift, shift );
-  my $error;
+  my $new = shift;
+
+  my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
+              ? shift
+              : $new->replace_old;
+
   warn "$me replacing $old with $new\n" if $DEBUG;
 
-  # We absolutely have to have an old vs. new record to make this work.
-  if (!defined($old)) {
-    $old = qsearchs( 'svc_acct', { 'svcnum' => $new->svcnum } );
-  }
+  my $error;
 
   return "can't modify system account" if $old->_check_system;
 
@@ -1150,7 +1140,7 @@ sub check {
       $recref->{_password} = $1.$2;
 
     } else {
-      return 'Illegal (crypt-encoded) password';
+      return 'Illegal (crypt-encoded) password: '. $recref->{_password};
     }
 
   } elsif ( $recref->{_password_encoding} eq 'plain' ) { 
@@ -1331,7 +1321,8 @@ sub _check_duplicate {
     foreach my $dup_user ( @dup_user ) {
       my $dup_svcpart = $dup_user->cust_svc->svcpart;
       if ( exists($conflict_user_svcpart{$dup_svcpart}) ) {
-        return "duplicate username: conflicts with svcnum ". $dup_user->svcnum.
+        return "duplicate username ". $self->username.
+               ": conflicts with svcnum ". $dup_user->svcnum.
                " via exportnum ". $conflict_user_svcpart{$dup_svcpart};
       }
     }
@@ -1339,9 +1330,9 @@ sub _check_duplicate {
     foreach my $dup_userdomain ( @dup_userdomain ) {
       my $dup_svcpart = $dup_userdomain->cust_svc->svcpart;
       if ( exists($conflict_userdomain_svcpart{$dup_svcpart}) ) {
-        return "duplicate username\@domain: conflicts with svcnum ".
-               $dup_userdomain->svcnum. " via exportnum ".
-               $conflict_userdomain_svcpart{$dup_svcpart};
+        return "duplicate username\@domain ". $self->email.
+               ": conflicts with svcnum ". $dup_userdomain->svcnum.
+               " via exportnum ". $conflict_userdomain_svcpart{$dup_svcpart};
       }
     }
 
@@ -1349,9 +1340,11 @@ sub _check_duplicate {
       my $dup_svcpart = $dup_uid->cust_svc->svcpart;
       if ( exists($conflict_user_svcpart{$dup_svcpart})
            || exists($conflict_userdomain_svcpart{$dup_svcpart}) ) {
-        return "duplicate uid: conflicts with svcnum ". $dup_uid->svcnum.
-               " via exportnum ". $conflict_user_svcpart{$dup_svcpart}
-                                 || $conflict_userdomain_svcpart{$dup_svcpart};
+        return "duplicate uid ". $self->uid.
+               ": conflicts with svcnum ". $dup_uid->svcnum.
+               " via exportnum ".
+               ( $conflict_user_svcpart{$dup_svcpart}
+                 || $conflict_userdomain_svcpart{$dup_svcpart} );
       }
     }
 
@@ -1433,8 +1426,9 @@ sub radius_check {
       ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
     } 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($pw_attrib, $password) = $self->radius_password;
+  $check{$pw_attrib} = $password;
 
   my $cust_svc = $self->cust_svc;
   die "FATAL: no cust_svc record for svc_acct.svcnum ". $self->svcnum. "\n"
@@ -1448,6 +1442,42 @@ sub radius_check {
 
 }
 
+=item radius_password 
+
+Returns a key/value pair containing the RADIUS attribute name and value
+for the password.
+
+=cut
+
+sub radius_password {
+  my $self = shift;
+
+  my($pw_attrib, $password);
+  if ( $self->_password_encoding eq 'ldap' ) {
+
+     $pw_attrib = 'Password-With-Header';
+     $password = $self->_password;
+
+  } elsif ( $self->_password_encoding eq 'crypt' ) {
+
+    $pw_attrib = 'Crypt-Password';
+    $password = $self->_password;
+
+  } elsif ( $self->_password_encoding eq 'plain' ) {
+
+    $pw_attrib = $radius_password; #Cleartext-Password?  man rlm_pap
+
+  } else {
+
+    $pw_attrib = length($password) <= 12 ? $radius_password : 'Crypt-Password';
+    $password = $self->_password;
+
+  }
+
+  ($pw_attrib, $password);
+
+}
+
 =item snapshot
 
 This method instructs the object to "snapshot" or freeze RADIUS check and