4 use vars qw(@ISA @EXPORT_OK $nossh_hack $conf $dir_prefix @shells
5 $shellmachine @saltset @pw_set);
8 use FS::Record qw(fields qsearchs);
12 @ISA = qw(FS::Record Exporter);
13 @EXPORT_OK = qw(fields);
16 $dir_prefix = $conf->config('home');
17 @shells = $conf->config('shells');
18 $shellmachine = $conf->config('shellmachine');
20 @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
21 @pw_set = ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '!', '.', ',' );
23 #not needed in 5.004 #srand($$|time);
27 FS::svc_acct - Object methods for svc_acct records
33 $record = create FS::svc_acct \%hash;
34 $record = create FS::svc_acct { 'column' => 'value' };
36 $error = $record->insert;
38 $error = $new_record->replace($old_record);
40 $error = $record->delete;
42 $error = $record->check;
44 $error = $record->suspend;
46 $error = $record->unsuspend;
48 $error = $record->cancel;
52 An FS::svc_acct object represents an account. FS::svc_acct inherits from
53 FS::Record. The following fields are currently supported:
57 =item svcnum - primary key (assigned automatcially for new accounts)
61 =item _password - generated if blank
63 =item popnum - Point of presence (see L<FS::svc_acct_pop>)
71 =item dir - set automatically if blank (and uid is not)
75 =item quota - (unimplementd)
77 =item slipip - IP address
79 =item radius_I<Radius_Attribute> - I<Radius-Attribute>
89 Creates a new account. To add the account to the database, see L<"insert">.
94 my($proto,$hashref)=@_;
96 #now in FS::Record::new
98 #foreach $field (fields('svc_acct')) {
99 # $hashref->{$field}='' unless defined $hashref->{$field};
102 $proto->new('svc_acct',$hashref);
108 Adds this account to the database. If there is an error, returns the error,
109 otherwise returns false.
111 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
112 defined. An FS::cust_svc record will be created and inserted.
114 If the configuration value (see L<FS::Conf>) shellmachine exists, and the
115 username, uid, and dir fields are defined, the command
117 useradd -d $dir -m -s $shell -u $uid $username
119 is executed on shellmachine via ssh. This behaviour can be surpressed by
120 setting $FS::svc_acct::nossh_hack true.
128 local $SIG{HUP} = 'IGNORE';
129 local $SIG{INT} = 'IGNORE';
130 local $SIG{QUIT} = 'IGNORE';
131 local $SIG{TERM} = 'IGNORE';
132 local $SIG{TSTP} = 'IGNORE';
135 return $error if $error;
137 return "Username ". $self->username. " in use"
138 if qsearchs('svc_acct',{'username'=> $self->username } );
140 my($part_svc) = qsearchs('part_svc',{ 'svcpart' => $self->svcpart });
141 return "Unkonwn svcpart" unless $part_svc;
143 if $part_svc->svc_acct__uid_flag ne 'F'
144 && qsearchs('svc_acct',{'uid'=> $self->uid } )
145 && $self->username !~ /^(hyla)?fax$/
148 my($svcnum)=$self->svcnum;
151 $cust_svc=create FS::cust_svc ( {
153 'pkgnum' => $self->pkgnum,
154 'svcpart' => $self->svcpart,
156 my($error) = $cust_svc->insert;
157 return $error if $error;
158 $svcnum = $self->svcnum($cust_svc->svcnum);
163 #$cust_svc->del if $cust_svc;
164 $cust_svc->delete if $cust_svc;
168 my($username,$uid,$dir,$shell) = (
180 ssh("root\@$shellmachine",
181 "useradd -d $dir -m -s $shell -u $uid $username"
184 #ssh("root\@$shellmachine","/bin/mkdir $dir; /bin/chmod 711 $dir; ".
185 # "/bin/cp -p /etc/skel/.* $dir 2>/dev/null; ".
186 # "/bin/cp -pR /etc/skel/Maildir $dir 2>/dev/null; ".
187 # "/bin/chown -R $uid $dir") unless $nossh_hack;
195 Deletes this account from the database. If there is an error, returns the
196 error, otherwise returns false.
198 The corresponding FS::cust_svc record will be deleted as well.
200 If the configuration value (see L<FS::Conf>) shellmachine exists, the command:
204 is executed on shellmachine via ssh. This behaviour can be surpressed by
205 setting $FS::svc_acct::nossh_hack true.
213 local $SIG{HUP} = 'IGNORE';
214 local $SIG{INT} = 'IGNORE';
215 local $SIG{QUIT} = 'IGNORE';
216 local $SIG{TERM} = 'IGNORE';
217 local $SIG{TSTP} = 'IGNORE';
219 my($svcnum)=$self->getfield('svcnum');
222 return $error if $error;
224 my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
225 $error = $cust_svc->del;
226 return $error if $error;
228 my($username) = $self->getfield('username');
229 if ( $username && $shellmachine && ! $nossh_hack ) {
230 ssh("root\@$shellmachine","userdel $username");
236 =item replace OLD_RECORD
238 Replaces OLD_RECORD with this one in the database. If there is an error,
239 returns the error, otherwise returns false.
241 If the configuration value (see L<FS::Conf>) shellmachine exists, and the
242 dir field has changed, the command:
249 find . -depth -print | cpio -pdm $new_dir;
251 chown -R $uid.$gid $new_dir;
255 is executed on shellmachine via ssh. This behaviour can be surpressed by
256 setting $FS::svc_acct::nossh_hack true.
264 return "(Old) Not a svc_acct record!" unless $old->table eq "svc_acct";
265 return "Can't change svcnum!"
266 unless $old->getfield('svcnum') eq $new->getfield('svcnum');
268 return "Username in use"
269 if $old->getfield('username') ne $new->getfield('username') &&
270 qsearchs('svc_acct',{'username'=> $new->getfield('username') } );
272 return "Can't change uid!"
273 if $old->getfield('uid') ne $new->getfield('uid');
275 #change homdir when we change username
276 if ( $old->getfield('username') ne $new->getfield('username') ) {
277 $new->setfield('dir','');
281 return $error if $error;
283 local $SIG{HUP} = 'IGNORE';
284 local $SIG{INT} = 'IGNORE';
285 local $SIG{QUIT} = 'IGNORE';
286 local $SIG{TERM} = 'IGNORE';
287 local $SIG{TSTP} = 'IGNORE';
289 $error = $new->rep($old);
290 return $error if $error;
292 my($old_dir,$new_dir)=( $old->getfield('dir'),$new->getfield('dir') );
293 my($uid,$gid)=( $new->getfield('uid'), $new->getfield('gid') );
296 && $old_dir ne $new_dir
299 ssh("root\@$shellmachine","[ -d $old_dir ] && ".
300 "( chmod u+t $old_dir; ". #turn off qmail delivery
301 "umask 022; mkdir $new_dir; cd $old_dir; ".
302 "find . -depth -print | cpio -pdm $new_dir; ".
303 "chmod u-t $new_dir; chown -R $uid.$gid $new_dir; ".
314 Suspends this account by prefixing *SUSPENDED* to the password. If there is an
315 error, returns the error, otherwise returns false.
317 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
323 my(%hash) = $old->hash;
324 unless ( $hash{_password} =~ /^\*SUSPENDED\* / ) {
325 $hash{_password} = '*SUSPENDED* '.$hash{_password};
326 my($new) = create FS::svc_acct ( \%hash );
327 # $new->replace($old);
328 $new->rep($old); #to avoid password checking :)
330 ''; #no error (already suspended)
337 Unsuspends this account by removing *SUSPENDED* from the password. If there is
338 an error, returns the error, otherwise returns false.
340 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
346 my(%hash) = $old->hash;
347 if ( $hash{_password} =~ /^\*SUSPENDED\* (.*)$/ ) {
348 $hash{_password} = $1;
349 my($new) = create FS::svc_acct ( \%hash );
350 # $new->replace($old);
351 $new->rep($old); #to avoid password checking :)
353 ''; #no error (already unsuspended)
359 Just returns false (no error) for now.
361 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
365 # Usage: $error = $record -> cancel;
367 ''; #stub (no error) - taken care of in delete
372 Checks all fields to make sure this is a valid service. If there is an error,
373 returns the error, otherwise returns false. Called by the insert and replace
376 Sets any fixed values; see L<FS::part_svc>.
382 return "Not a svc_acct record!" unless $self->table eq "svc_acct";
383 my($recref) = $self->hashref;
385 $recref->{svcnum} =~ /^(\d*)$/ or return "Illegal svcnum";
386 $recref->{svcnum} = $1;
390 my($svcnum)=$self->getfield('svcnum');
392 my($cust_svc)=qsearchs('cust_svc',{'svcnum'=>$svcnum});
393 return "Unknown svcnum" unless $cust_svc;
394 $svcpart=$cust_svc->svcpart;
396 $svcpart=$self->getfield('svcpart');
398 my($part_svc)=qsearchs('part_svc',{'svcpart'=>$svcpart});
399 return "Unkonwn svcpart" unless $part_svc;
401 #set fixed fields from part_svc
403 foreach $field ( fields('svc_acct') ) {
404 if ( $part_svc->getfield('svc_acct__'. $field. '_flag') eq 'F' ) {
405 $self->setfield($field,$part_svc->getfield('svc_acct__'. $field) );
409 my($ulen)=$self->dbdef_table->column('username')->length;
410 $recref->{username} =~ /^([a-z0-9_\-]{2,$ulen})$/
411 or return "Illegal username";
412 $recref->{username} = $1;
413 $recref->{username} =~ /[a-z]/ or return "Illegal username";
415 $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum";
416 $recref->{popnum} = $1;
417 return "Unkonwn popnum" unless
418 ! $recref->{popnum} ||
419 qsearchs('svc_acct_pop',{'popnum'=> $recref->{popnum} } );
421 unless ( $part_svc->getfield('svc_acct__uid_flag') eq 'F' ) {
423 $recref->{uid} =~ /^(\d*)$/ or return "Illegal uid";
424 $recref->{uid} = $1 eq '' ? $self->unique('uid') : $1;
426 $recref->{gid} =~ /^(\d*)$/ or return "Illegal gid";
427 $recref->{gid} = $1 eq '' ? $recref->{uid} : $1;
428 #not all systems use gid=uid
429 #you can set a fixed gid in part_svc
431 return "Only root can have uid 0"
432 if $recref->{uid} == 0 && $recref->{username} ne 'root';
435 return $error if $error=$self->ut_textn('finger');
437 $recref->{dir} =~ /^([\/\w\-]*)$/
438 or return "Illegal directory";
439 $recref->{dir} = $1 ||
440 $dir_prefix . '/' . $recref->{username}
441 #$dir_prefix . '/' . substr($recref->{username},0,1). '/' . $recref->{username}
444 unless ( $recref->{username} eq 'sync' ) {
446 if ( $shell = (grep $_ eq $recref->{shell}, @shells)[0] ) {
447 $recref->{shell} = $shell;
449 return "Illegal shell ". $self->shell;
452 $recref->{shell} = '/bin/sync';
455 $recref->{quota} =~ /^(\d*)$/ or return "Illegal quota (unimplemented)";
456 $recref->{quota} = $1;
459 $recref->{gid} ne '' ?
460 return "Can't have gid without uid" : ( $recref->{gid}='' );
461 $recref->{finger} ne '' ?
462 return "Can't have finger-name without uid" : ( $recref->{finger}='' );
463 $recref->{dir} ne '' ?
464 return "Can't have directory without uid" : ( $recref->{dir}='' );
465 $recref->{shell} ne '' ?
466 return "Can't have shell without uid" : ( $recref->{shell}='' );
467 $recref->{quota} ne '' ?
468 return "Can't have quota without uid" : ( $recref->{quota}='' );
471 unless ( $part_svc->getfield('svc_acct__slipip_flag') eq 'F' ) {
472 unless ( $recref->{slipip} eq '0e0' ) {
473 $recref->{slipip} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/
474 or return "Illegal slipip". $self->slipip;
475 $recref->{slipip} = $1;
477 $recref->{slipip} = '0e0';
482 #arbitrary RADIUS stuff; allow ut_textn for now
483 foreach ( grep /^radius_/, fields('svc_acct') ) {
487 #generate a password if it is blank
488 $recref->{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) )
489 unless ( $recref->{_password} );
491 #if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,16})$/ ) {
492 if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,8})$/ ) {
493 $recref->{_password} = $1.$3;
494 #uncomment this to encrypt password immediately upon entry, or run
495 #bin/crypt_pw in cron to give new users a window during which their
496 #password is available to techs, for faxing, etc. (also be aware of
498 #$recref->{password} = $1.
499 # crypt($3,$saltset[int(rand(64))].$saltset[int(rand(64))]
501 } elsif ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([\w\.\/]{13,24})$/ ) {
502 $recref->{_password} = $1.$3;
503 } elsif ( $recref->{_password} eq '*' ) {
504 $recref->{_password} = '*';
506 return "Illegal password";
516 It doesn't properly override FS::Record yet.
518 The remote commands should be configurable.
520 The create method should set defaults from part_svc (like the check method
525 L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>,
526 L<FS::SSH>, L<ssh>, L<FS::svc_acct_pop>, schema.html from the base
531 ivan@voicenet.com 97-jul-16 - 21
533 rewrite (among other things, now know about part_svc) ivan@sisd.com 98-mar-8
535 Changed 'password' to '_password' because Pg6.3 reserves the password word
536 bmccane@maxbaud.net 98-apr-3
538 username length and shell no longer hardcoded ivan@sisd.com 98-jun-28
540 eww but needed: ignore uid duplicates for 'fax' and 'hylafax'
541 ivan@sisd.com 98-jun-29
543 $nossh_hack ivan@sisd.com 98-jul-13
545 protections against UID/GID of 0 for incorrectly-setup RDBMSs (also
546 in bin/svc_acct.export) ivan@sisd.com 98-jul-13
548 arbitrary radius attributes ivan@sisd.com 98-aug-13
550 /var/spool/freeside/conf/shellmachine ivan@sisd.com 98-aug-13
552 pod and FS::conf ivan@sisd.com 98-sep-22