[RADIATOR] TACACS Authorisation sessions across reloads in 4.9

Jason Griffith jason at rjay45.co.uk
Wed May 30 13:44:46 CDT 2012


Hello,

I've recently been toying with Radiator 4.9 as we are planning on upgrading
from 4.5 and have come across this TACACS+ session issue where command
authorisations fail after Radiator is reloaded even when the session is
saved to the temporary TACACS sessions file. I could not get this to
function correctly with standard configuration listed in the manual.

As I can't compromise on the frequency of Radiator reloads due to our
integration with other upstream systems, I instead modified the
Radius/ServerTACACSPLUS.pm file (see attached). I've done a couple of
things here - move the check for a valid context to after the point where
the temporary file is read; and also added a timestamp to the session file
so that any sessions older than 24 hours will not authorise.
My initial testing of this is positive and I have not come across anything
unexpected.

My question to the group is - are there any side effects to this of which I
may not be aware of or any other features that I'm not using right now that
may be broken? Being only familiar with the features we use and our other
customisations I thought it best to throw this out there.

Thanks for any feed back.

Jason Griffith
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://www.open.com.au/pipermail/radiator/attachments/20120530/a648f736/attachment-0001.html 
-------------- next part --------------
# ServerTACACSPLUS.pm
#
# Object for receiving TACACS+ requests and satisfying them
# Incoming TACACS+ authentication requests are converted into 
# Radius requests. ASCII, PAP, CHAP and MSCHAP are supported.
# Incoming TACACS+ authorization requests are always approved,
# and any cisco-avpair reply items from the previous Radius Access-Accept are 
# used as authorization attribute-value pairs
# Incoming TACACS+ accounting requests are converted into Radius
# accounting requests.
#
# Based on draft-grant-tacacs-02.txt 
#
# Author: Mike McCauley (mikem at open.com.au)
# Copyright (C) 2003 Open System Consultants
# $Id: ServerTACACSPLUS.pm,v 1.128 2012/04/19 23:22:15 mikem Exp $

package Radius::ServerTACACSPLUS;
@ISA = qw(Radius::Configurable);
use Radius::Client;
use Radius::Configurable;
use Radius::Context;
use Radius::Tacacsplus;
use Digest::MD5;
use Socket;
use strict;

# Map between Tacacs+ service types and Radius Service-Type
%Radius::ServerTACACSPLUS::service_to_service_type =
    (
     $Radius::Tacacsplus::TAC_PLUS_AUTHEN_SVC_LOGIN => 'Login-User',
     $Radius::Tacacsplus::TAC_PLUS_AUTHEN_SVC_ENABLE => 'Administrative-User',
     $Radius::Tacacsplus::TAC_PLUS_AUTHEN_SVC_PPP => 'Framed-User',
     );

