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