FS/FS/svc_acct.pm

   1 package FS::svc_acct;
   2
   3 use strict;
   4 use vars qw( @ISA $nossh_hack $conf $dir_prefix @shells $usernamemin
   5              $usernamemax $passwordmin $username_letter $username_letterfirst
   6              $shellmachine $useradd $usermod $userdel
   7              @saltset @pw_set);
   8 use Carp;
   9 use FS::Conf;
  10 use FS::Record qw( qsearch qsearchs fields );
  11 use FS::svc_Common;
  12 use Net::SSH qw(ssh);
  13 use FS::part_svc;
  14 use FS::svc_acct_pop;
  15 use FS::svc_acct_sm;
  16
  17 @ISA = qw( FS::svc_Common );
  18
  19 #ask FS::UID to run this stuff for us later
  20 $FS::UID::callback{'FS::svc_acct'} = sub {
  21   $conf = new FS::Conf;
  22   $dir_prefix = $conf->config('home');
  23   @shells = $conf->config('shells');
  24   $shellmachine = $conf->config('shellmachine');
  25   $usernamemin = $conf->config('usernamemin') || 2;
  26   $usernamemax = $conf->config('usernamemax');
  27   $passwordmin = $conf->config('passwordmin') || 6;
  28   if ( $shellmachine ) {
  29     if ( $conf->exists('shellmachine-useradd') ) {
  30       $useradd = join("\n", $conf->config('shellmachine-useradd') )
  31                  || 'cp -pr /etc/skel $dir; chown -R $uid.$gid $dir';
  32     } else {
  33       $useradd = 'useradd -d $dir -m -s $shell -u $uid $username';
  34     }
  35     if ( $conf->exists('shellmachine-userdel') ) {
  36       $userdel = join("\n", $conf->config('shellmachine-userdel') )
  37                  || 'rm -rf $dir';
  38     } else {
  39       $userdel = 'userdel $username';
  40     }
  41     $usermod = join("\n", $conf->config('shellmachine-usermod') )
  42                || '[ -d $old_dir ] && mv $old_dir $new_dir || ( '.
  43                     'chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; '.
  44                     'find . -depth -print | cpio -pdm $new_dir; '.
  45                     'chmod u-t $new_dir; chown -R $uid.$gid $new_dir; '.
  46                     'rm -rf $old_dir'.
  47                   ')';
  48   }
  49   $username_letter = $conf->exists('username-letter');
  50   $username_letterfirst = $conf->exists('username-letterfirst');
  51 };
  52
  53 @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
  54 @pw_set = ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '!', '.', ',' );
  55
  56 #not needed in 5.004 #srand($$|time);
  57
  58 =head1 NAME
  59
  60 FS::svc_acct - Object methods for svc_acct records
  61
  62 =head1 SYNOPSIS
  63
  64   use FS::svc_acct;
  65
  66   $record = new FS::svc_acct \%hash;
  67   $record = new FS::svc_acct { 'column' => 'value' };
  68
  69   $error = $record->insert;
  70
  71   $error = $new_record->replace($old_record);
  72
  73   $error = $record->delete;
  74
  75   $error = $record->check;
  76
  77   $error = $record->suspend;
  78
  79   $error = $record->unsuspend;
  80
  81   $error = $record->cancel;
  82
  83   %hash = $record->radius;
  84
  85   %hash = $record->radius_reply;
  86
  87   %hash = $record->radius_check;
  88
  89 =head1 DESCRIPTION
  90
  91 An FS::svc_acct object represents an account.  FS::svc_acct inherits from
  92 FS::svc_Common.  The following fields are currently supported:
  93
  94 =over 4
  95
  96 =item svcnum - primary key (assigned automatcially for new accounts)
  97
  98 =item username
  99
 100 =item _password - generated if blank
 101
 102 =item popnum - Point of presence (see L<FS::svc_acct_pop>)
 103
 104 =item uid
 105
 106 =item gid
 107
 108 =item finger - GECOS
 109
 110 =item dir - set automatically if blank (and uid is not)
 111
 112 =item shell
 113
 114 =item quota - (unimplementd)
 115
 116 =item slipip - IP address
 117
 118 =item radius_I<Radius_Attribute> - I<Radius-Attribute>
 119
 120 =item domsvc - service number of svc_domain with which to associate
 121
 122 =back
 123
 124 =head1 METHODS
 125
 126 =over 4
 127
 128 =item new HASHREF
 129
 130 Creates a new account.  To add the account to the database, see L<"insert">.
 131
 132 =cut
 133
 134 sub table { 'svc_acct'; }
 135
 136 =item insert
 137
 138 Adds this account to the database.  If there is an error, returns the error,
 139 otherwise returns false.
 140
 141 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
 142 defined.  An FS::cust_svc record will be created and inserted.
 143
 144 If the configuration value (see L<FS::Conf>) shellmachine exists, and the
 145 username, uid, and dir fields are defined, the command(s) specified in
 146 the shellmachine-useradd configuration are exectued on shellmachine via ssh.
 147 This behaviour can be surpressed by setting $FS::svc_acct::nossh_hack true.
 148 If the shellmachine-useradd configuration file does not exist,
 149
 150   useradd -d $dir -m -s $shell -u $uid $username
 151
 152 is the default.  If the shellmachine-useradd configuration file exists but
 153 it empty,
 154
 155   cp -pr /etc/skel $dir; chown -R $uid.$gid $dir
 156
 157 is the default instead.  Otherwise the contents of the file are treated as
 158 a double-quoted perl string, with the following variables available:
 159 $username, $uid, $gid, $dir, and $shell.
 160
 161 =cut
 162
 163 sub insert {
 164   my $self = shift;
 165   my $error;
 166
 167   local $SIG{HUP} = 'IGNORE';
 168   local $SIG{INT} = 'IGNORE';
 169   local $SIG{QUIT} = 'IGNORE';
 170   local $SIG{TERM} = 'IGNORE';
 171   local $SIG{TSTP} = 'IGNORE';
 172   local $SIG{PIPE} = 'IGNORE';
 173
 174   $error = $self->check;
 175   return $error if $error;
 176
 177   return "Username ". $self->username. " in use"
 178     if qsearchs( 'svc_acct', { 'username' => $self->username,
 179                                'domsvc'   => $self->domsvc,
 180                              } );
 181
 182   my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
 183   return "Unknown svcpart" unless $part_svc;
 184   return "uid in use"
 185     if $part_svc->svc_acct__uid_flag ne 'F'
 186       && qsearchs( 'svc_acct', { 'uid' => $self->uid } )
 187       && $self->username !~ /^(hyla)?fax$/
 188     ;
 189
 190   $error = $self->SUPER::insert;
 191   return $error if $error;
 192
 193   my( $username, $uid, $gid, $dir, $shell ) = (
 194     $self->username,
 195     $self->uid,
 196     $self->gid,
 197     $self->dir,
 198     $self->shell,
 199   );
 200   if ( $username && $uid && $dir && $shellmachine && ! $nossh_hack ) {
 201     ssh("root\@$shellmachine", eval qq("$useradd") );
 202   }
 203
 204   ''; #no error
 205 }
 206
 207 =item delete
 208
 209 Deletes this account from the database.  If there is an error, returns the
 210 error, otherwise returns false.
 211
 212 The corresponding FS::cust_svc record will be deleted as well.
 213
 214 If the configuration value (see L<FS::Conf>) shellmachine exists, the
 215 command(s) specified in the shellmachine-userdel configuration file are
 216 executed on shellmachine via ssh.  This behavior can be surpressed by setting
 217 $FS::svc_acct::nossh_hack true.  If the shellmachine-userdel configuration
 218 file does not exist,
 219
 220   userdel $username
 221
 222 is the default.  If the shellmachine-userdel configuration file exists but
 223 is empty,
 224
 225   rm -rf $dir
 226
 227 is the default instead.  Otherwise the contents of the file are treated as a
 228 double-quoted perl string, with the following variables available:
 229 $username and $dir.
 230
 231 =cut
 232
 233 sub delete {
 234   my $self = shift;
 235   my $error;
 236
 237   return "Can't delete an account which has mail aliases pointed to it!"
 238     if $self->uid && qsearch( 'svc_acct_sm', { 'domuid' => $self->uid } );
 239
 240   local $SIG{HUP} = 'IGNORE';
 241   local $SIG{INT} = 'IGNORE';
 242   local $SIG{QUIT} = 'IGNORE';
 243   local $SIG{TERM} = 'IGNORE';
 244   local $SIG{TSTP} = 'IGNORE';
 245   local $SIG{PIPE} = 'IGNORE';
 246
 247   $error = $self->SUPER::delete;
 248   return $error if $error;
 249
 250   my( $username, $dir ) = (
 251     $self->username,
 252     $self->dir,
 253   );
 254   if ( $username && $shellmachine && ! $nossh_hack ) {
 255     ssh("root\@$shellmachine", eval qq("$userdel") );
 256   }
 257
 258   '';
 259 }
 260
 261 =item replace OLD_RECORD
 262
 263 Replaces OLD_RECORD with this one in the database.  If there is an error,
 264 returns the error, otherwise returns false.
 265
 266 If the configuration value (see L<FS::Conf>) shellmachine exists, and the
 267 dir field has changed, the command(s) specified in the shellmachine-usermod
 268 configuraiton file are executed on shellmachine via ssh.  This behavior can
 269 be surpressed by setting $FS::svc-acct::nossh_hack true.  If the
 270 shellmachine-userdel configuration file does not exist or is empty, :
 271
 272   [ -d $old_dir ] && mv $old_dir $new_dir || (
 273     chmod u+t $old_dir;
 274     mkdir $new_dir;
 275     cd $old_dir;
 276     find . -depth -print | cpio -pdm $new_dir;
 277     chmod u-t $new_dir;
 278     chown -R $uid.$gid $new_dir;
 279     rm -rf $old_dir
 280   )
 281
 282 is executed on shellmachine via ssh.  This behaviour can be surpressed by
 283 setting $FS::svc_acct::nossh_hack true.
 284
 285 =cut
 286
 287 sub replace {
 288   my ( $new, $old ) = ( shift, shift );
 289   my $error;
 290
 291   return "Username in use"
 292     if $old->username ne $new->username &&
 293       qsearchs( 'svc_acct', { 'username' => $new->username } );
 294
 295   return "Can't change uid!" if $old->uid != $new->uid;
 296
 297   #change homdir when we change username
 298   $new->setfield('dir', '') if $old->username ne $new->username;
 299
 300   local $SIG{HUP} = 'IGNORE';
 301   local $SIG{INT} = 'IGNORE';
 302   local $SIG{QUIT} = 'IGNORE';
 303   local $SIG{TERM} = 'IGNORE';
 304   local $SIG{TSTP} = 'IGNORE';
 305   local $SIG{PIPE} = 'IGNORE';
 306
 307   $error = $new->SUPER::replace($old);
 308   return $error if $error;
 309
 310   my ( $old_dir, $new_dir, $uid, $gid ) = (
 311     $old->getfield('dir'),
 312     $new->getfield('dir'),
 313     $new->getfield('uid'),
 314     $new->getfield('gid'),
 315   );
 316   if ( $old_dir && $new_dir && $old_dir ne $new_dir && ! $nossh_hack ) {
 317     ssh("root\@$shellmachine", eval qq("$usermod") );
 318   }
 319
 320   ''; #no error
 321 }
 322
 323 =item suspend
 324
 325 Suspends this account by prefixing *SUSPENDED* to the password.  If there is an
 326 error, returns the error, otherwise returns false.
 327
 328 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 329
 330 =cut
 331
 332 sub suspend {
 333   my $self = shift;
 334   my %hash = $self->hash;
 335   unless ( $hash{_password} =~ /^\*SUSPENDED\* / ) {
 336     $hash{_password} = '*SUSPENDED* '.$hash{_password};
 337     my $new = new FS::svc_acct ( \%hash );
 338     $new->replace($self);
 339   } else {
 340     ''; #no error (already suspended)
 341   }
 342 }
 343
 344 =item unsuspend
 345
 346 Unsuspends this account by removing *SUSPENDED* from the password.  If there is
 347 an error, returns the error, otherwise returns false.
 348
 349 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 350
 351 =cut
 352
 353 sub unsuspend {
 354   my $self = shift;
 355   my %hash = $self->hash;
 356   if ( $hash{_password} =~ /^\*SUSPENDED\* (.*)$/ ) {
 357     $hash{_password} = $1;
 358     my $new = new FS::svc_acct ( \%hash );
 359     $new->replace($self);
 360   } else {
 361     ''; #no error (already unsuspended)
 362   }
 363 }
 364
 365 =item cancel
 366
 367 Just returns false (no error) for now.
 368
 369 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 370
 371 =item check
 372
 373 Checks all fields to make sure this is a valid service.  If there is an error,
 374 returns the error, otherwise returns false.  Called by the insert and replace
 375 methods.
 376
 377 Sets any fixed values; see L<FS::part_svc>.
 378
 379 =cut
 380
 381 sub check {
 382   my $self = shift;
 383
 384   my($recref) = $self->hashref;
 385
 386   my $x = $self->setfixed;
 387   return $x unless ref($x);
 388   my $part_svc = $x;
 389
 390   my $ulen = $usernamemax || $self->dbdef_table->column('username')->length;
 391   $recref->{username} =~ /^([a-z0-9_\-\.]{$usernamemin,$ulen})$/
 392     or return "Illegal username";
 393   $recref->{username} = $1;
 394   if ( $username_letterfirst ) {
 395     $recref->{username} =~ /^[a-z]/ or return "Illegal username";
 396   } elsif ( $username_letter ) {
 397     $recref->{username} =~ /[a-z]/ or return "Illegal username";
 398   }
 399
 400   $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum};
 401   $recref->{popnum} = $1;
 402   return "Unknown popnum" unless
 403     ! $recref->{popnum} ||
 404     qsearchs('svc_acct_pop',{'popnum'=> $recref->{popnum} } );
 405
 406   unless ( $part_svc->getfield('svc_acct__uid_flag') eq 'F' ) {
 407
 408     $recref->{uid} =~ /^(\d*)$/ or return "Illegal uid";
 409     $recref->{uid} = $1 eq '' ? $self->unique('uid') : $1;
 410
 411     $recref->{gid} =~ /^(\d*)$/ or return "Illegal gid";
 412     $recref->{gid} = $1 eq '' ? $recref->{uid} : $1;
 413     #not all systems use gid=uid
 414     #you can set a fixed gid in part_svc
 415
 416     return "Only root can have uid 0"
 417       if $recref->{uid} == 0 && $recref->{username} ne 'root';
 418
 419     my($error);
 420     return $error if $error=$self->ut_textn('finger');
 421
 422     $recref->{dir} =~ /^([\/\w\-]*)$/
 423       or return "Illegal directory";
 424     $recref->{dir} = $1 ||
 425       $dir_prefix . '/' . $recref->{username}
 426       #$dir_prefix . '/' . substr($recref->{username},0,1). '/' . $recref->{username}
 427     ;
 428
 429     unless ( $recref->{username} eq 'sync' ) {
 430       if ( grep $_ eq $recref->{shell}, @shells ) {
 431         $recref->{shell} = (grep $_ eq $recref->{shell}, @shells)[0];
 432       } else {
 433         return "Illegal shell \`". $self->shell. "\'; ".
 434                $conf->dir. "/shells contains: @shells";
 435       }
 436     } else {
 437       $recref->{shell} = '/bin/sync';
 438     }
 439
 440     $recref->{quota} =~ /^(\d*)$/ or return "Illegal quota (unimplemented)";
 441     $recref->{quota} = $1;
 442
 443   } else {
 444     $recref->{gid} ne '' ?
 445       return "Can't have gid without uid" : ( $recref->{gid}='' );
 446     $recref->{finger} ne '' ?
 447       return "Can't have finger-name without uid" : ( $recref->{finger}='' );
 448     $recref->{dir} ne '' ?
 449       return "Can't have directory without uid" : ( $recref->{dir}='' );
 450     $recref->{shell} ne '' ?
 451       return "Can't have shell without uid" : ( $recref->{shell}='' );
 452     $recref->{quota} ne '' ?
 453       return "Can't have quota without uid" : ( $recref->{quota}='' );
 454   }
 455
 456   unless ( $part_svc->getfield('svc_acct__slipip_flag') eq 'F' ) {
 457     unless ( $recref->{slipip} eq '0e0' ) {
 458       $recref->{slipip} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/
 459         or return "Illegal slipip". $self->slipip;
 460       $recref->{slipip} = $1;
 461     } else {
 462       $recref->{slipip} = '0e0';
 463     }
 464
 465   }
 466
 467   #arbitrary RADIUS stuff; allow ut_textn for now
 468   foreach ( grep /^radius_/, fields('svc_acct') ) {
 469     $self->ut_textn($_);
 470   }
 471
 472   #generate a password if it is blank
 473   $recref->{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) )
 474     unless ( $recref->{_password} );
 475
 476   #if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,16})$/ ) {
 477   if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{$passwordmin,8})$/ ) {
 478     $recref->{_password} = $1.$3;
 479     #uncomment this to encrypt password immediately upon entry, or run
 480     #bin/crypt_pw in cron to give new users a window during which their
 481     #password is available to techs, for faxing, etc.  (also be aware of
 482     #radius issues!)
 483     #$recref->{password} = $1.
 484     #  crypt($3,$saltset[int(rand(64))].$saltset[int(rand(64))]
 485     #;
 486   } elsif ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([\w\.\/\$]{13,34})$/ ) {
 487     $recref->{_password} = $1.$3;
 488   } elsif ( $recref->{_password} eq '*' ) {
 489     $recref->{_password} = '*';
 490   } elsif ( $recref->{_password} eq '!!' ) {
 491     $recref->{_password} = '!!';
 492   } else {
 493     return "Illegal password";
 494   }
 495
 496   ''; #no error
 497 }
 498
 499 =item radius
 500
 501 Depriciated, use radius_reply instead.
 502
 503 =cut
 504
 505 sub radius {
 506   carp "FS::svc_acct::radius depriciated, use radius_reply";
 507   $_[0]->radius_reply;
 508 }
 509
 510 =item radius_reply
 511
 512 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
 513 reply attributes of this record.
 514
 515 Note that this is now the preferred method for reading RADIUS attributes -
 516 accessing the columns directly is discouraged, as the column names are
 517 expected to change in the future.
 518
 519 =cut
 520
 521 sub radius_reply {
 522   my $self = shift;
 523   map {
 524     /^(radius_(.*))$/;
 525     my($column, $attrib) = ($1, $2);
 526     $attrib =~ s/_/\-/g;
 527     ( $attrib, $self->getfield($column) );
 528   } grep { /^radius_/ && $self->getfield($_) } fields( $self->table );
 529 }
 530
 531 =item radius_check
 532
 533 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
 534 check attributes of this record.
 535
 536 Accessing RADIUS attributes directly is not supported and will break in the
 537 future.
 538
 539 =cut
 540
 541 sub radius_check {
 542   my $self = shift;
 543   map {
 544     /^(rc_(.*))$/;
 545     my($column, $attrib) = ($1, $2);
 546     $attrib =~ s/_/\-/g;
 547     ( $attrib, $self->getfield($column) );
 548   } grep { /^rc_/ && $self->getfield($_) } fields( $self->table );
 549 }
 550
 551 =back
 552
 553 =head1 VERSION
 554
 555 $Id: svc_acct.pm,v 1.20 2001-08-12 19:41:24 jeff Exp $
 556
 557 =head1 BUGS
 558
 559 The bits which ssh should fork before doing so (or maybe queue jobs for a
 560 daemon).
 561
 562 The $recref stuff in sub check should be cleaned up.
 563
 564 The suspend, unsuspend and cancel methods update the database, but not the
 565 current object.  This is probably a bug as it's unexpected and
 566 counterintuitive.
 567
 568 =head1 SEE ALSO
 569
 570 L<FS::svc_Common>, L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>,
 571 L<FS::part_svc>, L<FS::cust_pkg>, L<Net::SSH>, L<ssh>, L<FS::svc_acct_pop>,
 572 schema.html from the base documentation.
 573
 574 =cut
 575
 576 1;
 577