X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fpart_export%2Fsqlradius.pm;h=d7cd459d8de1b4ec5d3a269d02d7267f19a36b2a;hb=ee8a023fff0a259b0c62b46b260a396805ad2f00;hp=8af53abcd15419bc7fa1f9fd33caae01b862185d;hpb=bf79d364cb1beb5dcc00becb6f7689dc37adfbc0;p=freeside.git diff --git a/FS/FS/part_export/sqlradius.pm b/FS/FS/part_export/sqlradius.pm index 8af53abcd..d7cd459d8 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; @@ -67,7 +68,10 @@ tie %options, 'Tie::IxHash', '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'; @@ -106,6 +110,8 @@ END 'desc' => 'Real-time export to SQL-backed RADIUS (FreeRADIUS, ICRADIUS)', 'options' => \%options, 'nodomain' => 'Y', + '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). '. @@ -118,24 +124,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) @@ -217,8 +233,8 @@ sub _export_replace { } 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 : '', @@ -235,6 +251,7 @@ sub _export_replace { ''; } +#false laziness w/broadband_sqlradius.pm sub _export_suspend { my( $self, $svc_acct ) = (shift, shift); @@ -265,12 +282,13 @@ sub _export_suspend { } my $error = - $self->sqlreplace_usergroups( $new->svcnum, - $self->export_username($new), - '', - $svc_acct->usergroup, - \@newgroups, - ); + $self->sqlreplace_usergroups( + $new->svcnum, + $self->export_username($new), + '', + [ $svc_acct->radius_groups('hashref') ], + \@newgroups, + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -281,7 +299,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'; @@ -294,21 +312,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; @@ -328,6 +347,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", @@ -341,14 +361,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) { @@ -357,19 +379,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; (); } @@ -422,10 +444,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 " . @@ -433,7 +457,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} ) { @@ -456,7 +480,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; } @@ -736,7 +761,7 @@ sub usage_sessions { } -=item update_svc_acct +=item update_svc =cut @@ -761,7 +786,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; @@ -864,6 +889,330 @@ 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'; + 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 ( 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 + return; +} + ### #class methods ### @@ -877,7 +1226,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; }