FS/FS/svc_acct.pm

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