site_perl/svc_acct.pm

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