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