(RADAR) Multiple monitor clauses
Mike McCauley
mikem at open.com.au
Thu May 16 01:33:27 CDT 2002
Hi Ashley,
Thanks for reporting this.
It was caused by an oversight in Monitor.pm
We apologise for this problem.
Attached is a new version of Monitor.pm for Radiator that will fix that.
The new version is also available as a patch on the web site.
Pls let me know if its OK, and I will roll it in to the next release.
Cheers.
On Thu, 16 May 2002 16:17, Kent, Ashley wrote:
> Hi guys,
>
> I'm having problems using multiple monitor clauses. My monitor clauses look
> like:
>
> <Monitor>
> # Helpdesk and Tier 2
> Username lanpc
> Password xxxxxx
> TraceOnly
> </Monitor>
>
> <Monitor>
> # Network and Security
> Username admin
> Password yyyyyy
> Port 9049
> </Monitor>
>
>
> When I point radar at the radiator box running this config the login box
> does not pop up. I do not get a chance to log in at all. A trace 4 log does
> not show any error messages. Actually it doesn't even show the "DEBUG: New
> MonitorConnection created for" message. Each of the clauses work fine
> seperately.
>
>
>
>
> Thanks,
>
>
>
> Ash.
>
> ===
> Archive at http://www.open.com.au/archives/radar/
> Announcements on radar-announce at open.com.au
> To unsubscribe, email 'majordomo at open.com.au' with
> 'unsubscribe radar' in the body of the message.
--
Mike McCauley mikem at open.com.au
Open System Consultants Pty. Ltd Unix, Perl, Motif, C++, WWW
24 Bateman St Hampton, VIC 3188 Australia http://www.open.com.au
Phone +61 3 9598-0985 Fax +61 3 9598-0955
Radiator: the most portable, flexible and configurable RADIUS server
anywhere. SQL, proxy, DBM, files, LDAP, NIS+, password, NT, Emerald,
Platypus, Freeside, TACACS+, PAM, external, Active Directory etc etc
on Unix, Win95/8, 2000, NT, MacOS 9, MacOS X etc etc
-------------- next part --------------
# Monitor.pm
#
# Object for TCP connections and debugging/monitoring
# of Radiator internals.
# IT is designed principally to support a remote client program
# for probing internals and getting statistics,
# but it can be used with telnet(1)
#
# Author: Mike McCauley (mikem at open.com.au)
# Copyright (C) 2001 Open System Consultants
# $Id: Monitor.pm,v 1.6 2002/05/16 06:27:36 mikem Exp mikem $
package Radius::Monitor;
@ISA = qw(Radius::Configurable);
use Radius::Configurable;
use Radius::Radius;
use Socket;
use strict;
%Radius::Monitor::ConfigKeywords =
('Port' => 'string',
'BindAddress' => 'string',
'Clients' => 'string',
'Username' => 'string',
'Password' => 'string',
'AuthByPolicy' => 'string',
'MaxBufferSize' => 'integer',
'TraceOnly' => 'flag',
'AuthBy' => 'objectlist',
);
#####################################################################
sub new
{
my ($class, @args) = @_;
my $self = $class->SUPER::new(@args);
# Set up the TCP listener
my $proto = getprotobyname('tcp');
my $port = Radius::Util::get_port($self->{Port});
my $s = do { local *FH };
socket($s, Socket::PF_INET, Socket::SOCK_STREAM, $proto)
|| $self->log($main::LOG_ERR, "Could not create Monitor socket: $!");
setsockopt($s, Socket::SOL_SOCKET, Socket::SO_REUSEADDR, 1);
bind($s,
scalar Socket::sockaddr_in
($port,
Socket::inet_aton
($self->{BindAddress})))
|| $self->log($main::LOG_ERR, "Could not bind Monitor socket: $!");
listen($s, Socket::SOMAXCONN)
|| $self->log($main::LOG_ERR, "Could not listen on Monitor socket: $!");
&Radius::Select::add_file
(fileno($s), 1, undef, undef,
\&handle_listen_socket_read, $s, $self);
return $self;
}
#####################################################################
# Do per-instance default initialization
# This is called by Configurable during Configurable::new before
# the config file is parsed. Its a good place initialize instance
# variables
# that might get overridden when the config file is parsed.
# Do per-instance default initialization. This is called after
# construction is complete
sub initialize
{
my ($self) = @_;
$self->SUPER::initialize;
$self->{Port} = 9048;
$self->{MaxBufferSize} = 100000;
$self->{BindAddress} = '0.0.0.0';
}
#####################################################################
# This is called by Select::select whenever our listen socket
# becomes readable, which means someone is trying to connect to us
# We accept the new connection
sub handle_listen_socket_read
{
my ($fileno, $listensocket, $self) = @_;
# This could have been done with FileHandle, but this is much
# more lightweight. It makes a reference to a TYPEGLOB
# and Perl can use a typeglob ref as an IO handle
my $newsocket = do { local *FH };
if (!accept($newsocket, $listensocket))
{
$self->log($main::LOG_ERR, "Could not accept on Monitor listen socket: $!");
return;
}
# REVISIT: check that the socket isd from a permitted client
Radius::MonitorConnection->new($self, $newsocket,
MaxBufferSize => $self->{MaxBufferSize});
}
#####################################################################
#####################################################################
#####################################################################
package Radius::MonitorConnection;
#####################################################################
sub new
{
my ($class, $parent, $socket, %args) = @_;
my $self = {%args};
bless $self, $class;
$self->{parent} = $parent;
$self->{socket} = $socket;
$self->{recsep} = "\n";
$self->{peer} = getpeername($self->{socket})
|| $self->log($main::LOG_ERR, "Could not get peer name on MonitorConnection socket: $!");
my ($port, $peeraddr) = Socket::unpack_sockaddr_in($self->{peer});
$self->{peerport} = $port;
$self->{peeraddr} = Socket::inet_ntoa($peeraddr);
$self->{inbuffer} = undef;
$self->{outbuffer} = undef;
$self->{Trace} = 0; # Default trace level
$parent->log($main::LOG_DEBUG, "New MonitorConnection created for $self->{peeraddr}:$self->{peerport}");
# We act like a global logger too
&Radius::LogGeneric::add_logger($self);
&Radius::Select::add_file
(fileno($self->{socket}), 1, undef, undef,
\&handle_connection_socket_read, $self);
}
#####################################################################
# Called when more data can be read from the socket
sub handle_connection_socket_read
{
my ($fileno, $self) = @_;
# Append the next lot of bytes to the buffer
if (sysread($self->{socket}, $self->{inbuffer}, 16384, length $self->{inbuffer}))
{
while ($self->{inbuffer} ne '')
{
# Look for EOL. If found, its the end of the command
my $index = index($self->{inbuffer}, $self->{recsep});
if ($index >= 0)
{
my $buffer = substr($self->{inbuffer}, 0, $index);
# Remove the record and the record sep
substr($self->{inbuffer}, 0, $index + length $self->{recsep}) = '';
$buffer =~ s/[\012\015]//g if $self->{recsep} eq "\n";
$self->command($buffer);
}
else
{
return; # No complete statement in buffer
}
}
$self->{inbuffer} = undef; # Prevent inbuffer growing inf long
}
else
{
# Strange, nothing there, must be a disconnection error
$self->disconnect();
}
}
#####################################################################
# Called when more data can be written to the socket
sub handle_connection_socket_write
{
my ($fileno, $self) = @_;
$self->write_pending();
# Dont need this callback any more if all the pending bytes
# have been written
&Radius::Select::remove_file
(fileno($self->{socket}), undef, 1, undef)
if !length $self->{outbuffer};
}
#####################################################################
# Called when a complete command has been received
# Parse and process it
sub command
{
my ($self, $cmd) = @_;
$self->{parent}->log($main::LOG_DEBUG, "Monitor received command: $cmd");
# Simple replay of commands
$cmd = $self->{lastcommand} if ($cmd eq '');
$self->{lastcommand} = $cmd;
if ($cmd =~ /^ID/i)
{
return $self->write('NOTLOGGEDIN') unless $self->{loggedin};
# Server ident message
my $time = time;
$self->write("ID $time $main::ident");
}
elsif ($cmd =~ /^TRACE\s+(\d+)/i)
{
return $self->write('NOTLOGGEDIN') unless $self->{loggedin};
# Set the current trace level for this client
$self->{Trace} = $1;
$self->write('TRACE');
}
elsif ($cmd =~ /^TRACE_USERNAME\s*(\S*)/i)
{
return $self->write('NOTLOGGEDIN') unless $self->{loggedin};
# Set the current trace username for this client
$self->{trace_username} = $1;
$self->write('TRACE_USERNAME');
}
elsif ($cmd =~ /^STATS\s+(\S*)/i)
{
return $self->write('NOTLOGGEDIN') unless $self->{loggedin};
return $self->write('NOPERMISSION') if $self->{parent}->{TraceOnly};
# Get the the statistics for the named object
my $path = $1 || '.';
my $o = findObject($path);
if ($o && ref($o) =~ /^Radius::/)
{
$self->write("STATS $path\n" . join("\001", map "$Radius::ServerConfig::statistic_names{$_}:$o->{Statistics}{$_}", (sort keys %Radius::ServerConfig::statistic_names)));
}
else
{
$self->write('NOSUCHOBJECT');
}
}
elsif ($cmd =~ /^DESCRIBE\s+(\S*)/i)
{
return $self->write('NOTLOGGEDIN') unless $self->{loggedin};
return $self->write('NOPERMISSION') if $self->{parent}->{TraceOnly};
# Describe the named object by returning a list of attribtues
# and their types
my $path = $1 || '.';
my $o = findObject($path);
if ($o && ref($o) =~ /^Radius::/)
{
my %keywords = $o->configKeywords();
$self->write("DESCRIBE $path\n" . join("\001", "Type:objecttype:" . ref($o), map "$_:$keywords{$_}:" . $o->{$_}, (sort keys %keywords)));
}
else
{
$self->write('NOSUCHOBJECT');
}
}
elsif ($cmd =~ /^SET\s+(\S+)\s+(\S+)\s+(.*)/i)
{
return $self->write('NOTLOGGEDIN') unless $self->{loggedin};
return $self->write('NOPERMISSION') if $self->{parent}->{TraceOnly};
# Set the value of a variable
my $path = $1 || '.';
my $attribute = $2;
my $value = $3;
my $o = findObject($path);
if ($o && ref($o) =~ /^Radius::/)
{
$o->set($attribute, $value);
$self->write("SET $path $attribute $value\n");
}
else
{
$self->write('NOSUCHOBJECT');
}
}
elsif ($cmd =~ /^LIST\s+(\S+)/i)
{
return $self->write('NOTLOGGEDIN') unless $self->{loggedin};
return $self->write('NOPERMISSION') if $self->{parent}->{TraceOnly};
# List the index and Name of each object in an objectlist
my $path = $1;
my $o = findObject($path);
my $x = ref($o);
if ($o && ref($o) eq 'ARRAY')
{
$self->write("LIST $path\n" . join("\001", map "$_:object:$$o[$_]->{Name}", (0 .. $#$o)));
}
}
elsif ($cmd =~ /^LOGIN\s+(\S*)\s+(\S*)/i)
{
# The username to be logged in as
$self->{username} = $1;
$self->{password} = $2;
$self->write($self->authenticate() ? 'LOGGEDIN' : 'BADLOGIN');
}
elsif ($cmd =~ /^CHALLENGE/i)
{
# Generate a challenge to use for logging in later
$self->{lastchallenge} = Radius::Util::random_string(16);
$self->write('CHALLENGE ' . unpack('H*', $self->{lastchallenge}));
}
elsif ($cmd =~ /^BINARY/i)
{
$self->{recsep} = "\000";
}
elsif ($cmd =~ /^RESTART/i)
{
return $self->write('NOTLOGGEDIN') unless $self->{loggedin};
return $self->write('NOPERMISSION') if $self->{parent}->{TraceOnly};
$main::restart++;
}
elsif ($cmd =~ /^HELP/i)
{
# Help message
$self->write("HELP\nLOGIN name password\nTRACE n\nSTATS objname\nDESCRIBE objname\nSET objname paramname value\nLIST objname\nCHALLENGE\nBINARY\nRESTART\nQUIT");
}
elsif ($cmd =~ /^GET\s+(\S+)/i)
{
return $self->write('NOTLOGGEDIN') unless $self->{loggedin};
return $self->write('NOPERMISSION') if $self->{parent}->{TraceOnly};
# Get the value of a variable
}
elsif ($cmd =~ /^QUIT/i)
{
# Quit
$self->disconnect();
}
else
{
# Huh?
$self->write('SYNTAXERROR');
}
}
#####################################################################
sub write
{
my ($self, $s) = @_;
$self->{outbuffer} .= $s . $self->{recsep};
if (length $self->{outbuffer} > $self->{MaxBufferSize})
{
$self->{parent}->log($main::LOG_ERR, "Monitor MaxBufferSize exceeded, disconnecting");
$self->disconnect();
}
else
{
$self->write_pending();
}
}
#####################################################################
sub write_pending
{
my ($self) = @_;
# BUG ALERT what hapens if the syswrite blocks?
my $written = syswrite($self->{socket}, $self->{outbuffer},
length $self->{outbuffer});
if (!defined $written)
{
$self->{parent}->log($main::LOG_ERR, "Monitor write error, disconnecting: $!");
$self->disconnect();
}
else
{
# Remove the bytes that have been written already
substr($self->{outbuffer}, 0, $written, '');
# Anything left? it was a partial write, need to
# get control when the socket is writeable again
if (length $self->{outbuffer})
{
&Radius::Select::add_file
(fileno($self->{socket}), undef, 1, undef,
\&handle_connection_socket_write, $self);
}
}
}
#####################################################################
# Called when a message is to be logged
# See if our trace level is high enough and send the message
# to the client
# $s is the message string
# $p is the current packet if any
sub log
{
my ($self, $priority, $s, $p) = @_;
if ($self->willLog($priority, $p))
{
my $ctime = localtime(time);
$self->write("LOG $ctime: $Radius::Log::priorityToString[$priority]: $s");
}
}
#####################################################################
sub configKeywords
{
return;
}
#####################################################################
# Return true if a message should be logged by this logger
# at the given log level (and matching an optional tracing username,
# or if the packet has PacketTrace set
sub willLog
{
my ($self, $priority, $p) = @_;
return ( $priority <= $self->{Trace}
&& ( $self->{trace_username} eq ''
|| ($p && ($p->getUserName() eq $self->{trace_username}))));
}
#####################################################################
# Dummy function to intercept attempts to change the trace level
# due to SUGUSR1 etc.
# Does nothing
sub adjustTrace
{
}
#####################################################################
sub disconnect
{
my ($self) = @_;
# Deleting any references to this MonitorConnection will
# cause it to be destroyed
&Radius::Select::remove_file
(fileno($self->{socket}), 1, 1, 1);
&Radius::LogGeneric::remove_logger($self);
$self->{parent}->log($main::LOG_DEBUG, "MonitorConnection disconnected from $self->{peeraddr}:$self->{peerport}");
}
#####################################################################
# Check the username and password are correct, if so
# permit further actions
sub authenticate
{
my ($self) = @_;
$self->{loggedin} = undef;
# Force disconnection if it looks like password attack
$self->disconnect() if $self->{badauths}++ > 5;
# First check the authenticators in the AuthBy list
# Try all the authenticators in sequence until the AuthByPolicy
# is satisfied
# CAUTION: The handler might fork
my ($handler, $reason, $p, $handled);
foreach $handler (@{$self->{parent}{AuthBy}})
{
if (!$p)
{
# Fake up a radius packet we can pass to the AuthBys
$p = new Radius::Radius $main::dictionary;
$p->{rp} = new Radius::Radius $main::dictionary;
$p->addAttrByNum($Radius::Radius::USER_NAME, $self->{username});
$p->set_code('Access-Request');
if ($self->{password} =~ /^{chap}(.*)/i)
{
return unless $self->{lastchallenge};
$p->addAttrByNum($Radius::Radius::CHAP_PASSWORD,
pack('H*', $1));
$p->addAttrByNum($Radius::Radius::CHAP_CHALLENGE,
$self->{lastchallenge});
}
else
{
# Plaintext password, fake the decoded password
$p->{DecodedPassword} = $self->{password};
}
}
# Make sure the authby is updated with stats
push(@{$p->{StatsTrail}}, \%{$handler->{Statistics}});
($handled, $reason) = $handler->handle_request($p);
my $stop = 0;
# Is there a better way to express this?
if ($self->{parent}{AuthByPolicy} eq 'ContinueWhileIgnore')
{
$stop = ($handled != $main::IGNORE);
}
elsif ($self->{parent}{AuthByPolicy} eq 'ContinueUntilIgnore')
{
$stop = ($handled == $main::IGNORE);
}
elsif ($self->{parent}{AuthByPolicy} eq 'ContinueWhileAccept')
{
$stop = ($handled != $main::ACCEPT);
}
elsif ($self->{parent}{AuthByPolicy} eq 'ContinueUntilAccept')
{
$stop = ($handled == $main::ACCEPT);
}
elsif ($self->{parent}{AuthByPolicy} eq 'ContinueWhileReject')
{
$stop = ($handled != $main::REJECT
&& $handled != $main::REJECT_IMMEDIATE);
}
elsif ($self->{parent}{AuthByPolicy} eq 'ContinueUntilReject')
{
$stop = ($handled == $main::REJECT
|| $handled == $main::REJECT_IMMEDIATE);
}
last if $stop;
}
if (defined $handled)
{
$self->{loggedin}++ if $handled == $main::ACCEPT;
return $self->{loggedin} if $handled != $main::IGNORE;
}
# Did not pass any of the AuthBy, try the hardwired Username
# as a last resort
return unless $self->{parent}{Username} ne ''
&& $self->{username} eq $self->{parent}{Username};
if ($self->{password} =~ /^{chap}(.*)/i)
{
return unless $self->{lastchallenge};
# Chap password. First octet of the response is the CHAP identifier.
# Rest of response is MD5(chap id + password + challenge)
# However, must have issued a challenge already
my $response = pack('H*', $1);
$self->{loggedin}++
if $self->{lastchallenge} ne '' &&
Digest::MD5::md5(substr($response, 0, 1) . $self->{parent}{Password} . $self->{lastchallenge})
eq substr($response, 1);
}
else
{
# Plaintext password
$self->{loggedin}++
if $self->{password} eq $self->{parent}{Password};
}
return $self->{loggedin};
}
#####################################################################
# Find and return a Radiator internal object, given its name
# Names start with . which means the root object of the
# Radiator object tree (ie The ServerConfig at $main::config)
# Path elements are . separated. Each path element is either the
# name of an attribtue, or an integer index into an object array
# eg .Client.0.AuthBy.2
# is the third AuthBy object in the first Client in ServerConfig
sub findObject
{
my ($path) = @_;
my @path = split(/\./, $path);
my $o = $main::config; # base of the search
foreach (@path)
{
my $pathel = $_;
next if $pathel eq '';
my $type = ref($o);
if ($type =~ /^Radius::/)
{
# Its a Radiator object
# Next element of the path should be the name of an attribute
$o = $o->{$pathel};
}
elsif ($type eq 'ARRAY')
{
# Its an array ref, presumably of object addresses
$o = $$o[$pathel];
}
else
{
# huh?
return ;
}
}
return $o;
}
1;
More information about the radar
mailing list