FS/FS/svc_acct.pm

   1 package FS::svc_acct;
   2
   3 use strict;
   4 use vars qw( @ISA $nossh_hack $noexport_hack $conf
   5              $dir_prefix @shells $usernamemin
   6              $usernamemax $passwordmin $passwordmax
   7              $username_ampersand $username_letter $username_letterfirst
   8              $username_noperiod $username_uppercase
   9              $shellmachine $useradd $usermod $userdel $mydomain
  10              $cyrus_server $cyrus_admin_user $cyrus_admin_pass
  11              $cp_server $cp_user $cp_pass $cp_workgroup
  12              $dirhash
  13              @saltset @pw_set
  14              $rsync $ssh $exportdir $vpopdir);
  15 use Carp;
  16 use File::Path;
  17 use Fcntl qw(:flock);
  18 use FS::UID qw( datasrc );
  19 use FS::Conf;
  20 use FS::Record qw( qsearch qsearchs fields dbh );
  21 use FS::svc_Common;
  22 use Net::SSH;
  23 use FS::part_svc;
  24 use FS::svc_acct_pop;
  25 use FS::svc_acct_sm;
  26 use FS::cust_main_invoice;
  27 use FS::svc_domain;
  28 use FS::raddb;
  29 use FS::queue;
  30 use FS::radius_usergroup;
  31
  32 @ISA = qw( FS::svc_Common );
  33
  34 #ask FS::UID to run this stuff for us later
  35 $FS::UID::callback{'FS::svc_acct'} = sub {
  36   $rsync = "rsync";
  37   $ssh = "ssh";
  38   $conf = new FS::Conf;
  39   $dir_prefix = $conf->config('home');
  40   @shells = $conf->config('shells');
  41   $shellmachine = $conf->config('shellmachine');
  42   $usernamemin = $conf->config('usernamemin') || 2;
  43   $usernamemax = $conf->config('usernamemax');
  44   $passwordmin = $conf->config('passwordmin') || 6;
  45   $passwordmax = $conf->config('passwordmax') || 8;
  46   if ( $shellmachine ) {
  47     if ( $conf->exists('shellmachine-useradd') ) {
  48       $useradd = join("\n", $conf->config('shellmachine-useradd') )
  49                  || 'cp -pr /etc/skel $dir; chown -R $uid.$gid $dir';
  50     } else {
  51       $useradd = 'useradd -d $dir -m -s $shell -u $uid $username';
  52     }
  53     if ( $conf->exists('shellmachine-userdel') ) {
  54       $userdel = join("\n", $conf->config('shellmachine-userdel') )
  55                  || 'rm -rf $dir';
  56     } else {
  57       $userdel = 'userdel $username';
  58     }
  59     $usermod = join("\n", $conf->config('shellmachine-usermod') )
  60                || '[ -d $old_dir ] && mv $old_dir $new_dir || ( '.
  61                     'chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; '.
  62                     'find . -depth -print | cpio -pdm $new_dir; '.
  63                     'chmod u-t $new_dir; chown -R $uid.$gid $new_dir; '.
  64                     'rm -rf $old_dir'.
  65                   ')';
  66   }
  67   $username_letter = $conf->exists('username-letter');
  68   $username_letterfirst = $conf->exists('username-letterfirst');
  69   $username_noperiod = $conf->exists('username-noperiod');
  70   $username_uppercase = $conf->exists('username-uppercase');
  71   $username_ampersand = $conf->exists('username-ampersand');
  72   $mydomain = $conf->config('domain');
  73   if ( $conf->exists('cyrus') ) {
  74     ($cyrus_server, $cyrus_admin_user, $cyrus_admin_pass) =
  75       $conf->config('cyrus');
  76     eval "use Cyrus::IMAP::Admin;"
  77   } else {
  78     $cyrus_server = '';
  79     $cyrus_admin_user = '';
  80     $cyrus_admin_pass = '';
  81   }
  82   if ( $conf->exists('cp_app') ) {
  83     ($cp_server, $cp_user, $cp_pass, $cp_workgroup) =
  84       $conf->config('cp_app');
  85     eval "use Net::APP;"
  86   } else {
  87     $cp_server = '';
  88     $cp_user = '';
  89     $cp_pass = '';
  90     $cp_workgroup = '';
  91   }
  92
  93   $dirhash = $conf->config('dirhash') || 0;
  94   $exportdir = "/usr/local/etc/freeside/export." . datasrc;
  95   if ( $conf->exists('vpopmailmachines') ) {
  96     my (@vpopmailmachines) = $conf->config('vpopmailmachines');
  97     my ($machine, $dir, $uid, $gid) = split (/\s+/, $vpopmailmachines[0]);
  98     $vpopdir = $dir;
  99   } else {
 100     $vpopdir = '';
 101   }
 102 };
 103
 104 @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
 105 @pw_set = ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '!', '.', ',' );
 106
 107 #not needed in 5.004 #srand($$|time);
 108
 109 sub _cache {
 110   my $self = shift;
 111   my ( $hashref, $cache ) = @_;
 112   if ( $hashref->{'svc_acct_svcnum'} ) {
 113     $self->{'_domsvc'} = FS::svc_domain->new( {
 114       'svcnum'   => $hashref->{'domsvc'},
 115       'domain'   => $hashref->{'svc_acct_domain'},
 116       'catchall' => $hashref->{'svc_acct_catchall'},
 117     } );
 118   }
 119 }
 120
 121 =head1 NAME
 122
 123 FS::svc_acct - Object methods for svc_acct records
 124
 125 =head1 SYNOPSIS
 126
 127   use FS::svc_acct;
 128
 129   $record = new FS::svc_acct \%hash;
 130   $record = new FS::svc_acct { 'column' => 'value' };
 131
 132   $error = $record->insert;
 133
 134   $error = $new_record->replace($old_record);
 135
 136   $error = $record->delete;
 137
 138   $error = $record->check;
 139
 140   $error = $record->suspend;
 141
 142   $error = $record->unsuspend;
 143
 144   $error = $record->cancel;
 145
 146   %hash = $record->radius;
 147
 148   %hash = $record->radius_reply;
 149
 150   %hash = $record->radius_check;
 151
 152   $domain = $record->domain;
 153
 154   $svc_domain = $record->svc_domain;
 155
 156   $email = $record->email;
 157
 158   $seconds_since = $record->seconds_since($timestamp);
 159
 160 =head1 DESCRIPTION
 161
 162 An FS::svc_acct object represents an account.  FS::svc_acct inherits from
 163 FS::svc_Common.  The following fields are currently supported:
 164
 165 =over 4
 166
 167 =item svcnum - primary key (assigned automatcially for new accounts)
 168
 169 =item username
 170
 171 =item _password - generated if blank
 172
 173 =item popnum - Point of presence (see L<FS::svc_acct_pop>)
 174
 175 =item uid
 176
 177 =item gid
 178
 179 =item finger - GECOS
 180
 181 =item dir - set automatically if blank (and uid is not)
 182
 183 =item shell
 184
 185 =item quota - (unimplementd)
 186
 187 =item slipip - IP address
 188
 189 =item seconds -
 190
 191 =item domsvc - svcnum from svc_domain
 192
 193 =item radius_I<Radius_Attribute> - I<Radius-Attribute>
 194
 195 =item domsvc - service number of svc_domain with which to associate
 196
 197 =back
 198
 199 =head1 METHODS
 200
 201 =over 4
 202
 203 =item new HASHREF
 204
 205 Creates a new account.  To add the account to the database, see L<"insert">.
 206
 207 =cut
 208
 209 sub table { 'svc_acct'; }
 210
 211 =item insert
 212
 213 Adds this account to the database.  If there is an error, returns the error,
 214 otherwise returns false.
 215
 216 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
 217 defined.  An FS::cust_svc record will be created and inserted.
 218
 219 If the configuration value (see L<FS::Conf>) shellmachine exists, and the
 220 username, uid, and dir fields are defined, the command(s) specified in
 221 the shellmachine-useradd configuration are added to the job queue (see
 222 L<FS::queue> and L<freeside-queued>) to be exectued on shellmachine via ssh.
 223 This behaviour can be surpressed by setting $FS::svc_acct::nossh_hack true.
 224 If the shellmachine-useradd configuration file does not exist,
 225
 226   useradd -d $dir -m -s $shell -u $uid $username
 227
 228 is the default.  If the shellmachine-useradd configuration file exists but
 229 it empty,
 230
 231   cp -pr /etc/skel $dir; chown -R $uid.$gid $dir
 232
 233 is the default instead.  Otherwise the contents of the file are treated as
 234 a double-quoted perl string, with the following variables available:
 235 $username, $uid, $gid, $dir, and $shell.
 236
 237 (TODOC: cyrus config file, L<FS::queue> and L<freeside-queued>)
 238
 239 (TODOC: new exports! $noexport_hack)
 240
 241 =cut
 242
 243 sub insert {
 244   my $self = shift;
 245   my $error;
 246
 247   local $SIG{HUP} = 'IGNORE';
 248   local $SIG{INT} = 'IGNORE';
 249   local $SIG{QUIT} = 'IGNORE';
 250   local $SIG{TERM} = 'IGNORE';
 251   local $SIG{TSTP} = 'IGNORE';
 252   local $SIG{PIPE} = 'IGNORE';
 253
 254   my $oldAutoCommit = $FS::UID::AutoCommit;
 255   local $FS::UID::AutoCommit = 0;
 256   my $dbh = dbh;
 257
 258   my $amount = 0;
 259
 260   $error = $self->check;
 261   return $error if $error;
 262
 263   return "Username ". $self->username. " in use"
 264     if qsearchs( 'svc_acct', { 'username' => $self->username,
 265                                'domsvc'   => $self->domsvc,
 266                              } );
 267
 268   if ( $self->svcnum ) {
 269     my $cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum});
 270     unless ( $cust_svc ) {
 271       $dbh->rollback if $oldAutoCommit;
 272       return "no cust_svc record found for svcnum ". $self->svcnum;
 273     }
 274     $self->pkgnum($cust_svc->pkgnum);
 275     $self->svcpart($cust_svc->svcpart);
 276   }
 277
 278   my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
 279   return "Unknown svcpart" unless $part_svc;
 280   return "uid in use"
 281     if $part_svc->part_svc_column('uid')->columnflag ne 'F'
 282       && qsearchs( 'svc_acct', { 'uid' => $self->uid } )
 283       && $self->username !~ /^(hyla)?fax$/
 284     ;
 285
 286   $error = $self->SUPER::insert;
 287   if ( $error ) {
 288     $dbh->rollback if $oldAutoCommit;
 289     return $error;
 290   }
 291
 292   #new-style exports!
 293   unless ( $noexport_hack ) {
 294     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
 295       my $error = $part_export->export_insert($self);
 296       if ( $error ) {
 297         $dbh->rollback if $oldAutoCommit;
 298         return "exporting to ". $part_export->exporttype.
 299                " (transaction rolled back): $error";
 300       }
 301     }
 302   }
 303
 304   #old-style exports
 305
 306   my( $username, $uid, $gid, $dir, $shell ) = (
 307     $self->username,
 308     $self->uid,
 309     $self->gid,
 310     $self->dir,
 311     $self->shell,
 312   );
 313   if ( $username && $uid && $dir && $shellmachine && ! $nossh_hack ) {
 314     my $queue = new FS::queue {
 315       'svcnum' => $self->svcnum,
 316       'job' => 'Net::SSH::ssh_cmd',
 317     };
 318     $error = $queue->insert("root\@$shellmachine", eval qq("$useradd") );
 319     if ( $error ) {
 320       $dbh->rollback if $oldAutoCommit;
 321       return "queueing job (transaction rolled back): $error";
 322     }
 323   }
 324
 325   if ( $cyrus_server ) {
 326     my $queue = new FS::queue {
 327       'svcnum' => $self->svcnum,
 328       'job'    => 'FS::svc_acct::cyrus_insert',
 329     };
 330     $error = $queue->insert($self->username, $self->quota);
 331     if ( $error ) {
 332       $dbh->rollback if $oldAutoCommit;
 333       return "queueing job (transaction rolled back): $error";
 334     }
 335   }
 336
 337   if ( $cp_server ) {
 338     my $queue = new FS::queue {
 339       'svcnum' => $self->svcnum,
 340       'job'    => 'FS::svc_acct::cp_insert'
 341     };
 342     $error = $queue->insert($self->username, $self->_password);
 343     if ( $error ) {
 344       $dbh->rollback if $oldAutoCommit;
 345       return "queueing job (transaction rolled back): $error";
 346     }
 347   }
 348
 349   if ( $vpopdir ) {
 350
 351     my $vpopmail_queue =
 352       new FS::queue {
 353       'svcnum' => $self->svcnum,
 354       'job' => 'FS::svc_acct::vpopmail_insert'
 355     };
 356     $error = $vpopmail_queue->insert( $self->username,
 357       crypt($self->_password,$saltset[int(rand(64))].$saltset[int(rand(64))]),
 358                                       $self->domain,
 359                                       $vpopdir,
 360                                     );
 361     if ( $error ) {
 362       $dbh->rollback if $oldAutoCommit;
 363       return "queueing job (transaction rolled back): $error";
 364     }
 365
 366   }
 367
 368   #end of old-style exports
 369
 370   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 371   ''; #no error
 372 }
 373
 374 sub cyrus_insert {
 375   my( $username, $quota ) = @_;
 376
 377   warn "cyrus_insert: starting for user $username, quota $quota\n";
 378
 379   warn "cyrus_insert: connecting to $cyrus_server\n";
 380   my $client = Cyrus::IMAP::Admin->new($cyrus_server);
 381
 382   warn "cyrus_insert: authentication as $cyrus_admin_user\n";
 383   $client->authenticate(
 384     -user      => $cyrus_admin_user,
 385     -mechanism => "login",
 386     -password  => $cyrus_admin_pass
 387   );
 388
 389   warn "cyrus_insert: creating user.$username\n";
 390   my $rc = $client->create("user.$username");
 391   my $error = $client->error;
 392   die "cyrus_insert: error creating user.$username: $error" if $error;
 393
 394   warn "cyrus_insert: setacl user.$username, $username => all\n";
 395   $rc = $client->setacl("user.$username", $username => 'all' );
 396   $error = $client->error;
 397   die "cyrus_insert: error setacl user.$username: $error" if $error;
 398
 399   if ( $quota ) {
 400     warn "cyrus_insert: setquota user.$username, STORAGE => $quota\n";
 401     $rc = $client->setquota("user.$username", 'STORAGE' => $quota );
 402     $error = $client->error;
 403     die "cyrus_insert: error setquota user.$username: $error" if $error;
 404   }
 405
 406   1;
 407 }
 408
 409 sub cp_insert {
 410   my( $username, $password ) = @_;
 411
 412   my $app = new Net::APP ( $cp_server,
 413                         User     => $cp_user,
 414                         Password => $cp_pass,
 415                         Domain   => $mydomain,
 416                         Timeout  => 60,
 417                         #Debug    => 1,
 418                       ) or die "$@\n";
 419
 420   $app->create_mailbox(
 421                         Mailbox   => $username,
 422                         Password  => $password,
 423                         Workgroup => $cp_workgroup,
 424                         Domain    => $mydomain,
 425                       );
 426
 427   die $app->message."\n" unless $app->ok;
 428 }
 429
 430 sub vpopmail_insert {
 431   my( $username, $password, $domain, $vpopdir ) = @_;
 432
 433   (open(VPASSWD, ">>$exportdir/domains/$domain/vpasswd")
 434     and flock(VPASSWD,LOCK_EX)
 435   ) or die "can't open vpasswd file for $username\@$domain: $exportdir/domains/$domain/vpasswd";
 436   print VPASSWD join(":",
 437     $username,
 438     $password,
 439     '1',
 440     '0',
 441     $username,
 442     "$vpopdir/domains/$domain/$username",
 443     'NOQUOTA',
 444   ), "\n";
 445
 446   flock(VPASSWD,LOCK_UN);
 447   close(VPASSWD);
 448
 449   mkdir "$exportdir/domains/$domain/$username", 0700  or die "can't create Maildir";
 450   mkdir "$exportdir/domains/$domain/$username/Maildir", 0700 or die "can't create Maildir";
 451   mkdir "$exportdir/domains/$domain/$username/Maildir/cur", 0700 or die "can't create Maildir";
 452   mkdir "$exportdir/domains/$domain/$username/Maildir/new", 0700 or die "can't create Maildir";
 453   mkdir "$exportdir/domains/$domain/$username/Maildir/tmp", 0700 or die "can't create Maildir";
 454
 455   my $queue = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_sync' };
 456   my $error = $queue->insert;
 457   die $error if $error;
 458
 459   1;
 460 }
 461
 462 sub vpopmail_sync {
 463
 464   my (@vpopmailmachines) = $conf->config('vpopmailmachines');
 465   my ($machine, $dir, $uid, $gid) = split (/\s+/, $vpopmailmachines[0]);
 466
 467   chdir $exportdir;
 468   my @args = ("$rsync", "-rlpt", "-e", "$ssh", "domains/", "vpopmail\@$machine:$vpopdir/domains/");
 469   system {$args[0]} @args;
 470
 471 }
 472
 473 =item delete
 474
 475 Deletes this account from the database.  If there is an error, returns the
 476 error, otherwise returns false.
 477
 478 The corresponding FS::cust_svc record will be deleted as well.
 479
 480 If the configuration value (see L<FS::Conf>) shellmachine exists, the
 481 command(s) specified in the shellmachine-userdel configuration file are
 482 added to the job queue (see L<FS::queue> and L<freeside-queued>) to be executed
 483 on shellmachine via ssh.  This behavior can be surpressed by setting
 484 $FS::svc_acct::nossh_hack true.  If the shellmachine-userdel configuration
 485 file does not exist,
 486
 487   userdel $username
 488
 489 is the default.  If the shellmachine-userdel configuration file exists but
 490 is empty,
 491
 492   rm -rf $dir
 493
 494 is the default instead.  Otherwise the contents of the file are treated as a
 495 double-quoted perl string, with the following variables available:
 496 $username and $dir.
 497
 498 (TODOC: cyrus config file)
 499
 500 (TODOC: new exports! $noexport_hack)
 501
 502 =cut
 503
 504 sub delete {
 505   my $self = shift;
 506
 507   if ( defined( $FS::Record::dbdef->table('svc_acct_sm') ) ) {
 508     return "Can't delete an account which has (svc_acct_sm) mail aliases!"
 509       if $self->uid && qsearch( 'svc_acct_sm', { 'domuid' => $self->uid } );
 510   }
 511
 512   return "Can't delete an account which is a (svc_forward) source!"
 513     if qsearch( 'svc_forward', { 'srcsvc' => $self->svcnum } );
 514
 515   return "Can't delete an account which is a (svc_forward) destination!"
 516     if qsearch( 'svc_forward', { 'dstsvc' => $self->svcnum } );
 517
 518   return "Can't delete an account with (svc_www) web service!"
 519     if qsearch( 'svc_www', { 'usersvc' => $self->usersvc } );
 520
 521   # what about records in session ? (they should refer to history table)
 522
 523   local $SIG{HUP} = 'IGNORE';
 524   local $SIG{INT} = 'IGNORE';
 525   local $SIG{QUIT} = 'IGNORE';
 526   local $SIG{TERM} = 'IGNORE';
 527   local $SIG{TSTP} = 'IGNORE';
 528   local $SIG{PIPE} = 'IGNORE';
 529
 530   my $oldAutoCommit = $FS::UID::AutoCommit;
 531   local $FS::UID::AutoCommit = 0;
 532   my $dbh = dbh;
 533
 534   foreach my $cust_main_invoice (
 535     qsearch( 'cust_main_invoice', { 'dest' => $self->svcnum } )
 536   ) {
 537     unless ( defined($cust_main_invoice) ) {
 538       warn "WARNING: something's wrong with qsearch";
 539       next;
 540     }
 541     my %hash = $cust_main_invoice->hash;
 542     $hash{'dest'} = $self->email;
 543     my $new = new FS::cust_main_invoice \%hash;
 544     my $error = $new->replace($cust_main_invoice);
 545     if ( $error ) {
 546       $dbh->rollback if $oldAutoCommit;
 547       return $error;
 548     }
 549   }
 550
 551   foreach my $svc_domain (
 552     qsearch( 'svc_domain', { 'catchall' => $self->svcnum } )
 553   ) {
 554     my %hash = new FS::svc_domain->hash;
 555     $hash{'catchall'} = '';
 556     my $new = new FS::svc_domain \%hash;
 557     my $error = $new->replace($svc_domain);
 558     if ( $error ) {
 559       $dbh->rollback if $oldAutoCommit;
 560       return $error;
 561     }
 562   }
 563
 564   my $error = $self->SUPER::delete;
 565   if ( $error ) {
 566     $dbh->rollback if $oldAutoCommit;
 567     return $error;
 568   }
 569
 570   #new-style exports!
 571   unless ( $noexport_hack ) {
 572     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
 573       my $error = $part_export->export_delete($self);
 574       if ( $error ) {
 575         $dbh->rollback if $oldAutoCommit;
 576         return "exporting to ". $part_export->exporttype.
 577                " (transaction rolled back): $error";
 578       }
 579     }
 580   }
 581
 582   #old-style exports
 583
 584   my( $username, $dir ) = (
 585     $self->username,
 586     $self->dir,
 587   );
 588   if ( $username && $shellmachine && ! $nossh_hack ) {
 589     my $queue = new FS::queue { 'job' => 'Net::SSH::ssh_cmd' };
 590     $error = $queue->insert("root\@$shellmachine", eval qq("$userdel") );
 591     if ( $error ) {
 592       $dbh->rollback if $oldAutoCommit;
 593       return "queueing job (transaction rolled back): $error";
 594     }
 595
 596   }
 597
 598   if ( $cyrus_server ) {
 599     my $queue = new FS::queue { 'job' => 'FS::svc_acct::cyrus_delete' };
 600     $error = $queue->insert($self->username);
 601     if ( $error ) {
 602       $dbh->rollback if $oldAutoCommit;
 603       return "queueing job (transaction rolled back): $error";
 604     }
 605   }
 606
 607   if ( $cp_server ) {
 608     my $queue = new FS::queue { 'job' => 'FS::svc_acct::cp_delete' };
 609     $error = $queue->insert($self->username);
 610     if ( $error ) {
 611       $dbh->rollback if $oldAutoCommit;
 612       return "queueing job (transaction rolled back): $error";
 613     }
 614   }
 615
 616   if ( $vpopdir ) {
 617     my $queue = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_delete' };
 618     $error = $queue->insert( $self->username, $self->domain );
 619     if ( $error ) {
 620       $dbh->rollback if $oldAutoCommit;
 621       return "queueing job (transaction rolled back): $error";
 622     }
 623
 624   }
 625
 626   #end of old-style exports
 627
 628   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 629   '';
 630 }
 631
 632 sub cyrus_delete {
 633   my $username = shift;
 634
 635   my $client = Cyrus::IMAP::Admin->new($cyrus_server);
 636   $client->authenticate(
 637     -user      => $cyrus_admin_user,
 638     -mechanism => "login",
 639     -password  => $cyrus_admin_pass
 640   );
 641
 642   my $rc = $client->setacl("user.$username", $cyrus_admin_user => 'all' );
 643   my $error = $client->error;
 644   die $error if $error;
 645
 646   $rc = $client->delete("user.$username");
 647   $error = $client->error;
 648   die $error if $error;
 649
 650   1;
 651 }
 652
 653 sub cp_delete {
 654   my( $username ) = @_;
 655   my $app = new Net::APP ( $cp_server,
 656                         User     => $cp_user,
 657                         Password => $cp_pass,
 658                         Domain   => $mydomain,
 659                         Timeout  => 60,
 660                         #Debug    => 1,
 661                       ) or die "$@\n";
 662
 663   $app->delete_mailbox(
 664                         Mailbox   => $username,
 665                         Domain    => $mydomain,
 666                       );
 667
 668   die $app->message."\n" unless $app->ok;
 669 }
 670
 671 sub vpopmail_delete {
 672   my( $username, $domain ) = @_;
 673
 674   (open(VPASSWD, "$exportdir/domains/$domain/vpasswd")
 675     and flock(VPASSWD,LOCK_EX)
 676   ) or die "can't open $exportdir/domains/$domain/vpasswd: $!";
 677
 678   open(VPASSWDTMP, ">$exportdir/domains/$domain/vpasswd.tmp")
 679     or die "Can't open $exportdir/domains/$domain/vpasswd.tmp: $!";
 680
 681   while (<VPASSWD>) {
 682     my ($mailbox, $rest) = split(':', $_);
 683     print VPASSWDTMP $_ unless $username eq $mailbox;
 684   }
 685
 686   close(VPASSWDTMP);
 687
 688   rename "$exportdir/domains/$domain/vpasswd.tmp", "$exportdir/domains/$domain/vpasswd"
 689     or die "Can't rename $exportdir/domains/$domain/vpasswd.tmp: $!";
 690
 691   flock(VPASSWD,LOCK_UN);
 692   close(VPASSWD);
 693
 694   rmtree "$exportdir/domains/$domain/$username" or die "can't destroy Maildir";+
 695   1;
 696 }
 697
 698 =item replace OLD_RECORD
 699
 700 Replaces OLD_RECORD with this one in the database.  If there is an error,
 701 returns the error, otherwise returns false.
 702
 703 If the configuration value (see L<FS::Conf>) shellmachine exists, and the
 704 dir field has changed, the command(s) specified in the shellmachine-usermod
 705 configuraiton file are added to the job queue (see L<FS::queue> and
 706 L<freeside-queued>) to be executed on shellmachine via ssh.  This behavior can
 707 be surpressed by setting $FS::svc-acct::nossh_hack true.  If the
 708 shellmachine-userdel configuration file does not exist or is empty,
 709
 710   [ -d $old_dir ] && mv $old_dir $new_dir || (
 711     chmod u+t $old_dir;
 712     mkdir $new_dir;
 713     cd $old_dir;
 714     find . -depth -print | cpio -pdm $new_dir;
 715     chmod u-t $new_dir;
 716     chown -R $uid.$gid $new_dir;
 717     rm -rf $old_dir
 718   )
 719
 720 is the default.  This behaviour can be surpressed by setting
 721 $FS::svc_acct::nossh_hack true.
 722
 723 =cut
 724
 725 sub replace {
 726   my ( $new, $old ) = ( shift, shift );
 727   my $error;
 728
 729   return "Username in use"
 730     if $old->username ne $new->username &&
 731       qsearchs( 'svc_acct', { 'username' => $new->username,
 732                                'domsvc'   => $new->domsvc,
 733                              } );
 734   {
 735     #no warnings 'numeric';  #alas, a 5.006-ism
 736     local($^W) = 0;
 737     return "Can't change uid!" if $old->uid != $new->uid;
 738   }
 739
 740   return "can't change username using Cyrus"
 741     if $cyrus_server && $old->username ne $new->username;
 742
 743   #change homdir when we change username
 744   $new->setfield('dir', '') if $old->username ne $new->username;
 745
 746   local $SIG{HUP} = 'IGNORE';
 747   local $SIG{INT} = 'IGNORE';
 748   local $SIG{QUIT} = 'IGNORE';
 749   local $SIG{TERM} = 'IGNORE';
 750   local $SIG{TSTP} = 'IGNORE';
 751   local $SIG{PIPE} = 'IGNORE';
 752
 753   my $oldAutoCommit = $FS::UID::AutoCommit;
 754   local $FS::UID::AutoCommit = 0;
 755   my $dbh = dbh;
 756
 757   $error = $new->SUPER::replace($old);
 758   if ( $error ) {
 759     $dbh->rollback if $oldAutoCommit;
 760     return $error if $error;
 761   }
 762
 763   #new-style exports!
 764   unless ( $noexport_hack ) {
 765     foreach my $part_export ( $new->cust_svc->part_svc->part_export ) {
 766       my $error = $part_export->export_replace($new,$old);
 767       if ( $error ) {
 768         $dbh->rollback if $oldAutoCommit;
 769         return "exporting to ". $part_export->exporttype.
 770                " (transaction rolled back): $error";
 771       }
 772     }
 773   }
 774
 775   #old-style exports
 776
 777   my ( $old_dir, $new_dir, $uid, $gid ) = (
 778     $old->getfield('dir'),
 779     $new->getfield('dir'),
 780     $new->getfield('uid'),
 781     $new->getfield('gid'),
 782   );
 783   if ( $old_dir && $new_dir && $old_dir ne $new_dir && ! $nossh_hack ) {
 784     my $queue = new FS::queue {
 785       'svcnum' => $new->svcnum,
 786       'job' => 'Net::SSH::ssh_cmd'
 787     };
 788     $error = $queue->insert("root\@$shellmachine", eval qq("$usermod") );
 789     if ( $error ) {
 790       $dbh->rollback if $oldAutoCommit;
 791       return "queueing job (transaction rolled back): $error";
 792     }
 793   }
 794
 795   if ( $cp_server && $old->username ne $new->username ) {
 796     my $queue = new FS::queue {
 797       'svcnum' => $new->svcnum,
 798       'job' => 'FS::svc_acct::cp_rename'
 799     };
 800     $error = $queue->insert( $old->username, $new->username );
 801     if ( $error ) {
 802       $dbh->rollback if $oldAutoCommit;
 803       return "queueing job (transaction rolled back): $error";
 804     }
 805   }
 806
 807   if ( $cp_server && $old->_password ne $new->_password ) {
 808     my $queue = new FS::queue {
 809       'svcnum' => $new->svcnum,
 810       'job' => 'FS::svc_acct::cp_change'
 811     };
 812     $error = $queue->insert( $new->username, $new->_password );
 813     if ( $error ) {
 814       $dbh->rollback if $oldAutoCommit;
 815       return "queueing job (transaction rolled back): $error";
 816     }
 817   }
 818
 819   if ( $vpopdir ) {
 820     my $cpassword = crypt(
 821       $new->_password,$saltset[int(rand(64))].$saltset[int(rand(64))]
 822     );
 823
 824     if ($old->username ne $new->username || $old->domain ne $new->domain ) {
 825       my $queue  = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_delete' };
 826         $error = $queue->insert( $old->username, $old->domain );
 827       my $queue2 = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_insert' };
 828         $error = $queue2->insert( $new->username,
 829                                   $cpassword,
 830                                   $new->domain,
 831                                   $vpopdir,
 832                                 )
 833         unless $error;
 834     } elsif ($old->_password ne $new->_password) {
 835       my $queue = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_replace_password' };
 836       $error = $queue->insert( $new->username, $cpassword, $new->domain );
 837     }
 838     if ( $error ) {
 839       $dbh->rollback if $oldAutoCommit;
 840       return "queueing job (transaction rolled back): $error";
 841     }
 842   }
 843
 844   #end of old-style exports
 845
 846   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 847   ''; #no error
 848 }
 849
 850 sub cp_rename {
 851   my ( $old_username, $new_username ) = @_;
 852
 853   my $app = new Net::APP ( $cp_server,
 854                         User     => $cp_user,
 855                         Password => $cp_pass,
 856                         Domain   => $mydomain,
 857                         Timeout  => 60,
 858                         #Debug    => 1,
 859                       ) or die "$@\n";
 860
 861   $app->rename_mailbox(
 862                         Domain        => $mydomain,
 863                         Old_Mailbox   => $old_username,
 864                         New_Mailbox   => $new_username,
 865                       );
 866
 867   die $app->message."\n" unless $app->ok;
 868
 869 }
 870
 871 sub cp_change {
 872   my ( $username, $password ) = @_;
 873
 874   my $app = new Net::APP ( $cp_server,
 875                         User     => $cp_user,
 876                         Password => $cp_pass,
 877                         Domain   => $mydomain,
 878                         Timeout  => 60,
 879                         #Debug    => 1,
 880                       ) or die "$@\n";
 881
 882   if ( $password =~ /^\*SUSPENDED\* (.*)$/ ) {
 883     $password = $1;
 884     $app->set_mailbox_status(
 885                               Domain       => $mydomain,
 886                               Mailbox      => $username,
 887                               Other        => 'T',
 888                               Other_Bounce => 'T',
 889                             );
 890   } else {
 891     $app->set_mailbox_status(
 892                               Domain       => $mydomain,
 893                               Mailbox      => $username,
 894                               Other        => 'F',
 895                               Other_Bounce => 'F',
 896                             );
 897   }
 898   die $app->message."\n" unless $app->ok;
 899
 900   $app->change_mailbox(
 901                         Domain    => $mydomain,
 902                         Mailbox   => $username,
 903                         Password  => $password,
 904                       );
 905   die $app->message."\n" unless $app->ok;
 906
 907 }
 908
 909 sub vpopmail_replace_password {
 910   my( $username, $password, $domain ) = @_;
 911
 912   (open(VPASSWD, "$exportdir/domains/$domain/vpasswd")
 913     and flock(VPASSWD,LOCK_EX)
 914   ) or die "can't open $exportdir/domains/$domain/vpasswd: $!";
 915
 916   open(VPASSWDTMP, ">$exportdir/domains/$domain/vpasswd.tmp")
 917     or die "Can't open $exportdir/domains/$domain/vpasswd.tmp: $!";
 918
 919   while (<VPASSWD>) {
 920     my ($mailbox, $pw, @rest) = split(':', $_);
 921     print VPASSWDTMP $_ unless $username eq $mailbox;
 922     print VPASSWDTMP join (':', ($mailbox, $password, @rest))
 923       if $username eq $mailbox;
 924   }
 925
 926   close(VPASSWDTMP);
 927
 928   rename "$exportdir/domains/$domain/vpasswd.tmp", "$exportdir/domains/$domain/vpasswd"
 929     or die "Can't rename $exportdir/domains/$domain/vpasswd.tmp: $!";
 930
 931   flock(VPASSWD,LOCK_UN);
 932   close(VPASSWD);
 933
 934   my $queue = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_sync' };
 935   my $error = $queue->insert;
 936   die $error if $error;
 937
 938   1;
 939 }
 940
 941
 942 =item suspend
 943
 944 Suspends this account by prefixing *SUSPENDED* to the password.  If there is an
 945 error, returns the error, otherwise returns false.
 946
 947 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 948
 949 =cut
 950
 951 sub suspend {
 952   my $self = shift;
 953   my %hash = $self->hash;
 954   unless ( $hash{_password} =~ /^\*SUSPENDED\* /
 955            || $hash{_password} eq '*'
 956          ) {
 957     $hash{_password} = '*SUSPENDED* '.$hash{_password};
 958     my $new = new FS::svc_acct ( \%hash );
 959     $new->replace($self);
 960   } else {
 961     ''; #no error (already suspended)
 962   }
 963 }
 964
 965 =item unsuspend
 966
 967 Unsuspends this account by removing *SUSPENDED* from the password.  If there is
 968 an error, returns the error, otherwise returns false.
 969
 970 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 971
 972 =cut
 973
 974 sub unsuspend {
 975   my $self = shift;
 976   my %hash = $self->hash;
 977   if ( $hash{_password} =~ /^\*SUSPENDED\* (.*)$/ ) {
 978     $hash{_password} = $1;
 979     my $new = new FS::svc_acct ( \%hash );
 980     $new->replace($self);
 981   } else {
 982     ''; #no error (already unsuspended)
 983   }
 984 }
 985
 986 =item cancel
 987
 988 Just returns false (no error) for now.
 989
 990 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 991
 992 =item check
 993
 994 Checks all fields to make sure this is a valid service.  If there is an error,
 995 returns the error, otherwise returns false.  Called by the insert and replace
 996 methods.
 997
 998 Sets any fixed values; see L<FS::part_svc>.
 999
