FS/FS/svc_acct.pm

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