site_perl/svc_acct.pm

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