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