From 1e1a0a1a7945cae26175e3afe25e61ec6114c48e Mon Sep 17 00:00:00 2001 From: mark Date: Mon, 31 Oct 2011 19:20:29 +0000 Subject: [PATCH] export NAS table to sqlradius, #14697 --- FS/FS/export_nas.pm | 32 ++++++++-- FS/FS/nas.pm | 100 ++++++++++++++++++++---------- FS/FS/part_export.pm | 3 +- FS/FS/part_export/sqlradius.pm | 69 ++++++++++++++++++++- bin/clients.conf.import | 91 +++++++++++++++++++++++++++ bin/sqlradius-nas.import | 67 ++++++++++++++++++++ httemplate/edit/nas.html | 25 +++++++- httemplate/edit/part_export.cgi | 20 ++++++ httemplate/edit/process/nas.html | 7 ++- httemplate/edit/process/part_export.cgi | 10 +++ httemplate/elements/checkboxes-table.html | 4 ++ 11 files changed, 382 insertions(+), 46 deletions(-) create mode 100755 bin/clients.conf.import create mode 100755 bin/sqlradius-nas.import diff --git a/FS/FS/export_nas.pm b/FS/FS/export_nas.pm index 3829b41c7..5282503d0 100644 --- a/FS/FS/export_nas.pm +++ b/FS/FS/export_nas.pm @@ -1,9 +1,12 @@ package FS::export_nas; use strict; +use vars qw($noexport_hack); use base qw( FS::Record ); use FS::Record qw( qsearch qsearchs ); +$noexport_hack = ''; + =head1 NAME FS::export_nas - Object methods for export_nas records @@ -70,7 +73,11 @@ otherwise returns false. =cut -# the insert method can be inherited from FS::Record +sub insert { + my $self = shift; + $self->SUPER::insert || + ($noexport_hack ? '' : $self->part_export->export_nas_insert($self->nas)); +} =item delete @@ -78,16 +85,21 @@ Delete this record from the database. =cut -# the delete method can be inherited from FS::Record +sub delete { + my $self = shift; + ($noexport_hack ? '' : $self->part_export->export_nas_delete($self->nas)) + || $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. +Unavailable. Delete the record and create a new one. =cut -# the replace method can be inherited from FS::Record +sub replace { + die "replace not implemented for export_nas records"; +} =item check @@ -113,6 +125,16 @@ sub check { $self->SUPER::check; } +sub part_export { + my $self = shift; + qsearchs('part_export', { 'exportnum' => $self->exportnum }); +} + +sub nas { + my $self = shift; + qsearchs('nas', { 'nasnum' => $self->nasnum }); +} + =back =head1 BUGS diff --git a/FS/FS/nas.pm b/FS/FS/nas.pm index 7fb7db5e5..4564a6342 100644 --- a/FS/FS/nas.pm +++ b/FS/FS/nas.pm @@ -1,8 +1,10 @@ package FS::nas; use strict; -use base qw( FS::Record ); -use FS::Record qw( qsearch qsearchs ); +use base qw( FS::m2m_Common FS::Record ); +use FS::Record qw( qsearch qsearchs dbh ); +use FS::export_nas; +use FS::part_export; =head1 NAME @@ -30,41 +32,23 @@ FS::Record. The following fields are currently supported: =over 4 -=item nasnum +=item nasnum - primary key -primary key +=item nasname - "NAS name", i.e. IP address -=item nasname +=item shortname - short descriptive name -nasname - -=item shortname - -shortname - -=item type - -type +=item type - the equipment vendor =item ports -ports +=item secret - the authentication secret for this client -=item secret - -secret - -=item server - -server +=item server - virtual server name (optional) =item community -community - -=item description - -description +=item description - a longer descriptive name =back @@ -91,26 +75,62 @@ sub table { 'nas'; } Adds this record to the database. If there is an error, returns the error, otherwise returns false. -=cut - -# the insert method can be inherited from FS::Record - =item delete -Delete this record from the database. +Delete this record from the database and remove all linked exports. =cut -# the delete method can be inherited from FS::Record +sub delete { + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $self = shift; + my $error = $self->process_m2m([]) + || $self->SUPER::delete; + + if ( $error ) { + $dbh->rollback; + return $error; + } + + $dbh->commit if $oldAutoCommit; + ''; +} =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. +To change the list of linked exports, see the C method. + =cut -# the replace method can be inherited from FS::Record +sub replace { + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my ($self, $old) = @_; + $old ||= qsearchs('nas', { 'nasnum' => $self->nasnum }); + + my $error; + foreach my $part_export ( $self->part_export ) { + $error ||= $part_export->export_nas_replace($self, $old); + } + + $error ||= $self->SUPER::replace($old); + + if ( $error ) { + $dbh->rollback; + return $error; + } + + $dbh->commit if $oldAutoCommit; + ''; +} =item check @@ -142,6 +162,18 @@ sub check { $self->SUPER::check; } +=item part_export + +Return all L objects to which this NAS is being exported. + +=cut + +sub part_export { + my $self = shift; + map { qsearchs('part_export', { exportnum => $_->exportnum }) } + qsearch('export_nas', { nasnum => $self->nasnum}) +} + =back =head1 BUGS diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm index 9a479b7c8..f84f2a096 100644 --- a/FS/FS/part_export.pm +++ b/FS/FS/part_export.pm @@ -4,8 +4,8 @@ use strict; use vars qw( @ISA @EXPORT_OK $DEBUG %exports ); use Exporter; use Tie::IxHash; +use base qw( FS::option_Common FS::m2m_Common ); # m2m for 'export_nas' use FS::Record qw( qsearch qsearchs dbh ); -use FS::option_Common; use FS::part_svc; use FS::part_export_option; use FS::export_svc; @@ -13,7 +13,6 @@ use FS::export_svc; #for export modules, though they should probably just use it themselves use FS::queue; -@ISA = qw( FS::option_Common ); @EXPORT_OK = qw(export_info); $DEBUG = 0; diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm index c51429de2..07f6cf05c 100644 --- a/FS/FS/part_export/sqlradius.pm +++ b/FS/FS/part_export/sqlradius.pm @@ -106,6 +106,7 @@ END 'desc' => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS)', 'options' => \%options, 'nodomain' => 'Y', + 'nas' => 'Y', # show export_nas selection in UI 'notes' => $notes1. 'This export does not export RADIUS realms (see also '. 'sqlradius_withdomain). '. @@ -761,7 +762,7 @@ sub update_svc { AcctInputOctets, AcctOutputOctets FROM radacct WHERE FreesideStatus IS NULL - AND AcctStopTime != 0 + AND AcctStopTime IS NOT NULL ") or die $dbh->errstr; $sth->execute() or die $sth->errstr; @@ -864,6 +865,72 @@ sub _try_decrement { return 'skipped'; } +=item export_nas_insert NAS + +=item export_nas_delete NAS + +=item export_nas_replace NEW_NAS OLD_NAS + +Update the NAS table (allowed RADIUS clients) on the attached RADIUS +server. Currently requires the table to be named 'nas' and to follow +the stock schema (/etc/freeradius/nas.sql). + +=cut + +sub export_nas_insert { shift->export_nas_action('insert', @_); } +sub export_nas_delete { shift->export_nas_action('delete', @_); } +sub export_nas_replace { shift->export_nas_action('replace', @_); } + +sub export_nas_action { + my $self = shift; + my ($action, $new, $old) = @_; + # find the NAS in the target table by its name + my $nasname = ($action eq 'replace') ? $old->nasname : $new->nasname; + my $nasnum = $new->nasnum; + + my $err_or_queue = $self->sqlradius_queue('', "nas_$action", + nasname => $nasname, + nasnum => $nasnum + ); + return $err_or_queue unless ref $err_or_queue; + ''; +} + +sub sqlradius_nas_insert { + my $dbh = sqlradius_connect(shift, shift, shift); + my %opt = @_; + my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} }) + or die "nasnum ".$opt{'nasnum'}.' not found'; + # insert actual NULLs where FS::Record has translated to empty strings + my @values = map { length($nas->$_) ? $nas->$_ : undef } + qw( nasname shortname type secret server community description ); + my $sth = $dbh->prepare('INSERT INTO nas +(nasname, shortname, type, secret, server, community, description) +VALUES (?, ?, ?, ?, ?, ?, ?)'); + $sth->execute(@values) or die $dbh->errstr; +} + +sub sqlradius_nas_delete { + my $dbh = sqlradius_connect(shift, shift, shift); + my %opt = @_; + my $sth = $dbh->prepare('DELETE FROM nas WHERE nasname = ?'); + $sth->execute($opt{'nasname'}) or die $dbh->errstr; +} + +sub sqlradius_nas_replace { + my $dbh = sqlradius_connect(shift, shift, shift); + my %opt = @_; + my $nas = qsearchs('nas', { nasnum => $opt{'nasnum'} }) + or die "nasnum ".$opt{'nasnum'}.' not found'; + my @values = map {$nas->$_} + qw( nasname shortname type secret server community description ); + my $sth = $dbh->prepare('UPDATE nas SET + nasname = ?, shortname = ?, type = ?, secret = ?, + server = ?, community = ?, description = ? + WHERE nasname = ?'); + $sth->execute(@values, $opt{'nasname'}) or die $dbh->errstr; +} + ### #class methods ### diff --git a/bin/clients.conf.import b/bin/clients.conf.import new file mode 100755 index 000000000..16aac4b27 --- /dev/null +++ b/bin/clients.conf.import @@ -0,0 +1,91 @@ +#!/usr/bin/perl -w + +use strict; +use DBI; +use FS::UID qw(adminsuidsetup); #datasrc +use FS::Record qw(qsearch qsearchs dbh); +use FS::nas; +use FS::export_nas; +use FS::part_export; + +my $user = shift or die &usage; +my $filename = shift or die &usage; +my $all_nas = []; + +my $client; +my $in; +open ($in, '<', $filename) or die "can't open $filename for reading\n"; +my $i = 0; +while (my $line = <$in>) { + $i++; + $line =~ s/#.*//; + my @t = grep $_, split(/\s+/, $line); + next if !@t; + if ( $client ) { + if ( $t[0] eq 'ipaddr' ) { + $client->{nasname} = $t[2]; + } + elsif ( $t[0] eq 'secret' ) { + $client->{secret} = $t[2]; + } + elsif( $t[0] eq 'shortname' ) { + $client->{shortname} = $t[2]; + } + elsif( $t[0] eq 'nastype' ) { + $client->{type} = $t[2]; + } + elsif( $t[0] eq 'virtual_server' ) { + $client->{server} = $t[2]; + } + elsif( $t[0] eq '}' ) { + $client->{description} = $client->{shortname}; + push @$all_nas, $client; + undef $client; + } + else { + warn "unknown parameter '$t[0]' (line $i), skipped\n"; + next; + } + } + else { # not in a client section + die "parse error (line $i)\n" if $t[0] ne 'client' or $t[2] ne '{'; + $client = { nasname => $t[1], + shortname => $t[1] }; # hostname + } +} +close $in; + +warn scalar(@$all_nas)." records found.\n"; + +adminsuidsetup $user; + +$FS::UID::AutoCommit = 0; +my $dbh = dbh; + +# cache NAS names we already know about, and don't import them +my %existing_names = map { $_->nasname , $_->nasnum } qsearch('nas', {}); + +my $inserted = 0; +foreach my $row (@$all_nas) { + my %hash = %$row; + if (my $num = $existing_names{ $hash{nasname} }) { + warn "NAS $hash{nasname} already exists as #$num (skipped)\n"; + } + else { + my $nas = FS::nas->new(\%hash); + my $error = $nas->insert; + if ( $error ) { + $dbh->rollback; + die "error inserting $hash{nasname}: $error (changes reverted)\n"; + } + $inserted++; + } +} #foreach $row + +warn "Inserted $inserted NAS records.\n\n"; +$dbh->commit; + +sub usage { + die "Usage:\n\n clients.conf.import user filename\n\n"; +} + diff --git a/bin/sqlradius-nas.import b/bin/sqlradius-nas.import new file mode 100755 index 000000000..0583272db --- /dev/null +++ b/bin/sqlradius-nas.import @@ -0,0 +1,67 @@ +#!/usr/bin/perl -w + +use strict; +use DBI; +use FS::UID qw(adminsuidsetup); #datasrc +use FS::Record qw(qsearch qsearchs dbh); +use FS::nas; +use FS::export_nas; +use FS::part_export; + +my $user = shift or die &usage; +adminsuidsetup $user; + +$FS::export_nas::noexport_hack = 1; +$FS::UID::AutoCommit = 0; +my $dbh = dbh; + +my $exportnum = shift or die &usage; +my $part_export = qsearchs('part_export', { exportnum => $exportnum }) + or die "export $exportnum not found.\n"; + +$part_export->isa('FS::part_export::sqlradius') + or die "export $exportnum is not an sqlradius export.\n"; + +my $raddbh = DBI->connect( + $part_export->option('datasrc'), + $part_export->option('username'), + $part_export->option('password') +); + +# cache NAS names we already know about, and don't import them +my %existing_names = map { $_->nasname , $_->nasnum } qsearch('nas', {}); + +my @fields = (qw( nasname shortname type secret server community description )); +my $sql = 'SELECT '.join(', ',@fields).' FROM nas'; +my $all_nas = $raddbh->selectall_arrayref($sql) + or die "unable to retrieve NAS records: ".$dbh->errstr."\n"; + +warn scalar(@$all_nas)." records found.\n"; +my $inserted = 0; +foreach my $row (@$all_nas) { + my %hash; + @hash{@fields} = @$row; + if (my $num = $existing_names{ $hash{nasname} }) { + warn "NAS $hash{nasname} already exists as #$num (skipped)\n"; + } + else { + my $nas = FS::nas->new(\%hash); + my $error = $nas->insert + || $nas->process_m2m(link_table => 'export_nas', + target_table => 'part_export', + params => [ $exportnum ]); + if ( $error ) { + $dbh->rollback; + die "error inserting $hash{nasname}: $error (changes reverted)\n"; + } + $inserted++; + } +} #foreach $row + +warn "Inserted $inserted NAS records.\n\n"; +$dbh->commit; + +sub usage { + die "Usage:\n\n sqlradius-nas.import user exportnum\n\n"; +} + diff --git a/httemplate/edit/nas.html b/httemplate/edit/nas.html index 64d722e52..9d9b8e9fd 100644 --- a/httemplate/edit/nas.html +++ b/httemplate/edit/nas.html @@ -8,7 +8,7 @@ 'secret' => 'Shared secret', 'type' => 'Type', 'ports' => 'Ports', - 'server' => 'Server', + 'server' => 'Virtual server', 'community' => 'Community', 'description' => 'Description', }, @@ -25,8 +25,7 @@ { field=>'community', size=>40, maxlength=>50 }, { field=>'description', size=>100, maxlength=>200 }, ], - 'html_bottom' => '* '. - emt('required fields'). '
', + 'html_bottom' => \&html_bottom, 'new_hashref_callback' => sub { +{ 'type' => 'other', 'secret' => 'secret', 'description' => 'RADIUS Client', @@ -38,4 +37,24 @@ die "access denied" unless $FS::CurrentUser::CurrentUser->access_right('Configuration'); +sub html_bottom { + my $nas = shift; + '* '. + emt('required fields'). '

