projects / freeside.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
> Order by City might be better
[freeside.git] / FS / FS / svc_acct.pm
diff --git a/FS/FS/svc_acct.pm b/FS/FS/svc_acct.pm
index 558e383..9c95b21 100644 (file)
--- a/FS/FS/svc_acct.pm
+++ b/FS/FS/svc_acct.pm
@@ -2,15 +2,19 @@ package FS::svc_acct;
 
 use strict;
 use vars qw( @ISA $nossh_hack $conf $dir_prefix @shells $usernamemin
 
 use strict;
 use vars qw( @ISA $nossh_hack $conf $dir_prefix @shells $usernamemin
-             $usernamemax $passwordmin
-             $shellmachine @saltset @pw_set);
+             $usernamemax $passwordmin $username_letter $username_letterfirst
+             $shellmachine $useradd $usermod $userdel $mydomain
+             @saltset @pw_set);
 use Carp;
 use FS::Conf;
 use Carp;
 use FS::Conf;
-use FS::Record qw( qsearchs fields );
+use FS::Record qw( qsearch qsearchs fields dbh );
 use FS::svc_Common;
 use FS::svc_Common;
-use FS::SSH qw(ssh);
+use Net::SSH qw(ssh);
 use FS::part_svc;
 use FS::svc_acct_pop;
 use FS::part_svc;
 use FS::svc_acct_pop;
+use FS::svc_acct_sm;
+use FS::cust_main_invoice;
+use FS::svc_domain;
 
 @ISA = qw( FS::svc_Common );
 
 
 @ISA = qw( FS::svc_Common );
 
@@ -23,6 +27,30 @@ $FS::UID::callback{'FS::svc_acct'} = sub {
   $usernamemin = $conf->config('usernamemin') || 2;
   $usernamemax = $conf->config('usernamemax');
   $passwordmin = $conf->config('passwordmin') || 6;
   $usernamemin = $conf->config('usernamemin') || 2;
   $usernamemax = $conf->config('usernamemax');
   $passwordmin = $conf->config('passwordmin') || 6;
+  if ( $shellmachine ) {
+    if ( $conf->exists('shellmachine-useradd') ) {
+      $useradd = join("\n", $conf->config('shellmachine-useradd') )
+                 || 'cp -pr /etc/skel $dir; chown -R $uid.$gid $dir';
+    } else {
+      $useradd = 'useradd -d $dir -m -s $shell -u $uid $username';
+    }
+    if ( $conf->exists('shellmachine-userdel') ) {
+      $userdel = join("\n", $conf->config('shellmachine-userdel') )
+                 || 'rm -rf $dir';
+    } else {
+      $userdel = 'userdel $username';
+    }
+    $usermod = join("\n", $conf->config('shellmachine-usermod') )
+               || '[ -d $old_dir ] && mv $old_dir $new_dir || ( '.
+                    'chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; '.
+                    'find . -depth -print | cpio -pdm $new_dir; '.
+                    'chmod u-t $new_dir; chown -R $uid.$gid $new_dir; '.
+                    'rm -rf $old_dir'.
+                  ')';
+  }
+  $username_letter = $conf->exists('username-letter');
+  $username_letterfirst = $conf->exists('username-letterfirst');
+  $mydomain = $conf->config('domain');
 };
 
 @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
 };
 
 @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
@@ -57,6 +85,10 @@ FS::svc_acct - Object methods for svc_acct records
 
   %hash = $record->radius;
 
 
   %hash = $record->radius;
 
+  %hash = $record->radius_reply;
+
+  %hash = $record->radius_check;
+
 =head1 DESCRIPTION
 
 An FS::svc_acct object represents an account.  FS::svc_acct inherits from
 =head1 DESCRIPTION
 
 An FS::svc_acct object represents an account.  FS::svc_acct inherits from
@@ -88,6 +120,8 @@ FS::svc_Common.  The following fields are currently supported:
 
 =item radius_I<Radius_Attribute> - I<Radius-Attribute>
 
 
 =item radius_I<Radius_Attribute> - I<Radius-Attribute>
 
+=item domsvc - service number of svc_domain with which to associate
+
 =back
 
 =head1 METHODS
 =back
 
 =head1 METHODS
@@ -111,12 +145,21 @@ The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
 defined.  An FS::cust_svc record will be created and inserted.
 
 If the configuration value (see L<FS::Conf>) shellmachine exists, and the 
 defined.  An FS::cust_svc record will be created and inserted.
 
 If the configuration value (see L<FS::Conf>) shellmachine exists, and the 
