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
11 use FS::Record qw( qsearch qsearchs fields dbh );
17 use FS::cust_main_invoice;
22 @ISA = qw( FS::svc_Common );
24 #ask FS::UID to run this stuff for us later
25 $FS::UID::callback{'FS::svc_acct'} = sub {
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';
38 $useradd = 'useradd -d $dir -m -s $shell -u $uid $username';
40 if ( $conf->exists('shellmachine-userdel') ) {
41 $userdel = join("\n", $conf->config('shellmachine-userdel') )
44 $userdel = 'userdel $username';
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; '.
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;"
63 $cyrus_admin_user = '';
64 $cyrus_admin_pass = '';
68 @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
69 @pw_set = ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '!', '.', ',' );
71 #not needed in 5.004 #srand($$|time);
75 FS::svc_acct - Object methods for svc_acct records
81 $record = new FS::svc_acct \%hash;
82 $record = new FS::svc_acct { 'column' => 'value' };
84 $error = $record->insert;
86 $error = $new_record->replace($old_record);
88 $error = $record->delete;
90 $error = $record->check;
92 $error = $record->suspend;
94 $error = $record->unsuspend;
96 $error = $record->cancel;
98 %hash = $record->radius;
100 %hash = $record->radius_reply;
102 %hash = $record->radius_check;
106 An FS::svc_acct object represents an account. FS::svc_acct inherits from
107 FS::svc_Common. The following fields are currently supported:
111 =item svcnum - primary key (assigned automatcially for new accounts)
115 =item _password - generated if blank
117 =item popnum - Point of presence (see L<FS::svc_acct_pop>)
125 =item dir - set automatically if blank (and uid is not)
129 =item quota - (unimplementd)
131 =item slipip - IP address
135 =item domsvc - svcnum from svc_domain
137 =item radius_I<Radius_Attribute> - I<Radius-Attribute>
139 =item domsvc - service number of svc_domain with which to associate
149 Creates a new account. To add the account to the database, see L<"insert">.
153 sub table { 'svc_acct'; }
157 Adds this account to the database. If there is an error, returns the error,
158 otherwise returns false.
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.
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,
170 useradd -d $dir -m -s $shell -u $uid $username
172 is the default. If the shellmachine-useradd configuration file exists but
175 cp -pr /etc/skel $dir; chown -R $uid.$gid $dir
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.
181 (TODOC: cyrus config file, L<FS::queue> and L<freeside-queued>)
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';
196 my $oldAutoCommit = $FS::UID::AutoCommit;
197 local $FS::UID::AutoCommit = 0;
202 $error = $self->check;
203 return $error if $error;
205 return "Username ". $self->username. " in use"
206 if qsearchs( 'svc_acct', { 'username' => $self->username,
207 'domsvc' => $self->domsvc,
210 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
211 return "Unknown svcpart" unless $part_svc;
213 if $part_svc->part_svc_column('uid')->columnflag ne 'F'
214 && qsearchs( 'svc_acct', { 'uid' => $self->uid } )
215 && $self->username !~ /^(hyla)?fax$/
218 $error = $self->SUPER::insert;
220 $dbh->rollback if $oldAutoCommit;
224 my( $username, $uid, $gid, $dir, $shell ) = (
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") );
235 $dbh->rollback if $oldAutoCommit;
236 return "queueing job (transaction rolled back): $error";
240 if ( $cyrus_server ) {
241 my $queue = new FS::queue { 'job' => 'FS::svc_acct::cyrus_insert' };
242 $error = $queue->insert($self->username, $self->quota);
244 $dbh->rollback if $oldAutoCommit;
245 return "queueing job (transaction rolled back): $error";
249 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
254 my( $username, $quota ) =
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
263 my $rc = $client->create("user.$username");
264 my $error = $client->error;
265 die $error if $error;
267 $rc = $client->setacl("user.$username", $username => 'all' );
268 $error = $client->error;
269 die $error if $error;
272 $rc = $client->setquota("user.$username", 'STORAGE' => $quota );
273 $error = $client->error;
274 die $error if $error;
282 Deletes this account from the database. If there is an error, returns the
283 error, otherwise returns false.
285 The corresponding FS::cust_svc record will be deleted as well.
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
296 is the default. If the shellmachine-userdel configuration file exists but
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:
305 (TODOC: cyrus config file)
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 } );
315 return "Can't delete an account which is a (svc_forward) source!"
316 if qsearch( 'svc_forward', { 'srcsvc' => $self->svcnum } );
318 return "Can't delete an account which is a (svc_forward) destination!"
319 if qsearch( 'svc_forward', { 'dstsvc' => $self->svcnum } );
321 return "Can't delete an account with (svc_www) web service!"
322 if qsearch( 'svc_www', { 'usersvc' => $self->usersvc } );
324 # what about records in session ?
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';
333 my $oldAutoCommit = $FS::UID::AutoCommit;
334 local $FS::UID::AutoCommit = 0;
337 foreach my $cust_main_invoice (
338 qsearch( 'cust_main_invoice', { 'dest' => $self->svcnum } )
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);
345 $dbh->rollback if $oldAutoCommit;
350 foreach my $svc_domain (
351 qsearch( 'svc_domain', { 'catchall' => $self->svcnum } )
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);
358 $dbh->rollback if $oldAutoCommit;
363 my $error = $self->SUPER::delete;
365 $dbh->rollback if $oldAutoCommit;
369 my( $username, $dir ) = (
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") );
377 $dbh->rollback if $oldAutoCommit;
378 return "queueing job (transaction rolled back): $error";
383 if ( $cyrus_server ) {
384 my $queue = new FS::queue { 'job' => 'FS::svc_acct::cyrus_delete' };
385 $error = $queue->insert($self->username);
387 $dbh->rollback if $oldAutoCommit;
388 return "queueing job (transaction rolled back): $error";
392 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
397 my( $username ) = shift;
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
406 my $rc = $client->setacl("user.$username", $cyrus_admin_user => 'all' );
407 my $error = $client->error;
408 die $error if $error;
410 $rc = $client->delete("user.$username");
411 $error = $client->error;
412 die $error if $error;
417 =item replace OLD_RECORD
419 Replaces OLD_RECORD with this one in the database. If there is an error,
420 returns the error, otherwise returns false.
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,
429 [ -d $old_dir ] && mv $old_dir $new_dir || (
433 find . -depth -print | cpio -pdm $new_dir;
435 chown -R $uid.$gid $new_dir;
439 is the default. This behaviour can be surpressed by setting
440 $FS::svc_acct::nossh_hack true.
445 my ( $new, $old ) = ( shift, shift );
448 return "Username in use"
449 if $old->username ne $new->username &&
450 qsearchs( 'svc_acct', { 'username' => $new->username } );
452 return "Can't change uid!" if $old->uid != $new->uid;
454 return "can't change username using Cyrus"
455 if $cyrus_server && $old->username ne $new->username;
457 #change homdir when we change username
458 $new->setfield('dir', '') if $old->username ne $new->username;
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';
467 my $oldAutoCommit = $FS::UID::AutoCommit;
468 local $FS::UID::AutoCommit = 0;
471 $error = $new->SUPER::replace($old);
473 $dbh->rollback if $oldAutoCommit;
474 return $error if $error;
477 my ( $old_dir, $new_dir, $uid, $gid ) = (
478 $old->getfield('dir'),
479 $new->getfield('dir'),
480 $new->getfield('uid'),
481 $new->getfield('gid'),
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") );
487 $dbh->rollback if $oldAutoCommit;
488 return "queueing job (transaction rolled back): $error";
492 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
498 Suspends this account by prefixing *SUSPENDED* to the password. If there is an
499 error, returns the error, otherwise returns false.
501 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
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);
513 ''; #no error (already suspended)
519 Unsuspends this account by removing *SUSPENDED* from the password. If there is
520 an error, returns the error, otherwise returns false.
522 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
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);
534 ''; #no error (already unsuspended)
540 Just returns false (no error) for now.
542 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
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
550 Sets any fixed values; see L<FS::part_svc>.
557 my($recref) = $self->hashref;
559 my $x = $self->setfixed;
560 return $x unless ref($x);
563 my $error = $self->ut_numbern('svcnum')
564 || $self->ut_number('domsvc')
566 return $error if $error;
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";
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} } );
584 unless ( $part_svc->part_svc_column('uid')->columnflag eq 'F' ) {
586 $recref->{uid} =~ /^(\d*)$/ or return "Illegal uid";
587 $recref->{uid} = $1 eq '' ? $self->unique('uid') : $1;
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
594 return "Only root can have uid 0"
595 if $recref->{uid} == 0 && $recref->{username} ne 'root';
597 $error = $self->ut_textn('finger');
598 return $error if $error;
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}
607 unless ( $recref->{username} eq 'sync' ) {
608 if ( grep $_ eq $recref->{shell}, @shells ) {
609 $recref->{shell} = (grep $_ eq $recref->{shell}, @shells)[0];
611 return "Illegal shell \`". $self->shell. "\'; ".
612 $conf->dir. "/shells contains: @shells";
615 $recref->{shell} = '/bin/sync';
618 $recref->{quota} =~ /^(\d*)$/ or return "Illegal quota (unimplemented)";
619 $recref->{quota} = $1;
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}='' );
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;
640 $recref->{slipip} = '0e0';
645 #arbitrary RADIUS stuff; allow ut_textn for now
646 foreach ( grep /^radius_/, fields('svc_acct') ) {
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} );
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
661 #$recref->{password} = $1.
662 # crypt($3,$saltset[int(rand(64))].$saltset[int(rand(64))]
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} = '!!';
671 return "Illegal password";
679 Depriciated, use radius_reply instead.
684 carp "FS::svc_acct::radius depriciated, use radius_reply";
690 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
691 reply attributes of this record.
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.
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 );
711 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
712 check attributes of this record.
714 Accessing RADIUS attributes directly is not supported and will break in the
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 );
731 Returns the domain associated with this account.
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;
742 $mydomain or die "svc_acct.domsvc is null and no legacy domain config file";
748 Returns an email address associated with the account.
754 $self->username. '@'. $self->domain;
761 $Id: svc_acct.pm,v 1.34 2001-09-11 03:15:58 ivan Exp $
765 The bits which ssh should fork before doing so (or maybe queue jobs for a
768 The $recref stuff in sub check should be cleaned up.
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
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.