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   ;
1083   return $error if $error;
1084
1085   my $ulen = $usernamemax || $self->dbdef_table->column('username')->length;
1086   if ( $username_uppercase ) {
1087     $recref->{username} =~ /^([a-z0-9_\-\.\&]{$usernamemin,$ulen})$/i
1088       or return "Illegal username: ". $recref->{username};
1089     $recref->{username} = $1;
1090   } else {
1091     $recref->{username} =~ /^([a-z0-9_\-\.\&]{$usernamemin,$ulen})$/
1092       or return "Illegal username: ". $recref->{username};
1093     $recref->{username} = $1;
1094   }
1095
1096   if ( $username_letterfirst ) {
1097     $recref->{username} =~ /^[a-z]/ or return "Illegal username";
1098   } elsif ( $username_letter ) {
1099     $recref->{username} =~ /[a-z]/ or return "Illegal username";
1100   }
1101   if ( $username_noperiod ) {
1102     $recref->{username} =~ /\./ and return "Illegal username";
1103   }
1104   unless ( $username_ampersand ) {
1105     $recref->{username} =~ /\&/ and return "Illegal username";
1106   }
1107
1108   $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum};
1109   $recref->{popnum} = $1;
1110   return "Unknown popnum" unless
1111     ! $recref->{popnum} ||
1112     qsearchs('svc_acct_pop',{'popnum'=> $recref->{popnum} } );
1113
1114   unless ( $part_svc->part_svc_column('uid')->columnflag eq 'F' ) {
1115
1116     $recref->{uid} =~ /^(\d*)$/ or return "Illegal uid";
1117     $recref->{uid} = $1 eq '' ? $self->unique('uid') : $1;
1118
1119     $recref->{gid} =~ /^(\d*)$/ or return "Illegal gid";
1120     $recref->{gid} = $1 eq '' ? $recref->{uid} : $1;
1121     #not all systems use gid=uid
1122     #you can set a fixed gid in part_svc
1123
1124     return "Only root can have uid 0"
1125       if $recref->{uid} == 0 && $recref->{username} ne 'root';
1126
1127 #    $error = $self->ut_textn('finger');
1128 #    return $error if $error;
1129     $self->getfield('finger') =~
1130       /^([\w \t\!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\*\<\>]*)$/
1131         or return "Illegal finger: ". $self->getfield('finger');
1132     $self->setfield('finger', $1);
1133
1134     $recref->{dir} =~ /^([\/\w\-\.\&]*)$/
1135       or return "Illegal directory";
1136     $recref->{dir} = $1;
1137     return "Illegal directory"
1138       if $recref->{dir} =~ /(^|\/)\.+(\/|$)/; #no .. component
1139     return "Illegal directory"
1140       if $recref->{dir} =~ /\&/ && ! $username_ampersand;
1141     unless ( $recref->{dir} ) {
1142       $recref->{dir} = $dir_prefix . '/';
1143       if ( $dirhash > 0 ) {
1144         for my $h ( 1 .. $dirhash ) {
1145           $recref->{dir} .= substr($recref->{username}, $h-1, 1). '/';
1146         }
1147       } elsif ( $dirhash < 0 ) {
1148         for my $h ( reverse $dirhash .. -1 ) {
1149           $recref->{dir} .= substr($recref->{username}, $h, 1). '/';
1150         }
1151       }
1152       $recref->{dir} .= $recref->{username};
1153     ;
1154     }
1155
1156     unless ( $recref->{username} eq 'sync' ) {
1157       if ( grep $_ eq $recref->{shell}, @shells ) {
1158         $recref->{shell} = (grep $_ eq $recref->{shell}, @shells)[0];
1159       } else {
1160         return "Illegal shell \`". $self->shell. "\'; ".
1161                $conf->dir. "/shells contains: @shells";
1162       }
1163     } else {
1164       $recref->{shell} = '/bin/sync';
1165     }
1166
1167     $recref->{quota} =~ /^(\d*)$/ or return "Illegal quota (unimplemented)";
1168     $recref->{quota} = $1;
1169
1170   } else {
1171     $recref->{gid} ne '' ?
1172       return "Can't have gid without uid" : ( $recref->{gid}='' );
1173     $recref->{finger} ne '' ?
1174       return "Can't have finger-name without uid" : ( $recref->{finger}='' );
1175     $recref->{dir} ne '' ?
1176       return "Can't have directory without uid" : ( $recref->{dir}='' );
1177     $recref->{shell} ne '' ?
1178       return "Can't have shell without uid" : ( $recref->{shell}='' );
1179     $recref->{quota} ne '' ?
1180       return "Can't have quota without uid" : ( $recref->{quota}='' );
1181   }
1182
1183   unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) {
1184     unless ( $recref->{slipip} eq '0e0' ) {
1185       $recref->{slipip} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/
1186         or return "Illegal slipip". $self->slipip;
1187       $recref->{slipip} = $1;
1188     } else {
1189       $recref->{slipip} = '0e0';
1190     }
1191
1192   }
1193
1194   #arbitrary RADIUS stuff; allow ut_textn for now
1195   foreach ( grep /^radius_/, fields('svc_acct') ) {
1196     $self->ut_textn($_);
1197   }
1198
1199   #generate a password if it is blank
1200   $recref->{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) )
1201     unless ( $recref->{_password} );
1202
1203   #if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,16})$/ ) {
1204   if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{$passwordmin,$passwordmax})$/ ) {
1205     $recref->{_password} = $1.$3;
1206     #uncomment this to encrypt password immediately upon entry, or run
1207     #bin/crypt_pw in cron to give new users a window during which their
1208     #password is available to techs, for faxing, etc.  (also be aware of
1209     #radius issues!)
1210     #$recref->{password} = $1.
1211     #  crypt($3,$saltset[int(rand(64))].$saltset[int(rand(64))]
1212     #;
1213   } elsif ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([\w\.\/\$]{13,34})$/ ) {
1214     $recref->{_password} = $1.$3;
1215   } elsif ( $recref->{_password} eq '*' ) {
1216     $recref->{_password} = '*';
1217   } elsif ( $recref->{_password} eq '!!' ) {
1218     $recref->{_password} = '!!';
1219   } else {
1220     #return "Illegal password";
1221     return "Illegal password: ". $recref->{_password};
1222   }
1223
1224   ''; #no error
1225 }
1226
1227 =item radius
1228
1229 Depriciated, use radius_reply instead.
1230
1231 =cut
1232
1233 sub radius {
1234   carp "FS::svc_acct::radius depriciated, use radius_reply";
1235   $_[0]->radius_reply;
1236 }
1237
1238 =item radius_reply
1239
1240 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
1241 reply attributes of this record.
1242
1243 Note that this is now the preferred method for reading RADIUS attributes -
1244 accessing the columns directly is discouraged, as the column names are
1245 expected to change in the future.
1246
1247 =cut
1248
1249 sub radius_reply {
1250   my $self = shift;
1251   my %reply =
1252     map {
1253       /^(radius_(.*))$/;
1254       my($column, $attrib) = ($1, $2);
1255       #$attrib =~ s/_/\-/g;
1256       ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
1257     } grep { /^radius_/ && $self->getfield($_) } fields( $self->table );
1258   if ( $self->ip && $self->ip ne '0e0' ) {
1259     $reply{'Framed-IP-Address'} = $self->ip;
1260   }
1261   %reply;
1262 }
1263
1264 =item radius_check
1265
1266 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
1267 check attributes of this record.
1268
1269 Note that this is now the preferred method for reading RADIUS attributes -
1270 accessing the columns directly is discouraged, as the column names are
1271 expected to change in the future.
1272
1273 =cut
1274
1275 sub radius_check {
1276   my $self = shift;
1277   ( 'Password' => $self->_password,
1278     map {
1279       /^(rc_(.*))$/;
1280       my($column, $attrib) = ($1, $2);
1281       #$attrib =~ s/_/\-/g;
1282       ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
1283     } grep { /^rc_/ && $self->getfield($_) } fields( $self->table )
1284   );
1285 }
1286
1287 =item domain
1288
1289 Returns the domain associated with this account.
1290
1291 =cut
1292
1293 sub domain {
1294   my $self = shift;
1295   if ( $self->domsvc ) {
1296     #$self->svc_domain->domain;
1297     my $svc_domain = $self->svc_domain
1298       or die "no svc_domain.svcnum for svc_acct.domsvc ". $self->domsvc;
1299     $svc_domain->domain;
1300   } else {
1301     $mydomain or die "svc_acct.domsvc is null and no legacy domain config file";
1302   }
1303 }
1304
1305 =item svc_domain
1306
1307 Returns the FS::svc_domain record for this account's domain (see
1308 L<FS::svc_domain>.
1309
1310 =cut
1311
1312 sub svc_domain {
1313   my $self = shift;
1314   $self->{'_domsvc'}
1315     ? $self->{'_domsvc'}
1316     : qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } );
1317 }
1318
1319 =item cust_svc
1320
1321 Returns the FS::cust_svc record for this account (see L<FS::cust_svc>).
1322
1323 sub cust_svc {
1324   my $self = shift;
1325   qsearchs( 'cust_svc', { 'svcnum' => $self->svcnum } );
1326 }
1327
1328 =item email
1329
1330 Returns an email address associated with the account.
1331
1332 =cut
1333
1334 sub email {
1335   my $self = shift;
1336   $self->username. '@'. $self->domain;
1337 }
1338
1339 =item seconds_since TIMESTAMP
1340
1341 Returns the number of seconds this account has been online since TIMESTAMP.
1342 See L<FS::session>
1343
1344 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
1345 L<Time::Local> and L<Date::Parse> for conversion functions.
1346
1347 =cut
1348
1349 #note: POD here, implementation in FS::cust_svc
1350 sub seconds_since {
1351   my $self = shift;
1352   $self->cust_svc->seconds_since(@_);
1353 }
1354
1355 =item radius_groups
1356
1357 Returns all RADIUS groups for this account (see L<FS::radius_usergroup>).
1358
1359 =cut
1360
1361 sub radius_groups {
1362   my $self = shift;
1363   map { $_->groupname }
1364     qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } );
1365 }
1366
1367 =back
1368
1369 =head1 SUBROUTINES
1370
1371 =item radius_usergroup_selector GROUPS_ARRAYREF [ SELECTNAME ]
1372
1373 =cut
1374
1375 sub radius_usergroup_selector {
1376   my $sel_groups = shift;
1377   my %sel_groups = map { $_=>1 } @$sel_groups;
1378
1379   my $selectname = shift || 'radius_usergroup';
1380
1381   my $dbh = dbh;
1382   my $sth = $dbh->prepare(
1383     'SELECT DISTINCT(groupname) FROM radius_usergroup ORDER BY groupname'
1384   ) or die $dbh->errstr;
1385   $sth->execute() or die $sth->errstr;
1386   my @all_groups = map { $_->[0] } @{$sth->fetchall_arrayref};
1387
1388   my $html = <<END;
1389     <SCRIPT>
1390     function ${selectname}_doadd(object) {
1391       var myvalue = object.${selectname}_add.value;
1392       var optionName = new Option(myvalue,myvalue,false,true);
1393       var length = object.$selectname.length;
1394       object.$selectname.options[length] = optionName;
1395       object.${selectname}_add.value = "";
1396     }
1397     </SCRIPT>
1398     <SELECT MULTIPLE NAME="$selectname">
1399 END
1400
1401   foreach my $group ( @all_groups ) {
1402     $html .= '<OPTION';
1403     if ( $sel_groups{$group} ) {
1404       $html .= ' SELECTED';
1405       $sel_groups{$group} = 0;
1406     }
1407     $html .= ">$group</OPTION>\n";
1408   }
1409   foreach my $group ( grep { $sel_groups{$_} } keys %sel_groups ) {
1410     $html .= "<OPTION SELECTED>$group</OPTION>\n";
1411   };
1412   $html .= '</SELECT>';
1413
1414   $html .= qq!<BR><INPUT TYPE="text" NAME="${selectname}_add">!.
1415            qq!<INPUT TYPE="button" VALUE="Add new group" onClick="${selectname}_doadd(this.form)">!;
1416
1417   $html;
1418 }
1419
1420 =head1 BUGS
1421
1422 The $recref stuff in sub check should be cleaned up.
1423
1424 The suspend, unsuspend and cancel methods update the database, but not the
1425 current object.  This is probably a bug as it's unexpected and
1426 counterintuitive.
1427
1428 radius_usergroup_selector?  putting web ui components in here?  they should
1429 probably live somewhere else...
1430
1431 =head1 SEE ALSO
1432
1433 L<FS::svc_Common>, edit/part_svc.cgi from an installed web interface,
1434 export.html from the base documentation, L<FS::Record>, L<FS::Conf>,
1435 L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, L<FS::queue>,
1436 L<freeside-queued>), L<Net::SSH>, L<ssh>, L<FS::svc_acct_pop>,
1437 schema.html from the base documentation.
1438
1439 =cut
1440
1441 1;
1442