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::SSH qw(ssh);
   9 use FS::cust_svc;
  10
  11 @ISA = qw( FS::Record );
  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::Record.  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
 124   $error = $self->check;
 125   return $error if $error;
 126
 127   return "Username ". $self->username. " in use"
 128     if qsearchs( 'svc_acct', { 'username' => $self->username } );
 129
 130   my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
 131   return "Unkonwn svcpart" unless $part_svc;
 132   return "uid in use"
 133     if $part_svc->svc_acct__uid_flag ne 'F'
 134       && qsearchs( 'svc_acct', { 'uid' => $self->uid } )
 135       && $self->username !~ /^(hyla)?fax$/
 136     ;
 137
 138   my $svcnum = $self->svcnum;
 139   my $cust_svc;
 140   unless ( $svcnum ) {
 141     $cust_svc = new FS::cust_svc ( {
 142       'svcnum'  => $svcnum,
 143       'pkgnum'  => $self->pkgnum,
 144       'svcpart' => $self->svcpart,
 145     } );
 146     my $error = $cust_svc->insert;
 147     return $error if $error;
 148     $svcnum = $self->svcnum($cust_svc->svcnum);
 149   }
 150
 151   $error = $self->SUPER::insert;
 152   if ($error) {
 153     $cust_svc->delete if $cust_svc;
 154     return $error;
 155   }
 156
 157   my ( $username, $uid, $dir, $shell ) = (
 158     $self->username,
 159     $self->uid,
 160     $self->dir,
 161     $self->shell,
 162   );
 163   if ( $username
 164        && $uid
 165        && $dir
 166        && $shellmachine
 167        && ! $nossh_hack ) {
 168     #one way
 169     ssh("root\@$shellmachine",
 170         "useradd -d $dir -m -s $shell -u $uid $username"
 171     );
 172     #another way
 173     #ssh("root\@$shellmachine","/bin/mkdir $dir; /bin/chmod 711 $dir; ".
 174     #  "/bin/cp -p /etc/skel/.* $dir 2>/dev/null; ".
 175     #  "/bin/cp -pR /etc/skel/Maildir $dir 2>/dev/null; ".
 176     #  "/bin/chown -R $uid $dir") unless $nossh_hack;
 177   }
 178
 179   ''; #no error
 180 }
 181
 182 =item delete
 183
 184 Deletes this account from the database.  If there is an error, returns the
 185 error, otherwise returns false.
 186
 187 The corresponding FS::cust_svc record will be deleted as well.
 188
 189 If the configuration value (see L<FS::Conf>) shellmachine exists, the command:
 190
 191   userdel $username
 192
 193 is executed on shellmachine via ssh.  This behaviour can be surpressed by
 194 setting $FS::svc_acct::nossh_hack true.
 195
 196 =cut
 197
 198 sub delete {
 199   my $self = shift;
 200   my $error;
 201
 202   local $SIG{HUP} = 'IGNORE';
 203   local $SIG{INT} = 'IGNORE';
 204   local $SIG{QUIT} = 'IGNORE';
 205   local $SIG{TERM} = 'IGNORE';
 206   local $SIG{TSTP} = 'IGNORE';
 207
 208   my $svcnum = $self->getfield('svcnum');
 209
 210   $error = $self->SUPER::delete;
 211   return $error if $error;
 212
 213   my $cust_svc = qsearchs( 'cust_svc' , { 'svcnum' => $svcnum } );
 214   $error = $cust_svc->delete;
 215   return $error if $error;
 216
 217   my $username = $self->username;
 218   if ( $username && $shellmachine && ! $nossh_hack ) {
 219     ssh("root\@$shellmachine","userdel $username");
 220   }
 221
 222   '';
 223 }
 224
 225 =item replace OLD_RECORD
 226
 227 Replaces OLD_RECORD with this one in the database.  If there is an error,
 228 returns the error, otherwise returns false.
 229
 230 If the configuration value (see L<FS::Conf>) shellmachine exists, and the
 231 dir field has changed, the command:
 232
 233   [ -d $old_dir ] && (
 234     chmod u+t $old_dir;
 235     umask 022;
 236     mkdir $new_dir;
 237     cd $old_dir;
 238     find . -depth -print | cpio -pdm $new_dir;
 239     chmod u-t $new_dir;
 240     chown -R $uid.$gid $new_dir;
 241     rm -rf $old_dir
 242   )
 243
 244 is executed on shellmachine via ssh.  This behaviour can be surpressed by
 245 setting $FS::svc_acct::nossh_hack true.
 246
 247 =cut
 248
 249 sub replace {
 250   my ( $new, $old ) = @_;
 251   my $error;
 252
 253   return "Username in use"
 254     if $old->username ne $new->username &&
 255       qsearchs( 'svc_acct', { 'username' => $new->username } );
 256
 257   return "Can't change uid!" if $old->uid ne $new->uid;
 258
 259   #change homdir when we change username
 260   $new->setfield('dir', '') if $old->username ne $new->username;
 261
 262   local $SIG{HUP} = 'IGNORE';
 263   local $SIG{INT} = 'IGNORE';
 264   local $SIG{QUIT} = 'IGNORE';
 265   local $SIG{TERM} = 'IGNORE';
 266   local $SIG{TSTP} = 'IGNORE';
 267
 268   $error = $new->SUPER::replace($old);
 269   return $error if $error;
 270
 271   my ( $old_dir, $new_dir ) = ( $old->getfield('dir'), $new->getfield('dir') );
 272   my ( $uid, $gid) = ( $new->getfield('uid'), $new->getfield('gid') );
 273   if ( $old_dir
 274        && $new_dir
 275        && $old_dir ne $new_dir
 276        && ! $nossh_hack
 277   ) {
 278     ssh("root\@$shellmachine","[ -d $old_dir ] && ".
 279                  "( chmod u+t $old_dir; ". #turn off qmail delivery
 280                  "umask 022; mkdir $new_dir; cd $old_dir; ".
 281                  "find . -depth -print | cpio -pdm $new_dir; ".
 282                  "chmod u-t $new_dir; chown -R $uid.$gid $new_dir; ".
 283                  "rm -rf $old_dir".
 284                  ")"
 285     );
 286   }
 287
 288   ''; #no error
 289 }
 290
 291 =item suspend
 292
 293 Suspends this account by prefixing *SUSPENDED* to the password.  If there is an
 294 error, returns the error, otherwise returns false.
 295
 296 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 297
 298 =cut
 299
 300 sub suspend {
 301   my $self = shift;
 302   my %hash = $self->hash;
 303   unless ( $hash{_password} =~ /^\*SUSPENDED\* / ) {
 304     $hash{_password} = '*SUSPENDED* '.$hash{_password};
 305     my $new = new FS::svc_acct ( \%hash );
 306     $new->replace($self);
 307   } else {
 308     ''; #no error (already suspended)
 309   }
 310 }
 311
 312 =item unsuspend
 313
 314 Unsuspends this account by removing *SUSPENDED* from the password.  If there is
 315 an error, returns the error, otherwise returns false.
 316
 317 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 318
 319 =cut
 320
 321 sub unsuspend {
 322   my $self = shift;
 323   my %hash = $self->hash;
 324   if ( $hash{_password} =~ /^\*SUSPENDED\* (.*)$/ ) {
 325     $hash{_password} = $1;
 326     my $new = new FS::svc_acct ( \%hash );
 327     $new->replace($self);
 328   } else {
 329     ''; #no error (already unsuspended)
 330   }
 331 }
 332
 333 =item cancel
 334
 335 Just returns false (no error) for now.
 336
 337 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 338
 339 =cut
 340
 341 sub cancel {
 342   ''; #stub (no error) - taken care of in delete
 343 }
 344
 345 =item check
 346
 347 Checks all fields to make sure this is a valid service.  If there is an error,
 348 returns the error, otherwise returns false.  Called by the insert and replace
 349 methods.
 350
 351 Sets any fixed values; see L<FS::part_svc>.
 352
 353 =cut
 354
 355 sub check {
 356   my $self = shift;
 357
 358   my($recref) = $self->hashref;
 359
 360   $recref->{svcnum} =~ /^(\d*)$/ or return "Illegal svcnum";
 361   $recref->{svcnum} = $1;
 362
 363   #get part_svc
 364   my($svcpart);
 365   my($svcnum)=$self->getfield('svcnum');
 366   if ($svcnum) {
 367     my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
 368     return "Unknown svcnum" unless $cust_svc;
 369     $svcpart=$cust_svc->svcpart;
 370   } else {
 371     $svcpart=$self->getfield('svcpart');
 372   }
 373   my($part_svc)=qsearchs('part_svc',{'svcpart'=>$svcpart});
 374   return "Unkonwn svcpart" unless $part_svc;
 375
 376   #set fixed fields from part_svc
 377   my($field);
 378   foreach $field ( fields('svc_acct') ) {
 379     if ( $part_svc->getfield('svc_acct__'. $field. '_flag') eq 'F' ) {
 380       $self->setfield($field,$part_svc->getfield('svc_acct__'. $field) );
 381     }
 382   }
 383
 384   my($ulen)=$self->dbdef_table->column('username')->length;
 385   $recref->{username} =~ /^([a-z0-9_\-]{2,$ulen})$/
 386     or return "Illegal username";
 387   $recref->{username} = $1;
 388   $recref->{username} =~ /[a-z]/ or return "Illegal username";
 389
 390   $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum";
 391   $recref->{popnum} = $1;
 392   return "Unkonwn popnum" unless
 393     ! $recref->{popnum} ||
 394     qsearchs('svc_acct_pop',{'popnum'=> $recref->{popnum} } );
 395
 396   unless ( $part_svc->getfield('svc_acct__uid_flag') eq 'F' ) {
 397
 398     $recref->{uid} =~ /^(\d*)$/ or return "Illegal uid";
 399     $recref->{uid} = $1 eq '' ? $self->unique('uid') : $1;
 400
 401     $recref->{gid} =~ /^(\d*)$/ or return "Illegal gid";
 402     $recref->{gid} = $1 eq '' ? $recref->{uid} : $1;
 403     #not all systems use gid=uid
 404     #you can set a fixed gid in part_svc
 405
 406     return "Only root can have uid 0"
 407       if $recref->{uid} == 0 && $recref->{username} ne 'root';
 408
 409     my($error);
 410     return $error if $error=$self->ut_textn('finger');
 411
 412     $recref->{dir} =~ /^([\/\w\-]*)$/
 413       or return "Illegal directory";
 414     $recref->{dir} = $1 ||
 415       $dir_prefix . '/' . $recref->{username}
 416       #$dir_prefix . '/' . substr($recref->{username},0,1). '/' . $recref->{username}
 417     ;
 418
 419     unless ( $recref->{username} eq 'sync' ) {
 420       my($shell);
 421       if ( $shell = (grep $_ eq $recref->{shell}, @shells)[0] ) {
 422         $recref->{shell} = $shell;
 423       } else {
 424         return "Illegal shell ". $self->shell;
 425       }
 426     } else {
 427       $recref->{shell} = '/bin/sync';
 428     }
 429
 430     $recref->{quota} =~ /^(\d*)$/ or return "Illegal quota (unimplemented)";
 431     $recref->{quota} = $1;
 432
 433   } else {
 434     $recref->{gid} ne '' ?
 435       return "Can't have gid without uid" : ( $recref->{gid}='' );
 436     $recref->{finger} ne '' ?
 437       return "Can't have finger-name without uid" : ( $recref->{finger}='' );
 438     $recref->{dir} ne '' ?
 439       return "Can't have directory without uid" : ( $recref->{dir}='' );
 440     $recref->{shell} ne '' ?
 441       return "Can't have shell without uid" : ( $recref->{shell}='' );
 442     $recref->{quota} ne '' ?
 443       return "Can't have quota without uid" : ( $recref->{quota}='' );
 444   }
 445
 446   unless ( $part_svc->getfield('svc_acct__slipip_flag') eq 'F' ) {
 447     unless ( $recref->{slipip} eq '0e0' ) {
 448       $recref->{slipip} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/
 449         or return "Illegal slipip". $self->slipip;
 450       $recref->{slipip} = $1;
 451     } else {
 452       $recref->{slipip} = '0e0';
 453     }
 454
 455   }
 456
 457   #arbitrary RADIUS stuff; allow ut_textn for now
 458   foreach ( grep /^radius_/, fields('svc_acct') ) {
 459     $self->ut_textn($_);
 460   }
 461
 462   #generate a password if it is blank
 463   $recref->{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) )
 464     unless ( $recref->{_password} );
 465
 466   #if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,16})$/ ) {
 467   if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,8})$/ ) {
 468     $recref->{_password} = $1.$3;
 469     #uncomment this to encrypt password immediately upon entry, or run
 470     #bin/crypt_pw in cron to give new users a window during which their
 471     #password is available to techs, for faxing, etc.  (also be aware of
 472     #radius issues!)
 473     #$recref->{password} = $1.
 474     #  crypt($3,$saltset[int(rand(64))].$saltset[int(rand(64))]
 475     #;
 476   } elsif ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([\w\.\/]{13,24})$/ ) {
 477     $recref->{_password} = $1.$3;
 478   } elsif ( $recref->{_password} eq '*' ) {
 479     $recref->{_password} = '*';
 480   } else {
 481     return "Illegal password";
 482   }
 483
 484   ''; #no error
 485 }
 486
 487 =back
 488
 489 =head1 VERSION
 490
 491 $Id: svc_acct.pm,v 1.3 1998-12-29 11:59:52 ivan Exp $
 492
 493 =head1 BUGS
 494
 495 The remote commands should be configurable.
 496
 497 The new method should set defaults from part_svc (like the check method
 498 sets fixed values).
 499
 500 The bits which ssh should fork before doing so.
 501
 502 The $recref stuff in sub check should be cleaned up.
 503
 504 =head1 SEE ALSO
 505
 506 L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>,
 507 L<FS::SSH>, L<ssh>, L<FS::svc_acct_pop>, schema.html from the base
 508 documentation.
 509
 510 =head1 HISTORY
 511
 512 ivan@voicenet.com 97-jul-16 - 21
 513
 514 rewrite (among other things, now know about part_svc) ivan@sisd.com 98-mar-8
 515
 516 Changed 'password' to '_password' because Pg6.3 reserves the password word
 517         bmccane@maxbaud.net     98-apr-3
 518
 519 username length and shell no longer hardcoded ivan@sisd.com 98-jun-28
 520
 521 eww but needed: ignore uid duplicates for 'fax' and 'hylafax'
 522 ivan@sisd.com 98-jun-29
 523
 524 $nossh_hack ivan@sisd.com 98-jul-13
 525
 526 protections against UID/GID of 0 for incorrectly-setup RDBMSs (also
 527 in bin/svc_acct.export) ivan@sisd.com 98-jul-13
 528
 529 arbitrary radius attributes ivan@sisd.com 98-aug-13
 530
 531 /var/spool/freeside/conf/shellmachine ivan@sisd.com 98-aug-13
 532
 533 pod and FS::conf ivan@sisd.com 98-sep-22
 534
 535 $Log: svc_acct.pm,v $
 536 Revision 1.3  1998-12-29 11:59:52  ivan
 537 mostly properly OO, some work still to be done with svc_ stuff
 538
 539 Revision 1.2  1998/11/13 09:56:55  ivan
 540 change configuration file layout to support multiple distinct databases (with
 541 own set of config files, export, etc.)
 542
 543
 544 =cut
 545
 546 1;
 547