RADIUS session viewing
[freeside.git] / FS / FS / part_export / sqlradius.pm
index b31ec5c..85e5969 100644 (file)
@@ -1,29 +1,87 @@
 package FS::part_export::sqlradius;
 
-use vars qw(@ISA);
+use vars qw(@ISA %info %options $notes1 $notes2);
+use Tie::IxHash;
 use FS::Record qw( dbh );
 use FS::part_export;
 
 @ISA = qw(FS::part_export);
 
+tie %options, 'Tie::IxHash',
+  'datasrc'  => { label=>'DBI data source ' },
+  'username' => { label=>'Database username' },
+  'password' => { label=>'Database password' },
+  'ignore_accounting' => {
+     type => 'checkbox',
+     label=>'Ignore accounting records from this database'
+  },
+;
+
+$notes1 = <<'END';
+Real-time export of radcheck, radreply and usergroup tables to any SQL database
+for <a href="http://www.freeradius.org/">FreeRADIUS</a>,
+<a href="http://radius.innercite.com/">ICRADIUS</a>
+or <a href="http://www.open.com.au/radiator/">Radiator</a>.  
+END
+
+$notes2 = <<'END';
+An existing RADIUS database will be updated in realtime, but you can use
+<a href="../docs/man/bin/freeside-sqlradius-reset">freeside-sqlradius-reset</a>
+to delete the entire RADIUS database and repopulate the tables from the
+Freeside database.  See the
+<a href="http://search.cpan.org/dist/DBI/DBI.pm#connect">DBI documentation</a>
+and the
+<a href="http://search.cpan.org/search?mode=module&query=DBD%3A%3A">documentation for your DBD</a>
+for the exact syntax of a DBI data source.
+<ul>
+  <li>Using FreeRADIUS 0.9.0 with the PostgreSQL backend, the db_postgresql.sql schema and postgresql.conf queries contain incompatible changes.  This is fixed in 0.9.1.  Only new installs with 0.9.0 and PostgreSQL are affected - upgrades and other database backends and versions are unaffected.
+  <li>Using ICRADIUS, add a dummy "op" column to your database:
+    <blockquote><code>
+      ALTER&nbsp;TABLE&nbsp;radcheck&nbsp;ADD&nbsp;COLUMN&nbsp;op&nbsp;VARCHAR(2)&nbsp;NOT&nbsp;NULL&nbsp;DEFAULT&nbsp;'=='<br>
+      ALTER&nbsp;TABLE&nbsp;radreply&nbsp;ADD&nbsp;COLUMN&nbsp;op&nbsp;VARCHAR(2)&nbsp;NOT&nbsp;NULL&nbsp;DEFAULT&nbsp;'=='<br>
+      ALTER&nbsp;TABLE&nbsp;radgroupcheck&nbsp;ADD&nbsp;COLUMN&nbsp;op&nbsp;VARCHAR(2)&nbsp;NOT&nbsp;NULL&nbsp;DEFAULT&nbsp;'=='<br>
+      ALTER&nbsp;TABLE&nbsp;radgroupreply&nbsp;ADD&nbsp;COLUMN&nbsp;op&nbsp;VARCHAR(2)&nbsp;NOT&nbsp;NULL&nbsp;DEFAULT&nbsp;'=='
+    </code></blockquote>
+  <li>Using Radiator, see the
+    <a href="http://www.open.com.au/radiator/faq.html#38">Radiator FAQ</a>
+    for configuration information.
+</ul>
+END
+
+%info = (
+  'svc'      => 'svc_acct',
+  'desc'     => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS, Radiator)',
+  'options'  => \%options,
+  'nodomain' => 'Y',
+  'notes'    => $notes1.
+                'This export does not export RADIUS realms (see also '.
+                'sqlradius_withdomain).  '.
+                $notes2
+);
+
 sub rebless { shift; }
 
