X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fsvc_acct.pm;h=0340e7cc5de54b48c069557318aad18e0d791d27;hb=b03df92e48df653460cb8b6034a06dd1de6f4095;hp=e52cebf15b6b8c98b4e9c7aaa79c3c14c7461bff;hpb=5477d23b51bd3135893c4d79091a9e272a17f4f8;p=freeside.git

diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm
index e52cebf15..0340e7cc5 100644
--- a/FS/FS/svc_acct.pm
+++ b/FS/FS/svc_acct.pm
@@ -2,17 +2,19 @@ package FS::svc_acct;
 
 use strict;
 use vars qw( @ISA $nossh_hack $conf $dir_prefix @shells $usernamemin
-             $usernamemax $passwordmin $username_letter $username_letterfirst
-             $username_noperiod
+             $usernamemax $passwordmin $passwordmax
+             $username_ampersand $username_letter $username_letterfirst
+             $username_noperiod $username_uppercase
              $shellmachine $useradd $usermod $userdel $mydomain
              $cyrus_server $cyrus_admin_user $cyrus_admin_pass
+             $dirhash
              $icradius_dbh
              @saltset @pw_set);
 use Carp;
 use FS::Conf;
 use FS::Record qw( qsearch qsearchs fields dbh );
 use FS::svc_Common;
-use Net::SSH qw(ssh);
+use Net::SSH;
 use FS::part_svc;
 use FS::svc_acct_pop;
 use FS::svc_acct_sm;
