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