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