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 $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
  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)
 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   my $error = $queue->insert;
 521   die $error if $error;
 522
 523   1;
 524 }
 525
 526 sub vpopmail_sync {
 527
 528   my (@vpopmailmachines) = $conf->config('vpopmailmachines');
 529   my ($machine, $dir, $uid, $gid) = split (/\s+/, $vpopmailmachines[0]);
 530
 531   chdir $exportdir;
 532   my @args = ("$rsync", "-rlpt", "-e", "$ssh", "domains/", "vpopmail\@$machine:$vpoppdir/domains/");
 533   system {$args[0]} @args;
 534
 535 }
 536
 537 =item delete
 538
 539 Deletes this account from the database.  If there is an error, returns the
 540 error, otherwise returns false.
 541
 542 The corresponding FS::cust_svc record will be deleted as well.
 543
 544 If the configuration value (see L<FS::Conf>) shellmachine exists, the
 545 command(s) specified in the shellmachine-userdel configuration file are
 546 added to the job queue (see L<FS::queue> and L<freeside-queued>) to be executed
 547 on shellmachine via ssh.  This behavior can be surpressed by setting
 548 $FS::svc_acct::nossh_hack true.  If the shellmachine-userdel configuration
 549 file does not exist,
 550
 551   userdel $username
 552
 553 is the default.  If the shellmachine-userdel configuration file exists but
 554 is empty,
 555
 556   rm -rf $dir
 557
 558 is the default instead.  Otherwise the contents of the file are treated as a
 559 double-quoted perl string, with the following variables available:
 560 $username and $dir.
 561
 562 (TODOC: cyrus config file)
 563
 564 =cut
 565
 566 sub delete {
 567   my $self = shift;
 568
 569   if ( defined( $FS::Record::dbdef->table('svc_acct_sm') ) ) {
 570     return "Can't delete an account which has (svc_acct_sm) mail aliases!"
 571       if $self->uid && qsearch( 'svc_acct_sm', { 'domuid' => $self->uid } );
 572   }
 573
 574   return "Can't delete an account which is a (svc_forward) source!"
 575     if qsearch( 'svc_forward', { 'srcsvc' => $self->svcnum } );
 576
 577   return "Can't delete an account which is a (svc_forward) destination!"
 578     if qsearch( 'svc_forward', { 'dstsvc' => $self->svcnum } );
 579
 580   return "Can't delete an account with (svc_www) web service!"
 581     if qsearch( 'svc_www', { 'usersvc' => $self->usersvc } );
 582
 583   # what about records in session ?
 584
 585   local $SIG{HUP} = 'IGNORE';
 586   local $SIG{INT} = 'IGNORE';
 587   local $SIG{QUIT} = 'IGNORE';
 588   local $SIG{TERM} = 'IGNORE';
 589   local $SIG{TSTP} = 'IGNORE';
 590   local $SIG{PIPE} = 'IGNORE';
 591
 592   my $oldAutoCommit = $FS::UID::AutoCommit;
 593   local $FS::UID::AutoCommit = 0;
 594   my $dbh = dbh;
 595
 596   foreach my $cust_main_invoice (
 597     qsearch( 'cust_main_invoice', { 'dest' => $self->svcnum } )
 598   ) {
 599     unless ( defined($cust_main_invoice) ) {
 600       warn "WARNING: something's wrong with qsearch";
 601       next;
 602     }
 603     my %hash = $cust_main_invoice->hash;
 604     $hash{'dest'} = $self->email;
 605     my $new = new FS::cust_main_invoice \%hash;
 606     my $error = $new->replace($cust_main_invoice);
 607     if ( $error ) {
 608       $dbh->rollback if $oldAutoCommit;
 609       return $error;
 610     }
 611   }
 612
 613   foreach my $svc_domain (
 614     qsearch( 'svc_domain', { 'catchall' => $self->svcnum } )
 615   ) {
 616     my %hash = new FS::svc_domain->hash;
 617     $hash{'catchall'} = '';
 618     my $new = new FS::svc_domain \%hash;
 619     my $error = $new->replace($svc_domain);
 620     if ( $error ) {
 621       $dbh->rollback if $oldAutoCommit;
 622       return $error;
 623     }
 624   }
 625
 626   my $error = $self->SUPER::delete;
 627   if ( $error ) {
 628     $dbh->rollback if $oldAutoCommit;
 629     return $error;
 630   }
 631
 632   my( $username, $dir ) = (
 633     $self->username,
 634     $self->dir,
 635   );
 636   if ( $username && $shellmachine && ! $nossh_hack ) {
 637     my $queue = new FS::queue { 'job' => 'Net::SSH::ssh_cmd' };
 638     $error = $queue->insert("root\@$shellmachine", eval qq("$userdel") );
 639     if ( $error ) {
 640       $dbh->rollback if $oldAutoCommit;
 641       return "queueing job (transaction rolled back): $error";
 642     }
 643
 644   }
 645
 646   if ( $cyrus_server ) {
 647     my $queue = new FS::queue { 'job' => 'FS::svc_acct::cyrus_delete' };
 648     $error = $queue->insert($self->username);
 649     if ( $error ) {
 650       $dbh->rollback if $oldAutoCommit;
 651       return "queueing job (transaction rolled back): $error";
 652     }
 653   }
 654
 655   if ( $cp_server ) {
 656     my $queue = new FS::queue { 'job' => 'FS::svc_acct::cp_delete' };
 657     $error = $queue->insert($self->username);
 658     if ( $error ) {
 659       $dbh->rollback if $oldAutoCommit;
 660       return "queueing job (transaction rolled back): $error";
 661     }
 662   }
 663
 664   if ( $icradius_dbh ) {
 665
 666     my $radcheck_queue =
 667       new FS::queue { 'job' => 'FS::svc_acct::icradius_rc_delete' };
 668     $error = $radcheck_queue->insert( $self->username );
 669     if ( $error ) {
 670       $dbh->rollback if $oldAutoCommit;
 671       return "queueing job (transaction rolled back): $error";
 672     }
 673
 674     my $radreply_queue =
 675       new FS::queue { 'job' => 'FS::svc_acct::icradius_rr_delete' };
 676     $error = $radreply_queue->insert( $self->username );
 677     if ( $error ) {
 678       $dbh->rollback if $oldAutoCommit;
 679       return "queueing job (transaction rolled back): $error";
 680     }
 681   }
 682   if ( $vpopdir ) {
 683     my $queue = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_delete' };
 684     $error = $queue->insert( $self->username, $self->domain );
 685     if ( $error ) {
 686       $dbh->rollback if $oldAutoCommit;
 687       return "queueing job (transaction rolled back): $error";
 688     }
 689
 690   }
 691
 692   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 693   '';
 694 }
 695
 696 sub cyrus_delete {
 697   my $username = shift;
 698
 699   my $client = Cyrus::IMAP::Admin->new($cyrus_server);
 700   $client->authenticate(
 701     -user      => $cyrus_admin_user,
 702     -mechanism => "login",
 703     -password  => $cyrus_admin_pass
 704   );
 705
 706   my $rc = $client->setacl("user.$username", $cyrus_admin_user => 'all' );
 707   my $error = $client->error;
 708   die $error if $error;
 709
 710   $rc = $client->delete("user.$username");
 711   $error = $client->error;
 712   die $error if $error;
 713
 714   1;
 715 }
 716
 717 sub cp_delete {
 718   my( $username ) = @_;
 719   my $app = new Net::APP ( $cp_server,
 720                         User     => $cp_user,
 721                         Password => $cp_pass,
 722                         Domain   => $mydomain,
 723                         Timeout  => 60,
 724                         #Debug    => 1,
 725                       ) or die "$@\n";
 726
 727   $app->delete_mailbox(
 728                         Mailbox   => $username,
 729                         Domain    => $mydomain,
 730                       );
 731
 732   die $app->message."\n" unless $app->ok;
 733 }
 734
 735 sub icradius_rc_delete {
 736   my $username = shift;
 737
 738   my $sth = $icradius_dbh->prepare(
 739     'DELETE FROM radcheck WHERE UserName = ?'
 740   );
 741   $sth->execute($username)
 742     or die "can't delete from radcheck table: ". $sth->errstr;
 743
 744   1;
 745 }
 746
 747 sub icradius_rr_delete {
 748   my $username = shift;
 749
 750   my $sth = $icradius_dbh->prepare(
 751     'DELETE FROM radreply WHERE UserName = ?'
 752   );
 753   $sth->execute($username)
 754     or die "can't delete from radreply table: ". $sth->errstr;
 755
 756   1;
 757 }
 758
 759 sub vpopmail_delete {
 760   my( $username, $domain ) = @_;
 761
 762   (open(VPASSWD, "$exportdir/domains/$domain/vpasswd")
 763     and flock(VPASSWD,LOCK_EX)
 764   ) or die "can't open $exportdir/domains/$domain/vpasswd: $!";
 765
 766   open(VPASSWDTMP, ">$exportdir/domains/$domain/vpasswd.tmp")
 767     or die "Can't open $exportdir/domains/$domain/vpasswd.tmp: $!";
 768
 769   while (<VPASSWD>) {
 770     my ($mailbox, $rest) = split(':', $_);
 771     print VPASSWDTMP $_ unless $username eq $mailbox;
 772   }
 773
 774   close(VPASSWDTMP);
 775
 776   rename "$exportdir/domains/$domain/vpasswd.tmp", "$exportdir/domains/$domain/vpasswd"
 777     or die "Can't rename $exportdir/domains/$domain/vpasswd.tmp: $!";
 778
 779   flock(VPASSWD,LOCK_UN);
 780   close(VPASSWD);
 781
 782   rmtree "$exportdir/domains/$domain/$username" or die "can't destroy Maildir";+
 783   1;
 784 }
 785
 786 =item replace OLD_RECORD
 787
 788 Replaces OLD_RECORD with this one in the database.  If there is an error,
 789 returns the error, otherwise returns false.
 790
 791 If the configuration value (see L<FS::Conf>) shellmachine exists, and the
 792 dir field has changed, the command(s) specified in the shellmachine-usermod
 793 configuraiton file are added to the job queue (see L<FS::queue> and
 794 L<freeside-queued>) to be executed on shellmachine via ssh.  This behavior can
 795 be surpressed by setting $FS::svc-acct::nossh_hack true.  If the
 796 shellmachine-userdel configuration file does not exist or is empty,
 797
 798   [ -d $old_dir ] && mv $old_dir $new_dir || (
 799     chmod u+t $old_dir;
 800     mkdir $new_dir;
 801     cd $old_dir;
 802     find . -depth -print | cpio -pdm $new_dir;
 803     chmod u-t $new_dir;
 804     chown -R $uid.$gid $new_dir;
 805     rm -rf $old_dir
 806   )
 807
 808 is the default.  This behaviour can be surpressed by setting
 809 $FS::svc_acct::nossh_hack true.
 810
 811 =cut
 812
 813 sub replace {
 814   my ( $new, $old ) = ( shift, shift );
 815   my $error;
 816
 817   return "Username in use"
 818     if $old->username ne $new->username &&
 819       qsearchs( 'svc_acct', { 'username' => $new->username,
 820                                'domsvc'   => $new->domsvc,
 821                              } );
 822   {
 823     #no warnings 'numeric';  #alas, a 5.006-ism
 824     local($^W) = 0;
 825     return "Can't change uid!" if $old->uid != $new->uid;
 826   }
 827
 828   return "can't change username using Cyrus"
 829     if $cyrus_server && $old->username ne $new->username;
 830
 831   #change homdir when we change username
 832   $new->setfield('dir', '') if $old->username ne $new->username;
 833
 834   local $SIG{HUP} = 'IGNORE';
 835   local $SIG{INT} = 'IGNORE';
 836   local $SIG{QUIT} = 'IGNORE';
 837   local $SIG{TERM} = 'IGNORE';
 838   local $SIG{TSTP} = 'IGNORE';
 839   local $SIG{PIPE} = 'IGNORE';
 840
 841   my $oldAutoCommit = $FS::UID::AutoCommit;
 842   local $FS::UID::AutoCommit = 0;
 843   my $dbh = dbh;
 844
 845   $error = $new->SUPER::replace($old);
 846   if ( $error ) {
 847     $dbh->rollback if $oldAutoCommit;
 848     return $error if $error;
 849   }
 850
 851   my ( $old_dir, $new_dir, $uid, $gid ) = (
 852     $old->getfield('dir'),
 853     $new->getfield('dir'),
 854     $new->getfield('uid'),
 855     $new->getfield('gid'),
 856   );
 857   if ( $old_dir && $new_dir && $old_dir ne $new_dir && ! $nossh_hack ) {
 858     my $queue = new FS::queue {
 859       'svcnum' => $new->svcnum,
 860       'job' => 'Net::SSH::ssh_cmd'
 861     };
 862     $error = $queue->insert("root\@$shellmachine", eval qq("$usermod") );
 863     if ( $error ) {
 864       $dbh->rollback if $oldAutoCommit;
 865       return "queueing job (transaction rolled back): $error";
 866     }
 867   }
 868
 869   if ( $cp_server && $old->username ne $new->username ) {
 870     my $queue = new FS::queue {
 871       'svcnum' => $new->svcnum,
 872       'job' => 'FS::svc_acct::cp_rename'
 873     };
 874     $error = $queue->insert( $old->username, $new->username );
 875     if ( $error ) {
 876       $dbh->rollback if $oldAutoCommit;
 877       return "queueing job (transaction rolled back): $error";
 878     }
 879   }
 880
 881   if ( $cp_server && $old->_password ne $new->_password ) {
 882     my $queue = new FS::queue {
 883       'svcnum' => $new->svcnum,
 884       'job' => 'FS::svc_acct::cp_change'
 885     };
 886     $error = $queue->insert( $new->username, $new->_password );
 887     if ( $error ) {
 888       $dbh->rollback if $oldAutoCommit;
 889       return "queueing job (transaction rolled back): $error";
 890     }
 891   }
 892
 893   if ( $icradius_dbh ) {
 894     my $queue = new FS::queue {
 895       'svcnum' => $new->svcnum,
 896       'job' => 'FS::svc_acct::icradius_rc_replace'
 897     };
 898     $error = $queue->insert( $new->username,
 899                              $new->_password,
 900                            );
 901     if ( $error ) {
 902       $dbh->rollback if $oldAutoCommit;
 903       return "queueing job (transaction rolled back): $error";
 904     }
 905   }
 906   if ( $vpopdir ) {
 907     my $cpassword = crypt(
 908       $new->_password,$saltset[int(rand(64))].$saltset[int(rand(64))]
 909     );
 910
 911     if ($old->username ne $new->username || $old->domain ne $new->domain ) {
 912       my $queue  = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_delete' };
 913         $error = $queue->insert( $old->username, $old->domain );
 914       my $queue2 = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_insert' };
 915         $error = $queue2->insert( $new->username,
 916                                   $cpassword,
 917                                   $new->domain,
 918                                   $vpopdir,
 919                                 )
 920         unless $error;
 921     } elsif ($old->_password ne $new->_password) {
 922       my $queue = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_replace_password' };
 923       $error = $queue->insert( $new->username, $cpassword, $new->domain );
 924     }
 925     if ( $error ) {
 926       $dbh->rollback if $oldAutoCommit;
 927       return "queueing job (transaction rolled back): $error";
 928     }
 929   }
 930
 931
 932   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 933   ''; #no error
 934 }
 935
 936 sub icradius_rc_replace {
 937   my( $username, $new_password ) = @_;
 938
 939    my $sth = $icradius_dbh->prepare(
 940      "UPDATE radcheck SET Value = ? WHERE UserName = ? and Attribute = ?"
 941    );
 942    $sth->execute($new_password, $username, 'Password' )
 943      or die "can't update radcheck table: ". $sth->errstr;
 944
 945   1;
 946 }
 947
 948 sub cp_rename {
 949   my ( $old_username, $new_username ) = @_;
 950
 951   my $app = new Net::APP ( $cp_server,
 952                         User     => $cp_user,
 953                         Password => $cp_pass,
 954                         Domain   => $mydomain,
 955                         Timeout  => 60,
 956                         #Debug    => 1,
 957                       ) or die "$@\n";
 958
 959   $app->rename_mailbox(
 960                         Domain        => $mydomain,
 961                         Old_Mailbox   => $old_username,
 962                         New_Mailbox   => $new_username,
 963                       );
 964
 965   die $app->message."\n" unless $app->ok;
 966
 967 }
 968
 969 sub cp_change {
 970   my ( $username, $password ) = @_;
 971
 972   my $app = new Net::APP ( $cp_server,
 973                         User     => $cp_user,
 974                         Password => $cp_pass,
 975                         Domain   => $mydomain,
 976                         Timeout  => 60,
 977                         #Debug    => 1,
 978                       ) or die "$@\n";
 979
 980   if ( $password =~ /^\*SUSPENDED\* (.*)$/ ) {
 981     $password = $1;
 982     $app->set_mailbox_status(
 983                               Domain       => $mydomain,
 984                               Mailbox      => $username,
 985                               Other        => 'T',
 986                               Other_Bounce => 'T',
 987                             );
 988   } else {
 989     $app->set_mailbox_status(
 990                               Domain       => $mydomain,
 991                               Mailbox      => $username,
 992                               Other        => 'F',
 993                               Other_Bounce => 'F',
 994                             );
 995   }
 996   die $app->message."\n" unless $app->ok;
 997
 998   $app->change_mailbox(
 999                         Domain    => $mydomain,
1000                         Mailbox   => $username,
1001                         Password  => $password,
1002                       );
1003   die $app->message."\n" unless $app->ok;
1004
1005 }
1006
1007 sub vpopmail_replace_password {
1008   my( $username, $password, $domain ) = @_;
1009
1010   (open(VPASSWD, "$exportdir/domains/$domain/vpasswd")
1011     and flock(VPASSWD,LOCK_EX)
1012   ) or die "can't open $exportdir/domains/$domain/vpasswd: $!";
1013
1014   open(VPASSWDTMP, ">$exportdir/domains/$domain/vpasswd.tmp")
1015     or die "Can't open $exportdir/domains/$domain/vpasswd.tmp: $!";
1016
1017   while (<VPASSWD>) {
1018     my ($mailbox, $pw, @rest) = split(':', $_);
1019     print VPASSWDTMP $_ unless $username eq $mailbox;
1020     print VPASSWDTMP join (':', ($mailbox, $password, @rest))
1021       if $username eq $mailbox;
1022   }
1023
1024   close(VPASSWDTMP);
1025
1026   rename "$exportdir/domains/$domain/vpasswd.tmp", "$exportdir/domains/$domain/vpasswd"
1027     or die "Can't rename $exportdir/domains/$domain/vpasswd.tmp: $!";
1028
1029   flock(VPASSWD,LOCK_UN);
1030   close(VPASSWD);
1031
1032   my $queue = new FS::queue { 'job' => 'FS::svc_acct::vpopmail_sync' };
1033   $error = $queue->insert;
1034
1035   1;
1036 }
1037
1038
1039 =item suspend
1040
1041 Suspends this account by prefixing *SUSPENDED* to the password.  If there is an
1042 error, returns the error, otherwise returns false.
1043
1044 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
1045
1046 =cut
1047
1048 sub suspend {
1049   my $self = shift;
1050   my %hash = $self->hash;
1051   unless ( $hash{_password} =~ /^\*SUSPENDED\* /
1052            || $hash{_password} eq '*'
1053          ) {
1054     $hash{_password} = '*SUSPENDED* '.$hash{_password};
1055     my $new = new FS::svc_acct ( \%hash );
1056     $new->replace($self);
1057   } else {
1058     ''; #no error (already suspended)
1059   }
1060 }
1061
1062 =item unsuspend
1063
1064 Unsuspends this account by removing *SUSPENDED* from the password.  If there is
1065 an error, returns the error, otherwise returns false.
1066
1067 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
1068
1069 =cut
1070
1071 sub unsuspend {
1072   my $self = shift;
1073   my %hash = $self->hash;
1074   if ( $hash{_password} =~ /^\*SUSPENDED\* (.*)$/ ) {
1075     $hash{_password} = $1;
1076     my $new = new FS::svc_acct ( \%hash );
1077     $new->replace($self);
1078   } else {
1079     ''; #no error (already unsuspended)
1080   }
1081 }
1082
1083 =item cancel
1084
1085 Just returns false (no error) for now.
1086
1087 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
1088
1089 =item check
1090
1091 Checks all fields to make sure this is a valid service.  If there is an error,
1092 returns the error, otherwise returns false.  Called by the insert and replace
1093 methods.
1094
1095 Sets any fixed values; see L<FS::part_svc>.
1096
1097 =cut
1098
1099 sub check {
1100   my $self = shift;
1101
1102   my($recref) = $self->hashref;
1103
1104   my $x = $self->setfixed;
1105   return $x unless ref($x);
1106   my $part_svc = $x;
1107
1108   my $error = $self->ut_numbern('svcnum')
1109               || $self->ut_number('domsvc')
1110   ;
1111   return $error if $error;
1112
1113   my $ulen = $usernamemax || $self->dbdef_table->column('username')->length;
1114   if ( $username_uppercase ) {
1115     $recref->{username} =~ /^([a-z0-9_\-\.\&]{$usernamemin,$ulen})$/i
1116       or return "Illegal username: ". $recref->{username};
1117     $recref->{username} = $1;
1118   } else {
1119     $recref->{username} =~ /^([a-z0-9_\-\.\&]{$usernamemin,$ulen})$/
1120       or return "Illegal username: ". $recref->{username};
1121     $recref->{username} = $1;
1122   }
1123
1124   if ( $username_letterfirst ) {
1125     $recref->{username} =~ /^[a-z]/ or return "Illegal username";
1126   } elsif ( $username_letter ) {
1127     $recref->{username} =~ /[a-z]/ or return "Illegal username";
1128   }
1129   if ( $username_noperiod ) {
1130     $recref->{username} =~ /\./ and return "Illegal username";
1131   }
1132   unless ( $username_ampersand ) {
1133     $recref->{username} =~ /\&/ and return "Illegal username";
1134   }
1135
1136   $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum};
1137   $recref->{popnum} = $1;
1138   return "Unknown popnum" unless
1139     ! $recref->{popnum} ||
1140     qsearchs('svc_acct_pop',{'popnum'=> $recref->{popnum} } );
1141
1142   unless ( $part_svc->part_svc_column('uid')->columnflag eq 'F' ) {
1143
1144     $recref->{uid} =~ /^(\d*)$/ or return "Illegal uid";
1145     $recref->{uid} = $1 eq '' ? $self->unique('uid') : $1;
1146
1147     $recref->{gid} =~ /^(\d*)$/ or return "Illegal gid";
1148     $recref->{gid} = $1 eq '' ? $recref->{uid} : $1;
1149     #not all systems use gid=uid
1150     #you can set a fixed gid in part_svc
1151
1152     return "Only root can have uid 0"
1153       if $recref->{uid} == 0 && $recref->{username} ne 'root';
1154
1155 #    $error = $self->ut_textn('finger');
1156 #    return $error if $error;
1157     $self->getfield('finger') =~
1158       /^([\w \t\!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\*\<\>]*)$/
1159         or return "Illegal finger: ". $self->getfield('finger');
1160     $self->setfield('finger', $1);
1161
1162     $recref->{dir} =~ /^([\/\w\-\.\&]*)$/
1163       or return "Illegal directory";
1164     $recref->{dir} = $1;
1165     return "Illegal directory"
1166       if $recref->{dir} =~ /(^|\/)\.+(\/|$)/; #no .. component
1167     return "Illegal directory"
1168       if $recref->{dir} =~ /\&/ && ! $username_ampersand;
1169     unless ( $recref->{dir} ) {
1170       $recref->{dir} = $dir_prefix . '/';
1171       if ( $dirhash > 0 ) {
1172         for my $h ( 1 .. $dirhash ) {
1173           $recref->{dir} .= substr($recref->{username}, $h-1, 1). '/';
1174         }
1175       } elsif ( $dirhash < 0 ) {
1176         for my $h ( reverse $dirhash .. -1 ) {
1177           $recref->{dir} .= substr($recref->{username}, $h, 1). '/';
1178         }
1179       }
1180       $recref->{dir} .= $recref->{username};
1181     ;
1182     }
1183
1184     unless ( $recref->{username} eq 'sync' ) {
1185       if ( grep $_ eq $recref->{shell}, @shells ) {
1186         $recref->{shell} = (grep $_ eq $recref->{shell}, @shells)[0];
1187       } else {
1188         return "Illegal shell \`". $self->shell. "\'; ".
1189                $conf->dir. "/shells contains: @shells";
1190       }
1191     } else {
1192       $recref->{shell} = '/bin/sync';
1193     }
1194
1195     $recref->{quota} =~ /^(\d*)$/ or return "Illegal quota (unimplemented)";
1196     $recref->{quota} = $1;
1197
1198   } else {
1199     $recref->{gid} ne '' ?
1200       return "Can't have gid without uid" : ( $recref->{gid}='' );
1201     $recref->{finger} ne '' ?
1202       return "Can't have finger-name without uid" : ( $recref->{finger}='' );
1203     $recref->{dir} ne '' ?
1204       return "Can't have directory without uid" : ( $recref->{dir}='' );
1205     $recref->{shell} ne '' ?
1206       return "Can't have shell without uid" : ( $recref->{shell}='' );
1207     $recref->{quota} ne '' ?
1208       return "Can't have quota without uid" : ( $recref->{quota}='' );
1209   }
1210
1211   unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) {
1212     unless ( $recref->{slipip} eq '0e0' ) {
1213       $recref->{slipip} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/
1214         or return "Illegal slipip". $self->slipip;
1215       $recref->{slipip} = $1;
1216     } else {
1217       $recref->{slipip} = '0e0';
1218     }
1219
1220   }
1221
1222   #arbitrary RADIUS stuff; allow ut_textn for now
1223   foreach ( grep /^radius_/, fields('svc_acct') ) {
1224     $self->ut_textn($_);
1225   }
1226
1227   #generate a password if it is blank
1228   $recref->{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) )
1229     unless ( $recref->{_password} );
1230
1231   #if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,16})$/ ) {
1232   if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{$passwordmin,$passwordmax})$/ ) {
1233     $recref->{_password} = $1.$3;
1234     #uncomment this to encrypt password immediately upon entry, or run
1235     #bin/crypt_pw in cron to give new users a window during which their
1236     #password is available to techs, for faxing, etc.  (also be aware of
1237     #radius issues!)
1238     #$recref->{password} = $1.
1239     #  crypt($3,$saltset[int(rand(64))].$saltset[int(rand(64))]
1240     #;
1241   } elsif ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([\w\.\/\$]{13,34})$/ ) {
1242     $recref->{_password} = $1.$3;
1243   } elsif ( $recref->{_password} eq '*' ) {
1244     $recref->{_password} = '*';
1245   } elsif ( $recref->{_password} eq '!!' ) {
1246     $recref->{_password} = '!!';
1247   } else {
1248     #return "Illegal password";
1249     return "Illegal password: ". $recref->{_password};
1250   }
1251
1252   ''; #no error
1253 }
1254
1255 =item radius
1256
1257 Depriciated, use radius_reply instead.
1258
1259 =cut
1260
1261 sub radius {
1262   carp "FS::svc_acct::radius depriciated, use radius_reply";
1263   $_[0]->radius_reply;
1264 }
1265
1266 =item radius_reply
1267
1268 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
1269 reply attributes of this record.
1270
1271 Note that this is now the preferred method for reading RADIUS attributes -
1272 accessing the columns directly is discouraged, as the column names are
1273 expected to change in the future.
1274
1275 =cut
1276
1277 sub radius_reply {
1278   my $self = shift;
1279   my %reply =
1280     map {
1281       /^(radius_(.*))$/;
1282       my($column, $attrib) = ($1, $2);
1283       #$attrib =~ s/_/\-/g;
1284       ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
1285     } grep { /^radius_/ && $self->getfield($_) } fields( $self->table );
1286   if ( $self->ip && $self->ip ne '0e0' ) {
1287     $reply{'Framed-IP-Address'} = $self->ip;
1288   }
1289   %reply;
1290 }
1291
1292 =item radius_check
1293
1294 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
1295 check attributes of this record.
1296
1297 Accessing RADIUS attributes directly is not supported and will break in the
1298 future.
1299
1300 =cut
1301
1302 sub radius_check {
1303   my $self = shift;
1304   map {
1305     /^(rc_(.*))$/;
1306     my($column, $attrib) = ($1, $2);
1307     #$attrib =~ s/_/\-/g;
1308     ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
1309   } grep { /^rc_/ && $self->getfield($_) } fields( $self->table );
1310 }
1311
1312 =item domain
1313
1314 Returns the domain associated with this account.
1315
1316 =cut
1317
1318 sub domain {
1319   my $self = shift;
1320   if ( $self->domsvc ) {
1321     #$self->svc_domain->domain;
1322     my $svc_domain = $self->svc_domain
1323       or die "no svc_domain.svcnum for svc_acct.domsvc ". $self->domsvc;
1324     $svc_domain->domain;
1325   } else {
1326     $mydomain or die "svc_acct.domsvc is null and no legacy domain config file";
1327   }
1328 }
1329
1330 =item svc_domain
1331
1332 Returns the FS::svc_domain record for this account's domain (see
1333 L<FS::svc_domain>.
1334
1335 =cut
1336
1337 sub svc_domain {
1338   my $self = shift;
1339   $self->{'_domsvc'}
1340     ? $self->{'_domsvc'}
1341     : qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } );
1342 }
1343
1344 =item cust_svc
1345
1346 Returns the FS::cust_svc record for this account (see L<FS::cust_svc>).
1347
1348 sub cust_svc {
1349   my $self = shift;
1350   qsearchs( 'cust_svc', { 'svcnum' => $self->svcnum } );
1351 }
1352
1353 =item email
1354
1355 Returns an email address associated with the account.
1356
1357 =cut
1358
1359 sub email {
1360   my $self = shift;
1361   $self->username. '@'. $self->domain;
1362 }
1363
1364 =item seconds_since TIMESTAMP
1365
1366 Returns the number of seconds this account has been online since TIMESTAMP.
1367 See L<FS::session>
1368
1369 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
1370 L<Time::Local> and L<Date::Parse> for conversion functions.
1371
1372 =cut
1373
1374 #note: POD here, implementation in FS::cust_svc
1375 sub seconds_since {
1376   my $self = shift;
1377   $self->cust_svc->seconds_since(@_);
1378 }
1379
1380 =back
1381
1382 =head1 BUGS
1383
1384 The $recref stuff in sub check should be cleaned up.
1385
1386 The suspend, unsuspend and cancel methods update the database, but not the
1387 current object.  This is probably a bug as it's unexpected and
1388 counterintuitive.
1389
1390 =head1 SEE ALSO
1391
1392 L<FS::svc_Common>, edit/part_svc.cgi from an installed web interface,
1393 export.html from the base documentation, L<FS::Record>, L<FS::Conf>,
1394 L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, L<FS::queue>,
1395 L<freeside-queued>), L<Net::SSH>, L<ssh>, L<FS::svc_acct_pop>,
1396 schema.html from the base documentation.
1397
1398 =cut
1399
1400 1;
1401