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";
 681   } else {
 682     $recref->{username} =~ /^([a-z0-9_\-\.]{$usernamemin,$ulen})$/
 683       or return "Illegal username";
 684   }
 685   $recref->{username} = $1;
 686
 687   if ( $username_letterfirst ) {
 688     $recref->{username} =~ /^[a-z]/ or return "Illegal username";
 689   } elsif ( $username_letter ) {
 690     $recref->{username} =~ /[a-z]/ or return "Illegal username";
 691   }
 692   if ( $username_noperiod ) {
 693     $recref->{username} =~ /\./ and return "Illegal username";
 694   }
 695
 696   $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum};
 697   $recref->{popnum} = $1;
 698   return "Unknown popnum" unless
 699     ! $recref->{popnum} ||
 700     qsearchs('svc_acct_pop',{'popnum'=> $recref->{popnum} } );
 701
 702   unless ( $part_svc->part_svc_column('uid')->columnflag eq 'F' ) {
 703
 704     $recref->{uid} =~ /^(\d*)$/ or return "Illegal uid";
 705     $recref->{uid} = $1 eq '' ? $self->unique('uid') : $1;
 706
 707     $recref->{gid} =~ /^(\d*)$/ or return "Illegal gid";
 708     $recref->{gid} = $1 eq '' ? $recref->{uid} : $1;
 709     #not all systems use gid=uid
 710     #you can set a fixed gid in part_svc
 711
 712     return "Only root can have uid 0"
 713       if $recref->{uid} == 0 && $recref->{username} ne 'root';
 714
 715 #    $error = $self->ut_textn('finger');
 716 #    return $error if $error;
 717     $self->getfield('finger') =~
 718       /^([\w \t\!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\*]*)$/
 719         or return "Illegal finger: ". $self->getfield('finger');
 720     $self->setfield('finger', $1);
 721
 722     $recref->{dir} =~ /^([\/\w\-]*)$/
 723       or return "Illegal directory";
 724     $recref->{dir} = $1;
 725     unless ( $recref->{dir} ) {
 726       $recref->{dir} = $dir_prefix . '/';
 727       if ( $dirhash > 0 ) {
 728         for my $h ( 1 .. $dirhash ) {
 729           $recref->{dir} .= substr($recref->{username}, $h-1, 1). '/';
 730         }
 731       } elsif ( $dirhash < 0 ) {
 732         for my $h ( reverse $dirhash .. -1 ) {
 733           $recref->{dir} .= substr($recref->{username}, $h, 1). '/';
 734         }
 735       }
 736       $recref->{dir} .= $recref->{username};
 737     ;
 738     }
 739
 740     unless ( $recref->{username} eq 'sync' ) {
 741       if ( grep $_ eq $recref->{shell}, @shells ) {
 742         $recref->{shell} = (grep $_ eq $recref->{shell}, @shells)[0];
 743       } else {
 744         return "Illegal shell \`". $self->shell. "\'; ".
 745                $conf->dir. "/shells contains: @shells";
 746       }
 747     } else {
 748       $recref->{shell} = '/bin/sync';
 749     }
 750
 751     $recref->{quota} =~ /^(\d*)$/ or return "Illegal quota (unimplemented)";
 752     $recref->{quota} = $1;
 753
 754   } else {
 755     $recref->{gid} ne '' ?
 756       return "Can't have gid without uid" : ( $recref->{gid}='' );
 757     $recref->{finger} ne '' ?
 758       return "Can't have finger-name without uid" : ( $recref->{finger}='' );
 759     $recref->{dir} ne '' ?
 760       return "Can't have directory without uid" : ( $recref->{dir}='' );
 761     $recref->{shell} ne '' ?
 762       return "Can't have shell without uid" : ( $recref->{shell}='' );
 763     $recref->{quota} ne '' ?
 764       return "Can't have quota without uid" : ( $recref->{quota}='' );
 765   }
 766
 767   unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) {
 768     unless ( $recref->{slipip} eq '0e0' ) {
 769       $recref->{slipip} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/
 770         or return "Illegal slipip". $self->slipip;
 771       $recref->{slipip} = $1;
 772     } else {
 773       $recref->{slipip} = '0e0';
 774     }
 775
 776   }
 777
 778   #arbitrary RADIUS stuff; allow ut_textn for now
 779   foreach ( grep /^radius_/, fields('svc_acct') ) {
 780     $self->ut_textn($_);
 781   }
 782
 783   #generate a password if it is blank
 784   $recref->{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) )
 785     unless ( $recref->{_password} );
 786
 787   #if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,16})$/ ) {
 788   if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{$passwordmin,8})$/ ) {
 789     $recref->{_password} = $1.$3;
 790     #uncomment this to encrypt password immediately upon entry, or run
 791     #bin/crypt_pw in cron to give new users a window during which their
 792     #password is available to techs, for faxing, etc.  (also be aware of
 793     #radius issues!)
 794     #$recref->{password} = $1.
 795     #  crypt($3,$saltset[int(rand(64))].$saltset[int(rand(64))]
 796     #;
 797   } elsif ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([\w\.\/\$]{13,34})$/ ) {
 798     $recref->{_password} = $1.$3;
 799   } elsif ( $recref->{_password} eq '*' ) {
 800     $recref->{_password} = '*';
 801   } elsif ( $recref->{_password} eq '!!' ) {
 802     $recref->{_password} = '!!';
 803   } else {
 804     return "Illegal password";
 805   }
 806
 807   ''; #no error
 808 }
 809
 810 =item radius
 811
 812 Depriciated, use radius_reply instead.
 813
 814 =cut
 815
 816 sub radius {
 817   carp "FS::svc_acct::radius depriciated, use radius_reply";
 818   $_[0]->radius_reply;
 819 }
 820
 821 =item radius_reply
 822
 823 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
 824 reply attributes of this record.
 825
 826 Note that this is now the preferred method for reading RADIUS attributes -
 827 accessing the columns directly is discouraged, as the column names are
 828 expected to change in the future.
 829
 830 =cut
 831
 832 sub radius_reply {
 833   my $self = shift;
 834   map {
 835     /^(radius_(.*))$/;
 836     my($column, $attrib) = ($1, $2);
 837     #$attrib =~ s/_/\-/g;
 838     ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
 839   } grep { /^radius_/ && $self->getfield($_) } fields( $self->table );
 840 }
 841
 842 =item radius_check
 843
 844 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
 845 check attributes of this record.
 846
 847 Accessing RADIUS attributes directly is not supported and will break in the
 848 future.
 849
 850 =cut
 851
 852 sub radius_check {
 853   my $self = shift;
 854   map {
 855     /^(rc_(.*))$/;
 856     my($column, $attrib) = ($1, $2);
 857     #$attrib =~ s/_/\-/g;
 858     ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
 859   } grep { /^rc_/ && $self->getfield($_) } fields( $self->table );
 860 }
 861
 862 =item domain
 863
 864 Returns the domain associated with this account.
 865
 866 =cut
 867
 868 sub domain {
 869   my $self = shift;
 870   if ( $self->domsvc ) {
 871     my $svc_domain = qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } )
 872       or die "no svc_domain.svcnum for svc_acct.domsvc ". $self->domsvc;
 873     $svc_domain->domain;
 874   } else {
 875     $mydomain or die "svc_acct.domsvc is null and no legacy domain config file";
 876   }
 877 }
 878
 879 =item email
 880
 881 Returns an email address associated with the account.
 882
 883 =cut
 884
 885 sub email {
 886   my $self = shift;
 887   $self->username. '@'. $self->domain;
 888 }
 889
 890 =item ssh
 891
 892 =cut
 893
 894 sub ssh {
 895   my ( $host, @cmd_and_args ) = @_;
 896
 897   use IO::File;
 898   my $reader = IO::File->new();
 899   my $writer = IO::File->new();
 900   my $error = IO::File->new();
 901
 902   &Net::SSH::sshopen3( $host, $reader, $writer, $error, @cmd_and_args) or die $!;
 903
 904   local $/ = undef;
 905   my $output_stream = <$writer>;
 906   my $error_stream = <$error>;
 907   if ( length $error_stream ) {
 908     #warn "[FS::svc_acct::ssh] STDERR $error_stream";
 909     die "[FS::svc_acct::ssh] STDERR $error_stream";
 910   }
 911   if ( length $output_stream ) {
 912     warn "[FS::svc_acct::ssh] STDOUT $output_stream";
 913   }
 914
 915 #  &Net::SSH::ssh(@args,">>/usr/local/etc/freeside/sshoutput 2>&1");
 916 }
 917
 918 =back
 919
 920 =head1 VERSION
 921
 922 $Id: svc_acct.pm,v 1.47 2001-09-30 20:30:09 ivan Exp $
 923
 924 =head1 BUGS
 925
 926 The bits which ssh should fork before doing so (or maybe queue jobs for a
 927 daemon).
 928
 929 The $recref stuff in sub check should be cleaned up.
 930
 931 The suspend, unsuspend and cancel methods update the database, but not the
 932 current object.  This is probably a bug as it's unexpected and
 933 counterintuitive.
 934
 935 =head1 SEE ALSO
 936
 937 L<FS::svc_Common>, L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>,
 938 L<FS::part_svc>, L<FS::cust_pkg>, L<FS::queue>, L<freeside-queued>),
 939 L<Net::SSH>, L<ssh>, L<FS::svc_acct_pop>,
 940 schema.html from the base documentation.
 941
 942 =cut
 943
 944 1;
 945