+sub export_username {
+  my($self, $svc_acct) = (shift, shift);
+  $svc_acct->username;
+}
+
 sub _export_insert {
   my($self, $svc_acct) = (shift, shift);
 
   foreach my $table (qw(reply check)) {
     my $method = "radius_$table";
-    my %attrib = $svc_acct->$method;
+    my %attrib = $svc_acct->$method();
     next unless keys %attrib;
     my $err_or_queue = $self->sqlradius_queue( $svc_acct->svcnum, 'insert',
-      $table, $svc_acct->username, %attrib );
+      $table, $self->export_username($svc_acct), %attrib );
     return $err_or_queue unless ref($err_or_queue);
   }
   my @groups = $svc_acct->radius_groups;
   if ( @groups ) {
     my $err_or_queue = $self->sqlradius_queue(
       $svc_acct->svcnum, 'usergroup_insert',
-      $svc_acct->username, @groups );
+      $self->export_username($svc_acct), @groups );
     return $err_or_queue unless ref($err_or_queue);
   }
   '';
@@ -44,9 +102,9 @@ sub _export_replace {
   my $dbh = dbh;
 
   my $jobnum = '';
-  if ( $old->username ne $new->username ) {
+  if ( $self->export_username($old) ne $self->export_username($new) ) {
     my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'rename',
-      $new->username, $old->username );
+      $self->export_username($new), $self->export_username($old) );
     unless ( ref($err_or_queue) ) {
       $dbh->rollback if $oldAutoCommit;
       return $err_or_queue;
@@ -56,14 +114,14 @@ sub _export_replace {
 
   foreach my $table (qw(reply check)) {
     my $method = "radius_$table";
-    my %new = $new->$method;
-    my %old = $old->$method;
+    my %new = $new->$method();
+    my %old = $old->$method();
     if ( grep { !exists $old{$_} #new attributes
                 || $new{$_} ne $old{$_} #changed
               } keys %new
     ) {
       my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert',
-        $table, $new->username, %new );
+        $table, $self->export_username($new), %new );
       unless ( ref($err_or_queue) ) {
         $dbh->rollback if $oldAutoCommit;
         return $err_or_queue;
@@ -80,7 +138,7 @@ sub _export_replace {
     my @del = grep { !exists $new{$_} } keys %old;
     if ( @del ) {
       my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'attrib_delete',
-        $table, $new->username, @del );
+        $table, $self->export_username($new), @del );
       unless ( ref($err_or_queue) ) {
         $dbh->rollback if $oldAutoCommit;
         return $err_or_queue;
@@ -109,7 +167,7 @@ sub _export_replace {
 
   if ( @delgroups ) {
     my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'usergroup_delete',
-      $new->username, @delgroups );
+      $self->export_username($new), @delgroups );
     unless ( ref($err_or_queue) ) {
       $dbh->rollback if $oldAutoCommit;
       return $err_or_queue;
@@ -125,7 +183,7 @@ sub _export_replace {
 
   if ( @newgroups ) {
     my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'usergroup_insert',
-      $new->username, @newgroups );
+      $self->export_username($new), @newgroups );
     unless ( ref($err_or_queue) ) {
       $dbh->rollback if $oldAutoCommit;
       return $err_or_queue;
@@ -147,7 +205,7 @@ sub _export_replace {
 sub _export_delete {
   my( $self, $svc_acct ) = (shift, shift);
   my $err_or_queue = $self->sqlradius_queue( $svc_acct->svcnum, 'delete',
-    $svc_acct->username );
+    $self->export_username($svc_acct) );
   ref($err_or_queue) ? '' : $err_or_queue;
 }
 
@@ -187,11 +245,15 @@ sub sqlradius_insert { #subroutine, not method
     } else {
 
       my $i_sth = $dbh->prepare(
-        "INSERT INTO rad$table ( id, UserName, Attribute, Value ) ".
+        "INSERT INTO rad$table ( UserName, Attribute, op, Value ) ".
           "VALUES ( ?, ?, ?, ? )"
       ) or die $dbh->errstr;
-      $i_sth->execute( '', $username, $attribute, $attributes{$attribute} )
-        or die $i_sth->errstr;
+      $i_sth->execute(
+        $username,
+        $attribute,
+        ( $attribute =~ /Password/i ? '==' : ':=' ),
+        $attributes{$attribute},
+      ) or die $i_sth->errstr;
 
     }
 
@@ -204,10 +266,10 @@ sub sqlradius_usergroup_insert { #subroutine, not method
   my( $username, @groups ) = @_;
 
   my $sth = $dbh->prepare( 
-    "INSERT INTO usergroup ( id, UserName, GroupName ) VALUES ( ?, ?, ? )"
+    "INSERT INTO usergroup ( UserName, GroupName ) VALUES ( ?, ? )"
   ) or die $dbh->errstr;
   foreach my $group ( @groups ) {
-    $sth->execute( '', $username, $group )
+    $sth->execute( $username, $group )
       or die "can't insert into groupname table: ". $sth->errstr;
   }
   $dbh->disconnect;
@@ -271,3 +333,112 @@ sub sqlradius_connect {
   DBI->connect(@_) or die $DBI::errstr;
 }
 
+#--
+
+=item usage_sessions TIMESTAMP_START TIMESTAMP_END [ SVC_ACCT [ IP [ SQL_SELECT ] ] ]
+
+TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
+L<perlfunc/"time">.  Also see L<Time::Local> and L<Date::Parse> for conversion
+functions.
+
+SVC_ACCT, if specified, limits the results to the specified account.
+
+IP, if specified, limits the results to the specified IP address.
+
+#SQL_SELECT defaults to * if unspecified.  It can be useful to set it to 
+#SUM(acctsessiontime) or SUM(AcctInputOctets), etc.
+
+Returns an array of hash references
+Returns an arrayref of hashrefs with the following fields:
+
+=over 4
+
+=item username
+
+=item framedipaddress
+
+=item acctstarttime
+
+=item acctstoptime
+
+=item acctsessiontime
+
+=item acctinputoctets
+
+=item acctoutputoctets
+
+=back
+
+=cut
+
+#some false laziness w/cust_svc::seconds_since_sqlradacct
+
+sub usage_sessions {
+  my( $self, $start, $end ) = splice(@_, 0, 3);
+  my $svc_acct = @_ ? shift : '';
+  my $ip = @_ ? shift : '';
+  #my $select = @_ ? shift : '*';
+
+  $end ||= 2147483647;
+
+  return () if $self->option('ignore_accounting');
+
+  my $dbh = sqlradius_connect( map $self->option($_),
+                                   qw( datasrc username password ) );
+
+  #select a unix time conversion function based on database type
+  my $str2time;
+  if ( $dbh->{Driver}->{Name} =~ /^mysql(PP)?$/ ) {
+    $str2time = 'UNIX_TIMESTAMP(';
+  } elsif ( $dbh->{Driver}->{Name} eq 'Pg' ) {
+    $str2time = 'EXTRACT( EPOCH FROM ';
+  } else {
+    warn "warning: unknown database type ". $dbh->{Driver}->{Name}.
+         "; guessing how to convert to UNIX timestamps";
+    $str2time = 'extract(epoch from ';
+  }
+
+  my @fields = (
+                 qw( username realm framedipaddress
+                     acctsessiontime acctinputoctets acctoutputoctets
+                   ),
+                 "$str2time acctstarttime ) as acctstarttime",
+                 "$str2time acctstoptime ) as acctstoptime",
+               );
+
+  my @param = ();
+  my $where = '';
+
+  if ( $svc_acct ) {
+    my $username = $self->export_username($svc_acct);
+    if ( $svc_acct =~ /^([^@]+)\@([^@]+)$/ ) {
+      $where = '( UserName = ? OR ( UserName = ? AND Realm = ? ) ) AND';
+      push @param, $username, $1, $2;
+    } else {
+      $where = 'UserName = ? AND';
+      push @param, $username;
+    }
+  }
+
+  if ( length($ip) ) {
+    $where .= ' FramedIPAddress = ? AND';
+    push @param, $ip;
+  }
+
+  push @param, $start, $end;
+
+  my $sth = $dbh->prepare('SELECT '. join(', ', @fields).
+                          "  FROM radacct
+                             WHERE $where
+                                   $str2time AcctStopTime ) >= ?
+                               AND $str2time AcctStopTime ) <=  ?
+                               ORDER BY AcctStartTime DESC
+  ") or die $dbh->errstr;                                 
+  $sth->execute(@param) or die $sth->errstr;
+
+  [ map { { %$_ } } @{ $sth->fetchall_arrayref({}) } ];
+
+}
+
+1;
+