FS/FS/svc_acct.pm

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