last login reporting (#2952)
[freeside.git] / FS / FS / part_export / sqlradius.pm
index 03802b2..5e63e10 100644 (file)
@@ -2,10 +2,11 @@ package FS::part_export::sqlradius;
 
 use vars qw(@ISA $DEBUG %info %options $notes1 $notes2);
 use Tie::IxHash;
-use FS::Record qw( dbh qsearch );
+use FS::Record qw( dbh qsearch qsearchs str2time_sql );
 use FS::part_export;
 use FS::svc_acct;
 use FS::export_svc;
+use Carp qw( cluck );
 
 @ISA = qw(FS::part_export);
 
@@ -31,13 +32,19 @@ 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', } ,
+  'groups_susp_reason' => { label =>
+                             'Radius group mapping to reason (via template user) (svcnum|username|username@domain  reasonnum|reason)',
+                            type  => 'textarea',
+                          },
+
 ;
 
 $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';
@@ -66,7 +73,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.
@@ -75,11 +82,15 @@ END
                 $notes2
 );
 
+sub _groups_susp_reason_map { map { reverse( /^\s*(\S+)\s*(.*)$/ ) } 
+                              split( "\n", shift->option('groups_susp_reason'));
+}
+
 sub rebless { shift; }
 
 sub export_username {
   my($self, $svc_acct) = (shift, shift);
-  warn "export_username called on $self with arg $svc_acct" if $DEBUG;
+  warn "export_username called on $self with arg $svc_acct" if $DEBUG > 1;
   $svc_acct->username;
 }
 
@@ -96,6 +107,9 @@ sub _export_insert {
   }
   my @groups = $svc_acct->radius_groups;
   if ( @groups ) {
+    cluck localtime(). ": queuing usergroup_insert for ". $svc_acct->svcnum.
+          " (". $self->export_username($svc_acct). " with ". join(", ", @groups)
+      if $DEBUG;
     my $err_or_queue = $self->sqlradius_queue(
       $svc_acct->svcnum, 'usergroup_insert',
       $self->export_username($svc_acct), @groups );
@@ -170,50 +184,99 @@ sub _export_replace {
     }
   }
 
-  # (sorta) false laziness with FS::svc_acct::replace
-  my @oldgroups = @{$old->usergroup}; #uuuh
-  my @newgroups = $new->radius_groups;
-  my @delgroups = ();
-  foreach my $oldgroup ( @oldgroups ) {
-    if ( grep { $oldgroup eq $_ } @newgroups ) {
-      @newgroups = grep { $oldgroup ne $_ } @newgroups;
-      next;
-    }
-    push @delgroups, $oldgroup;
+  my $error;
+  my (@oldgroups) = $old->radius_groups;
+  my (@newgroups) = $new->radius_groups;
+  $error = $self->sqlreplace_usergroups( $new->svcnum,
+                                         $self->export_username($new),
+                                         $jobnum ? $jobnum : '',
+                                         \@oldgroups,
+                                         \@newgroups,
+                                       );
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
   }
 
-  if ( @delgroups ) {
-    my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'usergroup_delete',
-      $self->export_username($new), @delgroups );
-    unless ( ref($err_or_queue) ) {
-      $dbh->rollback if $oldAutoCommit;
-      return $err_or_queue;
-    }
-    if ( $jobnum ) {
-      my $error = $err_or_queue->depend_insert( $jobnum );
-      if ( $error ) {
-        $dbh->rollback if $oldAutoCommit;
-        return $error;
-      }
-    }
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+  '';
+}
+
+sub _export_suspend {
+  my( $self, $svc_acct ) = (shift, shift);
+
+  my $new = $svc_acct->clone_suspended;
+  
+  local $SIG{HUP} = 'IGNORE';
+  local $SIG{INT} = 'IGNORE';
+  local $SIG{QUIT} = 'IGNORE';
+  local $SIG{TERM} = 'IGNORE';
+  local $SIG{TSTP} = 'IGNORE';
+  local $SIG{PIPE} = 'IGNORE';
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  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;
   }
 
