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