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