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   warn "cyrus_insert: starting for user $username, quota $quota\n";
 259
 260   warn "cyrus_insert: connecting to $cyrus_server\n";
 261   my $client = Cyrus::IMAP::Admin->new($cyrus_server);
 262
 263   warn "cyrus_insert: authentication as $cyrus_admin_user\n";
 264   $client->authenticate(
 265     -user      => $cyrus_admin_user,
 266     -mechanism => "login",
 267     -password  => $cyrus_admin_pass
 268   );
 269
 270   warn "cyrus_insert: creating user.$username\n";
 271   my $rc = $client->create("user.$username");
 272   my $error = $client->error;
 273   die "cyrus_insert: error creating user.$username: $error" if $error;
 274
 275   warn "cyrus_insert: setacl user.$username, $username => all\n";
 276   $rc = $client->setacl("user.$username", $username => 'all' );
 277   $error = $client->error;
 278   die $error if $error;
 279
 280   if ( $quota ) {
 281     warn "cyrus_insert: setquota user.$username, STORAGE => $quota\n";
 282     $rc = $client->setquota("user.$username", 'STORAGE' => $quota );
 283     $error = $client->error;
 284     die $error if $error;
 285   }
 286
 287   1;
 288 }
 289
 290 =item delete
 291
 292 Deletes this account from the database.  If there is an error, returns the
 293 error, otherwise returns false.
 294
 295 The corresponding FS::cust_svc record will be deleted as well.
 296
 297 If the configuration value (see L<FS::Conf>) shellmachine exists, the
 298 command(s) specified in the shellmachine-userdel configuration file are
 299 added to the job queue (see L<FS::queue> and L<freeside-queued>) to be executed
 300 on shellmachine via ssh.  This behavior can be surpressed by setting
 301 $FS::svc_acct::nossh_hack true.  If the shellmachine-userdel configuration
 302 file does not exist,
 303
 304   userdel $username
 305
 306 is the default.  If the shellmachine-userdel configuration file exists but
 307 is empty,
 308
 309   rm -rf $dir
 310
 311 is the default instead.  Otherwise the contents of the file are treated as a
 312 double-quoted perl string, with the following variables available:
 313 $username and $dir.
 314
 315 (TODOC: cyrus config file)
 316
 317 =cut
 318
 319 sub delete {
 320   my $self = shift;
 321
 322   return "Can't delete an account which has (svc_acct_sm) mail aliases!"
 323     if $self->uid && qsearch( 'svc_acct_sm', { 'domuid' => $self->uid } );
 324
 325   return "Can't delete an account which is a (svc_forward) source!"
 326     if qsearch( 'svc_forward', { 'srcsvc' => $self->svcnum } );
 327
 328   return "Can't delete an account which is a (svc_forward) destination!"
 329     if qsearch( 'svc_forward', { 'dstsvc' => $self->svcnum } );
 330
 331   return "Can't delete an account with (svc_www) web service!"
 332     if qsearch( 'svc_www', { 'usersvc' => $self->usersvc } );
 333
 334   # what about records in session ?
 335
 336   local $SIG{HUP} = 'IGNORE';
 337   local $SIG{INT} = 'IGNORE';
 338   local $SIG{QUIT} = 'IGNORE';
 339   local $SIG{TERM} = 'IGNORE';
 340   local $SIG{TSTP} = 'IGNORE';
 341   local $SIG{PIPE} = 'IGNORE';
 342
 343   my $oldAutoCommit = $FS::UID::AutoCommit;
 344   local $FS::UID::AutoCommit = 0;
 345   my $dbh = dbh;
 346
 347   foreach my $cust_main_invoice (
 348     qsearch( 'cust_main_invoice', { 'dest' => $self->svcnum } )
 349   ) {
 350     my %hash = $cust_main_invoice->hash;
 351     $hash{'dest'} = $self->email;
 352     my $new = new FS::cust_main_invoice \%hash;
 353     my $error = $new->replace($cust_main_invoice);
 354     if ( $error ) {
 355       $dbh->rollback if $oldAutoCommit;
 356       return $error;
 357     }
 358   }
 359
 360   foreach my $svc_domain (
 361     qsearch( 'svc_domain', { 'catchall' => $self->svcnum } )
 362   ) {
 363     my %hash = new FS::svc_domain->hash;
 364     $hash{'catchall'} = '';
 365     my $new = new FS::svc_domain \%hash;
 366     my $error = $new->replace($svc_domain);
 367     if ( $error ) {
 368       $dbh->rollback if $oldAutoCommit;
 369       return $error;
 370     }
 371   }
 372
 373   my $error = $self->SUPER::delete;
 374   if ( $error ) {
 375     $dbh->rollback if $oldAutoCommit;
 376     return $error;
 377   }
 378
 379   my( $username, $dir ) = (
 380     $self->username,
 381     $self->dir,
 382   );
 383   if ( $username && $shellmachine && ! $nossh_hack ) {
 384     my $queue = new FS::queue { 'job' => 'Net::SSH::ssh' };
 385     $error = $queue->insert("root\@$shellmachine", eval qq("$userdel") );
 386     if ( $error ) {
 387       $dbh->rollback if $oldAutoCommit;
 388       return "queueing job (transaction rolled back): $error";
 389     }
 390
 391   }
 392
 393   if ( $cyrus_server ) {
 394     my $queue = new FS::queue { 'job' => 'FS::svc_acct::cyrus_delete' };
 395     $error = $queue->insert($self->username);
 396     if ( $error ) {
 397       $dbh->rollback if $oldAutoCommit;
 398       return "queueing job (transaction rolled back): $error";
 399     }
 400   }
 401
 402   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 403   '';
 404 }
 405
 406 sub cyrus_delete {
 407   my $username = shift;
 408
 409   my $client = Cyrus::IMAP::Admin->new($cyrus_server);
 410   $client->authenticate(
 411     -user      => $cyrus_admin_user,
 412     -mechanism => "login",
 413     -password  => $cyrus_admin_pass
 414   );
 415
 416   my $rc = $client->setacl("user.$username", $cyrus_admin_user => 'all' );
 417   my $error = $client->error;
 418   die $error if $error;
 419
 420   $rc = $client->delete("user.$username");
 421   $error = $client->error;
 422   die $error if $error;
 423
 424   1;
 425 }
 426
 427 =item replace OLD_RECORD
 428
 429 Replaces OLD_RECORD with this one in the database.  If there is an error,
 430 returns the error, otherwise returns false.
 431
 432 If the configuration value (see L<FS::Conf>) shellmachine exists, and the
 433 dir field has changed, the command(s) specified in the shellmachine-usermod
 434 configuraiton file are added to the job queue (see L<FS::queue> and
 435 L<freeside-queued>) to be executed on shellmachine via ssh.  This behavior can
 436 be surpressed by setting $FS::svc-acct::nossh_hack true.  If the
 437 shellmachine-userdel configuration file does not exist or is empty,
 438
 439   [ -d $old_dir ] && mv $old_dir $new_dir || (
 440     chmod u+t $old_dir;
 441     mkdir $new_dir;
 442     cd $old_dir;
 443     find . -depth -print | cpio -pdm $new_dir;
 444     chmod u-t $new_dir;
 445     chown -R $uid.$gid $new_dir;
 446     rm -rf $old_dir
 447   )
 448
 449 is the default.  This behaviour can be surpressed by setting
 450 $FS::svc_acct::nossh_hack true.
 451
 452 =cut
 453
 454 sub replace {
 455   my ( $new, $old ) = ( shift, shift );
 456   my $error;
 457
 458   return "Username in use"
 459     if $old->username ne $new->username &&
 460       qsearchs( 'svc_acct', { 'username' => $new->username } );
 461
 462   return "Can't change uid!" if $old->uid != $new->uid;
 463
 464   return "can't change username using Cyrus"
 465     if $cyrus_server && $old->username ne $new->username;
 466
 467   #change homdir when we change username
 468   $new->setfield('dir', '') if $old->username ne $new->username;
 469
 470   local $SIG{HUP} = 'IGNORE';
 471   local $SIG{INT} = 'IGNORE';
 472   local $SIG{QUIT} = 'IGNORE';
 473   local $SIG{TERM} = 'IGNORE';
 474   local $SIG{TSTP} = 'IGNORE';
 475   local $SIG{PIPE} = 'IGNORE';
 476
 477   my $oldAutoCommit = $FS::UID::AutoCommit;
 478   local $FS::UID::AutoCommit = 0;
 479   my $dbh = dbh;
 480
 481   $error = $new->SUPER::replace($old);
 482   if ( $error ) {
 483     $dbh->rollback if $oldAutoCommit;
 484     return $error if $error;
 485   }
 486
 487   my ( $old_dir, $new_dir, $uid, $gid ) = (
 488     $old->getfield('dir'),
 489     $new->getfield('dir'),
 490     $new->getfield('uid'),
 491     $new->getfield('gid'),
 492   );
 493   if ( $old_dir && $new_dir && $old_dir ne $new_dir && ! $nossh_hack ) {
 494     my $queue = new FS::queue { 'job' => 'Net::SSH::ssh' };
 495     $error = $queue->insert("root\@$shellmachine", eval qq("$usermod") );
 496     if ( $error ) {
 497       $dbh->rollback if $oldAutoCommit;
 498       return "queueing job (transaction rolled back): $error";
 499     }
 500   }
 501
 502   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 503   ''; #no error
 504 }
 505
 506 =item suspend
 507
 508 Suspends this account by prefixing *SUSPENDED* to the password.  If there is an
 509 error, returns the error, otherwise returns false.
 510
 511 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 512
 513 =cut
 514
 515 sub suspend {
 516   my $self = shift;
 517   my %hash = $self->hash;
 518   unless ( $hash{_password} =~ /^\*SUSPENDED\* / ) {
 519     $hash{_password} = '*SUSPENDED* '.$hash{_password};
 520     my $new = new FS::svc_acct ( \%hash );
 521     $new->replace($self);
 522   } else {
 523     ''; #no error (already suspended)
 524   }
 525 }
 526
 527 =item unsuspend
 528
 529 Unsuspends this account by removing *SUSPENDED* from the password.  If there is
 530 an error, returns the error, otherwise returns false.
 531
 532 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
 533
 534 =cut
 535
 536 sub unsuspend {
 537   my $self = shift;
 538   my %hash = $self->hash;
 539   if ( $hash{_password} =~ /^\*SUSPENDED\* (.*)$/ ) {
 540     $hash{_password} = $1;
 541     my $new = new FS::svc_acct ( \%hash );
 542     $new->replace($self);
 543   } else {
 544     ''; #no error (already unsuspended)
 545   }
 546 }
 547
 548 =item cancel
 549
 550 Just returns false (no error) for now.
 551
 552 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
 553
 554 =item check
 555
 556 Checks all fields to make sure this is a valid service.  If there is an error,
 557 returns the error, otherwise returns false.  Called by the insert and replace
 558 methods.
 559
 560 Sets any fixed values; see L<FS::part_svc>.
 561
 562 =cut
 563
 564 sub check {
 565   my $self = shift;
 566
 567   my($recref) = $self->hashref;
 568
 569   my $x = $self->setfixed;
 570   return $x unless ref($x);
 571   my $part_svc = $x;
 572
 573   my $error = $self->ut_numbern('svcnum')
 574               || $self->ut_number('domsvc')
 575   ;
 576   return $error if $error;
 577
 578   my $ulen = $usernamemax || $self->dbdef_table->column('username')->length;
 579   $recref->{username} =~ /^([a-z0-9_\-\.]{$usernamemin,$ulen})$/
 580     or return "Illegal username";
 581   $recref->{username} = $1;
 582   if ( $username_letterfirst ) {
 583     $recref->{username} =~ /^[a-z]/ or return "Illegal username";
 584   } elsif ( $username_letter ) {
 585     $recref->{username} =~ /[a-z]/ or return "Illegal username";
 586   }
 587   if ( $username_noperiod ) {
 588     $recref->{username} =~ /\./ and return "Illegal username";
 589   }
 590
 591   $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum};
 592   $recref->{popnum} = $1;
 593   return "Unknown popnum" unless
 594     ! $recref->{popnum} ||
 595     qsearchs('svc_acct_pop',{'popnum'=> $recref->{popnum} } );
 596
 597   unless ( $part_svc->part_svc_column('uid')->columnflag eq 'F' ) {
 598
 599     $recref->{uid} =~ /^(\d*)$/ or return "Illegal uid";
 600     $recref->{uid} = $1 eq '' ? $self->unique('uid') : $1;
 601
 602     $recref->{gid} =~ /^(\d*)$/ or return "Illegal gid";
 603     $recref->{gid} = $1 eq '' ? $recref->{uid} : $1;
 604     #not all systems use gid=uid
 605     #you can set a fixed gid in part_svc
 606
 607     return "Only root can have uid 0"
 608       if $recref->{uid} == 0 && $recref->{username} ne 'root';
 609
 610     $error = $self->ut_textn('finger');
 611     return $error if $error;
 612
 613     $recref->{dir} =~ /^([\/\w\-]*)$/
 614       or return "Illegal directory";
 615     $recref->{dir} = $1 ||
 616       $dir_prefix . '/' . $recref->{username}
 617       #$dir_prefix . '/' . substr($recref->{username},0,1). '/' . $recref->{username}
 618     ;
 619
 620     unless ( $recref->{username} eq 'sync' ) {
 621       if ( grep $_ eq $recref->{shell}, @shells ) {
 622         $recref->{shell} = (grep $_ eq $recref->{shell}, @shells)[0];
 623       } else {
 624         return "Illegal shell \`". $self->shell. "\'; ".
 625                $conf->dir. "/shells contains: @shells";
 626       }
 627     } else {
 628       $recref->{shell} = '/bin/sync';
 629     }
 630
 631     $recref->{quota} =~ /^(\d*)$/ or return "Illegal quota (unimplemented)";
 632     $recref->{quota} = $1;
 633
 634   } else {
 635     $recref->{gid} ne '' ?
 636       return "Can't have gid without uid" : ( $recref->{gid}='' );
 637     $recref->{finger} ne '' ?
 638       return "Can't have finger-name without uid" : ( $recref->{finger}='' );
 639     $recref->{dir} ne '' ?
 640       return "Can't have directory without uid" : ( $recref->{dir}='' );
 641     $recref->{shell} ne '' ?
 642       return "Can't have shell without uid" : ( $recref->{shell}='' );
 643     $recref->{quota} ne '' ?
 644       return "Can't have quota without uid" : ( $recref->{quota}='' );
 645   }
 646
 647   unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) {
 648     unless ( $recref->{slipip} eq '0e0' ) {
 649       $recref->{slipip} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/
 650         or return "Illegal slipip". $self->slipip;
 651       $recref->{slipip} = $1;
 652     } else {
 653       $recref->{slipip} = '0e0';
 654     }
 655
 656   }
 657
 658   #arbitrary RADIUS stuff; allow ut_textn for now
 659   foreach ( grep /^radius_/, fields('svc_acct') ) {
 660     $self->ut_textn($_);
 661   }
 662
 663   #generate a password if it is blank
 664   $recref->{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) )
 665     unless ( $recref->{_password} );
 666
 667   #if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,16})$/ ) {
 668   if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{$passwordmin,8})$/ ) {
 669     $recref->{_password} = $1.$3;
 670     #uncomment this to encrypt password immediately upon entry, or run
 671     #bin/crypt_pw in cron to give new users a window during which their
 672     #password is available to techs, for faxing, etc.  (also be aware of
 673     #radius issues!)
 674     #$recref->{password} = $1.
 675     #  crypt($3,$saltset[int(rand(64))].$saltset[int(rand(64))]
 676     #;
 677   } elsif ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([\w\.\/\$]{13,34})$/ ) {
 678     $recref->{_password} = $1.$3;
 679   } elsif ( $recref->{_password} eq '*' ) {
 680     $recref->{_password} = '*';
 681   } elsif ( $recref->{_password} eq '!!' ) {
 682     $recref->{_password} = '!!';
 683   } else {
 684     return "Illegal password";
 685   }
 686
 687   ''; #no error
 688 }
 689
 690 =item radius
 691
 692 Depriciated, use radius_reply instead.
 693
 694 =cut
 695
 696 sub radius {
 697   carp "FS::svc_acct::radius depriciated, use radius_reply";
 698   $_[0]->radius_reply;
 699 }
 700
 701 =item radius_reply
 702
 703 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
 704 reply attributes of this record.
 705
 706 Note that this is now the preferred method for reading RADIUS attributes -
 707 accessing the columns directly is discouraged, as the column names are
 708 expected to change in the future.
 709
 710 =cut
 711
 712 sub radius_reply {
 713   my $self = shift;
 714   map {
 715     /^(radius_(.*))$/;
 716     my($column, $attrib) = ($1, $2);
 717     #$attrib =~ s/_/\-/g;
 718     ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
 719   } grep { /^radius_/ && $self->getfield($_) } fields( $self->table );
 720 }
 721
 722 =item radius_check
 723
 724 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
 725 check attributes of this record.
 726
 727 Accessing RADIUS attributes directly is not supported and will break in the
 728 future.
 729
 730 =cut
 731
 732 sub radius_check {
 733   my $self = shift;
 734   map {
 735     /^(rc_(.*))$/;
 736     my($column, $attrib) = ($1, $2);
 737     #$attrib =~ s/_/\-/g;
 738     ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
 739   } grep { /^rc_/ && $self->getfield($_) } fields( $self->table );
 740 }
 741
 742 =item domain
 743
 744 Returns the domain associated with this account.
 745
 746 =cut
 747
 748 sub domain {
 749   my $self = shift;
 750   if ( $self->domsvc ) {
 751     my $svc_domain = qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } )
 752       or die "no svc_domain.svcnum for svc_acct.domsvc ". $self->domsvc;
 753     $svc_domain->domain;
 754   } else {
 755     $mydomain or die "svc_acct.domsvc is null and no legacy domain config file";
 756   }
 757 }
 758
 759 =item email
 760
 761 Returns an email address associated with the account.
 762
 763 =cut
 764
 765 sub email {
 766   my $self = shift;
 767   $self->username. '@'. $self->domain;
 768 }
 769
 770 =back
 771
 772 =head1 VERSION
 773
 774 $Id: svc_acct.pm,v 1.37 2001-09-11 12:06:57 ivan Exp $
 775
 776 =head1 BUGS
 777
 778 The bits which ssh should fork before doing so (or maybe queue jobs for a
 779 daemon).
 780
 781 The $recref stuff in sub check should be cleaned up.
 782
 783 The suspend, unsuspend and cancel methods update the database, but not the
 784 current object.  This is probably a bug as it's unexpected and
 785 counterintuitive.
 786
 787 =head1 SEE ALSO
 788
 789 L<FS::svc_Common>, L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>,
 790 L<FS::part_svc>, L<FS::cust_pkg>, L<FS::queue>, L<freeside-queued>),
 791 L<Net::SSH>, L<ssh>, L<FS::svc_acct_pop>,
 792 schema.html from the base documentation.
 793
 794 =cut
 795
 796 1;
 797