1000 =cut
1001
1002 sub check {
1003   my $self = shift;
1004
1005   my($recref) = $self->hashref;
1006
1007   my $x = $self->setfixed;
1008   return $x unless ref($x);
1009   my $part_svc = $x;
1010
1011   my $error = $self->ut_numbern('svcnum')
1012               || $self->ut_number('domsvc')
1013   ;
1014   return $error if $error;
1015
1016   my $ulen = $usernamemax || $self->dbdef_table->column('username')->length;
1017   if ( $username_uppercase ) {
1018     $recref->{username} =~ /^([a-z0-9_\-\.\&]{$usernamemin,$ulen})$/i
1019       or return "Illegal username: ". $recref->{username};
1020     $recref->{username} = $1;
1021   } else {
1022     $recref->{username} =~ /^([a-z0-9_\-\.\&]{$usernamemin,$ulen})$/
1023       or return "Illegal username: ". $recref->{username};
1024     $recref->{username} = $1;
1025   }
1026
1027   if ( $username_letterfirst ) {
1028     $recref->{username} =~ /^[a-z]/ or return "Illegal username";
1029   } elsif ( $username_letter ) {
1030     $recref->{username} =~ /[a-z]/ or return "Illegal username";
1031   }
1032   if ( $username_noperiod ) {
1033     $recref->{username} =~ /\./ and return "Illegal username";
1034   }
1035   unless ( $username_ampersand ) {
1036     $recref->{username} =~ /\&/ and return "Illegal username";
1037   }
1038
1039   $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum};
1040   $recref->{popnum} = $1;
1041   return "Unknown popnum" unless
1042     ! $recref->{popnum} ||
1043     qsearchs('svc_acct_pop',{'popnum'=> $recref->{popnum} } );
1044
1045   unless ( $part_svc->part_svc_column('uid')->columnflag eq 'F' ) {
1046
1047     $recref->{uid} =~ /^(\d*)$/ or return "Illegal uid";
1048     $recref->{uid} = $1 eq '' ? $self->unique('uid') : $1;
1049
1050     $recref->{gid} =~ /^(\d*)$/ or return "Illegal gid";
1051     $recref->{gid} = $1 eq '' ? $recref->{uid} : $1;
1052     #not all systems use gid=uid
1053     #you can set a fixed gid in part_svc
1054
1055     return "Only root can have uid 0"
1056       if $recref->{uid} == 0 && $recref->{username} ne 'root';
1057
1058 #    $error = $self->ut_textn('finger');
1059 #    return $error if $error;
1060     $self->getfield('finger') =~
1061       /^([\w \t\!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\*\<\>]*)$/
1062         or return "Illegal finger: ". $self->getfield('finger');
1063     $self->setfield('finger', $1);
1064
1065     $recref->{dir} =~ /^([\/\w\-\.\&]*)$/
1066       or return "Illegal directory";
1067     $recref->{dir} = $1;
1068     return "Illegal directory"
1069       if $recref->{dir} =~ /(^|\/)\.+(\/|$)/; #no .. component
1070     return "Illegal directory"
1071       if $recref->{dir} =~ /\&/ && ! $username_ampersand;
1072     unless ( $recref->{dir} ) {
1073       $recref->{dir} = $dir_prefix . '/';
1074       if ( $dirhash > 0 ) {
1075         for my $h ( 1 .. $dirhash ) {
1076           $recref->{dir} .= substr($recref->{username}, $h-1, 1). '/';
1077         }
1078       } elsif ( $dirhash < 0 ) {
1079         for my $h ( reverse $dirhash .. -1 ) {
1080           $recref->{dir} .= substr($recref->{username}, $h, 1). '/';
1081         }
1082       }
1083       $recref->{dir} .= $recref->{username};
1084     ;
1085     }
1086
1087     unless ( $recref->{username} eq 'sync' ) {
1088       if ( grep $_ eq $recref->{shell}, @shells ) {
1089         $recref->{shell} = (grep $_ eq $recref->{shell}, @shells)[0];
1090       } else {
1091         return "Illegal shell \`". $self->shell. "\'; ".
1092                $conf->dir. "/shells contains: @shells";
1093       }
1094     } else {
1095       $recref->{shell} = '/bin/sync';
1096     }
1097
1098     $recref->{quota} =~ /^(\d*)$/ or return "Illegal quota (unimplemented)";
1099     $recref->{quota} = $1;
1100
1101   } else {
1102     $recref->{gid} ne '' ?
1103       return "Can't have gid without uid" : ( $recref->{gid}='' );
1104     $recref->{finger} ne '' ?
1105       return "Can't have finger-name without uid" : ( $recref->{finger}='' );
1106     $recref->{dir} ne '' ?
1107       return "Can't have directory without uid" : ( $recref->{dir}='' );
1108     $recref->{shell} ne '' ?
1109       return "Can't have shell without uid" : ( $recref->{shell}='' );
1110     $recref->{quota} ne '' ?
1111       return "Can't have quota without uid" : ( $recref->{quota}='' );
1112   }
1113
1114   unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) {
1115     unless ( $recref->{slipip} eq '0e0' ) {
1116       $recref->{slipip} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/
1117         or return "Illegal slipip". $self->slipip;
1118       $recref->{slipip} = $1;
1119     } else {
1120       $recref->{slipip} = '0e0';
1121     }
1122
1123   }
1124
1125   #arbitrary RADIUS stuff; allow ut_textn for now
1126   foreach ( grep /^radius_/, fields('svc_acct') ) {
1127     $self->ut_textn($_);
1128   }
1129
1130   #generate a password if it is blank
1131   $recref->{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) )
1132     unless ( $recref->{_password} );
1133
1134   #if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,16})$/ ) {
1135   if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{$passwordmin,$passwordmax})$/ ) {
1136     $recref->{_password} = $1.$3;
1137     #uncomment this to encrypt password immediately upon entry, or run
1138     #bin/crypt_pw in cron to give new users a window during which their
1139     #password is available to techs, for faxing, etc.  (also be aware of
1140     #radius issues!)
1141     #$recref->{password} = $1.
1142     #  crypt($3,$saltset[int(rand(64))].$saltset[int(rand(64))]
1143     #;
1144   } elsif ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([\w\.\/\$]{13,34})$/ ) {
1145     $recref->{_password} = $1.$3;
1146   } elsif ( $recref->{_password} eq '*' ) {
1147     $recref->{_password} = '*';
1148   } elsif ( $recref->{_password} eq '!!' ) {
1149     $recref->{_password} = '!!';
1150   } else {
1151     #return "Illegal password";
1152     return "Illegal password: ". $recref->{_password};
1153   }
1154
1155   ''; #no error
1156 }
1157
1158 =item radius
1159
1160 Depriciated, use radius_reply instead.
1161
1162 =cut
1163
1164 sub radius {
1165   carp "FS::svc_acct::radius depriciated, use radius_reply";
1166   $_[0]->radius_reply;
1167 }
1168
1169 =item radius_reply
1170
1171 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
1172 reply attributes of this record.
1173
1174 Note that this is now the preferred method for reading RADIUS attributes -
1175 accessing the columns directly is discouraged, as the column names are
1176 expected to change in the future.
1177
1178 =cut
1179
1180 sub radius_reply {
1181   my $self = shift;
1182   my %reply =
1183     map {
1184       /^(radius_(.*))$/;
1185       my($column, $attrib) = ($1, $2);
1186       #$attrib =~ s/_/\-/g;
1187       ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
1188     } grep { /^radius_/ && $self->getfield($_) } fields( $self->table );
1189   if ( $self->ip && $self->ip ne '0e0' ) {
1190     $reply{'Framed-IP-Address'} = $self->ip;
1191   }
1192   %reply;
1193 }
1194
1195 =item radius_check
1196
1197 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
1198 check attributes of this record.
1199
1200 Note that this is now the preferred method for reading RADIUS attributes -
1201 accessing the columns directly is discouraged, as the column names are
1202 expected to change in the future.
1203
1204 =cut
1205
1206 sub radius_check {
1207   my $self = shift;
1208   ( 'Password' => $self->_password,
1209     map {
1210       /^(rc_(.*))$/;
1211       my($column, $attrib) = ($1, $2);
1212       #$attrib =~ s/_/\-/g;
1213       ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
1214     } grep { /^rc_/ && $self->getfield($_) } fields( $self->table )
1215   );
1216 }
1217
1218 =item domain
1219
1220 Returns the domain associated with this account.
1221
1222 =cut
1223
1224 sub domain {
1225   my $self = shift;
1226   if ( $self->domsvc ) {
1227     #$self->svc_domain->domain;
1228     my $svc_domain = $self->svc_domain
1229       or die "no svc_domain.svcnum for svc_acct.domsvc ". $self->domsvc;
1230     $svc_domain->domain;
1231   } else {
1232     $mydomain or die "svc_acct.domsvc is null and no legacy domain config file";
1233   }
1234 }
1235
1236 =item svc_domain
1237
1238 Returns the FS::svc_domain record for this account's domain (see
1239 L<FS::svc_domain>.
1240
1241 =cut
1242
1243 sub svc_domain {
1244   my $self = shift;
1245   $self->{'_domsvc'}
1246     ? $self->{'_domsvc'}
1247     : qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } );
1248 }
1249
1250 =item cust_svc
1251
1252 Returns the FS::cust_svc record for this account (see L<FS::cust_svc>).
1253
1254 sub cust_svc {
1255   my $self = shift;
1256   qsearchs( 'cust_svc', { 'svcnum' => $self->svcnum } );
1257 }
1258
1259 =item email
1260
1261 Returns an email address associated with the account.
1262
1263 =cut
1264
1265 sub email {
1266   my $self = shift;
1267   $self->username. '@'. $self->domain;
1268 }
1269
1270 =item seconds_since TIMESTAMP
1271
1272 Returns the number of seconds this account has been online since TIMESTAMP.
1273 See L<FS::session>
1274
1275 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
1276 L<Time::Local> and L<Date::Parse> for conversion functions.
1277
1278 =cut
1279
1280 #note: POD here, implementation in FS::cust_svc
1281 sub seconds_since {
1282   my $self = shift;
1283   $self->cust_svc->seconds_since(@_);
1284 }
1285
1286 =item radius_groups
1287
1288 Returns all RADIUS groups for this account (see L<FS::radius_usergroup>).
1289
1290 =cut
1291
1292 sub radius_groups {
1293   my $self = shift;
1294   map { $_->groupname }
1295     qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } );
1296 }
1297
1298 =back
1299
1300 =head1 SUBROUTINES
1301
1302 =item radius_usergroup_selector GROUPS_ARRAYREF
1303
1304 =cut
1305
1306 sub radius_usergroup_selector {
1307   my $sel_groups = shift;
1308   my %sel_groups = map { $_=>1 } @$sel_groups;
1309
1310   my $selectname = shift || 'radius_usergroup';
1311
1312   my $dbh = dbh;
1313   my $sth = $dbh->prepare(
1314     'SELECT DISTINCT(groupname) FROM radius_usergroup ORDER BY groupname'
1315   ) or die $dbh->errstr;
1316   $sth->execute() or die $sth->errstr;
1317   my @all_groups = map { $_->[0] } @{$sth->fetchall_arrayref};
1318
1319   my $html = <<END;
1320     <SCRIPT>
1321     function ${selectname}_doadd(object) {
1322       var myvalue = object.${selectname}_add.value;
1323       var optionName = new Option(myvalue,myvalue,false,true);
1324       var length = object.$selectname.length;
1325       object.$selectname.options[length] = optionName;
1326     }
1327     </SCRIPT>
1328     <SELECT MULTIPLE NAME="$selectname">
1329 END
1330
1331   foreach my $group ( @all_groups ) {
1332     $html .= '<OPTION';
1333     $html .= ' SELECTED' if $sel_groups{$group};
1334     $html .= ">$group</OPTION>\n";
1335   }
1336   $html .= '</SELECT>';
1337
1338   $html .= qq!<BR><INPUT TYPE="text" NAME="${selectname}_add">!.
1339            qq!<INPUT TYPE="button" VALUE="Add new group" onClick="${selectname}_doadd(this.form)">!;
1340
1341   $html;
1342 }
1343
1344 =head1 BUGS
1345
1346 The $recref stuff in sub check should be cleaned up.
1347
1348 The suspend, unsuspend and cancel methods update the database, but not the
1349 current object.  This is probably a bug as it's unexpected and
1350 counterintuitive.
1351
1352 radius_usergroup_selector?  putting web ui components in here?  they should
1353 probably live somewhere else...
1354
1355 =head1 SEE ALSO
1356
1357 L<FS::svc_Common>, edit/part_svc.cgi from an installed web interface,
1358 export.html from the base documentation, L<FS::Record>, L<FS::Conf>,
1359 L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, L<FS::queue>,
1360 L<freeside-queued>), L<Net::SSH>, L<ssh>, L<FS::svc_acct_pop>,
1361 schema.html from the base documentation.
1362
1363 =cut
1364
1365 1;
1366