@@ -32,6 +34,7 @@ $FS::UID::callback{'FS::svc_acct'} = sub {
   $usernamemin = $conf->config('usernamemin') || 2;
   $usernamemax = $conf->config('usernamemax');
   $passwordmin = $conf->config('passwordmin') || 6;
+  $passwordmax = $conf->config('passwordmax') || 8;
   if ( $shellmachine ) {
     if ( $conf->exists('shellmachine-useradd') ) {
       $useradd = join("\n", $conf->config('shellmachine-useradd') )
@@ -56,6 +59,8 @@ $FS::UID::callback{'FS::svc_acct'} = sub {
   $username_letter = $conf->exists('username-letter');
   $username_letterfirst = $conf->exists('username-letterfirst');
   $username_noperiod = $conf->exists('username-noperiod');
+  $username_uppercase = $conf->exists('username-uppercase');
+  $username_ampersand = $conf->exists('username-ampersand');
   $mydomain = $conf->config('domain');
   if ( $conf->exists('cyrus') ) {
     ($cyrus_server, $cyrus_admin_user, $cyrus_admin_pass) =
@@ -66,12 +71,19 @@ $FS::UID::callback{'FS::svc_acct'} = sub {
     $cyrus_admin_user = '';
     $cyrus_admin_pass = '';
   }
-  if ( $conf->exists('icradius_secrets') ) {
-    $icradius_dbh = DBI->connect($conf->config('icradius_secrets'))
-      or die $DBI::errstr;
+  if ( $conf->exists('icradiusmachines') ) {
+    if ( $conf->exists('icradius_secrets') ) {
+      #need some sort of late binding so it's only connected to when
+      # actually used, hmm
+      $icradius_dbh = DBI->connect($conf->config('icradius_secrets'))
+        or die $DBI::errstr;
+    } else {
+      $icradius_dbh = dbh;
+    }
   } else {
     $icradius_dbh = '';
   }
+  $dirhash = $conf->config('dirhash') || 0;
 };
 
 @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
@@ -79,6 +91,18 @@ $FS::UID::callback{'FS::svc_acct'} = sub {
 
 #not needed in 5.004 #srand($$|time);
 
+sub _cache {
+  my $self = shift;
+  my ( $hashref, $cache ) = @_;
+  if ( $hashref->{'svc_acct_svcnum'} ) {
+    $self->{'_domsvc'} = FS::svc_domain->new( {
+      'svcnum'   => $hashref->{'domsvc'},
+      'domain'   => $hashref->{'svc_acct_domain'},
+      'catchall' => $hashref->{'svc_acct_catchall'},
+    } );
+  }
+}
+
 =head1 NAME
 
 FS::svc_acct - Object methods for svc_acct records
@@ -238,7 +262,7 @@ sub insert {
     $self->shell,
   );
   if ( $username && $uid && $dir && $shellmachine && ! $nossh_hack ) {
-    my $queue = new FS::queue { 'job' => 'Net::SSH::ssh' };
+    my $queue = new FS::queue { 'job' => 'FS::svc_acct::ssh' };
     $error = $queue->insert("root\@$shellmachine", eval qq("$useradd") );
     if ( $error ) {
       $dbh->rollback if $oldAutoCommit;
@@ -255,15 +279,29 @@ sub insert {
     }
   }
   if ( $icradius_dbh ) {
-    my $queue = new FS::queue { 'job' => 'FS::svc_acct::icradius_rc_insert' };
-    $error = $queue->insert( $self->username,
-                             $self->_password,
-                             $self->radius_check
-                           );
+
+    my $radcheck_queue =
+      new FS::queue { 'job' => 'FS::svc_acct::icradius_rc_insert' };
+    $error = $radcheck_queue->insert( $self->username,
+                                      $self->_password,
+                                      $self->radius_check
+                                    );
     if ( $error ) {
       $dbh->rollback if $oldAutoCommit;
       return "queueing job (transaction rolled back): $error";
     }
+
+    my $radreply_queue =
+      new FS::queue { 'job' => 'FS::svc_acct::icradius_rr_insert' };
+    $error = $radreply_queue->insert( $self->username,
+                                      $self->_password,
+                                      $self->radius_reply
+                                    );
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "queueing job (transaction rolled back): $error";
+    }
+
   }
 
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
@@ -335,6 +373,25 @@ sub icradius_rc_insert {
   1;
 }
 
+sub icradius_rr_insert {
+  my( $username, $password, %radreply ) = @_;
+  
+  foreach my $attribute ( keys %radreply ) {
+    my $sth = $icradius_dbh->prepare(
+      "INSERT INTO radreply ( id, UserName, Attribute, Value ) VALUES ( ".
+      join(", ", map { $icradius_dbh->quote($_) } (
+        '',
+        $username,
+        $attribute,
+        $radreply{$attribute},
+      ) ). " )"
+    );
+    $sth->execute or die "can't insert into radreply table: ". $sth->errstr;
+  }
+
+  1;
+}
+
 =item delete
 
 Deletes this account from the database.  If there is an error, returns the
@@ -397,6 +454,10 @@ sub delete {
   foreach my $cust_main_invoice (
     qsearch( 'cust_main_invoice', { 'dest' => $self->svcnum } )
   ) {
+    unless ( defined($cust_main_invoice) ) {
+      warn "WARNING: something's wrong with qsearch";
+      next;
+    }
     my %hash = $cust_main_invoice->hash;
     $hash{'dest'} = $self->email;
     my $new = new FS::cust_main_invoice \%hash;
@@ -431,7 +492,7 @@ sub delete {
     $self->dir,
   );
   if ( $username && $shellmachine && ! $nossh_hack ) {
-    my $queue = new FS::queue { 'job' => 'Net::SSH::ssh' };
+    my $queue = new FS::queue { 'job' => 'FS::svc_acct::ssh' };
     $error = $queue->insert("root\@$shellmachine", eval qq("$userdel") );
     if ( $error ) {
       $dbh->rollback if $oldAutoCommit;
@@ -449,12 +510,23 @@ sub delete {
     }
   }
   if ( $icradius_dbh ) {
-    my $queue = new FS::queue { 'job' => 'FS::svc_acct::icradius_rc_delete' };
-    $error = $queue->insert( $self->username );
+
+    my $radcheck_queue =
+      new FS::queue { 'job' => 'FS::svc_acct::icradius_rc_delete' };
+    $error = $radcheck_queue->insert( $self->username );
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "queueing job (transaction rolled back): $error";
+    }
+
+    my $radreply_queue =
+      new FS::queue { 'job' => 'FS::svc_acct::icradius_rr_delete' };
+    $error = $radreply_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;
@@ -494,6 +566,18 @@ sub icradius_rc_delete {
   1;
 }
 
+sub icradius_rr_delete {
+  my $username = shift;
+  
+  my $sth = $icradius_dbh->prepare(
+    'DELETE FROM radreply WHERE UserName = ?'
+  );
+  $sth->execute($username)
+    or die "can't delete from radreply table: ". $sth->errstr;
+
+  1;
+}
+
 =item replace OLD_RECORD
 
 Replaces OLD_RECORD with this one in the database.  If there is an error,
@@ -527,9 +611,14 @@ sub replace {
 
   return "Username in use"
     if $old->username ne $new->username &&
-      qsearchs( 'svc_acct', { 'username' => $new->username } );
-
-  return "Can't change uid!" if $old->uid != $new->uid;
+      qsearchs( 'svc_acct', { 'username' => $new->username,
+                               'domsvc'   => $new->domsvc,
+                             } );
+  {
+    #no warnings 'numeric';  #alas, a 5.006-ism
+    local($^W) = 0;
+    return "Can't change uid!" if $old->uid != $new->uid;
+  }
 
   return "can't change username using Cyrus"
     if $cyrus_server && $old->username ne $new->username;
@@ -561,7 +650,7 @@ sub replace {
     $new->getfield('gid'),
   );
   if ( $old_dir && $new_dir && $old_dir ne $new_dir && ! $nossh_hack ) {
-    my $queue = new FS::queue { 'job' => 'Net::SSH::ssh' };
+    my $queue = new FS::queue { 'job' => 'FS::svc_acct::ssh' };
     $error = $queue->insert("root\@$shellmachine", eval qq("$usermod") );
     if ( $error ) {
       $dbh->rollback if $oldAutoCommit;
@@ -569,10 +658,33 @@ sub replace {
     }
   }
 
+  if ( $icradius_dbh ) {
+    my $queue = new FS::queue { 'job' => 'FS::svc_acct::icradius_rc_replace' };
+    $error = $queue->insert( $new->username,
+                             $new->_password,
+                           );
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "queueing job (transaction rolled back): $error";
+    }
+  }
+
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
   ''; #no error
 }
 
+sub icradius_rc_replace {
+  my( $username, $new_password ) = @_;
+ 
+   my $sth = $icradius_dbh->prepare(
+     "UPDATE radcheck SET Value = ? WHERE UserName = ? and Attribute = ?"
+   );
+   $sth->execute($new_password, $username, 'Password' )
+     or die "can't update radcheck table: ". $sth->errstr;
+
+  1;
+}
+
 =item suspend
 
 Suspends this account by prefixing *SUSPENDED* to the password.  If there is an
@@ -585,7 +697,9 @@ Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 sub suspend {
   my $self = shift;
   my %hash = $self->hash;
-  unless ( $hash{_password} =~ /^\*SUSPENDED\* / ) {
+  unless ( $hash{_password} =~ /^\*SUSPENDED\* /
+           || $hash{_password} eq '*'
+         ) {
     $hash{_password} = '*SUSPENDED* '.$hash{_password};
     my $new = new FS::svc_acct ( \%hash );
     $new->replace($self);
@@ -646,9 +760,16 @@ sub check {
   return $error if $error;
 
   my $ulen = $usernamemax || $self->dbdef_table->column('username')->length;
-  $recref->{username} =~ /^([a-z0-9_\-\.]{$usernamemin,$ulen})$/
-    or return "Illegal username";
-  $recref->{username} = $1;
+  if ( $username_uppercase ) {
+    $recref->{username} =~ /^([a-z0-9_\-\.\&]{$usernamemin,$ulen})$/i
+      or return "Illegal username: ". $recref->{username};
+    $recref->{username} = $1;
+  } else {
+    $recref->{username} =~ /^([a-z0-9_\-\.\&]{$usernamemin,$ulen})$/
+      or return "Illegal username: ". $recref->{username};
+    $recref->{username} = $1;
+  }
+
   if ( $username_letterfirst ) {
     $recref->{username} =~ /^[a-z]/ or return "Illegal username";
   } elsif ( $username_letter ) {
@@ -657,6 +778,9 @@ sub check {
   if ( $username_noperiod ) {
     $recref->{username} =~ /\./ and return "Illegal username";
   }
+  unless ( $username_ampersand ) {
+    $recref->{username} =~ /\&/ and return "Illegal username";
+  }
 
   $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum};
   $recref->{popnum} = $1;
@@ -677,15 +801,34 @@ sub check {
     return "Only root can have uid 0"
       if $recref->{uid} == 0 && $recref->{username} ne 'root';
 
-    $error = $self->ut_textn('finger');
-    return $error if $error;
+#    $error = $self->ut_textn('finger');
+#    return $error if $error;
+    $self->getfield('finger') =~
+      /^([\w \t\!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\*\<\>]*)$/
+        or return "Illegal finger: ". $self->getfield('finger');
+    $self->setfield('finger', $1);
 
-    $recref->{dir} =~ /^([\/\w\-]*)$/
+    $recref->{dir} =~ /^([\/\w\-\.\&]*)$/
       or return "Illegal directory";
-    $recref->{dir} = $1 || 
-      $dir_prefix . '/' . $recref->{username}
-      #$dir_prefix . '/' . substr($recref->{username},0,1). '/' . $recref->{username}
+    $recref->{dir} = $1;
+    return "Illegal directory"
+      if $recref->{dir} =~ /(^|\/)\.+(\/|$)/; #no .. component
+    return "Illegal directory"
+      if $recref->{dir} =~ /\&/ && ! $username_ampersand;
+    unless ( $recref->{dir} ) {
+      $recref->{dir} = $dir_prefix . '/';
+      if ( $dirhash > 0 ) {
+        for my $h ( 1 .. $dirhash ) {
+          $recref->{dir} .= substr($recref->{username}, $h-1, 1). '/';
+        }
+      } elsif ( $dirhash < 0 ) {
+        for my $h ( reverse $dirhash .. -1 ) {
+          $recref->{dir} .= substr($recref->{username}, $h, 1). '/';
+        }
+      }
+      $recref->{dir} .= $recref->{username};
     ;
+    }
 
     unless ( $recref->{username} eq 'sync' ) {
       if ( grep $_ eq $recref->{shell}, @shells ) {
@@ -735,7 +878,7 @@ sub check {
     unless ( $recref->{_password} );
 
   #if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,16})$/ ) {
-  if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{$passwordmin,8})$/ ) {
+  if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{$passwordmin,$passwordmax})$/ ) {
     $recref->{_password} = $1.$3;
     #uncomment this to encrypt password immediately upon entry, or run
     #bin/crypt_pw in cron to give new users a window during which their
@@ -751,7 +894,8 @@ sub check {
   } elsif ( $recref->{_password} eq '!!' ) {
     $recref->{_password} = '!!';
   } else {
-    return "Illegal password";
+    #return "Illegal password";
+    return "Illegal password: ". $recref->{_password};
   }
 
   ''; #no error
@@ -781,12 +925,17 @@ expected to change in the future.
 
 sub radius_reply { 
   my $self = shift;
-  map {
-    /^(radius_(.*))$/;
-    my($column, $attrib) = ($1, $2);
-    #$attrib =~ s/_/\-/g;
-    ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
-  } grep { /^radius_/ && $self->getfield($_) } fields( $self->table );
+  my %reply =
+    map {
+      /^(radius_(.*))$/;
+      my($column, $attrib) = ($1, $2);
+      #$attrib =~ s/_/\-/g;
+      ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
+    } grep { /^radius_/ && $self->getfield($_) } fields( $self->table );
+  if ( $self->ip && $self->ip ne '0e0' ) {
+    $reply{'Framed-IP-Address'} = $self->ip;
+  }
+  %reply;
 }
 
 =item radius_check
@@ -818,7 +967,8 @@ Returns the domain associated with this account.
 sub domain {
   my $self = shift;
   if ( $self->domsvc ) {
-    my $svc_domain = qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } )
+    #$self->svc_domain->domain;
+    my $svc_domain = $self->svc_domain
       or die "no svc_domain.svcnum for svc_acct.domsvc ". $self->domsvc;
     $svc_domain->domain;
   } else {
@@ -826,6 +976,20 @@ sub domain {
   }
 }
 
+=item svc_domain
+
+Returns the FS::svc_domain record for this account's domain (see
+L<FS::svc_domain>.
+
+=cut
+
+sub svc_domain {
+  my $self = shift;
+  $self->{'_domsvc'}
+    ? $self->{'_domsvc'}
+    : qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } );
+}
+
 =item email
 
 Returns an email address associated with the account.
@@ -837,11 +1001,39 @@ sub email {
   $self->username. '@'. $self->domain;
 }
 
+=item ssh
+
+=cut
+
+sub ssh {
+  my ( $host, @cmd_and_args ) = @_;
+
+  use IO::File;
+  my $reader = IO::File->new();
+  my $writer = IO::File->new();
+  my $error = IO::File->new();
+
+  &Net::SSH::sshopen3( $host, $reader, $writer, $error, @cmd_and_args) or die $!;
+
+  local $/ = undef;
+  my $output_stream = <$writer>;
+  my $error_stream = <$error>;
+  if ( length $error_stream ) {
+    #warn "[FS::svc_acct::ssh] STDERR $error_stream";
+    die "[FS::svc_acct::ssh] STDERR $error_stream";
+  }
+  if ( length $output_stream ) {
+    warn "[FS::svc_acct::ssh] STDOUT $output_stream";
+  }
+
+#  &Net::SSH::ssh(@args,">>/usr/local/etc/freeside/sshoutput 2>&1");
+}
+
 =back
 
 =head1 VERSION
 
-$Id: svc_acct.pm,v 1.39 2001-09-14 19:54:22 ivan Exp $
+$Id: svc_acct.pm,v 1.63 2002-01-22 14:53:26 ivan Exp $
 
 =head1 BUGS
 
@@ -856,9 +1048,10 @@ counterintuitive.
 
 =head1 SEE ALSO
 
-L<FS::svc_Common>, L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>,
-L<FS::part_svc>, L<FS::cust_pkg>, L<FS::queue>, L<freeside-queued>),
-L<Net::SSH>, L<ssh>, L<FS::svc_acct_pop>,
+L<FS::svc_Common>, edit/part_svc.cgi from an installed web interface,
+export.html from the base documentation, L<FS::Record>, L<FS::Conf>,
+L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, L<FS::queue>,
+L<freeside-queued>), L<Net::SSH>, L<ssh>, L<FS::svc_acct_pop>,
 schema.html from the base documentation.
 
 =cut