export NAS table to sqlradius, #14697

diff --git a/FS/FS/export_nas.pm b/FS/FS/export_nas.pm
index 3829b41..5282503 100644 (file)
--- a/FS/FS/export_nas.pm
+++ b/FS/FS/export_nas.pm
@@ -1,9 +1,12 @@
 package FS::export_nas;
 
 use strict;
 package FS::export_nas;
 
 use strict;

+use vars qw($noexport_hack);

 use base qw( FS::Record );
 use FS::Record qw( qsearch qsearchs );
 
 use base qw( FS::Record );
 use FS::Record qw( qsearch qsearchs );
 

+$noexport_hack = '';
+

 =head1 NAME
 
 FS::export_nas - Object methods for export_nas records
 =head1 NAME
 
 FS::export_nas - Object methods for export_nas records


@@ -70,7 +73,11 @@ otherwise returns false.
 
 =cut
 
 
 =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
 
 
 =item delete
 


@@ -78,16 +85,21 @@ Delete this record from the database.
 
 =cut
 
 
 =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
 
 
 =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
 
 
 =cut
 

-# the replace method can be inherited from FS::Record
+sub replace {
+  die "replace not implemented for export_nas records";
+}

 
 =item check
 
 
 =item check
 


@@ -113,6 +125,16 @@ sub check {
   $self->SUPER::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
 =back
 
 =head1 BUGS

diff --git a/FS/FS/nas.pm b/FS/FS/nas.pm
index 7fb7db5..4564a63 100644 (file)
--- a/FS/FS/nas.pm
+++ b/FS/FS/nas.pm
@@ -1,8 +1,10 @@
 package FS::nas;
 
 use strict;
 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
 
 
 =head1 NAME
 


@@ -30,41 +32,23 @@ FS::Record.  The following fields are currently supported:
 
 =over 4
 
 
 =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
 
 
 =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
 
 
 =item community
 

-community
-
-=item description
-
-description
+=item description - a longer descriptive name

 
 
 =back
 
 
 =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.
 
 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
 
 =item delete
 

-Delete this record from the database.
+Delete this record from the database and remove all linked exports.

 
 =cut
 
 
 =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.
 
 
 =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
 
 =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
 
 
 =item check
 


@@ -142,6 +162,18 @@ sub check {
   $self->SUPER::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
 =back
 
 =head1 BUGS

diff --git a/FS/FS/part_export.pm b/FS/FS/part_export.pm
index 9a479b7..f84f2a0 100644 (file)
--- 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 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::Record qw( qsearch qsearchs dbh );

-use FS::option_Common;

 use FS::part_svc;
 use FS::part_export_option;
 use FS::export_svc;
 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;
 
 #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;
 @EXPORT_OK = qw(export_info);
 
 $DEBUG = 0;

diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm
index c51429d..07f6cf0 100644 (file)
--- 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',
   '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).  '.
   '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
            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;
 
   ") or die $dbh->errstr;
   $sth->execute() or die $sth->errstr;
 


@@ -864,6 +865,72 @@ sub _try_decrement {
   return 'skipped';
 }
 
   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
 ###
 ###
 #class methods
 ###

diff --git a/bin/clients.conf.import b/bin/clients.conf.import
new file mode 100755 (executable)
index 0000000..16aac4b
--- /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 (executable)
index 0000000..0583272
--- /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 64d722e..9d9b8e9 100644 (file)
--- a/httemplate/edit/nas.html
+++ b/httemplate/edit/nas.html
@@ -8,7 +8,7 @@
                          'secret'      => 'Shared secret',
                          'type'        => 'Type',
                          'ports'       => 'Ports',
                          'secret'      => 'Shared secret',
                          'type'        => 'Type',
                          'ports'       => 'Ports',

-                         'server'      => 'Server',
+                         'server'      => 'Virtual server',

                          'community'   => 'Community',
                          'description' => 'Description',
                        },
                          'community'   => 'Community',
                          'description' => 'Description',
                        },


@@ -25,8 +25,7 @@
       { field=>'community', size=>40, maxlength=>50 },
       { field=>'description', size=>100, maxlength=>200 },
     ],
       { field=>'community', size=>40, maxlength=>50 },
       { field=>'description', size=>100, maxlength=>200 },
     ],

-    'html_bottom'   => '<font color="#ff0000">*</font>&nbsp;'.
-                       emt('required fields'). '<BR>',
+    'html_bottom'   => \&html_bottom,

     'new_hashref_callback' => sub { +{ 'type'        => 'other',
                                        'secret'      => 'secret',
                                        'description' => 'RADIUS Client',
     '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');
 
 die "access denied"
   unless $FS::CurrentUser::CurrentUser->access_right('Configuration');
 

+sub html_bottom {
+  my $nas = shift;
+  '<font color="#ff0000">*</font>&nbsp;'.
+  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>
 </%init>

diff --git a/httemplate/edit/part_export.cgi b/httemplate/edit/part_export.cgi
index 32ed1fc..9a0e0bd 100644 (file)
--- a/httemplate/edit/part_export.cgi
+++ b/httemplate/edit/part_export.cgi
@@ -139,6 +139,26 @@ my $widget = new HTML::Widgets::SelectLayers(
         $html .= '</TD></TR>';
       }
     }
         $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="'.
     $html .= '</TABLE>';
 
     $html .= '<INPUT TYPE="hidden" NAME="options" VALUE="'.

diff --git a/httemplate/edit/process/nas.html b/httemplate/edit/process/nas.html
index 04b46a5..6b8e4b8 100644 (file)
--- a/httemplate/edit/process/nas.html
+++ b/httemplate/edit/process/nas.html
@@ -1,4 +1,9 @@
-<& 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"
 <%init>
 
 die "access denied"

diff --git a/httemplate/edit/process/part_export.cgi b/httemplate/edit/process/part_export.cgi
index 209419f..21150ef 100644 (file)
--- a/httemplate/edit/process/part_export.cgi
+++ b/httemplate/edit/process/part_export.cgi
@@ -39,4 +39,14 @@ if ( $exportnum ) {
 #  $exportnum = $new->exportnum;
 }
 
 #  $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>
 </%init>

diff --git a/httemplate/elements/checkboxes-table.html b/httemplate/elements/checkboxes-table.html
index a31bdb9..671cd1f 100644 (file)
--- a/httemplate/elements/checkboxes-table.html
+++ b/httemplate/elements/checkboxes-table.html
@@ -81,6 +81,10 @@
 %                    ? 'CHECKED'
 %                    : '';
 %
 %                    ? 'CHECKED'
 %                    : '';
 %

+%     } elsif ( !$sourcenum ) { # newly created object, has no links yet
+%
+%       $checked = $opt{'default'} ? 'CHECKED' : ''
+%

 %     } else {
 %
 %       $checked = qsearchs( $opt{'link_table'}, {
 %     } else {
 %
 %       $checked = qsearchs( $opt{'link_table'}, {