radius-clients.redhat

#!/usr/bin/perl

# radius-clients - manage the clients.conf file in freeradius
# 
# since editing the file is troublesome and error-prone, we keep the 
# contents of the file in an sqlite database and re-generate the actual 
# file on demand.

## user-configurable stuff
# DSN for database (hint: use sqlite)
my $DBDSN = "dbi:SQLite:dbname=/var/secrets/radius-client-db.sqlite";

# where's the freeradius clients.conf file?
my $FR_CLIENT_CONFFILE = "/var/secrets/clients.conf";


## includes
# handles dns/hosts lookup and ip -> int conversion
use Socket qw(AF_INET inet_ntop SOCK_RAW IPPROTO_IP unpack_sockaddr_in getaddrinfo inet_aton);

# get real random numbers that are safe for crypto
use Crypt::OpenSSL::Random qw(random_bytes random_status);

# because long hex strings suck.
use MIME::Base64;

# database for clients
use DBI;

# this script will take arguments
use Getopt::Long;


# world-readable files are bad for us.
umask 0077;

## takes an ip or hostname and returns an ipv4 longip 
# (in unpacked integer form)
# some hostnames resolve to multiple addresses -- we fail if this happens.
# 
# dies if input doesn't convert to an ip.
# also dies if input converts to multiple ips.
sub addr2long($)
{
    my $addr = shift;

    my($err, @res) = getaddrinfo($addr, "", {socktype=>SOCK_RAW, family=>AF_INET, protocol=>IPPROTO_IP});

    # just blow up the script, it's not like we're going to do anything 
    # else for error recovery.
    # better to fail here than input garbage.
    die($err) if( length $err );

    # @res can contain duplicates, which we are okay with.
    # @res can also contain multiple unique items, which we are not.
    # the host has a single canonical IP, and that's the one we want.
    # adding entries based on a dns name that resolves to multiple ips is
    # almost always not what we want. (this will change the secret on all
    # hosts, not just the one the user is thinking of)

    my %seen;
    # stick unpacked ips in a hash for dedup
    foreach my $sa (@res)
    {
        my($port, $packip) = unpack_sockaddr_in($sa->{'addr'});
        $seen{unpack("N*", $packip)} = 1;
        #unshift(@longips, unpack("N*", $packip));
    }

    # now we can build a list of unique IPs;
    my @longips;
    foreach my $packip (keys %seen)
    {
        unshift(@longips, $packip);
    }

    # and blow up if there's more than one IP.
    if( scalar @longips > 1 )
    {
        die("Host \"$addr\" corresponds to multiple IP addresses:\n  " .
            join("\n  ", map(long2ip($_), @longips)) . 
            "\nUse a unique IP address or the host's " .
            "canonical hostname instead.\n");
    }

    return $longips[0];
}



## take a longip (unpacked integer form) and return a dotted-quad 
# string representation
sub long2ip($)
{
    my $longip = shift;
    return inet_ntop(AF_INET, pack("N*", $longip));
}



## return a cryptographically-secure nonce with ~128 bits of entropy
# this will be safe to use as a radius secret.
# takes a string as input and prepends to the nonce. this is to 
# help with identifying the nonce, not contribute to its entropy.
#
# dies if insufficient entropy (usually means no /dev/urandom)
sub makeRadiusSecret($)
{
    my $id = shift;

    # bail out here if there's not enough entropy. better than using non-random data.
    die("OpenSSL PRNG isn't adequately seeded.  Do you have /dev/urnadom?") if( !random_status() );

    # 16 bytes = 128 bits
    # we'll base64 encode this to save space. the other choice was hex, 
    # and that's really long.
    my $random = encode_base64(random_bytes(16));
    chomp $random;
    $random =~ s/=*$//g;
    
    # and break into blocks of 4 characters, just in case cut/paste isn't 
    # an option.
    $random = join('.', unpack('(a4)*', $random));

    return sprintf("%s-%s", $id, $random);
}



## create database schema
# provide a usable DSN string.
# dies if anything goes wrong.
# DO NOT CALL THIS IF YOU HAVE ALREADY CONNECTED TO THE DATABASE.
sub createDB($)
{
    my $DBDSN = shift;

    # connect
    my $dbh = DBI->connect($DBDSN, "", "", 
        { AutoCommit => 1, PrintWarn => 1, PrintError => 1}) or die($!);

    # create table
    printf STDERR ("Creating database at DSN: %s\n", $DBDSN);
    $dbh->do("CREATE TABLE radius_clients (ip integer primary key not null unique on conflict replace, secret text not null)") or die($dbh->errstr);

    # yay!
    printf STDERR ("Success!\n");
}



## print some help
sub printHelp()
{
    printf STDERR ("Usage: %s <action> [<host>]\n", $0);
    print STDERR << '__END__HELP__';

Manage the radius client database.

Action:
  --create             Create and initialize the database
  --add                Add a client, hostname follows
  --del                Delete a client, hostname follows
  --replaceconfigfile  Generate a new FreeRadius clients.conf file
  --help               This message
__END__HELP__

    exit(1);
}



