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:$vpopdir/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   my $error = $queue->insert;
1034   die $error if $error;
1035
1036   1;
1037 }
1038
1039
1040 =item suspend
1041
1042 Suspends this account by prefixing *SUSPENDED* to the password.  If there is an
1043 error, returns the error, otherwise returns false.
1044
1045 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
1046
1047 =cut
1048
1049 sub suspend {
1050   my $self = shift;
1051   my %hash = $self->hash;
1052   unless ( $hash{_password} =~ /^\*SUSPENDED\* /
1053            || $hash{_password} eq '*'
1054          ) {
1055     $hash{_password} = '*SUSPENDED* '.$hash{_password};
1056     my $new = new FS::svc_acct ( \%hash );
1057     $new->replace($self);
1058   } else {
1059     ''; #no error (already suspended)
1060   }
1061 }
1062
1063 =item unsuspend
1064
1065 Unsuspends this account by removing *SUSPENDED* from the password.  If there is
1066 an error, returns the error, otherwise returns false.
1067
1068 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
1069
1070 =cut
1071
1072 sub unsuspend {
1073   my $self = shift;
1074   my %hash = $self->hash;
1075   if ( $hash{_password} =~ /^\*SUSPENDED\* (.*)$/ ) {
1076     $hash{_password} = $1;
1077     my $new = new FS::svc_acct ( \%hash );
1078     $new->replace($self);
1079   } else {
1080     ''; #no error (already unsuspended)
1081   }
1082 }
1083
1084 =item cancel
1085
1086 Just returns false (no error) for now.
1087
1088 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
1089
1090 =item check
1091
1092 Checks all fields to make sure this is a valid service.  If there is an error,
1093 returns the error, otherwise returns false.  Called by the insert and replace
1094 methods.
1095
1096 Sets any fixed values; see L<FS::part_svc>.
1097
1098 =cut
1099
1100 sub check {
1101   my $self = shift;
1102
1103   my($recref) = $self->hashref;
1104
1105   my $x = $self->setfixed;
1106   return $x unless ref($x);
1107   my $part_svc = $x;
1108
1109   my $error = $self->ut_numbern('svcnum')
1110               || $self->ut_number('domsvc')
1111   ;
1112   return $error if $error;
1113
1114   my $ulen = $usernamemax || $self->dbdef_table->column('username')->length;
1115   if ( $username_uppercase ) {
1116     $recref->{username} =~ /^([a-z0-9_\-\.\&]{$usernamemin,$ulen})$/i
1117       or return "Illegal username: ". $recref->{username};
1118     $recref->{username} = $1;
1119   } else {
1120     $recref->{username} =~ /^([a-z0-9_\-\.\&]{$usernamemin,$ulen})$/
1121       or return "Illegal username: ". $recref->{username};
1122     $recref->{username} = $1;
1123   }
1124
1125   if ( $username_letterfirst ) {
1126     $recref->{username} =~ /^[a-z]/ or return "Illegal username";
1127   } elsif ( $username_letter ) {
1128     $recref->{username} =~ /[a-z]/ or return "Illegal username";
1129   }
1130   if ( $username_noperiod ) {
1131     $recref->{username} =~ /\./ and return "Illegal username";
1132   }
1133   unless ( $username_ampersand ) {
1134     $recref->{username} =~ /\&/ and return "Illegal username";
1135   }
1136
1137   $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum};
1138   $recref->{popnum} = $1;
1139   return "Unknown popnum" unless
1140     ! $recref->{popnum} ||
1141     qsearchs('svc_acct_pop',{'popnum'=> $recref->{popnum} } );
1142
1143   unless ( $part_svc->part_svc_column('uid')->columnflag eq 'F' ) {
1144
1145     $recref->{uid} =~ /^(\d*)$/ or return "Illegal uid";
1146     $recref->{uid} = $1 eq '' ? $self->unique('uid') : $1;
1147
1148     $recref->{gid} =~ /^(\d*)$/ or return "Illegal gid";
1149     $recref->{gid} = $1 eq '' ? $recref->{uid} : $1;
1150     #not all systems use gid=uid
1151     #you can set a fixed gid in part_svc
1152
1153     return "Only root can have uid 0"
1154       if $recref->{uid} == 0 && $recref->{username} ne 'root';
1155
1156 #    $error = $self->ut_textn('finger');
1157 #    return $error if $error;
1158     $self->getfield('finger') =~
1159       /^([\w \t\!\@\#\$\%\&\(\)\-\+\;\:\'\"\,\.\?\/\*\<\>]*)$/
1160         or return "Illegal finger: ". $self->getfield('finger');
1161     $self->setfield('finger', $1);
1162
1163     $recref->{dir} =~ /^([\/\w\-\.\&]*)$/
1164       or return "Illegal directory";
1165     $recref->{dir} = $1;
1166     return "Illegal directory"
1167       if $recref->{dir} =~ /(^|\/)\.+(\/|$)/; #no .. component
1168     return "Illegal directory"
1169       if $recref->{dir} =~ /\&/ && ! $username_ampersand;
1170     unless ( $recref->{dir} ) {
1171       $recref->{dir} = $dir_prefix . '/';
1172       if ( $dirhash > 0 ) {
1173         for my $h ( 1 .. $dirhash ) {
1174           $recref->{dir} .= substr($recref->{username}, $h-1, 1). '/';
1175         }
1176       } elsif ( $dirhash < 0 ) {
1177         for my $h ( reverse $dirhash .. -1 ) {
1178           $recref->{dir} .= substr($recref->{username}, $h, 1). '/';
1179         }
1180       }
1181       $recref->{dir} .= $recref->{username};
1182     ;
1183     }
1184
1185     unless ( $recref->{username} eq 'sync' ) {
1186       if ( grep $_ eq $recref->{shell}, @shells ) {
1187         $recref->{shell} = (grep $_ eq $recref->{shell}, @shells)[0];
1188       } else {
1189         return "Illegal shell \`". $self->shell. "\'; ".
1190                $conf->dir. "/shells contains: @shells";
1191       }
1192     } else {
1193       $recref->{shell} = '/bin/sync';
1194     }
1195
1196     $recref->{quota} =~ /^(\d*)$/ or return "Illegal quota (unimplemented)";
1197     $recref->{quota} = $1;
1198
1199   } else {
1200     $recref->{gid} ne '' ?
1201       return "Can't have gid without uid" : ( $recref->{gid}='' );
1202     $recref->{finger} ne '' ?
1203       return "Can't have finger-name without uid" : ( $recref->{finger}='' );
1204     $recref->{dir} ne '' ?
1205       return "Can't have directory without uid" : ( $recref->{dir}='' );
1206     $recref->{shell} ne '' ?
1207       return "Can't have shell without uid" : ( $recref->{shell}='' );
1208     $recref->{quota} ne '' ?
1209       return "Can't have quota without uid" : ( $recref->{quota}='' );
1210   }
1211
1212   unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) {
1213     unless ( $recref->{slipip} eq '0e0' ) {
1214       $recref->{slipip} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/
1215         or return "Illegal slipip". $self->slipip;
1216       $recref->{slipip} = $1;
1217     } else {
1218       $recref->{slipip} = '0e0';
1219     }
1220
1221   }
1222
1223   #arbitrary RADIUS stuff; allow ut_textn for now
1224   foreach ( grep /^radius_/, fields('svc_acct') ) {
1225     $self->ut_textn($_);
1226   }
1227
1228   #generate a password if it is blank
1229   $recref->{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) )
1230     unless ( $recref->{_password} );
1231
1232   #if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,16})$/ ) {
1233   if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{$passwordmin,$passwordmax})$/ ) {
1234     $recref->{_password} = $1.$3;
1235     #uncomment this to encrypt password immediately upon entry, or run
1236     #bin/crypt_pw in cron to give new users a window during which their
1237     #password is available to techs, for faxing, etc.  (also be aware of
1238     #radius issues!)
1239     #$recref->{password} = $1.
1240     #  crypt($3,$saltset[int(rand(64))].$saltset[int(rand(64))]
1241     #;
1242   } elsif ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([\w\.\/\$]{13,34})$/ ) {
1243     $recref->{_password} = $1.$3;
1244   } elsif ( $recref->{_password} eq '*' ) {
1245     $recref->{_password} = '*';
1246   } elsif ( $recref->{_password} eq '!!' ) {
1247     $recref->{_password} = '!!';
1248   } else {
1249     #return "Illegal password";
1250     return "Illegal password: ". $recref->{_password};
1251   }
1252
1253   ''; #no error
1254 }
1255
1256 =item radius
1257
1258 Depriciated, use radius_reply instead.
1259
1260 =cut
1261
1262 sub radius {
1263   carp "FS::svc_acct::radius depriciated, use radius_reply";
1264   $_[0]->radius_reply;
1265 }
1266
1267 =item radius_reply
1268
1269 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
1270 reply attributes of this record.
1271
1272 Note that this is now the preferred method for reading RADIUS attributes -
1273 accessing the columns directly is discouraged, as the column names are
1274 expected to change in the future.
1275
1276 =cut
1277
1278 sub radius_reply {
1279   my $self = shift;
1280   my %reply =
1281     map {
1282       /^(radius_(.*))$/;
1283       my($column, $attrib) = ($1, $2);
1284       #$attrib =~ s/_/\-/g;
1285       ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
1286     } grep { /^radius_/ && $self->getfield($_) } fields( $self->table );
1287   if ( $self->ip && $self->ip ne '0e0' ) {
1288     $reply{'Framed-IP-Address'} = $self->ip;
1289   }
1290   %reply;
1291 }
1292
1293 =item radius_check
1294
1295 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
1296 check attributes of this record.
1297
1298 Accessing RADIUS attributes directly is not supported and will break in the
1299 future.
1300
1301 =cut
1302
1303 sub radius_check {
1304   my $self = shift;
1305   map {
1306     /^(rc_(.*))$/;
1307     my($column, $attrib) = ($1, $2);
1308     #$attrib =~ s/_/\-/g;
1309     ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
1310   } grep { /^rc_/ && $self->getfield($_) } fields( $self->table );
1311 }
1312
1313 =item domain
1314
1315 Returns the domain associated with this account.
1316
1317 =cut
1318
1319 sub domain {
1320   my $self = shift;
1321   if ( $self->domsvc ) {
1322     #$self->svc_domain->domain;
1323     my $svc_domain = $self->svc_domain
1324       or die "no svc_domain.svcnum for svc_acct.domsvc ". $self->domsvc;
1325     $svc_domain->domain;
1326   } else {
1327     $mydomain or die "svc_acct.domsvc is null and no legacy domain config file";
1328   }
1329 }
1330
1331 =item svc_domain
1332
1333 Returns the FS::svc_domain record for this account's domain (see
1334 L<FS::svc_domain>.
1335
1336 =cut
1337
1338 sub svc_domain {
1339   my $self = shift;
1340   $self->{'_domsvc'}
1341     ? $self->{'_domsvc'}
1342     : qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } );
1343 }
1344
1345 =item cust_svc
1346
1347 Returns the FS::cust_svc record for this account (see L<FS::cust_svc>).
1348
1349 sub cust_svc {
1350   my $self = shift;
1351   qsearchs( 'cust_svc', { 'svcnum' => $self->svcnum } );
1352 }
1353
1354 =item email
1355
1356 Returns an email address associated with the account.
1357
1358 =cut
1359
1360 sub email {
1361   my $self = shift;
1362   $self->username. '@'. $self->domain;
1363 }
1364
1365 =item seconds_since TIMESTAMP
1366
1367 Returns the number of seconds this account has been online since TIMESTAMP.
1368 See L<FS::session>
1369
1370 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">.  Also see
1371 L<Time::Local> and L<Date::Parse> for conversion functions.
1372
1373 =cut
1374
1375 #note: POD here, implementation in FS::cust_svc
1376 sub seconds_since {
1377   my $self = shift;
1378   $self->cust_svc->seconds_since(@_);
1379 }
1380
1381 =back
1382
1383 =head1 BUGS
1384
1385 The $recref stuff in sub check should be cleaned up.
1386
1387 The suspend, unsuspend and cancel methods update the database, but not the
1388 current object.  This is probably a bug as it's unexpected and
1389 counterintuitive.
1390
1391 =head1 SEE ALSO
1392
1393 L<FS::svc_Common>, edit/part_svc.cgi from an installed web interface,
1394 export.html from the base documentation, L<FS::Record>, L<FS::Conf>,
1395 L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, L<FS::queue>,
1396 L<freeside-queued>), L<Net::SSH>, L<ssh>, L<FS::svc_acct_pop>,
1397 schema.html from the base documentation.
1398
1399 =cut
1400
1401 1;
1402