package FS::part_export::sqlradius; use strict; use vars qw(@ISA @EXPORT_OK $DEBUG %info %options $notes1 $notes2); use Exporter; use Tie::IxHash; use FS::Record qw( dbh qsearch qsearchs str2time_sql str2time_sql_closing ); use FS::part_export; use FS::svc_acct; use FS::export_svc; use Carp qw( carp cluck ); use NEXT; use Net::OpenSSH; use FS::DBI; @ISA = qw(FS::part_export); @EXPORT_OK = qw( sqlradius_connect ); $DEBUG = 0; my %groups; tie %options, 'Tie::IxHash', 'datasrc' => { label=>'DBI data source ' }, 'username' => { label=>'Database username' }, 'password' => { label=>'Database password' }, 'usergroup' => { label => 'Group table', type => 'select', options => [qw( usergroup radusergroup ) ], }, 'skip_provisioning' => { type => 'checkbox', label => 'Skip provisioning records to this database' }, 'ignore_accounting' => { type => 'checkbox', label => 'Ignore accounting records from this database' }, 'process_single_realm' => { type => 'checkbox', label => 'Only process one realm of accounting records', }, 'realm' => { label => 'The realm of of accounting records to be processed' }, 'ignore_long_sessions' => { type => 'checkbox', label => 'Ignore sessions which span billing periods', }, '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', #as a phone number }, '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', }, 'export_attrs' => { type => 'checkbox', label => 'Export RADIUS group attributes to this database', }, 'disconnect_ssh' => { label => 'To send a disconnection request to each RADIUS client when modifying, suspending or deleting an account, enter a ssh connection string (username@host) with access to the radclient program', }, 'disconnect_port' => { label => 'Port to send disconnection requests to, default 1700', }, ; $notes1 = <<'END'; Real-time export of radcheck, radreply and usergroup/radusergroup tables to any SQL database for FreeRADIUS or ICRADIUS. END $notes2 = <<'END'; An existing RADIUS database will be updated in realtime, but you can use freeside-sqlradius-reset to delete the entire RADIUS database and repopulate the tables from the Freeside database. See the DBI documentation and the documentation for your DBD for the exact syntax of a DBI data source. END %info = ( 'svc' => 'svc_acct', 'desc' => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS)', 'options' => \%options, 'nodomain' => 'Y', 'no_machine' => 1, 'nas' => 'Y', # show export_nas selection in UI 'default_svc_class' => 'Internet', 'notes' => $notes1. 'This export does not export RADIUS realms (see also '. 'sqlradius_withdomain). '. $notes2 ); sub _groups_susp_reason_map { map { reverse( /^\s*(\S+)\s*(.*)$/ ) } split( "\n", shift->option('groups_susp_reason')); } sub rebless { shift; } 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); my %every = $svc_acct->EVERY::radius_reply; map { @$_ } values %every; } sub radius_check { #override for other svcdb my($self, $svc_acct) = (shift, shift); my %every = $svc_acct->EVERY::radius_check; map { @$_ } values %every; } sub _export_insert { my($self, $svc_x) = (shift, shift); return '' if $self->option('skip_provisioning'); foreach my $table (qw(reply check)) { my $method = "radius_$table"; 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 ); return $err_or_queue unless ref($err_or_queue); } my @groups = $svc_x->radius_groups('hashref'); if ( @groups ) { cluck localtime(). ": queuing usergroup_insert for ". $svc_x->svcnum. " (". $self->export_username($svc_x). " with ". join(", ", @groups) if $DEBUG; my $usergroup = $self->option('usergroup') || 'usergroup'; my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'usergroup_insert', $self->export_username($svc_x), $usergroup, @groups ); return $err_or_queue unless ref($err_or_queue); } ''; } sub _export_replace { my( $self, $new, $old ) = (shift, shift, shift); return '' if $self->option('skip_provisioning'); 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 $jobnum = ''; if ( $self->export_username($old) ne $self->export_username($new) ) { my $usergroup = $self->option('usergroup') || 'usergroup'; my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'rename', $self->export_username($new), $self->export_username($old), $usergroup ); unless ( ref($err_or_queue) ) { $dbh->rollback if $oldAutoCommit; return $err_or_queue; } $jobnum = $err_or_queue->jobnum; } foreach my $table (qw(reply check)) { my $method = "radius_$table"; my %new = $self->$method($new); my %old = $self->$method($old); if ( grep { !exists $old{$_} #new attributes || $new{$_} ne $old{$_} #changed } keys %new ) { my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'insert', $table, $self->export_username($new), %new ); 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; } } $jobnum = $err_or_queue->jobnum; # chain all of these dependencies } my @del = grep { !exists $new{$_} } keys %old; if ( @del ) { my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'attrib_delete', $table, $self->export_username($new), @del ); 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; } } $jobnum = $err_or_queue->jobnum; # chain all of these dependencies } } my $error; my (@oldgroups) = $old->radius_groups('hashref'); my (@newgroups) = $new->radius_groups('hashref'); ($error,$jobnum) = $self->sqlreplace_usergroups( $new->svcnum, $self->export_username($new), $jobnum ? $jobnum : '', \@oldgroups, \@newgroups, ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } # radius database is used for authorization, so to avoid users reauthorizing # before the database changes, disconnect users after changing database if ($self->option('disconnect_ssh')) { my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'user_disconnect', 'disconnect_ssh' => $self->option('disconnect_ssh'), 'svc_acct_username' => $old->username, 'disconnect_port' => $self->option('disconnect_port'), ); 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; ''; } #false laziness w/broadband_sqlradius.pm sub _export_suspend { my( $self, $svc_acct ) = (shift, shift); return '' if $self->option('skip_provisioning'); 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 $jobnum = ''; 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; } $jobnum = $err_or_queue->jobnum; } my $error; ($error,$jobnum) = $self->sqlreplace_usergroups( $new->svcnum, $self->export_username($new), '', [ $svc_acct->radius_groups('hashref') ], \@newgroups, ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } # radius database is used for authorization, so to avoid users reauthorizing # before the database changes, disconnect users after changing database if ($self->option('disconnect_ssh')) { my $err_or_queue = $self->sqlradius_queue( $new->svcnum, 'user_disconnect', 'disconnect_ssh' => $self->option('disconnect_ssh'), 'svc_acct_username' => $svc_acct->username, 'disconnect_port' => $self->option('disconnect_port'), ); 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_unsuspend { my( $self, $svc_x ) = (shift, shift); return '' if $self->option('skip_provisioning'); 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_x->svcnum, 'insert', 'check', $self->export_username($svc_x), $self->radius_check($svc_x) ); unless ( ref($err_or_queue) ) { $dbh->rollback if $oldAutoCommit; return $err_or_queue; } my $error; my (@oldgroups) = $self->suspended_usergroups($svc_x); $error = $self->sqlreplace_usergroups( $svc_x->svcnum, $self->export_username($svc_x), '', \@oldgroups, [ $svc_x->radius_groups('hashref') ], ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; } $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } sub _export_delete { my( $self, $svc_x ) = (shift, shift); return '' if $self->option('skip_provisioning'); my $jobnum = ''; my $usergroup = $self->option('usergroup') || 'usergroup'; my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'delete', $self->export_username($svc_x), $usergroup ); $jobnum = $err_or_queue->jobnum; # radius database is used for authorization, so to avoid users reauthorizing # before the database changes, disconnect users after changing database if ($self->option('disconnect_ssh')) { my $err_or_queue = $self->sqlradius_queue( $svc_x->svcnum, 'user_disconnect', 'disconnect_ssh' => $self->option('disconnect_ssh'), 'svc_acct_username' => $svc_x->username, 'disconnect_port' => $self->option('disconnect_port'), ); return $err_or_queue unless ref($err_or_queue); if ( $jobnum ) { my $error = $err_or_queue->depend_insert( $jobnum ); return $error if $error; } } ref($err_or_queue) ? '' : $err_or_queue; } sub sqlradius_queue { my( $self, $svcnum, $method ) = (shift, shift, shift); #my %args = @_; my $queue = new FS::queue { 'svcnum' => $svcnum, 'job' => "FS::part_export::sqlradius::sqlradius_$method", }; $queue->insert( $self->option('datasrc'), $self->option('username'), $self->option('password'), @_, ) or $queue; } sub suspended_usergroups { my ($self, $svc_x) = (shift, shift); return () unless $svc_x; my $svc_table = $svc_x->table; #false laziness with FS::part_export::shellcommands #subclass part_export? my $r = $svc_x->cust_svc->cust_pkg->last_reason('susp'); 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_svc; if ( $userspec =~ /^\d+$/ ){ $suspend_svc = qsearchs( $svc_table, { 'svcnum' => $userspec } ); } elsif ( $userspec =~ /^\S+\@\S+$/ && $svc_table eq 'svc_acct' ){ my ($username,$domain) = split(/\@/, $userspec); for my $user (qsearch( 'svc_acct', { 'username' => $username } )){ $suspend_svc = $user if $userspec eq $user->email; } }elsif ( $userspec && $svc_table eq 'svc_acct' ){ $suspend_svc = qsearchs( 'svc_acct', { 'username' => $userspec } ); } #esalf return $suspend_svc->radius_groups('hashref') if $suspend_svc; (); } sub sqlradius_insert { #subroutine, not method if ( $FS::svc_Common::noexport_hack ) { carp 'sqlradius_insert() suppressed by noexport_hack' if $DEBUG; return; } my $dbh = sqlradius_connect(shift, shift, shift); my( $table, $username, %attributes ) = @_; foreach my $attribute ( keys %attributes ) { my $s_sth = $dbh->prepare( "SELECT COUNT(*) FROM rad$table WHERE UserName = ? AND Attribute = ?" ) or die $dbh->errstr; $s_sth->execute( $username, $attribute ) or die $s_sth->errstr; if ( $s_sth->fetchrow_arrayref->[0] ) { my $u_sth = $dbh->prepare( "UPDATE rad$table SET Value = ? WHERE UserName = ? AND Attribute = ?" ) or die $dbh->errstr; $u_sth->execute($attributes{$attribute}, $username, $attribute) or die $u_sth->errstr; } else { my $i_sth = $dbh->prepare( "INSERT INTO rad$table ( UserName, Attribute, op, Value ) ". "VALUES ( ?, ?, ?, ? )" ) or die $dbh->errstr; $i_sth->execute( $username, $attribute, ( $attribute eq 'Password' ? '==' : ':=' ), $attributes{$attribute}, ) or die $i_sth->errstr; } } $dbh->disconnect; } sub sqlradius_usergroup_insert { #subroutine, not method if ( $FS::svc_Common::noexport_hack ) { carp 'sqlradius_usergroup_insert() suppressed by noexport_hack' if $DEBUG; return; } my $dbh = sqlradius_connect(shift, shift, shift); my $username = shift; my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup'; my @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, Priority ) VALUES ( ?, ?, ? )" ) or die $dbh->errstr; foreach ( @groups ) { my $group = $_->{'groupname'}; my $priority = $_->{'priority'}; $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, $priority ) or die "can't insert into groupname table: ". $sth->errstr; } if ( $s_sth->{Active} ) { warn "sqlradius s_sth still active; calling ->finish()"; $s_sth->finish; } if ( $sth->{Active} ) { warn "sqlradius sth still active; calling ->finish()"; $sth->finish; } $dbh->disconnect; } sub sqlradius_usergroup_delete { #subroutine, not method if ( $FS::svc_Common::noexport_hack ) { carp 'sqlradius_usergroup_delete() suppressed by noexport_hack' if $DEBUG; return; } my $dbh = sqlradius_connect(shift, shift, shift); my $username = shift; my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup'; my @groups = @_; my $sth = $dbh->prepare( "DELETE FROM $usergroup WHERE UserName = ? AND GroupName = ?" ) or die $dbh->errstr; foreach ( @groups ) { my $group = $_->{'groupname'}; $sth->execute( $username, $group ) or die "can't delete from groupname table: ". $sth->errstr; } $dbh->disconnect; } sub sqlradius_rename { #subroutine, not method if ( $FS::svc_Common::noexport_hack ) { carp 'sqlradius_rename() suppressed by noexport_hack' if $DEBUG; return; } my $dbh = sqlradius_connect(shift, shift, shift); my($new_username, $old_username) = (shift, shift); my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup'; foreach my $table (qw(radreply radcheck), $usergroup ) { my $sth = $dbh->prepare("UPDATE $table SET Username = ? WHERE UserName = ?") or die $dbh->errstr; $sth->execute($new_username, $old_username) or die "can't update $table: ". $sth->errstr; } $dbh->disconnect; } sub sqlradius_attrib_delete { #subroutine, not method if ( $FS::svc_Common::noexport_hack ) { carp 'sqlradius_attrib_delete() suppressed by noexport_hack' if $DEBUG; return; } my $dbh = sqlradius_connect(shift, shift, shift); my( $table, $username, @attrib ) = @_; foreach my $attribute ( @attrib ) { my $sth = $dbh->prepare( "DELETE FROM rad$table WHERE UserName = ? AND Attribute = ?" ) or die $dbh->errstr; $sth->execute($username,$attribute) or die "can't delete from rad$table table: ". $sth->errstr; } $dbh->disconnect; } sub sqlradius_delete { #subroutine, not method if ( $FS::svc_Common::noexport_hack ) { carp 'sqlradius_delete() suppressed by noexport_hack' if $DEBUG; return; } my $dbh = sqlradius_connect(shift, shift, shift); my $username = shift; my $usergroup = ( $_[0] =~ /^(rad)?usergroup/i ) ? shift : 'usergroup'; foreach my $table (qw( radcheck radreply), $usergroup ) { my $sth = $dbh->prepare( "DELETE FROM $table WHERE UserName = ?" ); $sth->execute($username) or die "can't delete from $table table: ". $sth->errstr; } $dbh->disconnect; } sub sqlradius_connect { #my($datasrc, $username, $password) = @_; #DBI->connect($datasrc, $username, $password) or die $DBI::errstr; FS::DBI->connect(@_) or die $FS::DBI::errstr; } # on success, returns '' in scalar context, ('',$jobnum) in list context # on error, always just returns error 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; } my $usergroup = $self->option('usergroup') || 'usergroup'; if ( @delgroups ) { my $err_or_queue = $self->sqlradius_queue( $svcnum, 'usergroup_delete', $username, $usergroup, @delgroups ); return $err_or_queue unless ref($err_or_queue); if ( $jobnum ) { my $error = $err_or_queue->depend_insert( $jobnum ); return $error if $error; } $jobnum = $err_or_queue->jobnum; # chain all of these dependencies } 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, $usergroup, @newgroups ); return $err_or_queue unless ref($err_or_queue); if ( $jobnum ) { my $error = $err_or_queue->depend_insert( $jobnum ); return $error if $error; } $jobnum = $err_or_queue->jobnum; # chain all of these dependencies } wantarray ? ('',$jobnum) : ''; } #-- =item usage_sessions HASHREF =item usage_sessions TIMESTAMP_START TIMESTAMP_END [ SVC_ACCT [ IP [ PREFIX [ SQL_SELECT ] ] ] ] New-style: pass a hashref with the following keys: =over 4 =item stoptime_start - Lower bound for AcctStopTime, as a UNIX timestamp =item stoptime_end - Upper bound for AcctStopTime, as a UNIX timestamp =item session_status - 'closed' to only show records with AcctStopTime, 'open' to only show records I AcctStopTime, empty to show both. =item starttime_start - Lower bound for AcctStartTime, as a UNIX timestamp =item starttime_end - Upper bound for AcctStartTime, as a UNIX timestamp =item svc_acct =item ip =item prefix =back Old-style: TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see L. Also see L and L 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. 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 arrayref of hashrefs with the following fields: =over 4 =item username =item framedipaddress =item acctstarttime =item acctstoptime =item acctsessiontime =item acctinputoctets =item acctoutputoctets =item callingstationid =item calledstationid =back =cut #some false laziness w/cust_svc::seconds_since_sqlradacct sub usage_sessions { my( $self ) = shift; my $opt = {}; my($start, $end, $svc_acct, $ip, $prefix) = ( '', '', '', '', ''); my $summarize = 0; if ( ref($_[0]) ) { $opt = shift; $start = $opt->{stoptime_start}; $end = $opt->{stoptime_end}; $svc_acct = $opt->{svc} || $opt->{svc_acct}; $ip = $opt->{ip}; $prefix = $opt->{prefix}; $summarize = $opt->{summarize}; } else { ( $start, $end ) = splice(@_, 0, 2); $svc_acct = @_ ? shift : ''; $ip = @_ ? shift : ''; $prefix = @_ ? 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 = str2time_sql( $dbh->{Driver}->{Name} ); my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} ); my @fields = ( qw( username realm framedipaddress acctsessiontime acctinputoctets acctoutputoctets callingstationid calledstationid ), "$str2time acctstarttime $closing as acctstarttime", "$str2time acctstoptime $closing as acctstoptime", ); @fields = ( 'username', 'sum(acctsessiontime) as acctsessiontime', 'sum(acctinputoctets) as acctinputoctets', 'sum(acctoutputoctets) as acctoutputoctets', ) if $summarize; my @param = (); my @where = (); if ( $svc_acct ) { my $username = $self->export_username($svc_acct); if ( $username =~ /^([^@]+)\@([^@]+)$/ ) { push @where, '( UserName = ? OR ( UserName = ? AND Realm = ? ) )'; push @param, $username, $1, $2; } else { push @where, 'UserName = ?'; push @param, $username; } } if ($self->option('process_single_realm')) { push @where, 'Realm = ?'; push @param, $self->option('realm'); } if ( length($ip) ) { push @where, ' FramedIPAddress = ?'; push @param, $ip; } if ( length($prefix) ) { #assume sip: for now, else things get ugly trying to match /^\w+:$prefix/ push @where, " CalledStationID LIKE 'sip:$prefix\%'"; } my $acctstoptime = ''; if ( $opt->{session_status} ne 'open' ) { if ( $start ) { $acctstoptime .= "$str2time AcctStopTime $closing >= ?"; push @param, $start; $acctstoptime .= ' AND ' if $end; } if ( $end ) { $acctstoptime .= "$str2time AcctStopTime $closing <= ?"; push @param, $end; } } if ( $opt->{session_status} ne 'closed' ) { if ( $acctstoptime ) { $acctstoptime = "( ( $acctstoptime ) OR AcctStopTime IS NULL )"; } else { $acctstoptime = 'AcctStopTime IS NULL'; } } push @where, $acctstoptime; if ( $opt->{starttime_start} ) { push @where, "$str2time AcctStartTime $closing >= ?"; push @param, $opt->{starttime_start}; } if ( $opt->{starttime_end} ) { push @where, "$str2time AcctStartTime $closing <= ?"; push @param, $opt->{starttime_end}; } 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 $sql = 'SELECT '. join(', ', @fields). " FROM radacct $where $groupby $orderby"; if ( $DEBUG ) { warn $sql; warn join(',', @param); } my $sth = $dbh->prepare($sql) or die $dbh->errstr; $sth->execute(@param) or die $sth->errstr; [ map { { %$_ } } @{ $sth->fetchall_arrayref({}) } ]; } =item update_svc =cut sub update_svc { my $self = shift; if ( $FS::svc_Common::noexport_hack ) { carp 'update_svc() suppressed by noexport_hack' if $self->option('debug') || $DEBUG; return; } 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 $closing = str2time_sql_closing( $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 $closing, $str2time AcctStopTime $closing, AcctInputOctets, AcctOutputOctets FROM radacct WHERE FreesideStatus IS NULL AND AcctStopTime IS NOT NULL ") 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; my $fs_username = $UserName; $fs_username = lc($fs_username) unless $conf->exists('username-uppercase'); #my %search = ( 'username' => $fs_username ); my $status = ''; my $errinfo = "for RADIUS detail RadAcctID $RadAcctId ". "(UserName $UserName, Realm $Realm)"; my $extra_sql = ''; if ( ref($self) =~ /withdomain/ ) { #well, should be a callback to that #module or something my $domain; if ( $Realm ) { $domain = $Realm; } elsif ( $fs_username =~ /\@/ ) { ($fs_username, $domain) = split('@', $fs_username); } else { warn 'WARNING: nothing Realm column and no @realm in UserName column '. "$errinfo -- skipping\n" if $DEBUG; $status = 'skipped (no realm)'; } $extra_sql = " AND '$domain' = ( 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 unless ( $status ) { $status = 'skipped'; if ( $self->option('process_single_realm') && $self->option('realm') ne $Realm ) { warn "WARNING: wrong realm $errinfo - skipping\n" if $DEBUG; } else { my @svc_acct = grep { qsearch( 'export_svc', { 'exportnum' => $self->exportnum, 'svcpart' => $_->cust_svc->svcpart, } ) } qsearch( 'svc_acct', { 'username' => $fs_username }, '', $extra_sql ); 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; $svc_acct->last_login($AcctStartTime); $svc_acct->last_logout($AcctStopTime); my $session_time = $AcctStopTime; $session_time = $AcctStartTime if $self->option('ignore_long_sessions'); my $cust_pkg = $svc_acct->cust_svc->cust_pkg; if ( $cust_pkg && $session_time < ( $cust_pkg->last_bill || $cust_pkg->setup ) ) { $status = 'skipped (too old)'; } else { my @st; push @st, _try_decrement($svc_acct,'seconds', $AcctSessionTime); push @st, _try_decrement($svc_acct,'upbytes', $AcctInputOctets); push @st, _try_decrement($svc_acct,'downbytes', $AcctOutputOctets); push @st, _try_decrement($svc_acct,'totalbytes', $AcctInputOctets + $AcctOutputOctets); $status=join(' ', @st); } } } } 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'; } =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) = @_; if ( $FS::svc_Common::noexport_hack ) { carp "export_nas_action($action) suppressed by noexport_hack" if $self->option('debug') || $DEBUG; return; } # 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 { if ( $FS::svc_Common::noexport_hack ) { carp 'sqlradius_nas_insert() suppressed by noexport_hack' if $DEBUG; return; } 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 { if ( $FS::svc_Common::noexport_hack ) { carp 'sqlradius_nas_delete() suppressed by noexport_hack' if $DEBUG; return; } 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 { if ( $FS::svc_Common::noexport_hack ) { carp 'sqlradius_nas_replace() suppressed by noexport_hack' if $DEBUG; return; } 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; } =item export_attr_insert RADIUS_ATTR =item export_attr_delete RADIUS_ATTR =item export_attr_replace NEW_RADIUS_ATTR OLD_RADIUS_ATTR Update the group attribute tables (radgroupcheck and radgroupreply) on the RADIUS server. In delete and replace actions, the existing records are identified by the combination of group name and attribute name. In the special case where attributes are being replaced because a group name (L->groupname) is changing, the pseudo-field 'groupname' must be set in OLD_RADIUS_ATTR. =cut # some false laziness with NAS export stuff... sub export_attr_insert { shift->export_attr_action('insert', @_); } sub export_attr_delete { shift->export_attr_action('delete', @_); } sub export_attr_replace { shift->export_attr_action('replace', @_); } sub export_attr_action { my $self = shift; my ($action, $new, $old) = @_; my $err_or_queue; if ( $action eq 'delete' ) { $old = $new; } if ( $action eq 'delete' or $action eq 'replace' ) { # delete based on an exact match my %opt = ( attrname => $old->attrname, attrtype => $old->attrtype, groupname => $old->groupname || $old->radius_group->groupname, op => $old->op, value => $old->value, ); $err_or_queue = $self->sqlradius_queue('', 'attr_delete', %opt); return $err_or_queue unless ref $err_or_queue; } # this probably doesn't matter, but just to be safe... my $jobnum = $err_or_queue->jobnum if $action eq 'replace'; if ( $action eq 'replace' or $action eq 'insert' ) { my %opt = ( attrname => $new->attrname, attrtype => $new->attrtype, groupname => $new->radius_group->groupname, op => $new->op, value => $new->value, ); $err_or_queue = $self->sqlradius_queue('', 'attr_insert', %opt); $err_or_queue->depend_insert($jobnum) if $jobnum; return $err_or_queue unless ref $err_or_queue; } ''; } sub sqlradius_attr_insert { if ( $FS::svc_Common::noexport_hack ) { carp 'sqlradius_attr_insert() suppressed by noexport_hack' if $DEBUG; return; } my $dbh = sqlradius_connect(shift, shift, shift); my %opt = @_; my $table; # make sure $table is completely safe if ( $opt{'attrtype'} eq 'C' ) { $table = 'radgroupcheck'; } elsif ( $opt{'attrtype'} eq 'R' ) { $table = 'radgroupreply'; } else { die "unknown attribute type '$opt{attrtype}'"; } my @values = @opt{ qw(groupname attrname op value) }; my $sth = $dbh->prepare( 'INSERT INTO '.$table.' (groupname, attribute, op, value) VALUES (?,?,?,?)' ); $sth->execute(@values) or die $dbh->errstr; } sub sqlradius_attr_delete { if ( $FS::svc_Common::noexport_hack ) { carp 'sqlradius_attr_delete() suppressed by noexport_hack' if $DEBUG; return; } my $dbh = sqlradius_connect(shift, shift, shift); my %opt = @_; my $table; if ( $opt{'attrtype'} eq 'C' ) { $table = 'radgroupcheck'; } elsif ( $opt{'attrtype'} eq 'R' ) { $table = 'radgroupreply'; } else { die "unknown attribute type '".$opt{'attrtype'}."'"; } my @values = @opt{ qw(groupname attrname op value) }; my $sth = $dbh->prepare( 'DELETE FROM '.$table. ' WHERE groupname = ? AND attribute = ? AND op = ? AND value = ?'. ' LIMIT 1' ); $sth->execute(@values) or die $dbh->errstr; } #sub sqlradius_attr_replace { no longer needed =item export_group_replace NEW OLD Replace the L object OLD with NEW. This will change the group name and priority in all radusergroup records, and the group name in radgroupcheck and radgroupreply. =cut sub export_group_replace { my $self = shift; my ($new, $old) = @_; return '' if $new->groupname eq $old->groupname and $new->priority == $old->priority; my $err_or_queue = $self->sqlradius_queue( '', 'group_replace', ($self->option('usergroup') || 'usergroup'), $new->hashref, $old->hashref, ); return $err_or_queue unless ref $err_or_queue; ''; } sub sqlradius_group_replace { if ( $FS::svc_Common::noexport_hack ) { carp 'sqlradius_group_replace() suppressed by noexport_hack' if $DEBUG; return; } my $dbh = sqlradius_connect(shift, shift, shift); my $usergroup = shift; $usergroup =~ /^(rad)?usergroup$/ or die "bad usergroup table name: $usergroup"; my ($new, $old) = (shift, shift); # apply renames to check/reply attribute tables if ( $new->{'groupname'} ne $old->{'groupname'} ) { foreach my $table (qw(radgroupcheck radgroupreply)) { my $sth = $dbh->prepare( 'UPDATE '.$table.' SET groupname = ? WHERE groupname = ?' ); $sth->execute($new->{'groupname'}, $old->{'groupname'}) or die $dbh->errstr; } } # apply renames and priority changes to usergroup table my $sth = $dbh->prepare( 'UPDATE '.$usergroup.' SET groupname = ?, priority = ? WHERE groupname = ?' ); $sth->execute($new->{'groupname'}, $new->{'priority'}, $old->{'groupname'}) or die $dbh->errstr; } =item sqlradius_user_disconnect For a specified user, sends a disconnect request to all nas in the server database. Accepts L connection input and the following named parameters: I - user@host with access to radclient program (required) I - the user to be disconnected (required) I - the port (on the nas) to send disconnect requests to (defaults to 1700) Note this is NOT the opposite of sqlradius_connect. =cut sub sqlradius_user_disconnect { if ( $FS::svc_Common::noexport_hack ) { carp 'sqlradius_user_disconnect() suppressed by noexport_hack' if $DEBUG; return; } my $dbh = sqlradius_connect(shift, shift, shift); my %opt = @_; # get list of nas my $sth = $dbh->prepare('select nasname, secret from nas') or die $dbh->errstr; $sth->execute() or die $dbh->errstr; my $nas = $sth->fetchall_arrayref({}); $sth->finish(); $dbh->disconnect(); die "No nas found in radius db" unless @$nas; # set up ssh connection my $ssh = Net::OpenSSH->new($opt{'disconnect_ssh'}); die "Couldn't establish SSH connection: " . $ssh->error if $ssh->error; # send individual disconnect requests my $user = $opt{'svc_acct_username'}; #svc_acct username my $port = $opt{'disconnect_port'} || 1700; #or should we pull this from the db? my $error = ''; foreach my $nas (@$nas) { my $nasname = $nas->{'nasname'}; my $secret = $nas->{'secret'}; my $command = qq(echo "User-Name=$user" | radclient -r 1 $nasname:$port disconnect '$secret'); my ($output, $errput) = $ssh->capture2($command); $error .= "Error running $command: $errput " . $ssh->error . " " if $errput || $ssh->error; } $error .= "Some clients may have successfully disconnected" if $error && (@$nas > 1); $error = "No clients found" unless @$nas; die $error if $error; return ''; } ### # class method to fetch groups/attributes from the sqlradius install on upgrade ### sub _upgrade_exporttype { # do this only if the radius_attr table is empty local $FS::radius_attr::noexport_hack = 1; my $class = shift; return if qsearch('radius_attr', {}); foreach my $self ($class->all_sqlradius) { my $error = $self->import_attrs; die "exportnum ".$self->exportnum.":\n$error\n" if $error; } return; } sub import_attrs { my $self = shift; my $dbh = FS::DBI->connect( map $self->option($_), qw( datasrc username password ) ); unless ( $dbh ) { warn "Error connecting to RADIUS server: $FS::DBI::errstr\n"; return; } my $usergroup = $self->option('usergroup') || 'usergroup'; my $error; warn "Importing RADIUS groups and attributes from ".$self->option('datasrc'). "\n"; # map out existing groups and attrs my %attrs_of; my %groupnum_of; foreach my $radius_group ( qsearch('radius_group', {}) ) { $attrs_of{$radius_group->groupname} = +{ map { $_->attrname => $_ } $radius_group->radius_attr }; $groupnum_of{$radius_group->groupname} = $radius_group->groupnum; } # get groupnames from radgroupcheck and radgroupreply my $sql = ' SELECT groupname, attribute, op, value, \'C\' FROM radgroupcheck UNION SELECT groupname, attribute, op, value, \'R\' FROM radgroupreply'; my @fixes; # things that need to be changed on the radius db foreach my $row ( @{ $dbh->selectall_arrayref($sql) } ) { my ($groupname, $attrname, $op, $value, $attrtype) = @$row; warn "$groupname.$attrname\n"; if ( !exists($groupnum_of{$groupname}) ) { my $radius_group = new FS::radius_group { 'groupname' => $groupname, 'priority' => 1, }; $error = $radius_group->insert; if ( $error ) { warn "error inserting group $groupname: $error"; next;#don't continue trying to insert the attribute } $attrs_of{$groupname} = {}; $groupnum_of{$groupname} = $radius_group->groupnum; } my $a = $attrs_of{$groupname}; my $old = $a->{$attrname}; my $new; if ( $attrtype eq 'R' ) { # Freeradius tolerates illegal operators in reply attributes. We don't. if ( !grep ($_ eq $op, FS::radius_attr->ops('R')) ) { warn "$groupname.$attrname: changing $op to +=\n"; # Make a note to change it in the db push @fixes, [ 'UPDATE radgroupreply SET op = \'+=\' WHERE groupname = ? AND attribute = ? AND op = ? AND VALUE = ?', $groupname, $attrname, $op, $value ]; # and import it correctly. $op = '+='; } } if ( defined $old ) { # replace $new = new FS::radius_attr { $old->hash, 'op' => $op, 'value' => $value, }; $error = $new->replace($old); if ( $error ) { warn "error modifying attr $attrname: $error"; next; } } else { $new = new FS::radius_attr { 'groupnum' => $groupnum_of{$groupname}, 'attrname' => $attrname, 'attrtype' => $attrtype, 'op' => $op, 'value' => $value, }; $error = $new->insert; if ( $error ) { warn "error inserting attr $attrname: $error" if $error; next; } } $attrs_of{$groupname}->{$attrname} = $new; } #foreach $row foreach (@fixes) { my ($sql, @args) = @$_; my $sth = $dbh->prepare($sql); $sth->execute(@args) or warn $sth->errstr; } return; } ### #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 phone_sqlradius broadband_sqlradius ); @part_export; } sub all_sqlradius_withaccounting { my $class = shift; grep { ! $_->option('ignore_accounting') } $class->all_sqlradius; } 1;