fix 'Can't call method svcdb without a package or object reference' when ordering...
[freeside.git] / FS / FS / part_export / sqlradius.pm
index 15aa986..736b34e 100644 (file)
@@ -12,8 +12,9 @@ use Carp qw( cluck );
 @ISA = qw(FS::part_export);
 @EXPORT_OK = qw( sqlradius_connect );
 
-$DEBUG = 0;
+$DEBUG = 1;
 
+my %groups;
 tie %options, 'Tie::IxHash',
   'datasrc'  => { label=>'DBI data source ' },
   'username' => { label=>'Database username' },
@@ -47,7 +48,21 @@ tie %options, 'Tie::IxHash',
     type  => 'checkbox',
     label => 'Show the Called-Station-ID on session reports',
   },
-  'overlimit_groups' => { label => 'Radius groups to assign to svc_acct which has exceeded its bandwidth or time limit (if not overridden by overlimit_groups global or per-agent config)', } ,
+  'overlimit_groups' => {
+      label => 'Radius groups to assign to svc_acct which has exceeded its bandwidth or time limit (if not overridden by overlimit_groups global or per-agent config)', 
+      type  => 'select',
+      multi => 1,
+      option_label  => sub {
+        $groups{$_[0]};
+      },
+      option_values => sub {
+        %groups = (
+              map { $_->groupnum, $_->long_description } 
+                  qsearch('radius_group', {}),
+            );
+            sort keys (%groups);
+      },
+   } ,
   'groups_susp_reason' => { label =>
                              'Radius group mapping to reason (via template user) (svcnum|username|username@domain  reasonnum|reason)',
                             type  => 'textarea',
@@ -91,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).  '.
@@ -103,18 +119,28 @@ 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 );
@@ -236,20 +262,24 @@ 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 =
+  my $error =
     $self->sqlreplace_usergroups( $new->svcnum,
                                   $self->export_username($new),
                                  '',
-                                  $svc_acct->usergroup,
+                                  [ $svc_acct->radius_groups ],
                                  \@newgroups,
                                );
   if ( $error ) {
@@ -288,7 +318,7 @@ sub _export_unsuspend {
                                          $self->export_username($svc_acct),
                                          '',
                                         \@oldgroups,
-                                        $svc_acct->usergroup,
+                                        [ $svc_acct->radius_groups ],
                                       );
   if ( $error ) {
     $dbh->rollback if $oldAutoCommit;
@@ -339,7 +369,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);
@@ -610,6 +640,7 @@ sub usage_sessions {
 
   my $opt = {};
   my($start, $end, $svc_acct, $ip, $prefix) = ( '', '', '', '', '');
+  my $summarize = 0;
   if ( ref($_[0]) ) {
     $opt = shift;
     $start    = $opt->{stoptime_start};
@@ -617,6 +648,7 @@ sub usage_sessions {
     $svc_acct = $opt->{svc_acct};
     $ip       = $opt->{ip};
     $prefix   = $opt->{prefix};
+    $summarize   = $opt->{summarize};
   } else {
     ( $start, $end ) = splice(@_, 0, 2);
     $svc_acct = @_ ? shift : '';
@@ -644,6 +676,10 @@ sub usage_sessions {
                  "$str2time acctstoptime ) as acctstoptime",
                );
 
+  @fields = ( 'username', 'sum(acctsessiontime) as acctsessiontime', 'sum(acctinputoctets) as acctinputoctets',
+              'sum(acctoutputoctets) as acctoutputoctets',
+            ) if $summarize;
+
   my @param = ();
   my @where = ();
 
@@ -696,11 +732,15 @@ sub usage_sessions {
   my $where = join(' AND ', @where);
   $where = "WHERE $where" if $where;
 
+  my $groupby = '';
+  $groupby = 'GROUP BY username' if $summarize;
+
+  my $orderby = 'ORDER BY AcctStartTime DESC';
+  $orderby = '' if $summarize;
+
   my $sth = $dbh->prepare('SELECT '. join(', ', @fields).
-                          "  FROM radacct
-                             $where
-                             ORDER BY AcctStartTime DESC
-  ") or die $dbh->errstr;                                 
+                          "  FROM radacct $where $groupby $orderby
+                        ") or die $dbh->errstr;                                 
   $sth->execute(@param) or die $sth->errstr;
 
   [ map { { %$_ } } @{ $sth->fetchall_arrayref({}) } ];
@@ -732,7 +772,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;
 
@@ -835,6 +875,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
 ###