+=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<FS::radius_group>->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<FS::radius_group> 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;
+}
+
+=item sqlradius_user_disconnect
+
+For a specified user, sends a disconnect request to all nas in the server database.
+
+Accepts L</sqlradius_connect> connection input and the following named parameters:
+
+I<disconnect_ssh> - user@host with access to radclient program (required)
+
+I<svc_acct_username> - the user to be disconnected (required)
+
+I<disconnect_port> - the port (on the nas) to send disconnect requests to (defaults to 1700)
+
+I<disconnect_log> - if true, print disconnect command & output to the error log
+
+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
+ eval "use Net::SSH";
+ 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?
+ 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);
+ warn $command . "\n" . $output . $errput . $ssh->error . "\n"
+ if $opt{'disconnect_log'};
+ }
+ 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 = 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;
+}
+