## option handler - figure out what action to perform
our $action = undef;
sub optionHandler($$)
{
    my($opt_name, $opt_value) = @_;

    # if we're trying to set an action again, this is an error. show some
    # help, as the user has NFI what they're doing.
    if( defined($action) )
    {
        warn("Multiple actions specified.  Use one.");
        printHelp();
	exit(1);
    }

    if( $opt_name eq 'help' )
    {
        printHelp();
        exit(1);
    }

    $action = $opt_name;

}

## do stuff


# determine action to perform
GetOptions(
    'createdb'        => \&optionHandler,
    'add'             => \&optionHandler,
    'del'             => \&optionHandler,
    'list'            => \&optionHandler,
    'replaceconfigfile' => \&optionHandler,
    'help'            => \&optionHandler,
);


# no action: show help.
if( ! $action )
{
    printHelp();
    exit(1);
}


# action: create the database 
if( $action eq 'createdb' )
{
    createDB($DBDSN);
    exit(0);
}


# everything below will touch the db. this is a good time to
# connect.
my $dbh = DBI->connect($DBDSN, "", "", { AutoCommit => 1, PrintWarn => 0, PrintError => 0, RaiseError => 0} ) or die("Unable to open database: $DBDSN");

# check for schema -- this might be a fresh or wrong file.
# just need to know if there's a radius_clients table.
# this might throw an error. let's assume it means 'table doesnt exist'
my $sth = $dbh->prepare("select ip from radius_clients limit 1");
if( !defined $sth )
{
    die("Database seems to be missing or uninitalized. Try creating it.\n" . 
    "  Hint: $0 --create\n");
}
else
{
    $sth->finish();
}


# action: build a config
if( $action eq 'replaceconfigfile' )
{
    # warn a little, just in case
    for( my $i = 5; $i > 0; $i-- )
    {
        printf STDERR ("Replacing %s in %d seconds! Use Ctrl-C to abort!\n", $FR_CLIENT_CONFFILE, $i);
        sleep(1);
    }

    open(FH, ">$FR_CLIENT_CONFFILE") or die($!);
    print FH <<__FR_CONFFILE_BOILERPLATE__;
###############################################################################
###############################################################################
###############################################################################
#  DO NOT EDIT THIS FILE     DO NOT EDIT THIS FILE     DO NOT EDIT THIS FILE  # 
#  DO NOT EDIT THIS FILE     DO NOT EDIT THIS FILE     DO NOT EDIT THIS FILE  # 
#  DO NOT EDIT THIS FILE     DO NOT EDIT THIS FILE     DO NOT EDIT THIS FILE  # 
#  DO NOT EDIT THIS FILE     DO NOT EDIT THIS FILE     DO NOT EDIT THIS FILE  # 
#  DO NOT EDIT THIS FILE     DO NOT EDIT THIS FILE     DO NOT EDIT THIS FILE  # 
###############################################################################
###############################################################################
###############################################################################
#  Generated by: radius-clients --replaceconfigfile                           #
#  Any changes made to this file will be lost FOREVER.                        #
###############################################################################


__FR_CONFFILE_BOILERPLATE__

    printf FH ("# Built on %s\n\n", scalar localtime());

    # pull the secrets from the db
    $sth = $dbh->prepare("SELECT ip,secret from radius_clients order by ip asc") or die($dbh->errstr);
    $sth->execute() or die($dbh->errstr);
  
    while(my @row = $sth->fetchrow_array())
    {
        printf FH ("client %s {\n\tsecret\t= %s\n\trequire_message_authenticator = no\n}\n\n", long2ip($row[0]), $row[1]);
    }

    $sth->finish();
    close(FH) or die($!);

    print STDERR ("Done! Don't forget to restart freeradius!\n");
    exit(0);
} 


# action: list
if( $action eq 'list' )
{
    $sth = $dbh->prepare("SELECT ip from radius_clients order by ip asc") or die($dbh->errstr);
    $sth->execute() or die($dbh->errstr);
    
    print(" IP (guessed hostname)\n ");
    print "-" x 78;
    print "\n";
    
    while(my @row = $sth->fetchrow_array())
    {
        my $ipstr = long2ip($row[0]);
        my $hostname = gethostbyaddr(inet_aton($ipstr), AF_INET);
        printf("%-15s %s\n", $ipstr, $hostname);
    }

    $sth->finish();
    exit(0);
}


# all further actions require a host/ip. get that now and resolve it.
if( !defined $ARGV[0] )
{
    die("This action requires a hostname or IP address.\n");
}
my $longip = addr2long($ARGV[0]);


# action: add
if( $action eq 'add' )
{
    my $secret = makeRadiusSecret(long2ip($longip));
    $sth = $dbh->prepare("INSERT OR REPLACE into radius_clients (ip,secret) values(?,?)") or die($dbh->errstr);
    $sth->execute($longip, $secret) or die($dbh->errstr);
    printf("%s %s\n", long2ip($longip), $secret);
    exit(0);
}


# action: del
if( $action eq 'del' )
{
    $sth = $dbh->prepare("DELETE from radius_clients where ip = ?") or die($dbh->errstr);
    $sth->execute($longip) or die($dbh->errstr);
    printf("Deleted secret for %s\n", long2ip($longip));
    exit(0);
}