diff options
| -rw-r--r-- | FS/FS/Mason.pm | 1 | ||||
| -rw-r--r-- | FS/FS/Schema.pm | 15 | ||||
| -rw-r--r-- | FS/FS/part_export/broadband_sqlradius.pm | 6 | ||||
| -rw-r--r-- | FS/FS/part_export/sqlradius.pm | 241 | ||||
| -rw-r--r-- | FS/FS/radius_attr.pm | 218 | ||||
| -rw-r--r-- | FS/FS/radius_group.pm | 51 | ||||
| -rw-r--r-- | FS/MANIFEST | 2 | ||||
| -rwxr-xr-x | FS/bin/freeside-sqlradius-reset | 15 | ||||
| -rw-r--r-- | FS/t/radius_attr.t | 5 | ||||
| -rw-r--r-- | httemplate/browse/radius_group.html | 44 | ||||
| -rw-r--r-- | httemplate/edit/process/radius_group.html | 23 | ||||
| -rw-r--r-- | httemplate/edit/radius_group.html | 58 | ||||
| -rw-r--r-- | httemplate/elements/radius_attr.html | 89 | ||||
| -rw-r--r-- | httemplate/elements/select-table.html | 2 | ||||
| -rw-r--r-- | httemplate/elements/select.html | 7 |
15 files changed, 720 insertions, 57 deletions
diff --git a/FS/FS/Mason.pm b/FS/FS/Mason.pm index 3d4fac4..1d42f71 100644 --- a/FS/FS/Mason.pm +++ b/FS/FS/Mason.pm @@ -295,6 +295,7 @@ if ( -e $addl_handler_use_file ) { use FS::nas; use FS::export_nas; use FS::legacy_cust_bill; + use FS::radius_attr; # Sammath Naur if ( $FS::Mason::addl_handler_use ) { diff --git a/FS/FS/Schema.pm b/FS/FS/Schema.pm index 50b8b6d..8f4531f 100644 --- a/FS/FS/Schema.pm +++ b/FS/FS/Schema.pm @@ -2391,12 +2391,27 @@ sub tables_hashref { 'groupnum', 'serial', '', '', '', '', 'groupname', 'varchar', '', $char_d, '', '', 'description', 'varchar', 'NULL', $char_d, '', '', + 'priority', 'int', '', '', '1', '', ], 'primary_key' => 'groupnum', 'unique' => [ ['groupname'] ], 'index' => [], }, + 'radius_attr' => { + 'columns' => [ + 'attrnum', 'serial', '', '', '', '', + 'groupnum', 'int', '', '', '', '', + 'attrname', 'varchar', '', $char_d, '', '', + 'value', 'varchar', '', $char_d, '', '', + 'attrtype', 'char', '', 1, '', '', + 'op', 'char', '', 2, '', '', + ], + 'primary_key' => 'attrnum', + 'unique' => [ ['groupnum','attrname'] ], #? + 'index' => [], + }, + 'msgcat' => { 'columns' => [ 'msgnum', 'serial', '', '', '', '', diff --git a/FS/FS/part_export/broadband_sqlradius.pm b/FS/FS/part_export/broadband_sqlradius.pm index ae0876d..9b6fbec 100644 --- a/FS/FS/part_export/broadband_sqlradius.pm +++ b/FS/FS/part_export/broadband_sqlradius.pm @@ -34,7 +34,11 @@ tie %options, 'Tie::IxHash', 'radius_password' => { label=>'Fixed password' }, 'ip_addr_as' => { label => 'Send IP address as', default => 'Framed-IP-Address' }, -; + 'export_attrs' => { + type => 'checkbox', + label => 'Export RADIUS group attributes to this database', + }, + ; %info = ( 'svc' => 'svc_broadband', diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm index 736b34e..7d0edd6 100644 --- a/FS/FS/part_export/sqlradius.pm +++ b/FS/FS/part_export/sqlradius.pm @@ -1,5 +1,6 @@ package FS::part_export::sqlradius; +use strict; use vars qw(@ISA @EXPORT_OK $DEBUG %info %options $notes1 $notes2); use Exporter; use Tie::IxHash; @@ -12,7 +13,7 @@ use Carp qw( cluck ); @ISA = qw(FS::part_export); @EXPORT_OK = qw( sqlradius_connect ); -$DEBUG = 1; +$DEBUG = 0; my %groups; tie %options, 'Tie::IxHash', @@ -67,7 +68,10 @@ tie %options, 'Tie::IxHash', 'Radius group mapping to reason (via template user) (svcnum|username|username@domain reasonnum|reason)', type => 'textarea', }, - + 'export_attrs' => { + type => 'checkbox', + label => 'Export RADIUS group attributes to this database', + }, ; $notes1 = <<'END'; @@ -146,7 +150,7 @@ sub _export_insert { $table, $self->export_username($svc_x), %attrib ); return $err_or_queue unless ref($err_or_queue); } - my @groups = $svc_x->radius_groups; + my @groups = $svc_x->radius_groups('hashref'); if ( @groups ) { cluck localtime(). ": queuing usergroup_insert for ". $svc_x->svcnum. " (". $self->export_username($svc_x). " with ". join(", ", @groups) @@ -228,8 +232,8 @@ sub _export_replace { } my $error; - my (@oldgroups) = $old->radius_groups; - my (@newgroups) = $new->radius_groups; + my (@oldgroups) = $old->radius_groups('hashref'); + my (@newgroups) = $new->radius_groups('hashref'); $error = $self->sqlreplace_usergroups( $new->svcnum, $self->export_username($new), $jobnum ? $jobnum : '', @@ -276,12 +280,13 @@ sub _export_suspend { } my $error = - $self->sqlreplace_usergroups( $new->svcnum, - $self->export_username($new), - '', - [ $svc_acct->radius_groups ], - \@newgroups, - ); + $self->sqlreplace_usergroups( + $new->svcnum, + $self->export_username($new), + '', + [ $svc_acct->radius_groups('hashref') ], + \@newgroups, + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -314,12 +319,13 @@ sub _export_unsuspend { my $error; my (@oldgroups) = $self->suspended_usergroups($svc_acct); - $error = $self->sqlreplace_usergroups( $svc_acct->svcnum, - $self->export_username($svc_acct), - '', - \@oldgroups, - [ $svc_acct->radius_groups ], - ); + $error = $self->sqlreplace_usergroups( + $svc_acct->svcnum, + $self->export_username($svc_acct), + '', + \@oldgroups, + [ $svc_acct->radius_groups('hashref') ], + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -380,7 +386,7 @@ sub suspended_usergroups { $suspend_user = qsearchs( 'svc_acct', { 'username' => $userspec } ); } #esalf - return $suspend_user->radius_groups if $suspend_user; + return $suspend_user->radius_groups('hashref') if $suspend_user; (); } @@ -433,10 +439,12 @@ sub sqlradius_usergroup_insert { #subroutine, not method ) or die $dbh->errstr; my $sth = $dbh->prepare( - "INSERT INTO $usergroup ( UserName, GroupName ) VALUES ( ?, ? )" + "INSERT INTO $usergroup ( UserName, GroupName, Priority ) VALUES ( ?, ?, ? )" ) or die $dbh->errstr; - foreach my $group ( @groups ) { + foreach ( @groups ) { + my $group = $_->{'groupname'}; + my $priority = $_->{'priority'}; $s_sth->execute( $username, $group ) or die $s_sth->errstr; if ($s_sth->fetchrow_arrayref->[0]) { warn localtime() . ": sqlradius_usergroup_insert attempted to reinsert " . @@ -444,7 +452,7 @@ sub sqlradius_usergroup_insert { #subroutine, not method if $DEBUG; next; } - $sth->execute( $username, $group ) + $sth->execute( $username, $group, $priority ) or die "can't insert into groupname table: ". $sth->errstr; } if ( $s_sth->{Active} ) { @@ -467,7 +475,8 @@ sub sqlradius_usergroup_delete { #subroutine, not method my $sth = $dbh->prepare( "DELETE FROM $usergroup WHERE UserName = ? AND GroupName = ?" ) or die $dbh->errstr; - foreach my $group ( @groups ) { + foreach ( @groups ) { + my $group = $_->{'groupname'}; $sth->execute( $username, $group ) or die "can't delete from groupname table: ". $sth->errstr; } @@ -941,6 +950,191 @@ sub sqlradius_nas_replace { $sth->execute(@values, $opt{'nasname'}) or die $dbh->errstr; } +=item export_attr_insert RADIUS_ATTR + +=item export_attr_delete RADIUS_ATTR + +=item export_attr_replace NEW_RADIUS_ATTR OLD_RADIUS_ATTR + +Update the group attribute tables (radgroupcheck and radgroupreply) on +the RADIUS server. In delete and replace actions, the existing records +are identified by the combination of group name and attribute name. + +In the special case where attributes are being replaced because a group +name (L<FS::radius_group>->groupname) is changing, the pseudo-field +'groupname' must be set in OLD_RADIUS_ATTR. It's probably best to do this + + +=cut + +# some false laziness with NAS export stuff... + +sub export_attr_insert { shift->export_attr_action('insert', @_); } + +sub export_attr_delete { shift->export_attr_action('delete', @_); } + +sub export_attr_replace { shift->export_attr_action('replace', @_); } + +sub export_attr_action { + my $self = shift; + my ($action, $new, $old) = @_; + my ($attrname, $attrtype, $groupname) = + ($new->attrname, $new->attrtype, $new->radius_group->groupname); + if ( $action eq 'replace' ) { + + if ( $new->attrtype ne $old->attrtype ) { + # they're in separate tables in the target + return $self->export_attr_action('delete', $old) + || $self->export_attr_action('insert', $new) + ; + } + + # otherwise, just make sure we know the old attribute/group names + # so we can find the existing record + $attrname = $old->attrname; + $groupname = $old->groupname || $old->radius_group->groupname; + # maybe this should be enforced more strictly + warn "WARNING: attribute replace without 'groupname' set; assuming '$groupname'\n" + if !defined($old->groupname); + } + + my $err_or_queue = $self->sqlradius_queue('', "attr_$action", + attrnum => $new->attrnum, + attrname => $attrname, + attrtype => $attrtype, + groupname => $groupname, + ); + return $err_or_queue unless ref $err_or_queue; + ''; +} + +sub sqlradius_attr_insert { + my $dbh = sqlradius_connect(shift, shift, shift); + my %opt = @_; + my $radius_attr = qsearchs('radius_attr', { attrnum => $opt{'attrnum'} }) + or die 'attrnum '.$opt{'attrnum'}.' not found'; + + my $table; + # make sure $table is completely safe + if ( $opt{'attrtype'} eq 'C' ) { + $table = 'radgroupcheck'; + } + elsif ( $opt{'attrtype'} eq 'R' ) { + $table = 'radgroupreply'; + } + else { + die "unknown attribute type '".$radius_attr->attrtype."'"; + } + + my @values = ( + $opt{'groupname'}, map { $radius_attr->$_ } qw(attrname op value) + ); + my $sth = $dbh->prepare( + 'INSERT INTO '.$table.' (groupname, attribute, op, value) VALUES (?,?,?,?)' + ); + $sth->execute(@values) or die $dbh->errstr; +} + +sub sqlradius_attr_delete { + my $dbh = sqlradius_connect(shift, shift, shift); + my %opt = @_; + + my $table; + if ( $opt{'attrtype'} eq 'C' ) { + $table = 'radgroupcheck'; + } + elsif ( $opt{'attrtype'} eq 'R' ) { + $table = 'radgroupreply'; + } + else { + die "unknown attribute type '".$opt{'attrtype'}."'"; + } + + my $sth = $dbh->prepare( + 'DELETE FROM '.$table.' WHERE groupname = ? AND attribute = ?' + ); + $sth->execute( @opt{'groupname', 'attrname'} ) or die $dbh->errstr; +} + +sub sqlradius_attr_replace { + my $dbh = sqlradius_connect(shift, shift, shift); + my %opt = @_; + my $radius_attr = qsearchs('radius_attr', { attrnum => $opt{'attrnum'} }) + or die 'attrnum '.$opt{'attrnum'}.' not found'; + + my $table; + if ( $opt{'attrtype'} eq 'C' ) { + $table = 'radgroupcheck'; + } + elsif ( $opt{'attrtype'} eq 'R' ) { + $table = 'radgroupreply'; + } + else { + die "unknown attribute type '".$opt{'attrtype'}."'"; + } + + my $sth = $dbh->prepare( + 'UPDATE '.$table.' SET groupname = ?, attribute = ?, op = ?, value = ? + WHERE groupname = ? AND attribute = ?' + ); + + my $new_groupname = $radius_attr->radius_group->groupname; + my @new_values = ( + $new_groupname, map { $radius_attr->$_ } qw(attrname op value) + ); + $sth->execute( @new_values, @opt{'groupname', 'attrname'} ) + or die $dbh->errstr; +} + +=item export_group_replace NEW OLD + +Replace the L<FS::radius_group> object OLD with NEW. This will change +the group name and priority in all radusergroup records, and the group +name in radgroupcheck and radgroupreply. + +=cut + +sub export_group_replace { + my $self = shift; + my ($new, $old) = @_; + return '' if $new->groupname eq $old->groupname + and $new->priority == $old->priority; + + my $err_or_queue = $self->sqlradius_queue( + '', + 'group_replace', + ($self->option('usergroup') || 'usergroup'), + $new->hashref, + $old->hashref, + ); + return $err_or_queue unless ref $err_or_queue; + ''; +} + +sub sqlradius_group_replace { + my $dbh = sqlradius_connect(shift, shift, shift); + my $usergroup = shift; + $usergroup =~ /^(rad)?usergroup$/ + or die "bad usergroup table name: $usergroup"; + my ($new, $old) = (shift, shift); + # apply renames to check/reply attribute tables + if ( $new->{'groupname'} ne $old->{'groupname'} ) { + foreach my $table (qw(radgroupcheck radgroupreply)) { + my $sth = $dbh->prepare( + 'UPDATE '.$table.' SET groupname = ? WHERE groupname = ?' + ); + $sth->execute($new->{'groupname'}, $old->{'groupname'}) + or die $dbh->errstr; + } + } + # apply renames and priority changes to usergroup table + my $sth = $dbh->prepare( + 'UPDATE '.$usergroup.' SET groupname = ?, priority = ? WHERE groupname = ?' + ); + $sth->execute($new->{'groupname'}, $new->{'priority'}, $old->{'groupname'}) + or die $dbh->errstr; +} + ### #class methods ### @@ -954,7 +1148,8 @@ sub all_sqlradius { my @part_export = (); push @part_export, qsearch('part_export', { 'exporttype' => $_ } ) - foreach qw( sqlradius sqlradius_withdomain radiator phone_sqlradius ); + foreach qw( sqlradius sqlradius_withdomain radiator phone_sqlradius + broadband_sqlradius ); @part_export; } diff --git a/FS/FS/radius_attr.pm b/FS/FS/radius_attr.pm new file mode 100644 index 0000000..b4c6e70 --- /dev/null +++ b/FS/FS/radius_attr.pm @@ -0,0 +1,218 @@ +package FS::radius_attr; + +use strict; +use base qw( FS::Record ); +use FS::Record qw( qsearch qsearchs ); +use vars qw( $noexport_hack ); + +=head1 NAME + +FS::radius_attr - Object methods for radius_attr records + +=head1 SYNOPSIS + + use FS::radius_attr; + + $record = new FS::radius_attr \%hash; + $record = new FS::radius_attr { 'column' => 'value' }; + + $error = $record->insert; + + $error = $new_record->replace($old_record); + + $error = $record->delete; + + $error = $record->check; + +=head1 DESCRIPTION + +An FS::radius_attr object represents a RADIUS group attribute. +FS::radius_attr inherits from FS::Record. The following fields are +currently supported: + +=over 4 + +=item attrnum - primary key + +=item groupnum - L<FS::radius_group> to assign this attribute + +=item attrname - Attribute name, as defined in the RADIUS server's dictionary + +=item value - Attribute value + +=item attrtype - 'C' (check) or 'R' (reply) + +=item op - Operator (see L<http://wiki.freeradius.org/Operators>) + +=back + +=head1 METHODS + +=over 4 + +=item new HASHREF + +Creates a new example. To add the example to the database, see L<"insert">. + +Note that this stores the hash reference, not a distinct copy of the hash it +points to. You can ask the object for a copy with the I<hash> method. + +=cut + +# the new method can be inherited from FS::Record, if a table method is defined + +sub table { 'radius_attr'; } + +=item insert + +Adds this record to the database. If there is an error, returns the error, +otherwise returns false. If any sqlradius-type exports exist and have the +C<export_attrs> option enabled, the new attribute will be exported to them. + +=cut + +sub insert { + my $self = shift; + my $error = $self->SUPER::insert; + return $error if $error; + return if $noexport_hack; + + foreach ( qsearch('part_export', {}) ) { + next if !$_->option('export_attrs',1); + $error = $_->export_attr_insert($self); + return $error if $error; + } + + ''; +} + + +=item delete + +Delete this record from the database. Like C<insert>, this will delete +the attribute from any attached RADIUS databases. + +=cut + +sub delete { + my $self = shift; + my $error; + if ( !$noexport_hack ) { + foreach ( qsearch('part_export', {}) ) { + next if !$_->option('export_attrs',1); + $error = $_->export_attr_delete($self); + return $error if $error; + } + } + + $self->SUPER::delete; +} + +=item replace OLD_RECORD + +Replaces the OLD_RECORD with this one in the database. If there is an error, +returns the error, otherwise returns false. + +=cut + +sub replace { + my ($self, $old) = @_; + $old ||= $self->replace_old; + return 'can\'t change radius_attr.groupnum' + if $self->groupnum != $old->groupnum; + return '' + unless grep { $self->$_ ne $old->$_ } qw(attrname value op attrtype); + + # don't attempt export on an invalid record + my $error = $self->check; + return $error if $error; + + # exportage + $old->set('groupname', $old->radius_group->groupname); + if ( !$noexport_hack ) { + foreach ( qsearch('part_export', {}) ) { + next if !$_->option('export_attrs',1); + $error = $_->export_attr_replace($self, $old); + return $error if $error; + } + } + + $self->SUPER::replace($old); +} + + +=item check + +Checks all fields to make sure this is a valid example. If there is +an error, returns the error, otherwise returns false. Called by the insert +and replace methods. + +=cut + +sub check { + my $self = shift; + + my $error = + $self->ut_numbern('attrnum') + || $self->ut_foreign_key('groupnum', 'radius_group', 'groupnum') + || $self->ut_text('attrname') + || $self->ut_text('value') + || $self->ut_enum('attrtype', [ 'C', 'R' ]) + ; + return $error if $error; + + my @ops = $self->ops($self->get('attrtype')); + $self->set('op' => $ops[0]) if !$self->get('op'); + $error ||= $self->ut_enum('op', \@ops); + + return $error if $error; + + $self->SUPER::check; +} + +=item radius_group + +Returns the L<FS::radius_group> object to which this attribute applies. + +=cut + +sub radius_group { + my $self = shift; + qsearchs('radius_group', { 'groupnum' => $self->groupnum }); +} + +=back + +=head1 CLASS METHODS + +=over 4 + +=item ops ATTRTYPE + +Returns a list of all legal values of the "op" field. ATTRTYPE must be C for +check or R for reply. + +=cut + +my %ops = ( + C => [ '==', ':=', '+=', '!=', '>', '>=', '<', '<=', '=~', '!~', '=*', '!*' ], + R => [ '=', ':=', '+=' ], +); + +sub ops { + my $self = shift; + my $attrtype = shift; + return @{ $ops{$attrtype} }; +} + +=back + +=head1 BUGS + +=head1 SEE ALSO + +L<FS::Record>, schema.html from the base documentation. + +=cut + +1; diff --git a/FS/FS/radius_group.pm b/FS/FS/radius_group.pm index eeb291b..8adf923 100644 --- a/FS/FS/radius_group.pm +++ b/FS/FS/radius_group.pm @@ -1,8 +1,9 @@ package FS::radius_group; use strict; -use base qw( FS::Record ); +use base qw( FS::o2m_Common FS::Record ); use FS::Record qw( qsearch qsearchs ); +use FS::radius_attr; =head1 NAME @@ -42,6 +43,10 @@ groupname description +=item priority + +priority - for export + =back @@ -77,7 +82,9 @@ Delete this record from the database. =cut -# the delete method can be inherited from FS::Record +# I'd delete any linked attributes here but we don't really support group +# deletion. We would also have to delete linked records from +# radius_usergroup and part_svc_column... =item replace OLD_RECORD @@ -86,7 +93,28 @@ returns the error, otherwise returns false. =cut -# the replace method can be inherited from FS::Record +# To keep these things from proliferating, we will follow the same +# export/noexport switches that radius_attr uses. If you _don't_ use +# Freeside to maintain your RADIUS group attributes, then it probably +# shouldn't try to rename groups either. + +sub replace { + my ($self, $old) = @_; + $old ||= $self->replace_old; + + my $error = $self->check; + return $error if $error; + + if ( !$FS::radius_attr::noexport_hack ) { + foreach ( qsearch('part_export', {}) ) { + next if !$_->option('export_attrs',1); + $error = $_->export_group_replace($self, $old); + return $error if $error; + } + } + + $self->SUPER::replace($old); +} =item check @@ -106,6 +134,7 @@ sub check { $self->ut_numbern('groupnum') || $self->ut_text('groupname') || $self->ut_textn('description') + || $self->ut_numbern('priority') ; return $error if $error; @@ -125,6 +154,22 @@ sub long_description { : $self->groupname; } +=item radius_attr + +Returns all L<FS::radius_attr> objects (check and reply attributes) for +this group. + +=cut + +sub radius_attr { + my $self = shift; + qsearch({ + table => 'radius_attr', + hashref => {'groupnum' => $self->groupnum }, + order_by => 'ORDER BY attrtype, attrname', + }) +} + =back =head1 BUGS diff --git a/FS/MANIFEST b/FS/MANIFEST index e983ea2..c35f33d 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -620,3 +620,5 @@ FS/rate_tier.pm t/rate_tier.t FS/rate_tier_detail.pm t/rate_tier_detail.t +FS/radius_attr.pm +t/radius_attr.t diff --git a/FS/bin/freeside-sqlradius-reset b/FS/bin/freeside-sqlradius-reset index 8ecd39d..b04c640 100755 --- a/FS/bin/freeside-sqlradius-reset +++ b/FS/bin/freeside-sqlradius-reset @@ -35,7 +35,10 @@ unless ( $opt_n ) { map { $export->option($_) } qw( datasrc username password ) ) or die $DBI::errstr; my $usergroup = $export->option('usergroup') || 'usergroup'; - for my $table (qw( radcheck radreply ), $usergroup) { + my @attr_tables; + @attr_tables = qw( radgroupcheck radgroupreply ) + if $export->option('export_attrs'); + for my $table (qw( radcheck radreply ), $usergroup, @attr_tables) { my $sth = $icradius_dbh->prepare("DELETE FROM $table"); $sth->execute or die "Can't reset $table table: ". $sth->errstr; } @@ -47,6 +50,9 @@ use FS::svc_Common; $FS::svc_Common::overlimit_missing_cust_svc_nonfatal_kludge = 1; $FS::svc_Common::overlimit_missing_cust_svc_nonfatal_kludge = 1; +# this is the same across all exports, for now +my @radius_attrs = qsearch('radius_attr', {}); + foreach my $export ( @exports ) { #my @svcparts = map { $_->svcpart } $export->export_svc; @@ -85,6 +91,13 @@ foreach my $export ( @exports ) { die $error if $error; } + + if ( $export->option('export_attrs') ) { + foreach my $attr (@radius_attrs) { + my $error = $export->export_attr_insert($attr); + die $error if $error; + } + } } sub usage { diff --git a/FS/t/radius_attr.t b/FS/t/radius_attr.t new file mode 100644 index 0000000..e17dff1 --- /dev/null +++ b/FS/t/radius_attr.t @@ -0,0 +1,5 @@ +BEGIN { $| = 1; print "1..1\n" } +END {print "not ok 1\n" unless $loaded;} +use FS::radius_attr; +$loaded=1; +print "ok 1\n"; diff --git a/httemplate/browse/radius_group.html b/httemplate/browse/radius_group.html index e2ac563..fbf6d37 100644 --- a/httemplate/browse/radius_group.html +++ b/httemplate/browse/radius_group.html @@ -1,18 +1,20 @@ <& elements/browse.html, - 'title' => 'RADIUS Groups', - 'name' => 'RADIUS Groups', - 'menubar' => [ 'Add a RADIUS Group' => $p.'edit/radius_group.html', ], - 'query' => { 'table' => 'radius_group' }, - 'count_query' => 'SELECT COUNT(*) FROM radius_group', - 'header' => [ '#', 'RADIUS Group', 'Description' ], - 'fields' => [ 'groupnum', - 'groupname', - 'description', - ], - 'links' => [ [ $p.'edit/radius_group.html?', 'groupnum' ], - '', - '', - ], + 'title' => 'RADIUS Groups', + 'name' => 'RADIUS Groups', + 'menubar' => [ 'Add a RADIUS Group' => $p.'edit/radius_group.html', ], + 'query' => { 'table' => 'radius_group' }, + 'count_query' => 'SELECT COUNT(*) FROM radius_group', + 'header' => [ '#', 'RADIUS Group', 'Description', 'Priority', + 'Check', 'Reply' ], + 'fields' => [ 'groupnum', + 'groupname', + 'description', + 'priority', + $check_attr, $reply_attr + ], + 'align' => 'lllcll', + 'links' => [ $link, $link, '', '', '', '', + ], &> <%init> @@ -21,4 +23,18 @@ my $curuser = $FS::CurrentUser::CurrentUser; die "access denied" unless $curuser->access_right('Configuration'); +my $attr_sub = sub { + my $type = shift; + my $radius_group = shift; + [ map { [ { data => join(' ', $_->attrname, $_->op, $_->value) } ] } + grep {$_->attrtype eq $type} + $radius_group->radius_attr + ]; +}; + +my $check_attr = sub { &$attr_sub('C', @_) }; +my $reply_attr = sub { &$attr_sub('R', @_) }; + +my $link = [ $p.'edit/radius_group.html?', 'groupnum' ]; + </%init> diff --git a/httemplate/edit/process/radius_group.html b/httemplate/edit/process/radius_group.html index 706813f..8846946 100644 --- a/httemplate/edit/process/radius_group.html +++ b/httemplate/edit/process/radius_group.html @@ -1,10 +1,27 @@ <& elements/process.html, - 'table' => 'radius_group', - 'viewall_dir' => 'browse', + 'table' => 'radius_group', + 'viewall_dir' => 'browse', + 'process_o2m' => { + 'table' => 'radius_attr', + 'fields' => [ qw( attrtype attrname op value )], + }, + 'precheck_callback' => $precheck_callback, &> <%init> - die "access denied" unless $FS::CurrentUser::CurrentUser->access_right('Configuration'); +my $precheck_callback = sub { + my $cgi = shift; + my $param = $cgi->Vars; + # remove rows with a blank attrname and attrnum + foreach my $k (grep /^attrnum\d+$/, keys %$param) { + if ( !length($param->{$k}) and !length($param->{$k.'_attrname'}) ) { + delete $param->{$k.'_'.$_} foreach qw(attrtype attrname op value); + delete $param->{$k}; + } + } + ''; +}; + </%init> diff --git a/httemplate/edit/radius_group.html b/httemplate/edit/radius_group.html index 80e17ed..c9bf525 100644 --- a/httemplate/edit/radius_group.html +++ b/httemplate/edit/radius_group.html @@ -1,16 +1,58 @@ <& elements/edit.html, - 'name' => 'RADIUS Group', - 'table' => 'radius_group', - 'labels' => { - 'groupnum' => 'Group', - 'groupname' => 'RADIUS Group', - 'description' => 'Description', - }, - 'viewall_dir' => 'browse', + 'name' => 'RADIUS Group', + 'table' => 'radius_group', + 'labels' => { + 'groupnum' => 'Group', + 'groupname' => 'RADIUS Group', + 'description' => 'Description', + 'attrnum' => 'Attribute', + 'priority' => 'Priority', + }, + 'viewall_dir' => 'browse', + 'fields' => [ + { 'field' => 'groupname', + 'type' => 'text', + 'size' => 20, + 'colspan' => 6, # just to not interfere with radius_attr columns + }, + { 'field' => 'description', + 'type' => 'text', + 'size' => 40, + 'colspan' => 6, + }, + { 'field' => 'priority', + 'type' => 'text', + 'size' => 2, + 'colspan' => 6, # just to not interfere with radius_attr columns + }, + { + 'field' => 'attrnum', + 'type' => 'radius_attr', + 'o2m_table' => 'radius_attr', + 'm2_label' => 'Attribute', + 'm2_error_callback' => $m2_error_callback, + }, + ], + #debug => 1 &> <%init> die "access denied" unless $FS::CurrentUser::CurrentUser->access_right('Configuration'); +my $m2_error_callback = sub { # reconstruct the list + my ($cgi, $object) = @_; + + warn Dumper({$cgi->Vars}); + my @fields = qw(attrname attrtype op value); + map { + my $k = $_; + next if !length($cgi->param($k.'_attrname')); + new FS::radius_attr { + 'groupnum' => $object->groupnum, + 'attrnum' => scalar( $cgi->param($k) ), + map { $_ => scalar( $cgi->param($k.'_'.$_) ) } @fields, + }; + } grep /^attrnum\d+$/, ($cgi->param); +}; </%init> diff --git a/httemplate/elements/radius_attr.html b/httemplate/elements/radius_attr.html new file mode 100644 index 0000000..2ebf346 --- /dev/null +++ b/httemplate/elements/radius_attr.html @@ -0,0 +1,89 @@ +% if ( $first_row ) { +% $first_row = ''; +<SCRIPT TYPE="text/javascript"> +var ops_for_type = { +% foreach my $type ('C','R') { +'<%$type%>': [<% join(',', map {"'$_'"} FS::radius_attr->ops($type)) %>], +% } +}; +function change_attrtype(what) { + var new_type = what.value; + var select_op = document.getElementById( + what.id.replace(/_attrtype$/, '_op') + ); + if ( select_op ) { + var options = select_op.options; + var new_ops = ops_for_type[new_type]; + while ( options.length > 0 ) + options.remove(0); + for ( var x in new_ops ) { + // Option(text, value, defaultSelected) + options.add(new Option(new_ops[x], new_ops[x], (options.length == 0))); + } + } + <% $onchange %>(what); +} +</SCRIPT> +% } #if $first_row +<INPUT TYPE="hidden" NAME="<%$name%>" ID="<%$id%>" VALUE="<% $curr_value %>"> +<& select.html, + field => $name.'_attrtype', + id => $name.'_attrtype', + options => ['C','R'], + labels => { 'C' => 'Check', 'R' => 'Reply' }, + curr_value => $radius_attr->attrtype, + onchange => 'change_attrtype(this)', +&> +<& input-text.html, + field => $name.'_attrname', + curr_value => $radius_attr->attrname, + onchange => $onchange, + size => 40, #longest attribute name in freeradius dict = 46 +&> +<& select.html, + field => $name.'_op', + id => $name.'_op', + options => [ FS::radius_attr->ops($radius_attr->attrtype) ], + curr_value => $radius_attr->op, + onchange => $onchange, +&> +<& input-text.html, + field => $name.'_value', + curr_value => $radius_attr->value, + onchange => $onchange, + size => 20, #tend to be shorter than attribute names +&> +<%shared> +my $first_row = 1; +</%shared> +<%init> + +my( %opt ) = @_; + +# for an 'onchange' option that will work in both select.html and +# input-text.html: +# - don't start with "onchange=" +# - don't end with (what) or (this) +# - don't end with a semicolon +# - don't have quotes +my $onchange = $opt{'onchange'} || ''; +$onchange =~ s/\((what|this)\);?$//; + +my $name = $opt{'element_name'} || $opt{'field'} || 'attrnum'; +my $id = $opt{'id'} || 'attrnum'; + +my $curr_value = $opt{'curr_value'} || $opt{'value'}; +my $radius_attr; + +if ( $curr_value ) { + $radius_attr = qsearchs('radius_attr', { 'attrnum' => $curr_value }) + or die "attrnum $curr_value not found"; +} +else { + $radius_attr = new FS::radius_attr { + 'attrtype' => 'C', + 'op' => '==', + }; +} + +</%init> diff --git a/httemplate/elements/select-table.html b/httemplate/elements/select-table.html index 741e51e..c0dde74 100644 --- a/httemplate/elements/select-table.html +++ b/httemplate/elements/select-table.html @@ -124,7 +124,7 @@ Example: my( %opt ) = @_; -warn "elements/select-table.html: \n". Dumper(%opt) +warn "elements/select-table.html: \n". Dumper(\%opt) if exists $opt{debug} && $opt{debug}; $opt{'extra_option_attributes'} ||= []; diff --git a/httemplate/elements/select.html b/httemplate/elements/select.html index 5249a6d..1bf56b5 100644 --- a/httemplate/elements/select.html +++ b/httemplate/elements/select.html @@ -45,9 +45,10 @@ my %opt = @_; -my $onchange = $opt{'onchange'} - ? 'onChange="'. $opt{'onchange'}. '(this)"' - : ''; +#no-op code... +#my $onchange = $opt{'onchange'} +# ? 'onChange="'. $opt{'onchange'}. '(this)"' +# : ''; my $labels = $opt{'option_labels'} || $opt{'labels'}; |