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