-  if ( @newgroups ) {
-    my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'usergroup_insert',
-      $self->export_username($new), @newgroups );
-    unless ( ref($err_or_queue) ) {
-      $dbh->rollback if $oldAutoCommit;
-      return $err_or_queue;
-    }
-    if ( $jobnum ) {
-      my $error = $err_or_queue->depend_insert( $jobnum );
-      if ( $error ) {
-        $dbh->rollback if $oldAutoCommit;
-        return $error;
-      }
-    }
+  my $error;
+  my (@newgroups) = $self->suspended_usergroups($svc_acct);
+  $error =
+    $self->sqlreplace_usergroups( $new->svcnum,
+                                  $self->export_username($new),
+                                 '',
+                                  $svc_acct->usergroup,
+                                 \@newgroups,
+                               );
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
+  $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+
+  '';
+}
+
+sub _export_unsuspend {
+  my( $self, $svc_acct ) = (shift, shift);
+
+  local $SIG{HUP} = 'IGNORE';
+  local $SIG{INT} = 'IGNORE';
+  local $SIG{QUIT} = 'IGNORE';
+  local $SIG{TERM} = 'IGNORE';
+  local $SIG{TSTP} = 'IGNORE';
+  local $SIG{PIPE} = 'IGNORE';
+
+  my $oldAutoCommit = $FS::UID::AutoCommit;
+  local $FS::UID::AutoCommit = 0;
+  my $dbh = dbh;
+
+  my $err_or_queue = $self->sqlradius_queue( $svc_acct->svcnum, 'insert',
+    'check', $self->export_username($svc_acct), $svc_acct->radius_check );
+  unless ( ref($err_or_queue) ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $err_or_queue;
   }
 
+  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,
+                                      );
+  if ( $error ) {
+    $dbh->rollback if $oldAutoCommit;
+    return $error;
+  }
   $dbh->commit or die $dbh->errstr if $oldAutoCommit;
 
   '';
@@ -240,6 +303,39 @@ sub sqlradius_queue {
   ) or $queue;
 }
 
+sub suspended_usergroups {
+  my ($self, $svc_acct) = (shift, shift);
+
+  return () unless $svc_acct;
+
+  #false laziness with FS::part_export::shellcommands
+  #subclass part_export?
+
+  my $r = $svc_acct->cust_svc->cust_pkg->last_reason;
+  my %reasonmap = $self->_groups_susp_reason_map;
+  my $userspec = '';
+  if ($r) {
+    $userspec = $reasonmap{$r->reasonnum}
+      if exists($reasonmap{$r->reasonnum});
+    $userspec = $reasonmap{$r->reason}
+      if (!$userspec && exists($reasonmap{$r->reason}));
+  }
+  my $suspend_user;
+  if ($userspec =~ /^d+$/ ){
+    $suspend_user = qsearchs( 'svc_acct', { 'svcnum' => $userspec } );
+  }elsif ($userspec =~ /^\S+\@\S+$/){
+    my ($username,$domain) = split(/\@/, $userspec);
+    for my $user (qsearch( 'svc_acct', { 'username' => $username } )){
+      $suspend_user = $user if $userspec eq $user->email;
+    }
+  }elsif ($userspec){
+    $suspend_user = qsearchs( 'svc_acct', { 'username' => $userspec } );
+  }
+  #esalf
+  return $suspend_user->radius_groups if $suspend_user;
+  ();
+}
+
 sub sqlradius_insert { #subroutine, not method
   my $dbh = sqlradius_connect(shift, shift, shift);
   my( $table, $username, %attributes ) = @_;
@@ -282,10 +378,22 @@ sub sqlradius_usergroup_insert { #subroutine, not method
   my $dbh = sqlradius_connect(shift, shift, shift);
   my( $username, @groups ) = @_;
 
+  my $s_sth = $dbh->prepare(
+    "SELECT COUNT(*) FROM usergroup WHERE UserName = ? AND GroupName = ?"
+  ) or die $dbh->errstr;
+
   my $sth = $dbh->prepare( 
     "INSERT INTO usergroup ( UserName, GroupName ) VALUES ( ?, ? )"
   ) or die $dbh->errstr;
+
   foreach my $group ( @groups ) {
+    $s_sth->execute( $username, $group ) or die $s_sth->errstr;
+    if ($s_sth->fetchrow_arrayref->[0]) {
+      warn localtime() . ": sqlradius_usergroup_insert attempted to reinsert " .
+           "$group for $username\n"
+        if $DEBUG;
+      next;
+    }
     $sth->execute( $username, $group )
       or die "can't insert into groupname table: ". $sth->errstr;
   }
@@ -350,6 +458,49 @@ sub sqlradius_connect {
   DBI->connect(@_) or die $DBI::errstr;
 }
 
+sub sqlreplace_usergroups {
+  my ($self, $svcnum, $username, $jobnum, $old, $new) = @_;
+
+  # (sorta) false laziness with FS::svc_acct::replace
+  my @oldgroups = @$old;
+  my @newgroups = @$new;
+  my @delgroups = ();
+  foreach my $oldgroup ( @oldgroups ) {
+    if ( grep { $oldgroup eq $_ } @newgroups ) {
+      @newgroups = grep { $oldgroup ne $_ } @newgroups;
+      next;
+    }
+    push @delgroups, $oldgroup;
+  }
+
+  if ( @delgroups ) {
+    my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_delete',
+      $username, @delgroups );
+    return $err_or_queue
+      unless ref($err_or_queue);
+    if ( $jobnum ) {
+      my $error = $err_or_queue->depend_insert( $jobnum );
+      return $error if $error;
+    }
+  }
+
+  if ( @newgroups ) {
+    cluck localtime(). ": queuing usergroup_insert for $svcnum ($username) ".
+          "with ".  join(", ", @newgroups)
+      if $DEBUG;
+    my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_insert',
+      $username, @newgroups );
+    return $err_or_queue
+      unless ref($err_or_queue);
+    if ( $jobnum ) {
+      my $error = $err_or_queue->depend_insert( $jobnum );
+      return $error if $error;
+    }
+  }
+  '';
+}
+
+
 #--
 
 =item usage_sessions TIMESTAMP_START TIMESTAMP_END [ SVC_ACCT [ IP [ PREFIX [ SQL_SELECT ] ] ] ]
