X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fpart_export%2Fsqlradius.pm;h=7d0edd65ca3cc66ec0e25a4dc0758e83805ddf17;hb=bfee00e26a87ccc687f085fdeaffef8e4b2a9b50;hp=4dea80e494cd7b03c91b71733f99f45710de1948;hpb=5fdd19665fb7c0ad425a99d3dbf9ad7e27fbf44a;p=freeside.git

diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm
index 4dea80e49..7d0edd65c 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;
@@ -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';
@@ -106,6 +110,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).  '.
@@ -118,24 +123,34 @@ sub _groups_susp_reason_map { map { reverse( /^\s*(\S+)\s*(.*)$/ ) }
 
 sub rebless { shift; }
 
-sub export_username {
+sub export_username { # override for other svcdb
   my($self, $svc_acct) = (shift, shift);
   warn "export_username called on $self with arg $svc_acct" if $DEBUG > 1;
   $svc_acct->username;
 }
 
+sub radius_reply { #override for other svcdb
+  my($self, $svc_acct) = (shift, shift);
+  $svc_acct->radius_reply;
+}
+
+sub radius_check { #override for other svcdb
+  my($self, $svc_acct) = (shift, shift);
+  $svc_acct->radius_check;
+}
+
 sub _export_insert {
   my($self, $svc_x) = (shift, shift);
 
   foreach my $table (qw(reply check)) {
     my $method = "radius_$table";
-    my %attrib = $svc_x->$method();
+    my %attrib = $self->$method($svc_x);
     next unless keys %attrib;
     my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, '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)
@@ -217,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 : '',
@@ -251,22 +266,27 @@ sub _export_suspend {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
-  my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert',
-    'check', $self->export_username($new), $new->radius_check );
-  unless ( ref($err_or_queue) ) {
-    $dbh->rollback if $oldAutoCommit;
-    return $err_or_queue;
+  my @newgroups = $self->suspended_usergroups($svc_acct);
+
+  unless (@newgroups) { #don't change password if assigning to a suspended group
+
+    my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert',
+      'check', $self->export_username($new), $new->radius_check );
+    unless ( ref($err_or_queue) ) {
+      $dbh->rollback if $oldAutoCommit;
+      return $err_or_queue;
+    }
+
   }
 
-  my $error;
-  my (@newgroups) = $self->suspended_usergroups($svc_acct);
-  $error =
-    $self->sqlreplace_usergroups( $new->svcnum,
-                                  $self->export_username($new),
-				  '',
-                                  $svc_acct->usergroup,
-				  \@newgroups,
-				);
+  my $error =
+    $self->sqlreplace_usergroups(
+      $new->svcnum,
+      $self->export_username($new),
+      '',
+      [ $svc_acct->radius_groups('hashref') ],
+      \@newgroups,
+    );
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
     return $error;
@@ -299,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->usergroup,
-				       );
+  $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;
@@ -354,7 +375,7 @@ sub suspended_usergroups {
       if (!$userspec && exists($reasonmap{$r->reason}));
   }
   my $suspend_user;
-  if ($userspec =~ /^d+$/ ){
+  if ($userspec =~ /^\d+$/ ){
     $suspend_user = qsearchs( 'svc_acct', { 'svcnum' => $userspec } );
   }elsif ($userspec =~ /^\S+\@\S+$/){
     my ($username,$domain) = split(/\@/, $userspec);
@@ -365,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;
   ();
 }
 
@@ -418,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 " .
@@ -429,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} ) {
@@ -452,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;
   }
@@ -757,7 +781,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;
 
@@ -860,6 +884,257 @@ 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;
+}
+
+=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
 ###
@@ -873,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;
 }