#####################################################################
# This hash describes all the standards types of keywords understood by this
# class. If a keyword is not present in ConfigKeywords for this
# class, or any of its superclasses, Configurable will call sub keyword
# to parse the keyword
# See Configurable.pm for the list of permitted keywordtype
%Radius::ServerTACACSPLUS::ConfigKeywords = 
(
 'Port'                 => 
 ['string', 'This optional parameter specifies which TCP port the server will listen on for incoming Tacacs+ connections. Defaults to 49 (which generally requires root or other privileged access) Any valid port number or service name can be used.', 1],

 'BindAddress'          => 
 ['string', 'This optional parameter specifies one or more network interface addresses to listen for incoming Tacacs+ connections on. It is only useful if you are running Radiator on a multi-homed host (i.e. a host that has more than one network address). Defaults to the global BindAddress, which defaults to 0.0.0.0 (i.e. listens on all networks connected to the host).', 1],

 'MaxBufferSize'               => 
 ['integer', 
  'Maximum input buffer size', 
  2],

 'Key'                  => 
 ['string', 'This parameter specifies the default shared secret to be used to decrypt Tacacs+ messages. When a new connection from a Tacacs+ client is received, Server TACACSPLUS tries to find a Key to use for decrypting that connection. It looks in the following places for a Key until it finds one that has been defined:
<ul>
<li>The TACACSPLUSKey parameter of a matching Client clause
<li>This Key parameter.
<li>The Secret parameter of a matching Client clause.</li>', 0],

 'AuthorizationAdd'     => 
 ['stringarray', 'This optional parameter specifies Tacacs+ authorization attribute-value pairs that are to be added to those suggested by the Tacacs+ client. It effectively increases the default authorization that the client would use.', 1],

 'AuthorizationReplace' => 
 ['stringarray', 'This optional parameter specifies Tacacs+ authorization attribute-value pairs that are to replace those suggested by the Tacacs+ client. It effectively overrides the default authorization that the client would use.', 1],

 'AuthorizationTimeout' => 
 ['integer', 'This optional parameter changes the timeout period for handling a complete TACACS+ conversation, including the authentication any subsequent authorization requests. Defaults to 600 seconds. If the timeout expires, further authorizations for an earlier authentication will not be valid, and will be rejected.', 1],

 'AddToRequest'         => 
 ['string', 'This optional parameter adds any number of RADIUS attributes to the RADIUS requests generated by ServerTACACSPLUS. It can be used to tag requests arriving from Tacacs+ for special handling within Radiator or in remote RADIUS servers.', 1],

 'CommandAuth'	    => 
 ['stringarray', 'Deprecated, see AuthorizeGroup', 3],

 'GroupMemberAttr'	    => 
 ['string', 'When AuthorizeGroup is use to specify TACACS+ user privileges, GroupMemberAttr specifies the name of the RADIUS reply attribute in the Access-Accept that is expected to contain the name of the TACACS+ users privilege group. This group name will then be used by AuthorizeGroup to determine which privileges can be extended to that user. If there is no such attribute in the Access-Accept, the TACACS+ group name for the user will be assumed to be "DEFAULT". If GroupMemberAttr is not defined in the configuration file, then all TACACS+ users will be assumed to have a TACACS+ group name of "DEFAULT".', 1],

 'GroupAuthAttr'	    => 
 ['stringarray', 'Deprecated, see AuthorizeGroup', 1],

 'GroupCacheFile'	    => 
 ['string', 'ServerTACACSPLUS can maintain a cache of username->tacacacs_group_name for use if Radiator is restarted between Tacacs authorization and authentication. Defaults to /tmp/radiator-tacacs-usergroup.cache.', 1],

 'DefaultRealm'         => 
 ['string', 'DefaultRealm
This optional parameter can be used to specify a default realm to use for received TACACS requests that have a username that does not include a realm. If the incoming user name does not have a realm (i.e. there is no @something following the user name) and if DefaultRealm is specified, the User-Name in the resulting RADIUS request will have @defaultrealm appended to it. The realm can then be used to trigger a specific <Realm> or <Handler> clause. This is useful if you operate a number of TACACS clients for different customer groups and where some or all of your customers log in without specifying a realm. Can be overridden on a per-client basis by setting DefaultRealm in the Client clause', 1],

 'AuthorizeGroup'       => 
 ['stringarray', 'Some TACACS+ clients can request per-command authorization of commands from the TACACS+ server. When this occurs, one or more AuthorizeGroup parameters can be used to specify privilege levels, permitted TACACS commands and TACACS restrictions for various TACACS+ privilege groups. If no AuthorizeGroup parameters are specified in the Radiator configuration file then all TACACS+ commands will be authorized by <Server TACSCPLUS>.', 1],

 'AuthorizeGroupAttr'       => 
 ['string', 'If this parameter is specified, it specifies the name of an attribute in 
Access-Accept that will contain per-command authorization patterns for authorising TACACS+ commands.', 1],

 'PreHandlerHook'             => 
 ['hook', 'This optional parameter allows you to define a Perl function that will be called during packet processing. PreHandlerHook is called for each request received by this ServerTACACSPLUS before it is passed to a Realm or Handler clause. A reference to the current request is passed as the only argument.', 1],

 'UsernamePrompt'       => 
 ['string', 'This optional parameter sets the prompt that ServerTACSPLUS will use to prompt the client for a user name when the Tacacs authen-type of ASCII is used. Defaults to "Username: ".', 1],

 'PasswordPrompt'       => 
 ['string', 'This optional parameter sets the prompt that ServerTACSPLUS will use to prompt the client for a password when the Tacacs authen-type of ASCII is used. Defaults to "Password: ".', 1],

 'AuthenticationStartHook'   => 
 ['hook', 'Perl hook run when a TACACS+ Authentication start is received.', 1],

 'AuthenticationContinueHook'=> 
 ['hook', 'Perl hook run when a TACACS+ Authentication continue is received.', 1],

 'IdleTimeout' => 
 ['integer', 'If a TACACS+ client stays connected for more than this number of seconds without sending any requests it will be disconnected. A value of 0 means no timeout.', 1],

 'SingleSession' => 
 ['flag', 'Tells the server to try to maintain a single session for all TACACS+ request from the same client', 1],

 'PacketTrace'                 => 
 ['flag', 
  'Forces all packets that pass through this module to be logged at trace level 4. This is useful for logging packets that pass through this clause in more detail than other clauses during testing or debugging. The packet tracing  will stay in effect until it passes through another clause with PacketTrace set to off or 0.', 
  1],
 );

# RCS version number of this module
$Radius::ServerTACACSPLUS::VERSION = '$Revision: 1.128 $';

#####################################################################
sub activate
{
    my ($self) = @_;

    $self->SUPER::activate();

    # Remove any old state
    foreach (@{$self->{sockets}})
    {
	&Radius::Select::remove_file(fileno($_), 1);
    }
    delete $self->{sockets};

    # Create a TCP socket to listen on each BindAddress, register it with select
    # Set up the TCP listener
    my $proto = getprotobyname('tcp');
    my $port = Radius::Util::get_port($self->{Port});
    foreach (split(/\s*,\s*/, &Radius::Util::format_special($self->{BindAddress})))
    {
	$self->log($main::LOG_DEBUG, "Creating TACACSPLUS port $_:$port");
	my $s = do { local *FH };
	my $bind_address = &Radius::Util::format_special($_);
	my ($paddr, $pfamily) = &Radius::Util::pack_sockaddr_pton($port, $bind_address);
	socket($s, $pfamily, Socket::SOCK_STREAM, $proto)
	    || $self->log($main::LOG_ERR,  "Could not create Server TACACSPLUS socket: $!");
	$main::forkclosesfdexceptions{fileno($s)}++;
	binmode($s); # Make safe in UTF environments
	setsockopt($s, Socket::SOL_SOCKET, Socket::SO_REUSEADDR, 1);
	bind($s, $paddr)
	    || $self->log($main::LOG_ERR,  "Could not bind Server TACACSPLUS socket: $!");
	listen($s, Socket::SOMAXCONN)
	    || $self->log($main::LOG_ERR,  "Could not listen on Server TACACSPLUS socket: $!");
	&Radius::Select::add_file
	    (fileno($s), 1, undef, undef, 
	     \&handle_listen_socket_read, $s, $self);
	push(@{$self->{sockets}}, $s);
    }
    # Parse and remeber the AuthorizeGroup parameters, format is
    # AuthorizeGroup <groupname> <permit|permitreplace|deny> pattern1 pattern2 ... {replyattr1=val replyatttr2=val ...}
    # The rules are stored in an array in $self->{authorizegroup}->{<groupname>}
    foreach (@{$self->{AuthorizeGroup}})
    {
	if (/^(\S*)\s+(.*)/)
	{
	    my ($groupname, $pattern) = ($1, $2);
	    my ($permission, $match, $reply) = $self->parseAuthorizeGroup($pattern);
	    # each rule is stored as [result, [pattern, pattern, ...], [reply, reply, ...]]
	    push(@{$self->{authorizegroup}->{$groupname}}, [$permission, $match, $reply])
		if defined $permission;
	}
	else
	{
	    $self->log($main::LOG_ERR,  "Invalid syntax in AuthorizeGroup parameter: $_");
	}
    }
}


#####################################################################
# 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} = $Radius::Tacacsplus::TAC_PLUS_PORT;
    $self->{MaxBufferSize} = 100000;
    $self->{BindAddress} = $main::config->{BindAddress} || '0.0.0.0';
    $self->{AuthorizationTimeout} = 600; # seconds
    $self->{IdleTimeout} = 180; # Seconds
    $self->{GroupCacheFile} = '/tmp/radiator-tacacs-usergroup.cache';
    $self->{UsernamePrompt} = 'Username: ';
    $self->{PasswordPrompt} = 'Password: ';
    $self->{SingleSession} = 1;
}

#####################################################################
# 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 Tacacs listen socket: $!");
	return;
    }

    Radius::TacacsplusConnection->new
	($self, $newsocket,
	 MaxBufferSize             => $self->{MaxBufferSize},
	 AuthorizationTimeout      => $self->{AuthorizationTimeout},
	 IdleTimeout               => $self->{IdleTimeout},
	 AddToRequest              => $self->{AddToRequest},
	 GroupCacheFile            => $self->{GroupCacheFile},
	 UsernamePrompt            => $self->{UsernamePrompt},
	 PasswordPrompt            => $self->{PasswordPrompt},
	 AuthenticationStartHook   => $self->{AuthenticationStartHook},
	 AuthenticationContinueHook=> $self->{AuthenticationContinueHook},
	 SingleSession             => $self->{SingleSession},
	 );
}

