9d2db0eff349ecf86a2181060a1adea7fc9a52fa
[freeside.git] / 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
6              $shellmachine $useradd $usermod $userdel 
7              @saltset @pw_set);
8 use Carp;
9 use FS::Conf;
10 use FS::Record qw( qsearchs fields );
11 use FS::svc_Common;
12 use FS::SSH qw(ssh);
13 use FS::part_svc;
14 use FS::svc_acct_pop;
15 use FS::svc_acct_sm;
16
17 @ISA = qw( FS::svc_Common );
18
19 #ask FS::UID to run this stuff for us later
20 $FS::UID::callback{'FS::svc_acct'} = sub { 
21   $conf = new FS::Conf;
22   $dir_prefix = $conf->config('home');
23   @shells = $conf->config('shells');
24   $shellmachine = $conf->config('shellmachine');
25   $usernamemin = $conf->config('usernamemin') || 2;
26   $usernamemax = $conf->config('usernamemax');
27   $passwordmin = $conf->config('passwordmin') || 6;
28   if ( $shellmachine ) {
29     if ( $conf->exists('shellmachine-useradd') ) {
30       $useradd = join("\n", $conf->config('shellmachine-useradd') )
31                  || 'cp -pr /etc/skel $dir; chown -R $uid.$gid $dir';
32     } else {
33       $useradd = 'useradd -d $dir -m -s $shell -u $uid $username';
34     }
35     if ( $conf->exists('shellmachine-userdel') ) {
36       $userdel = join("\n", $conf->config('shellmachine-userdel') )
37                  || 'rm -rf $dir';
38     } else {
39       $userdel = 'userdel $username';
40     }
41     $usermod = join("\n", $conf->config('shellmachine-usermod') )
42                || '[ -d $old_dir ] && mv $old_dir $new_dir || ( '.
43                     'chmod u+t $old_dir; mkdir $new_dir; cd $old_dir; '.
44                     'find . -depth -print | cpio -pdm $new_dir; '.
45                     'chmod u-t $new_dir; chown -R $uid.$gid $new_dir; '.
46                     'rm -rf $old_dir'.
47                   ')';
48   }
49 };
50
51 @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
52 @pw_set = ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '!', '.', ',' );
53
54 #not needed in 5.004 #srand($$|time);
55
56 =head1 NAME
57
58 FS::svc_acct - Object methods for svc_acct records
59
60 =head1 SYNOPSIS
61
62   use FS::svc_acct;
63
64   $record = new FS::svc_acct \%hash;
65   $record = new FS::svc_acct { 'column' => 'value' };
66
67   $error = $record->insert;
68
69   $error = $new_record->replace($old_record);
70
71   $error = $record->delete;
72
73   $error = $record->check;
74
75   $error = $record->suspend;
76
77   $error = $record->unsuspend;
78
79   $error = $record->cancel;
80
81   %hash = $record->radius;
82
83 =head1 DESCRIPTION
84
85 An FS::svc_acct object represents an account.  FS::svc_acct inherits from
86 FS::svc_Common.  The following fields are currently supported:
87
88 =over 4
89
90 =item svcnum - primary key (assigned automatcially for new accounts)
91
92 =item username
93
94 =item _password - generated if blank
95
96 =item popnum - Point of presence (see L<FS::svc_acct_pop>)
97
98 =item uid
99
100 =item gid
101
102 =item finger - GECOS
103
104 =item dir - set automatically if blank (and uid is not)
105
106 =item shell
107
108 =item quota - (unimplementd)
109
110 =item slipip - IP address
111
112 =item radius_I<Radius_Attribute> - I<Radius-Attribute>
113
114 =back
115
116 =head1 METHODS
117
118 =over 4
119
120 =item new HASHREF
121
122 Creates a new account.  To add the account to the database, see L<"insert">.
123
124 =cut
125
126 sub table { 'svc_acct'; }
127
128 =item insert
129
130 Adds this account to the database.  If there is an error, returns the error,
131 otherwise returns false.
132
133 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be 
134 defined.  An FS::cust_svc record will be created and inserted.
135
136 If the configuration value (see L<FS::Conf>) shellmachine exists, and the 
137 username, uid, and dir fields are defined, the command(s) specified in
138 the shellmachine-useradd configuration are exectued on shellmachine via ssh.
139 This behaviour can be surpressed by setting $FS::svc_acct::nossh_hack true.
140 If the shellmachine-useradd configuration file does not exist,
141
142   useradd -d $dir -m -s $shell -u $uid $username
143
144 is the default.  If the shellmachine-useradd configuration file exists but
145 it empty,
146
147   cp -pr /etc/skel $dir; chown -R $uid.$gid $dir
148
149 is the default instead.  Otherwise the contents of the file are treated as
150 a double-quoted perl string, with the following variables available:
151 $username, $uid, $gid, $dir, and $shell.
152
153 =cut
154
155 sub insert {
156   my $self = shift;
157   my $error;
158
159   local $SIG{HUP} = 'IGNORE';
160   local $SIG{INT} = 'IGNORE';
161   local $SIG{QUIT} = 'IGNORE';
162   local $SIG{TERM} = 'IGNORE';
163   local $SIG{TSTP} = 'IGNORE';
164   local $SIG{PIPE} = 'IGNORE';
165
166   $error = $self->check;
167   return $error if $error;
168
169   return "Username ". $self->username. " in use"
170     if qsearchs( 'svc_acct', { 'username' => $self->username } );
171
172   my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $self->svcpart } );
173   return "Unknown svcpart" unless $part_svc;
174   return "uid in use"
175     if $part_svc->svc_acct__uid_flag ne 'F'
176       && qsearchs( 'svc_acct', { 'uid' => $self->uid } )
177       && $self->username !~ /^(hyla)?fax$/
178     ;
179
180   $error = $self->SUPER::insert;
181   return $error if $error;
182
183   my( $username, $uid, $gid, $dir, $shell ) = (
184     $self->username,
185     $self->uid,
186     $self->gid,
187     $self->dir,
188     $self->shell,
189   );
190   if ( $username && $uid && $dir && $shellmachine && ! $nossh_hack ) {
191     ssh("root\@$shellmachine", eval qq("$useradd") );
192   }
193
194   ''; #no error
195 }
196
197 =item delete
198
199 Deletes this account from the database.  If there is an error, returns the
200 error, otherwise returns false.
201
202 The corresponding FS::cust_svc record will be deleted as well.
203
204 If the configuration value (see L<FS::Conf>) shellmachine exists, the
205 command(s) specified in the shellmachine-userdel configuration file are
206 executed on shellmachine via ssh.  This behavior can be surpressed by setting
207 $FS::svc_acct::nossh_hack true.  If the shellmachine-userdel configuration
208 file does not exist,
209
210   userdel $username
211
212 is the default.  If the shellmachine-userdel configuration file exists but
213 is empty,
214
215   rm -rf $dir
216
217 is the default instead.  Otherwise the contents of the file are treated as a
218 double-quoted perl string, with the following variables available:
219 $username and $dir.
220
221 =cut
222
223 sub delete {
224   my $self = shift;
225   my $error;
226
227   return "Can't delete an account which has mail aliases pointed to it!"
228     if $self->uid && qsearch( 'svc_acct_sm', { 'domuid' => $self->uid } );
229
230   local $SIG{HUP} = 'IGNORE';
231   local $SIG{INT} = 'IGNORE';
232   local $SIG{QUIT} = 'IGNORE';
233   local $SIG{TERM} = 'IGNORE';
234   local $SIG{TSTP} = 'IGNORE';
235   local $SIG{PIPE} = 'IGNORE';
236
237   $error = $self->SUPER::delete;
238   return $error if $error;
239
240   my( $username, $dir ) = (
241     $self->username,
242     $self->dir,
243   );
244   if ( $username && $shellmachine && ! $nossh_hack ) {
245     ssh("root\@$shellmachine", eval qq("$userdel") );
246   }
247
248   '';
249 }
250
251 =item replace OLD_RECORD
252
253 Replaces OLD_RECORD with this one in the database.  If there is an error,
254 returns the error, otherwise returns false.
255
256 If the configuration value (see L<FS::Conf>) shellmachine exists, and the 
257 dir field has changed, the command(s) specified in the shellmachine-usermod
258 configuraiton file are executed on shellmachine via ssh.  This behavior can
259 be surpressed by setting $FS::svc-acct::nossh_hack true.  If the
260 shellmachine-userdel configuration file does not exist or is empty, :
261
262   [ -d $old_dir ] && mv $old_dir $new_dir || (
263     chmod u+t $old_dir;
264     mkdir $new_dir;
265     cd $old_dir;
266     find . -depth -print | cpio -pdm $new_dir;
267     chmod u-t $new_dir;
268     chown -R $uid.$gid $new_dir;
269     rm -rf $old_dir
270   )
271
272 is executed on shellmachine via ssh.  This behaviour can be surpressed by
273 setting $FS::svc_acct::nossh_hack true.
274
275 =cut
276
277 sub replace {
278   my ( $new, $old ) = ( shift, shift );
279   my $error;
280
281   return "Username in use"
282     if $old->username ne $new->username &&
283       qsearchs( 'svc_acct', { 'username' => $new->username } );
284
285   return "Can't change uid!" if $old->uid != $new->uid;
286
287   #change homdir when we change username
288   $new->setfield('dir', '') if $old->username ne $new->username;
289
290   local $SIG{HUP} = 'IGNORE';
291   local $SIG{INT} = 'IGNORE';
292   local $SIG{QUIT} = 'IGNORE';
293   local $SIG{TERM} = 'IGNORE';
294   local $SIG{TSTP} = 'IGNORE';
295   local $SIG{PIPE} = 'IGNORE';
296
297   $error = $new->SUPER::replace($old);
298   return $error if $error;
299
300   my ( $old_dir, $new_dir, $uid, $gid ) = (
301     $old->getfield('dir'),
302     $new->getfield('dir'),
303     $new->getfield('uid'),
304     $new->getfield('gid'),
305   );
306   if ( $old_dir && $new_dir && $old_dir ne $new_dir && ! $nossh_hack ) {
307     ssh("root\@$shellmachine", eval qq("$usermod") );
308   }
309
310   ''; #no error
311 }
312
313 =item suspend
314
315 Suspends this account by prefixing *SUSPENDED* to the password.  If there is an
316 error, returns the error, otherwise returns false.
317
318 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
319
320 =cut
321
322 sub suspend {
323   my $self = shift;
324   my %hash = $self->hash;
325   unless ( $hash{_password} =~ /^\*SUSPENDED\* / ) {
326     $hash{_password} = '*SUSPENDED* '.$hash{_password};
327     my $new = new FS::svc_acct ( \%hash );
328     $new->replace($self);
329   } else {
330     ''; #no error (already suspended)
331   }
332 }
333
334 =item unsuspend
335
336 Unsuspends this account by removing *SUSPENDED* from the password.  If there is
337 an error, returns the error, otherwise returns false.
338
339 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
340
341 =cut
342
343 sub unsuspend {
344   my $self = shift;
345   my %hash = $self->hash;
346   if ( $hash{_password} =~ /^\*SUSPENDED\* (.*)$/ ) {
347     $hash{_password} = $1;
348     my $new = new FS::svc_acct ( \%hash );
349     $new->replace($self);
350   } else {
351     ''; #no error (already unsuspended)
352   }
353 }
354
355 =item cancel
356
357 Just returns false (no error) for now.
358
359 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
360
361 =item check
362
363 Checks all fields to make sure this is a valid service.  If there is an error,
364 returns the error, otherwise returns false.  Called by the insert and replace
365 methods.
366
367 Sets any fixed values; see L<FS::part_svc>.
368
369 =cut
370
371 sub check {
372   my $self = shift;
373
374   my($recref) = $self->hashref;
375
376   my $x = $self->setfixed;
377   return $x unless ref($x);
378   my $part_svc = $x;
379
380   my $ulen = $usernamemax || $self->dbdef_table->column('username')->length;
381   $recref->{username} =~ /^([a-z0-9_\-\.]{$usernamemin,$ulen})$/
382     or return "Illegal username";
383   $recref->{username} = $1;
384   $recref->{username} =~ /[a-z]/ or return "Illegal username";
385
386   $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum};
387   $recref->{popnum} = $1;
388   return "Unknown popnum" unless
389     ! $recref->{popnum} ||
390     qsearchs('svc_acct_pop',{'popnum'=> $recref->{popnum} } );
391
392   unless ( $part_svc->getfield('svc_acct__uid_flag') eq 'F' ) {
393
394     $recref->{uid} =~ /^(\d*)$/ or return "Illegal uid";
395     $recref->{uid} = $1 eq '' ? $self->unique('uid') : $1;
396
397     $recref->{gid} =~ /^(\d*)$/ or return "Illegal gid";
398     $recref->{gid} = $1 eq '' ? $recref->{uid} : $1;
399     #not all systems use gid=uid
400     #you can set a fixed gid in part_svc
401
402     return "Only root can have uid 0"
403       if $recref->{uid} == 0 && $recref->{username} ne 'root';
404
405     my($error);
406     return $error if $error=$self->ut_textn('finger');
407
408     $recref->{dir} =~ /^([\/\w\-]*)$/
409       or return "Illegal directory";
410     $recref->{dir} = $1 || 
411       $dir_prefix . '/' . $recref->{username}
412       #$dir_prefix . '/' . substr($recref->{username},0,1). '/' . $recref->{username}
413     ;
414
415     unless ( $recref->{username} eq 'sync' ) {
416       if ( grep $_ eq $recref->{shell}, @shells ) {
417         $recref->{shell} = (grep $_ eq $recref->{shell}, @shells)[0];
418       } else {
419         return "Illegal shell \`". $self->shell. "\'; ".
420                $conf->dir. "/shells contains: @shells";
421       }
422     } else {
423       $recref->{shell} = '/bin/sync';
424     }
425
426     $recref->{quota} =~ /^(\d*)$/ or return "Illegal quota (unimplemented)";
427     $recref->{quota} = $1;
428
429   } else {
430     $recref->{gid} ne '' ? 
431       return "Can't have gid without uid" : ( $recref->{gid}='' );
432     $recref->{finger} ne '' ? 
433       return "Can't have finger-name without uid" : ( $recref->{finger}='' );
434     $recref->{dir} ne '' ? 
435       return "Can't have directory without uid" : ( $recref->{dir}='' );
436     $recref->{shell} ne '' ? 
437       return "Can't have shell without uid" : ( $recref->{shell}='' );
438     $recref->{quota} ne '' ? 
439       return "Can't have quota without uid" : ( $recref->{quota}='' );
440   }
441
442   unless ( $part_svc->getfield('svc_acct__slipip_flag') eq 'F' ) {
443     unless ( $recref->{slipip} eq '0e0' ) {
444       $recref->{slipip} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/
445         or return "Illegal slipip". $self->slipip;
446       $recref->{slipip} = $1;
447     } else {
448       $recref->{slipip} = '0e0';
449     }
450
451   }
452
453   #arbitrary RADIUS stuff; allow ut_textn for now
454   foreach ( grep /^radius_/, fields('svc_acct') ) {
455     $self->ut_textn($_);
456   }
457
458   #generate a password if it is blank
459   $recref->{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) )
460     unless ( $recref->{_password} );
461
462   #if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,16})$/ ) {
463   if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{$passwordmin,8})$/ ) {
464     $recref->{_password} = $1.$3;
465     #uncomment this to encrypt password immediately upon entry, or run
466     #bin/crypt_pw in cron to give new users a window during which their
467     #password is available to techs, for faxing, etc.  (also be aware of 
468     #radius issues!)
469     #$recref->{password} = $1.
470     #  crypt($3,$saltset[int(rand(64))].$saltset[int(rand(64))]
471     #;
472   } elsif ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([\w\.\/\$]{13,34})$/ ) {
473     $recref->{_password} = $1.$3;
474   } elsif ( $recref->{_password} eq '*' ) {
475     $recref->{_password} = '*';
476   } else {
477     return "Illegal password";
478   }
479
480   ''; #no error
481 }
482
483 =item radius
484
485 Depriciated, use radius_reply instead.
486
487 =cut
488
489 sub radius {
490   carp "FS::svc_acct::radius depriciated, use radius_reply";
491   $_[0]->radius_reply;
492 }
493
494 =item radius_reply
495
496 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
497 reply attributes of this record.
498
499 Note that this is now the preferred method for reading RADIUS attributes - 
500 accessing the columns directly is discouraged, as the column names are
501 expected to change in the future.
502
503 =cut
504
505 sub radius_reply { 
506   my $self = shift;
507   map {
508     /^(radius_(.*))$/;
509     my($column, $attrib) = ($1, $2);
510     $attrib =~ s/_/\-/g;
511     ( $attrib, $self->getfield($column) );
512   } grep { /^radius_/ && $self->getfield($_) } fields( $self->table );
513 }
514
515 =item radius_check
516
517 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
518 check attributes of this record.
519
520 Accessing RADIUS attributes directly is not supported and will break in the
521 future.
522
523 =cut
524
525 sub radius_check {
526   my $self = shift;
527   map {
528     /^(rc_(.*))$/;
529     my($column, $attrib) = ($1, $2);
530     $attrib =~ s/_/\-/g;
531     ( $attrib, $self->getfield($column) );
532   } grep { /^rc_/ && $self->getfield($_) } fields( $self->table );
533 }
534
535 =cut
536
537 =head1 VERSION
538
539 $Id: svc_acct.pm,v 1.14 2001-01-31 07:21:00 ivan Exp $
540
541 =head1 BUGS
542
543 The bits which ssh should fork before doing so (or maybe queue jobs for a
544 daemon).
545
546 The $recref stuff in sub check should be cleaned up.
547
548 The suspend, unsuspend and cancel methods update the database, but not the
549 current object.  This is probably a bug as it's unexpected and
550 counterintuitive.
551
552 =head1 SEE ALSO
553
554 L<FS::svc_Common>, L<FS::Record>, L<FS::Conf>, L<FS::cust_svc>,
555 L<FS::part_svc>, L<FS::cust_pkg>, L<FS::SSH>, L<ssh>, L<FS::svc_acct_pop>,
556 schema.html from the base documentation.
557
558 =cut
559
560 1;
561