-username, uid, and dir fields are defined, the command
+username, uid, and dir fields are defined, the command(s) specified in
+the shellmachine-useradd configuration are exectued on shellmachine via ssh.
+This behaviour can be surpressed by setting $FS::svc_acct::nossh_hack true.
+If the shellmachine-useradd configuration file does not exist,
 
   useradd -d $dir -m -s $shell -u $uid $username
 
 
   useradd -d $dir -m -s $shell -u $uid $username
 
-is executed on shellmachine via ssh.  This behaviour can be surpressed by
-setting $FS::svc_acct::nossh_hack true.
+is the default.  If the shellmachine-useradd configuration file exists but
+it empty,
+
+  cp -pr /etc/skel $dir; chown -R $uid.$gid $dir
+
+is the default instead.  Otherwise the contents of the file are treated as
+a double-quoted perl string, with the following variables available:
+$username, $uid, $gid, $dir, and $shell.
 
 =cut
 
 
 =cut
 
@@ -135,10 +178,12 @@ sub insert {
   return $error if $error;
 
   return "Username ". $self->username. " in use"
   return $error if $error;
 
   return "Username ". $self->username. " in use"
-    if qsearchs( 'svc_acct', { 'username' => $self->username } );
+    if qsearchs( 'svc_acct', { 'username' => $self->username,
+                               'domsvc'   => $self->domsvc,
+                             } );
 
   my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
 
   my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
-  return "Unkonwn svcpart" unless $part_svc;
+  return "Unknown svcpart" unless $part_svc;
   return "uid in use"
     if $part_svc->svc_acct__uid_flag ne 'F'
       && qsearchs( 'svc_acct', { 'uid' => $self->uid } )
   return "uid in use"
     if $part_svc->svc_acct__uid_flag ne 'F'
       && qsearchs( 'svc_acct', { 'uid' => $self->uid } )
@@ -148,26 +193,15 @@ sub insert {
   $error = $self->SUPER::insert;
   return $error if $error;
 
   $error = $self->SUPER::insert;
   return $error if $error;
 
-  my ( $username, $uid, $dir, $shell ) = (
+  my( $username, $uid, $gid, $dir, $shell ) = (
     $self->username,
     $self->uid,
     $self->username,
     $self->uid,
+    $self->gid,
     $self->dir,
     $self->shell,
   );
     $self->dir,
     $self->shell,
   );
-  if ( $username 
-       && $uid
-       && $dir
-       && $shellmachine
-       && ! $nossh_hack ) {
-    #one way
-    ssh("root\@$shellmachine",
-        "useradd -d $dir -m -s $shell -u $uid $username"
-    );
-    #another way
-    #ssh("root\@$shellmachine","/bin/mkdir $dir; /bin/chmod 711 $dir; ".
-    #  "/bin/cp -p /etc/skel/.* $dir 2>/dev/null; ".
-    #  "/bin/cp -pR /etc/skel/Maildir $dir 2>/dev/null; ".
-    #  "/bin/chown -R $uid $dir") unless $nossh_hack;
+  if ( $username && $uid && $dir && $shellmachine && ! $nossh_hack ) {
+    ssh("root\@$shellmachine", eval qq("$useradd") );
   }
 
   ''; #no error
   }
 
   ''; #no error
@@ -180,18 +214,41 @@ error, otherwise returns false.
 
 The corresponding FS::cust_svc record will be deleted as well.
 
 
 The corresponding FS::cust_svc record will be deleted as well.
 
-If the configuration value (see L<FS::Conf>) shellmachine exists, the command:
+If the configuration value (see L<FS::Conf>) shellmachine exists, the
+command(s) specified in the shellmachine-userdel configuration file are
+executed on shellmachine via ssh.  This behavior can be surpressed by setting
+$FS::svc_acct::nossh_hack true.  If the shellmachine-userdel configuration
+file does not exist,
 
   userdel $username
 
 
   userdel $username
 
-is executed on shellmachine via ssh.  This behaviour can be surpressed by
-setting $FS::svc_acct::nossh_hack true.
+is the default.  If the shellmachine-userdel configuration file exists but
+is empty,
+
+  rm -rf $dir
+
+is the default instead.  Otherwise the contents of the file are treated as a
+double-quoted perl string, with the following variables available:
+$username and $dir.
 
 =cut
 
 sub delete {
   my $self = shift;
 
 =cut
 
 sub delete {
   my $self = shift;
-  my $error;
+
+  return "Can't delete an account which has (svc_acct_sm) mail aliases!"
+    if $self->uid && qsearch( 'svc_acct_sm', { 'domuid' => $self->uid } );
+
+  return "Can't delete an account which is a (svc_forward) source!"
+    if qsearch( 'svc_forward', { 'srcsvc' => $self->svcnum } );
+
+  return "Can't delete an account which is a (svc_forward) destination!"
+    if qsearch( 'svc_forward', { 'dstsvc' => $self->svcnum } );
+
+  return "Can't delete an account with (svc_www) web service!"
+    if qsearch( 'svc_www', { 'usersvc' => $self->usersvc } );
+
+  # what about records in session ?
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
 
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
@@ -200,12 +257,50 @@ sub delete {
   local $SIG{TSTP} = 'IGNORE';
   local $SIG{PIPE} = 'IGNORE';
 
   local $SIG{TSTP} = 'IGNORE';
   local $SIG{PIPE} = 'IGNORE';
 
-  $error = $self->SUPER::delete;
-  return $error if $error;
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  foreach my $cust_main_invoice (
+    qsearch( 'cust_main_invoice', { 'dest' => $self->svcnum } )
+  ) {
+    my %hash = $cust_main_invoice->hash;
+    $hash{'dest'} = $self->email;
+    my $new = new FS::cust_main_invoice \%hash;
+    my $error = $new->replace($cust_main_invoice);
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+  }
+
+  foreach my $svc_domain (
+    qsearch( 'svc_domain', { 'catchall' => $self->svcnum } )
+  ) {
+    my %hash = new FS::svc_domain->hash;
+    $hash{'catchall'} = '';
+    my $new = new FS::svc_domain \%hash;
+    my $error = $new->replace($svc_domain);
+    if ( $error ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $error;
+    }
+  }
 
 
-  my $username = $self->username;
+  my $error = $self->SUPER::delete;
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+  my( $username, $dir ) = (
+    $self->username,
+    $self->dir,
+  );
   if ( $username && $shellmachine && ! $nossh_hack ) {
   if ( $username && $shellmachine && ! $nossh_hack ) {
-    ssh("root\@$shellmachine","userdel $username");
+    ssh("root\@$shellmachine", eval qq("$userdel") );
   }
 
   '';
   }
 
   '';
@@ -217,11 +312,13 @@ Replaces OLD_RECORD with this one in the database.  If there is an error,
 returns the error, otherwise returns false.
 
 If the configuration value (see L<FS::Conf>) shellmachine exists, and the 
 returns the error, otherwise returns false.
 
 If the configuration value (see L<FS::Conf>) shellmachine exists, and the 
-dir field has changed, the command:
+dir field has changed, the command(s) specified in the shellmachine-usermod
+configuraiton file are executed on shellmachine via ssh.  This behavior can
+be surpressed by setting $FS::svc-acct::nossh_hack true.  If the
+shellmachine-userdel configuration file does not exist or is empty, :
 
 
-  [ -d $old_dir ] && (
+  [ -d $old_dir ] && mv $old_dir $new_dir || (
     chmod u+t $old_dir;
     chmod u+t $old_dir;
-    umask 022;
     mkdir $new_dir;
     cd $old_dir;
     find . -depth -print | cpio -pdm $new_dir;
     mkdir $new_dir;
     cd $old_dir;
     find . -depth -print | cpio -pdm $new_dir;
@@ -258,21 +355,14 @@ sub replace {
   $error = $new->SUPER::replace($old);
   return $error if $error;
 
   $error = $new->SUPER::replace($old);
   return $error if $error;
 
-  my ( $old_dir, $new_dir ) = ( $old->getfield('dir'), $new->getfield('dir') );
-  my ( $uid, $gid) = ( $new->getfield('uid'), $new->getfield('gid') );
-  if ( $old_dir
-       && $new_dir
-       && $old_dir ne $new_dir
-       && ! $nossh_hack
-  ) {
-    ssh("root\@$shellmachine","[ -d $old_dir ] && ".
-                 "( chmod u+t $old_dir; ". #turn off qmail delivery
-                 "umask 022; mkdir $new_dir; cd $old_dir; ".
-                 "find . -depth -print | cpio -pdm $new_dir; ".
-                 "chmod u-t $new_dir; chown -R $uid.$gid $new_dir; ".
-                 "rm -rf $old_dir". 
-                 ")"
-    );
+  my ( $old_dir, $new_dir, $uid, $gid ) = (
+    $old->getfield('dir'),
+    $new->getfield('dir'),
+    $new->getfield('uid'),
+    $new->getfield('gid'),
+  );
+  if ( $old_dir && $new_dir && $old_dir ne $new_dir && ! $nossh_hack ) {
+    ssh("root\@$shellmachine", eval qq("$usermod") );
   }
 
   ''; #no error
   }
 
   ''; #no error
@@ -345,15 +435,24 @@ sub check {
   return $x unless ref($x);
   my $part_svc = $x;
 
   return $x unless ref($x);
   my $part_svc = $x;
 
+  my $error = $self->ut_numbern('svcnum')
+              || $self->ut_number('domsvc')
+  ;
+  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;
   my $ulen = $usernamemax || $self->dbdef_table->column('username')->length;
   $recref->{username} =~ /^([a-z0-9_\-\.]{$usernamemin,$ulen})$/
     or return "Illegal username";
   $recref->{username} = $1;
-  $recref->{username} =~ /[a-z]/ or return "Illegal username";
+  if ( $username_letterfirst ) {
+    $recref->{username} =~ /^[a-z]/ or return "Illegal username";
+  } elsif ( $username_letter ) {
+    $recref->{username} =~ /[a-z]/ or return "Illegal username";
+  }
 
   $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum};
   $recref->{popnum} = $1;
 
   $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum};
   $recref->{popnum} = $1;
-  return "Unkonwn popnum" unless
+  return "Unknown popnum" unless
     ! $recref->{popnum} ||
     qsearchs('svc_acct_pop',{'popnum'=> $recref->{popnum} } );
 
     ! $recref->{popnum} ||
     qsearchs('svc_acct_pop',{'popnum'=> $recref->{popnum} } );
 
@@ -370,8 +469,8 @@ sub check {
     return "Only root can have uid 0"
       if $recref->{uid} == 0 && $recref->{username} ne 'root';
 
     return "Only root can have uid 0"
       if $recref->{uid} == 0 && $recref->{username} ne 'root';
 
-    my($error);
-    return $error if $error=$self->ut_textn('finger');
+    $error = $self->ut_textn('finger');
+    return $error if $error;
 
     $recref->{dir} =~ /^([\/\w\-]*)$/
       or return "Illegal directory";
 
     $recref->{dir} =~ /^([\/\w\-]*)$/
       or return "Illegal directory";
@@ -441,6 +540,8 @@ sub check {
     $recref->{_password} = $1.$3;
   } elsif ( $recref->{_password} eq '*' ) {
     $recref->{_password} = '*';
     $recref->{_password} = $1.$3;
   } elsif ( $recref->{_password} eq '*' ) {
     $recref->{_password} = '*';
+  } elsif ( $recref->{_password} eq '!!' ) {
+    $recref->{_password} = '!!';
   } else {
     return "Illegal password";
   }
   } else {
     return "Illegal password";
   }
@@ -488,7 +589,7 @@ check attributes of this record.
 Accessing RADIUS attributes directly is not supported and will break in the
 future.
 
 Accessing RADIUS attributes directly is not supported and will break in the
 future.
 
-=back
+=cut
 
 sub radius_check {
   my $self = shift;
 
 sub radius_check {
   my $self = shift;
@@ -500,15 +601,43 @@ sub radius_check {
   } grep { /^rc_/ && $self->getfield($_) } fields( $self->table );
 }
 
   } grep { /^rc_/ && $self->getfield($_) } fields( $self->table );
 }
 
+=item domain
+
+Returns the domain associated with this account.
+
+=cut
+
+sub domain {
+  my $self = shift;
+  if ( $self->domsvc ) {
+    my $svc_domain = qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } );
+    $svc_domain->domain;
+  } else {
+    $mydomain or die "svc_acct.domsvc is null and no legacy domain config file";
+  }
+}
+
+=item email
+
+Returns an email address associated with the account.
+
+=cut
+
+sub email {
+  my $self = shift;
+  $self->username. '@'. $self->domain;
+}
+
+=back
+
 =head1 VERSION
 
 =head1 VERSION
 
-$Id: svc_acct.pm,v 1.9 2000-07-06 08:57:27 ivan Exp $
+$Id: svc_acct.pm,v 1.28 2001-08-21 03:03:36 ivan Exp $
 
 =head1 BUGS
 
 
 =head1 BUGS
 
-The remote commands should be configurable.
-
-The bits which ssh should fork before doing so.
+The bits which ssh should fork before doing so (or maybe queue jobs for a
+daemon).
 
 The $recref stuff in sub check should be cleaned up.
 
 
 The $recref stuff in sub check should be cleaned up.
 
@@ -519,7 +648,7 @@ counterintuitive.
 =head1 SEE ALSO
 
 L<FS::svc_Common>, L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>,
 =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::SSH>, L<ssh>, L<FS::svc_acct_pop>,
+L<FS::part_svc>, L<FS::cust_pkg>, L<Net::SSH>, L<ssh>, L<FS::svc_acct_pop>,
 schema.html from the base documentation.
 
 =cut
 schema.html from the base documentation.
 
 =cut
Freeside billing, trouble ticketing, network monitoring and provisioning