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