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;
21 use FS::UID qw( datasrc );
23 use FS::Record qw( qsearch qsearchs fields dbh dbdef );
24 use FS::Msgcat qw(gettext);
29 use FS::cust_main_invoice;
33 use FS::radius_usergroup;
40 @ISA = qw( FS::svc_Common );
43 $me = '[FS::svc_acct]';
45 #ask FS::UID to run this stuff for us later
46 $FS::UID::callback{'FS::svc_acct'} = sub {
48 $dir_prefix = $conf->config('home');
49 @shells = $conf->config('shells');
50 $usernamemin = $conf->config('usernamemin') || 2;
51 $usernamemax = $conf->config('usernamemax');
52 $passwordmin = $conf->config('passwordmin') || 6;
53 $passwordmax = $conf->config('passwordmax') || 8;
54 $username_letter = $conf->exists('username-letter');
55 $username_letterfirst = $conf->exists('username-letterfirst');
56 $username_noperiod = $conf->exists('username-noperiod');
57 $username_nounderscore = $conf->exists('username-nounderscore');
58 $username_nodash = $conf->exists('username-nodash');
59 $username_uppercase = $conf->exists('username-uppercase');
60 $username_ampersand = $conf->exists('username-ampersand');
61 $username_percent = $conf->exists('username-percent');
62 $password_noampersand = $conf->exists('password-noexclamation');
63 $password_noexclamation = $conf->exists('password-noexclamation');
64 $dirhash = $conf->config('dirhash') || 0;
65 if ( $conf->exists('welcome_email') ) {
66 $welcome_template = new Text::Template (
68 SOURCE => [ map "$_\n", $conf->config('welcome_email') ]
69 ) or warn "can't create welcome email template: $Text::Template::ERROR";
70 $welcome_from = $conf->config('welcome_email-from'); # || 'your-isp-is-dum'
71 $welcome_subject = $conf->config('welcome_email-subject') || 'Welcome';
72 $welcome_mimetype = $conf->config('welcome_email-mimetype') || 'text/plain';
74 $welcome_template = '';
76 $welcome_subject = '';
77 $welcome_mimetype = '';
79 $smtpmachine = $conf->config('smtpmachine');
80 $radius_password = $conf->config('radius-password') || 'Password';
81 $radius_ip = $conf->config('radius-ip') || 'Framed-IP-Address';
84 @saltset = ( 'a'..'z' , 'A'..'Z' , '0'..'9' , '.' , '/' );
85 @pw_set = ( 'a'..'z', 'A'..'Z', '0'..'9', '(', ')', '#', '!', '.', ',' );
89 my ( $hashref, $cache ) = @_;
90 if ( $hashref->{'svc_acct_svcnum'} ) {
91 $self->{'_domsvc'} = FS::svc_domain->new( {
92 'svcnum' => $hashref->{'domsvc'},
93 'domain' => $hashref->{'svc_acct_domain'},
94 'catchall' => $hashref->{'svc_acct_catchall'},
101 FS::svc_acct - Object methods for svc_acct records
107 $record = new FS::svc_acct \%hash;
108 $record = new FS::svc_acct { 'column' => 'value' };
110 $error = $record->insert;
112 $error = $new_record->replace($old_record);
114 $error = $record->delete;
116 $error = $record->check;
118 $error = $record->suspend;
120 $error = $record->unsuspend;
122 $error = $record->cancel;
124 %hash = $record->radius;
126 %hash = $record->radius_reply;
128 %hash = $record->radius_check;
130 $domain = $record->domain;
132 $svc_domain = $record->svc_domain;
134 $email = $record->email;
136 $seconds_since = $record->seconds_since($timestamp);
140 An FS::svc_acct object represents an account. FS::svc_acct inherits from
141 FS::svc_Common. The following fields are currently supported:
145 =item svcnum - primary key (assigned automatcially for new accounts)
149 =item _password - generated if blank
151 =item sec_phrase - security phrase
153 =item popnum - Point of presence (see L<FS::svc_acct_pop>)
161 =item dir - set automatically if blank (and uid is not)
165 =item quota - (unimplementd)
167 =item slipip - IP address
171 =item domsvc - svcnum from svc_domain
173 =item radius_I<Radius_Attribute> - I<Radius-Attribute> (reply)
175 =item rc_I<Radius_Attribute> - I<Radius-Attribute> (check)
185 Creates a new account. To add the account to the database, see L<"insert">.
189 sub table { 'svc_acct'; }
191 =item insert [ , OPTION => VALUE ... ]
193 Adds this account to the database. If there is an error, returns the error,
194 otherwise returns false.
196 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
197 defined. An FS::cust_svc record will be created and inserted.
199 The additional field I<usergroup> can optionally be defined; if so it should
200 contain an arrayref of group names. See L<FS::radius_usergroup>.
202 The additional field I<child_objects> can optionally be defined; if so it
203 should contain an arrayref of FS::tablename objects. They will have their
204 svcnum fields set and will be inserted after this record, but before any
205 exports are run. Each element of the array can also optionally be a
206 two-element array reference containing the child object and the name of an
207 alternate field to be filled in with the newly-inserted svcnum, for example
208 C<[ $svc_forward, 'srcsvc' ]>
210 Currently available options are: I<depend_jobnum>
212 If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
213 jobnums), all provisioning jobs will have a dependancy on the supplied
214 jobnum(s) (they will not run until the specific job(s) complete(s)).
216 (TODOC: L<FS::queue> and L<freeside-queued>)
218 (TODOC: new exports!)
227 warn "[$me] insert called on $self: ". Dumper($self).
228 "\nwith options: ". Dumper(%options);
231 local $SIG{HUP} = 'IGNORE';
232 local $SIG{INT} = 'IGNORE';
233 local $SIG{QUIT} = 'IGNORE';
234 local $SIG{TERM} = 'IGNORE';
235 local $SIG{TSTP} = 'IGNORE';
236 local $SIG{PIPE} = 'IGNORE';
238 my $oldAutoCommit = $FS::UID::AutoCommit;
239 local $FS::UID::AutoCommit = 0;
242 my $error = $self->check;
243 return $error if $error;
245 if ( $self->svcnum && qsearchs('cust_svc',{'svcnum'=>$self->svcnum}) ) {
246 my $cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum});
247 unless ( $cust_svc ) {
248 $dbh->rollback if $oldAutoCommit;
249 return "no cust_svc record found for svcnum ". $self->svcnum;
251 $self->pkgnum($cust_svc->pkgnum);
252 $self->svcpart($cust_svc->svcpart);
255 $error = $self->_check_duplicate;
257 $dbh->rollback if $oldAutoCommit;
262 $error = $self->SUPER::insert(
263 'jobnums' => \@jobnums,
264 'child_objects' => $self->child_objects,
268 $dbh->rollback if $oldAutoCommit;
272 if ( $self->usergroup ) {
273 foreach my $groupname ( @{$self->usergroup} ) {
274 my $radius_usergroup = new FS::radius_usergroup ( {
275 svcnum => $self->svcnum,
276 groupname => $groupname,
278 my $error = $radius_usergroup->insert;
280 $dbh->rollback if $oldAutoCommit;
286 unless ( $skip_fuzzyfiles ) {
287 $error = $self->queue_fuzzyfiles_update;
289 $dbh->rollback if $oldAutoCommit;
290 return "updating fuzzy search cache: $error";
294 my $cust_pkg = $self->cust_svc->cust_pkg;
297 my $cust_main = $cust_pkg->cust_main;
299 if ( $conf->exists('emailinvoiceauto') ) {
300 my @invoicing_list = $cust_main->invoicing_list;
301 push @invoicing_list, $self->email;
302 $cust_main->invoicing_list(\@invoicing_list);
307 if ( $welcome_template && $cust_pkg ) {
308 my $to = join(', ', grep { $_ !~ /^(POST|FAX)$/ } $cust_main->invoicing_list );
310 my $wqueue = new FS::queue {
311 'svcnum' => $self->svcnum,
312 'job' => 'FS::svc_acct::send_email'
314 my $error = $wqueue->insert(
316 'from' => $welcome_from,
317 'subject' => $welcome_subject,
318 'mimetype' => $welcome_mimetype,
319 'body' => $welcome_template->fill_in( HASH => {
320 'custnum' => $self->custnum,
321 'username' => $self->username,
322 'password' => $self->_password,
323 'first' => $cust_main->first,
324 'last' => $cust_main->getfield('last'),
325 'pkg' => $cust_pkg->part_pkg->pkg,
329 $dbh->rollback if $oldAutoCommit;
330 return "error queuing welcome email: $error";
333 if ( $options{'depend_jobnum'} ) {
334 warn "$me depend_jobnum found; adding to welcome email dependancies"
336 if ( ref($options{'depend_jobnum'}) ) {
337 warn "$me adding jobs ". join(', ', @{$options{'depend_jobnum'}} ).
338 "to welcome email dependancies"
340 push @jobnums, @{ $options{'depend_jobnum'} };
342 warn "$me adding job $options{'depend_jobnum'} ".
343 "to welcome email dependancies"
345 push @jobnums, $options{'depend_jobnum'};
349 foreach my $jobnum ( @jobnums ) {
350 my $error = $wqueue->depend_insert($jobnum);
352 $dbh->rollback if $oldAutoCommit;
353 return "error queuing welcome email job dependancy: $error";
363 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
369 Deletes this account from the database. If there is an error, returns the
370 error, otherwise returns false.
372 The corresponding FS::cust_svc record will be deleted as well.
374 (TODOC: new exports!)
381 return "can't delete system account" if $self->_check_system;
383 return "Can't delete an account which is a (svc_forward) source!"
384 if qsearch( 'svc_forward', { 'srcsvc' => $self->svcnum } );
386 return "Can't delete an account which is a (svc_forward) destination!"
387 if qsearch( 'svc_forward', { 'dstsvc' => $self->svcnum } );
389 return "Can't delete an account with (svc_www) web service!"
390 if qsearch( 'svc_www', { 'usersvc' => $self->svcnum } );
392 # what about records in session ? (they should refer to history table)
394 local $SIG{HUP} = 'IGNORE';
395 local $SIG{INT} = 'IGNORE';
396 local $SIG{QUIT} = 'IGNORE';
397 local $SIG{TERM} = 'IGNORE';
398 local $SIG{TSTP} = 'IGNORE';
399 local $SIG{PIPE} = 'IGNORE';
401 my $oldAutoCommit = $FS::UID::AutoCommit;
402 local $FS::UID::AutoCommit = 0;
405 foreach my $cust_main_invoice (
406 qsearch( 'cust_main_invoice', { 'dest' => $self->svcnum } )
408 unless ( defined($cust_main_invoice) ) {
409 warn "WARNING: something's wrong with qsearch";
412 my %hash = $cust_main_invoice->hash;
413 $hash{'dest'} = $self->email;
414 my $new = new FS::cust_main_invoice \%hash;
415 my $error = $new->replace($cust_main_invoice);
417 $dbh->rollback if $oldAutoCommit;
422 foreach my $svc_domain (
423 qsearch( 'svc_domain', { 'catchall' => $self->svcnum } )
425 my %hash = new FS::svc_domain->hash;
426 $hash{'catchall'} = '';
427 my $new = new FS::svc_domain \%hash;
428 my $error = $new->replace($svc_domain);
430 $dbh->rollback if $oldAutoCommit;
435 foreach my $radius_usergroup (
436 qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } )
438 my $error = $radius_usergroup->delete;
440 $dbh->rollback if $oldAutoCommit;
445 my $error = $self->SUPER::delete;
447 $dbh->rollback if $oldAutoCommit;
451 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
455 =item replace OLD_RECORD
457 Replaces OLD_RECORD with this one in the database. If there is an error,
458 returns the error, otherwise returns false.
460 The additional field I<usergroup> can optionally be defined; if so it should
461 contain an arrayref of group names. See L<FS::radius_usergroup>.
467 my ( $new, $old ) = ( shift, shift );
469 warn "$me replacing $old with $new\n" if $DEBUG;
471 return "can't modify system account" if $old->_check_system;
474 #no warnings 'numeric'; #alas, a 5.006-ism
477 foreach my $xid (qw( uid gid )) {
479 return "Can't change $xid!"
480 if ! $conf->exists("svc_acct-edit_$xid")
481 && $old->$xid() != $new->$xid()
482 && $new->cust_svc->part_svc->part_svc_column($xid)->columnflag ne 'F'
487 #change homdir when we change username
488 $new->setfield('dir', '') if $old->username ne $new->username;
490 local $SIG{HUP} = 'IGNORE';
491 local $SIG{INT} = 'IGNORE';
492 local $SIG{QUIT} = 'IGNORE';
493 local $SIG{TERM} = 'IGNORE';
494 local $SIG{TSTP} = 'IGNORE';
495 local $SIG{PIPE} = 'IGNORE';
497 my $oldAutoCommit = $FS::UID::AutoCommit;
498 local $FS::UID::AutoCommit = 0;
501 # redundant, but so $new->usergroup gets set
502 $error = $new->check;
503 return $error if $error;
505 $old->usergroup( [ $old->radius_groups ] );
507 warn $old->email. " old groups: ". join(' ',@{$old->usergroup}). "\n";
508 warn $new->email. "new groups: ". join(' ',@{$new->usergroup}). "\n";
510 if ( $new->usergroup ) {
511 #(sorta) false laziness with FS::part_export::sqlradius::_export_replace
512 my @newgroups = @{$new->usergroup};
513 foreach my $oldgroup ( @{$old->usergroup} ) {
514 if ( grep { $oldgroup eq $_ } @newgroups ) {
515 @newgroups = grep { $oldgroup ne $_ } @newgroups;
518 my $radius_usergroup = qsearchs('radius_usergroup', {
519 svcnum => $old->svcnum,
520 groupname => $oldgroup,
522 my $error = $radius_usergroup->delete;
524 $dbh->rollback if $oldAutoCommit;
525 return "error deleting radius_usergroup $oldgroup: $error";
529 foreach my $newgroup ( @newgroups ) {
530 my $radius_usergroup = new FS::radius_usergroup ( {
531 svcnum => $new->svcnum,
532 groupname => $newgroup,
534 my $error = $radius_usergroup->insert;
536 $dbh->rollback if $oldAutoCommit;
537 return "error adding radius_usergroup $newgroup: $error";
543 if ( $old->username ne $new->username || $old->domsvc != $new->domsvc ) {
544 $new->svcpart( $new->cust_svc->svcpart ) unless $new->svcpart;
545 $error = $new->_check_duplicate;
547 $dbh->rollback if $oldAutoCommit;
552 $error = $new->SUPER::replace($old);
554 $dbh->rollback if $oldAutoCommit;
555 return $error if $error;
558 if ( $new->username ne $old->username && ! $skip_fuzzyfiles ) {
559 $error = $new->queue_fuzzyfiles_update;
561 $dbh->rollback if $oldAutoCommit;
562 return "updating fuzzy search cache: $error";
566 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
570 =item queue_fuzzyfiles_update
572 Used by insert & replace to update the fuzzy search cache
576 sub queue_fuzzyfiles_update {
579 local $SIG{HUP} = 'IGNORE';
580 local $SIG{INT} = 'IGNORE';
581 local $SIG{QUIT} = 'IGNORE';
582 local $SIG{TERM} = 'IGNORE';
583 local $SIG{TSTP} = 'IGNORE';
584 local $SIG{PIPE} = 'IGNORE';
586 my $oldAutoCommit = $FS::UID::AutoCommit;
587 local $FS::UID::AutoCommit = 0;
590 my $queue = new FS::queue {
591 'svcnum' => $self->svcnum,
592 'job' => 'FS::svc_acct::append_fuzzyfiles'
594 my $error = $queue->insert($self->username);
596 $dbh->rollback if $oldAutoCommit;
597 return "queueing job (transaction rolled back): $error";
600 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
608 Suspends this account by calling export-specific suspend hooks. If there is
609 an error, returns the error, otherwise returns false.
611 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
617 return "can't suspend system account" if $self->_check_system;
618 $self->SUPER::suspend;
623 Unsuspends this account by by calling export-specific suspend hooks. If there
624 is an error, returns the error, otherwise returns false.
626 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
632 my %hash = $self->hash;
633 if ( $hash{_password} =~ /^\*SUSPENDED\* (.*)$/ ) {
634 $hash{_password} = $1;
635 my $new = new FS::svc_acct ( \%hash );
636 my $error = $new->replace($self);
637 return $error if $error;
640 $self->SUPER::unsuspend;
645 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
647 If the B<auto_unset_catchall> configuration option is set, this method will
648 automatically remove any references to the canceled service in the catchall
649 field of svc_domain. This allows packages that contain both a svc_domain and
650 its catchall svc_acct to be canceled in one step.
655 # Only one thing to do at this level
657 foreach my $svc_domain (
658 qsearch( 'svc_domain', { catchall => $self->svcnum } ) ) {
659 if($conf->exists('auto_unset_catchall')) {
660 my %hash = $svc_domain->hash;
661 $hash{catchall} = '';
662 my $new = new FS::svc_domain ( \%hash );
663 my $error = $new->replace($svc_domain);
664 return $error if $error;
666 return "cannot unprovision svc_acct #".$self->svcnum.
667 " while assigned as catchall for svc_domain #".$svc_domain->svcnum;
671 $self->SUPER::cancel;
677 Checks all fields to make sure this is a valid service. If there is an error,
678 returns the error, otherwise returns false. Called by the insert and replace
681 Sets any fixed values; see L<FS::part_svc>.
688 my($recref) = $self->hashref;
690 my $x = $self->setfixed;
691 return $x unless ref($x);
694 if ( $part_svc->part_svc_column('usergroup')->columnflag eq "F" ) {
696 [ split(',', $part_svc->part_svc_column('usergroup')->columnvalue) ] );
699 my $error = $self->ut_numbern('svcnum')
700 #|| $self->ut_number('domsvc')
701 || $self->ut_foreign_key('domsvc', 'svc_domain', 'svcnum' )
702 || $self->ut_textn('sec_phrase')
704 return $error if $error;
706 my $ulen = $usernamemax || $self->dbdef_table->column('username')->length;
707 if ( $username_uppercase ) {
708 $recref->{username} =~ /^([a-z0-9_\-\.\&\%]{$usernamemin,$ulen})$/i
709 or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username};
710 $recref->{username} = $1;
712 $recref->{username} =~ /^([a-z0-9_\-\.\&\%]{$usernamemin,$ulen})$/
713 or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username};
714 $recref->{username} = $1;
717 if ( $username_letterfirst ) {
718 $recref->{username} =~ /^[a-z]/ or return gettext('illegal_username');
719 } elsif ( $username_letter ) {
720 $recref->{username} =~ /[a-z]/ or return gettext('illegal_username');
722 if ( $username_noperiod ) {
723 $recref->{username} =~ /\./ and return gettext('illegal_username');
725 if ( $username_nounderscore ) {
726 $recref->{username} =~ /_/ and return gettext('illegal_username');
728 if ( $username_nodash ) {
729 $recref->{username} =~ /\-/ and return gettext('illegal_username');
731 unless ( $username_ampersand ) {
732 $recref->{username} =~ /\&/ and return gettext('illegal_username');
734 if ( $password_noampersand ) {
735 $recref->{_password} =~ /\&/ and return gettext('illegal_password');
737 if ( $password_noexclamation ) {
738 $recref->{_password} =~ /\!/ and return gettext('illegal_password');
740 unless ( $username_percent ) {
741 $recref->{username} =~ /\%/ and return gettext('illegal_username');
744 $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum};
745 $recref->{popnum} = $1;
746 return "Unknown popnum" unless
747 ! $recref->{popnum} ||
748 qsearchs('svc_acct_pop',{'popnum'=> $recref->{popnum} } );
750 unless ( $part_svc->part_svc_column('uid')->columnflag eq 'F' ) {
752 $recref->{uid} =~ /^(\d*)$/ or return "Illegal uid";
753 $recref->{uid} = $1 eq '' ? $self->unique('uid') : $1;
755 $recref->{gid} =~ /^(\d*)$/ or return "Illegal gid";
756 $recref->{gid} = $1 eq '' ? $recref->{uid} : $1;
757 #not all systems use gid=uid
758 #you can set a fixed gid in part_svc
760 return "Only root can have uid 0"
761 if $recref->{uid} == 0
762 && $recref->{username} !~ /^(root|toor|smtp)$/;
764 unless ( $recref->{username} eq 'sync' ) {
765 if ( grep $_ eq $recref->{shell}, @shells ) {
766 $recref->{shell} = (grep $_ eq $recref->{shell}, @shells)[0];
768 return "Illegal shell \`". $self->shell. "\'; ".
769 $conf->dir. "/shells contains: @shells";
772 $recref->{shell} = '/bin/sync';
776 $recref->{gid} ne '' ?
777 return "Can't have gid without uid" : ( $recref->{gid}='' );
778 #$recref->{dir} ne '' ?
779 # return "Can't have directory without uid" : ( $recref->{dir}='' );
780 $recref->{shell} ne '' ?
781 return "Can't have shell without uid" : ( $recref->{shell}='' );
784 unless ( $part_svc->part_svc_column('dir')->columnflag eq 'F' ) {
786 $recref->{dir} =~ /^([\/\w\-\.\&]*)$/
787 or return "Illegal directory: ". $recref->{dir};
789 return "Illegal directory"
790 if $recref->{dir} =~ /(^|\/)\.+(\/|$)/; #no .. component
791 return "Illegal directory"
792 if $recref->{dir} =~ /\&/ && ! $username_ampersand;
793 unless ( $recref->{dir} ) {
794 $recref->{dir} = $dir_prefix . '/';
795 if ( $dirhash > 0 ) {
796 for my $h ( 1 .. $dirhash ) {
797 $recref->{dir} .= substr($recref->{username}, $h-1, 1). '/';
799 } elsif ( $dirhash < 0 ) {
800 for my $h ( reverse $dirhash .. -1 ) {
801 $recref->{dir} .= substr($recref->{username}, $h, 1). '/';
804 $recref->{dir} .= $recref->{username};
810 # $error = $self->ut_textn('finger');
811 # return $error if $error;
812 if ( $self->getfield('finger') eq '' ) {
813 my $cust_pkg = $self->svcnum
814 ? $self->cust_svc->cust_pkg
815 : qsearchs('cust_pkg', { 'pkgnum' => $self->getfield('pkgnum') } );
817 my $cust_main = $cust_pkg->cust_main;
818 $self->setfield('finger', $cust_main->first.' '.$cust_main->get('last') );
821 $self->getfield('finger') =~
822 /^([\w \t\!\@\#\$\%\&\(\)\-\+\;\'\"\,\.\?\/\*\<\>]*)$/
823 or return "Illegal finger: ". $self->getfield('finger');
824 $self->setfield('finger', $1);
826 $recref->{quota} =~ /^(\w*)$/ or return "Illegal quota";
827 $recref->{quota} = $1;
829 unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) {
830 if ( $recref->{slipip} eq '' ) {
831 $recref->{slipip} = '';
832 } elsif ( $recref->{slipip} eq '0e0' ) {
833 $recref->{slipip} = '0e0';
835 $recref->{slipip} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/
836 or return "Illegal slipip: ". $self->slipip;
837 $recref->{slipip} = $1;
842 #arbitrary RADIUS stuff; allow ut_textn for now
843 foreach ( grep /^radius_/, fields('svc_acct') ) {
847 #generate a password if it is blank
848 $recref->{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) )
849 unless ( $recref->{_password} );
851 #if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,16})$/ ) {
852 if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{$passwordmin,$passwordmax})$/ ) {
853 $recref->{_password} = $1.$3;
854 #uncomment this to encrypt password immediately upon entry, or run
855 #bin/crypt_pw in cron to give new users a window during which their
856 #password is available to techs, for faxing, etc. (also be aware of
858 #$recref->{password} = $1.
859 # crypt($3,$saltset[int(rand(64))].$saltset[int(rand(64))]
861 } elsif ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([\w\.\/\$\;\+]{13,60})$/ ) {
862 $recref->{_password} = $1.$3;
863 } elsif ( $recref->{_password} eq '*' ) {
864 $recref->{_password} = '*';
865 } elsif ( $recref->{_password} eq '!' ) {
866 $recref->{_password} = '!';
867 } elsif ( $recref->{_password} eq '!!' ) {
868 $recref->{_password} = '!!';
870 #return "Illegal password";
871 return gettext('illegal_password'). " $passwordmin-$passwordmax ".
872 FS::Msgcat::_gettext('illegal_password_characters').
873 ": ". $recref->{_password};
881 Internal function to check the username against the list of system usernames
882 from the I<system_usernames> configuration value. Returns true if the username
883 is listed on the system username list.
889 scalar( grep { $self->username eq $_ || $self->email eq $_ }
890 $conf->config('system_usernames')
894 =item _check_duplicate
896 Internal function to check for duplicates usernames, username@domain pairs and
899 If the I<global_unique-username> configuration value is set to B<username> or
900 B<username@domain>, enforces global username or username@domain uniqueness.
902 In all cases, check for duplicate uids and usernames or username@domain pairs
903 per export and with identical I<svcpart> values.
907 sub _check_duplicate {
910 my $global_unique = $conf->config('global_unique-username') || 'none';
911 return '' if $global_unique eq 'disabled';
913 #this is Pg-specific. what to do for mysql etc?
914 # ( mysql LOCK TABLES certainly isn't equivalent or useful here :/ )
915 warn "$me locking svc_acct table for duplicate search" if $DEBUG;
916 dbh->do("LOCK TABLE svc_acct IN SHARE ROW EXCLUSIVE MODE")
918 warn "$me acquired svc_acct table lock for duplicate search" if $DEBUG;
920 my $part_svc = qsearchs('part_svc', { 'svcpart' => $self->svcpart } );
921 unless ( $part_svc ) {
922 return 'unknown svcpart '. $self->svcpart;
925 my @dup_user = grep { !$self->svcnum || $_->svcnum != $self->svcnum }
926 qsearch( 'svc_acct', { 'username' => $self->username } );
927 return gettext('username_in_use')
928 if $global_unique eq 'username' && @dup_user;
930 my @dup_userdomain = grep { !$self->svcnum || $_->svcnum != $self->svcnum }
931 qsearch( 'svc_acct', { 'username' => $self->username,
932 'domsvc' => $self->domsvc } );
933 return gettext('username_in_use')
934 if $global_unique eq 'username@domain' && @dup_userdomain;
937 if ( $part_svc->part_svc_column('uid')->columnflag ne 'F'
938 && $self->username !~ /^(toor|(hyla)?fax)$/ ) {
939 @dup_uid = grep { !$self->svcnum || $_->svcnum != $self->svcnum }
940 qsearch( 'svc_acct', { 'uid' => $self->uid } );
945 if ( @dup_user || @dup_userdomain || @dup_uid ) {
946 my $exports = FS::part_export::export_info('svc_acct');
947 my %conflict_user_svcpart;
948 my %conflict_userdomain_svcpart = ( $self->svcpart => 'SELF', );
950 foreach my $part_export ( $part_svc->part_export ) {
952 #this will catch to the same exact export
953 my @svcparts = map { $_->svcpart } $part_export->export_svc;
955 #this will catch to exports w/same exporthost+type ???
956 #my @other_part_export = qsearch('part_export', {
957 # 'machine' => $part_export->machine,
958 # 'exporttype' => $part_export->exporttype,
960 #foreach my $other_part_export ( @other_part_export ) {
961 # push @svcparts, map { $_->svcpart }
962 # qsearch('export_svc', { 'exportnum' => $part_export->exportnum });
965 #my $nodomain = $exports->{$part_export->exporttype}{'nodomain'};
966 #silly kludge to avoid uninitialized value errors
967 my $nodomain = exists( $exports->{$part_export->exporttype}{'nodomain'} )
968 ? $exports->{$part_export->exporttype}{'nodomain'}
970 if ( $nodomain =~ /^Y/i ) {
971 $conflict_user_svcpart{$_} = $part_export->exportnum
974 $conflict_userdomain_svcpart{$_} = $part_export->exportnum
979 foreach my $dup_user ( @dup_user ) {
980 my $dup_svcpart = $dup_user->cust_svc->svcpart;
981 if ( exists($conflict_user_svcpart{$dup_svcpart}) ) {
982 return "duplicate username: conflicts with svcnum ". $dup_user->svcnum.
983 " via exportnum ". $conflict_user_svcpart{$dup_svcpart};
987 foreach my $dup_userdomain ( @dup_userdomain ) {
988 my $dup_svcpart = $dup_userdomain->cust_svc->svcpart;
989 if ( exists($conflict_userdomain_svcpart{$dup_svcpart}) ) {
990 return "duplicate username\@domain: conflicts with svcnum ".
991 $dup_userdomain->svcnum. " via exportnum ".
992 $conflict_userdomain_svcpart{$dup_svcpart};
996 foreach my $dup_uid ( @dup_uid ) {
997 my $dup_svcpart = $dup_uid->cust_svc->svcpart;
998 if ( exists($conflict_user_svcpart{$dup_svcpart})
999 || exists($conflict_userdomain_svcpart{$dup_svcpart}) ) {
1000 return "duplicate uid: conflicts with svcnum ". $dup_uid->svcnum.
1001 " via exportnum ". $conflict_user_svcpart{$dup_svcpart}
1002 || $conflict_userdomain_svcpart{$dup_svcpart};
1014 Depriciated, use radius_reply instead.
1019 carp "FS::svc_acct::radius depriciated, use radius_reply";
1020 $_[0]->radius_reply;
1025 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
1026 reply attributes of this record.
1028 Note that this is now the preferred method for reading RADIUS attributes -
1029 accessing the columns directly is discouraged, as the column names are
1030 expected to change in the future.
1037 return %{ $self->{'radius_reply'} }
1038 if exists $self->{'radius_reply'};
1043 my($column, $attrib) = ($1, $2);
1044 #$attrib =~ s/_/\-/g;
1045 ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
1046 } grep { /^radius_/ && $self->getfield($_) } fields( $self->table );
1048 if ( $self->slipip && $self->slipip ne '0e0' ) {
1049 $reply{$radius_ip} = $self->slipip;
1052 if ( $self->seconds !~ /^$/ ) {
1053 $reply{'Session-Timeout'} = $self->seconds;
1061 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
1062 check attributes of this record.
1064 Note that this is now the preferred method for reading RADIUS attributes -
1065 accessing the columns directly is discouraged, as the column names are
1066 expected to change in the future.
1073 return %{ $self->{'radius_check'} }
1074 if exists $self->{'radius_check'};
1079 my($column, $attrib) = ($1, $2);
1080 #$attrib =~ s/_/\-/g;
1081 ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
1082 } grep { /^rc_/ && $self->getfield($_) } fields( $self->table );
1084 my $password = $self->_password;
1085 my $pw_attrib = length($password) <= 12 ? $radius_password : 'Crypt-Password'; $check{$pw_attrib} = $password;
1087 my $cust_svc = $self->cust_svc;
1088 die "FATAL: no cust_svc record for svc_acct.svcnum ". $self->svcnum. "\n"
1090 my $cust_pkg = $cust_svc->cust_pkg;
1091 if ( $cust_pkg && $cust_pkg->part_pkg->is_prepaid && $cust_pkg->bill ) {
1092 $check{'Expiration'} = time2str('%B %e %Y %T', $cust_pkg->bill ); #http://lists.cistron.nl/pipermail/freeradius-users/2005-January/040184.html
1101 This method instructs the object to "snapshot" or freeze RADIUS check and
1102 reply attributes to the current values.
1106 #bah, my english is too broken this morning
1107 #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
1108 #the FS::cust_pkg's replace method to trigger the correct export updates when
1109 #package dates change)
1114 $self->{$_} = { $self->$_() }
1115 foreach qw( radius_reply radius_check );
1119 =item forget_snapshot
1121 This methos instructs the object to forget any previously snapshotted
1122 RADIUS check and reply attributes.
1126 sub forget_snapshot {
1130 foreach qw( radius_reply radius_check );
1136 Returns the domain associated with this account.
1142 die "svc_acct.domsvc is null for svcnum ". $self->svcnum unless $self->domsvc;
1143 my $svc_domain = $self->svc_domain(@_)
1144 or die "no svc_domain.svcnum for svc_acct.domsvc ". $self->domsvc;
1145 $svc_domain->domain;
1150 Returns the FS::svc_domain record for this account's domain (see
1158 ? $self->{'_domsvc'}
1159 : qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } );
1164 Returns the FS::cust_svc record for this account (see L<FS::cust_svc>).
1168 #inherited from svc_Common
1172 Returns an email address associated with the account.
1178 $self->username. '@'. $self->domain(@_);
1183 Returns an array of FS::acct_snarf records associated with the account.
1184 If the acct_snarf table does not exist or there are no associated records,
1185 an empty list is returned
1191 return () unless dbdef->table('acct_snarf');
1192 eval "use FS::acct_snarf;";
1194 qsearch('acct_snarf', { 'svcnum' => $self->svcnum } );
1197 =item decrement_seconds SECONDS
1199 Decrements the I<seconds> field of this record by the given amount. If there
1200 is an error, returns the error, otherwise returns false.
1204 sub decrement_seconds {
1205 shift->_op_seconds('-', @_);
1208 =item increment_seconds SECONDS
1210 Increments the I<seconds> field of this record by the given amount. If there
1211 is an error, returns the error, otherwise returns false.
1215 sub increment_seconds {
1216 shift->_op_seconds('+', @_);
1224 my %op2condition = (
1225 '-' => sub { my($self, $seconds) = @_;
1226 $self->seconds - $seconds <= 0;
1228 '+' => sub { my($self, $seconds) = @_;
1229 $self->seconds + $seconds > 0;
1234 my( $self, $op, $seconds ) = @_;
1235 warn "$me _op_seconds called for svcnum ". $self->svcnum.
1236 ' ('. $self->email. "): $op $seconds\n"
1239 local $SIG{HUP} = 'IGNORE';
1240 local $SIG{INT} = 'IGNORE';
1241 local $SIG{QUIT} = 'IGNORE';
1242 local $SIG{TERM} = 'IGNORE';
1243 local $SIG{TSTP} = 'IGNORE';
1244 local $SIG{PIPE} = 'IGNORE';
1246 my $oldAutoCommit = $FS::UID::AutoCommit;
1247 local $FS::UID::AutoCommit = 0;
1250 my $sql = "UPDATE svc_acct SET seconds = ".
1251 " CASE WHEN seconds IS NULL THEN 0 ELSE seconds END ". #$seconds||0
1252 " $op ? WHERE svcnum = ?";
1256 my $sth = $dbh->prepare( $sql )
1257 or die "Error preparing $sql: ". $dbh->errstr;
1258 my $rv = $sth->execute($seconds, $self->svcnum);
1259 die "Error executing $sql: ". $sth->errstr
1260 unless defined($rv);
1261 die "Can't update seconds for svcnum". $self->svcnum
1264 my $action = $op2action{$op};
1266 if ( $conf->exists("svc_acct-usage_$action")
1267 && &{$op2condition{$op}}($self, $seconds) ) {
1268 #my $error = $self->$action();
1269 my $error = $self->cust_svc->cust_pkg->$action();
1271 $dbh->rollback if $oldAutoCommit;
1272 return "Error ${action}ing: $error";
1276 warn "$me update successful; committing\n"
1278 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1284 =item seconds_since TIMESTAMP
1286 Returns the number of seconds this account has been online since TIMESTAMP,
1287 according to the session monitor (see L<FS::Session>).
1289 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
1290 L<Time::Local> and L<Date::Parse> for conversion functions.
1294 #note: POD here, implementation in FS::cust_svc
1297 $self->cust_svc->seconds_since(@_);
1300 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
1302 Returns the numbers of seconds this account has been online between
1303 TIMESTAMP_START (inclusive) and TIMESTAMP_END (exclusive), according to an
1304 external SQL radacct table, specified via sqlradius export. Sessions which
1305 started in the specified range but are still open are counted from session
1306 start to the end of the range (unless they are over 1 day old, in which case
1307 they are presumed missing their stop record and not counted). Also, sessions
1308 which end in the range but started earlier are counted from the start of the
1309 range to session end. Finally, sessions which start before the range but end
1310 after are counted for the entire range.
1312 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1313 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
1318 #note: POD here, implementation in FS::cust_svc
1319 sub seconds_since_sqlradacct {
1321 $self->cust_svc->seconds_since_sqlradacct(@_);
1324 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
1326 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
1327 in this package for sessions ending between TIMESTAMP_START (inclusive) and
1328 TIMESTAMP_END (exclusive).
1330 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1331 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
1336 #note: POD here, implementation in FS::cust_svc
1337 sub attribute_since_sqlradacct {
1339 $self->cust_svc->attribute_since_sqlradacct(@_);
1342 =item get_session_history TIMESTAMP_START TIMESTAMP_END
1344 Returns an array of hash references of this customers login history for the
1345 given time range. (document this better)
1349 sub get_session_history {
1351 $self->cust_svc->get_session_history(@_);
1354 =item get_cdrs TIMESTAMP_START TIMESTAMP_END [ 'OPTION' => 'VALUE ... ]
1359 my($self, $start, $end, %opt ) = @_;
1361 my $did = $self->username; #yup
1363 my $prefix = $opt{'default_prefix'}; #convergent.au '+61'
1365 my $for_update = $opt{'for_update'} ? 'FOR UPDATE' : '';
1367 #SELECT $for_update * FROM cdr
1368 # WHERE calldate >= $start #need a conversion
1369 # AND calldate < $end #ditto
1370 # AND ( charged_party = "$did"
1371 # OR charged_party = "$prefix$did" #if length($prefix);
1372 # OR ( ( charged_party IS NULL OR charged_party = '' )
1374 # ( src = "$did" OR src = "$prefix$did" ) # if length($prefix)
1377 # AND ( freesidestatus IS NULL OR freesidestatus = '' )
1380 if ( length($prefix) ) {
1382 " AND ( charged_party = '$did'
1383 OR charged_party = '$prefix$did'
1384 OR ( ( charged_party IS NULL OR charged_party = '' )
1386 ( src = '$did' OR src = '$prefix$did' )
1392 " AND ( charged_party = '$did'
1393 OR ( ( charged_party IS NULL OR charged_party = '' )
1403 'select' => "$for_update *",
1406 #( freesidestatus IS NULL OR freesidestatus = '' )
1407 'freesidestatus' => '',
1409 'extra_sql' => $charged_or_src,
1417 Returns all RADIUS groups for this account (see L<FS::radius_usergroup>).
1423 if ( $self->usergroup ) {
1424 confess "explicitly specified usergroup not an arrayref: ". $self->usergroup
1425 unless ref($self->usergroup) eq 'ARRAY';
1426 #when provisioning records, export callback runs in svc_Common.pm before
1427 #radius_usergroup records can be inserted...
1428 @{$self->usergroup};
1430 map { $_->groupname }
1431 qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } );
1435 =item clone_suspended
1437 Constructor used by FS::part_export::_export_suspend fallback. Document
1442 sub clone_suspended {
1444 my %hash = $self->hash;
1445 $hash{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) );
1446 new FS::svc_acct \%hash;
1449 =item clone_kludge_unsuspend
1451 Constructor used by FS::part_export::_export_unsuspend fallback. Document
1456 sub clone_kludge_unsuspend {
1458 my %hash = $self->hash;
1459 $hash{_password} = '';
1460 new FS::svc_acct \%hash;
1463 =item check_password
1465 Checks the supplied password against the (possibly encrypted) password in the
1466 database. Returns true for a successful authentication, false for no match.
1468 Currently supported encryptions are: classic DES crypt() and MD5
1472 sub check_password {
1473 my($self, $check_password) = @_;
1475 #remove old-style SUSPENDED kludge, they should be allowed to login to
1476 #self-service and pay up
1477 ( my $password = $self->_password ) =~ s/^\*SUSPENDED\* //;
1479 #eventually should check a "password-encoding" field
1480 if ( $password =~ /^(\*|!!?)$/ ) { #no self-service login
1482 } elsif ( length($password) < 13 ) { #plaintext
1483 $check_password eq $password;
1484 } elsif ( length($password) == 13 ) { #traditional DES crypt
1485 crypt($check_password, $password) eq $password;
1486 } elsif ( $password =~ /^\$1\$/ ) { #MD5 crypt
1487 unix_md5_crypt($check_password, $password) eq $password;
1488 } elsif ( $password =~ /^\$2a?\$/ ) { #Blowfish
1489 warn "Can't check password: Blowfish encryption not yet supported, svcnum".
1490 $self->svcnum. "\n";
1493 warn "Can't check password: Unrecognized encryption for svcnum ".
1494 $self->svcnum. "\n";
1500 =item crypt_password [ DEFAULT_ENCRYPTION_TYPE ]
1502 Returns an encrypted password, either by passing through an encrypted password
1503 in the database or by encrypting a plaintext password from the database.
1505 The optional DEFAULT_ENCRYPTION_TYPE parameter can be set to I<crypt> (classic
1506 UNIX DES crypt), I<md5> (md5 crypt supported by most modern Linux and BSD
1507 distrubtions), or (eventually) I<blowfish> (blowfish hashing supported by
1508 OpenBSD, SuSE, other Linux distibutions with pam_unix2, etc.). The default
1509 encryption type is only used if the password is not already encrypted in the
1514 sub crypt_password {
1516 #eventually should check a "password-encoding" field
1517 if ( length($self->_password) == 13
1518 || $self->_password =~ /^\$(1|2a?)\$/
1519 || $self->_password =~ /^(\*|NP|\*LK\*|!!?)$/
1524 my $encryption = ( scalar(@_) && $_[0] ) ? shift : 'crypt';
1525 if ( $encryption eq 'crypt' ) {
1528 $saltset[int(rand(64))].$saltset[int(rand(64))]
1530 } elsif ( $encryption eq 'md5' ) {
1531 unix_md5_crypt( $self->_password );
1532 } elsif ( $encryption eq 'blowfish' ) {
1533 die "unknown encryption method $encryption";
1535 die "unknown encryption method $encryption";
1540 =item virtual_maildir
1542 Returns $domain/maildirs/$username/
1546 sub virtual_maildir {
1548 $self->domain. '/maildirs/'. $self->username. '/';
1559 This is the FS::svc_acct job-queue-able version. It still uses
1560 FS::Misc::send_email under-the-hood.
1567 eval "use FS::Misc qw(send_email)";
1570 $opt{mimetype} ||= 'text/plain';
1571 $opt{mimetype} .= '; charset="iso-8859-1"' unless $opt{mimetype} =~ /charset/;
1573 my $error = send_email(
1574 'from' => $opt{from},
1576 'subject' => $opt{subject},
1577 'content-type' => $opt{mimetype},
1578 'body' => [ map "$_\n", split("\n", $opt{body}) ],
1580 die $error if $error;
1583 =item check_and_rebuild_fuzzyfiles
1587 sub check_and_rebuild_fuzzyfiles {
1588 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1589 -e "$dir/svc_acct.username"
1590 or &rebuild_fuzzyfiles;
1593 =item rebuild_fuzzyfiles
1597 sub rebuild_fuzzyfiles {
1599 use Fcntl qw(:flock);
1601 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1605 open(USERNAMELOCK,">>$dir/svc_acct.username")
1606 or die "can't open $dir/svc_acct.username: $!";
1607 flock(USERNAMELOCK,LOCK_EX)
1608 or die "can't lock $dir/svc_acct.username: $!";
1610 my @all_username = map $_->getfield('username'), qsearch('svc_acct', {});
1612 open (USERNAMECACHE,">$dir/svc_acct.username.tmp")
1613 or die "can't open $dir/svc_acct.username.tmp: $!";
1614 print USERNAMECACHE join("\n", @all_username), "\n";
1615 close USERNAMECACHE or die "can't close $dir/svc_acct.username.tmp: $!";
1617 rename "$dir/svc_acct.username.tmp", "$dir/svc_acct.username";
1627 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1628 open(USERNAMECACHE,"<$dir/svc_acct.username")
1629 or die "can't open $dir/svc_acct.username: $!";
1630 my @array = map { chomp; $_; } <USERNAMECACHE>;
1631 close USERNAMECACHE;
1635 =item append_fuzzyfiles USERNAME
1639 sub append_fuzzyfiles {
1640 my $username = shift;
1642 &check_and_rebuild_fuzzyfiles;
1644 use Fcntl qw(:flock);
1646 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1648 open(USERNAME,">>$dir/svc_acct.username")
1649 or die "can't open $dir/svc_acct.username: $!";
1650 flock(USERNAME,LOCK_EX)
1651 or die "can't lock $dir/svc_acct.username: $!";
1653 print USERNAME "$username\n";
1655 flock(USERNAME,LOCK_UN)
1656 or die "can't unlock $dir/svc_acct.username: $!";
1664 =item radius_usergroup_selector GROUPS_ARRAYREF [ SELECTNAME ]
1668 sub radius_usergroup_selector {
1669 my $sel_groups = shift;
1670 my %sel_groups = map { $_=>1 } @$sel_groups;
1672 my $selectname = shift || 'radius_usergroup';
1675 my $sth = $dbh->prepare(
1676 'SELECT DISTINCT(groupname) FROM radius_usergroup ORDER BY groupname'
1677 ) or die $dbh->errstr;
1678 $sth->execute() or die $sth->errstr;
1679 my @all_groups = map { $_->[0] } @{$sth->fetchall_arrayref};
1683 function ${selectname}_doadd(object) {
1684 var myvalue = object.${selectname}_add.value;
1685 var optionName = new Option(myvalue,myvalue,false,true);
1686 var length = object.$selectname.length;
1687 object.$selectname.options[length] = optionName;
1688 object.${selectname}_add.value = "";
1691 <SELECT MULTIPLE NAME="$selectname">
1694 foreach my $group ( @all_groups ) {
1695 $html .= qq(<OPTION VALUE="$group");
1696 if ( $sel_groups{$group} ) {
1697 $html .= ' SELECTED';
1698 $sel_groups{$group} = 0;
1700 $html .= ">$group</OPTION>\n";
1702 foreach my $group ( grep { $sel_groups{$_} } keys %sel_groups ) {
1703 $html .= qq(<OPTION VALUE="$group" SELECTED>$group</OPTION>\n);
1705 $html .= '</SELECT>';
1707 $html .= qq!<BR><INPUT TYPE="text" NAME="${selectname}_add">!.
1708 qq!<INPUT TYPE="button" VALUE="Add new group" onClick="${selectname}_doadd(this.form)">!;
1717 The $recref stuff in sub check should be cleaned up.
1719 The suspend, unsuspend and cancel methods update the database, but not the
1720 current object. This is probably a bug as it's unexpected and
1723 radius_usergroup_selector? putting web ui components in here? they should
1724 probably live somewhere else...
1726 insertion of RADIUS group stuff in insert could be done with child_objects now
1727 (would probably clean up export of them too)
1731 L<FS::svc_Common>, edit/part_svc.cgi from an installed web interface,
1732 export.html from the base documentation, L<FS::Record>, L<FS::Conf>,
1733 L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, L<FS::queue>,
1734 L<freeside-queued>), L<FS::svc_acct_pop>,
1735 schema.html from the base documentation.