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'; }
193 #false laziness with edit/svc_acct.cgi
195 my( $self, $groups ) = @_;
196 if ( ref($groups) eq 'ARRAY' ) {
198 } elsif ( length($groups) ) {
199 [ split(/\s*,\s*/, $groups) ];
207 =item insert [ , OPTION => VALUE ... ]
209 Adds this account to the database. If there is an error, returns the error,
210 otherwise returns false.
212 The additional fields pkgnum and svcpart (see L<FS::cust_svc>) should be
213 defined. An FS::cust_svc record will be created and inserted.
215 The additional field I<usergroup> can optionally be defined; if so it should
216 contain an arrayref of group names. See L<FS::radius_usergroup>.
218 The additional field I<child_objects> can optionally be defined; if so it
219 should contain an arrayref of FS::tablename objects. They will have their
220 svcnum fields set and will be inserted after this record, but before any
221 exports are run. Each element of the array can also optionally be a
222 two-element array reference containing the child object and the name of an
223 alternate field to be filled in with the newly-inserted svcnum, for example
224 C<[ $svc_forward, 'srcsvc' ]>
226 Currently available options are: I<depend_jobnum>
228 If I<depend_jobnum> is set (to a scalar jobnum or an array reference of
229 jobnums), all provisioning jobs will have a dependancy on the supplied
230 jobnum(s) (they will not run until the specific job(s) complete(s)).
232 (TODOC: L<FS::queue> and L<freeside-queued>)
234 (TODOC: new exports!)
243 warn "[$me] insert called on $self: ". Dumper($self).
244 "\nwith options: ". Dumper(%options);
247 local $SIG{HUP} = 'IGNORE';
248 local $SIG{INT} = 'IGNORE';
249 local $SIG{QUIT} = 'IGNORE';
250 local $SIG{TERM} = 'IGNORE';
251 local $SIG{TSTP} = 'IGNORE';
252 local $SIG{PIPE} = 'IGNORE';
254 my $oldAutoCommit = $FS::UID::AutoCommit;
255 local $FS::UID::AutoCommit = 0;
258 my $error = $self->check;
259 return $error if $error;
261 if ( $self->svcnum && qsearchs('cust_svc',{'svcnum'=>$self->svcnum}) ) {
262 my $cust_svc = qsearchs('cust_svc',{'svcnum'=>$self->svcnum});
263 unless ( $cust_svc ) {
264 $dbh->rollback if $oldAutoCommit;
265 return "no cust_svc record found for svcnum ". $self->svcnum;
267 $self->pkgnum($cust_svc->pkgnum);
268 $self->svcpart($cust_svc->svcpart);
271 $error = $self->_check_duplicate;
273 $dbh->rollback if $oldAutoCommit;
278 $error = $self->SUPER::insert(
279 'jobnums' => \@jobnums,
280 'child_objects' => $self->child_objects,
284 $dbh->rollback if $oldAutoCommit;
288 if ( $self->usergroup ) {
289 foreach my $groupname ( @{$self->usergroup} ) {
290 my $radius_usergroup = new FS::radius_usergroup ( {
291 svcnum => $self->svcnum,
292 groupname => $groupname,
294 my $error = $radius_usergroup->insert;
296 $dbh->rollback if $oldAutoCommit;
302 unless ( $skip_fuzzyfiles ) {
303 $error = $self->queue_fuzzyfiles_update;
305 $dbh->rollback if $oldAutoCommit;
306 return "updating fuzzy search cache: $error";
310 my $cust_pkg = $self->cust_svc->cust_pkg;
313 my $cust_main = $cust_pkg->cust_main;
315 if ( $conf->exists('emailinvoiceauto') ) {
316 my @invoicing_list = $cust_main->invoicing_list;
317 push @invoicing_list, $self->email;
318 $cust_main->invoicing_list(\@invoicing_list);
323 if ( $welcome_template && $cust_pkg ) {
324 my $to = join(', ', grep { $_ !~ /^(POST|FAX)$/ } $cust_main->invoicing_list );
326 my $wqueue = new FS::queue {
327 'svcnum' => $self->svcnum,
328 'job' => 'FS::svc_acct::send_email'
330 my $error = $wqueue->insert(
332 'from' => $welcome_from,
333 'subject' => $welcome_subject,
334 'mimetype' => $welcome_mimetype,
335 'body' => $welcome_template->fill_in( HASH => {
336 'custnum' => $self->custnum,
337 'username' => $self->username,
338 'password' => $self->_password,
339 'first' => $cust_main->first,
340 'last' => $cust_main->getfield('last'),
341 'pkg' => $cust_pkg->part_pkg->pkg,
345 $dbh->rollback if $oldAutoCommit;
346 return "error queuing welcome email: $error";
349 if ( $options{'depend_jobnum'} ) {
350 warn "$me depend_jobnum found; adding to welcome email dependancies"
352 if ( ref($options{'depend_jobnum'}) ) {
353 warn "$me adding jobs ". join(', ', @{$options{'depend_jobnum'}} ).
354 "to welcome email dependancies"
356 push @jobnums, @{ $options{'depend_jobnum'} };
358 warn "$me adding job $options{'depend_jobnum'} ".
359 "to welcome email dependancies"
361 push @jobnums, $options{'depend_jobnum'};
365 foreach my $jobnum ( @jobnums ) {
366 my $error = $wqueue->depend_insert($jobnum);
368 $dbh->rollback if $oldAutoCommit;
369 return "error queuing welcome email job dependancy: $error";
379 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
385 Deletes this account from the database. If there is an error, returns the
386 error, otherwise returns false.
388 The corresponding FS::cust_svc record will be deleted as well.
390 (TODOC: new exports!)
397 return "can't delete system account" if $self->_check_system;
399 return "Can't delete an account which is a (svc_forward) source!"
400 if qsearch( 'svc_forward', { 'srcsvc' => $self->svcnum } );
402 return "Can't delete an account which is a (svc_forward) destination!"
403 if qsearch( 'svc_forward', { 'dstsvc' => $self->svcnum } );
405 return "Can't delete an account with (svc_www) web service!"
406 if qsearch( 'svc_www', { 'usersvc' => $self->svcnum } );
408 # what about records in session ? (they should refer to history table)
410 local $SIG{HUP} = 'IGNORE';
411 local $SIG{INT} = 'IGNORE';
412 local $SIG{QUIT} = 'IGNORE';
413 local $SIG{TERM} = 'IGNORE';
414 local $SIG{TSTP} = 'IGNORE';
415 local $SIG{PIPE} = 'IGNORE';
417 my $oldAutoCommit = $FS::UID::AutoCommit;
418 local $FS::UID::AutoCommit = 0;
421 foreach my $cust_main_invoice (
422 qsearch( 'cust_main_invoice', { 'dest' => $self->svcnum } )
424 unless ( defined($cust_main_invoice) ) {
425 warn "WARNING: something's wrong with qsearch";
428 my %hash = $cust_main_invoice->hash;
429 $hash{'dest'} = $self->email;
430 my $new = new FS::cust_main_invoice \%hash;
431 my $error = $new->replace($cust_main_invoice);
433 $dbh->rollback if $oldAutoCommit;
438 foreach my $svc_domain (
439 qsearch( 'svc_domain', { 'catchall' => $self->svcnum } )
441 my %hash = new FS::svc_domain->hash;
442 $hash{'catchall'} = '';
443 my $new = new FS::svc_domain \%hash;
444 my $error = $new->replace($svc_domain);
446 $dbh->rollback if $oldAutoCommit;
451 foreach my $radius_usergroup (
452 qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } )
454 my $error = $radius_usergroup->delete;
456 $dbh->rollback if $oldAutoCommit;
461 my $error = $self->SUPER::delete;
463 $dbh->rollback if $oldAutoCommit;
467 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
471 =item replace OLD_RECORD
473 Replaces OLD_RECORD with this one in the database. If there is an error,
474 returns the error, otherwise returns false.
476 The additional field I<usergroup> can optionally be defined; if so it should
477 contain an arrayref of group names. See L<FS::radius_usergroup>.
483 my ( $new, $old ) = ( shift, shift );
485 warn "$me replacing $old with $new\n" if $DEBUG;
487 return "can't modify system account" if $old->_check_system;
490 #no warnings 'numeric'; #alas, a 5.006-ism
493 foreach my $xid (qw( uid gid )) {
495 return "Can't change $xid!"
496 if ! $conf->exists("svc_acct-edit_$xid")
497 && $old->$xid() != $new->$xid()
498 && $new->cust_svc->part_svc->part_svc_column($xid)->columnflag ne 'F'
503 #change homdir when we change username
504 $new->setfield('dir', '') if $old->username ne $new->username;
506 local $SIG{HUP} = 'IGNORE';
507 local $SIG{INT} = 'IGNORE';
508 local $SIG{QUIT} = 'IGNORE';
509 local $SIG{TERM} = 'IGNORE';
510 local $SIG{TSTP} = 'IGNORE';
511 local $SIG{PIPE} = 'IGNORE';
513 my $oldAutoCommit = $FS::UID::AutoCommit;
514 local $FS::UID::AutoCommit = 0;
517 # redundant, but so $new->usergroup gets set
518 $error = $new->check;
519 return $error if $error;
521 $old->usergroup( [ $old->radius_groups ] );
523 warn $old->email. " old groups: ". join(' ',@{$old->usergroup}). "\n";
524 warn $new->email. "new groups: ". join(' ',@{$new->usergroup}). "\n";
526 if ( $new->usergroup ) {
527 #(sorta) false laziness with FS::part_export::sqlradius::_export_replace
528 my @newgroups = @{$new->usergroup};
529 foreach my $oldgroup ( @{$old->usergroup} ) {
530 if ( grep { $oldgroup eq $_ } @newgroups ) {
531 @newgroups = grep { $oldgroup ne $_ } @newgroups;
534 my $radius_usergroup = qsearchs('radius_usergroup', {
535 svcnum => $old->svcnum,
536 groupname => $oldgroup,
538 my $error = $radius_usergroup->delete;
540 $dbh->rollback if $oldAutoCommit;
541 return "error deleting radius_usergroup $oldgroup: $error";
545 foreach my $newgroup ( @newgroups ) {
546 my $radius_usergroup = new FS::radius_usergroup ( {
547 svcnum => $new->svcnum,
548 groupname => $newgroup,
550 my $error = $radius_usergroup->insert;
552 $dbh->rollback if $oldAutoCommit;
553 return "error adding radius_usergroup $newgroup: $error";
559 if ( $old->username ne $new->username || $old->domsvc != $new->domsvc ) {
560 $new->svcpart( $new->cust_svc->svcpart ) unless $new->svcpart;
561 $error = $new->_check_duplicate;
563 $dbh->rollback if $oldAutoCommit;
568 $error = $new->SUPER::replace($old);
570 $dbh->rollback if $oldAutoCommit;
571 return $error if $error;
574 if ( $new->username ne $old->username && ! $skip_fuzzyfiles ) {
575 $error = $new->queue_fuzzyfiles_update;
577 $dbh->rollback if $oldAutoCommit;
578 return "updating fuzzy search cache: $error";
582 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
586 =item queue_fuzzyfiles_update
588 Used by insert & replace to update the fuzzy search cache
592 sub queue_fuzzyfiles_update {
595 local $SIG{HUP} = 'IGNORE';
596 local $SIG{INT} = 'IGNORE';
597 local $SIG{QUIT} = 'IGNORE';
598 local $SIG{TERM} = 'IGNORE';
599 local $SIG{TSTP} = 'IGNORE';
600 local $SIG{PIPE} = 'IGNORE';
602 my $oldAutoCommit = $FS::UID::AutoCommit;
603 local $FS::UID::AutoCommit = 0;
606 my $queue = new FS::queue {
607 'svcnum' => $self->svcnum,
608 'job' => 'FS::svc_acct::append_fuzzyfiles'
610 my $error = $queue->insert($self->username);
612 $dbh->rollback if $oldAutoCommit;
613 return "queueing job (transaction rolled back): $error";
616 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
624 Suspends this account by calling export-specific suspend hooks. If there is
625 an error, returns the error, otherwise returns false.
627 Called by the suspend method of FS::cust_pkg (see L<FS::cust_pkg>).
633 return "can't suspend system account" if $self->_check_system;
634 $self->SUPER::suspend;
639 Unsuspends this account by by calling export-specific suspend hooks. If there
640 is an error, returns the error, otherwise returns false.
642 Called by the unsuspend method of FS::cust_pkg (see L<FS::cust_pkg>).
648 my %hash = $self->hash;
649 if ( $hash{_password} =~ /^\*SUSPENDED\* (.*)$/ ) {
650 $hash{_password} = $1;
651 my $new = new FS::svc_acct ( \%hash );
652 my $error = $new->replace($self);
653 return $error if $error;
656 $self->SUPER::unsuspend;
661 Called by the cancel method of FS::cust_pkg (see L<FS::cust_pkg>).
663 If the B<auto_unset_catchall> configuration option is set, this method will
664 automatically remove any references to the canceled service in the catchall
665 field of svc_domain. This allows packages that contain both a svc_domain and
666 its catchall svc_acct to be canceled in one step.
671 # Only one thing to do at this level
673 foreach my $svc_domain (
674 qsearch( 'svc_domain', { catchall => $self->svcnum } ) ) {
675 if($conf->exists('auto_unset_catchall')) {
676 my %hash = $svc_domain->hash;
677 $hash{catchall} = '';
678 my $new = new FS::svc_domain ( \%hash );
679 my $error = $new->replace($svc_domain);
680 return $error if $error;
682 return "cannot unprovision svc_acct #".$self->svcnum.
683 " while assigned as catchall for svc_domain #".$svc_domain->svcnum;
687 $self->SUPER::cancel;
693 Checks all fields to make sure this is a valid service. If there is an error,
694 returns the error, otherwise returns false. Called by the insert and replace
697 Sets any fixed values; see L<FS::part_svc>.
704 my($recref) = $self->hashref;
706 my $x = $self->setfixed( $self->_fieldhandlers );
707 return $x unless ref($x);
710 if ( $part_svc->part_svc_column('usergroup')->columnflag eq "F" ) {
712 [ split(',', $part_svc->part_svc_column('usergroup')->columnvalue) ] );
715 my $error = $self->ut_numbern('svcnum')
716 #|| $self->ut_number('domsvc')
717 || $self->ut_foreign_key('domsvc', 'svc_domain', 'svcnum' )
718 || $self->ut_textn('sec_phrase')
720 return $error if $error;
722 my $ulen = $usernamemax || $self->dbdef_table->column('username')->length;
723 if ( $username_uppercase ) {
724 $recref->{username} =~ /^([a-z0-9_\-\.\&\%]{$usernamemin,$ulen})$/i
725 or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username};
726 $recref->{username} = $1;
728 $recref->{username} =~ /^([a-z0-9_\-\.\&\%]{$usernamemin,$ulen})$/
729 or return gettext('illegal_username'). " ($usernamemin-$ulen): ". $recref->{username};
730 $recref->{username} = $1;
733 if ( $username_letterfirst ) {
734 $recref->{username} =~ /^[a-z]/ or return gettext('illegal_username');
735 } elsif ( $username_letter ) {
736 $recref->{username} =~ /[a-z]/ or return gettext('illegal_username');
738 if ( $username_noperiod ) {
739 $recref->{username} =~ /\./ and return gettext('illegal_username');
741 if ( $username_nounderscore ) {
742 $recref->{username} =~ /_/ and return gettext('illegal_username');
744 if ( $username_nodash ) {
745 $recref->{username} =~ /\-/ and return gettext('illegal_username');
747 unless ( $username_ampersand ) {
748 $recref->{username} =~ /\&/ and return gettext('illegal_username');
750 if ( $password_noampersand ) {
751 $recref->{_password} =~ /\&/ and return gettext('illegal_password');
753 if ( $password_noexclamation ) {
754 $recref->{_password} =~ /\!/ and return gettext('illegal_password');
756 unless ( $username_percent ) {
757 $recref->{username} =~ /\%/ and return gettext('illegal_username');
760 $recref->{popnum} =~ /^(\d*)$/ or return "Illegal popnum: ".$recref->{popnum};
761 $recref->{popnum} = $1;
762 return "Unknown popnum" unless
763 ! $recref->{popnum} ||
764 qsearchs('svc_acct_pop',{'popnum'=> $recref->{popnum} } );
766 unless ( $part_svc->part_svc_column('uid')->columnflag eq 'F' ) {
768 $recref->{uid} =~ /^(\d*)$/ or return "Illegal uid";
769 $recref->{uid} = $1 eq '' ? $self->unique('uid') : $1;
771 $recref->{gid} =~ /^(\d*)$/ or return "Illegal gid";
772 $recref->{gid} = $1 eq '' ? $recref->{uid} : $1;
773 #not all systems use gid=uid
774 #you can set a fixed gid in part_svc
776 return "Only root can have uid 0"
777 if $recref->{uid} == 0
778 && $recref->{username} !~ /^(root|toor|smtp)$/;
780 unless ( $recref->{username} eq 'sync' ) {
781 if ( grep $_ eq $recref->{shell}, @shells ) {
782 $recref->{shell} = (grep $_ eq $recref->{shell}, @shells)[0];
784 return "Illegal shell \`". $self->shell. "\'; ".
785 $conf->dir. "/shells contains: @shells";
788 $recref->{shell} = '/bin/sync';
792 $recref->{gid} ne '' ?
793 return "Can't have gid without uid" : ( $recref->{gid}='' );
794 #$recref->{dir} ne '' ?
795 # return "Can't have directory without uid" : ( $recref->{dir}='' );
796 $recref->{shell} ne '' ?
797 return "Can't have shell without uid" : ( $recref->{shell}='' );
800 unless ( $part_svc->part_svc_column('dir')->columnflag eq 'F' ) {
802 $recref->{dir} =~ /^([\/\w\-\.\&]*)$/
803 or return "Illegal directory: ". $recref->{dir};
805 return "Illegal directory"
806 if $recref->{dir} =~ /(^|\/)\.+(\/|$)/; #no .. component
807 return "Illegal directory"
808 if $recref->{dir} =~ /\&/ && ! $username_ampersand;
809 unless ( $recref->{dir} ) {
810 $recref->{dir} = $dir_prefix . '/';
811 if ( $dirhash > 0 ) {
812 for my $h ( 1 .. $dirhash ) {
813 $recref->{dir} .= substr($recref->{username}, $h-1, 1). '/';
815 } elsif ( $dirhash < 0 ) {
816 for my $h ( reverse $dirhash .. -1 ) {
817 $recref->{dir} .= substr($recref->{username}, $h, 1). '/';
820 $recref->{dir} .= $recref->{username};
826 # $error = $self->ut_textn('finger');
827 # return $error if $error;
828 if ( $self->getfield('finger') eq '' ) {
829 my $cust_pkg = $self->svcnum
830 ? $self->cust_svc->cust_pkg
831 : qsearchs('cust_pkg', { 'pkgnum' => $self->getfield('pkgnum') } );
833 my $cust_main = $cust_pkg->cust_main;
834 $self->setfield('finger', $cust_main->first.' '.$cust_main->get('last') );
837 $self->getfield('finger') =~
838 /^([\w \t\!\@\#\$\%\&\(\)\-\+\;\'\"\,\.\?\/\*\<\>]*)$/
839 or return "Illegal finger: ". $self->getfield('finger');
840 $self->setfield('finger', $1);
842 $recref->{quota} =~ /^(\w*)$/ or return "Illegal quota";
843 $recref->{quota} = $1;
845 unless ( $part_svc->part_svc_column('slipip')->columnflag eq 'F' ) {
846 if ( $recref->{slipip} eq '' ) {
847 $recref->{slipip} = '';
848 } elsif ( $recref->{slipip} eq '0e0' ) {
849 $recref->{slipip} = '0e0';
851 $recref->{slipip} =~ /^(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$/
852 or return "Illegal slipip: ". $self->slipip;
853 $recref->{slipip} = $1;
858 #arbitrary RADIUS stuff; allow ut_textn for now
859 foreach ( grep /^radius_/, fields('svc_acct') ) {
863 #generate a password if it is blank
864 $recref->{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) )
865 unless ( $recref->{_password} );
867 #if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{4,16})$/ ) {
868 if ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([^\t\n]{$passwordmin,$passwordmax})$/ ) {
869 $recref->{_password} = $1.$3;
870 #uncomment this to encrypt password immediately upon entry, or run
871 #bin/crypt_pw in cron to give new users a window during which their
872 #password is available to techs, for faxing, etc. (also be aware of
874 #$recref->{password} = $1.
875 # crypt($3,$saltset[int(rand(64))].$saltset[int(rand(64))]
877 } elsif ( $recref->{_password} =~ /^((\*SUSPENDED\* )?)([\w\.\/\$\;\+]{13,60})$/ ) {
878 $recref->{_password} = $1.$3;
879 } elsif ( $recref->{_password} eq '*' ) {
880 $recref->{_password} = '*';
881 } elsif ( $recref->{_password} eq '!' ) {
882 $recref->{_password} = '!';
883 } elsif ( $recref->{_password} eq '!!' ) {
884 $recref->{_password} = '!!';
886 #return "Illegal password";
887 return gettext('illegal_password'). " $passwordmin-$passwordmax ".
888 FS::Msgcat::_gettext('illegal_password_characters').
889 ": ". $recref->{_password};
897 Internal function to check the username against the list of system usernames
898 from the I<system_usernames> configuration value. Returns true if the username
899 is listed on the system username list.
905 scalar( grep { $self->username eq $_ || $self->email eq $_ }
906 $conf->config('system_usernames')
910 =item _check_duplicate
912 Internal function to check for duplicates usernames, username@domain pairs and
915 If the I<global_unique-username> configuration value is set to B<username> or
916 B<username@domain>, enforces global username or username@domain uniqueness.
918 In all cases, check for duplicate uids and usernames or username@domain pairs
919 per export and with identical I<svcpart> values.
923 sub _check_duplicate {
926 my $global_unique = $conf->config('global_unique-username') || 'none';
927 return '' if $global_unique eq 'disabled';
929 #this is Pg-specific. what to do for mysql etc?
930 # ( mysql LOCK TABLES certainly isn't equivalent or useful here :/ )
931 warn "$me locking svc_acct table for duplicate search" if $DEBUG;
932 dbh->do("LOCK TABLE svc_acct IN SHARE ROW EXCLUSIVE MODE")
934 warn "$me acquired svc_acct table lock for duplicate search" if $DEBUG;
936 my $part_svc = qsearchs('part_svc', { 'svcpart' => $self->svcpart } );
937 unless ( $part_svc ) {
938 return 'unknown svcpart '. $self->svcpart;
941 my @dup_user = grep { !$self->svcnum || $_->svcnum != $self->svcnum }
942 qsearch( 'svc_acct', { 'username' => $self->username } );
943 return gettext('username_in_use')
944 if $global_unique eq 'username' && @dup_user;
946 my @dup_userdomain = grep { !$self->svcnum || $_->svcnum != $self->svcnum }
947 qsearch( 'svc_acct', { 'username' => $self->username,
948 'domsvc' => $self->domsvc } );
949 return gettext('username_in_use')
950 if $global_unique eq 'username@domain' && @dup_userdomain;
953 if ( $part_svc->part_svc_column('uid')->columnflag ne 'F'
954 && $self->username !~ /^(toor|(hyla)?fax)$/ ) {
955 @dup_uid = grep { !$self->svcnum || $_->svcnum != $self->svcnum }
956 qsearch( 'svc_acct', { 'uid' => $self->uid } );
961 if ( @dup_user || @dup_userdomain || @dup_uid ) {
962 my $exports = FS::part_export::export_info('svc_acct');
963 my %conflict_user_svcpart;
964 my %conflict_userdomain_svcpart = ( $self->svcpart => 'SELF', );
966 foreach my $part_export ( $part_svc->part_export ) {
968 #this will catch to the same exact export
969 my @svcparts = map { $_->svcpart } $part_export->export_svc;
971 #this will catch to exports w/same exporthost+type ???
972 #my @other_part_export = qsearch('part_export', {
973 # 'machine' => $part_export->machine,
974 # 'exporttype' => $part_export->exporttype,
976 #foreach my $other_part_export ( @other_part_export ) {
977 # push @svcparts, map { $_->svcpart }
978 # qsearch('export_svc', { 'exportnum' => $part_export->exportnum });
981 #my $nodomain = $exports->{$part_export->exporttype}{'nodomain'};
982 #silly kludge to avoid uninitialized value errors
983 my $nodomain = exists( $exports->{$part_export->exporttype}{'nodomain'} )
984 ? $exports->{$part_export->exporttype}{'nodomain'}
986 if ( $nodomain =~ /^Y/i ) {
987 $conflict_user_svcpart{$_} = $part_export->exportnum
990 $conflict_userdomain_svcpart{$_} = $part_export->exportnum
995 foreach my $dup_user ( @dup_user ) {
996 my $dup_svcpart = $dup_user->cust_svc->svcpart;
997 if ( exists($conflict_user_svcpart{$dup_svcpart}) ) {
998 return "duplicate username: conflicts with svcnum ". $dup_user->svcnum.
999 " via exportnum ". $conflict_user_svcpart{$dup_svcpart};
1003 foreach my $dup_userdomain ( @dup_userdomain ) {
1004 my $dup_svcpart = $dup_userdomain->cust_svc->svcpart;
1005 if ( exists($conflict_userdomain_svcpart{$dup_svcpart}) ) {
1006 return "duplicate username\@domain: conflicts with svcnum ".
1007 $dup_userdomain->svcnum. " via exportnum ".
1008 $conflict_userdomain_svcpart{$dup_svcpart};
1012 foreach my $dup_uid ( @dup_uid ) {
1013 my $dup_svcpart = $dup_uid->cust_svc->svcpart;
1014 if ( exists($conflict_user_svcpart{$dup_svcpart})
1015 || exists($conflict_userdomain_svcpart{$dup_svcpart}) ) {
1016 return "duplicate uid: conflicts with svcnum ". $dup_uid->svcnum.
1017 " via exportnum ". $conflict_user_svcpart{$dup_svcpart}
1018 || $conflict_userdomain_svcpart{$dup_svcpart};
1030 Depriciated, use radius_reply instead.
1035 carp "FS::svc_acct::radius depriciated, use radius_reply";
1036 $_[0]->radius_reply;
1041 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
1042 reply attributes of this record.
1044 Note that this is now the preferred method for reading RADIUS attributes -
1045 accessing the columns directly is discouraged, as the column names are
1046 expected to change in the future.
1053 return %{ $self->{'radius_reply'} }
1054 if exists $self->{'radius_reply'};
1059 my($column, $attrib) = ($1, $2);
1060 #$attrib =~ s/_/\-/g;
1061 ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
1062 } grep { /^radius_/ && $self->getfield($_) } fields( $self->table );
1064 if ( $self->slipip && $self->slipip ne '0e0' ) {
1065 $reply{$radius_ip} = $self->slipip;
1068 if ( $self->seconds !~ /^$/ ) {
1069 $reply{'Session-Timeout'} = $self->seconds;
1077 Returns key/value pairs, suitable for assigning to a hash, for any RADIUS
1078 check attributes of this record.
1080 Note that this is now the preferred method for reading RADIUS attributes -
1081 accessing the columns directly is discouraged, as the column names are
1082 expected to change in the future.
1089 return %{ $self->{'radius_check'} }
1090 if exists $self->{'radius_check'};
1095 my($column, $attrib) = ($1, $2);
1096 #$attrib =~ s/_/\-/g;
1097 ( $FS::raddb::attrib{lc($attrib)}, $self->getfield($column) );
1098 } grep { /^rc_/ && $self->getfield($_) } fields( $self->table );
1100 my $password = $self->_password;
1101 my $pw_attrib = length($password) <= 12 ? $radius_password : 'Crypt-Password'; $check{$pw_attrib} = $password;
1103 my $cust_svc = $self->cust_svc;
1104 die "FATAL: no cust_svc record for svc_acct.svcnum ". $self->svcnum. "\n"
1106 my $cust_pkg = $cust_svc->cust_pkg;
1107 if ( $cust_pkg && $cust_pkg->part_pkg->is_prepaid && $cust_pkg->bill ) {
1108 $check{'Expiration'} = time2str('%B %e %Y %T', $cust_pkg->bill ); #http://lists.cistron.nl/pipermail/freeradius-users/2005-January/040184.html
1117 This method instructs the object to "snapshot" or freeze RADIUS check and
1118 reply attributes to the current values.
1122 #bah, my english is too broken this morning
1123 #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
1124 #the FS::cust_pkg's replace method to trigger the correct export updates when
1125 #package dates change)
1130 $self->{$_} = { $self->$_() }
1131 foreach qw( radius_reply radius_check );
1135 =item forget_snapshot
1137 This methos instructs the object to forget any previously snapshotted
1138 RADIUS check and reply attributes.
1142 sub forget_snapshot {
1146 foreach qw( radius_reply radius_check );
1152 Returns the domain associated with this account.
1158 die "svc_acct.domsvc is null for svcnum ". $self->svcnum unless $self->domsvc;
1159 my $svc_domain = $self->svc_domain(@_)
1160 or die "no svc_domain.svcnum for svc_acct.domsvc ". $self->domsvc;
1161 $svc_domain->domain;
1166 Returns the FS::svc_domain record for this account's domain (see
1174 ? $self->{'_domsvc'}
1175 : qsearchs( 'svc_domain', { 'svcnum' => $self->domsvc } );
1180 Returns the FS::cust_svc record for this account (see L<FS::cust_svc>).
1184 #inherited from svc_Common
1188 Returns an email address associated with the account.
1194 $self->username. '@'. $self->domain(@_);
1199 Returns an array of FS::acct_snarf records associated with the account.
1200 If the acct_snarf table does not exist or there are no associated records,
1201 an empty list is returned
1207 return () unless dbdef->table('acct_snarf');
1208 eval "use FS::acct_snarf;";
1210 qsearch('acct_snarf', { 'svcnum' => $self->svcnum } );
1213 =item decrement_seconds SECONDS
1215 Decrements the I<seconds> field of this record by the given amount. If there
1216 is an error, returns the error, otherwise returns false.
1220 sub decrement_seconds {
1221 shift->_op_seconds('-', @_);
1224 =item increment_seconds SECONDS
1226 Increments the I<seconds> field of this record by the given amount. If there
1227 is an error, returns the error, otherwise returns false.
1231 sub increment_seconds {
1232 shift->_op_seconds('+', @_);
1240 my %op2condition = (
1241 '-' => sub { my($self, $seconds) = @_;
1242 $self->seconds - $seconds <= 0;
1244 '+' => sub { my($self, $seconds) = @_;
1245 $self->seconds + $seconds > 0;
1250 my( $self, $op, $seconds ) = @_;
1251 warn "$me _op_seconds called for svcnum ". $self->svcnum.
1252 ' ('. $self->email. "): $op $seconds\n"
1255 local $SIG{HUP} = 'IGNORE';
1256 local $SIG{INT} = 'IGNORE';
1257 local $SIG{QUIT} = 'IGNORE';
1258 local $SIG{TERM} = 'IGNORE';
1259 local $SIG{TSTP} = 'IGNORE';
1260 local $SIG{PIPE} = 'IGNORE';
1262 my $oldAutoCommit = $FS::UID::AutoCommit;
1263 local $FS::UID::AutoCommit = 0;
1266 my $sql = "UPDATE svc_acct SET seconds = ".
1267 " CASE WHEN seconds IS NULL THEN 0 ELSE seconds END ". #$seconds||0
1268 " $op ? WHERE svcnum = ?";
1272 my $sth = $dbh->prepare( $sql )
1273 or die "Error preparing $sql: ". $dbh->errstr;
1274 my $rv = $sth->execute($seconds, $self->svcnum);
1275 die "Error executing $sql: ". $sth->errstr
1276 unless defined($rv);
1277 die "Can't update seconds for svcnum". $self->svcnum
1280 my $action = $op2action{$op};
1282 if ( $conf->exists("svc_acct-usage_$action")
1283 && &{$op2condition{$op}}($self, $seconds) ) {
1284 #my $error = $self->$action();
1285 my $error = $self->cust_svc->cust_pkg->$action();
1287 $dbh->rollback if $oldAutoCommit;
1288 return "Error ${action}ing: $error";
1292 warn "$me update successful; committing\n"
1294 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1300 =item seconds_since TIMESTAMP
1302 Returns the number of seconds this account has been online since TIMESTAMP,
1303 according to the session monitor (see L<FS::Session>).
1305 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
1306 L<Time::Local> and L<Date::Parse> for conversion functions.
1310 #note: POD here, implementation in FS::cust_svc
1313 $self->cust_svc->seconds_since(@_);
1316 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
1318 Returns the numbers of seconds this account has been online between
1319 TIMESTAMP_START (inclusive) and TIMESTAMP_END (exclusive), according to an
1320 external SQL radacct table, specified via sqlradius export. Sessions which
1321 started in the specified range but are still open are counted from session
1322 start to the end of the range (unless they are over 1 day old, in which case
1323 they are presumed missing their stop record and not counted). Also, sessions
1324 which end in the range but started earlier are counted from the start of the
1325 range to session end. Finally, sessions which start before the range but end
1326 after are counted for the entire range.
1328 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1329 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
1334 #note: POD here, implementation in FS::cust_svc
1335 sub seconds_since_sqlradacct {
1337 $self->cust_svc->seconds_since_sqlradacct(@_);
1340 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
1342 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
1343 in this package for sessions ending between TIMESTAMP_START (inclusive) and
1344 TIMESTAMP_END (exclusive).
1346 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1347 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
1352 #note: POD here, implementation in FS::cust_svc
1353 sub attribute_since_sqlradacct {
1355 $self->cust_svc->attribute_since_sqlradacct(@_);
1358 =item get_session_history TIMESTAMP_START TIMESTAMP_END
1360 Returns an array of hash references of this customers login history for the
1361 given time range. (document this better)
1365 sub get_session_history {
1367 $self->cust_svc->get_session_history(@_);
1370 =item get_cdrs TIMESTAMP_START TIMESTAMP_END [ 'OPTION' => 'VALUE ... ]
1375 my($self, $start, $end, %opt ) = @_;
1377 my $did = $self->username; #yup
1379 my $prefix = $opt{'default_prefix'}; #convergent.au '+61'
1381 my $for_update = $opt{'for_update'} ? 'FOR UPDATE' : '';
1383 #SELECT $for_update * FROM cdr
1384 # WHERE calldate >= $start #need a conversion
1385 # AND calldate < $end #ditto
1386 # AND ( charged_party = "$did"
1387 # OR charged_party = "$prefix$did" #if length($prefix);
1388 # OR ( ( charged_party IS NULL OR charged_party = '' )
1390 # ( src = "$did" OR src = "$prefix$did" ) # if length($prefix)
1393 # AND ( freesidestatus IS NULL OR freesidestatus = '' )
1396 if ( length($prefix) ) {
1398 " AND ( charged_party = '$did'
1399 OR charged_party = '$prefix$did'
1400 OR ( ( charged_party IS NULL OR charged_party = '' )
1402 ( src = '$did' OR src = '$prefix$did' )
1408 " AND ( charged_party = '$did'
1409 OR ( ( charged_party IS NULL OR charged_party = '' )
1419 'select' => "$for_update *",
1422 #( freesidestatus IS NULL OR freesidestatus = '' )
1423 'freesidestatus' => '',
1425 'extra_sql' => $charged_or_src,
1433 Returns all RADIUS groups for this account (see L<FS::radius_usergroup>).
1439 if ( $self->usergroup ) {
1440 confess "explicitly specified usergroup not an arrayref: ". $self->usergroup
1441 unless ref($self->usergroup) eq 'ARRAY';
1442 #when provisioning records, export callback runs in svc_Common.pm before
1443 #radius_usergroup records can be inserted...
1444 @{$self->usergroup};
1446 map { $_->groupname }
1447 qsearch('radius_usergroup', { 'svcnum' => $self->svcnum } );
1451 =item clone_suspended
1453 Constructor used by FS::part_export::_export_suspend fallback. Document
1458 sub clone_suspended {
1460 my %hash = $self->hash;
1461 $hash{_password} = join('',map($pw_set[ int(rand $#pw_set) ], (0..7) ) );
1462 new FS::svc_acct \%hash;
1465 =item clone_kludge_unsuspend
1467 Constructor used by FS::part_export::_export_unsuspend fallback. Document
1472 sub clone_kludge_unsuspend {
1474 my %hash = $self->hash;
1475 $hash{_password} = '';
1476 new FS::svc_acct \%hash;
1479 =item check_password
1481 Checks the supplied password against the (possibly encrypted) password in the
1482 database. Returns true for a successful authentication, false for no match.
1484 Currently supported encryptions are: classic DES crypt() and MD5
1488 sub check_password {
1489 my($self, $check_password) = @_;
1491 #remove old-style SUSPENDED kludge, they should be allowed to login to
1492 #self-service and pay up
1493 ( my $password = $self->_password ) =~ s/^\*SUSPENDED\* //;
1495 #eventually should check a "password-encoding" field
1496 if ( $password =~ /^(\*|!!?)$/ ) { #no self-service login
1498 } elsif ( length($password) < 13 ) { #plaintext
1499 $check_password eq $password;
1500 } elsif ( length($password) == 13 ) { #traditional DES crypt
1501 crypt($check_password, $password) eq $password;
1502 } elsif ( $password =~ /^\$1\$/ ) { #MD5 crypt
1503 unix_md5_crypt($check_password, $password) eq $password;
1504 } elsif ( $password =~ /^\$2a?\$/ ) { #Blowfish
1505 warn "Can't check password: Blowfish encryption not yet supported, svcnum".
1506 $self->svcnum. "\n";
1509 warn "Can't check password: Unrecognized encryption for svcnum ".
1510 $self->svcnum. "\n";
1516 =item crypt_password [ DEFAULT_ENCRYPTION_TYPE ]
1518 Returns an encrypted password, either by passing through an encrypted password
1519 in the database or by encrypting a plaintext password from the database.
1521 The optional DEFAULT_ENCRYPTION_TYPE parameter can be set to I<crypt> (classic
1522 UNIX DES crypt), I<md5> (md5 crypt supported by most modern Linux and BSD
1523 distrubtions), or (eventually) I<blowfish> (blowfish hashing supported by
1524 OpenBSD, SuSE, other Linux distibutions with pam_unix2, etc.). The default
1525 encryption type is only used if the password is not already encrypted in the
1530 sub crypt_password {
1532 #eventually should check a "password-encoding" field
1533 if ( length($self->_password) == 13
1534 || $self->_password =~ /^\$(1|2a?)\$/
1535 || $self->_password =~ /^(\*|NP|\*LK\*|!!?)$/
1540 my $encryption = ( scalar(@_) && $_[0] ) ? shift : 'crypt';
1541 if ( $encryption eq 'crypt' ) {
1544 $saltset[int(rand(64))].$saltset[int(rand(64))]
1546 } elsif ( $encryption eq 'md5' ) {
1547 unix_md5_crypt( $self->_password );
1548 } elsif ( $encryption eq 'blowfish' ) {
1549 die "unknown encryption method $encryption";
1551 die "unknown encryption method $encryption";
1556 =item virtual_maildir
1558 Returns $domain/maildirs/$username/
1562 sub virtual_maildir {
1564 $self->domain. '/maildirs/'. $self->username. '/';
1575 This is the FS::svc_acct job-queue-able version. It still uses
1576 FS::Misc::send_email under-the-hood.
1583 eval "use FS::Misc qw(send_email)";
1586 $opt{mimetype} ||= 'text/plain';
1587 $opt{mimetype} .= '; charset="iso-8859-1"' unless $opt{mimetype} =~ /charset/;
1589 my $error = send_email(
1590 'from' => $opt{from},
1592 'subject' => $opt{subject},
1593 'content-type' => $opt{mimetype},
1594 'body' => [ map "$_\n", split("\n", $opt{body}) ],
1596 die $error if $error;
1599 =item check_and_rebuild_fuzzyfiles
1603 sub check_and_rebuild_fuzzyfiles {
1604 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1605 -e "$dir/svc_acct.username"
1606 or &rebuild_fuzzyfiles;
1609 =item rebuild_fuzzyfiles
1613 sub rebuild_fuzzyfiles {
1615 use Fcntl qw(:flock);
1617 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1621 open(USERNAMELOCK,">>$dir/svc_acct.username")
1622 or die "can't open $dir/svc_acct.username: $!";
1623 flock(USERNAMELOCK,LOCK_EX)
1624 or die "can't lock $dir/svc_acct.username: $!";
1626 my @all_username = map $_->getfield('username'), qsearch('svc_acct', {});
1628 open (USERNAMECACHE,">$dir/svc_acct.username.tmp")
1629 or die "can't open $dir/svc_acct.username.tmp: $!";
1630 print USERNAMECACHE join("\n", @all_username), "\n";
1631 close USERNAMECACHE or die "can't close $dir/svc_acct.username.tmp: $!";
1633 rename "$dir/svc_acct.username.tmp", "$dir/svc_acct.username";
1643 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1644 open(USERNAMECACHE,"<$dir/svc_acct.username")
1645 or die "can't open $dir/svc_acct.username: $!";
1646 my @array = map { chomp; $_; } <USERNAMECACHE>;
1647 close USERNAMECACHE;
1651 =item append_fuzzyfiles USERNAME
1655 sub append_fuzzyfiles {
1656 my $username = shift;
1658 &check_and_rebuild_fuzzyfiles;
1660 use Fcntl qw(:flock);
1662 my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc;
1664 open(USERNAME,">>$dir/svc_acct.username")
1665 or die "can't open $dir/svc_acct.username: $!";
1666 flock(USERNAME,LOCK_EX)
1667 or die "can't lock $dir/svc_acct.username: $!";
1669 print USERNAME "$username\n";
1671 flock(USERNAME,LOCK_UN)
1672 or die "can't unlock $dir/svc_acct.username: $!";
1680 =item radius_usergroup_selector GROUPS_ARRAYREF [ SELECTNAME ]
1684 sub radius_usergroup_selector {
1685 my $sel_groups = shift;
1686 my %sel_groups = map { $_=>1 } @$sel_groups;
1688 my $selectname = shift || 'radius_usergroup';
1691 my $sth = $dbh->prepare(
1692 'SELECT DISTINCT(groupname) FROM radius_usergroup ORDER BY groupname'
1693 ) or die $dbh->errstr;
1694 $sth->execute() or die $sth->errstr;
1695 my @all_groups = map { $_->[0] } @{$sth->fetchall_arrayref};
1699 function ${selectname}_doadd(object) {
1700 var myvalue = object.${selectname}_add.value;
1701 var optionName = new Option(myvalue,myvalue,false,true);
1702 var length = object.$selectname.length;
1703 object.$selectname.options[length] = optionName;
1704 object.${selectname}_add.value = "";
1707 <SELECT MULTIPLE NAME="$selectname">
1710 foreach my $group ( @all_groups ) {
1711 $html .= qq(<OPTION VALUE="$group");
1712 if ( $sel_groups{$group} ) {
1713 $html .= ' SELECTED';
1714 $sel_groups{$group} = 0;
1716 $html .= ">$group</OPTION>\n";
1718 foreach my $group ( grep { $sel_groups{$_} } keys %sel_groups ) {
1719 $html .= qq(<OPTION VALUE="$group" SELECTED>$group</OPTION>\n);
1721 $html .= '</SELECT>';
1723 $html .= qq!<BR><INPUT TYPE="text" NAME="${selectname}_add">!.
1724 qq!<INPUT TYPE="button" VALUE="Add new group" onClick="${selectname}_doadd(this.form)">!;
1733 The $recref stuff in sub check should be cleaned up.
1735 The suspend, unsuspend and cancel methods update the database, but not the
1736 current object. This is probably a bug as it's unexpected and
1739 radius_usergroup_selector? putting web ui components in here? they should
1740 probably live somewhere else...
1742 insertion of RADIUS group stuff in insert could be done with child_objects now
1743 (would probably clean up export of them too)
1747 L<FS::svc_Common>, edit/part_svc.cgi from an installed web interface,
1748 export.html from the base documentation, L<FS::Record>, L<FS::Conf>,
1749 L<FS::cust_svc>, L<FS::part_svc>, L<FS::cust_pkg>, L<FS::queue>,
1750 L<freeside-queued>), L<FS::svc_acct_pop>,
1751 schema.html from the base documentation.