This commit was generated by cvs2svn to compensate for changes in r4407,
[freeside.git] / FS / FS / part_export / sqlradius.pm
index 5eddd3a..10bccb0 100644 (file)
@@ -1,27 +1,43 @@
 package FS::part_export::sqlradius;
 
-use vars qw(@ISA %info %options $notes1 $notes2);
+use vars qw(@ISA $DEBUG %info %options $notes1 $notes2);
 use Tie::IxHash;
-use FS::Record qw( dbh );
+use FS::Record qw( dbh qsearch );
 use FS::part_export;
+use FS::svc_acct;
+use FS::export_svc;
 
 @ISA = qw(FS::part_export);
 
+$DEBUG = 0;
+
 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'
+    type  => 'checkbox',
+    label => 'Ignore accounting records from this database'
+  },
+  'hide_ip' => {
+    type  => 'checkbox',
+    label => 'Hide IP address information on session reports',
+  },
+  'hide_data' => {
+    type  => 'checkbox',
+    label => 'Hide download/upload information on session reports',
+  },
+  'show_called_station' => {
+    type  => 'checkbox',
+    label => 'Show the Called-Station-ID on session reports',
   },
 ;
 
 $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>.  
+Real-time export of <b>radcheck</b>, <b>radreply</b> and <b>usergroup</b>
+tables to any SQL database for
+<a href="http://www.freeradius.org/">FreeRADIUS</a>
+or <a href="http://radius.innercite.com/">ICRADIUS</a>.
 END
 
 $notes2 = <<'END';
@@ -50,7 +66,7 @@ END
 
 %info = (
   'svc'      => 'svc_acct',
-  'desc'     => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS, Radiator)',
+  'desc'     => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS)',
   'options'  => \%options,
   'nodomain' => 'Y',
   'notes'    => $notes1.
@@ -63,6 +79,7 @@ sub rebless { shift; }
 
 sub export_username {
   my($self, $svc_acct) = (shift, shift);
+  warn "export_username called on $self with arg $svc_acct" if $DEBUG;
   $svc_acct->username;
 }
 
@@ -335,7 +352,7 @@ sub sqlradius_connect {
 
 #--
 
-=item usage_sessions TIMESTAMP_START TIMESTAMP_END [ SVC_ACCT [ IP [ SQL_SELECT ] ] ]
+=item usage_sessions TIMESTAMP_START TIMESTAMP_END [ SVC_ACCT [ IP [ PREFIX [ 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
@@ -345,10 +362,12 @@ SVC_ACCT, if specified, limits the results to the specified account.
 
 IP, if specified, limits the results to the specified IP address.
 
+PREFIX, if specified, limits the results to records with a matching
+Called-Station-ID.
+
 #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
@@ -367,6 +386,8 @@ Returns an arrayref of hashrefs with the following fields:
 
 =item acctoutputoctets
 
+=item calledstationid
+
 =back
 
 =cut
@@ -377,6 +398,7 @@ sub usage_sessions {
   my( $self, $start, $end ) = splice(@_, 0, 3);
   my $svc_acct = @_ ? shift : '';
   my $ip = @_ ? shift : '';
+  my $prefix = @_ ? shift : '';
   #my $select = @_ ? shift : '*';
 
   $end ||= 2147483647;
@@ -401,6 +423,7 @@ sub usage_sessions {
   my @fields = (
                  qw( username realm framedipaddress
                      acctsessiontime acctinputoctets acctoutputoctets
+                     calledstationid
                    ),
                  "$str2time acctstarttime ) as acctstarttime",
                  "$str2time acctstoptime ) as acctstoptime",
@@ -425,6 +448,11 @@ sub usage_sessions {
     push @param, $ip;
   }
 
+  if ( length($prefix) ) {
+    #assume sip: for now, else things get ugly trying to match /^\w+:$prefix/
+    $where .= " CalledStationID LIKE 'sip:$prefix\%' AND";
+  }
+
   push @param, $start, $end;
 
   my $sth = $dbh->prepare('SELECT '. join(', ', @fields).
@@ -440,5 +468,85 @@ sub usage_sessions {
 
 }
 
+=item update_svc_acct
+
+=cut
+
+sub update_svc_acct {
+  my $self = shift;
+
+  my $dbh = sqlradius_connect( map $self->option($_),
+                                   qw( datasrc username password ) );
+
+  my @fields = qw( radacctid username realm acctsessiontime );
+
+  my @param = ();
+  my $where = '';
+
+  my $sth = $dbh->prepare("
+    SELECT RadAcctId, UserName, Realm, AcctSessionTime
+      FROM radacct
+      WHERE FreesideStatus IS NULL
+        AND AcctStopTime != 0
+  ") or die $dbh->errstr;
+  $sth->execute() or die $sth->errstr;
+
+  while ( my $row = $sth->fetchrow_arrayref ) {
+    my($RadAcctId, $UserName, $Realm, $AcctSessionTime) = @$row;
+    warn "processing record: ".
+         "$RadAcctId ($UserName\@$Realm for ${AcctSessionTime}s"
+      if $DEBUG;
+
+    my %search = ( 'username' => $UserName );
+    my $extra_sql = '';
+    if ( ref($self) =~ /withdomain/ ) { #well...
+      $extra_sql = " AND '$Realm' = ( SELECT domain FROM svc_domain
+                          WHERE svc_domain.svcnum = svc_acct.domsvc ) ";
+      my $svc_domain = qsearch
+    }
+
+    my @svc_acct =
+      grep { qsearch( 'export_svc', { 'exportnum' => $self->exportnum,
+                                      'svcpart'   => $_->cust_svc->svcpart, } )
+           }
+      qsearch( 'svc_acct',
+                 { 'username' => $UserName },
+                 '',
+                 $extra_sql
+               );
+
+    my $errinfo = "for RADIUS detail RadAcctID $RadAcctId ".
+                  "(UserName $UserName, Realm $Realm)";
+    my $status = 'skipped';
+    if ( !@svc_acct ) {
+      warn "WARNING: no svc_acct record found $errinfo - skipping\n";
+    } elsif ( scalar(@svc_acct) > 1 ) {
+      warn "WARNING: multiple svc_acct records found $errinfo - skipping\n";
+    } else {
+      my $svc_acct = $svc_acct[0];
+      warn "found svc_acct ". $svc_acct->svcnum. " $errinfo\n" if $DEBUG;
+      if ( $svc_acct->seconds !~ /^$/ ) {
+        warn "  svc_acct.seconds found (". $svc_acct->seconds.
+             ") - decrementing\n"
+          if $DEBUG;
+        my $error = $svc_acct->decrement_seconds($AcctSessionTime);
+        die $error if $error;
+        $status = 'done';
+      } else {
+        warn "  no existing seconds value for svc_acct - skiping\n" if $DEBUG;
+      }
+    }
+
+    warn "setting FreesideStatus to $status $errinfo\n" if $DEBUG; 
+    my $psth = $dbh->prepare("UPDATE radacct
+                                SET FreesideStatus = ?
+                                WHERE RadAcctId = ?"
+    ) or die $dbh->errstr;
+    $psth->execute($status, $RadAcctId) or die $psth->errstr;
+
+  }
+
+}
+
 1;