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