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