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
=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
=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
$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
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
=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
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<export_nas> 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
$self->SUPER::check;
}
+=item part_export
+
+Return all L<FS::part_export> 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
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;
#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;
'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). '.
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;
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
###
--- /dev/null
+#!/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";
+}
+
--- /dev/null
+#!/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";
+}
+
'secret' => 'Shared secret',
'type' => 'Type',
'ports' => 'Ports',
- 'server' => 'Server',
+ 'server' => 'Virtual server',
'community' => 'Community',
'description' => 'Description',
},
{ field=>'community', size=>40, maxlength=>50 },
{ field=>'description', size=>100, maxlength=>200 },
],
- 'html_bottom' => '<font color="#ff0000">*</font> '.
- emt('required fields'). '<BR>',
+ 'html_bottom' => \&html_bottom,
'new_hashref_callback' => sub { +{ 'type' => 'other',
'secret' => 'secret',
'description' => 'RADIUS Client',
die "access denied"
unless $FS::CurrentUser::CurrentUser->access_right('Configuration');
+sub html_bottom {
+ my $nas = shift;
+ '<font color="#ff0000">*</font> '.
+ emt('required fields'). '<BR><BR>'.
+ '<FONT SIZE="+1"><B>'.emt('Export to these RADIUS servers:').
+ '</B></FONT><BR>'.
+
+ 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,
+ )
+}
+
+
</%init>
$html .= '</TD></TR>';
}
}
+
+ if ( $exports->{$layer}{nas} and qsearch('nas',{}) ) {
+ # show NAS checkboxes
+ $html .= '<TR><TD ALIGN="right">Export RADIUS clients</TD><TD>';
+
+ $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 .= '</TD></TR>';
+ }
+
$html .= '</TABLE>';
$html .= '<INPUT TYPE="hidden" NAME="options" VALUE="'.
-<& elements/process.html, table=>'nas', viewall_dir=>'browse', &>
+<& elements/process.html,
+ table => 'nas',
+ viewall_dir => 'browse',
+ process_m2m => { link_table => 'export_nas',
+ target_table => 'part_export' },
+&>
<%init>
die "access denied"
# $exportnum = $new->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
+ );
+}
+
</%init>
% ? 'CHECKED'
% : '';
%
+% } elsif ( !$sourcenum ) { # newly created object, has no links yet
+%
+% $checked = $opt{'default'} ? 'CHECKED' : ''
+%
% } else {
%
% $checked = qsearchs( $opt{'link_table'}, {
projects / freeside.git / commitdiff