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 qsearchs str2time_sql );
use FS::part_export;
+use FS::svc_acct;
+use FS::export_svc;
+use Carp qw( cluck );
@ISA = qw(FS::part_export);
+$DEBUG = 0;
+
tie %options, 'Tie::IxHash',
'datasrc' => { label=>'DBI data source ' },
'username' => { label=>'Database username' },
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';
%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.
$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 > 1;
$svc_acct->username;
}
}
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 );
}
}
- # (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;
'';
) 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 ) = @_;
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;
}
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 ] ] ] ]
#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
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
}
+=item update_svc_acct
+
+=cut
+
+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,
+ $str2time AcctStartTime), $str2time AcctStopTime),
+ AcctInputOctets, AcctOutputOctets
+ 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, $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 $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, } )
+ }
+ 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 {
+ 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;
+ my $psth = $dbh->prepare("UPDATE radacct
+ SET FreesideStatus = ?
+ WHERE RadAcctId = ?"
+ ) 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';
+}
+
+###
+#class methods
+###
+
+sub all_sqlradius {
+ #my $class = shift;
+
+ #don't just look for ->can('usage_sessions'), we're sqlradius-specific
+ # (radiator is supposed to be setup with a radacct table)
+ #i suppose it would be more slick to look for things that inherit from us..
+
+ my @part_export = ();
+ push @part_export, qsearch('part_export', { 'exporttype' => $_ } )
+ foreach qw(sqlradius sqlradius_withdomain radiator);
+ @part_export;
+}
+
+sub all_sqlradius_withaccounting {
+ my $class = shift;
+ grep { ! $_->option('ignore_accounting') } $class->_part_export_sqlradius;
+}
+
1;
projects / freeside.git / blobdiff