@@ -409,16 +560,7 @@ sub usage_sessions {
                                    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 $str2time = str2time_sql( $dbh->{Driver}->{Name} );
 
   my @fields = (
                  qw( username realm framedipaddress
@@ -475,16 +617,22 @@ sub usage_sessions {
 sub update_svc_acct {
   my $self = shift;
 
+  my $conf = new FS::Conf;
+
+  my $fdbh = dbh;
   my $dbh = sqlradius_connect( map $self->option($_),
                                    qw( datasrc username password ) );
 
+  my $str2time = str2time_sql( $dbh->{Driver}->{Name} );
   my @fields = qw( radacctid username realm acctsessiontime );
 
   my @param = ();
   my $where = '';
 
   my $sth = $dbh->prepare("
-    SELECT RadAcctId, UserName, Realm, AcctSessionTime
+    SELECT RadAcctId, UserName, Realm, AcctSessionTime,
+           $str2time AcctStartTime),  $str2time AcctStopTime), 
+           AcctInputOctets, AcctOutputOctets
       FROM radacct
       WHERE FreesideStatus IS NULL
         AND AcctStopTime != 0
@@ -492,19 +640,25 @@ sub update_svc_acct {
   $sth->execute() or die $sth->errstr;
 
   while ( my $row = $sth->fetchrow_arrayref ) {
-    my($RadAcctId, $UserName, $Realm, $AcctSessionTime) = @$row;
+    my($RadAcctId, $UserName, $Realm, $AcctSessionTime, $AcctStartTime,
+       $AcctStopTime, $AcctInputOctets, $AcctOutputOctets) = @$row;
     warn "processing record: ".
          "$RadAcctId ($UserName\@$Realm for ${AcctSessionTime}s"
       if $DEBUG;
 
+    $UserName = lc($UserName) unless $conf->exists('username-uppercase');
+
     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 $oldAutoCommit = $FS::UID::AutoCommit; # can't undo side effects, but at
+    local $FS::UID::AutoCommit = 0;           # least we can avoid over counting
+
     my @svc_acct =
       grep { qsearch( 'export_svc', { 'exportnum' => $self->exportnum,
                                       'svcpart'   => $_->cust_svc->svcpart, } )
@@ -523,17 +677,16 @@ sub update_svc_acct {
     } 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;
-        $svc_acct->decrement_seconds($AcctSessionTime);
-        $status = 'done';
-      } else {
-        warn "  no existing seconds value for svc_acct - skiping\n" if $DEBUG;
-      }
+      warn "found svc_acct ". $svc_acct[0]->svcnum. " $errinfo\n" if $DEBUG;
+      $svc_acct[0]->last_login($AcctStartTime);
+      $svc_acct[0]->last_logout($AcctStopTime);
+      my @stati;
+      push @stati, _try_decrement($svc_acct[0], 'seconds', $AcctSessionTime);
+      push @stati, _try_decrement($svc_acct[0], 'upbytes', $AcctInputOctets);
+      push @stati, _try_decrement($svc_acct[0], 'downbytes', $AcctOutputOctets);
+      push @stati, _try_decrement($svc_acct[0], 'totalbytes', $AcctInputOctets + 
+                     $AcctOutputOctets);
+      $status=join(' ', @stati);
     }
 
     warn "setting FreesideStatus to $status $errinfo\n" if $DEBUG; 
@@ -543,9 +696,27 @@ sub update_svc_acct {
     ) or die $dbh->errstr;
     $psth->execute($status, $RadAcctId) or die $psth->errstr;
 
+    $fdbh->commit or die $fdbh->errstr if $oldAutoCommit;
+
   }
 
 }
 
+sub _try_decrement {
+  my ($svc_acct, $column, $amount) = @_;
+  if ( $svc_acct->$column !~ /^$/ ) {
+    warn "  svc_acct.$column found (". $svc_acct->$column.
+         ") - decrementing\n"
+      if $DEBUG;
+    my $method = 'decrement_' . $column;
+    my $error = $svc_acct->$method($amount);
+    die $error if $error;
+    return 'done';
+  } else {
+    warn "  no existing $column value for svc_acct - skipping\n" if $DEBUG;
+  }
+  return 'skipped';
+}
+
 1;