Better documentation will follow; for now, this will have to do.
It's the source of the module as of version 0.9.7. This module is useful
if you don't want to perform the actual checks in your SQL query or
the behaviour file or if you're migrating from FreeRADIUS; it should
provide full compatibility with the 'radcheck' table as used by rlm_sql.
#!/usr/bin/perl -w
#
# RADCHECKSQL - OpenRADIUS module that queries any DBI/DBD-supported database
# for check items, performs the checks, and returns an 'int'
# attribute, containing 1 if all checks returned OK, -1 if the
# query returned no rows, and 0 otherwise.
#
# Usage: radchecksql [-d] database dbuser dbpass
# radchecksql -h
#
# 'database' is a DBI connect string without the leading 'dbi:' part.
# -d increases verbosity on stderr and allows module to run standalone
#
# The module performs a query based on the first 'str' attribute and using
# optional subsequent 'str' and 'int' attributes as bind variables -- see
# the documentation for radsql for details.
#
# The query must return three columns, in this order: attribute, value,
# operation. The 'operation' must be either <, <=, ==, !=, >=, >, any other
# value, including NULL is treated the same way as ==.
#
# Author: Emile van Bergen, emile@evbergen.xs4all.nl
#
# Permission to redistribute an original or modified version of this program in
# source, intermediate or object code form is hereby granted exclusively under
# the terms of the GNU General Public License, version 2. Please see the file
# COPYING for details, or refer to http://www.gnu.org/copyleft/gpl.html.
#
# History: 2003/04/26 - EvB - Started
########
# USES #
########
use Getopt::Long;
use DBI qw(:sql_types);
use strict qw(vars);
###########
# OPTIONS #
###########
my $usage = 0;
my $debug = 0;
my $noint = 0;
########
# MAIN #
########
# Get options
Getopt::Long::Configure("bundling");
GetOptions("h" => \$usage,
"d+" => \$debug,
"n" => \$noint);
if ($usage || !$ARGV[2]) {
die("Usage: radchecksql [-d] database dbuser dbpass\n" .
" radchecksql -h\n");
}
# Check that we're running under OpenRADIUS, interface version 1
unless ($debug ||
$ENV{'RADIUSINTERFACEVERSION'} &&
$ENV{'RADIUSINTERFACEVERSION'} == 1) {
die "radsql: ERROR: not running under OpenRADIUS, interface v1!\n";
}
# Connect to database
my $dbh = DBI->connect("dbi:" . $ARGV[0], $ARGV[1], $ARGV[2])
or die "ERROR: Could not connect to @ARGV!\n";
# Set record separator to empty line and loop on input.
$/ = "\n\n";
$| = 1; # Important - we're outputting to a pipe
my $sql;
my $lastsql;
my $sth;
my $n;
my $v;
my $r;
my $ca;
my $cv;
my $op;
my @bindvars;
my %pairs;
MESG:
while() {
# get int and str pairs from message; first str is SQL query
$sql = '';
@bindvars = ();
%pairs = ();
PAIR:
while(s/^\s*
([A-Za-z0-9:-]+) # attr
\s*=\s*
(
(\d+).*| # int or date
(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}).*| # ip
"([^"]*)".*| # quoted str
([^"].*) # bare str to eol
)
(\n|$)//mx) {
$v = defined $3 ? $3 : ($5 || $6);
if ($1 eq 'int') { push @bindvars, [$v, 1]; next PAIR; }
if ($1 eq 'str') {
if ($sql) { push @bindvars, [$v, 0]; next PAIR; }
$sql = $v;
next PAIR;
}
$pairs{$1} = $v;
}
if ($debug) {
print STDERR "sql=[$sql]\n";
foreach my $bindvar (@bindvars) {
print STDERR "bindvar=[$bindvar->[0]] isint=$bindvar->[1]\n";
}
foreach my $atr (keys %pairs) {
print STDERR "atr=[$atr] val=[$pairs{$atr}]\n";
}
}
next MESG unless $sql;
# Prepare statement if not same as last one
if (!$sth || $sql ne $lastsql) {
if ($sth) { $sth->finish; }
$sth = $dbh->prepare($sql) or die "ERROR: Could not parse SQL!\n";
$lastsql = $sql;
}
# Bind variables
$n = 1;
foreach my $bindvar (@bindvars) {
$sth->bind_param($n, $bindvar->[0], $bindvar->[1] ? SQL_INTEGER :
SQL_VARCHAR)
or die "ERROR: Could not bind variable $n!\n";
$n++;
}
# Run statement
$sth->execute or die "ERROR: Could not execute SQL!\n";
$n = $sth->{NUM_OF_FIELDS};
if ($n != 3) { die "ERROR: Query returns $n columns instead of 3!\n"; }
$r = -1;
while(($ca, $cv, $op) = $sth->fetchrow_array) {
$v = $pairs{$ca} || '';
OP: {
$r &= $v lt $cv, last OP if $op eq '<';
$r &= $v le $cv, last OP if $op eq '<=';
$r &= $v ne $cv, last OP if $op eq '!=';
$r &= $v ge $cv, last OP if $op eq '>=';
$r &= $v gt $cv, last OP if $op eq '>';
$r &= $v eq $cv;
}
$debug and print STDERR "a=[$ca] cv=[$cv] op=[$op] v=[$v] r=[$r]\n";
}
print "int=$r\n";
# End of message
print "\n";
}