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