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 $username_letter $username_letterfirst
   6              $username_noperiod
   7              $shellmachine $useradd $usermod $userdel $mydomain
   8              $cyrus_server $cyrus_admin_user $cyrus_admin_pass
   9              $icradius_dbh
  10              @saltset @pw_set);
  11 use Carp;
  12 use FS::Conf;
  13 use FS::Record qw( qsearch qsearchs fields dbh );
  14 use FS::svc_Common;
  15 use Net::SSH qw(ssh);
  16 use FS::part_svc;
  17 use FS::svc_acct_pop;
  18 use FS::svc_acct_sm;
  19 use FS::cust_main_invoice;
  20 use FS::svc_domain;
  21 use FS::raddb;
  22 use FS::queue;
  23
  24 @ISA = qw( FS::svc_Common );
  25
  26 #ask FS::UID to run this stuff for us later
  27 $FS::UID::callback{'FS::svc_acct'} = sub {
  28   $conf = new FS::Conf;
  29   $dir_prefix = $conf->config('home');
  30   @shells = $conf->config('shells');
  31   $shellmachine = $conf->config('shellmachine');
  32   $usernamemin = $conf->config('usernamemin') || 2;
  33   $usernamemax = $conf->config('usernamemax');
  34   $passwordmin = $conf->config('passwordmin') || 6;
  35   if ( $shellmachine ) {
  36     if ( $conf->exists('shellmachine-useradd') ) {
  37       $useradd = join("\n", $conf->config('shellmachine-useradd') )
  38                  || 'cp -pr /etc/skel $dir; chown -R $uid.$gid $dir';
  39     } else {
  40       $useradd = 'useradd -d $dir -m -s $shell -u $uid $username';
  41     }
  42     if ( $conf->exists('shellmachine-userdel') ) {
  43       $userdel = join("\n", $conf->config('shellmachine-userdel') )
  44                  || 'rm -rf $dir';
  45     } else {
  46       $userdel = 'userdel $username';
  47     }
  48     $usermod = join("\n", $conf->config('shellmachine-usermod') )
  49                || '[ -d $old_dir ] && mv $old_dir $new_dir || ( '.
  50                     'chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; '.
  51                     'find . -depth -print | cpio -pdm $new_dir; '.
  52                     'chmod u-t $new_dir; chown -R $uid.$gid $new_dir; '.
  53                     'rm -rf $old_dir'.
  54                   ')';
  55   }
  56   $username_letter = $conf->exists('username-letter');
  57   $username_letterfirst = $conf->exists('username-letterfirst');
  58   $username_noperiod = $conf->exists('username-noperiod');
  59   $mydomain = $conf->config('domain');
  60   if ( $conf->exists('cyrus') ) {
  61     ($cyrus_server, $cyrus_admin_user, $cyrus_admin_pass) =
  62       $conf->config('cyrus');
  63     eval "use Cyrus::IMAP::Admin;"
  64   } else {
  65     $cyrus_server = '';
  66     $cyrus_admin_user = '';
  67     $cyrus_admin_pass = '';
  68   }
  69   if ( $conf->exists('icradius_secrets') ) {
  70     $icradius_dbh = DBI->connect($conf->config('icradius_secrets'))
  71       or die $DBI::errstr;
  72   } else {
  73     $icradius_dbh = '';
  74   }
  75 };
  76
  77 @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
  78 @pw_set = ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '!', '.', ',' );
  79
  80 #not needed in 5.004 #srand($$|time);
  81
  82 =head1 NAME
  83
  84 FS::svc_acct - Object methods for svc_acct records
  85
  86 =head1 SYNOPSIS
  87
  88   use FS::svc_acct;
  89
  90   $record = new FS::svc_acct \%hash;
  91   $record = new FS::svc_acct { 'column' => 'value' };
  92
  93   $error = $record->insert;
  94
  95   $error = $new_record->replace($old_record);
  96
  97   $error = $record->delete;
  98
  99   $error = $record->check;
 100
 101   $error = $record->suspend;
 102
 103   $error = $record->unsuspend;
 104
 105   $error = $record->cancel;
 106
 107   %hash = $record->radius;
 108
 109   %hash = $record->radius_reply;
 110
 111   %hash = $record->radius_check;
 112
 113 =head1 DESCRIPTION
 114
 115 An FS::svc_acct object represents an account.  FS::svc_acct inherits from
 116 FS::svc_Common.  The following fields are currently supported:
 117
 118 =over 4
 119
 120 =item svcnum - primary key (assigned automatcially for new accounts)
 121
 122 =item username
 123
 124 =item _password - generated if blank
 125
 126 =item popnum - Point of presence (see L<FS::svc_acct_pop>)
 127
 128 =item uid
 129
 130 =item gid
 131
 132 =item finger - GECOS
 133
 134 =item dir - set automatically if blank (and uid is not)
 135
 136 =item shell
 137
 138 =item quota - (unimplementd)
 139
 140 =item slipip - IP address
 141
 142 =item seconds -
 143
 144 =item domsvc - svcnum from svc_domain
 145
 146 =item radius_I<Radius_Attribute> - I<Radius-Attribute>
 147
 148 =item domsvc - service number of svc_domain with which to associate
 149
 150 =back
 151
 152 =head1 METHODS
 153
 154 =over 4
 155
 156 =item new HASHREF
 157
 158 Creates a new account.  To add the account to the database, see L<"insert">.
 159
 160 =cut
 161
 162 sub table { 'svc_acct'; }
 163
 164 =item insert
 165
 166 Adds this account to the database.  If there is an error, returns the error,
 167 otherwise returns false.
 168
 169 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
 170 defined.  An FS::cust_svc record will be created and inserted.
 171
 172 If the configuration value (see L<FS::Conf>) shellmachine exists, and the
 173 username, uid, and dir fields are defined, the command(s) specified in
 174 the shellmachine-useradd configuration are added to the job queue (see
 175 L<FS::queue> and L<freeside-queued>) to be exectued on shellmachine via ssh.
 176 This behaviour can be surpressed by setting $FS::svc_acct::nossh_hack true.
 177 If the shellmachine-useradd configuration file does not exist,
 178
 179   useradd -d $dir -m -s $shell -u $uid $username
 180
 181 is the default.  If the shellmachine-useradd configuration file exists but
 182 it empty,
 183
 184   cp -pr /etc/skel $dir; chown -R $uid.$gid $dir
 185
 186 is the default instead.  Otherwise the contents of the file are treated as
 187 a double-quoted perl string, with the following variables available:
 188 $username, $uid, $gid, $dir, and $shell.
 189
 190 (TODOC: cyrus config file, L<FS::queue> and L<freeside-queued>)
 191
 192 =cut
 193
 194 sub insert {
 195   my $self = shift;
 196   my $error;
 197
 198   local $SIG{HUP} = 'IGNORE';
 199   local $SIG{INT} = 'IGNORE';
 200   local $SIG{QUIT} = 'IGNORE';
 201   local $SIG{TERM} = 'IGNORE';
 202   local $SIG{TSTP} = 'IGNORE';
 203   local $SIG{PIPE} = 'IGNORE';
 204
 205   my $oldAutoCommit = $FS::UID::AutoCommit;
 206   local $FS::UID::AutoCommit = 0;
 207   my $dbh = dbh;
 208
 209   my $amount = 0;
 210
 211   $error = $self->check;
 212   return $error if $error;
 213
 214   return "Username ". $self->username. " in use"
 215     if qsearchs( 'svc_acct', { 'username' => $self->username,
 216                                'domsvc'   => $self->domsvc,
 217                              } );
 218
 219   my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
 220   return "Unknown svcpart" unless $part_svc;
 221   return "uid in use"
 222     if $part_svc->part_svc_column('uid')->columnflag ne 'F'
 223       && qsearchs( 'svc_acct', { 'uid' => $self->uid } )
 224       && $self->username !~ /^(hyla)?fax$/
 225     ;
 226
 227   $error = $self->SUPER::insert;
 228   if ( $error ) {
 229     $dbh->rollback if $oldAutoCommit;
 230     return $error;
 231   }
 232
 233   my( $username, $uid, $gid, $dir, $shell ) = (
 234     $self->username,
 235     $self->uid,
 236     $self->gid,
 237     $self->dir,
 238     $self->shell,
 239   );
 240   if ( $username && $uid && $dir && $shellmachine && ! $nossh_hack ) {
 241     my $queue = new FS::queue { 'job' => 'Net::SSH::ssh' };
 242     $error = $queue->insert("root\@$shellmachine", eval qq("$useradd") );
 243     if ( $error ) {
 244       $dbh->rollback if $oldAutoCommit;
 245       return "queueing job (transaction rolled back): $error";
 246     }
 247   }
 248
 249   if ( $cyrus_server ) {
 250     my $queue = new FS::queue { 'job' => 'FS::svc_acct::cyrus_insert' };
 251     $error = $queue->insert($self->username, $self->quota);
 252     if ( $error ) {
 253       $dbh->rollback if $oldAutoCommit;
 254       return "queueing job (transaction rolled back): $error";
 255     }
 256   }
 257   if ( $icradius_dbh ) {
 258     my $queue = new FS::queue { 'job' => 'FS::svc_acct::icradius_rc_insert' };
 259     $error = $queue->insert( $self->username,
 260                              $self->_password,
 261                              $self->radius_check
 262                            );
 263     if ( $error ) {
 264       $dbh->rollback if $oldAutoCommit;
 265       return "queueing job (transaction rolled back): $error";
 266     }
 267   }
 268
 269   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 270   ''; #no error
 271 }
 272
 273 sub cyrus_insert {
 274   my( $username, $quota ) = @_;
 275
 276   warn "cyrus_insert: starting for user $username, quota $quota\n";
 277
 278   warn "cyrus_insert: connecting to $cyrus_server\n";
 279   my $client = Cyrus::IMAP::Admin->new($cyrus_server);
 280
 281   warn "cyrus_insert: authentication as $cyrus_admin_user\n";
 282   $client->authenticate(
 283     -user      => $cyrus_admin_user,
 284     -mechanism => "login",
 285     -password  => $cyrus_admin_pass
 286   );
 287
 288   warn "cyrus_insert: creating user.$username\n";
 289   my $rc = $client->create("user.$username");
 290   my $error = $client->error;
 291   die "cyrus_insert: error creating user.$username: $error" if $error;
 292
 293   warn "cyrus_insert: setacl user.$username, $username => all\n";
 294   $rc = $client->setacl("user.$username", $username => 'all' );
 295   $error = $client->error;
 296   die "cyrus_insert: error setacl user.$username: $error" if $error;
 297
 298   if ( $quota ) {
 299     warn "cyrus_insert: setquota user.$username, STORAGE => $quota\n";
 300     $rc = $client->setquota("user.$username", 'STORAGE' => $quota );
 301     $error = $client->error;
 302     die "cyrus_insert: error setquota user.$username: $error" if $error;
 303   }
 304
 305   1;
 306 }
 307
 308 sub icradius_rc_insert {
 309   my( $username, $password, %radcheck ) = @_;
 310
 311   my $sth = $icradius_dbh->prepare(
 312     "INSERT INTO radcheck ( id, UserName, Attribute, Value ) VALUES ( ".
 313     join(", ", map { $icradius_dbh->quote($_) } (
 314       '',
 315       $username,
 316       "Password",
 317       $password,
 318     ) ). " )"
 319   );
 320   $sth->execute or die "can't insert into radcheck table: ". $sth->errstr;
 321
 322   foreach my $attribute ( keys %radcheck ) {
 323     my $sth = $icradius_dbh->prepare(
 324       "INSERT INTO radcheck ( id, UserName, Attribute, Value ) VALUES ( ".
 325       join(", ", map { $icradius_dbh->quote($_) } (
 326         '',
 327         $username,
 328         $attribute,
 329         $radcheck{$attribute},
 330       ) ). " )"
 331     );
 332     $sth->execute or die "can't insert into radcheck table: ". $sth->errstr;
 333   }
 334
 335   1;
 336 }
 337
 338 =item delete
 339
 340 Deletes this account from the database.  If there is an error, returns the
 341 error, otherwise returns false.
 342
 343 The corresponding FS::cust_svc record will be deleted as well.
 344
 345 If the configuration value (see L<FS::Conf>) shellmachine exists, the
 346 command(s) specified in the shellmachine-userdel configuration file are
 347 added to the job queue (see L<FS::queue> and L<freeside-queued>) to be executed
 348 on shellmachine via ssh.  This behavior can be surpressed by setting
 349 $FS::svc_acct::nossh_hack true.  If the shellmachine-userdel configuration
 350 file does not exist,
 351
 352   userdel $username
 353
 354 is the default.  If the shellmachine-userdel configuration file exists but
 355 is empty,
 356
 357   rm -rf $dir
 358
 359 is the default instead.  Otherwise the contents of the file are treated as a
 360 double-quoted perl string, with the following variables available:
 361 $username and $dir.
 362
 363 (TODOC: cyrus config file)
 364
 365 =cut
 366
 367 sub delete {
 368   my $self = shift;
 369
 370   if ( defined( $FS::Record::dbdef->table('svc_acct_sm') ) ) {
 371     return "Can't delete an account which has (svc_acct_sm) mail aliases!"
 372       if $self->uid && qsearch( 'svc_acct_sm', { 'domuid' => $self->uid } );
 373   }
 374
 375   return "Can't delete an account which is a (svc_forward) source!"
 376     if qsearch( 'svc_forward', { 'srcsvc' => $self->svcnum } );
 377
 378   return "Can't delete an account which is a (svc_forward) destination!"
 379     if qsearch( 'svc_forward', { 'dstsvc' => $self->svcnum } );
 380
 381   return "Can't delete an account with (svc_www) web service!"
 382     if qsearch( 'svc_www', { 'usersvc' => $self->usersvc } );
 383
 384   # what about records in session ?
 385
 386   local $SIG{HUP} = 'IGNORE';
 387   local $SIG{INT} = 'IGNORE';
 388   local $SIG{QUIT} = 'IGNORE';
 389   local $SIG{TERM} = 'IGNORE';
 390   local $SIG{TSTP} = 'IGNORE';
 391   local $SIG{PIPE} = 'IGNORE';
 392
 393   my $oldAutoCommit = $FS::UID::AutoCommit;
 394   local $FS::UID::AutoCommit = 0;
 395   my $dbh = dbh;
 396
 397   foreach my $cust_main_invoice (
 398     qsearch( 'cust_main_invoice', { 'dest' => $self->svcnum } )
 399   ) {
 400     #next unless defined; #wtf is up with qsearch?
 401     warn $cust_main_invoice;
 402     next unless defined $cust_main_invoice;
 403     my %hash = $cust_main_invoice->hash;
 404     $hash{'dest'} = $self->email;
 405     my $new = new FS::cust_main_invoice \%hash;
 406     my $error = $new->replace($cust_main_invoice);
 407     if ( $error ) {
 408       $dbh->rollback if $oldAutoCommit;
 409       return $error;
 410     }
 411   }
 412
 413   foreach my $svc_domain (
 414     qsearch( 'svc_domain', { 'catchall' => $self->svcnum } )
 415   ) {
 416     my %hash = new FS::svc_domain->hash;
 417     $hash{'catchall'} = '';
 418     my $new = new FS::svc_domain \%hash;
 419     my $error = $new->replace($svc_domain);
 420     if ( $error ) {
 421       $dbh->rollback if $oldAutoCommit;
 422       return $error;
 423     }
 424   }
 425
 426   my $error = $self->SUPER::delete;
 427   if ( $error ) {
 428     $dbh->rollback if $oldAutoCommit;
 429     return $error;
 430   }
 431
 432   my( $username, $dir ) = (
 433     $self->username,
 434     $self->dir,
 435   );
 436   if ( $username && $shellmachine && ! $nossh_hack ) {
 437     my $queue = new FS::queue { 'job' => 'Net::SSH::ssh' };
 438     $error = $queue->insert("root\@$shellmachine", eval qq("$userdel") );
 439     if ( $error ) {
 440       $dbh->rollback if $oldAutoCommit;
 441       return "queueing job (transaction rolled back): $error";
 442     }
 443
 444   }
 445
 446   if ( $cyrus_server ) {
 447     my $queue = new FS::queue { 'job' => 'FS::svc_acct::cyrus_delete' };
 448     $error = $queue->insert($self->username);
 449     if ( $error ) {
 450       $dbh->rollback if $oldAutoCommit;
 451       return "queueing job (transaction rolled back): $error";
 452     }
 453   }
 454   if ( $icradius_dbh ) {
 455     my $queue = new FS::queue { 'job' => 'FS::svc_acct::icradius_rc_delete' };
 456     $error = $queue->insert( $self->username );
 457     if ( $error ) {
 458       $dbh->rollback if $oldAutoCommit;
 459       return "queueing job (transaction rolled back): $error";
 460     }
 461   }
 462
 463   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 464   '';
 465 }
 466
 467 sub cyrus_delete {
 468   my $username = shift;
 469
 470   my $client = Cyrus::IMAP::Admin->new($cyrus_server);
 471   $client->authenticate(
 472     -user      => $cyrus_admin_user,
 473     -mechanism => "login",
 474     -password  => $cyrus_admin_pass
 475   );
 476
 477   my $rc = $client->setacl("user.$username", $cyrus_admin_user => 'all' );
 478   my $error = $client->error;
 479   die $error if $error;
 480
 481   $rc = $client->delete("user.$username");
 482   $error = $client->error;
 483   die $error if $error;
 484
 485   1;
 486 }
 487
 488 sub icradius_rc_delete {
 489   my $username = shift;
 490
 491   my $sth = $icradius_dbh->prepare(
 492     'DELETE FROM radcheck WHERE UserName = ?'
 493   );
 494   $sth->execute($username)
 495     or die "can't delete from radcheck table: ". $sth->errstr;
 496
 497   1;
 498 }
 499
 500 =item replace OLD_RECORD
 501
 502 Replaces OLD_RECORD with this one in the database.  If there is an error,
 503 returns the error, otherwise returns false.
 504
 505 If the configuration value (see L<FS::Conf>) shellmachine exists, and the
 506 dir field has changed, the command(s) specified in the shellmachine-usermod
 507 configuraiton file are added to the job queue (see L<FS::queue> and
 508 L<freeside-queued>) to be executed on shellmachine via ssh.  This behavior can
 509 be surpressed by setting $FS::svc-acct::nossh_hack true.  If the
 510 shellmachine-userdel configuration file does not exist or is empty,
 511
 512   [ -d $old_dir ] && mv $old_dir $new_dir || (
 513     chmod u+t $old_dir;
 514     mkdir $new_dir;
 515     cd $old_dir;
 516     find . -depth -print | cpio -pdm $new_dir;
 517     chmod u-t $new_dir;
 518     chown -R $uid.$gid $new_dir;
 519     rm -rf $old_dir
 520   )
 521
 522 is the default.  This behaviour can be surpressed by setting
 523 $FS::svc_acct::nossh_hack true.
 524
 525 =cut
 526
 527 sub replace {
 528   my ( $new, $old ) = ( shift, shift );
 529   my $error;
 530
 531   return "Username in use"
 532     if $old->username ne $new->username &&
 533       qsearchs( 'svc_acct', { 'username' => $new->username } );
 534
 535   return "Can't change uid!" if $old->uid != $new->uid;
 536
 537   return "can't change username using Cyrus"
 538     if $cyrus_server && $old->username ne $new->username;
 539
 540   #change homdir when we change username
 541   $new->setfield('dir', '') if $old->username ne $new->username;
 542
 543   local $SIG{HUP} = 'IGNORE';
 544   local $SIG{INT} = 'IGNORE';
 545   local $SIG{QUIT} = 'IGNORE';
 546   local $SIG{TERM} = 'IGNORE';
 547   local $SIG{TSTP} = 'IGNORE';
 548   local $SIG{PIPE} = 'IGNORE';
 549
 550   my $oldAutoCommit = $FS::UID::AutoCommit;
 551   local $FS::UID::AutoCommit = 0;
 552   my $dbh = dbh;
 553
 554   $error = $new->SUPER::replace($old);
 555   if ( $error ) {
 556     $dbh->rollback if $oldAutoCommit;
 557     return $error if $error;
 558   }
 559
 560   my ( $old_dir, $new_dir, $uid, $gid ) = (
 561     $old->getfield('dir'),
 562     $new->getfield('dir'),
 563     $new->getfield('uid'),
 564     $new->getfield('gid'),
 565   );
 566   if ( $old_dir && $new_dir && $old_dir ne $new_dir && ! $nossh_hack ) {
 567     my $queue = new FS::queue { 'job' => 'Net::SSH::ssh' };
 568     $error = $queue->insert("root\@$shellmachine", eval qq("$usermod") );
 569     if ( $error ) {
 570       $dbh->rollback if $oldAutoCommit;
 571       return "queueing job (transaction rolled back): $error";
 572     }
 573   }
 574
 575   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 576   ''; #no error
 577 }
 578
 579 =item suspend
 580
 581 Suspends this account by prefixing *SUSPENDED* to the password.  If there is an
 582 error, returns the error, otherwise returns false.
 583
 584 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 585
 586 =cut
 587
 588 sub suspend {
 589   my $self = shift;
 590   my %hash = $self->hash;
 591   unless ( $hash{_password} =~ /^\*SUSPENDED\* / ) {
 592     $hash{_password} = '*SUSPENDED* '.$hash{_password};
 593     my $new = new FS::svc_acct ( \%hash );
 594     $new->replace($self);
 595   } else {
 596     ''; #no error (already suspended)
 597   }
 598 }
 599
 600 =item unsuspend
 601
 602 Unsuspends this account by removing *SUSPENDED* from the password.  If there is
 603 an error, returns the error, otherwise returns false.
 604
 605 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 606
 607 =cut
 608
 609 sub unsuspend {
 610   my $self = shift;
 611   my %hash = $self->hash;
 612   if ( $hash{_password} =~ /^\*SUSPENDED\* (.*)$/ ) {
 613     $hash{_password} = $1;
 614     my $new = new FS::svc_acct ( \%hash );
 615     $new->replace($self);
 616   } else {
 617     ''; #no error (already unsuspended)
 618   }
 619 }
 620
 621 =item cancel
 622
 623 Just returns false (no error) for now.
 624
 625 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 626
 627 =item check
 628
 629 Checks all fields to make sure this is a valid service.  If there is an error,
 630 returns the error, otherwise returns false.  Called by the insert and replace
 631 methods.
 632
 633 Sets any fixed values; see L<FS::part_svc>.
 634
 635 =cut
 636
 637 sub check {
 638   my $self = shift;
 639
 640   my($recref) = $self->hashref;
 641
 642   my $x = $self->setfixed;
 643   return $x unless ref($x);
 644   my $part_svc = $x;
 645
 646   my $error = $self->ut_numbern('svcnum')
 647               || $self->ut_number('domsvc')
 648   ;
 649   return $error if $error;
 650
 651   my $ulen = $usernamemax || $self->dbdef_table->column('username')->length;
 652   $recref->{username} =~ /^([a-z0-9_\-\.]{$usernamemin,$ulen})$/
 653     or return "Illegal username";
 654   $recref->{username} = $1;
 655   if ( $username_letterfirst ) {
 656     $recref->{username} =~ /^[a-z]/ or return "Illegal username";
 657   } elsif ( $username_letter ) {
 658     $recref->{username} =~ /[a-z]/ or return "Illegal username";
 659   }
 660   if ( $username_noperiod ) {
 661     $recref->{username} =~ /\./ and return "Illegal username";
 662   }
 663
 664   $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum};
 665   $recref->{popnum} = $1;
 666   return "Unknown popnum" unless
 667     ! $recref->{popnum} ||
 668     qsearchs('svc_acct_pop',{'popnum'=> $recref->{popnum} } );
 669
 670   unless ( $part_svc->part_svc_column('uid')->columnflag eq 'F' ) {
 671
 672     $recref->{uid} =~ /^(\d*)$/ or return "Illegal uid";
 673     $recref->{uid} = $1 eq '' ? $self->unique('uid') : $1;
 674
 675     $recref->{gid} =~ /^(\d*)$/ or return "Illegal gid";
 676     $recref->{gid} = $1 eq '' ? $recref->{uid} : $1;
 677     #not all systems use gid=uid
 678     #you can set a fixed gid in part_svc
 679
 680     return "Only root can have uid 0"
 681       if $recref->{uid} == 0 && $recref->{username} ne 'root';
 682
 683     $error = $self->ut_textn('finger');
 684     return $error if $error;
 685
 686     $recref->{dir} =~ /^([\/\w\-]*)$/
 687       or return "Illegal directory";
 688     $recref->{dir} = $1 ||
 689       $dir_prefix . '/' . $recref->{username}
 690       #$dir_prefix . '/' . substr($recref->{username},0,1). '/' . $recref->{username}
 691     ;
 692
 693     unless ( $recref->{username} eq 'sync' ) {
 694       if ( grep $_ eq $recref->{shell}, @shells ) {
 695         $recref->{shell} = (grep $_ eq $recref->{shell}, @shells)[0];
 696       } else {
 697         return "Illegal shell \`". $self->shell. "\'; ".
 698                $conf->dir. "/shells contains: @shells";
 699       }
 700     } else {
 701       $recref->{shell} = '/bin/sync';
 702     }
 703
 704     $recref->{quota} =~ /^(\d*)$/ or return "Illegal quota (unimplemented)";
 705     $recref->{quota} = $1;
 706
 707   } else {
 708     $recref->{gid} ne '' ?
 709       return "Can't have gid without uid" : ( $recref->{gid}='' );
 710     $recref->{finger} ne '' ?
 711       return "Can't have finger-name without uid" : ( $recref->{finger}='' );
 712     $recref->{dir} ne '' ?
 713       return "Can't have directory without uid" : ( $recref->{dir}='' );
 714     $recref->{shell} ne '' ?
 715       return "Can't have shell without uid" : ( $recref->{shell}='' );
 716     $recref->{quota} ne '' ?
 717       return "Can't have quota without uid" : ( $recref->{quota}='' );
 718   }
 719
 720   unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) {
 721     unless ( $recref->{slipip} eq '0e0' ) {
 722       $recref->{slipip} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/
 723         or return "Illegal slipip". $self->slipip;
 724       $recref->{slipip} = $1;
 725     } else {
 726       $recref->{slipip} = '0e0';
 727     }
 728
 729   }
 730
 731   #arbitrary RADIUS stuff; allow ut_textn for now
 732   foreach ( grep /^radius_/, fields('svc_acct') ) {
 733     $self->ut_textn($_);
 734   }
 735
 736   #generate a password if it is blank
 737   $recref->{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) )
 738     unless ( $recref->{_password} );
 739
 740   #if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,16})$/ ) {
 741   if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{$passwordmin,8})$/ ) {
 742     $recref->{_password} = $1.$3;
 743     #uncomment this to encrypt password immediately upon entry, or run
 744     #bin/crypt_pw in cron to give new users a window during which their
 745     #password is available to techs, for faxing, etc.  (also be aware of
 746     #radius issues!)
 747     #$recref->{password} = $1.
 748     #  crypt($3,$saltset[int(rand(64))].$saltset[int(rand(64))]
 749     #;
 750   } elsif ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([\w\.\/\$]{13,34})$/ ) {
 751     $recref->{_password} = $1.$3;
 752   } elsif ( $recref->{_password} eq '*' ) {
 753     $recref->{_password} = '*';
 754   } elsif ( $recref->{_password} eq '!!' ) {
 755     $recref->{_password} = '!!';
 756   } else {
 757     return "Illegal password";
 758   }
 759
 760   ''; #no error
 761 }
 762
 763 =item radius
 764
 765 Depriciated, use radius_reply instead.
 766
 767 =cut
 768
 769 sub radius {
 770   carp "FS::svc_acct::radius depriciated, use radius_reply";
 771   $_[0]->radius_reply;
 772 }
 773
 774 =item radius_reply
 775
 776 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
 777 reply attributes of this record.
 778
 779 Note that this is now the preferred method for reading RADIUS attributes -
 780 accessing the columns directly is discouraged, as the column names are
 781 expected to change in the future.
 782
 783 =cut
 784
 785 sub radius_reply {
 786   my $self = shift;
 787   map {
 788     /^(radius_(.*))$/;
 789     my($column, $attrib) = ($1, $2);
 790     #$attrib =~ s/_/\-/g;
 791     ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
 792   } grep { /^radius_/ && $self->getfield($_) } fields( $self->table );
 793 }
 794
 795 =item radius_check
 796
 797 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
 798 check attributes of this record.
 799
 800 Accessing RADIUS attributes directly is not supported and will break in the
 801 future.
 802
 803 =cut
 804
 805 sub radius_check {
 806   my $self = shift;
 807   map {
 808     /^(rc_(.*))$/;
 809     my($column, $attrib) = ($1, $2);
 810     #$attrib =~ s/_/\-/g;
 811     ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
 812   } grep { /^rc_/ && $self->getfield($_) } fields( $self->table );
 813 }
 814
 815 =item domain
 816
 817 Returns the domain associated with this account.
 818
 819 =cut
 820
 821 sub domain {
 822   my $self = shift;
 823   if ( $self->domsvc ) {
 824     my $svc_domain = qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } )
 825       or die "no svc_domain.svcnum for svc_acct.domsvc ". $self->domsvc;
 826     $svc_domain->domain;
 827   } else {
 828     $mydomain or die "svc_acct.domsvc is null and no legacy domain config file";
 829   }
 830 }
 831
 832 =item email
 833
 834 Returns an email address associated with the account.
 835
 836 =cut
 837
 838 sub email {
 839   my $self = shift;
 840   $self->username. '@'. $self->domain;
 841 }
 842
 843 =back
 844
 845 =head1 VERSION
 846
 847 $Id: svc_acct.pm,v 1.40 2001-09-16 12:45:35 ivan Exp $
 848
 849 =head1 BUGS
 850
 851 The bits which ssh should fork before doing so (or maybe queue jobs for a
 852 daemon).
 853
 854 The $recref stuff in sub check should be cleaned up.
 855
 856 The suspend, unsuspend and cancel methods update the database, but not the
 857 current object.  This is probably a bug as it's unexpected and
 858 counterintuitive.
 859
 860 =head1 SEE ALSO
 861
 862 L<FS::svc_Common>, L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>,
 863 L<FS::part_svc>, L<FS::cust_pkg>, L<FS::queue>, L<freeside-queued>),
 864 L<Net::SSH>, L<ssh>, L<FS::svc_acct_pop>,
 865 schema.html from the base documentation.
 866
 867 =cut
 868
 869 1;
 870