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