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