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