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