4 use vars qw( @ISA $DEBUG $me $conf $skip_fuzzyfiles
5 $dir_prefix @shells $usernamemin
6 $usernamemax $passwordmin $passwordmax
7 $username_ampersand $username_letter $username_letterfirst
8 $username_noperiod $username_nounderscore $username_nodash
9 $username_uppercase $username_percent
10 $password_noampersand $password_noexclamation
11 $welcome_template $welcome_from $welcome_subject $welcome_mimetype
13 $radius_password $radius_ip
19 use Crypt::PasswdMD5 1.2;
20 use FS::UID qw( datasrc );
22 use FS::Record qw( qsearch qsearchs fields dbh dbdef );
23 use FS::Msgcat qw(gettext);
28 use FS::cust_main_invoice;
32 use FS::radius_usergroup;
39 @ISA = qw( FS::svc_Common );
42 $me = '[FS::svc_acct]';
44 #ask FS::UID to run this stuff for us later
45 $FS::UID::callback{'FS::svc_acct'} = sub {
47 $dir_prefix = $conf->config('home');
48 @shells = $conf->config('shells');
49 $usernamemin = $conf->config('usernamemin') || 2;
50 $usernamemax = $conf->config('usernamemax');
51 $passwordmin = $conf->config('passwordmin') || 6;
52 $passwordmax = $conf->config('passwordmax') || 8;
53 $username_letter = $conf->exists('username-letter');
54 $username_letterfirst = $conf->exists('username-letterfirst');
55 $username_noperiod = $conf->exists('username-noperiod');
56 $username_nounderscore = $conf->exists('username-nounderscore');
57 $username_nodash = $conf->exists('username-nodash');
58 $username_uppercase = $conf->exists('username-uppercase');
59 $username_ampersand = $conf->exists('username-ampersand');
60 $username_percent = $conf->exists('username-percent');
61 $password_noampersand = $conf->exists('password-noexclamation');
62 $password_noexclamation = $conf->exists('password-noexclamation');
63 $dirhash = $conf->config('dirhash') || 0;
64 if ( $conf->exists('welcome_email') ) {
65 $welcome_template = new Text::Template (
67 SOURCE => [ map "$_\n", $conf->config('welcome_email') ]
68 ) or warn "can't create welcome email template: $Text::Template::ERROR";
69 $welcome_from = $conf->config('welcome_email-from'); # || 'your-isp-is-dum'
70 $welcome_subject = $conf->config('welcome_email-subject') || 'Welcome';
71 $welcome_mimetype = $conf->config('welcome_email-mimetype') || 'text/plain';
73 $welcome_template = '';
75 $welcome_subject = '';
76 $welcome_mimetype = '';
78 $smtpmachine = $conf->config('smtpmachine');
79 $radius_password = $conf->config('radius-password') || 'Password';
80 $radius_ip = $conf->config('radius-ip') || 'Framed-IP-Address';
83 @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
84 @pw_set = ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '!', '.', ',' );
88 my ( $hashref, $cache ) = @_;
89 if ( $hashref->{'svc_acct_svcnum'} ) {
90 $self->{'_domsvc'} = FS::svc_domain->new( {
91 'svcnum' => $hashref->{'domsvc'},
92 'domain' => $hashref->{'svc_acct_domain'},
93 'catchall' => $hashref->{'svc_acct_catchall'},
100 FS::svc_acct - Object methods for svc_acct records
106 $record = new FS::svc_acct \%hash;
107 $record = new FS::svc_acct { 'column' => 'value' };
109 $error = $record->insert;
111 $error = $new_record->replace($old_record);
113 $error = $record->delete;
115 $error = $record->check;
117 $error = $record->suspend;
119 $error = $record->unsuspend;
121 $error = $record->cancel;
123 %hash = $record->radius;
125 %hash = $record->radius_reply;
127 %hash = $record->radius_check;
129 $domain = $record->domain;
131 $svc_domain = $record->svc_domain;
133 $email = $record->email;
135 $seconds_since = $record->seconds_since($timestamp);
139 An FS::svc_acct object represents an account. FS::svc_acct inherits from
140 FS::svc_Common. The following fields are currently supported:
144 =item svcnum - primary key (assigned automatcially for new accounts)
148 =item _password - generated if blank
150 =item sec_phrase - security phrase
152 =item popnum - Point of presence (see L<FS::svc_acct_pop>)
160 =item dir - set automatically if blank (and uid is not)
164 =item quota - (unimplementd)
166 =item slipip - IP address
170 =item domsvc - svcnum from svc_domain
172 =item radius_I<Radius_Attribute> - I<Radius-Attribute> (reply)
174 =item rc_I<Radius_Attribute> - I<Radius-Attribute> (check)
184 Creates a new account. To add the account to the database, see L<"insert">.
188 sub table { 'svc_acct'; }
190 =item insert [ , OPTION => VALUE ... ]
192 Adds this account to the database. If there is an error, returns the error,
193 otherwise returns false.
195 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
196 defined. An FS::cust_svc record will be created and inserted.
198 The additional field I<usergroup> can optionally be defined; if so it should
199 contain an arrayref of group names. See L<FS::radius_usergroup>.
201 The additional field I<child_objects> can optionally be defined; if so it
202 should contain an arrayref of FS::tablename objects. They will have their
203 svcnum fields set and will be inserted after this record, but before any
204 exports are run. Each element of the array can also optionally be a
205 two-element array reference containing the child object and the name of an
206 alternate field to be filled in with the newly-inserted svcnum, for example
207 C<[ $svc_forward, 'srcsvc' ]>
209 Currently available options are: I<depend_jobnum>
211 If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
212 jobnums), all provisioning jobs will have a dependancy on the supplied
213 jobnum(s) (they will not run until the specific job(s) complete(s)).
215 (TODOC: L<FS::queue> and L<freeside-queued>)
217 (TODOC: new exports!)
226 local $SIG{HUP} = 'IGNORE';
227 local $SIG{INT} = 'IGNORE';
228 local $SIG{QUIT} = 'IGNORE';
229 local $SIG{TERM} = 'IGNORE';
230 local $SIG{TSTP} = 'IGNORE';
231 local $SIG{PIPE} = 'IGNORE';
233 my $oldAutoCommit = $FS::UID::AutoCommit;
234 local $FS::UID::AutoCommit = 0;
237 $error = $self->check;
238 return $error if $error;
240 if ( $self->svcnum && qsearchs('cust_svc',{'svcnum'=>$self->svcnum}) ) {
241 my $cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum});
242 unless ( $cust_svc ) {
243 $dbh->rollback if $oldAutoCommit;
244 return "no cust_svc record found for svcnum ". $self->svcnum;
246 $self->pkgnum($cust_svc->pkgnum);
247 $self->svcpart($cust_svc->svcpart);
250 $error = $self->_check_duplicate;
252 $dbh->rollback if $oldAutoCommit;
257 $error = $self->SUPER::insert(
258 'jobnums' => \@jobnums,
259 'child_objects' => $self->child_objects,
263 $dbh->rollback if $oldAutoCommit;
267 if ( $self->usergroup ) {
268 foreach my $groupname ( @{$self->usergroup} ) {
269 my $radius_usergroup = new FS::radius_usergroup ( {
270 svcnum => $self->svcnum,
271 groupname => $groupname,
273 my $error = $radius_usergroup->insert;
275 $dbh->rollback if $oldAutoCommit;
281 unless ( $skip_fuzzyfiles ) {
282 $error = $self->queue_fuzzyfiles_update;
284 $dbh->rollback if $oldAutoCommit;
285 return "updating fuzzy search cache: $error";
289 my $cust_pkg = $self->cust_svc->cust_pkg;
292 my $cust_main = $cust_pkg->cust_main;
294 if ( $conf->exists('emailinvoiceauto') ) {
295 my @invoicing_list = $cust_main->invoicing_list;
296 push @invoicing_list, $self->email;
297 $cust_main->invoicing_list(\@invoicing_list);
302 if ( $welcome_template && $cust_pkg ) {
303 my $to = join(', ', grep { $_ !~ /^(POST|FAX)$/ } $cust_main->invoicing_list );
305 my $wqueue = new FS::queue {
306 'svcnum' => $self->svcnum,
307 'job' => 'FS::svc_acct::send_email'
309 my $error = $wqueue->insert(
311 'from' => $welcome_from,
312 'subject' => $welcome_subject,
313 'mimetype' => $welcome_mimetype,
314 'body' => $welcome_template->fill_in( HASH => {
315 'custnum' => $self->custnum,
316 'username' => $self->username,
317 'password' => $self->_password,
318 'first' => $cust_main->first,
319 'last' => $cust_main->getfield('last'),
320 'pkg' => $cust_pkg->part_pkg->pkg,
324 $dbh->rollback if $oldAutoCommit;
325 return "error queuing welcome email: $error";
328 if ( $options{'depend_jobnum'} ) {
329 warn "$me depend_jobnum found; adding to welcome email dependancies"
331 if ( ref($options{'depend_jobnum'}) ) {
332 warn "$me adding jobs ". join(', ', @{$options{'depend_jobnum'}} ).
333 "to welcome email dependancies"
335 push @jobnums, @{ $options{'depend_jobnum'} };
337 warn "$me adding job $options{'depend_jobnum'} ".
338 "to welcome email dependancies"
340 push @jobnums, $options{'depend_jobnum'};
344 foreach my $jobnum ( @jobnums ) {
345 my $error = $wqueue->depend_insert($jobnum);
347 $dbh->rollback if $oldAutoCommit;
348 return "error queuing welcome email job dependancy: $error";
358 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
364 Deletes this account from the database. If there is an error, returns the
365 error, otherwise returns false.
367 The corresponding FS::cust_svc record will be deleted as well.
369 (TODOC: new exports!)
376 return "can't delete system account" if $self->_check_system;
378 return "Can't delete an account which is a (svc_forward) source!"
379 if qsearch( 'svc_forward', { 'srcsvc' => $self->svcnum } );
381 return "Can't delete an account which is a (svc_forward) destination!"
382 if qsearch( 'svc_forward', { 'dstsvc' => $self->svcnum } );
384 return "Can't delete an account with (svc_www) web service!"
385 if qsearch( 'svc_www', { 'usersvc' => $self->svcnum } );
387 # what about records in session ? (they should refer to history table)
389 local $SIG{HUP} = 'IGNORE';
390 local $SIG{INT} = 'IGNORE';
391 local $SIG{QUIT} = 'IGNORE';
392 local $SIG{TERM} = 'IGNORE';
393 local $SIG{TSTP} = 'IGNORE';
394 local $SIG{PIPE} = 'IGNORE';
396 my $oldAutoCommit = $FS::UID::AutoCommit;
397 local $FS::UID::AutoCommit = 0;
400 foreach my $cust_main_invoice (
401 qsearch( 'cust_main_invoice', { 'dest' => $self->svcnum } )
403 unless ( defined($cust_main_invoice) ) {
404 warn "WARNING: something's wrong with qsearch";
407 my %hash = $cust_main_invoice->hash;
408 $hash{'dest'} = $self->email;
409 my $new = new FS::cust_main_invoice \%hash;
410 my $error = $new->replace($cust_main_invoice);
412 $dbh->rollback if $oldAutoCommit;
417 foreach my $svc_domain (
418 qsearch( 'svc_domain', { 'catchall' => $self->svcnum } )
420 my %hash = new FS::svc_domain->hash;
421 $hash{'catchall'} = '';
422 my $new = new FS::svc_domain \%hash;
423 my $error = $new->replace($svc_domain);
425 $dbh->rollback if $oldAutoCommit;
430 foreach my $radius_usergroup (
431 qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } )
433 my $error = $radius_usergroup->delete;
435 $dbh->rollback if $oldAutoCommit;
440 my $error = $self->SUPER::delete;
442 $dbh->rollback if $oldAutoCommit;
446 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
450 =item replace OLD_RECORD
452 Replaces OLD_RECORD with this one in the database. If there is an error,
453 returns the error, otherwise returns false.
455 The additional field I<usergroup> can optionally be defined; if so it should
456 contain an arrayref of group names. See L<FS::radius_usergroup>.
462 my ( $new, $old ) = ( shift, shift );
464 warn "$me replacing $old with $new\n" if $DEBUG;
466 return "can't modify system account" if $old->_check_system;
469 #no warnings 'numeric'; #alas, a 5.006-ism
472 foreach my $xid (qw( uid gid )) {
474 return "Can't change $xid!"
475 if ! $conf->exists("svc_acct-edit_$xid")
476 && $old->$xid() != $new->$xid()
477 && $new->cust_svc->part_svc->part_svc_column($xid)->columnflag ne 'F'
482 #change homdir when we change username
483 $new->setfield('dir', '') if $old->username ne $new->username;
485 local $SIG{HUP} = 'IGNORE';
486 local $SIG{INT} = 'IGNORE';
487 local $SIG{QUIT} = 'IGNORE';
488 local $SIG{TERM} = 'IGNORE';
489 local $SIG{TSTP} = 'IGNORE';
490 local $SIG{PIPE} = 'IGNORE';
492 my $oldAutoCommit = $FS::UID::AutoCommit;
493 local $FS::UID::AutoCommit = 0;
496 # redundant, but so $new->usergroup gets set
497 $error = $new->check;
498 return $error if $error;
500 $old->usergroup( [ $old->radius_groups ] );
502 warn $old->email. " old groups: ". join(' ',@{$old->usergroup}). "\n";
503 warn $new->email. "new groups: ". join(' ',@{$new->usergroup}). "\n";
505 if ( $new->usergroup ) {
506 #(sorta) false laziness with FS::part_export::sqlradius::_export_replace
507 my @newgroups = @{$new->usergroup};
508 foreach my $oldgroup ( @{$old->usergroup} ) {
509 if ( grep { $oldgroup eq $_ } @newgroups ) {
510 @newgroups = grep { $oldgroup ne $_ } @newgroups;
513 my $radius_usergroup = qsearchs('radius_usergroup', {
514 svcnum => $old->svcnum,
515 groupname => $oldgroup,
517 my $error = $radius_usergroup->delete;
519 $dbh->rollback if $oldAutoCommit;
520 return "error deleting radius_usergroup $oldgroup: $error";
524 foreach my $newgroup ( @newgroups ) {
525 my $radius_usergroup = new FS::radius_usergroup ( {
526 svcnum => $new->svcnum,
527 groupname => $newgroup,
529 my $error = $radius_usergroup->insert;
531 $dbh->rollback if $oldAutoCommit;
532 return "error adding radius_usergroup $newgroup: $error";
538 if ( $old->username ne $new->username || $old->domsvc != $new->domsvc ) {
539 $new->svcpart( $new->cust_svc->svcpart ) unless $new->svcpart;
540 $error = $new->_check_duplicate;
542 $dbh->rollback if $oldAutoCommit;
547 $error = $new->SUPER::replace($old);
549 $dbh->rollback if $oldAutoCommit;
550 return $error if $error;
553 if ( $new->username ne $old->username && ! $skip_fuzzyfiles ) {
554 $error = $new->queue_fuzzyfiles_update;
556 $dbh->rollback if $oldAutoCommit;
557 return "updating fuzzy search cache: $error";
561 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
565 =item queue_fuzzyfiles_update
567 Used by insert & replace to update the fuzzy search cache
571 sub queue_fuzzyfiles_update {
574 local $SIG{HUP} = 'IGNORE';
575 local $SIG{INT} = 'IGNORE';
576 local $SIG{QUIT} = 'IGNORE';
577 local $SIG{TERM} = 'IGNORE';
578 local $SIG{TSTP} = 'IGNORE';
579 local $SIG{PIPE} = 'IGNORE';
581 my $oldAutoCommit = $FS::UID::AutoCommit;
582 local $FS::UID::AutoCommit = 0;
585 my $queue = new FS::queue {
586 'svcnum' => $self->svcnum,
587 'job' => 'FS::svc_acct::append_fuzzyfiles'
589 my $error = $queue->insert($self->username);
591 $dbh->rollback if $oldAutoCommit;
592 return "queueing job (transaction rolled back): $error";
595 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
603 Suspends this account by calling export-specific suspend hooks. If there is
604 an error, returns the error, otherwise returns false.
606 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
612 return "can't suspend system account" if $self->_check_system;
613 $self->SUPER::suspend;
618 Unsuspends this account by by calling export-specific suspend hooks. If there
619 is an error, returns the error, otherwise returns false.
621 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
627 my %hash = $self->hash;
628 if ( $hash{_password} =~ /^\*SUSPENDED\* (.*)$/ ) {
629 $hash{_password} = $1;
630 my $new = new FS::svc_acct ( \%hash );
631 my $error = $new->replace($self);
632 return $error if $error;
635 $self->SUPER::unsuspend;
640 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
642 If the B<auto_unset_catchall> configuration option is set, this method will
643 automatically remove any references to the canceled service in the catchall
644 field of svc_domain. This allows packages that contain both a svc_domain and
645 its catchall svc_acct to be canceled in one step.
650 # Only one thing to do at this level
652 foreach my $svc_domain (
653 qsearch( 'svc_domain', { catchall => $self->svcnum } ) ) {
654 if($conf->exists('auto_unset_catchall')) {
655 my %hash = $svc_domain->hash;
656 $hash{catchall} = '';
657 my $new = new FS::svc_domain ( \%hash );
658 my $error = $new->replace($svc_domain);
659 return $error if $error;
661 return "cannot unprovision svc_acct #".$self->svcnum.
662 " while assigned as catchall for svc_domain #".$svc_domain->svcnum;
666 $self->SUPER::cancel;
672 Checks all fields to make sure this is a valid service. If there is an error,
673 returns the error, otherwise returns false. Called by the insert and replace
676 Sets any fixed values; see L<FS::part_svc>.
683 my($recref) = $self->hashref;
685 my $x = $self->setfixed;
686 return $x unless ref($x);
689 if ( $part_svc->part_svc_column('usergroup')->columnflag eq "F" ) {
691 [ split(',', $part_svc->part_svc_column('usergroup')->columnvalue) ] );
694 my $error = $self->ut_numbern('svcnum')
695 #|| $self->ut_number('domsvc')
696 || $self->ut_foreign_key('domsvc', 'svc_domain', 'svcnum' )
697 || $self->ut_textn('sec_phrase')
699 return $error if $error;
701 my $ulen = $usernamemax || $self->dbdef_table->column('username')->length;
702 if ( $username_uppercase ) {
703 $recref->{username} =~ /^([a-z0-9_\-\.\&\%]{$usernamemin,$ulen})$/i
704 or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username};
705 $recref->{username} = $1;
707 $recref->{username} =~ /^([a-z0-9_\-\.\&\%]{$usernamemin,$ulen})$/
708 or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username};
709 $recref->{username} = $1;
712 if ( $username_letterfirst ) {
713 $recref->{username} =~ /^[a-z]/ or return gettext('illegal_username');
714 } elsif ( $username_letter ) {
715 $recref->{username} =~ /[a-z]/ or return gettext('illegal_username');
717 if ( $username_noperiod ) {
718 $recref->{username} =~ /\./ and return gettext('illegal_username');
720 if ( $username_nounderscore ) {
721 $recref->{username} =~ /_/ and return gettext('illegal_username');
723 if ( $username_nodash ) {
724 $recref->{username} =~ /\-/ and return gettext('illegal_username');
726 unless ( $username_ampersand ) {
727 $recref->{username} =~ /\&/ and return gettext('illegal_username');
729 if ( $password_noampersand ) {
730 $recref->{_password} =~ /\&/ and return gettext('illegal_password');
732 if ( $password_noexclamation ) {
733 $recref->{_password} =~ /\!/ and return gettext('illegal_password');
735 unless ( $username_percent ) {
736 $recref->{username} =~ /\%/ and return gettext('illegal_username');
739 $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum};
740 $recref->{popnum} = $1;
741 return "Unknown popnum" unless
742 ! $recref->{popnum} ||
743 qsearchs('svc_acct_pop',{'popnum'=> $recref->{popnum} } );
745 unless ( $part_svc->part_svc_column('uid')->columnflag eq 'F' ) {
747 $recref->{uid} =~ /^(\d*)$/ or return "Illegal uid";
748 $recref->{uid} = $1 eq '' ? $self->unique('uid') : $1;
750 $recref->{gid} =~ /^(\d*)$/ or return "Illegal gid";
751 $recref->{gid} = $1 eq '' ? $recref->{uid} : $1;
752 #not all systems use gid=uid
753 #you can set a fixed gid in part_svc
755 return "Only root can have uid 0"
756 if $recref->{uid} == 0
757 && $recref->{username} !~ /^(root|toor|smtp)$/;
759 unless ( $recref->{username} eq 'sync' ) {
760 if ( grep $_ eq $recref->{shell}, @shells ) {
761 $recref->{shell} = (grep $_ eq $recref->{shell}, @shells)[0];
763 return "Illegal shell \`". $self->shell. "\'; ".
764 $conf->dir. "/shells contains: @shells";
767 $recref->{shell} = '/bin/sync';
771 $recref->{gid} ne '' ?
772 return "Can't have gid without uid" : ( $recref->{gid}='' );
773 #$recref->{dir} ne '' ?
774 # return "Can't have directory without uid" : ( $recref->{dir}='' );
775 $recref->{shell} ne '' ?
776 return "Can't have shell without uid" : ( $recref->{shell}='' );
779 unless ( $part_svc->part_svc_column('dir')->columnflag eq 'F' ) {
781 $recref->{dir} =~ /^([\/\w\-\.\&]*)$/
782 or return "Illegal directory: ". $recref->{dir};
784 return "Illegal directory"
785 if $recref->{dir} =~ /(^|\/)\.+(\/|$)/; #no .. component
786 return "Illegal directory"
787 if $recref->{dir} =~ /\&/ && ! $username_ampersand;
788 unless ( $recref->{dir} ) {
789 $recref->{dir} = $dir_prefix . '/';
790 if ( $dirhash > 0 ) {
791 for my $h ( 1 .. $dirhash ) {
792 $recref->{dir} .= substr($recref->{username}, $h-1, 1). '/';
794 } elsif ( $dirhash < 0 ) {
795 for my $h ( reverse $dirhash .. -1 ) {
796 $recref->{dir} .= substr($recref->{username}, $h, 1). '/';
799 $recref->{dir} .= $recref->{username};
805 # $error = $self->ut_textn('finger');
806 # return $error if $error;
807 if ( $self->getfield('finger') eq '' ) {
808 my $cust_pkg = $self->svcnum
809 ? $self->cust_svc->cust_pkg
810 : qsearchs('cust_pkg', { 'pkgnum' => $self->getfield('pkgnum') } );
812 my $cust_main = $cust_pkg->cust_main;
813 $self->setfield('finger', $cust_main->first.' '.$cust_main->get('last') );
816 $self->getfield('finger') =~
817 /^([\w \t\!\@\#\$\%\&\(\)\-\+\;\'\"\,\.\?\/\*\<\>]*)$/
818 or return "Illegal finger: ". $self->getfield('finger');
819 $self->setfield('finger', $1);
821 $recref->{quota} =~ /^(\w*)$/ or return "Illegal quota";
822 $recref->{quota} = $1;
824 unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) {
825 if ( $recref->{slipip} eq '' ) {
826 $recref->{slipip} = '';
827 } elsif ( $recref->{slipip} eq '0e0' ) {
828 $recref->{slipip} = '0e0';
830 $recref->{slipip} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/
831 or return "Illegal slipip: ". $self->slipip;
832 $recref->{slipip} = $1;
837 #arbitrary RADIUS stuff; allow ut_textn for now
838 foreach ( grep /^radius_/, fields('svc_acct') ) {
842 #generate a password if it is blank
843 $recref->{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) )
844 unless ( $recref->{_password} );
846 #if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,16})$/ ) {
847 if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{$passwordmin,$passwordmax})$/ ) {
848 $recref->{_password} = $1.$3;
849 #uncomment this to encrypt password immediately upon entry, or run
850 #bin/crypt_pw in cron to give new users a window during which their
851 #password is available to techs, for faxing, etc. (also be aware of
853 #$recref->{password} = $1.
854 # crypt($3,$saltset[int(rand(64))].$saltset[int(rand(64))]
856 } elsif ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([\w\.\/\$\;\+]{13,60})$/ ) {
857 $recref->{_password} = $1.$3;
858 } elsif ( $recref->{_password} eq '*' ) {
859 $recref->{_password} = '*';
860 } elsif ( $recref->{_password} eq '!' ) {
861 $recref->{_password} = '!';
862 } elsif ( $recref->{_password} eq '!!' ) {
863 $recref->{_password} = '!!';
865 #return "Illegal password";
866 return gettext('illegal_password'). " $passwordmin-$passwordmax ".
867 FS::Msgcat::_gettext('illegal_password_characters').
868 ": ". $recref->{_password};
876 Internal function to check the username against the list of system usernames
877 from the I<system_usernames> configuration value. Returns true if the username
878 is listed on the system username list.
884 scalar( grep { $self->username eq $_ || $self->email eq $_ }
885 $conf->config('system_usernames')
889 =item _check_duplicate
891 Internal function to check for duplicates usernames, username@domain pairs and
894 If the I<global_unique-username> configuration value is set to B<username> or
895 B<username@domain>, enforces global username or username@domain uniqueness.
897 In all cases, check for duplicate uids and usernames or username@domain pairs
898 per export and with identical I<svcpart> values.
902 sub _check_duplicate {
905 #this is Pg-specific. what to do for mysql etc?
906 # ( mysql LOCK TABLES certainly isn't equivalent or useful here :/ )
907 warn "$me locking svc_acct table for duplicate search" if $DEBUG;
908 dbh->do("LOCK TABLE svc_acct IN SHARE ROW EXCLUSIVE MODE")
910 warn "$me acquired svc_acct table lock for duplicate search" if $DEBUG;
912 my $part_svc = qsearchs('part_svc', { 'svcpart' => $self->svcpart } );
913 unless ( $part_svc ) {
914 return 'unknown svcpart '. $self->svcpart;
917 my $global_unique = $conf->config('global_unique-username') || 'none';
919 my @dup_user = grep { !$self->svcnum || $_->svcnum != $self->svcnum }
920 qsearch( 'svc_acct', { 'username' => $self->username } );
921 return gettext('username_in_use')
922 if $global_unique eq 'username' && @dup_user;
924 my @dup_userdomain = grep { !$self->svcnum || $_->svcnum != $self->svcnum }
925 qsearch( 'svc_acct', { 'username' => $self->username,
926 'domsvc' => $self->domsvc } );
927 return gettext('username_in_use')
928 if $global_unique eq 'username@domain' && @dup_userdomain;
931 if ( $part_svc->part_svc_column('uid')->columnflag ne 'F'
932 && $self->username !~ /^(toor|(hyla)?fax)$/ ) {
933 @dup_uid = grep { !$self->svcnum || $_->svcnum != $self->svcnum }
934 qsearch( 'svc_acct', { 'uid' => $self->uid } );
939 if ( @dup_user || @dup_userdomain || @dup_uid ) {
940 my $exports = FS::part_export::export_info('svc_acct');
941 my %conflict_user_svcpart;
942 my %conflict_userdomain_svcpart = ( $self->svcpart => 'SELF', );
944 foreach my $part_export ( $part_svc->part_export ) {
946 #this will catch to the same exact export
947 my @svcparts = map { $_->svcpart } $part_export->export_svc;
949 #this will catch to exports w/same exporthost+type ???
950 #my @other_part_export = qsearch('part_export', {
951 # 'machine' => $part_export->machine,
952 # 'exporttype' => $part_export->exporttype,
954 #foreach my $other_part_export ( @other_part_export ) {
955 # push @svcparts, map { $_->svcpart }
956 # qsearch('export_svc', { 'exportnum' => $part_export->exportnum });
959 #my $nodomain = $exports->{$part_export->exporttype}{'nodomain'};
960 #silly kludge to avoid uninitialized value errors
961 my $nodomain = exists( $exports->{$part_export->exporttype}{'nodomain'} )
962 ? $exports->{$part_export->exporttype}{'nodomain'}
964 if ( $nodomain =~ /^Y/i ) {
965 $conflict_user_svcpart{$_} = $part_export->exportnum
968 $conflict_userdomain_svcpart{$_} = $part_export->exportnum
973 foreach my $dup_user ( @dup_user ) {
974 my $dup_svcpart = $dup_user->cust_svc->svcpart;
975 if ( exists($conflict_user_svcpart{$dup_svcpart}) ) {
976 return "duplicate username: conflicts with svcnum ". $dup_user->svcnum.
977 " via exportnum ". $conflict_user_svcpart{$dup_svcpart};
981 foreach my $dup_userdomain ( @dup_userdomain ) {
982 my $dup_svcpart = $dup_userdomain->cust_svc->svcpart;
983 if ( exists($conflict_userdomain_svcpart{$dup_svcpart}) ) {
984 return "duplicate username\@domain: conflicts with svcnum ".
985 $dup_userdomain->svcnum. " via exportnum ".
986 $conflict_userdomain_svcpart{$dup_svcpart};
990 foreach my $dup_uid ( @dup_uid ) {
991 my $dup_svcpart = $dup_uid->cust_svc->svcpart;
992 if ( exists($conflict_user_svcpart{$dup_svcpart})
993 || exists($conflict_userdomain_svcpart{$dup_svcpart}) ) {
994 return "duplicate uid: conflicts with svcnum ". $dup_uid->svcnum.
995 " via exportnum ". $conflict_user_svcpart{$dup_svcpart}
996 || $conflict_userdomain_svcpart{$dup_svcpart};
1008 Depriciated, use radius_reply instead.
1013 carp "FS::svc_acct::radius depriciated, use radius_reply";
1014 $_[0]->radius_reply;
1019 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
1020 reply attributes of this record.
1022 Note that this is now the preferred method for reading RADIUS attributes -
1023 accessing the columns directly is discouraged, as the column names are
1024 expected to change in the future.
1031 return %{ $self->{'radius_reply'} }
1032 if exists $self->{'radius_reply'};
1037 my($column, $attrib) = ($1, $2);
1038 #$attrib =~ s/_/\-/g;
1039 ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
1040 } grep { /^radius_/ && $self->getfield($_) } fields( $self->table );
1042 if ( $self->slipip && $self->slipip ne '0e0' ) {
1043 $reply{$radius_ip} = $self->slipip;
1046 if ( $self->seconds !~ /^$/ ) {
1047 $reply{'Session-Timeout'} = $self->seconds;
1055 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
1056 check attributes of this record.
1058 Note that this is now the preferred method for reading RADIUS attributes -
1059 accessing the columns directly is discouraged, as the column names are
1060 expected to change in the future.
1067 return %{ $self->{'radius_check'} }
1068 if exists $self->{'radius_check'};
1073 my($column, $attrib) = ($1, $2);
1074 #$attrib =~ s/_/\-/g;
1075 ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
1076 } grep { /^rc_/ && $self->getfield($_) } fields( $self->table );
1078 my $password = $self->_password;
1079 my $pw_attrib = length($password) <= 12 ? $radius_password : 'Crypt-Password'; $check{$pw_attrib} = $password;
1081 my $cust_svc = $self->cust_svc;
1082 die "FATAL: no cust_svc record for svc_acct.svcnum ". $self->svcnum. "\n"
1084 my $cust_pkg = $cust_svc->cust_pkg;
1085 if ( $cust_pkg && $cust_pkg->part_pkg->is_prepaid && $cust_pkg->bill ) {
1086 $check{'Expiration'} = time2str('%B %e %Y %T', $cust_pkg->bill ); #http://lists.cistron.nl/pipermail/freeradius-users/2005-January/040184.html
1095 This method instructs the object to "snapshot" or freeze RADIUS check and
1096 reply attributes to the current values.
1100 #bah, my english is too broken this morning
1101 #Of note is the "Expiration" attribute, which, for accounts in prepaid packages, is typically defined on-the-fly as the associated packages cust_pkg.bill. (This is used by
1102 #the FS::cust_pkg's replace method to trigger the correct export updates when
1103 #package dates change)
1108 $self->{$_} = { $self->$_() }
1109 foreach qw( radius_reply radius_check );
1113 =item forget_snapshot
1115 This methos instructs the object to forget any previously snapshotted
1116 RADIUS check and reply attributes.
1120 sub forget_snapshot {
1124 foreach qw( radius_reply radius_check );
1130 Returns the domain associated with this account.
1136 die "svc_acct.domsvc is null for svcnum ". $self->svcnum unless $self->domsvc;
1137 my $svc_domain = $self->svc_domain(@_)
1138 or die "no svc_domain.svcnum for svc_acct.domsvc ". $self->domsvc;
1139 $svc_domain->domain;
1144 Returns the FS::svc_domain record for this account's domain (see
1152 ? $self->{'_domsvc'}
1153 : qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } );
1158 Returns the FS::cust_svc record for this account (see L<FS::cust_svc>).
1162 #inherited from svc_Common
1166 Returns an email address associated with the account.
1172 $self->username. '@'. $self->domain(@_);
1177 Returns an array of FS::acct_snarf records associated with the account.
1178 If the acct_snarf table does not exist or there are no associated records,
1179 an empty list is returned
1185 return () unless dbdef->table('acct_snarf');
1186 eval "use FS::acct_snarf;";
1188 qsearch('acct_snarf', { 'svcnum' => $self->svcnum } );
1191 =item decrement_seconds SECONDS
1193 Decrements the I<seconds> field of this record by the given amount. If there
1194 is an error, returns the error, otherwise returns false.
1198 sub decrement_seconds {
1199 shift->_op_seconds('-', @_);
1202 =item increment_seconds SECONDS
1204 Increments the I<seconds> field of this record by the given amount. If there
1205 is an error, returns the error, otherwise returns false.
1209 sub increment_seconds {
1210 shift->_op_seconds('+', @_);
1218 my %op2condition = (
1219 '-' => sub { my($self, $seconds) = @_;
1220 $self->seconds - $seconds <= 0;
1222 '+' => sub { my($self, $seconds) = @_;
1223 $self->seconds + $seconds > 0;
1228 my( $self, $op, $seconds ) = @_;
1229 warn "$me _op_seconds called for svcnum ". $self->svcnum.
1230 ' ('. $self->email. "): $op $seconds\n"
1233 local $SIG{HUP} = 'IGNORE';
1234 local $SIG{INT} = 'IGNORE';
1235 local $SIG{QUIT} = 'IGNORE';
1236 local $SIG{TERM} = 'IGNORE';
1237 local $SIG{TSTP} = 'IGNORE';
1238 local $SIG{PIPE} = 'IGNORE';
1240 my $oldAutoCommit = $FS::UID::AutoCommit;
1241 local $FS::UID::AutoCommit = 0;
1244 my $sql = "UPDATE svc_acct SET seconds = ".
1245 " CASE WHEN seconds IS NULL THEN 0 ELSE seconds END ". #$seconds||0
1246 " $op ? WHERE svcnum = ?";
1250 my $sth = $dbh->prepare( $sql )
1251 or die "Error preparing $sql: ". $dbh->errstr;
1252 my $rv = $sth->execute($seconds, $self->svcnum);
1253 die "Error executing $sql: ". $sth->errstr
1254 unless defined($rv);
1255 die "Can't update seconds for svcnum". $self->svcnum
1258 my $action = $op2action{$op};
1260 if ( $conf->exists("svc_acct-usage_$action")
1261 && &{$op2condition{$op}}($self, $seconds) ) {
1262 #my $error = $self->$action();
1263 my $error = $self->cust_svc->cust_pkg->$action();
1265 $dbh->rollback if $oldAutoCommit;
1266 return "Error ${action}ing: $error";
1270 warn "$me update successful; committing\n"
1272 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1278 =item seconds_since TIMESTAMP
1280 Returns the number of seconds this account has been online since TIMESTAMP,
1281 according to the session monitor (see L<FS::Session>).
1283 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
1284 L<Time::Local> and L<Date::Parse> for conversion functions.
1288 #note: POD here, implementation in FS::cust_svc
1291 $self->cust_svc->seconds_since(@_);
1294 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
1296 Returns the numbers of seconds this account has been online between
1297 TIMESTAMP_START (inclusive) and TIMESTAMP_END (exclusive), according to an
1298 external SQL radacct table, specified via sqlradius export. Sessions which
1299 started in the specified range but are still open are counted from session
1300 start to the end of the range (unless they are over 1 day old, in which case
1301 they are presumed missing their stop record and not counted). Also, sessions
1302 which end in the range but started earlier are counted from the start of the
1303 range to session end. Finally, sessions which start before the range but end
1304 after are counted for the entire range.
1306 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1307 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
1312 #note: POD here, implementation in FS::cust_svc
1313 sub seconds_since_sqlradacct {
1315 $self->cust_svc->seconds_since_sqlradacct(@_);
1318 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
1320 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
1321 in this package for sessions ending between TIMESTAMP_START (inclusive) and
1322 TIMESTAMP_END (exclusive).
1324 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1325 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
1330 #note: POD here, implementation in FS::cust_svc
1331 sub attribute_since_sqlradacct {
1333 $self->cust_svc->attribute_since_sqlradacct(@_);
1336 =item get_session_history TIMESTAMP_START TIMESTAMP_END
1338 Returns an array of hash references of this customers login history for the
1339 given time range. (document this better)
1343 sub get_session_history {
1345 $self->cust_svc->get_session_history(@_);
1348 =item get_cdrs TIMESTAMP_START TIMESTAMP_END [ 'OPTION' => 'VALUE ... ]
1353 my($self, $start, $end, %opt ) = @_;
1355 my $did = $self->username; #yup
1357 my $prefix = $opt{'default_prefix'}; #convergent.au '+61'
1359 my $for_update = $opt{'for_update'} ? 'FOR UPDATE' : '';
1361 #SELECT $for_update * FROM cdr
1362 # WHERE calldate >= $start #need a conversion
1363 # AND calldate < $end #ditto
1364 # AND ( charged_party = "$did"
1365 # OR charged_party = "$prefix$did" #if length($prefix);
1366 # OR ( ( charged_party IS NULL OR charged_party = '' )
1368 # ( src = "$did" OR src = "$prefix$did" ) # if length($prefix)
1371 # AND ( freesidestatus IS NULL OR freesidestatus = '' )
1374 if ( length($prefix) ) {
1376 " AND ( charged_party = '$did'
1377 OR charged_party = '$prefix$did'
1378 OR ( ( charged_party IS NULL OR charged_party = '' )
1380 ( src = '$did' OR src = '$prefix$did' )
1386 " AND ( charged_party = '$did'
1387 OR ( ( charged_party IS NULL OR charged_party = '' )
1397 'select' => "$for_update *",
1400 #( freesidestatus IS NULL OR freesidestatus = '' )
1401 'freesidestatus' => '',
1403 'extra_sql' => $charged_or_src,
1411 Returns all RADIUS groups for this account (see L<FS::radius_usergroup>).
1417 if ( $self->usergroup ) {
1418 #when provisioning records, export callback runs in svc_Common.pm before
1419 #radius_usergroup records can be inserted...
1420 @{$self->usergroup};
1422 map { $_->groupname }
1423 qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } );
1427 =item clone_suspended
1429 Constructor used by FS::part_export::_export_suspend fallback. Document
1434 sub clone_suspended {
1436 my %hash = $self->hash;
1437 $hash{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) );
1438 new FS::svc_acct \%hash;
1441 =item clone_kludge_unsuspend
1443 Constructor used by FS::part_export::_export_unsuspend fallback. Document
1448 sub clone_kludge_unsuspend {
1450 my %hash = $self->hash;
1451 $hash{_password} = '';
1452 new FS::svc_acct \%hash;
1455 =item check_password
1457 Checks the supplied password against the (possibly encrypted) password in the
1458 database. Returns true for a successful authentication, false for no match.
1460 Currently supported encryptions are: classic DES crypt() and MD5
1464 sub check_password {
1465 my($self, $check_password) = @_;
1467 #remove old-style SUSPENDED kludge, they should be allowed to login to
1468 #self-service and pay up
1469 ( my $password = $self->_password ) =~ s/^\*SUSPENDED\* //;
1471 #eventually should check a "password-encoding" field
1472 if ( $password =~ /^(\*|!!?)$/ ) { #no self-service login
1474 } elsif ( length($password) < 13 ) { #plaintext
1475 $check_password eq $password;
1476 } elsif ( length($password) == 13 ) { #traditional DES crypt
1477 crypt($check_password, $password) eq $password;
1478 } elsif ( $password =~ /^\$1\$/ ) { #MD5 crypt
1479 unix_md5_crypt($check_password, $password) eq $password;
1480 } elsif ( $password =~ /^\$2a?\$/ ) { #Blowfish
1481 warn "Can't check password: Blowfish encryption not yet supported, svcnum".
1482 $self->svcnum. "\n";
1485 warn "Can't check password: Unrecognized encryption for svcnum ".
1486 $self->svcnum. "\n";
1492 =item crypt_password [ DEFAULT_ENCRYPTION_TYPE ]
1494 Returns an encrypted password, either by passing through an encrypted password
1495 in the database or by encrypting a plaintext password from the database.
1497 The optional DEFAULT_ENCRYPTION_TYPE parameter can be set to I<crypt> (classic
1498 UNIX DES crypt), I<md5> (md5 crypt supported by most modern Linux and BSD
1499 distrubtions), or (eventually) I<blowfish> (blowfish hashing supported by
1500 OpenBSD, SuSE, other Linux distibutions with pam_unix2, etc.). The default
1501 encryption type is only used if the password is not already encrypted in the
1506 sub crypt_password {
1508 #eventually should check a "password-encoding" field
1509 if ( length($self->_password) == 13
1510 || $self->_password =~ /^\$(1|2a?)\$/
1511 || $self->_password =~ /^(\*|NP|\*LK\*|!!?)$/
1516 my $encryption = ( scalar(@_) && $_[0] ) ? shift : 'crypt';
1517 if ( $encryption eq 'crypt' ) {
1520 $saltset[int(rand(64))].$saltset[int(rand(64))]
1522 } elsif ( $encryption eq 'md5' ) {
1523 unix_md5_crypt( $self->_password );
1524 } elsif ( $encryption eq 'blowfish' ) {
1525 die "unknown encryption method $encryption";
1527 die "unknown encryption method $encryption";
1532 =item virtual_maildir
1534 Returns $domain/maildirs/$username/
1538 sub virtual_maildir {
1540 $self->domain. '/maildirs/'. $self->username. '/';
1551 This is the FS::svc_acct job-queue-able version. It still uses
1552 FS::Misc::send_email under-the-hood.
1559 eval "use FS::Misc qw(send_email)";
1562 $opt{mimetype} ||= 'text/plain';
1563 $opt{mimetype} .= '; charset="iso-8859-1"' unless $opt{mimetype} =~ /charset/;
1565 my $error = send_email(
1566 'from' => $opt{from},
1568 'subject' => $opt{subject},
1569 'content-type' => $opt{mimetype},
1570 'body' => [ map "$_\n", split("\n", $opt{body}) ],
1572 die $error if $error;
1575 =item check_and_rebuild_fuzzyfiles
1579 sub check_and_rebuild_fuzzyfiles {
1580 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1581 -e "$dir/svc_acct.username"
1582 or &rebuild_fuzzyfiles;
1585 =item rebuild_fuzzyfiles
1589 sub rebuild_fuzzyfiles {
1591 use Fcntl qw(:flock);
1593 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1597 open(USERNAMELOCK,">>$dir/svc_acct.username")
1598 or die "can't open $dir/svc_acct.username: $!";
1599 flock(USERNAMELOCK,LOCK_EX)
1600 or die "can't lock $dir/svc_acct.username: $!";
1602 my @all_username = map $_->getfield('username'), qsearch('svc_acct', {});
1604 open (USERNAMECACHE,">$dir/svc_acct.username.tmp")
1605 or die "can't open $dir/svc_acct.username.tmp: $!";
1606 print USERNAMECACHE join("\n", @all_username), "\n";
1607 close USERNAMECACHE or die "can't close $dir/svc_acct.username.tmp: $!";
1609 rename "$dir/svc_acct.username.tmp", "$dir/svc_acct.username";
1619 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1620 open(USERNAMECACHE,"<$dir/svc_acct.username")
1621 or die "can't open $dir/svc_acct.username: $!";
1622 my @array = map { chomp; $_; } <USERNAMECACHE>;
1623 close USERNAMECACHE;
1627 =item append_fuzzyfiles USERNAME
1631 sub append_fuzzyfiles {
1632 my $username = shift;
1634 &check_and_rebuild_fuzzyfiles;
1636 use Fcntl qw(:flock);
1638 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1640 open(USERNAME,">>$dir/svc_acct.username")
1641 or die "can't open $dir/svc_acct.username: $!";
1642 flock(USERNAME,LOCK_EX)
1643 or die "can't lock $dir/svc_acct.username: $!";
1645 print USERNAME "$username\n";
1647 flock(USERNAME,LOCK_UN)
1648 or die "can't unlock $dir/svc_acct.username: $!";
1656 =item radius_usergroup_selector GROUPS_ARRAYREF [ SELECTNAME ]
1660 sub radius_usergroup_selector {
1661 my $sel_groups = shift;
1662 my %sel_groups = map { $_=>1 } @$sel_groups;
1664 my $selectname = shift || 'radius_usergroup';
1667 my $sth = $dbh->prepare(
1668 'SELECT DISTINCT(groupname) FROM radius_usergroup ORDER BY groupname'
1669 ) or die $dbh->errstr;
1670 $sth->execute() or die $sth->errstr;
1671 my @all_groups = map { $_->[0] } @{$sth->fetchall_arrayref};
1675 function ${selectname}_doadd(object) {
1676 var myvalue = object.${selectname}_add.value;
1677 var optionName = new Option(myvalue,myvalue,false,true);
1678 var length = object.$selectname.length;
1679 object.$selectname.options[length] = optionName;
1680 object.${selectname}_add.value = "";
1683 <SELECT MULTIPLE NAME="$selectname">
1686 foreach my $group ( @all_groups ) {
1687 $html .= qq(<OPTION VALUE="$group");
1688 if ( $sel_groups{$group} ) {
1689 $html .= ' SELECTED';
1690 $sel_groups{$group} = 0;
1692 $html .= ">$group</OPTION>\n";
1694 foreach my $group ( grep { $sel_groups{$_} } keys %sel_groups ) {
1695 $html .= qq(<OPTION VALUE="$group" SELECTED>$group</OPTION>\n);
1697 $html .= '</SELECT>';
1699 $html .= qq!<BR><INPUT TYPE="text" NAME="${selectname}_add">!.
1700 qq!<INPUT TYPE="button" VALUE="Add new group" onClick="${selectname}_doadd(this.form)">!;
1709 The $recref stuff in sub check should be cleaned up.
1711 The suspend, unsuspend and cancel methods update the database, but not the
1712 current object. This is probably a bug as it's unexpected and
1715 radius_usergroup_selector? putting web ui components in here? they should
1716 probably live somewhere else...
1718 insertion of RADIUS group stuff in insert could be done with child_objects now
1719 (would probably clean up export of them too)
1723 L<FS::svc_Common>, edit/part_svc.cgi from an installed web interface,
1724 export.html from the base documentation, L<FS::Record>, L<FS::Conf>,
1725 L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, L<FS::queue>,
1726 L<freeside-queued>), L<FS::svc_acct_pop>,
1727 schema.html from the base documentation.