FS/FS/svc_acct.pm

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