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   return "Can't delete an account which has (svc_acct_sm) mail aliases!"
 371     if $self->uid && qsearch( 'svc_acct_sm', { 'domuid' => $self->uid } );
 372
 373   return "Can't delete an account which is a (svc_forward) source!"
 374     if qsearch( 'svc_forward', { 'srcsvc' => $self->svcnum } );
 375
 376   return "Can't delete an account which is a (svc_forward) destination!"
 377     if qsearch( 'svc_forward', { 'dstsvc' => $self->svcnum } );
 378
 379   return "Can't delete an account with (svc_www) web service!"
 380     if qsearch( 'svc_www', { 'usersvc' => $self->usersvc } );
 381
 382   # what about records in session ?
 383
 384   local $SIG{HUP} = 'IGNORE';
 385   local $SIG{INT} = 'IGNORE';
 386   local $SIG{QUIT} = 'IGNORE';
 387   local $SIG{TERM} = 'IGNORE';
 388   local $SIG{TSTP} = 'IGNORE';
 389   local $SIG{PIPE} = 'IGNORE';
 390
 391   my $oldAutoCommit = $FS::UID::AutoCommit;
 392   local $FS::UID::AutoCommit = 0;
 393   my $dbh = dbh;
 394
 395   foreach my $cust_main_invoice (
 396     qsearch( 'cust_main_invoice', { 'dest' => $self->svcnum } )
 397   ) {
 398     my %hash = $cust_main_invoice->hash;
 399     $hash{'dest'} = $self->email;
 400     my $new = new FS::cust_main_invoice \%hash;
 401     my $error = $new->replace($cust_main_invoice);
 402     if ( $error ) {
 403       $dbh->rollback if $oldAutoCommit;
 404       return $error;
 405     }
 406   }
 407
 408   foreach my $svc_domain (
 409     qsearch( 'svc_domain', { 'catchall' => $self->svcnum } )
 410   ) {
 411     my %hash = new FS::svc_domain->hash;
 412     $hash{'catchall'} = '';
 413     my $new = new FS::svc_domain \%hash;
 414     my $error = $new->replace($svc_domain);
 415     if ( $error ) {
 416       $dbh->rollback if $oldAutoCommit;
 417       return $error;
 418     }
 419   }
 420
 421   my $error = $self->SUPER::delete;
 422   if ( $error ) {
 423     $dbh->rollback if $oldAutoCommit;
 424     return $error;
 425   }
 426
 427   my( $username, $dir ) = (
 428     $self->username,
 429     $self->dir,
 430   );
 431   if ( $username && $shellmachine && ! $nossh_hack ) {
 432     my $queue = new FS::queue { 'job' => 'Net::SSH::ssh' };
 433     $error = $queue->insert("root\@$shellmachine", eval qq("$userdel") );
 434     if ( $error ) {
 435       $dbh->rollback if $oldAutoCommit;
 436       return "queueing job (transaction rolled back): $error";
 437     }
 438
 439   }
 440
 441   if ( $cyrus_server ) {
 442     my $queue = new FS::queue { 'job' => 'FS::svc_acct::cyrus_delete' };
 443     $error = $queue->insert($self->username);
 444     if ( $error ) {
 445       $dbh->rollback if $oldAutoCommit;
 446       return "queueing job (transaction rolled back): $error";
 447     }
 448   }
 449   if ( $icradius_dbh ) {
 450     my $queue = new FS::queue { 'job' => 'FS::svc_acct::icradius_rc_delete' };
 451     $error = $queue->insert( $self->username );
 452     if ( $error ) {
 453       $dbh->rollback if $oldAutoCommit;
 454       return "queueing job (transaction rolled back): $error";
 455     }
 456   }
 457
 458   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 459   '';
 460 }
 461
 462 sub cyrus_delete {
 463   my $username = shift;
 464
 465   my $client = Cyrus::IMAP::Admin->new($cyrus_server);
 466   $client->authenticate(
 467     -user      => $cyrus_admin_user,
 468     -mechanism => "login",
 469     -password  => $cyrus_admin_pass
 470   );
 471
 472   my $rc = $client->setacl("user.$username", $cyrus_admin_user => 'all' );
 473   my $error = $client->error;
 474   die $error if $error;
 475
 476   $rc = $client->delete("user.$username");
 477   $error = $client->error;
 478   die $error if $error;
 479
 480   1;
 481 }
 482
 483 sub icradius_rc_delete {
 484   my $username = shift;
 485
 486   my $sth = $icradius_dbh->prepare(
 487     'DELETE FROM radcheck WHERE UserName = ?'
 488   );
 489   $sth->execute($username)
 490     or die "can't delete from radcheck table: ". $sth->errstr;
 491
 492   1;
 493 }
 494
 495 =item replace OLD_RECORD
 496
 497 Replaces OLD_RECORD with this one in the database.  If there is an error,
 498 returns the error, otherwise returns false.
 499
 500 If the configuration value (see L<FS::Conf>) shellmachine exists, and the
 501 dir field has changed, the command(s) specified in the shellmachine-usermod
 502 configuraiton file are added to the job queue (see L<FS::queue> and
 503 L<freeside-queued>) to be executed on shellmachine via ssh.  This behavior can
 504 be surpressed by setting $FS::svc-acct::nossh_hack true.  If the
 505 shellmachine-userdel configuration file does not exist or is empty,
 506
 507   [ -d $old_dir ] && mv $old_dir $new_dir || (
 508     chmod u+t $old_dir;
 509     mkdir $new_dir;
 510     cd $old_dir;
 511     find . -depth -print | cpio -pdm $new_dir;
 512     chmod u-t $new_dir;
 513     chown -R $uid.$gid $new_dir;
 514     rm -rf $old_dir
 515   )
 516
 517 is the default.  This behaviour can be surpressed by setting
 518 $FS::svc_acct::nossh_hack true.
 519
 520 =cut
 521
 522 sub replace {
 523   my ( $new, $old ) = ( shift, shift );
 524   my $error;
 525
 526   return "Username in use"
 527     if $old->username ne $new->username &&
 528       qsearchs( 'svc_acct', { 'username' => $new->username } );
 529
 530   return "Can't change uid!" if $old->uid != $new->uid;
 531
 532   return "can't change username using Cyrus"
 533     if $cyrus_server && $old->username ne $new->username;
 534
 535   #change homdir when we change username
 536   $new->setfield('dir', '') if $old->username ne $new->username;
 537
 538   local $SIG{HUP} = 'IGNORE';
 539   local $SIG{INT} = 'IGNORE';
 540   local $SIG{QUIT} = 'IGNORE';
 541   local $SIG{TERM} = 'IGNORE';
 542   local $SIG{TSTP} = 'IGNORE';
 543   local $SIG{PIPE} = 'IGNORE';
 544
 545   my $oldAutoCommit = $FS::UID::AutoCommit;
 546   local $FS::UID::AutoCommit = 0;
 547   my $dbh = dbh;
 548
 549   $error = $new->SUPER::replace($old);
 550   if ( $error ) {
 551     $dbh->rollback if $oldAutoCommit;
 552     return $error if $error;
 553   }
 554
 555   my ( $old_dir, $new_dir, $uid, $gid ) = (
 556     $old->getfield('dir'),
 557     $new->getfield('dir'),
 558     $new->getfield('uid'),
 559     $new->getfield('gid'),
 560   );
 561   if ( $old_dir && $new_dir && $old_dir ne $new_dir && ! $nossh_hack ) {
 562     my $queue = new FS::queue { 'job' => 'Net::SSH::ssh' };
 563     $error = $queue->insert("root\@$shellmachine", eval qq("$usermod") );
 564     if ( $error ) {
 565       $dbh->rollback if $oldAutoCommit;
 566       return "queueing job (transaction rolled back): $error";
 567     }
 568   }
 569
 570   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 571   ''; #no error
 572 }
 573
 574 =item suspend
 575
 576 Suspends this account by prefixing *SUSPENDED* to the password.  If there is an
 577 error, returns the error, otherwise returns false.
 578
 579 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 580
 581 =cut
 582
 583 sub suspend {
 584   my $self = shift;
 585   my %hash = $self->hash;
 586   unless ( $hash{_password} =~ /^\*SUSPENDED\* / ) {
 587     $hash{_password} = '*SUSPENDED* '.$hash{_password};
 588     my $new = new FS::svc_acct ( \%hash );
 589     $new->replace($self);
 590   } else {
 591     ''; #no error (already suspended)
 592   }
 593 }
 594
 595 =item unsuspend
 596
 597 Unsuspends this account by removing *SUSPENDED* from the password.  If there is
 598 an error, returns the error, otherwise returns false.
 599
 600 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 601
 602 =cut
 603
 604 sub unsuspend {
 605   my $self = shift;
 606   my %hash = $self->hash;
 607   if ( $hash{_password} =~ /^\*SUSPENDED\* (.*)$/ ) {
 608     $hash{_password} = $1;
 609     my $new = new FS::svc_acct ( \%hash );
 610     $new->replace($self);
 611   } else {
 612     ''; #no error (already unsuspended)
 613   }
 614 }
 615
 616 =item cancel
 617
 618 Just returns false (no error) for now.
 619
 620 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 621
 622 =item check
 623
 624 Checks all fields to make sure this is a valid service.  If there is an error,
 625 returns the error, otherwise returns false.  Called by the insert and replace
 626 methods.
 627
 628 Sets any fixed values; see L<FS::part_svc>.
 629
 630 =cut
 631
 632 sub check {
 633   my $self = shift;
 634
 635   my($recref) = $self->hashref;
 636
 637   my $x = $self->setfixed;
 638   return $x unless ref($x);
 639   my $part_svc = $x;
 640
 641   my $error = $self->ut_numbern('svcnum')
 642               || $self->ut_number('domsvc')
 643   ;
 644   return $error if $error;
 645
 646   my $ulen = $usernamemax || $self->dbdef_table->column('username')->length;
 647   $recref->{username} =~ /^([a-z0-9_\-\.]{$usernamemin,$ulen})$/
 648     or return "Illegal username";
 649   $recref->{username} = $1;
 650   if ( $username_letterfirst ) {
 651     $recref->{username} =~ /^[a-z]/ or return "Illegal username";
 652   } elsif ( $username_letter ) {
 653     $recref->{username} =~ /[a-z]/ or return "Illegal username";
 654   }
 655   if ( $username_noperiod ) {
 656     $recref->{username} =~ /\./ and return "Illegal username";
 657   }
 658
 659   $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum};
 660   $recref->{popnum} = $1;
 661   return "Unknown popnum" unless
 662     ! $recref->{popnum} ||
 663     qsearchs('svc_acct_pop',{'popnum'=> $recref->{popnum} } );
 664
 665   unless ( $part_svc->part_svc_column('uid')->columnflag eq 'F' ) {
 666
 667     $recref->{uid} =~ /^(\d*)$/ or return "Illegal uid";
 668     $recref->{uid} = $1 eq '' ? $self->unique('uid') : $1;
 669
 670     $recref->{gid} =~ /^(\d*)$/ or return "Illegal gid";
 671     $recref->{gid} = $1 eq '' ? $recref->{uid} : $1;
 672     #not all systems use gid=uid
 673     #you can set a fixed gid in part_svc
 674
 675     return "Only root can have uid 0"
 676       if $recref->{uid} == 0 && $recref->{username} ne 'root';
 677
 678     $error = $self->ut_textn('finger');
 679     return $error if $error;
 680
 681     $recref->{dir} =~ /^([\/\w\-]*)$/
 682       or return "Illegal directory";
 683     $recref->{dir} = $1 ||
 684       $dir_prefix . '/' . $recref->{username}
 685       #$dir_prefix . '/' . substr($recref->{username},0,1). '/' . $recref->{username}
 686     ;
 687
 688     unless ( $recref->{username} eq 'sync' ) {
 689       if ( grep $_ eq $recref->{shell}, @shells ) {
 690         $recref->{shell} = (grep $_ eq $recref->{shell}, @shells)[0];
 691       } else {
 692         return "Illegal shell \`". $self->shell. "\'; ".
 693                $conf->dir. "/shells contains: @shells";
 694       }
 695     } else {
 696       $recref->{shell} = '/bin/sync';
 697     }
 698
 699     $recref->{quota} =~ /^(\d*)$/ or return "Illegal quota (unimplemented)";
 700     $recref->{quota} = $1;
 701
 702   } else {
 703     $recref->{gid} ne '' ?
 704       return "Can't have gid without uid" : ( $recref->{gid}='' );
 705     $recref->{finger} ne '' ?
 706       return "Can't have finger-name without uid" : ( $recref->{finger}='' );
 707     $recref->{dir} ne '' ?
 708       return "Can't have directory without uid" : ( $recref->{dir}='' );
 709     $recref->{shell} ne '' ?
 710       return "Can't have shell without uid" : ( $recref->{shell}='' );
 711     $recref->{quota} ne '' ?
 712       return "Can't have quota without uid" : ( $recref->{quota}='' );
 713   }
 714
 715   unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) {
 716     unless ( $recref->{slipip} eq '0e0' ) {
 717       $recref->{slipip} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/
 718         or return "Illegal slipip". $self->slipip;
 719       $recref->{slipip} = $1;
 720     } else {
 721       $recref->{slipip} = '0e0';
 722     }
 723
 724   }
 725
 726   #arbitrary RADIUS stuff; allow ut_textn for now
 727   foreach ( grep /^radius_/, fields('svc_acct') ) {
 728     $self->ut_textn($_);
 729   }
 730
 731   #generate a password if it is blank
 732   $recref->{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) )
 733     unless ( $recref->{_password} );
 734
 735   #if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,16})$/ ) {
 736   if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{$passwordmin,8})$/ ) {
 737     $recref->{_password} = $1.$3;
 738     #uncomment this to encrypt password immediately upon entry, or run
 739     #bin/crypt_pw in cron to give new users a window during which their
 740     #password is available to techs, for faxing, etc.  (also be aware of
 741     #radius issues!)
 742     #$recref->{password} = $1.
 743     #  crypt($3,$saltset[int(rand(64))].$saltset[int(rand(64))]
 744     #;
 745   } elsif ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([\w\.\/\$]{13,34})$/ ) {
 746     $recref->{_password} = $1.$3;
 747   } elsif ( $recref->{_password} eq '*' ) {
 748     $recref->{_password} = '*';
 749   } elsif ( $recref->{_password} eq '!!' ) {
 750     $recref->{_password} = '!!';
 751   } else {
 752     return "Illegal password";
 753   }
 754
 755   ''; #no error
 756 }
 757
 758 =item radius
 759
 760 Depriciated, use radius_reply instead.
 761
 762 =cut
 763
 764 sub radius {
 765   carp "FS::svc_acct::radius depriciated, use radius_reply";
 766   $_[0]->radius_reply;
 767 }
 768
 769 =item radius_reply
 770
 771 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
 772 reply attributes of this record.
 773
 774 Note that this is now the preferred method for reading RADIUS attributes -
 775 accessing the columns directly is discouraged, as the column names are
 776 expected to change in the future.
 777
 778 =cut
 779
 780 sub radius_reply {
 781   my $self = shift;
 782   map {
 783     /^(radius_(.*))$/;
 784     my($column, $attrib) = ($1, $2);
 785     #$attrib =~ s/_/\-/g;
 786     ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
 787   } grep { /^radius_/ && $self->getfield($_) } fields( $self->table );
 788 }
 789
 790 =item radius_check
 791
 792 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
 793 check attributes of this record.
 794
 795 Accessing RADIUS attributes directly is not supported and will break in the
 796 future.
 797
 798 =cut
 799
 800 sub radius_check {
 801   my $self = shift;
 802   map {
 803     /^(rc_(.*))$/;
 804     my($column, $attrib) = ($1, $2);
 805     #$attrib =~ s/_/\-/g;
 806     ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
 807   } grep { /^rc_/ && $self->getfield($_) } fields( $self->table );
 808 }
 809
 810 =item domain
 811
 812 Returns the domain associated with this account.
 813
 814 =cut
 815
 816 sub domain {
 817   my $self = shift;
 818   if ( $self->domsvc ) {
 819     my $svc_domain = qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } )
 820       or die "no svc_domain.svcnum for svc_acct.domsvc ". $self->domsvc;
 821     $svc_domain->domain;
 822   } else {
 823     $mydomain or die "svc_acct.domsvc is null and no legacy domain config file";
 824   }
 825 }
 826
 827 =item email
 828
 829 Returns an email address associated with the account.
 830
 831 =cut
 832
 833 sub email {
 834   my $self = shift;
 835   $self->username. '@'. $self->domain;
 836 }
 837
 838 =back
 839
 840 =head1 VERSION
 841
 842 $Id: svc_acct.pm,v 1.38 2001-09-11 13:10:22 ivan Exp $
 843
 844 =head1 BUGS
 845
 846 The bits which ssh should fork before doing so (or maybe queue jobs for a
 847 daemon).
 848
 849 The $recref stuff in sub check should be cleaned up.
 850
 851 The suspend, unsuspend and cancel methods update the database, but not the
 852 current object.  This is probably a bug as it's unexpected and
 853 counterintuitive.
 854
 855 =head1 SEE ALSO
 856
 857 L<FS::svc_Common>, L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>,
 858 L<FS::part_svc>, L<FS::cust_pkg>, L<FS::queue>, L<freeside-queued>),
 859 L<Net::SSH>, L<ssh>, L<FS::svc_acct_pop>,
 860 schema.html from the base documentation.
 861
 862 =cut
 863
 864 1;
 865