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 $username_letter $username_letterfirst
   6              $username_noperiod
   7              $shellmachine $useradd $usermod $userdel $mydomain
   8              $cyrus_server $cyrus_admin_user $cyrus_admin_pass
   9              @saltset @pw_set);
  10 use Carp;
  11 use FS::Conf;
  12 use FS::Record qw( qsearch qsearchs fields dbh );
  13 use FS::svc_Common;
  14 use Net::SSH qw(ssh);
  15 use FS::part_svc;
  16 use FS::svc_acct_pop;
  17 use FS::svc_acct_sm;
  18 use FS::cust_main_invoice;
  19 use FS::svc_domain;
  20 use FS::raddb;
  21 use FS::queue;
  22
  23 @ISA = qw( FS::svc_Common );
  24
  25 #ask FS::UID to run this stuff for us later
  26 $FS::UID::callback{'FS::svc_acct'} = sub {
  27   $conf = new FS::Conf;
  28   $dir_prefix = $conf->config('home');
  29   @shells = $conf->config('shells');
  30   $shellmachine = $conf->config('shellmachine');
  31   $usernamemin = $conf->config('usernamemin') || 2;
  32   $usernamemax = $conf->config('usernamemax');
  33   $passwordmin = $conf->config('passwordmin') || 6;
  34   if ( $shellmachine ) {
  35     if ( $conf->exists('shellmachine-useradd') ) {
  36       $useradd = join("\n", $conf->config('shellmachine-useradd') )
  37                  || 'cp -pr /etc/skel $dir; chown -R $uid.$gid $dir';
  38     } else {
  39       $useradd = 'useradd -d $dir -m -s $shell -u $uid $username';
  40     }
  41     if ( $conf->exists('shellmachine-userdel') ) {
  42       $userdel = join("\n", $conf->config('shellmachine-userdel') )
  43                  || 'rm -rf $dir';
  44     } else {
  45       $userdel = 'userdel $username';
  46     }
  47     $usermod = join("\n", $conf->config('shellmachine-usermod') )
  48                || '[ -d $old_dir ] && mv $old_dir $new_dir || ( '.
  49                     'chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; '.
  50                     'find . -depth -print | cpio -pdm $new_dir; '.
  51                     'chmod u-t $new_dir; chown -R $uid.$gid $new_dir; '.
  52                     'rm -rf $old_dir'.
  53                   ')';
  54   }
  55   $username_letter = $conf->exists('username-letter');
  56   $username_letterfirst = $conf->exists('username-letterfirst');
  57   $username_noperiod = $conf->exists('username-noperiod');
  58   $mydomain = $conf->config('domain');
  59   if ( $conf->exists('cyrus') ) {
  60     ($cyrus_server, $cyrus_admin_user, $cyrus_admin_pass) =
  61       $conf->config('cyrus');
  62     eval "use Cyrus::IMAP::Admin;"
  63   } else {
  64     $cyrus_server = '';
  65     $cyrus_admin_user = '';
  66     $cyrus_admin_pass = '';
  67   }
  68 };
  69
  70 @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
  71 @pw_set = ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '!', '.', ',' );
  72
  73 #not needed in 5.004 #srand($$|time);
  74
  75 =head1 NAME
  76
  77 FS::svc_acct - Object methods for svc_acct records
  78
  79 =head1 SYNOPSIS
  80
  81   use FS::svc_acct;
  82
  83   $record = new FS::svc_acct \%hash;
  84   $record = new FS::svc_acct { 'column' => 'value' };
  85
  86   $error = $record->insert;
  87
  88   $error = $new_record->replace($old_record);
  89
  90   $error = $record->delete;
  91
  92   $error = $record->check;
  93
  94   $error = $record->suspend;
  95
  96   $error = $record->unsuspend;
  97
  98   $error = $record->cancel;
  99
 100   %hash = $record->radius;
 101
 102   %hash = $record->radius_reply;
 103
 104   %hash = $record->radius_check;
 105
 106 =head1 DESCRIPTION
 107
 108 An FS::svc_acct object represents an account.  FS::svc_acct inherits from
 109 FS::svc_Common.  The following fields are currently supported:
 110
 111 =over 4
 112
 113 =item svcnum - primary key (assigned automatcially for new accounts)
 114
 115 =item username
 116
 117 =item _password - generated if blank
 118
 119 =item popnum - Point of presence (see L<FS::svc_acct_pop>)
 120
 121 =item uid
 122
 123 =item gid
 124
 125 =item finger - GECOS
 126
 127 =item dir - set automatically if blank (and uid is not)
 128
 129 =item shell
 130
 131 =item quota - (unimplementd)
 132
 133 =item slipip - IP address
 134
 135 =item seconds -
 136
 137 =item domsvc - svcnum from svc_domain
 138
 139 =item radius_I<Radius_Attribute> - I<Radius-Attribute>
 140
 141 =item domsvc - service number of svc_domain with which to associate
 142
 143 =back
 144
 145 =head1 METHODS
 146
 147 =over 4
 148
 149 =item new HASHREF
 150
 151 Creates a new account.  To add the account to the database, see L<"insert">.
 152
 153 =cut
 154
 155 sub table { 'svc_acct'; }
 156
 157 =item insert
 158
 159 Adds this account to the database.  If there is an error, returns the error,
 160 otherwise returns false.
 161
 162 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
 163 defined.  An FS::cust_svc record will be created and inserted.
 164
 165 If the configuration value (see L<FS::Conf>) shellmachine exists, and the
 166 username, uid, and dir fields are defined, the command(s) specified in
 167 the shellmachine-useradd configuration are added to the job queue (see
 168 L<FS::queue> and L<freeside-queued>) to be exectued on shellmachine via ssh.
 169 This behaviour can be surpressed by setting $FS::svc_acct::nossh_hack true.
 170 If the shellmachine-useradd configuration file does not exist,
 171
 172   useradd -d $dir -m -s $shell -u $uid $username
 173
 174 is the default.  If the shellmachine-useradd configuration file exists but
 175 it empty,
 176
 177   cp -pr /etc/skel $dir; chown -R $uid.$gid $dir
 178
 179 is the default instead.  Otherwise the contents of the file are treated as
 180 a double-quoted perl string, with the following variables available:
 181 $username, $uid, $gid, $dir, and $shell.
 182
 183 (TODOC: cyrus config file, L<FS::queue> and L<freeside-queued>)
 184
 185 =cut
 186
 187 sub insert {
 188   my $self = shift;
 189   my $error;
 190
 191   local $SIG{HUP} = 'IGNORE';
 192   local $SIG{INT} = 'IGNORE';
 193   local $SIG{QUIT} = 'IGNORE';
 194   local $SIG{TERM} = 'IGNORE';
 195   local $SIG{TSTP} = 'IGNORE';
 196   local $SIG{PIPE} = 'IGNORE';
 197
 198   my $oldAutoCommit = $FS::UID::AutoCommit;
 199   local $FS::UID::AutoCommit = 0;
 200   my $dbh = dbh;
 201
 202   my $amount = 0;
 203
 204   $error = $self->check;
 205   return $error if $error;
 206
 207   return "Username ". $self->username. " in use"
 208     if qsearchs( 'svc_acct', { 'username' => $self->username,
 209                                'domsvc'   => $self->domsvc,
 210                              } );
 211
 212   my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
 213   return "Unknown svcpart" unless $part_svc;
 214   return "uid in use"
 215     if $part_svc->part_svc_column('uid')->columnflag ne 'F'
 216       && qsearchs( 'svc_acct', { 'uid' => $self->uid } )
 217       && $self->username !~ /^(hyla)?fax$/
 218     ;
 219
 220   $error = $self->SUPER::insert;
 221   if ( $error ) {
 222     $dbh->rollback if $oldAutoCommit;
 223     return $error;
 224   }
 225
 226   my( $username, $uid, $gid, $dir, $shell ) = (
 227     $self->username,
 228     $self->uid,
 229     $self->gid,
 230     $self->dir,
 231     $self->shell,
 232   );
 233   if ( $username && $uid && $dir && $shellmachine && ! $nossh_hack ) {
 234     my $queue = new FS::queue { 'job' => 'Net::SSH::ssh' };
 235     $error = $queue->insert("root\@$shellmachine", eval qq("$useradd") );
 236     if ( $error ) {
 237       $dbh->rollback if $oldAutoCommit;
 238       return "queueing job (transaction rolled back): $error";
 239     }
 240   }
 241
 242   if ( $cyrus_server ) {
 243     my $queue = new FS::queue { 'job' => 'FS::svc_acct::cyrus_insert' };
 244     $error = $queue->insert($self->username, $self->quota);
 245     if ( $error ) {
 246       $dbh->rollback if $oldAutoCommit;
 247       return "queueing job (transaction rolled back): $error";
 248     }
 249   }
 250
 251   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 252   ''; #no error
 253 }
 254
 255 sub cyrus_insert {
 256   my( $username, $quota ) = @_;
 257
 258   my $client = Cyrus::IMAP::Admin->new($cyrus_server);
 259   $client->authenticate(
 260     -user      => $cyrus_admin_user,
 261     -mechanism => "login",
 262     -password  => $cyrus_admin_pass
 263   );
 264
 265   my $rc = $client->create("user.$username");
 266   my $error = $client->error;
 267   die $error if $error;
 268
 269   $rc = $client->setacl("user.$username", $username => 'all' );
 270   $error = $client->error;
 271   die $error if $error;
 272
 273   if ( $quota ) {
 274     $rc = $client->setquota("user.$username", 'STORAGE' => $quota );
 275     $error = $client->error;
 276     die $error if $error;
 277   }
 278
 279   1;
 280 }
 281
 282 =item delete
 283
 284 Deletes this account from the database.  If there is an error, returns the
 285 error, otherwise returns false.
 286
 287 The corresponding FS::cust_svc record will be deleted as well.
 288
 289 If the configuration value (see L<FS::Conf>) shellmachine exists, the
 290 command(s) specified in the shellmachine-userdel configuration file are
 291 added to the job queue (see L<FS::queue> and L<freeside-queued>) to be executed
 292 on shellmachine via ssh.  This behavior can be surpressed by setting
 293 $FS::svc_acct::nossh_hack true.  If the shellmachine-userdel configuration
 294 file does not exist,
 295
 296   userdel $username
 297
 298 is the default.  If the shellmachine-userdel configuration file exists but
 299 is empty,
 300
 301   rm -rf $dir
 302
 303 is the default instead.  Otherwise the contents of the file are treated as a
 304 double-quoted perl string, with the following variables available:
 305 $username and $dir.
 306
 307 (TODOC: cyrus config file)
 308
 309 =cut
 310
 311 sub delete {
 312   my $self = shift;
 313
 314   return "Can't delete an account which has (svc_acct_sm) mail aliases!"
 315     if $self->uid && qsearch( 'svc_acct_sm', { 'domuid' => $self->uid } );
 316
 317   return "Can't delete an account which is a (svc_forward) source!"
 318     if qsearch( 'svc_forward', { 'srcsvc' => $self->svcnum } );
 319
 320   return "Can't delete an account which is a (svc_forward) destination!"
 321     if qsearch( 'svc_forward', { 'dstsvc' => $self->svcnum } );
 322
 323   return "Can't delete an account with (svc_www) web service!"
 324     if qsearch( 'svc_www', { 'usersvc' => $self->usersvc } );
 325
 326   # what about records in session ?
 327
 328   local $SIG{HUP} = 'IGNORE';
 329   local $SIG{INT} = 'IGNORE';
 330   local $SIG{QUIT} = 'IGNORE';
 331   local $SIG{TERM} = 'IGNORE';
 332   local $SIG{TSTP} = 'IGNORE';
 333   local $SIG{PIPE} = 'IGNORE';
 334
 335   my $oldAutoCommit = $FS::UID::AutoCommit;
 336   local $FS::UID::AutoCommit = 0;
 337   my $dbh = dbh;
 338
 339   foreach my $cust_main_invoice (
 340     qsearch( 'cust_main_invoice', { 'dest' => $self->svcnum } )
 341   ) {
 342     my %hash = $cust_main_invoice->hash;
 343     $hash{'dest'} = $self->email;
 344     my $new = new FS::cust_main_invoice \%hash;
 345     my $error = $new->replace($cust_main_invoice);
 346     if ( $error ) {
 347       $dbh->rollback if $oldAutoCommit;
 348       return $error;
 349     }
 350   }
 351
 352   foreach my $svc_domain (
 353     qsearch( 'svc_domain', { 'catchall' => $self->svcnum } )
 354   ) {
 355     my %hash = new FS::svc_domain->hash;
 356     $hash{'catchall'} = '';
 357     my $new = new FS::svc_domain \%hash;
 358     my $error = $new->replace($svc_domain);
 359     if ( $error ) {
 360       $dbh->rollback if $oldAutoCommit;
 361       return $error;
 362     }
 363   }
 364
 365   my $error = $self->SUPER::delete;
 366   if ( $error ) {
 367     $dbh->rollback if $oldAutoCommit;
 368     return $error;
 369   }
 370
 371   my( $username, $dir ) = (
 372     $self->username,
 373     $self->dir,
 374   );
 375   if ( $username && $shellmachine && ! $nossh_hack ) {
 376     my $queue = new FS::queue { 'job' => 'Net::SSH::ssh' };
 377     $error = $queue->insert("root\@$shellmachine", eval qq("$userdel") );
 378     if ( $error ) {
 379       $dbh->rollback if $oldAutoCommit;
 380       return "queueing job (transaction rolled back): $error";
 381     }
 382
 383   }
 384
 385   if ( $cyrus_server ) {
 386     my $queue = new FS::queue { 'job' => 'FS::svc_acct::cyrus_delete' };
 387     $error = $queue->insert($self->username);
 388     if ( $error ) {
 389       $dbh->rollback if $oldAutoCommit;
 390       return "queueing job (transaction rolled back): $error";
 391     }
 392   }
 393
 394   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 395   '';
 396 }
 397
 398 sub cyrus_delete {
 399   my $username = shift;
 400
 401   my $client = Cyrus::IMAP::Admin->new($cyrus_server);
 402   $client->authenticate(
 403     -user      => $cyrus_admin_user,
 404     -mechanism => "login",
 405     -password  => $cyrus_admin_pass
 406   );
 407
 408   my $rc = $client->setacl("user.$username", $cyrus_admin_user => 'all' );
 409   my $error = $client->error;
 410   die $error if $error;
 411
 412   $rc = $client->delete("user.$username");
 413   $error = $client->error;
 414   die $error if $error;
 415
 416   1;
 417 }
 418
 419 =item replace OLD_RECORD
 420
 421 Replaces OLD_RECORD with this one in the database.  If there is an error,
 422 returns the error, otherwise returns false.
 423
 424 If the configuration value (see L<FS::Conf>) shellmachine exists, and the
 425 dir field has changed, the command(s) specified in the shellmachine-usermod
 426 configuraiton file are added to the job queue (see L<FS::queue> and
 427 L<freeside-queued>) to be executed on shellmachine via ssh.  This behavior can
 428 be surpressed by setting $FS::svc-acct::nossh_hack true.  If the
 429 shellmachine-userdel configuration file does not exist or is empty,
 430
 431   [ -d $old_dir ] && mv $old_dir $new_dir || (
 432     chmod u+t $old_dir;
 433     mkdir $new_dir;
 434     cd $old_dir;
 435     find . -depth -print | cpio -pdm $new_dir;
 436     chmod u-t $new_dir;
 437     chown -R $uid.$gid $new_dir;
 438     rm -rf $old_dir
 439   )
 440
 441 is the default.  This behaviour can be surpressed by setting
 442 $FS::svc_acct::nossh_hack true.
 443
 444 =cut
 445
 446 sub replace {
 447   my ( $new, $old ) = ( shift, shift );
 448   my $error;
 449
 450   return "Username in use"
 451     if $old->username ne $new->username &&
 452       qsearchs( 'svc_acct', { 'username' => $new->username } );
 453
 454   return "Can't change uid!" if $old->uid != $new->uid;
 455
 456   return "can't change username using Cyrus"
 457     if $cyrus_server && $old->username ne $new->username;
 458
 459   #change homdir when we change username
 460   $new->setfield('dir', '') if $old->username ne $new->username;
 461
 462   local $SIG{HUP} = 'IGNORE';
 463   local $SIG{INT} = 'IGNORE';
 464   local $SIG{QUIT} = 'IGNORE';
 465   local $SIG{TERM} = 'IGNORE';
 466   local $SIG{TSTP} = 'IGNORE';
 467   local $SIG{PIPE} = 'IGNORE';
 468
 469   my $oldAutoCommit = $FS::UID::AutoCommit;
 470   local $FS::UID::AutoCommit = 0;
 471   my $dbh = dbh;
 472
 473   $error = $new->SUPER::replace($old);
 474   if ( $error ) {
 475     $dbh->rollback if $oldAutoCommit;
 476     return $error if $error;
 477   }
 478
 479   my ( $old_dir, $new_dir, $uid, $gid ) = (
 480     $old->getfield('dir'),
 481     $new->getfield('dir'),
 482     $new->getfield('uid'),
 483     $new->getfield('gid'),
 484   );
 485   if ( $old_dir && $new_dir && $old_dir ne $new_dir && ! $nossh_hack ) {
 486     my $queue = new FS::queue { 'job' => 'Net::SSH::ssh' };
 487     $error = $queue->insert("root\@$shellmachine", eval qq("$usermod") );
 488     if ( $error ) {
 489       $dbh->rollback if $oldAutoCommit;
 490       return "queueing job (transaction rolled back): $error";
 491     }
 492   }
 493
 494   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 495   ''; #no error
 496 }
 497
 498 =item suspend
 499
 500 Suspends this account by prefixing *SUSPENDED* to the password.  If there is an
 501 error, returns the error, otherwise returns false.
 502
 503 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 504
 505 =cut
 506
 507 sub suspend {
 508   my $self = shift;
 509   my %hash = $self->hash;
 510   unless ( $hash{_password} =~ /^\*SUSPENDED\* / ) {
 511     $hash{_password} = '*SUSPENDED* '.$hash{_password};
 512     my $new = new FS::svc_acct ( \%hash );
 513     $new->replace($self);
 514   } else {
 515     ''; #no error (already suspended)
 516   }
 517 }
 518
 519 =item unsuspend
 520
 521 Unsuspends this account by removing *SUSPENDED* from the password.  If there is
 522 an error, returns the error, otherwise returns false.
 523
 524 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 525
 526 =cut
 527
 528 sub unsuspend {
 529   my $self = shift;
 530   my %hash = $self->hash;
 531   if ( $hash{_password} =~ /^\*SUSPENDED\* (.*)$/ ) {
 532     $hash{_password} = $1;
 533     my $new = new FS::svc_acct ( \%hash );
 534     $new->replace($self);
 535   } else {
 536     ''; #no error (already unsuspended)
 537   }
 538 }
 539
 540 =item cancel
 541
 542 Just returns false (no error) for now.
 543
 544 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 545
 546 =item check
 547
 548 Checks all fields to make sure this is a valid service.  If there is an error,
 549 returns the error, otherwise returns false.  Called by the insert and replace
 550 methods.
 551
 552 Sets any fixed values; see L<FS::part_svc>.
 553
 554 =cut
 555
 556 sub check {
 557   my $self = shift;
 558
 559   my($recref) = $self->hashref;
 560
 561   my $x = $self->setfixed;
 562   return $x unless ref($x);
 563   my $part_svc = $x;
 564
 565   my $error = $self->ut_numbern('svcnum')
 566               || $self->ut_number('domsvc')
 567   ;
 568   return $error if $error;
 569
 570   my $ulen = $usernamemax || $self->dbdef_table->column('username')->length;
 571   $recref->{username} =~ /^([a-z0-9_\-\.]{$usernamemin,$ulen})$/
 572     or return "Illegal username";
 573   $recref->{username} = $1;
 574   if ( $username_letterfirst ) {
 575     $recref->{username} =~ /^[a-z]/ or return "Illegal username";
 576   } elsif ( $username_letter ) {
 577     $recref->{username} =~ /[a-z]/ or return "Illegal username";
 578   }
 579   if ( $username_noperiod ) {
 580     $recref->{username} =~ /\./ and return "Illegal username";
 581   }
 582
 583   $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum};
 584   $recref->{popnum} = $1;
 585   return "Unknown popnum" unless
 586     ! $recref->{popnum} ||
 587     qsearchs('svc_acct_pop',{'popnum'=> $recref->{popnum} } );
 588
 589   unless ( $part_svc->part_svc_column('uid')->columnflag eq 'F' ) {
 590
 591     $recref->{uid} =~ /^(\d*)$/ or return "Illegal uid";
 592     $recref->{uid} = $1 eq '' ? $self->unique('uid') : $1;
 593
 594     $recref->{gid} =~ /^(\d*)$/ or return "Illegal gid";
 595     $recref->{gid} = $1 eq '' ? $recref->{uid} : $1;
 596     #not all systems use gid=uid
 597     #you can set a fixed gid in part_svc
 598
 599     return "Only root can have uid 0"
 600       if $recref->{uid} == 0 && $recref->{username} ne 'root';
 601
 602     $error = $self->ut_textn('finger');
 603     return $error if $error;
 604
 605     $recref->{dir} =~ /^([\/\w\-]*)$/
 606       or return "Illegal directory";
 607     $recref->{dir} = $1 ||
 608       $dir_prefix . '/' . $recref->{username}
 609       #$dir_prefix . '/' . substr($recref->{username},0,1). '/' . $recref->{username}
 610     ;
 611
 612     unless ( $recref->{username} eq 'sync' ) {
 613       if ( grep $_ eq $recref->{shell}, @shells ) {
 614         $recref->{shell} = (grep $_ eq $recref->{shell}, @shells)[0];
 615       } else {
 616         return "Illegal shell \`". $self->shell. "\'; ".
 617                $conf->dir. "/shells contains: @shells";
 618       }
 619     } else {
 620       $recref->{shell} = '/bin/sync';
 621     }
 622
 623     $recref->{quota} =~ /^(\d*)$/ or return "Illegal quota (unimplemented)";
 624     $recref->{quota} = $1;
 625
 626   } else {
 627     $recref->{gid} ne '' ?
 628       return "Can't have gid without uid" : ( $recref->{gid}='' );
 629     $recref->{finger} ne '' ?
 630       return "Can't have finger-name without uid" : ( $recref->{finger}='' );
 631     $recref->{dir} ne '' ?
 632       return "Can't have directory without uid" : ( $recref->{dir}='' );
 633     $recref->{shell} ne '' ?
 634       return "Can't have shell without uid" : ( $recref->{shell}='' );
 635     $recref->{quota} ne '' ?
 636       return "Can't have quota without uid" : ( $recref->{quota}='' );
 637   }
 638
 639   unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) {
 640     unless ( $recref->{slipip} eq '0e0' ) {
 641       $recref->{slipip} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/
 642         or return "Illegal slipip". $self->slipip;
 643       $recref->{slipip} = $1;
 644     } else {
 645       $recref->{slipip} = '0e0';
 646     }
 647
 648   }
 649
 650   #arbitrary RADIUS stuff; allow ut_textn for now
 651   foreach ( grep /^radius_/, fields('svc_acct') ) {
 652     $self->ut_textn($_);
 653   }
 654
 655   #generate a password if it is blank
 656   $recref->{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) )
 657     unless ( $recref->{_password} );
 658
 659   #if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,16})$/ ) {
 660   if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{$passwordmin,8})$/ ) {
 661     $recref->{_password} = $1.$3;
 662     #uncomment this to encrypt password immediately upon entry, or run
 663     #bin/crypt_pw in cron to give new users a window during which their
 664     #password is available to techs, for faxing, etc.  (also be aware of
 665     #radius issues!)
 666     #$recref->{password} = $1.
 667     #  crypt($3,$saltset[int(rand(64))].$saltset[int(rand(64))]
 668     #;
 669   } elsif ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([\w\.\/\$]{13,34})$/ ) {
 670     $recref->{_password} = $1.$3;
 671   } elsif ( $recref->{_password} eq '*' ) {
 672     $recref->{_password} = '*';
 673   } elsif ( $recref->{_password} eq '!!' ) {
 674     $recref->{_password} = '!!';
 675   } else {
 676     return "Illegal password";
 677   }
 678
 679   ''; #no error
 680 }
 681
 682 =item radius
 683
 684 Depriciated, use radius_reply instead.
 685
 686 =cut
 687
 688 sub radius {
 689   carp "FS::svc_acct::radius depriciated, use radius_reply";
 690   $_[0]->radius_reply;
 691 }
 692
 693 =item radius_reply
 694
 695 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
 696 reply attributes of this record.
 697
 698 Note that this is now the preferred method for reading RADIUS attributes -
 699 accessing the columns directly is discouraged, as the column names are
 700 expected to change in the future.
 701
 702 =cut
 703
 704 sub radius_reply {
 705   my $self = shift;
 706   map {
 707     /^(radius_(.*))$/;
 708     my($column, $attrib) = ($1, $2);
 709     #$attrib =~ s/_/\-/g;
 710     ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
 711   } grep { /^radius_/ && $self->getfield($_) } fields( $self->table );
 712 }
 713
 714 =item radius_check
 715
 716 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
 717 check attributes of this record.
 718
 719 Accessing RADIUS attributes directly is not supported and will break in the
 720 future.
 721
 722 =cut
 723
 724 sub radius_check {
 725   my $self = shift;
 726   map {
 727     /^(rc_(.*))$/;
 728     my($column, $attrib) = ($1, $2);
 729     #$attrib =~ s/_/\-/g;
 730     ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
 731   } grep { /^rc_/ && $self->getfield($_) } fields( $self->table );
 732 }
 733
 734 =item domain
 735
 736 Returns the domain associated with this account.
 737
 738 =cut
 739
 740 sub domain {
 741   my $self = shift;
 742   if ( $self->domsvc ) {
 743     my $svc_domain = qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } )
 744       or die "no svc_domain.svcnum for svc_acct.domsvc ". $self->domsvc;
 745     $svc_domain->domain;
 746   } else {
 747     $mydomain or die "svc_acct.domsvc is null and no legacy domain config file";
 748   }
 749 }
 750
 751 =item email
 752
 753 Returns an email address associated with the account.
 754
 755 =cut
 756
 757 sub email {
 758   my $self = shift;
 759   $self->username. '@'. $self->domain;
 760 }
 761
 762 =back
 763
 764 =head1 VERSION
 765
 766 $Id: svc_acct.pm,v 1.36 2001-09-11 12:00:19 ivan Exp $
 767
 768 =head1 BUGS
 769
 770 The bits which ssh should fork before doing so (or maybe queue jobs for a
 771 daemon).
 772
 773 The $recref stuff in sub check should be cleaned up.
 774
 775 The suspend, unsuspend and cancel methods update the database, but not the
 776 current object.  This is probably a bug as it's unexpected and
 777 counterintuitive.
 778
 779 =head1 SEE ALSO
 780
 781 L<FS::svc_Common>, L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>,
 782 L<FS::part_svc>, L<FS::cust_pkg>, L<FS::queue>, L<freeside-queued>),
 783 L<Net::SSH>, L<ssh>, L<FS::svc_acct_pop>,
 784 schema.html from the base documentation.
 785
 786 =cut
 787
 788 1;
 789