X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fpart_export%2Fsqlradius.pm;h=58cc5be95df82881fffa9a64540053e538e770e0;hb=a72a10f754f7465121d6137bb3dcee0a21ea6443;hp=d1663dcf5060bfb4abb0834c36b793426513e969;hpb=38eb380a88ea7a130e83b77ff9c51ef6967b707b;p=freeside.git diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm index d1663dcf5..58cc5be95 100644 --- a/FS/FS/part_export/sqlradius.pm +++ b/FS/FS/part_export/sqlradius.pm @@ -1,5 +1,6 @@ package FS::part_export::sqlradius; +use strict; use vars qw(@ISA @EXPORT_OK $DEBUG %info %options $notes1 $notes2); use Exporter; use Tie::IxHash; @@ -14,6 +15,7 @@ use Carp qw( cluck ); $DEBUG = 0; +my %groups; tie %options, 'Tie::IxHash', 'datasrc' => { label=>'DBI data source ' }, 'username' => { label=>'Database username' }, @@ -47,12 +49,29 @@ 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 (if not overridden by overlimit_groups global or per-agent config)', } , + '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', + }, ; $notes1 = <<'END'; @@ -91,6 +110,9 @@ 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. 'This export does not export RADIUS realms (see also '. 'sqlradius_withdomain). '. @@ -103,24 +125,34 @@ sub _groups_susp_reason_map { map { reverse( /^\s*(\S+)\s*(.*)$/ ) } sub rebless { shift; } -sub export_username { +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); + $svc_acct->radius_reply; +} + +sub radius_check { #override for other svcdb + my($self, $svc_acct) = (shift, shift); + $svc_acct->radius_check; +} + sub _export_insert { my($self, $svc_x) = (shift, shift); foreach my $table (qw(reply check)) { my $method = "radius_$table"; - my %attrib = $svc_x->$method(); + 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; + 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) @@ -181,6 +213,7 @@ sub _export_replace { return $error; } } + $jobnum = $err_or_queue->jobnum; # chain all of these dependencies } my @del = grep { !exists $new{$_} } keys %old; @@ -198,12 +231,13 @@ sub _export_replace { return $error; } } + $jobnum = $err_or_queue->jobnum; # chain all of these dependencies } } my $error; - my (@oldgroups) = $old->radius_groups; - my (@newgroups) = $new->radius_groups; + my (@oldgroups) = $old->radius_groups('hashref'); + my (@newgroups) = $new->radius_groups('hashref'); $error = $self->sqlreplace_usergroups( $new->svcnum, $self->export_username($new), $jobnum ? $jobnum : '', @@ -220,6 +254,7 @@ sub _export_replace { ''; } +#false laziness w/broadband_sqlradius.pm sub _export_suspend { my( $self, $svc_acct ) = (shift, shift); @@ -236,22 +271,27 @@ sub _export_suspend { 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; + 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; + } + } - my $error; - my (@newgroups) = $self->suspended_usergroups($svc_acct); - $error = - $self->sqlreplace_usergroups( $new->svcnum, - $self->export_username($new), - '', - $svc_acct->usergroup, - \@newgroups, - ); + my $error = + $self->sqlreplace_usergroups( + $new->svcnum, + $self->export_username($new), + '', + [ $svc_acct->radius_groups('hashref') ], + \@newgroups, + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -262,7 +302,7 @@ sub _export_suspend { } sub _export_unsuspend { - my( $self, $svc_acct ) = (shift, shift); + my( $self, $svc_x ) = (shift, shift); local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -275,21 +315,22 @@ sub _export_unsuspend { 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 ); + 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_acct); - $error = $self->sqlreplace_usergroups( $svc_acct->svcnum, - $self->export_username($svc_acct), - '', - \@oldgroups, - $svc_acct->usergroup, - ); + 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; @@ -309,6 +350,7 @@ sub _export_delete { 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", @@ -322,14 +364,16 @@ sub sqlradius_queue { } sub suspended_usergroups { - my ($self, $svc_acct) = (shift, shift); + my ($self, $svc_x) = (shift, shift); + + return () unless $svc_x; - return () unless $svc_acct; + my $svc_table = $svc_x->table; #false laziness with FS::part_export::shellcommands #subclass part_export? - my $r = $svc_acct->cust_svc->cust_pkg->last_reason('susp'); + my $r = $svc_x->cust_svc->cust_pkg->last_reason('susp'); my %reasonmap = $self->_groups_susp_reason_map; my $userspec = ''; if ($r) { @@ -338,19 +382,19 @@ sub suspended_usergroups { $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 $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_user = $user if $userspec eq $user->email; + $suspend_svc = $user if $userspec eq $user->email; } - }elsif ($userspec){ - $suspend_user = qsearchs( 'svc_acct', { 'username' => $userspec } ); + }elsif ( $userspec && $svc_table eq 'svc_acct' ){ + $suspend_svc = qsearchs( 'svc_acct', { 'username' => $userspec } ); } #esalf - return $suspend_user->radius_groups if $suspend_user; + return $suspend_svc->radius_groups('hashref') if $suspend_svc; (); } @@ -403,10 +447,12 @@ sub sqlradius_usergroup_insert { #subroutine, not method ) or die $dbh->errstr; my $sth = $dbh->prepare( - "INSERT INTO $usergroup ( UserName, GroupName ) VALUES ( ?, ? )" + "INSERT INTO $usergroup ( UserName, GroupName, Priority ) VALUES ( ?, ?, ? )" ) or die $dbh->errstr; - foreach my $group ( @groups ) { + 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 " . @@ -414,7 +460,7 @@ sub sqlradius_usergroup_insert { #subroutine, not method if $DEBUG; next; } - $sth->execute( $username, $group ) + $sth->execute( $username, $group, $priority ) or die "can't insert into groupname table: ". $sth->errstr; } if ( $s_sth->{Active} ) { @@ -437,7 +483,8 @@ sub sqlradius_usergroup_delete { #subroutine, not method my $sth = $dbh->prepare( "DELETE FROM $usergroup WHERE UserName = ? AND GroupName = ?" ) or die $dbh->errstr; - foreach my $group ( @groups ) { + foreach ( @groups ) { + my $group = $_->{'groupname'}; $sth->execute( $username, $group ) or die "can't delete from groupname table: ". $sth->errstr; } @@ -516,6 +563,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 ) { @@ -717,7 +765,7 @@ sub usage_sessions { } -=item update_svc_acct +=item update_svc =cut @@ -742,7 +790,7 @@ sub update_svc { AcctInputOctets, AcctOutputOctets FROM radacct WHERE FreesideStatus IS NULL - AND AcctStopTime != 0 + AND AcctStopTime IS NOT NULL ") or die $dbh->errstr; $sth->execute() or die $sth->errstr; @@ -845,6 +893,352 @@ sub _try_decrement { 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) = @_; + # 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 { + 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 { + 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 { + 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 { + 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 { + 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 { + 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; +} + +### +# 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 = DBI->connect( map $self->option($_), + qw( datasrc username password ) ); + unless ( $dbh ) { + warn "Error connecting to RADIUS server: $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 ### @@ -858,7 +1252,8 @@ sub all_sqlradius { my @part_export = (); push @part_export, qsearch('part_export', { 'exporttype' => $_ } ) - foreach qw( sqlradius sqlradius_withdomain radiator phone_sqlradius ); + foreach qw( sqlradius sqlradius_withdomain radiator phone_sqlradius + broadband_sqlradius ); @part_export; }