'. + ''.emt('Export to these RADIUS servers:'). + '
'. + + include('/elements/checkboxes-table.html', + 'source_obj' => $nas, + 'link_table' => 'export_nas', + 'target_table' => 'part_export', + 'hashref' => { 'exporttype' => 'sqlradius' }, + 'name_callback' => sub { $_[0]->label }, + 'default' => 'yes', + 'target_link' => $p.'edit/part_export.cgi?', + 'disable-able' => 1, + ) +} + + diff --git a/httemplate/edit/part_export.cgi b/httemplate/edit/part_export.cgi index 32ed1fc94..9a0e0bd29 100644 --- a/httemplate/edit/part_export.cgi +++ b/httemplate/edit/part_export.cgi @@ -139,6 +139,26 @@ my $widget = new HTML::Widgets::SelectLayers( $html .= ''; } } + + if ( $exports->{$layer}{nas} and qsearch('nas',{}) ) { + # show NAS checkboxes + $html .= 'Export RADIUS clients'; + + $html .= include('/elements/checkboxes-table.html', + 'source_obj' => $part_export, + 'link_table' => 'export_nas', + 'target_table' => 'nas', + #hashref => {}, + 'name_callback' => sub { + $_[0]->shortname . ' (' . $_[0]->nasname . ')', + }, + 'default' => 'yes', + 'target_link' => $p.'edit/nas.html?', + ); + + $html .= ''; + } + $html .= ''; $html .= 'exportnum; } +my $info = FS::part_export::export_info()->{$new->exporttype}; +if ( $info->{nas} ) { + my @nasnums = map { /^nasnum(\d+)$/ ? $1 : () } keys %{ $cgi->Vars }; + $error ||= $new->process_m2m( + link_table => 'export_nas', + target_table => 'nas', + params => \@nasnums + ); +} + diff --git a/httemplate/elements/checkboxes-table.html b/httemplate/elements/checkboxes-table.html index a31bdb919..671cd1f9b 100644 --- a/httemplate/elements/checkboxes-table.html +++ b/httemplate/elements/checkboxes-table.html @@ -81,6 +81,10 @@ % ? 'CHECKED' % : ''; % +% } elsif ( !$sourcenum ) { # newly created object, has no links yet +% +% $checked = $opt{'default'} ? 'CHECKED' : '' +% % } else { % % $checked = qsearchs( $opt{'link_table'}, { -- 2.11.0