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 my $global_unique = $conf->config('global_unique-username') || 'none';
906 return '' if $global_unique eq 'disabled';
908 #this is Pg-specific. what to do for mysql etc?
909 # ( mysql LOCK TABLES certainly isn't equivalent or useful here :/ )
910 warn "$me locking svc_acct table for duplicate search" if $DEBUG;
911 dbh->do("LOCK TABLE svc_acct IN SHARE ROW EXCLUSIVE MODE")
913 warn "$me acquired svc_acct table lock for duplicate search" if $DEBUG;
915 my $part_svc = qsearchs('part_svc', { 'svcpart' => $self->svcpart } );
916 unless ( $part_svc ) {
917 return 'unknown svcpart '. $self->svcpart;
920 my @dup_user = grep { !$self->svcnum || $_->svcnum != $self->svcnum }
921 qsearch( 'svc_acct', { 'username' => $self->username } );
922 return gettext('username_in_use')
923 if $global_unique eq 'username' && @dup_user;
925 my @dup_userdomain = grep { !$self->svcnum || $_->svcnum != $self->svcnum }
926 qsearch( 'svc_acct', { 'username' => $self->username,
927 'domsvc' => $self->domsvc } );
928 return gettext('username_in_use')
929 if $global_unique eq 'username@domain' && @dup_userdomain;
932 if ( $part_svc->part_svc_column('uid')->columnflag ne 'F'
933 && $self->username !~ /^(toor|(hyla)?fax)$/ ) {
934 @dup_uid = grep { !$self->svcnum || $_->svcnum != $self->svcnum }
935 qsearch( 'svc_acct', { 'uid' => $self->uid } );
940 if ( @dup_user || @dup_userdomain || @dup_uid ) {
941 my $exports = FS::part_export::export_info('svc_acct');
942 my %conflict_user_svcpart;
943 my %conflict_userdomain_svcpart = ( $self->svcpart => 'SELF', );
945 foreach my $part_export ( $part_svc->part_export ) {
947 #this will catch to the same exact export
948 my @svcparts = map { $_->svcpart } $part_export->export_svc;
950 #this will catch to exports w/same exporthost+type ???
951 #my @other_part_export = qsearch('part_export', {
952 # 'machine' => $part_export->machine,
953 # 'exporttype' => $part_export->exporttype,
955 #foreach my $other_part_export ( @other_part_export ) {
956 # push @svcparts, map { $_->svcpart }
957 # qsearch('export_svc', { 'exportnum' => $part_export->exportnum });
960 #my $nodomain = $exports->{$part_export->exporttype}{'nodomain'};
961 #silly kludge to avoid uninitialized value errors
962 my $nodomain = exists( $exports->{$part_export->exporttype}{'nodomain'} )
963 ? $exports->{$part_export->exporttype}{'nodomain'}
965 if ( $nodomain =~ /^Y/i ) {
966 $conflict_user_svcpart{$_} = $part_export->exportnum
969 $conflict_userdomain_svcpart{$_} = $part_export->exportnum
974 foreach my $dup_user ( @dup_user ) {
975 my $dup_svcpart = $dup_user->cust_svc->svcpart;
976 if ( exists($conflict_user_svcpart{$dup_svcpart}) ) {
977 return "duplicate username: conflicts with svcnum ". $dup_user->svcnum.
978 " via exportnum ". $conflict_user_svcpart{$dup_svcpart};
982 foreach my $dup_userdomain ( @dup_userdomain ) {
983 my $dup_svcpart = $dup_userdomain->cust_svc->svcpart;
984 if ( exists($conflict_userdomain_svcpart{$dup_svcpart}) ) {
985 return "duplicate username\@domain: conflicts with svcnum ".
986 $dup_userdomain->svcnum. " via exportnum ".
987 $conflict_userdomain_svcpart{$dup_svcpart};
991 foreach my $dup_uid ( @dup_uid ) {
992 my $dup_svcpart = $dup_uid->cust_svc->svcpart;
993 if ( exists($conflict_user_svcpart{$dup_svcpart})
994 || exists($conflict_userdomain_svcpart{$dup_svcpart}) ) {
995 return "duplicate uid: conflicts with svcnum ". $dup_uid->svcnum.
996 " via exportnum ". $conflict_user_svcpart{$dup_svcpart}
997 || $conflict_userdomain_svcpart{$dup_svcpart};
1009 Depriciated, use radius_reply instead.
1014 carp "FS::svc_acct::radius depriciated, use radius_reply";
1015 $_[0]->radius_reply;
1020 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
1021 reply attributes of this record.
1023 Note that this is now the preferred method for reading RADIUS attributes -
1024 accessing the columns directly is discouraged, as the column names are
1025 expected to change in the future.
1032 return %{ $self->{'radius_reply'} }
1033 if exists $self->{'radius_reply'};
1038 my($column, $attrib) = ($1, $2);
1039 #$attrib =~ s/_/\-/g;
1040 ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
1041 } grep { /^radius_/ && $self->getfield($_) } fields( $self->table );
1043 if ( $self->slipip && $self->slipip ne '0e0' ) {
1044 $reply{$radius_ip} = $self->slipip;
1047 if ( $self->seconds !~ /^$/ ) {
1048 $reply{'Session-Timeout'} = $self->seconds;
1056 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
1057 check attributes of this record.
1059 Note that this is now the preferred method for reading RADIUS attributes -
1060 accessing the columns directly is discouraged, as the column names are
1061 expected to change in the future.
1068 return %{ $self->{'radius_check'} }
1069 if exists $self->{'radius_check'};
1074 my($column, $attrib) = ($1, $2);
1075 #$attrib =~ s/_/\-/g;
1076 ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
1077 } grep { /^rc_/ && $self->getfield($_) } fields( $self->table );
1079 my $password = $self->_password;
1080 my $pw_attrib = length($password) <= 12 ? $radius_password : 'Crypt-Password'; $check{$pw_attrib} = $password;
1082 my $cust_svc = $self->cust_svc;
1083 die "FATAL: no cust_svc record for svc_acct.svcnum ". $self->svcnum. "\n"
1085 my $cust_pkg = $cust_svc->cust_pkg;
1086 if ( $cust_pkg && $cust_pkg->part_pkg->is_prepaid && $cust_pkg->bill ) {
1087 $check{'Expiration'} = time2str('%B %e %Y %T', $cust_pkg->bill ); #http://lists.cistron.nl/pipermail/freeradius-users/2005-January/040184.html
1096 This method instructs the object to "snapshot" or freeze RADIUS check and
1097 reply attributes to the current values.
1101 #bah, my english is too broken this morning
1102 #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
1103 #the FS::cust_pkg's replace method to trigger the correct export updates when
1104 #package dates change)
1109 $self->{$_} = { $self->$_() }
1110 foreach qw( radius_reply radius_check );
1114 =item forget_snapshot
1116 This methos instructs the object to forget any previously snapshotted
1117 RADIUS check and reply attributes.
1121 sub forget_snapshot {
1125 foreach qw( radius_reply radius_check );
1131 Returns the domain associated with this account.
1137 die "svc_acct.domsvc is null for svcnum ". $self->svcnum unless $self->domsvc;
1138 my $svc_domain = $self->svc_domain(@_)
1139 or die "no svc_domain.svcnum for svc_acct.domsvc ". $self->domsvc;
1140 $svc_domain->domain;
1145 Returns the FS::svc_domain record for this account's domain (see
1153 ? $self->{'_domsvc'}
1154 : qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } );
1159 Returns the FS::cust_svc record for this account (see L<FS::cust_svc>).
1163 #inherited from svc_Common
1167 Returns an email address associated with the account.
1173 $self->username. '@'. $self->domain(@_);
1178 Returns an array of FS::acct_snarf records associated with the account.
1179 If the acct_snarf table does not exist or there are no associated records,
1180 an empty list is returned
1186 return () unless dbdef->table('acct_snarf');
1187 eval "use FS::acct_snarf;";
1189 qsearch('acct_snarf', { 'svcnum' => $self->svcnum } );
1192 =item decrement_seconds SECONDS
1194 Decrements the I<seconds> field of this record by the given amount. If there
1195 is an error, returns the error, otherwise returns false.
1199 sub decrement_seconds {
1200 shift->_op_seconds('-', @_);
1203 =item increment_seconds SECONDS
1205 Increments the I<seconds> field of this record by the given amount. If there
1206 is an error, returns the error, otherwise returns false.
1210 sub increment_seconds {
1211 shift->_op_seconds('+', @_);
1219 my %op2condition = (
1220 '-' => sub { my($self, $seconds) = @_;
1221 $self->seconds - $seconds <= 0;
1223 '+' => sub { my($self, $seconds) = @_;
1224 $self->seconds + $seconds > 0;
1229 my( $self, $op, $seconds ) = @_;
1230 warn "$me _op_seconds called for svcnum ". $self->svcnum.
1231 ' ('. $self->email. "): $op $seconds\n"
1234 local $SIG{HUP} = 'IGNORE';
1235 local $SIG{INT} = 'IGNORE';
1236 local $SIG{QUIT} = 'IGNORE';
1237 local $SIG{TERM} = 'IGNORE';
1238 local $SIG{TSTP} = 'IGNORE';
1239 local $SIG{PIPE} = 'IGNORE';
1241 my $oldAutoCommit = $FS::UID::AutoCommit;
1242 local $FS::UID::AutoCommit = 0;
1245 my $sql = "UPDATE svc_acct SET seconds = ".
1246 " CASE WHEN seconds IS NULL THEN 0 ELSE seconds END ". #$seconds||0
1247 " $op ? WHERE svcnum = ?";
1251 my $sth = $dbh->prepare( $sql )
1252 or die "Error preparing $sql: ". $dbh->errstr;
1253 my $rv = $sth->execute($seconds, $self->svcnum);
1254 die "Error executing $sql: ". $sth->errstr
1255 unless defined($rv);
1256 die "Can't update seconds for svcnum". $self->svcnum
1259 my $action = $op2action{$op};
1261 if ( $conf->exists("svc_acct-usage_$action")
1262 && &{$op2condition{$op}}($self, $seconds) ) {
1263 #my $error = $self->$action();
1264 my $error = $self->cust_svc->cust_pkg->$action();
1266 $dbh->rollback if $oldAutoCommit;
1267 return "Error ${action}ing: $error";
1271 warn "$me update successful; committing\n"
1273 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1279 =item seconds_since TIMESTAMP
1281 Returns the number of seconds this account has been online since TIMESTAMP,
1282 according to the session monitor (see L<FS::Session>).
1284 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
1285 L<Time::Local> and L<Date::Parse> for conversion functions.
1289 #note: POD here, implementation in FS::cust_svc
1292 $self->cust_svc->seconds_since(@_);
1295 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
1297 Returns the numbers of seconds this account has been online between
1298 TIMESTAMP_START (inclusive) and TIMESTAMP_END (exclusive), according to an
1299 external SQL radacct table, specified via sqlradius export. Sessions which
1300 started in the specified range but are still open are counted from session
1301 start to the end of the range (unless they are over 1 day old, in which case
1302 they are presumed missing their stop record and not counted). Also, sessions
1303 which end in the range but started earlier are counted from the start of the
1304 range to session end. Finally, sessions which start before the range but end
1305 after are counted for the entire range.
1307 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1308 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
1313 #note: POD here, implementation in FS::cust_svc
1314 sub seconds_since_sqlradacct {
1316 $self->cust_svc->seconds_since_sqlradacct(@_);
1319 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
1321 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
1322 in this package for sessions ending between TIMESTAMP_START (inclusive) and
1323 TIMESTAMP_END (exclusive).
1325 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1326 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
1331 #note: POD here, implementation in FS::cust_svc
1332 sub attribute_since_sqlradacct {
1334 $self->cust_svc->attribute_since_sqlradacct(@_);
1337 =item get_session_history TIMESTAMP_START TIMESTAMP_END
1339 Returns an array of hash references of this customers login history for the
1340 given time range. (document this better)
1344 sub get_session_history {
1346 $self->cust_svc->get_session_history(@_);
1349 =item get_cdrs TIMESTAMP_START TIMESTAMP_END [ 'OPTION' => 'VALUE ... ]
1354 my($self, $start, $end, %opt ) = @_;
1356 my $did = $self->username; #yup
1358 my $prefix = $opt{'default_prefix'}; #convergent.au '+61'
1360 my $for_update = $opt{'for_update'} ? 'FOR UPDATE' : '';
1362 #SELECT $for_update * FROM cdr
1363 # WHERE calldate >= $start #need a conversion
1364 # AND calldate < $end #ditto
1365 # AND ( charged_party = "$did"
1366 # OR charged_party = "$prefix$did" #if length($prefix);
1367 # OR ( ( charged_party IS NULL OR charged_party = '' )
1369 # ( src = "$did" OR src = "$prefix$did" ) # if length($prefix)
1372 # AND ( freesidestatus IS NULL OR freesidestatus = '' )
1375 if ( length($prefix) ) {
1377 " AND ( charged_party = '$did'
1378 OR charged_party = '$prefix$did'
1379 OR ( ( charged_party IS NULL OR charged_party = '' )
1381 ( src = '$did' OR src = '$prefix$did' )
1387 " AND ( charged_party = '$did'
1388 OR ( ( charged_party IS NULL OR charged_party = '' )
1398 'select' => "$for_update *",
1401 #( freesidestatus IS NULL OR freesidestatus = '' )
1402 'freesidestatus' => '',
1404 'extra_sql' => $charged_or_src,
1412 Returns all RADIUS groups for this account (see L<FS::radius_usergroup>).
1418 if ( $self->usergroup ) {
1419 #when provisioning records, export callback runs in svc_Common.pm before
1420 #radius_usergroup records can be inserted...
1421 @{$self->usergroup};
1423 map { $_->groupname }
1424 qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } );
1428 =item clone_suspended
1430 Constructor used by FS::part_export::_export_suspend fallback. Document
1435 sub clone_suspended {
1437 my %hash = $self->hash;
1438 $hash{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) );
1439 new FS::svc_acct \%hash;
1442 =item clone_kludge_unsuspend
1444 Constructor used by FS::part_export::_export_unsuspend fallback. Document
1449 sub clone_kludge_unsuspend {
1451 my %hash = $self->hash;
1452 $hash{_password} = '';
1453 new FS::svc_acct \%hash;
1456 =item check_password
1458 Checks the supplied password against the (possibly encrypted) password in the
1459 database. Returns true for a successful authentication, false for no match.
1461 Currently supported encryptions are: classic DES crypt() and MD5
1465 sub check_password {
1466 my($self, $check_password) = @_;
1468 #remove old-style SUSPENDED kludge, they should be allowed to login to
1469 #self-service and pay up
1470 ( my $password = $self->_password ) =~ s/^\*SUSPENDED\* //;
1472 #eventually should check a "password-encoding" field
1473 if ( $password =~ /^(\*|!!?)$/ ) { #no self-service login
1475 } elsif ( length($password) < 13 ) { #plaintext
1476 $check_password eq $password;
1477 } elsif ( length($password) == 13 ) { #traditional DES crypt
1478 crypt($check_password, $password) eq $password;
1479 } elsif ( $password =~ /^\$1\$/ ) { #MD5 crypt
1480 unix_md5_crypt($check_password, $password) eq $password;
1481 } elsif ( $password =~ /^\$2a?\$/ ) { #Blowfish
1482 warn "Can't check password: Blowfish encryption not yet supported, svcnum".
1483 $self->svcnum. "\n";
1486 warn "Can't check password: Unrecognized encryption for svcnum ".
1487 $self->svcnum. "\n";
1493 =item crypt_password [ DEFAULT_ENCRYPTION_TYPE ]
1495 Returns an encrypted password, either by passing through an encrypted password
1496 in the database or by encrypting a plaintext password from the database.
1498 The optional DEFAULT_ENCRYPTION_TYPE parameter can be set to I<crypt> (classic
1499 UNIX DES crypt), I<md5> (md5 crypt supported by most modern Linux and BSD
1500 distrubtions), or (eventually) I<blowfish> (blowfish hashing supported by
1501 OpenBSD, SuSE, other Linux distibutions with pam_unix2, etc.). The default
1502 encryption type is only used if the password is not already encrypted in the
1507 sub crypt_password {
1509 #eventually should check a "password-encoding" field
1510 if ( length($self->_password) == 13
1511 || $self->_password =~ /^\$(1|2a?)\$/
1512 || $self->_password =~ /^(\*|NP|\*LK\*|!!?)$/
1517 my $encryption = ( scalar(@_) && $_[0] ) ? shift : 'crypt';
1518 if ( $encryption eq 'crypt' ) {
1521 $saltset[int(rand(64))].$saltset[int(rand(64))]
1523 } elsif ( $encryption eq 'md5' ) {
1524 unix_md5_crypt( $self->_password );
1525 } elsif ( $encryption eq 'blowfish' ) {
1526 die "unknown encryption method $encryption";
1528 die "unknown encryption method $encryption";
1533 =item virtual_maildir
1535 Returns $domain/maildirs/$username/
1539 sub virtual_maildir {
1541 $self->domain. '/maildirs/'. $self->username. '/';
1552 This is the FS::svc_acct job-queue-able version. It still uses
1553 FS::Misc::send_email under-the-hood.
1560 eval "use FS::Misc qw(send_email)";
1563 $opt{mimetype} ||= 'text/plain';
1564 $opt{mimetype} .= '; charset="iso-8859-1"' unless $opt{mimetype} =~ /charset/;
1566 my $error = send_email(
1567 'from' => $opt{from},
1569 'subject' => $opt{subject},
1570 'content-type' => $opt{mimetype},
1571 'body' => [ map "$_\n", split("\n", $opt{body}) ],
1573 die $error if $error;
1576 =item check_and_rebuild_fuzzyfiles
1580 sub check_and_rebuild_fuzzyfiles {
1581 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1582 -e "$dir/svc_acct.username"
1583 or &rebuild_fuzzyfiles;
1586 =item rebuild_fuzzyfiles
1590 sub rebuild_fuzzyfiles {
1592 use Fcntl qw(:flock);
1594 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1598 open(USERNAMELOCK,">>$dir/svc_acct.username")
1599 or die "can't open $dir/svc_acct.username: $!";
1600 flock(USERNAMELOCK,LOCK_EX)
1601 or die "can't lock $dir/svc_acct.username: $!";
1603 my @all_username = map $_->getfield('username'), qsearch('svc_acct', {});
1605 open (USERNAMECACHE,">$dir/svc_acct.username.tmp")
1606 or die "can't open $dir/svc_acct.username.tmp: $!";
1607 print USERNAMECACHE join("\n", @all_username), "\n";
1608 close USERNAMECACHE or die "can't close $dir/svc_acct.username.tmp: $!";
1610 rename "$dir/svc_acct.username.tmp", "$dir/svc_acct.username";
1620 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1621 open(USERNAMECACHE,"<$dir/svc_acct.username")
1622 or die "can't open $dir/svc_acct.username: $!";
1623 my @array = map { chomp; $_; } <USERNAMECACHE>;
1624 close USERNAMECACHE;
1628 =item append_fuzzyfiles USERNAME
1632 sub append_fuzzyfiles {
1633 my $username = shift;
1635 &check_and_rebuild_fuzzyfiles;
1637 use Fcntl qw(:flock);
1639 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1641 open(USERNAME,">>$dir/svc_acct.username")
1642 or die "can't open $dir/svc_acct.username: $!";
1643 flock(USERNAME,LOCK_EX)
1644 or die "can't lock $dir/svc_acct.username: $!";
1646 print USERNAME "$username\n";
1648 flock(USERNAME,LOCK_UN)
1649 or die "can't unlock $dir/svc_acct.username: $!";
1657 =item radius_usergroup_selector GROUPS_ARRAYREF [ SELECTNAME ]
1661 sub radius_usergroup_selector {
1662 my $sel_groups = shift;
1663 my %sel_groups = map { $_=>1 } @$sel_groups;
1665 my $selectname = shift || 'radius_usergroup';
1668 my $sth = $dbh->prepare(
1669 'SELECT DISTINCT(groupname) FROM radius_usergroup ORDER BY groupname'
1670 ) or die $dbh->errstr;
1671 $sth->execute() or die $sth->errstr;
1672 my @all_groups = map { $_->[0] } @{$sth->fetchall_arrayref};
1676 function ${selectname}_doadd(object) {
1677 var myvalue = object.${selectname}_add.value;
1678 var optionName = new Option(myvalue,myvalue,false,true);
1679 var length = object.$selectname.length;
1680 object.$selectname.options[length] = optionName;
1681 object.${selectname}_add.value = "";
1684 <SELECT MULTIPLE NAME="$selectname">
1687 foreach my $group ( @all_groups ) {
1688 $html .= qq(<OPTION VALUE="$group");
1689 if ( $sel_groups{$group} ) {
1690 $html .= ' SELECTED';
1691 $sel_groups{$group} = 0;
1693 $html .= ">$group</OPTION>\n";
1695 foreach my $group ( grep { $sel_groups{$_} } keys %sel_groups ) {
1696 $html .= qq(<OPTION VALUE="$group" SELECTED>$group</OPTION>\n);
1698 $html .= '</SELECT>';
1700 $html .= qq!<BR><INPUT TYPE="text" NAME="${selectname}_add">!.
1701 qq!<INPUT TYPE="button" VALUE="Add new group" onClick="${selectname}_doadd(this.form)">!;
1710 The $recref stuff in sub check should be cleaned up.
1712 The suspend, unsuspend and cancel methods update the database, but not the
1713 current object. This is probably a bug as it's unexpected and
1716 radius_usergroup_selector? putting web ui components in here? they should
1717 probably live somewhere else...
1719 insertion of RADIUS group stuff in insert could be done with child_objects now
1720 (would probably clean up export of them too)
1724 L<FS::svc_Common>, edit/part_svc.cgi from an installed web interface,
1725 export.html from the base documentation, L<FS::Record>, L<FS::Conf>,
1726 L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, L<FS::queue>,
1727 L<freeside-queued>), L<FS::svc_acct_pop>,
1728 schema.html from the base documentation.