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