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