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   my $amount = 0;
 261
 262   $error = $self->check;
 263   return $error if $error;
 264
 265   return "Username ". $self->username. " in use"
 266     if qsearchs( 'svc_acct', { 'username' => $self->username,
 267                                'domsvc'   => $self->domsvc,
 268                              } );
 269
 270   if ( $self->svcnum ) {
 271     my $cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum});
 272     unless ( $cust_svc ) {
 273       $dbh->rollback if $oldAutoCommit;
 274       return "no cust_svc record found for svcnum ". $self->svcnum;
 275     }
 276     $self->pkgnum($cust_svc->pkgnum);
 277     $self->svcpart($cust_svc->svcpart);
 278   }
 279
 280   my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
 281   return "Unknown svcpart" unless $part_svc;
 282   return "uid in use"
 283     if $part_svc->part_svc_column('uid')->columnflag ne 'F'
 284       && qsearchs( 'svc_acct', { 'uid' => $self->uid } )
 285       && $self->username !~ /^(hyla)?fax$/
 286     ;
 287
 288   $error = $self->SUPER::insert;
 289   if ( $error ) {
 290     $dbh->rollback if $oldAutoCommit;
 291     return $error;
 292   }
 293
 294   if ( $self->usergroup ) {
 295     foreach my $groupname ( @{$self->usergroup} ) {
 296       my $radius_usergroup = new FS::radius_usergroup ( {
 297         svcnum    => $self->svcnum,
 298         groupname => $groupname,
 299       } );
 300       my $error = $radius_usergroup->insert;
 301       if ( $error ) {
 302         $dbh->rollback if $oldAutoCommit;
 303         return $error;
 304       }
 305     }
 306   }
 307
 308   #new-style exports!
 309   unless ( $noexport_hack ) {
 310     foreach my $part_export ( $self->cust_svc->part_svc->part_export ) {
 311       my $error = $part_export->export_insert($self);
 312       if ( $error ) {
 313         $dbh->rollback if $oldAutoCommit;
 314         return "exporting to ". $part_export->exporttype.
 315                " (transaction rolled back): $error";
 316       }
 317     }
 318   }
 319
 320   #old-style exports
 321
 322   my( $username, $uid, $gid, $dir, $shell ) = (
 323     $self->username,
 324     $self->uid,
 325     $self->gid,
 326     $self->dir,
 327     $self->shell,
 328   );
 329   if ( $username && $uid && $dir && $shellmachine && ! $nossh_hack ) {
 330     my $queue = new FS::queue {
 331       'svcnum' => $self->svcnum,
 332       'job' => 'Net::SSH::ssh_cmd',
 333     };
 334     $error = $queue->insert("root\@$shellmachine", eval qq("$useradd") );
 335     if ( $error ) {
 336       $dbh->rollback if $oldAutoCommit;
 337       return "queueing job (transaction rolled back): $error";
 338     }
 339   }
 340
 341   if ( $cyrus_server ) {
 342     my $queue = new FS::queue {
 343       'svcnum' => $self->svcnum,
 344       'job'    => 'FS::svc_acct::cyrus_insert',
 345     };
 346     $error = $queue->insert($self->username, $self->quota);
 347     if ( $error ) {
 348       $dbh->rollback if $oldAutoCommit;
 349       return "queueing job (transaction rolled back): $error";
 350     }
 351   }
 352
 353   if ( $cp_server ) {
 354     my $queue = new FS::queue {
 355       'svcnum' => $self->svcnum,
 356       'job'    => 'FS::svc_acct::cp_insert'
 357     };
 358     $error = $queue->insert($self->username, $self->_password);
 359     if ( $error ) {
 360       $dbh->rollback if $oldAutoCommit;
 361       return "queueing job (transaction rolled back): $error";
 362     }
 363   }
 364
 365   if ( $vpopdir ) {
 366
 367     my $vpopmail_queue =
 368       new FS::queue {
 369       'svcnum' => $self->svcnum,
 370       'job' => 'FS::svc_acct::vpopmail_insert'
 371     };
 372     $error = $vpopmail_queue->insert( $self->username,
 373       crypt($self->_password,$saltset[int(rand(64))].$saltset[int(rand(64))]),
 374                                       $self->domain,
 375                                       $vpopdir,
 376                                     );
 377     if ( $error ) {
 378       $dbh->rollback if $oldAutoCommit;
 379       return "queueing job (transaction rolled back): $error";
 380     }
 381
 382   }
 383
 384   #end of old-style exports
 385
 386   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 387   ''; #no error
 388 }
 389
 390 sub cyrus_insert {
 391   my( $username, $quota ) = @_;
 392
 393   warn "cyrus_insert: starting for user $username, quota $quota\n";
 394
 395   warn "cyrus_insert: connecting to $cyrus_server\n";
 396   my $client = Cyrus::IMAP::Admin->new($cyrus_server);
 397
 398   warn "cyrus_insert: authentication as $cyrus_admin_user\n";
 399   $client->authenticate(
 400     -user      => $cyrus_admin_user,
 401     -mechanism => "login",
 402     -password  => $cyrus_admin_pass
 403   );
 404
 405   warn "cyrus_insert: creating user.$username\n";
 406   my $rc = $client->create("user.$username");
 407   my $error = $client->error;
 408   die "cyrus_insert: error creating user.$username: $error" if $error;
 409
 410   warn "cyrus_insert: setacl user.$username, $username => all\n";
 411   $rc = $client->setacl("user.$username", $username => 'all' );
 412   $error = $client->error;
 413   die "cyrus_insert: error setacl user.$username: $error" if $error;
 414
 415   if ( $quota ) {
 416     warn "cyrus_insert: setquota user.$username, STORAGE => $quota\n";
 417     $rc = $client->setquota("user.$username", 'STORAGE' => $quota );
 418     $error = $client->error;
 419     die "cyrus_insert: error setquota user.$username: $error" if $error;
 420   }
 421
 422   1;
 423 }
 424
 425 sub cp_insert {
 426   my( $username, $password ) = @_;
 427
 428   my $app = new Net::APP ( $cp_server,
 429                         User     => $cp_user,
 430                         Password => $cp_pass,
 431                         Domain   => $mydomain,
 432                         Timeout  => 60,
 433                         #Debug    => 1,
 434                       ) or die "$@\n";
 435
 436   $app->create_mailbox(
 437                         Mailbox   => $username,
 438                         Password  => $password,
 439                         Workgroup => $cp_workgroup,
 440                         Domain    => $mydomain,
 441                       );
 442
 443   die $app->message."\n" unless $app->ok;
 444 }
 445
 446 sub vpopmail_insert {
 447   my( $username, $password, $domain, $vpopdir ) = @_;
 448
 449   (open(VPASSWD, ">>$exportdir/domains/$domain/vpasswd")
 450     and flock(VPASSWD,LOCK_EX)
 451   ) or die "can't open vpasswd file for $username\@$domain: $exportdir/domains/$domain/vpasswd";
 452   print VPASSWD join(":",
 453     $username,
 454     $password,
 455     '1',
 456     '0',
 457     $username,
 458     "$vpopdir/domains/$domain/$username",
 459     'NOQUOTA',
 460   ), "\n";
 461
 462   flock(VPASSWD,LOCK_UN);
 463   close(VPASSWD);
 464
 465   mkdir "$exportdir/domains/$domain/$username", 0700  or die "can't create Maildir";
 466   mkdir "$exportdir/domains/$domain/$username/Maildir", 0700 or die "can't create Maildir";
 467   mkdir "$exportdir/domains/$domain/$username/Maildir/cur", 0700 or die "can't create Maildir";
 468   mkdir "$exportdir/domains/$domain/$username/Maildir/new", 0700 or die "can't create Maildir";
 469   mkdir "$exportdir/domains/$domain/$username/Maildir/tmp", 0700 or die "can't create Maildir";
 470
 471   my $queue = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_sync' };
 472   my $error = $queue->insert;
 473   die $error if $error;
 474
 475   1;
 476 }
 477
 478 sub vpopmail_sync {
 479
 480   my (@vpopmailmachines) = $conf->config('vpopmailmachines');
 481   my ($machine, $dir, $uid, $gid) = split (/\s+/, $vpopmailmachines[0]);
 482
 483   chdir $exportdir;
 484   my @args = ("$rsync", "-rlpt", "-e", "$ssh", "domains/", "vpopmail\@$machine:$vpopdir/domains/");
 485   system {$args[0]} @args;
 486
 487 }
 488
 489 =item delete
 490
 491 Deletes this account from the database.  If there is an error, returns the
 492 error, otherwise returns false.
 493
 494 The corresponding FS::cust_svc record will be deleted as well.
 495
 496 If the configuration value (see L<FS::Conf>) shellmachine exists, the
 497 command(s) specified in the shellmachine-userdel configuration file are
 498 added to the job queue (see L<FS::queue> and L<freeside-queued>) to be executed
 499 on shellmachine via ssh.  This behavior can be surpressed by setting
 500 $FS::svc_acct::nossh_hack true.  If the shellmachine-userdel configuration
 501 file does not exist,
 502
 503   userdel $username
 504
 505 is the default.  If the shellmachine-userdel configuration file exists but
 506 is empty,
 507
 508   rm -rf $dir
 509
 510 is the default instead.  Otherwise the contents of the file are treated as a
 511 double-quoted perl string, with the following variables available:
 512 $username and $dir.
 513
 514 (TODOC: cyrus config file)
 515
 516 (TODOC: new exports! $noexport_hack)
 517
 518 =cut
 519
 520 sub delete {
 521   my $self = shift;
 522
 523   if ( defined( $FS::Record::dbdef->table('svc_acct_sm') ) ) {
 524     return "Can't delete an account which has (svc_acct_sm) mail aliases!"
 525       if $self->uid && qsearch( 'svc_acct_sm', { 'domuid' => $self->uid } );
 526   }
 527
 528   return "Can't delete an account which is a (svc_forward) source!"
 529     if qsearch( 'svc_forward', { 'srcsvc' => $self->svcnum } );
 530
 531   return "Can't delete an account which is a (svc_forward) destination!"
 532     if qsearch( 'svc_forward', { 'dstsvc' => $self->svcnum } );
 533
 534   return "Can't delete an account with (svc_www) web service!"
 535     if qsearch( 'svc_www', { 'usersvc' => $self->usersvc } );
 536
 537   # what about records in session ? (they should refer to history table)
 538
 539   local $SIG{HUP} = 'IGNORE';
 540   local $SIG{INT} = 'IGNORE';
 541   local $SIG{QUIT} = 'IGNORE';
 542   local $SIG{TERM} = 'IGNORE';
 543   local $SIG{TSTP} = 'IGNORE';
 544   local $SIG{PIPE} = 'IGNORE';
 545
 546   my $oldAutoCommit = $FS::UID::AutoCommit;
 547   local $FS::UID::AutoCommit = 0;
 548   my $dbh = dbh;
 549
 550   foreach my $cust_main_invoice (
 551     qsearch( 'cust_main_invoice', { 'dest' => $self->svcnum } )
 552   ) {
 553     unless ( defined($cust_main_invoice) ) {
 554       warn "WARNING: something's wrong with qsearch";
 555       next;
 556     }
 557     my %hash = $cust_main_invoice->hash;
 558     $hash{'dest'} = $self->email;
 559     my $new = new FS::cust_main_invoice \%hash;
 560     my $error = $new->replace($cust_main_invoice);
 561     if ( $error ) {
 562       $dbh->rollback if $oldAutoCommit;
 563       return $error;
 564     }
 565   }
 566
 567   foreach my $svc_domain (
 568     qsearch( 'svc_domain', { 'catchall' => $self->svcnum } )
 569   ) {
 570     my %hash = new FS::svc_domain->hash;
 571     $hash{'catchall'} = '';
 572     my $new = new FS::svc_domain \%hash;
 573     my $error = $new->replace($svc_domain);
 574     if ( $error ) {
 575       $dbh->rollback if $oldAutoCommit;
 576       return $error;
 577     }
 578   }
 579
 580   foreach my $radius_usergroup (
 581     qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } )
 582   ) {
 583     my $error = $radius_usergroup->delete;
 584     if ( $error ) {
 585       $dbh->rollback if $oldAutoCommit;
 586       return $error;
 587     }
 588   }
 589
 590   my $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 ( $self->cust_svc->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
 795   if ( $new->usergroup ) {
 796
 797     foreach my $groupname ( @{$old->usergroup} ) {
 798       if ( grep { $groupname eq $_ } @{$new->usergroup} ) {
 799         $new->usergroup( [ grep { $groupname ne $_ } @{$new->usergroup} ] );
 800         next;
 801       }
 802       my $radius_usergroup = qsearch('radius_usergroup', {
 803         svcnum    => $old->svcnum,
 804         groupname => $groupname,
 805       } );
 806       my $error = $radius_usergroup->delete;
 807       if ( $error ) {
 808         $dbh->rollback if $oldAutoCommit;
 809         return "error deleting radius_usergroup $groupname: $error";
 810       }
 811     }
 812
 813     foreach my $groupname ( @{$new->usergroup} ) {
 814       my $radius_usergroup = new FS::radius_usergroup ( {
 815         svcnum    => $new->svcnum,
 816         groupname => $groupname,
 817       } );
 818       my $error = $radius_usergroup->insert;
 819       if ( $error ) {
 820         $dbh->rollback if $oldAutoCommit;
 821         return "error adding radius_usergroup $groupname: $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   my $error = $self->ut_numbern('svcnum')
1076               || $self->ut_number('domsvc')
1077   ;
1078   return $error if $error;
1079
1080   my $ulen = $usernamemax || $self->dbdef_table->column('username')->length;
1081   if ( $username_uppercase ) {
1082     $recref->{username} =~ /^([a-z0-9_\-\.\&]{$usernamemin,$ulen})$/i
1083       or return "Illegal username: ". $recref->{username};
1084     $recref->{username} = $1;
1085   } else {
1086     $recref->{username} =~ /^([a-z0-9_\-\.\&]{$usernamemin,$ulen})$/
1087       or return "Illegal username: ". $recref->{username};
1088     $recref->{username} = $1;
1089   }
1090
1091   if ( $username_letterfirst ) {
1092     $recref->{username} =~ /^[a-z]/ or return "Illegal username";
1093   } elsif ( $username_letter ) {
1094     $recref->{username} =~ /[a-z]/ or return "Illegal username";
1095   }
1096   if ( $username_noperiod ) {
1097     $recref->{username} =~ /\./ and return "Illegal username";
1098   }
1099   unless ( $username_ampersand ) {
1100     $recref->{username} =~ /\&/ and return "Illegal username";
1101   }
1102
1103   $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum};
1104   $recref->{popnum} = $1;
1105   return "Unknown popnum" unless
1106     ! $recref->{popnum} ||
1107     qsearchs('svc_acct_pop',{'popnum'=> $recref->{popnum} } );
1108
1109   unless ( $part_svc->part_svc_column('uid')->columnflag eq 'F' ) {
1110
1111     $recref->{uid} =~ /^(\d*)$/ or return "Illegal uid";
1112     $recref->{uid} = $1 eq '' ? $self->unique('uid') : $1;
1113
1114     $recref->{gid} =~ /^(\d*)$/ or return "Illegal gid";
1115     $recref->{gid} = $1 eq '' ? $recref->{uid} : $1;
1116     #not all systems use gid=uid
1117     #you can set a fixed gid in part_svc
1118
1119     return "Only root can have uid 0"
1120       if $recref->{uid} == 0 && $recref->{username} ne 'root';
1121
1122 #    $error = $self->ut_textn('finger');
1123 #    return $error if $error;
1124     $self->getfield('finger') =~
1125       /^([\w \t\!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\*\<\>]*)$/
1126         or return "Illegal finger: ". $self->getfield('finger');
1127     $self->setfield('finger', $1);
1128
1129     $recref->{dir} =~ /^([\/\w\-\.\&]*)$/
1130       or return "Illegal directory";
1131     $recref->{dir} = $1;
1132     return "Illegal directory"
1133       if $recref->{dir} =~ /(^|\/)\.+(\/|$)/; #no .. component
1134     return "Illegal directory"
1135       if $recref->{dir} =~ /\&/ && ! $username_ampersand;
1136     unless ( $recref->{dir} ) {
1137       $recref->{dir} = $dir_prefix . '/';
1138       if ( $dirhash > 0 ) {
1139         for my $h ( 1 .. $dirhash ) {
1140           $recref->{dir} .= substr($recref->{username}, $h-1, 1). '/';
1141         }
1142       } elsif ( $dirhash < 0 ) {
1143         for my $h ( reverse $dirhash .. -1 ) {
1144           $recref->{dir} .= substr($recref->{username}, $h, 1). '/';
1145         }
1146       }
1147       $recref->{dir} .= $recref->{username};
1148     ;
1149     }
1150
1151     unless ( $recref->{username} eq 'sync' ) {
1152       if ( grep $_ eq $recref->{shell}, @shells ) {
1153         $recref->{shell} = (grep $_ eq $recref->{shell}, @shells)[0];
1154       } else {
1155         return "Illegal shell \`". $self->shell. "\'; ".
1156                $conf->dir. "/shells contains: @shells";
1157       }
1158     } else {
1159       $recref->{shell} = '/bin/sync';
1160     }
1161
1162     $recref->{quota} =~ /^(\d*)$/ or return "Illegal quota (unimplemented)";
1163     $recref->{quota} = $1;
1164
1165   } else {
1166     $recref->{gid} ne '' ?
1167       return "Can't have gid without uid" : ( $recref->{gid}='' );
1168     $recref->{finger} ne '' ?
1169       return "Can't have finger-name without uid" : ( $recref->{finger}='' );
1170     $recref->{dir} ne '' ?
1171       return "Can't have directory without uid" : ( $recref->{dir}='' );
1172     $recref->{shell} ne '' ?
1173       return "Can't have shell without uid" : ( $recref->{shell}='' );
1174     $recref->{quota} ne '' ?
1175       return "Can't have quota without uid" : ( $recref->{quota}='' );
1176   }
1177
1178   unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) {
1179     unless ( $recref->{slipip} eq '0e0' ) {
1180       $recref->{slipip} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/
1181         or return "Illegal slipip". $self->slipip;
1182       $recref->{slipip} = $1;
1183     } else {
1184       $recref->{slipip} = '0e0';
1185     }
1186
1187   }
1188
1189   #arbitrary RADIUS stuff; allow ut_textn for now
1190   foreach ( grep /^radius_/, fields('svc_acct') ) {
1191     $self->ut_textn($_);
1192   }
1193
1194   #generate a password if it is blank
1195   $recref->{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) )
1196     unless ( $recref->{_password} );
1197
1198   #if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,16})$/ ) {
1199   if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{$passwordmin,$passwordmax})$/ ) {
1200     $recref->{_password} = $1.$3;
1201     #uncomment this to encrypt password immediately upon entry, or run
1202     #bin/crypt_pw in cron to give new users a window during which their
1203     #password is available to techs, for faxing, etc.  (also be aware of
1204     #radius issues!)
1205     #$recref->{password} = $1.
1206     #  crypt($3,$saltset[int(rand(64))].$saltset[int(rand(64))]
1207     #;
1208   } elsif ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([\w\.\/\$]{13,34})$/ ) {
1209     $recref->{_password} = $1.$3;
1210   } elsif ( $recref->{_password} eq '*' ) {
1211     $recref->{_password} = '*';
1212   } elsif ( $recref->{_password} eq '!!' ) {
1213     $recref->{_password} = '!!';
1214   } else {
1215     #return "Illegal password";
1216     return "Illegal password: ". $recref->{_password};
1217   }
1218
1219   ''; #no error
1220 }
1221
1222 =item radius
1223
1224 Depriciated, use radius_reply instead.
1225
1226 =cut
1227
1228 sub radius {
1229   carp "FS::svc_acct::radius depriciated, use radius_reply";
1230   $_[0]->radius_reply;
1231 }
1232
1233 =item radius_reply
1234
1235 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
1236 reply attributes of this record.
1237
1238 Note that this is now the preferred method for reading RADIUS attributes -
1239 accessing the columns directly is discouraged, as the column names are
1240 expected to change in the future.
1241
1242 =cut
1243
1244 sub radius_reply {
1245   my $self = shift;
1246   my %reply =
1247     map {
1248       /^(radius_(.*))$/;
1249       my($column, $attrib) = ($1, $2);
1250       #$attrib =~ s/_/\-/g;
1251       ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
1252     } grep { /^radius_/ && $self->getfield($_) } fields( $self->table );
1253   if ( $self->ip && $self->ip ne '0e0' ) {
1254     $reply{'Framed-IP-Address'} = $self->ip;
1255   }
1256   %reply;
1257 }
1258
1259 =item radius_check
1260
1261 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
1262 check attributes of this record.
1263
1264 Note that this is now the preferred method for reading RADIUS attributes -
1265 accessing the columns directly is discouraged, as the column names are
1266 expected to change in the future.
1267
1268 =cut
1269
1270 sub radius_check {
1271   my $self = shift;
1272   ( 'Password' => $self->_password,
1273     map {
1274       /^(rc_(.*))$/;
1275       my($column, $attrib) = ($1, $2);
1276       #$attrib =~ s/_/\-/g;
1277       ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
1278     } grep { /^rc_/ && $self->getfield($_) } fields( $self->table )
1279   );
1280 }
1281
1282 =item domain
1283
1284 Returns the domain associated with this account.
1285
1286 =cut
1287
1288 sub domain {
1289   my $self = shift;
1290   if ( $self->domsvc ) {
1291     #$self->svc_domain->domain;
1292     my $svc_domain = $self->svc_domain
1293       or die "no svc_domain.svcnum for svc_acct.domsvc ". $self->domsvc;
1294     $svc_domain->domain;
1295   } else {
1296     $mydomain or die "svc_acct.domsvc is null and no legacy domain config file";
1297   }
1298 }
1299
1300 =item svc_domain
1301
1302 Returns the FS::svc_domain record for this account's domain (see
1303 L<FS::svc_domain>.
1304
1305 =cut
1306
1307 sub svc_domain {
1308   my $self = shift;
1309   $self->{'_domsvc'}
1310     ? $self->{'_domsvc'}
1311     : qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } );
1312 }
1313
1314 =item cust_svc
1315
1316 Returns the FS::cust_svc record for this account (see L<FS::cust_svc>).
1317
1318 sub cust_svc {
1319   my $self = shift;
1320   qsearchs( 'cust_svc', { 'svcnum' => $self->svcnum } );
1321 }
1322
1323 =item email
1324
1325 Returns an email address associated with the account.
1326
1327 =cut
1328
1329 sub email {
1330   my $self = shift;
1331   $self->username. '@'. $self->domain;
1332 }
1333
1334 =item seconds_since TIMESTAMP
1335
1336 Returns the number of seconds this account has been online since TIMESTAMP.
1337 See L<FS::session>
1338
1339 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
1340 L<Time::Local> and L<Date::Parse> for conversion functions.
1341
1342 =cut
1343
1344 #note: POD here, implementation in FS::cust_svc
1345 sub seconds_since {
1346   my $self = shift;
1347   $self->cust_svc->seconds_since(@_);
1348 }
1349
1350 =item radius_groups
1351
1352 Returns all RADIUS groups for this account (see L<FS::radius_usergroup>).
1353
1354 =cut
1355
1356 sub radius_groups {
1357   my $self = shift;
1358   map { $_->groupname }
1359     qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } );
1360 }
1361
1362 =back
1363
1364 =head1 SUBROUTINES
1365
1366 =item radius_usergroup_selector GROUPS_ARRAYREF [ SELECTNAME ]
1367
1368 =cut
1369
1370 sub radius_usergroup_selector {
1371   my $sel_groups = shift;
1372   my %sel_groups = map { $_=>1 } @$sel_groups;
1373
1374   my $selectname = shift || 'radius_usergroup';
1375
1376   my $dbh = dbh;
1377   my $sth = $dbh->prepare(
1378     'SELECT DISTINCT(groupname) FROM radius_usergroup ORDER BY groupname'
1379   ) or die $dbh->errstr;
1380   $sth->execute() or die $sth->errstr;
1381   my @all_groups = map { $_->[0] } @{$sth->fetchall_arrayref};
1382
1383   my $html = <<END;
1384     <SCRIPT>
1385     function ${selectname}_doadd(object) {
1386       var myvalue = object.${selectname}_add.value;
1387       var optionName = new Option(myvalue,myvalue,false,true);
1388       var length = object.$selectname.length;
1389       object.$selectname.options[length] = optionName;
1390       object.${selectname}_add.value = "";
1391     }
1392     </SCRIPT>
1393     <SELECT MULTIPLE NAME="$selectname">
1394 END
1395
1396   foreach my $group ( @all_groups ) {
1397     $html .= '<OPTION';
1398     $html .= ' SELECTED' if $sel_groups{$group}--;
1399     $html .= ">$group</OPTION>\n";
1400   }
1401   foreach my $group ( grep { $sel_groups{$_} } keys %sel_groups ) {
1402     $html .= "<OPTION SELECTED>$group</OPTION>\n";
1403   };
1404   $html .= '</SELECT>';
1405
1406   $html .= qq!<BR><INPUT TYPE="text" NAME="${selectname}_add">!.
1407            qq!<INPUT TYPE="button" VALUE="Add new group" onClick="${selectname}_doadd(this.form)">!;
1408
1409   $html;
1410 }
1411
1412 =head1 BUGS
1413
1414 The $recref stuff in sub check should be cleaned up.
1415
1416 The suspend, unsuspend and cancel methods update the database, but not the
1417 current object.  This is probably a bug as it's unexpected and
1418 counterintuitive.
1419
1420 radius_usergroup_selector?  putting web ui components in here?  they should
1421 probably live somewhere else...
1422
1423 =head1 SEE ALSO
1424
1425 L<FS::svc_Common>, edit/part_svc.cgi from an installed web interface,
1426 export.html from the base documentation, L<FS::Record>, L<FS::Conf>,
1427 L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, L<FS::queue>,
1428 L<freeside-queued>), L<Net::SSH>, L<ssh>, L<FS::svc_acct_pop>,
1429 schema.html from the base documentation.
1430
1431 =cut
1432
1433 1;
1434