#####################################################################
# Parse an AuthoriseGroup pattern, returning ($permission, $match, $reply)
# Input string is in the form:
# <permit|permitreplace|deny> pattern1 pattern2 ... {replyattr1=val replyattr2=val ...}
# $permission is the permission name
sub parseAuthorizeGroup
{
    my ($self, $s) = @_;

    if ($s =~ /(permit|permitreplace|deny)\s+([^{]*)?(\s*\{(.*)\})?/)
    {
	my $permission = $1;
	my $match = $2;
	my $reply = $4;
	my @match = split(/\s+/, $match);
	my @reply;
	# Splitting the reply is more complicated since there may be 
	# quotes around spaces
	# We now support cisco optional reply attributes
	# in this kind of format, contributed by Kristian Larsson:
	# AuthorizeGroup xr-friendly permit service=shell cmd\* {task*#root-system,#cisco-support priv-lvl=15}
	while ($reply ne '')
	{
	    if ($reply =~ /^((\S+?[=\*])\"([^"]*)\") */g)
	    {
		push(@reply, "$2$3");
		$reply = substr($reply, pos $reply);
	    }
	    elsif ($reply =~ /^(\S+?[=\*]\S+) */g)
	    {
		push(@reply, $1);
		$reply = substr($reply, pos $reply);
	    }
	    else
	    {
		$self->log($main::LOG_ERR,  "Invalid reply item '$reply' in AuthorizeGroup rule: $s");
		last;
	    }
	}
	return ($permission, [@match], [@reply]);
    }
    else
    {
	$self->log($main::LOG_ERR,  "Invalid syntax in AuthorizeGroup pattern: $s");
	return;
    }
}

#####################################################################
#####################################################################
#####################################################################
package Radius::TacacsplusConnection;

#####################################################################
sub new
{
    my ($class, $parent, $socket, %args) = @_;

    my $self = {%args};
    bless $self, $class;  


    $self->{parent} = $parent;
    $self->{socket} = $socket;

    $self->{peer} = getpeername($self->{socket});
    if (!$self->{peer})
    {
	$parent->log($main::LOG_ERR,  "Could not get peer name on TacacsplusConnection socket: $!");
	$self->disconnect();
	return;
    }
    my ($port, $peeraddr) = Radius::Util::unpack_sockaddr_in($self->{peer});
    $self->{peerport} = $port;
    $self->{peeraddr} = Radius::Util::inet_ntop($peeraddr);

    $self->{inbuffer} = undef;
    $self->{outbuffer} = undef;
    
    $self->{Trace} = 0; # Default trace level

    $parent->log($main::LOG_DEBUG,  "New TacacsplusConnection created for $self->{peeraddr}:$self->{peerport}");

    # Try to find a key to decrypt the payload (per-client, falling back to server global)
    my $client = &Radius::Client::findAddress($peeraddr);
    $client = &Radius::Client::findAddress(Radius::Util::inet_pton($self->{peeraddr})) 
	unless $client;

    $parent->log($main::LOG_WARNING, "Could not find a Client for $self->{peeraddr}:$self->{peerport}. Falling back to default Key")
	unless defined $client;

    $self->{Key} = $client->{TACACSPLUSKey}
        if $client && !defined $self->{Key};
    $self->{Key} = $parent->{Key}
        unless defined $self->{Key};
    $self->{Key} = $client->{Secret}
        if $client && !defined $self->{Key};

    $parent->log($main::LOG_WARNING, "Could not find a per-Client or global TACACS+ Key for $self->{peeraddr}:$self->{peerport}")
	unless defined $self->{Key};

    &Radius::Select::add_file
	(fileno($self->{socket}), 1, undef, undef, 
	 \&handle_connection_socket_read, $self);

    $self->{idleTimeoutHandle} = &Radius::Select::add_timeout(time + $self->{IdleTimeout}, \&idle_timeout, $self)
	if $self->{IdleTimeout};

}

#####################################################################
# Clients has been idle for too long
# Disconnect them
sub idle_timeout
{
    my ($handle, $self) = @_;

    $self->{parent}->log($main::LOG_WARNING, "TacacsplusConnection client $self->{peeraddr} was idle for more than $self->{IdleTimeout} seconds. Disconnected.");
    $self->{idleTimeoutHandle} = undef;
    $self->disconnect();
}

#####################################################################
# 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}))
    {
	# Reset the idle timer
	if ($self->{idleTimeoutHandle})
	{
	    &Radius::Select::remove_timeout($self->{idleTimeoutHandle});
	    $self->{idleTimeoutHandle} = &Radius::Select::add_timeout(time + $self->{IdleTimeout}, \&idle_timeout, $self)
	}

	while (length $self->{inbuffer} >= 12)
	{
	    # Have the header at least
	    my ($version, $type, $seq_no, $tflags, $session_id, $length) 
		= unpack('CCCCNN', $self->{inbuffer});
	    #my $x = unpack('H*', $self->{inbuffer});
	    #print "Tacacs got: $x\n";
	    # Make some trivial checks on the request
	    if (   $version != $Radius::Tacacsplus::TAC_PLUS_VERSION_DEFAULT 
		&& $version != $Radius::Tacacsplus::TAC_PLUS_VERSION_ONE)
	    {
		# REVISIT: should send an ERROR message
		$self->{parent}->log($main::LOG_ERR, "TacacsplusConnection received a request for unsupported version $version from $self->{peeraddr}. Disconnecting");
		
		$self->disconnect();
	    }
	    if ($length > $self->{MaxBufferSize})
	    {
		$self->{parent}->log($main::LOG_ERR, "TacacsplusConnection received a request with excessive length $length from $self->{peeraddr}. Disconnecting");
		$self->disconnect();
	    }
	    # Have at least one complete message yet?
	    last unless length($self->{inbuffer}) >= $length+12;

	    # Have the entire request
	    # Get, clear and handle this request
	    my $request = substr($self->{inbuffer}, 0, $length+12, undef);
	    $main::statistics{total_packets}++;
	    $main::statistics{packets_this_sec}++;
	    $self->request($request);
	}
    }
    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 request has been received
# Parse and process it
# Version has been checked
sub request
{
    my ($self, $request) = @_;

    my ($version, $type, $seq_no, $tflags, $session_id, $length, $body) 
	= unpack('CCCCNNa*', $request);

    $self->{parent}->log($main::LOG_DEBUG, "TacacsplusConnection request $version, $type, $seq_no, $tflags, $session_id, $length");
    $self->{parent}->log($main::LOG_EXTRA_DEBUG, "TacacsPlus request packet dump: " . unpack('H*', $request));

    # Need these during the reply phase
    $self->{version} = $version;
    $self->{tflags} = $tflags;
    $self->{last_seq_no} = $seq_no;
    $self->{session_id} = $session_id;
    $self->{state} = undef if ($seq_no == 1);

    # Maybe decrypt the payload
    if( defined($self->{Key}) ) {
        $self->{parent}->log($main::LOG_EXTRA_DEBUG, "Decrypting TacacsPlus request");
        $body = &Radius::Tacacsplus::crypt($session_id, $self->{Key}, $version, $seq_no, $body);
        $self->{parent}->log($main::LOG_EXTRA_DEBUG, "TacacsPlus request decrypted body: " . unpack('H*', $body));
    }
    else {
        $self->{parent}->log($main::LOG_EXTRA_DEBUG, "TacacsPlus request body: " . unpack('H*', $body));
    }

    if ($type == $Radius::Tacacsplus::TAC_PLUS_AUTHEN && $seq_no == 1)
    {
	$self->authentication_start($body);
    }
    elsif ($type == $Radius::Tacacsplus::TAC_PLUS_AUTHEN)
    {
	$self->authentication_continue($body);
    }
    elsif ($type == $Radius::Tacacsplus::TAC_PLUS_AUTHOR)
    {
	$self->authorization_request($body);
    }
    elsif ($type == $Radius::Tacacsplus::TAC_PLUS_ACCT)
    {
	$self->accounting_request($body);
    }
    # REVISIT: reset, error, etc
    else
    {
	$self->{parent}->log($main::LOG_WARNING, "TacacsplusConnection cant handle request type $type from $self->{peeraddr}");
    }
}

#####################################################################
# Handle a TACACS+ authentication START request
sub authentication_start
{
    my ($self, $body) = @_;

    $self->{user} = undef;
    $self->{password} = undef;

    my ($action, $priv_lvl, $authen_type, $service, 
	$user_len, $port_len, $rem_addr_len, $data_len, 
	$fields) = unpack('CCCCCCCCa*', $body);
    if ($user_len + $port_len + $rem_addr_len + $data_len > length($fields))
    {
	$self->{parent}->log($main::LOG_ERR, "Inconsistent lengths in Tacacs Authentication request from $self->{peeraddr}:$self->{peerport}. Bad Key?");
	$self->authentication_reply($Radius::Tacacsplus::TAC_PLUS_AUTHEN_STATUS_ERROR, 0, 'Inconsistent lengths');
	$self->disconnect();
	return;
    }
    # Decode the variable length fields
    my $i = 0;
    my $user     = substr($fields, $i, $user_len);     $i += $user_len;
    my $port     = substr($fields, $i, $port_len);     $i += $port_len;
    my $rem_addr = substr($fields, $i, $rem_addr_len); $i += $rem_addr_len;
    my $data     = substr($fields, $i, $data_len);     $i += $data_len;

    $self->{parent}->log($main::LOG_DEBUG, "TacacsplusConnection Authentication START $action, $authen_type, $service for $user, $port, $rem_addr");

    $self->{user} = $user;
    $self->{port} = $port;
    $self->{service} = $service;
    $self->{rem_addr} = $rem_addr;
    my $tp = $self->create_radius_request('Access-Request');
    $tp->add_attr('cisco-avpair', "action=$action");
    $tp->add_attr('cisco-avpair', "authen_type=$authen_type");
    $tp->add_attr('cisco-avpair', "priv-lvl=$priv_lvl");
    $tp->add_attr('cisco-avpair', "service=$service");

    if ($self->{parent}->runHook('AuthenticationStartHook', undef, $self, $tp, $action, $authen_type, $priv_lvl, $service))
    {
	$self->{parent}->log($main::LOG_DEBUG, "Authentication Start was handled by AuthenticationStartHook");
	return;
    }
    elsif ($action == $Radius::Tacacsplus::TAC_PLUS_AUTHEN_LOGIN
	&& $authen_type == $Radius::Tacacsplus::TAC_PLUS_AUTHEN_TYPE_ASCII)
    {
	# Start of an ASCII login
	$self->{user} = $user;

	if (!length $user)
	{
	    $self->authentication_reply($Radius::Tacacsplus::TAC_PLUS_AUTHEN_STATUS_GETUSER,
					0, $self->{UsernamePrompt});
	}
	else
	{
	    # Ask for the password
	    $self->authentication_reply($Radius::Tacacsplus::TAC_PLUS_AUTHEN_STATUS_GETPASS, $Radius::Tacacsplus::TAC_PLUS_AUTHEN_FLAG_NOECHO, $self->{PasswordPrompt});
	}
	# Save the cisco-avpairs. They are needed when this ASCII login finishes.
	@{$self->{saved_avpairs}} = $tp->get_attr('cisco-avpair');
	# We should get an authentication CONTINUE soon.
	return;
	
    }
    elsif ($action == $Radius::Tacacsplus::TAC_PLUS_AUTHEN_LOGIN
	&& $authen_type == $Radius::Tacacsplus::TAC_PLUS_AUTHEN_TYPE_PAP)
    {
	# PAP login
	$tp->add_attr('User-Name', $user);
	$tp->add_attr('User-Password', '**obscured**');
	$tp->{DecodedPassword} = $data;
    }
    elsif ($action == $Radius::Tacacsplus::TAC_PLUS_AUTHEN_LOGIN
	&& $authen_type == $Radius::Tacacsplus::TAC_PLUS_AUTHEN_TYPE_CHAP)
    {
	# CHAP Login
	my ($chapid, $challenge, $result) = unpack('Ca16a16', $data);
	$tp->add_attr('User-Name', $user);
	$tp->add_attr('CHAP-Password', pack('Ca*', $chapid, $result));
	$tp->add_attr('CHAP-Challenge', $challenge);
    }
    else
    {
	$self->{parent}->log($main::LOG_WARNING, "TacacsplusConnection unknown authentication action $action, type $authen_type from $self->{peeraddr}. Bad encryption Key?");
	$self->authentication_reply($Radius::Tacacsplus::TAC_PLUS_AUTHEN_STATUS_ERROR, 0, 'unknown authentication action');
	$self->disconnect();
	return;
    }
    if ($self->dispatch_radius_request($tp) == $main::IGNORE && !$tp->{proxied})
    {
	$self->authentication_reply($Radius::Tacacsplus::TAC_PLUS_AUTHEN_STATUS_ERROR, 0, 'Database failure');
    }
}

#####################################################################
# Create a standard fake Radius request
sub create_radius_request
{
    my ($self, $code) = @_;

    # Create a fake incoming radius request
    my $tp = Radius::Radius->new($main::dictionary);
    $tp->set_code($code);
    $tp->{RecvFrom} = $self->{peer};
    my @l = Radius::Util::unpack_sockaddr_in($self->{peer});
    $tp->{RecvFromPort} = $l[0];
    $tp->{RecvFromAddress} = $l[1];
    ($tp->{RecvTime}, $tp->{RecvTimeMicros}) = &Radius::Util::getTimeHires;
    $tp->set_authenticator(&Radius::Util::random_string(16));
    $tp->add_attr('NAS-IP-Address', $self->{peeraddr});
    $tp->add_attr('NAS-Port-Id', $self->{port}) if length $self->{port};
    $tp->add_attr('Calling-Station-Id', $self->{rem_addr}) if length $self->{rem_addr};
    $tp->add_attr('Service-Type', $Radius::ServerTACACSPLUS::service_to_service_type{$self->{service}}) 
	if defined $Radius::ServerTACACSPLUS::service_to_service_type{$self->{service}};

    # Add arbitrary data to every request
    $tp->parse(&Radius::Util::format_special($self->{AddToRequest}))
	if (defined $self->{AddToRequest});

    # Arrange to call our reply function when we get a reply
    $tp->{replyFn} = [\&Radius::TacacsplusConnection::replyFn, $self];

    return $tp;
}

#####################################################################
# Dispatch a fake Radius request to the appropriate Handler
sub dispatch_radius_request
{
    my ($self, $tp) = @_;

    # Allow clients to see the Tacacs version
    $tp->add_attr('OSC-Version-Identifier', $self->{version});

    # Make sure top level config is updated with stats
    push(@{$tp->{StatsTrail}}, \%{$main::config->{Statistics}});

    $tp->{PacketTrace} = $self->{parent}->{PacketTrace} 
        if defined $self->{parent}->{PacketTrace}; # Optional extra tracing

    # Use Client settings to manipulate Request/Reply
    my $client = &Radius::Client::findAddress($self->{peeraddr});
    $client = &Radius::Client::findAddress(Radius::Util::inet_pton($self->{peeraddr})) 
	unless $client;

    $tp->{Client} = $client; # So you can use Client-Identifier check items

    # Now arrange for this fake radius request to be handled and find out the result
    $tp->{OriginalUserName} = $tp->get_attr('User-Name');
    my ($userName, $realmName) = split(/@/, $tp->{OriginalUserName});
    # Maybe set a default realm
    if (defined $userName
	&& $realmName eq '')
    {
	if (defined $client->{'DefaultRealm'})
	{
	    $realmName = $client->{'DefaultRealm'};
	    $tp->changeUserName("$userName\@$realmName");
	}
	elsif (defined $self->{parent}->{'DefaultRealm'})
	{
	    $realmName = $self->{parent}->{'DefaultRealm'};
	    $tp->changeUserName("$userName\@$realmName");
	}
    }

    $tp->rewriteUsername($client->{RewriteUsername})
        if defined $client->{RewriteUsername};

    # Add and strip attributes before forwarding.
    map {$tp->delete_attr($_)} (split(/\s*,\s*/, $client->{StripFromRequest}))
        if defined $client->{StripFromRequest};

    $tp->parse(&Radius::Util::format_special($client->{AddToRequest}, $tp))
        if defined $client->{AddToRequest};

    $tp->parse_ifnotexist(&Radius::Util::format_special($client->{AddToRequestIfNotExist}, $tp))
        if defined $client->{AddToRequestIfNotExist};

    # Dump the fake radius request
    &main::log($main::LOG_DEBUG, "TACACSPLUS derived Radius request packet dump:\n" . $tp->dump)
	if (&main::willLog($main::LOG_DEBUG, $self->{parent}));

    my ($handler, $finder, $handled);
    # Call the PreHandlerHook of client, if there is one
    $client->runHook('PreHandlerHook', $tp, \$tp)
        if defined $client->{PreHandlerHook};
    # Call the PreHandlerHook, if there is one
    $self->{parent}->runHook('PreHandlerHook', $tp, \$tp);

    foreach $finder (@Radius::Client::handlerFindFn)
    {
	if ($handler = &$finder($tp, $userName, $realmName))
	{
	    # Make sure the handler is updated with stats
	    push(@{$tp->{StatsTrail}}, \%{$handler->{Statistics}});
	    
	    # replyFn will be called from inside the handler when the
	    # reply is available
	    $handled = $handler->handle_request($tp);
	    last;
	}
    }
    $self->{parent}->log($main::LOG_WARNING, "TacacsplusConnection could not find a Handler")
	if !$handler;

    # Adjust statistics
    my $code = $tp->code();
    $tp->statsIncrement('requests');
    $tp->statsIncrement('accessRequests') 
	if $code eq 'Access-Request';
    $tp->statsIncrement('accountingRequests') 
	if $code eq 'Accounting-Request';
    return $handled;
}

#####################################################################
# Handle a TACACS+ authentication CONTINUE request
sub authentication_continue
{
    my ($self, $body) = @_;

    my ($user_msg_len, $data_len, $aflags, $fields) = unpack('nnCa*', $body);
    # Decode the variable length fields
    my $i = 0;
    my $user_msg  = substr($fields, $i, $user_msg_len); $i += $user_msg_len;
    my $data      = substr($fields, $i, $data_len);     $i += $data_len;
    
    if ($self->{last_status} == $Radius::Tacacsplus::TAC_PLUS_AUTHEN_STATUS_GETPASS)
    {
	# Obscure password
       $self->{parent}->log($main::LOG_DEBUG, "TacacsplusConnection Authentication CONTINUE $aflags, **obscured**, $data");
    }
    else
    {
       $self->{parent}->log($main::LOG_DEBUG, "TacacsplusConnection Authentication CONTINUE $aflags, $user_msg, $data");
    }

    if ($aflags & $Radius::Tacacsplus::TAC_PLUS_CONTINUE_FLAG_ABORT)
    {
	$self->{parent}->log($main::LOG_WARN, "TacacsplusConnection Authentication CONTINUE from $self->{peeraddr} aborted: $data");
	$self->disconnect();
	return;
    }

    if ($self->{last_status} == $Radius::Tacacsplus::TAC_PLUS_AUTHEN_STATUS_GETPASS)
    {
	$self->{password} = $user_msg;
    }
    elsif ($self->{last_status} == $Radius::Tacacsplus::TAC_PLUS_AUTHEN_STATUS_GETUSER)
    {
	$self->{user} = $user_msg;
    }

    if ($self->{parent}->runHook('AuthenticationContinueHook', undef, $self, $body))
    {
	$self->{parent}->log($main::LOG_DEBUG, "Authentication Continue was handled by AuthenticationContinueHook");
    }
    elsif (   defined $self->{password}
	&& length $self->{user})
    {
	# Create and dispatch a fake radius request. When the result becomes available
	# our replyFn will be called
	my $tp = $self->create_radius_request('Access-Request');
	$tp->add_attr('User-Name', $self->{user});
	$tp->add_attr('User-Password', '**obscured**');
	$tp->{DecodedPassword} = $self->{password};

	# Add the attributes saved during authentication START
	map {$tp->add_attr('cisco-avpair', $_)} (@{$self->{saved_avpairs}}); 

	# Recover any radius State from a previous Access-Challenge
	$tp->add_attr('State', $self->{state}) if defined $self->{state};

	if ($self->dispatch_radius_request($tp) == $main::IGNORE && !$tp->{proxied})
	{
	    $self->authentication_reply($Radius::Tacacsplus::TAC_PLUS_AUTHEN_STATUS_ERROR, 0, 'Database failure');
	}
    }
    else
    {
	# Need more data
	return $self->authentication_reply($Radius::Tacacsplus::TAC_PLUS_AUTHEN_STATUS_GETUSER,
					   0,
					   $self->{UsernamePrompt})
	    unless length $self->{user};
	return $self->authentication_reply($Radius::Tacacsplus::TAC_PLUS_AUTHEN_STATUS_GETPASS,
					   $Radius::Tacacsplus::TAC_PLUS_AUTHEN_FLAG_NOECHO,
					   $self->{PasswordPrompt})
	    unless defined $self->{password};
    }
}

#####################################################################
sub authorization_request
{
    my ($self, $body) = @_;

    my ($authen_method, $priv_lvl, $authen_type, $authen_service, 
	$user_len, $port_len, $rem_addr_len, $arg_cnt, $fields) = unpack('CCCCCCCCa*', $body);
    if ($arg_cnt + $user_len + $port_len + $rem_addr_len > length($fields))
    {
	$self->{parent}->log($main::LOG_ERR, "Inconsistent lengths in Tacacs Authorization request from $self->{peeraddr}:$self->{peerport}. Bad Key?");
	$self->authorization_reply($Radius::Tacacsplus::TAC_PLUS_AUTHOR_STATUS_ERROR, 'Inconsistent lengths');
	$self->disconnect();
	return;
    }

    my $i = 0;
    # Decode the variable length fields
    my @arg_len = unpack('C*', substr($fields, $i, $arg_cnt)); $i += $arg_cnt;
    my $user     = substr($fields, $i, $user_len);                    $i += $user_len;
    my $port     = substr($fields, $i, $port_len);                    $i += $port_len;
    my $rem_addr = substr($fields, $i, $rem_addr_len);                $i += $rem_addr_len;
    # Unpack additional args
    my (@args, $j);
    for ($j = 0; $j < @arg_len; $j++)
    {
	$args[$j] = substr($fields, $i, $arg_len[$j]);     $i += $arg_len[$j];
    }
    if ($i > length($fields))
    {
	$self->{parent}->log($main::LOG_ERR, "Inconsistent lengths in Tacacs Authorization request from $self->{peeraddr}:$self->{peerport}. Bad Key?");
	$self->authorization_reply($Radius::Tacacsplus::TAC_PLUS_AUTHOR_STATUS_ERROR, 'Inconsistent length');
	$self->disconnect();
	return;
    }

    $self->{parent}->log($main::LOG_DEBUG, "TacacsplusConnection Authorization REQUEST $authen_method, $priv_lvl, $authen_type, $authen_service, $user, $port, $rem_addr, $arg_cnt, @args");


    $self->{user} = $user;
    $self->{port} = $port;
    $self->{rem_addr} = $rem_addr;

    # Recover the context and any radius reply to our earlier authentication request
    my $context = &Radius::Context::find("tacacs:$self->{user}:$self->{peeraddr}");
    my $rp = $context->{rp} if $context;

    # get group membership and any other cisco-avpair attributes
    my $group_name_attr = $self->{parent}->{GroupMemberAttr} 
        if defined $self->{parent}->{GroupMemberAttr};

    # Hmmm. funny behaviour remembering the value of @reply_pairs from call to call
    # on perl 5.8.5
    my @reply_pairs;
    @reply_pairs = $rp->get_attr('cisco-avpair') if $rp;

    # if the AuthGroupAttr is set either set the user/group pair
    # in the cache file or retrieve it if the timeout has expired.
    my $group_name = '';
    if ($rp && $group_name_attr) 
    {
	my $g = $rp->get_attr($group_name_attr);
	if (defined $g)
	{
	    $group_name = $g;
	    $self->authgroup_file("set", "$user:$self->{peeraddr}", $g);
	}
    }
    elsif ($group_name_attr) 
    { 
	my $g = $self->authgroup_file("get", "$user:$self->{peeraddr}");
	$group_name = $g if defined $g;
    }
	
	 if (!$context && $group_name eq '')
    {
	# No context, so not authorised, reject
	# Hmm, no matching rule, deny them
	$self->{parent}->log($main::LOG_INFO, "Authorization denied for $user at $self->{peeraddr}: No context found. Expired?");   
	$self->authorization_reply($Radius::Tacacsplus::TAC_PLUS_AUTHOR_STATUS_FAIL, 'Authentication expired');
	return;
    }

    # now get avpair attributes for the group and push em to @reply_pairs
    foreach (@{$self->{parent}->{GroupAuthAttr}}) 
    {
	my ($group, $avpair) = split(' ', $_);
	push(@reply_pairs, $avpair)
	    if $group_name eq $group;
    }

    if (defined $self->{parent}->{authorizegroup}
	|| defined $self->{parent}->{AuthorizeGroupAttr})
    {
	# Use the new AuthorizeGroup parameters for determining 
	# per-group command authorization
	# Hardwired AuthorizeGroup patterns can be overridden by per-user 
	# patterns in AuthorizeGroupAttr attributes
      rulematch:
	foreach (@{$context->{authorizegroup}}, @{$self->{parent}->{authorizegroup}->{$group_name}})
	{
	    my $result   = $_->[0];
	    my @patterns = @{$_->[1]};
	    my @reply    = @{$_->[2]};

	    my $i;
	    for ($i = 0; $i < scalar @patterns; $i++)
	    {
		next rulematch unless $args[$i] =~ /^$patterns[$i]$/;
	    }
	    
            # filter reply for optional attributes
	    # Contributed by Aki Tuomi
	    # Test requests using optional attributes can be generated like:
	    # perl goodies/tacacsplustest -noacct -user jim -password jim -author_args 'service=shell,cmd=,shell:LBAGG0010200PR*' 
	    # and a rule like:
	    # OSC-Authorize-Group="permit service=shell cmd= {shell:Admin*Admin shell:LBAGG0010200PR*Admin shell:LBAGG0010300PR*Admin shell:LBAGG0010500TS*Admin shell:LBAGG0010600TS*Admin}",
            my @new_reply;
	    
            for my $r_token (@reply) 
	    {
                if ($r_token=~/=/) 
		{
                   push @new_reply, $r_token;
                   next;
                }
                my ($r_name,$r_attr) = split /[*]/,$r_token;
		for my $q_token (@args) 
		{
                    push @new_reply, $r_token if ($q_token eq "$r_name*");
                }
            }
            @reply = @new_reply;

	    # OK, this rule must be the first one to completely match, so honour it
	    $self->{parent}->log($main::LOG_DEBUG, "AuthorizeGroup rule match found: $result @patterns { @reply }");    
	    if ($result eq 'deny')
	    {
		$self->{parent}->log($main::LOG_INFO, "Authorization denied for $user at $self->{peeraddr}, group $group_name, args @args");   
		$self->authorization_reply($Radius::Tacacsplus::TAC_PLUS_AUTHOR_STATUS_FAIL, 'denied');
		return;
	    }
	    elsif ($result eq 'permit')
	    {
		# This tells the tacacs client that its ok to run the command,
		# and the @reply will be appended to the users command.
		$self->{parent}->log($main::LOG_INFO, "Authorization permitted for $user at $self->{peeraddr}, group $group_name, args @args");    
		$self->authorization_reply($Radius::Tacacsplus::TAC_PLUS_AUTHOR_STATUS_PASS_ADD, 
					   undef, undef,
					   @reply,
					   @{$self->{parent}->{AuthorizationAdd}},
					   @reply_pairs);

		return;
	    }
	    elsif ($result eq 'permitreplace')
	    {
		# This tells the tacacs client that its ok to run the command,
		# but use the @reply to replace the users input commands
		$self->{parent}->log($main::LOG_INFO, "Authorization permitted with replacement for $user at $self->{peeraddr}, group $group_name, args @args");    
		$self->authorization_reply($Radius::Tacacsplus::TAC_PLUS_AUTHOR_STATUS_PASS_REPL, 
					   undef, undef, 
					   @reply,
					   @{$self->{parent}->{AuthorizationAdd}},
					   @reply_pairs);
		return;
	    }
	}
	# Hmm, no matching rule, deny them
	$self->{parent}->log($main::LOG_INFO, "Authorization denied for $user, group $group_name. No matching AuthorizeGroup rule for args @args");   
	$self->authorization_reply($Radius::Tacacsplus::TAC_PLUS_AUTHOR_STATUS_FAIL, 'denied');
	return;
    }
    else
    {
	# Use the old and deprecated CommandAuth parameters for determining 
	# per-group command authorization

	# Routers want different kinds of responses for command authorization,
	# just a pass or fail with NO extra attributes sent with the response.
	# 
	# Cisco is nice and just sets the authen_method to NONE instead of 
	# TACPLUS, but the Juniper E-series sends it as TACPLUS.  Only other 
	# way to identify is that both send command authorization requests 
	# with a 'cmd=' value and a 'cmg-arg=' value (even if the command 
	# entered has simply <cr> as an argument.) 
	#
	# The draft mentions nothing about using NONE for command auth, so we'll
	# proceed with the cmd/cmg-arg pair to identify it.
	#
	# - Paul Schultz 10/07/03 
	my $cmd_auth = 1 if $args[1] =~ /^cmd\=/ && $args[2] =~ /^cmd-arg\=/;
	my ($cmd_auth_response, $cmd_auth_reason) = command_authorization($self, $user, $group_name, @args) 
	    if $cmd_auth == 1 && defined $self->{parent}->{CommandAuth};
	
	if ( $cmd_auth_response == 1 ) 
	{
	    $self->authorization_reply($Radius::Tacacsplus::TAC_PLUS_AUTHOR_STATUS_PASS_ADD);
	}
	elsif ( $cmd_auth_response == 2 ) 
	{
	    $self->authorization_reply($Radius::Tacacsplus::TAC_PLUS_AUTHOR_STATUS_FAIL, $cmd_auth_reason);
	    $self->{parent}->log($main::LOG_INFO, "Authorization rejected for $user at $self->{peeraddr}: $cmd_auth_reason");    
	}
	elsif (defined $self->{parent}->{AuthorizationReplace})
	{
	    $self->authorization_reply($Radius::Tacacsplus::TAC_PLUS_AUTHOR_STATUS_PASS_REPL, 
				       undef, undef, 
				       @{$self->{parent}->{AuthorizationReplace}},
				       @{$self->{parent}->{AuthorizationAdd}},
				       @reply_pairs);
	}
	else
	{
	    $self->authorization_reply($Radius::Tacacsplus::TAC_PLUS_AUTHOR_STATUS_PASS_ADD, 
				       undef, undef, 
				       @{$self->{parent}->{AuthorizationAdd}},
				       @reply_pairs);
	}
    }
}

#####################################################################
# authorizes per-command for cisco and other capable routers 
sub command_authorization 
{

    my ($self, $user, $auth_group, @auth_args) = @_;

    my ($cmd_auth_response, $cmd_auth_reason);
    my $auth_service = shift(@auth_args);
    my $auth_cmd = shift(@auth_args);

    # just does a basic top-down search of CommandAuth attributes
    # to try to find a match.. first match wins.
    command_match: foreach my $command ( @{$self->{parent}->{CommandAuth}}  ) 
    {
	my ($group,$action,$command,$response) = split(' ', $command, 4);
	my @commands = split(':', $command);
	my $command_value = "cmd=" . shift(@commands);

	# match command by regex 
	if ( $group eq $auth_group && $auth_cmd =~ /^$command_value$/ ) {

	    # now check command arguments if command matches
	    for ( my $i = 0; $i <= length(@commands) && $commands[$i] ne ""; $i++ ) {

		my $current_arg = "cmd-arg=" . $commands[$i];
		next command_match if not $auth_args[$i] =~ /^$current_arg$/;

	    }

	    if ( $action eq "permit" ) {
		$cmd_auth_response = 1;
	    }
	    else { 
		$cmd_auth_response = 2; 
		$cmd_auth_reason = $response;
	    }
	    last;
	}
    }
    return ($cmd_auth_response, $cmd_auth_reason);
}



#####################################################################
sub accounting_request
{
    my ($self, $body) = @_;

    my ($aflags, $authen_method, $priv_lvl, $authen_type, $authen_service, 
	$user_len, $port_len, $rem_addr_len, $arg_cnt, $fields) = unpack('CCCCCCCCCa*', $body);
    if ($arg_cnt + $user_len + $port_len + $rem_addr_len > length($fields))
    {
	$self->{parent}->log($main::LOG_ERR, "Inconsistent lengths in Tacacs Accounting request from $self->{peeraddr}:$self->{peerport}. Bad Key?");
	$self->accounting_reply($Radius::Tacacsplus::TAC_PLUS_ACCT_STATUS_ERROR, 'Inconsistent lengths');
	$self->disconnect();
	return;
    }

    my $i = 0;
    # Decode the variable length fields
    my @arg_len = unpack('C*', substr($fields, $i, $arg_cnt)); $i += $arg_cnt;
    my $user     = substr($fields, $i, $user_len);             $i += $user_len;
    my $port     = substr($fields, $i, $port_len);             $i += $port_len;
    my $rem_addr = substr($fields, $i, $rem_addr_len);         $i += $rem_addr_len;
    # Unpack additional args
    my (@args, $j);
    for ($j = 0; $j < @arg_len; $j++)
    {
	$args[$j] = substr($fields, $i, $arg_len[$j]); $i += $arg_len[$j];
    }
    # Sanity check for incorrect keys
    if ($i > length($fields))
    {
	$self->{parent}->log($main::LOG_ERR, "Inconsistent lengths in Tacacs Accounting request from $self->{peeraddr}:$self->{peerport}. Bad Key?");
	$self->accounting_reply($Radius::Tacacsplus::TAC_PLUS_ACCT_STATUS_ERROR, 'Inconsistent length');
	$self->disconnect();
	return;
    }
    $self->{parent}->log($main::LOG_DEBUG, "TacacsplusConnection Accounting REQUEST $aflags, $authen_method, $priv_lvl, $authen_type, $authen_service, $user, $port, $rem_addr, $arg_cnt, @args");

    $self->{user} = $user;
    $self->{port} = $port;
    $self->{rem_addr} = $rem_addr;

    my $tp = $self->create_radius_request('Accounting-Request');
    $tp->add_attr('User-Name', $user);

    # Add Acct-Status-Type
    if ($aflags & $Radius::Tacacsplus::TAC_PLUS_ACCT_WATCHDOG)
    {
	$tp->add_attr('Acct-Status-Type', 'Alive');
    }
    elsif ($aflags & $Radius::Tacacsplus::TAC_PLUS_ACCT_START)
    {
	$tp->add_attr('Acct-Status-Type', 'Start');
    }
    elsif ($aflags & $Radius::Tacacsplus::TAC_PLUS_ACCT_STOP)
    {
	$tp->add_attr('Acct-Status-Type', 'Stop');
    }
    $tp->add_attr('Acct-Session-Id', $self->{session_id});

    # REVISIT: May need to do something a bit more interesting with these AV pairs
    foreach (@args)
    {
	$tp->add_attr('cisco-avpair', $_);
    }
    if ($self->dispatch_radius_request($tp) == $main::IGNORE && !$tp->{proxied})
    {
	$self->accounting_reply($Radius::Tacacsplus::TAC_PLUS_ACCT_STATUS_ERROR, 0, 'Database failure');
    }
}

#####################################################################
# This function is called automatically when an authentication request
# has been serviced. $tp->{rp} will have been set to the reply message
sub replyFn
{
    my ($tp, $self) = @_;

    my $text = "Packet dump:\n*** Reply to TACACSPLUS request:\n" . $tp->{rp}->dump;
    $self->{parent}->log($main::LOG_DEBUG, $text, $tp->{rp});

    my $reply_code = $tp->{rp}->code();  # The result of the request
    $self->{parent}->log($main::LOG_DEBUG, "TacacsplusConnection result $reply_code");

    my $response_time = &Radius::Util::timeInterval($tp->{RecvTime}, $tp->{RecvTimeMicros}, &Radius::Util::getTimeHires);
    $tp->statsAverage($response_time, 'responseTime');

    if ($reply_code eq 'Access-Accept')
    {
	$tp->statsIncrement('accessAccepts');

	$self->authentication_reply($Radius::Tacacsplus::TAC_PLUS_AUTHEN_STATUS_PASS, 0);
	$self->disconnect() 
	    unless $self->{SingleSession} 
	           && ($self->{tflags} & $Radius::Tacacsplus::TAC_PLUS_SINGLE_CONNECT_FLAG);

	# Most TACACS clients create a new TCP session
	# for the authorisation phase. Therefore we cant cache the reply in $self.
	# So we have to create a context to hold the reply for a few seconds until
	# (maybe) an authorization REQUEST for this user arrives.
	my $context = Radius::Context::get("tacacs:$self->{user}:$self->{peeraddr}", $self->{AuthorizationTimeout});
	$context->{rp} = $tp->{rp};

	# If the reply contains any attributes named by AuthorizeGroupAttr, get
	# them and parse them and use them later during authorisation
	if (defined $self->{parent}->{AuthorizeGroupAttr})
	{
	    my @attrs = $tp->{rp}->get_attr($self->{parent}->{AuthorizeGroupAttr});
	    @{$context->{authorizegroup}} = ();
	    foreach (@attrs)
	    {
		my ($permission, $match, $reply) = $self->{parent}->parseAuthorizeGroup($_);
		# each rule is stored as [result, [pattern, pattern, ...], [reply, reply, ...]]
		push(@{$context->{authorizegroup}}, [$permission, $match, $reply])
		    if defined $permission;
	    }
	}
    }
    elsif ($reply_code eq 'Access-Challenge')
    {
	$tp->statsIncrement('accessChallenges');

	# Authenticator wants more data
	$self->authentication_reply($Radius::Tacacsplus::TAC_PLUS_AUTHEN_STATUS_GETPASS, 0, $tp->{rp}->getAttrByNum($Radius::Radius::REPLY_MESSAGE));
	# Save the State reply attribute
	$self->{state} = $tp->{rp}->getAttrByNum($Radius::Radius::STATE);
    }
    elsif ($reply_code eq 'Access-Reject')
    {
	$tp->statsIncrement('accessRejects');

	# A REJECT, or anything else, fail them
	$self->authentication_reply($Radius::Tacacsplus::TAC_PLUS_AUTHEN_STATUS_FAIL, 0, $tp->{rp}->getAttrByNum($Radius::Radius::REPLY_MESSAGE));
	# Old Ciscos dont close their TCP session after a failure
	$self->disconnect();
    }
    elsif ($reply_code eq 'Accounting-Response')
    {
	$tp->statsIncrement('accountingResponses');
	$self->accounting_reply($Radius::Tacacsplus::TAC_PLUS_ACCT_STATUS_SUCCESS);
    }
    else
    {
	# Anything else, close the connection
	$tp->statsIncrement('droppedRequests');
	$self->disconnect();
    }
}

#####################################################################
# Assemble and send and authentication reply message
sub authentication_reply
{
    my ($self, $status, $aflags, $server_msg, $data) = @_;

    no warnings "uninitialized";
    $self->{parent}->log($main::LOG_DEBUG, "TacacsplusConnection Authentication REPLY $status, $aflags, $server_msg, $data ");
    $self->{last_status} = $status;
    my $body = pack('CCnna*a*', $status, $aflags, 
		   length($server_msg), length($data),
		   $server_msg, $data);
    $self->reply($Radius::Tacacsplus::TAC_PLUS_AUTHEN, $body);
}

#####################################################################
# Assemble and send and accounting reply message
sub accounting_reply
{
    my ($self, $status, $server_msg, $data) = @_;

    $self->{parent}->log($main::LOG_DEBUG, "TacacsplusConnection Accounting REPLY $status, $server_msg, $data ");
    my $body = pack('nnCa*a*',
		    length($server_msg), length($data),
		    $status,
		    $server_msg, $data);
    $self->reply($Radius::Tacacsplus::TAC_PLUS_ACCT, $body);
    $self->disconnect() 
	unless $self->{SingleSession} 
               && ($self->{tflags} & $Radius::Tacacsplus::TAC_PLUS_SINGLE_CONNECT_FLAG);
}

#####################################################################
# Assemble and send and authentication reply message
sub authorization_reply
{
    my ($self, $status, $server_msg, $data, @args) = @_;

    my $nargs = @args;
    my $arglenarray = pack('C*', map {length $_} @args);
    $self->{parent}->log($main::LOG_DEBUG, "TacacsplusConnection Authorization RESPONSE $status, $server_msg, $data, @args");
    my $body = pack("CCnna*a*a*a*", $status, $nargs,
		   length($server_msg), length($data), 
		    $arglenarray,
		   $server_msg, $data,
		    join('', @args));
    $self->reply($Radius::Tacacsplus::TAC_PLUS_AUTHOR, $body);
    $self->disconnect() 
	unless $self->{SingleSession} 
               && ($self->{tflags} & $Radius::Tacacsplus::TAC_PLUS_SINGLE_CONNECT_FLAG);
}

#####################################################################
# Assemble a complete TACACS+ message, and encrypt the body if required
sub reply
{
    my ($self, $type, $body) = @_;

    no warnings "uninitialized";
    my $session_id = $self->{session_id};
    my $version = $self->{version};
    my $seq_no = $self->{last_seq_no} + 1;
    my $tflags;

    # check if we're doing encryption
    $tflags = $Radius::Tacacsplus::TAC_PLUS_UNENCRYPTED_FLAG unless defined $self->{Key};
    $body = &Radius::Tacacsplus::crypt($session_id, $self->{Key}, $version, $seq_no, $body) if defined $self->{Key};
# No: presence of this flag causes some Cisco routers to prematurely disconnect during multi-pass authentications.
#    $tflags |= $Radius::Tacacsplus::TAC_PLUS_SINGLE_CONNECT_FLAG if $self->{SingleSession};

    my $msg = pack('CCCCNNa*', 
		   $version, 
		   $type,
		   $seq_no,
		   $tflags,
		   $session_id,
		   length($body),
		   $body);
    $self->write($msg);
}

#####################################################################
sub write
{
    my ($self, $s) = @_;

    $self->{outbuffer} .= $s;
    if (length $self->{outbuffer} > $self->{MaxBufferSize})
    {
	$self->{parent}->log($main::LOG_ERR, "TacacsplusConnection 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, "TacacsplusConnection 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
	&Radius::Select::add_file
	    (fileno($self->{socket}), undef, 1, undef, 
	     \&handle_connection_socket_write, $self)
	    if length $self->{outbuffer};
    }
}

#####################################################################
sub disconnect
{
    my ($self) = @_;

    # Deleting any references to this TacacsConnection will
    # cause it to be destroyed    
    &Radius::Select::remove_file(fileno($self->{socket}), 1, 1, 1);
    &Radius::Select::remove_timeout($self->{idleTimeoutHandle})
	if $self->{idleTimeoutHandle};
    shutdown($self->{socket}, 2); # No more access
    close($self->{socket});

    $self->{parent}->log($main::LOG_DEBUG,  "TacacsplusConnection disconnected from $self->{peeraddr}:$self->{peerport}");
}


#####################################################################
# Store username/group membership pairs in a file.  This is
# necessary since Radiator will timeout any attributes passed back
# to the TACACS+ module (most importantly - group membership).
sub authgroup_file
{
    my ($self, $action, $user, $group) = @_;
    my $user_match = 0;
	my $datetime = time;
	my $expiretime = 86400;

    my $file =  &Radius::Util::format_special($self->{GroupCacheFile});
	
    open (RDATA, $file) || open(RDATA, ">$file");
    open (GDATA, ">$file.new") if $action eq "set";

    while (<RDATA>) {

	my ($read_user,$read_group,$read_datetime) = split(/\s/, $_);

	if ( $action eq "set" ) {

	    # check if user already has a value and replace it
	    if ( $read_user eq $user ) {
		print GDATA "$user $group $datetime\n";
		s/$read_user $read_group $read_datetime/$user $group $datetime/;
		$user_match = 1;
	    }
	    else {
		print GDATA "$_";
	    }
	}
	elsif ( $action eq "get" && $read_user eq $user ) {
	    close(RDATA);
		my $expired = ($datetime - $read_datetime) > $expiretime;
		
	    return $read_group if !$expired;
	}
    }

    if ( $user_match == 0 && $action eq "set" ) {
	print GDATA "$user $group $datetime\n";
    }
    close(GDATA) if $action eq "set";
    close(RDATA);
    rename("$file.new", $file) if $action eq "set";
}

1;


More information about the radiator mailing list