X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fpart_export%2Fsqlradius.pm;h=9e65e51a660a67c7317052b5651c3fe3a0c33563;hp=c360c9ef07943b0ea31b334ebb44408b45a921cd;hb=87c195131764ee7307e834bfb5b36b9e6ba14d07;hpb=f3c4966ed1f6ec3db7accd6dcdd3a5a3821d72a7 diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm index c360c9ef0..9e65e51a6 100644 --- a/FS/FS/part_export/sqlradius.pm +++ b/FS/FS/part_export/sqlradius.pm @@ -4,11 +4,13 @@ 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 ); +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( cluck ); +use NEXT; +use Net::OpenSSH; @ISA = qw(FS::part_export); @EXPORT_OK = qw( sqlradius_connect ); @@ -24,6 +26,10 @@ tie %options, 'Tie::IxHash', 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' @@ -47,7 +53,7 @@ tie %options, 'Tie::IxHash', }, 'show_called_station' => { type => 'checkbox', - label => 'Show the Called-Station-ID on session reports', + 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)', @@ -72,6 +78,12 @@ tie %options, 'Tie::IxHash', 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'; @@ -110,6 +122,7 @@ END '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. @@ -132,17 +145,21 @@ sub export_username { # override for other svcdb sub radius_reply { #override for other svcdb my($self, $svc_acct) = (shift, shift); - $svc_acct->radius_reply; + my %every = $svc_acct->EVERY::radius_reply; + map { @$_ } values %every; } sub radius_check { #override for other svcdb my($self, $svc_acct) = (shift, shift); - $svc_acct->radius_check; + 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); @@ -168,6 +185,8 @@ sub _export_insert { 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'; @@ -193,8 +212,8 @@ sub _export_replace { foreach my $table (qw(reply check)) { my $method = "radius_$table"; - my %new = $new->$method(); - my %old = $old->$method(); + my %new = $self->$method($new); + my %old = $self->$method($old); if ( grep { !exists $old{$_} #new attributes || $new{$_} ne $old{$_} #changed } keys %new @@ -212,6 +231,7 @@ sub _export_replace { return $error; } } + $jobnum = $err_or_queue->jobnum; # chain all of these dependencies } my @del = grep { !exists $new{$_} } keys %old; @@ -229,13 +249,14 @@ sub _export_replace { 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 = $self->sqlreplace_usergroups( $new->svcnum, + ($error,$jobnum) = $self->sqlreplace_usergroups( $new->svcnum, $self->export_username($new), $jobnum ? $jobnum : '', \@oldgroups, @@ -246,6 +267,27 @@ sub _export_replace { 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; ''; @@ -255,6 +297,8 @@ sub _export_replace { 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'; @@ -268,6 +312,8 @@ sub _export_suspend { 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 @@ -278,10 +324,11 @@ sub _export_suspend { $dbh->rollback if $oldAutoCommit; return $err_or_queue; } - + $jobnum = $err_or_queue->jobnum; } - my $error = + my $error; + ($error,$jobnum) = $self->sqlreplace_usergroups( $new->svcnum, $self->export_username($new), @@ -293,6 +340,28 @@ sub _export_suspend { $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; ''; @@ -301,6 +370,8 @@ sub _export_suspend { 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'; @@ -339,14 +410,37 @@ sub _export_unsuspend { 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", @@ -533,6 +627,8 @@ sub sqlradius_connect { DBI->connect(@_) or die $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) = @_; @@ -559,6 +655,7 @@ sub sqlreplace_usergroups { my $error = $err_or_queue->depend_insert( $jobnum ); return $error if $error; } + $jobnum = $err_or_queue->jobnum; # chain all of these dependencies } if ( @newgroups ) { @@ -573,8 +670,9 @@ sub sqlreplace_usergroups { my $error = $err_or_queue->depend_insert( $jobnum ); return $error if $error; } + $jobnum = $err_or_queue->jobnum; # chain all of these dependencies } - ''; + wantarray ? ('',$jobnum) : ''; } @@ -592,7 +690,8 @@ New-style: pass a hashref with the following keys: =item stoptime_end - Upper bound for AcctStopTime, as a UNIX timestamp -=item open_sessions - Only show records with no AcctStopTime (typically used without stoptime_* options and with starttime_* options instead) +=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 @@ -640,6 +739,8 @@ Returns an arrayref of hashrefs with the following fields: =item acctoutputoctets +=item callingstationid + =item calledstationid =back @@ -658,7 +759,7 @@ sub usage_sessions { $opt = shift; $start = $opt->{stoptime_start}; $end = $opt->{stoptime_end}; - $svc_acct = $opt->{svc_acct}; + $svc_acct = $opt->{svc} || $opt->{svc_acct}; $ip = $opt->{ip}; $prefix = $opt->{prefix}; $summarize = $opt->{summarize}; @@ -678,15 +779,16 @@ sub usage_sessions { qw( datasrc username password ) ); #select a unix time conversion function based on database type - my $str2time = str2time_sql( $dbh->{Driver}->{Name} ); + my $str2time = str2time_sql( $dbh->{Driver}->{Name} ); + my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} ); my @fields = ( qw( username realm framedipaddress acctsessiontime acctinputoctets acctoutputoctets - calledstationid + callingstationid calledstationid ), - "$str2time acctstarttime ) as acctstarttime", - "$str2time acctstoptime ) as acctstoptime", + "$str2time acctstarttime $closing as acctstarttime", + "$str2time acctstoptime $closing as acctstoptime", ); @fields = ( 'username', 'sum(acctsessiontime) as acctsessiontime', 'sum(acctinputoctets) as acctinputoctets', @@ -722,23 +824,33 @@ sub usage_sessions { push @where, " CalledStationID LIKE 'sip:$prefix\%'"; } - if ( $start ) { - push @where, "$str2time AcctStopTime ) >= ?"; - push @param, $start; - } - if ( $end ) { - push @where, "$str2time AcctStopTime ) <= ?"; - push @param, $end; + 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->{open_sessions} ) { - push @where, 'AcctStopTime IS NULL'; + 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 ) >= ?"; + push @where, "$str2time AcctStartTime $closing >= ?"; push @param, $opt->{starttime_start}; } if ( $opt->{starttime_end} ) { - push @where, "$str2time AcctStartTime ) <= ?"; + push @where, "$str2time AcctStartTime $closing <= ?"; push @param, $opt->{starttime_end}; } @@ -751,10 +863,14 @@ sub usage_sessions { my $orderby = 'ORDER BY AcctStartTime DESC'; $orderby = '' if $summarize; - my $sth = $dbh->prepare('SELECT '. join(', ', @fields). - " FROM radacct $where $groupby $orderby - ") or die $dbh->errstr; - $sth->execute(@param) or die $sth->errstr; + 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({}) } ]; @@ -773,7 +889,9 @@ sub update_svc { my $dbh = sqlradius_connect( map $self->option($_), qw( datasrc username password ) ); - my $str2time = str2time_sql( $dbh->{Driver}->{Name} ); + my $str2time = str2time_sql( $dbh->{Driver}->{Name} ); + my $closing = str2time_sql_closing( $dbh->{Driver}->{Name} ); + my @fields = qw( radacctid username realm acctsessiontime ); my @param = (); @@ -781,7 +899,7 @@ sub update_svc { my $sth = $dbh->prepare(" SELECT RadAcctId, UserName, Realm, AcctSessionTime, - $str2time AcctStartTime), $str2time AcctStopTime), + $str2time AcctStartTime $closing, $str2time AcctStopTime $closing, AcctInputOctets, AcctOutputOctets FROM radacct WHERE FreesideStatus IS NULL @@ -796,67 +914,90 @@ sub update_svc { "$RadAcctId ($UserName\@$Realm for ${AcctSessionTime}s" if $DEBUG; - $UserName = lc($UserName) unless $conf->exists('username-uppercase'); + my $fs_username = $UserName; - #my %search = ( 'username' => $UserName ); + $fs_username = lc($fs_username) unless $conf->exists('username-uppercase'); - 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 %search = ( 'username' => $fs_username ); - my $oldAutoCommit = $FS::UID::AutoCommit; # can't undo side effects, but at - local $FS::UID::AutoCommit = 0; # least we can avoid over counting - - my $status = 'skipped'; + my $status = ''; my $errinfo = "for RADIUS detail RadAcctID $RadAcctId ". "(UserName $UserName, Realm $Realm)"; - 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' => $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"; + 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 $svc_acct = $svc_acct[0]; - warn "found svc_acct ". $svc_acct->svcnum. " $errinfo\n" if $DEBUG; + my $oldAutoCommit = $FS::UID::AutoCommit; # can't undo side effects, but at + local $FS::UID::AutoCommit = 0; # least we can avoid over counting - $svc_acct->last_login($AcctStartTime); - $svc_acct->last_logout($AcctStopTime); + unless ( $status ) { - my $session_time = $AcctStopTime; - $session_time = $AcctStartTime if $self->option('ignore_long_sessions'); + $status = 'skipped'; - 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)'; + 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 @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); + + 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; @@ -966,8 +1107,7 @@ 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. It's probably best to do this - +'groupname' must be set in OLD_RADIUS_ATTR. =cut @@ -982,41 +1122,43 @@ sub export_attr_replace { shift->export_attr_action('replace', @_); } sub export_attr_action { my $self = shift; my ($action, $new, $old) = @_; - my ($attrname, $attrtype, $groupname) = - ($new->attrname, $new->attrtype, $new->radius_group->groupname); - if ( $action eq 'replace' ) { - - if ( $new->attrtype ne $old->attrtype ) { - # they're in separate tables in the target - return $self->export_attr_action('delete', $old) - || $self->export_attr_action('insert', $new) - ; - } + my $err_or_queue; - # otherwise, just make sure we know the old attribute/group names - # so we can find the existing record - $attrname = $old->attrname; - $groupname = $old->groupname || $old->radius_group->groupname; - # maybe this should be enforced more strictly - warn "WARNING: attribute replace without 'groupname' set; assuming '$groupname'\n" - if !defined($old->groupname); + 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; } - - my $err_or_queue = $self->sqlradius_queue('', "attr_$action", - attrnum => $new->attrnum, - attrname => $attrname, - attrtype => $attrtype, - groupname => $groupname, - ); - return $err_or_queue unless ref $err_or_queue; ''; } sub sqlradius_attr_insert { my $dbh = sqlradius_connect(shift, shift, shift); my %opt = @_; - my $radius_attr = qsearchs('radius_attr', { attrnum => $opt{'attrnum'} }) - or die 'attrnum '.$opt{'attrnum'}.' not found'; my $table; # make sure $table is completely safe @@ -1027,12 +1169,10 @@ sub sqlradius_attr_insert { $table = 'radgroupreply'; } else { - die "unknown attribute type '".$radius_attr->attrtype."'"; + die "unknown attribute type '$opt{attrtype}'"; } - my @values = ( - $opt{'groupname'}, map { $radius_attr->$_ } qw(attrname op value) - ); + my @values = @opt{ qw(groupname attrname op value) }; my $sth = $dbh->prepare( 'INSERT INTO '.$table.' (groupname, attribute, op, value) VALUES (?,?,?,?)' ); @@ -1054,41 +1194,16 @@ sub sqlradius_attr_delete { 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 = ?' + 'DELETE FROM '.$table. + ' WHERE groupname = ? AND attribute = ? AND op = ? AND value = ?'. + ' LIMIT 1' ); - $sth->execute( @opt{'groupname', 'attrname'} ) or die $dbh->errstr; + $sth->execute(@values) or die $dbh->errstr; } -sub sqlradius_attr_replace { - my $dbh = sqlradius_connect(shift, shift, shift); - my %opt = @_; - my $radius_attr = qsearchs('radius_attr', { attrnum => $opt{'attrnum'} }) - or die 'attrnum '.$opt{'attrnum'}.' not found'; - - my $table; - if ( $opt{'attrtype'} eq 'C' ) { - $table = 'radgroupcheck'; - } - elsif ( $opt{'attrtype'} eq 'R' ) { - $table = 'radgroupreply'; - } - else { - die "unknown attribute type '".$opt{'attrtype'}."'"; - } - - my $sth = $dbh->prepare( - 'UPDATE '.$table.' SET groupname = ?, attribute = ?, op = ?, value = ? - WHERE groupname = ? AND attribute = ?' - ); - - my $new_groupname = $radius_attr->radius_group->groupname; - my @new_values = ( - $new_groupname, map { $radius_attr->$_ } qw(attrname op value) - ); - $sth->execute( @new_values, @opt{'groupname', 'attrname'} ) - or die $dbh->errstr; -} +#sub sqlradius_attr_replace { no longer needed =item export_group_replace NEW OLD @@ -1139,6 +1254,56 @@ sub sqlradius_group_replace { 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 { + 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 ### @@ -1185,6 +1350,7 @@ sub import_attrs { 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"; @@ -1206,6 +1372,20 @@ SELECT groupname, attribute, op, value, \'R\' FROM radgroupreply'; 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 { @@ -1235,6 +1415,13 @@ SELECT groupname, attribute, op, value, \'R\' FROM radgroupreply'; } $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; }