# 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@open.com.au)
# Copyright (C) 2003 Open System Consultants
# $Id: ServerTACACSPLUS.pm,v 1.90 2008/01/14 04:05:21 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.', 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],

 '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],

 );

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

#####################################################################
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 (/^(\w*)\s+(permit|permitreplace|deny)\s+([^{]*)?(\s*\{(.*)\})?/)
	{
	    # each rule is stored as [result, [pattern, pattern, ...], [reply, reply, ...]]
	    my $groupname = $1;
	    my $permission = $2;
	    my $match = $3;
	    my $reply = $5;
	    my @match = split(/\s+/, $match);
	    my @reply;
	    # Splitting the reply is more complicated since there may be 
	    # quotes around spaces
	    # We now suport 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 in AuthorizeGroup rule: $_");
		    last;
		}
	    }
	    push(@{$self->{authorizegroup}->{$groupname}}, [$permission, [@match], [@reply]]);
	}
	else
	{
	    $self->log($main::LOG_ERR,  "Invalid syntax in AuthorizeGroup rule: $_");
	}
    }
}


#####################################################################
# 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->{GroupCacheFile} = '/tmp/radiator-tacacs-usergroup.cache';
    $self->{UsernamePrompt} = 'Username: ';
    $self->{PasswordPrompt} = 'Password: ';
}

#####################################################################
# 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},
	 AddToRequest              => $self->{AddToRequest},
	 GroupCacheFile            => $self->{GroupCacheFile},
	 UsernamePrompt            => $self->{UsernamePrompt},
	 PasswordPrompt            => $self->{PasswordPrompt},
	 AuthenticationStartHook=> $self->{AuthenticationStartHook},
	 AuthenticationContinueHook=> $self->{AuthenticationContinueHook},
	 );
}

#####################################################################
#####################################################################
#####################################################################
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);
    $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);
}

#####################################################################
# 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 (length $self->{inbuffer} >= 12)
	{
	    # Have the header at least
	    my ($version, $type, $seq_no, $flags, $session_id, $length) 
		= unpack('CCCCNN', $self->{inbuffer});
	    # 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. Disconnecting");
		
		$self->disconnect();
	    }
	    if ($length > $self->{MaxBufferSize})
	    {
		$self->{parent}->log($main::LOG_ERR, "TacacsplusConnection received a request with excessive length $length. Disconnecting");
		$self->disconnect();
	    }
	    # Have at least one complete message yet?
	    last unless length($self->{inbuffer}) >= $length;

	    # Have the entire request
	    # Get, clear and handle this request
	    my $request = substr($self->{inbuffer}, 0, $length+12, undef);
	    $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, $flags, $session_id, $length, $body) 
	= unpack('CCCCNNa*', $request);

    $self->{parent}->log($main::LOG_DEBUG, "TacacsplusConnection request $version, $type, $seq_no, $flags, $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->{last_seq_no} = $seq_no;
    $self->{session_id} = $session_id;

    # 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");
    }
}

#####################################################################
# 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. 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');

    if ($self->{parent}->runHook('AuthenticationStartHook', undef, $self, $tp, $action, $authen_type))
    {
	$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});
	}
	# 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', $data);
	$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. Bad encryption Key?");
	$self->authentication_reply($Radius::Tacacsplus::TAC_PLUS_AUTHEN_STATUS_ERROR, 0, 'unknown authentication action');
	$self->disconnect();
	return;
    }

    $self->dispatch_radius_request($tp);
}

#####################################################################
# 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} = time;
    $tp->{Client} = $self; # So you can use Client-Identifier check items
    $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) = @_;

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

    # 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 '' 
	&& defined $self->{parent}->{'DefaultRealm'})
    {
	$realmName = $self->{parent}->{'DefaultRealm'};
	$tp->changeUserName("$userName\@$realmName");
    }

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

    $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); 
    # 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';
}

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

    my ($user_msg_len, $data_len, $flags, $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;
    
    $self->{parent}->log($main::LOG_DEBUG, "TacacsplusConnection Authentication CONTINUE $flags, $user_msg, $data");

    if ($flags & $Radius::Tacacsplus::TAC_PLUS_CONTINUE_FLAG_ABORT)
    {
	$self->{parent}->log($main::LOG_WARN, "TacacsplusConnection Authentication CONTINUE 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', $self->{password});
	$tp->{DecodedPassword} = $self->{password};

	# Recover the context and any radius State from a previous Access-Challenge
	my $context = &Radius::Context::find("tacacs:$self->{user}");
	$tp->add_attr('State', $context->{state}) if defined $context && defined $context->{state};

	$self->dispatch_radius_request($tp);
    }
    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. 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 length in Tacacs Authorization request. 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}");
    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 = 'DEFAULT';
    if ($rp && $group_name_attr) 
    {
	my $g = $rp->get_attr($group_name_attr);
	if (defined $g)
	{
	    $group_name = $g;
	    $self->authgroup_file("set", $user, $g);
	}
    }
    elsif ($group_name_attr) 
    { 
	my $g = $self->authgroup_file("get", $user);
	$group_name = $g if defined $g;
    }

    # 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})
    {
	# Use the new AuthorizeGroup parameters for determining 
	# per-group command authorization
      rulematch:
	foreach (@{$self->{parent}->{authorizegroup}->{$group_name}})
	{
	    my $result   = $_->[0];
	    my @patterns = @{$_->[1]};
	    my @reply    = @{$_->[2]};

	    # If every pattern matches the corresponding request arg, 
	    # then use the result and perhaps the reply args
	    my $i;
	    for ($i = 0; $i < scalar @patterns; $i++)
	    {
		next rulematch unless $args[$i] =~ /^$patterns[$i]$/;
	    }

	    # 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, 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, 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, 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: $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 ($flags, $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. 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 length in Tacacs Accounting request. 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 $flags, $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 ($flags & $Radius::Tacacsplus::TAC_PLUS_ACCT_WATCHDOG)
    {
	$tp->add_attr('Acct-Status-Type', 'Alive');
    }
    elsif ($flags & $Radius::Tacacsplus::TAC_PLUS_ACCT_START)
    {
	$tp->add_attr('Acct-Status-Type', 'Start');
    }
    elsif ($flags & $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', $_);
    }
    $self->dispatch_radius_request($tp);
}

#####################################################################
# 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 = time - $tp->{RecvTime};
    $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);

	# Sigh. Some TACACS clients (Cisco Aironet etc) create a new TCP session
	# for the authorisation phase. Therfore 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->{AuthorizationTimeout});
	$context->{rp} = $tp->{rp};
    }
    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));
	my $context = Radius::Context::get("tacacs:$self->{user}", $self->{AuthorizationTimeout});
	# Save the State reply attribute
	$context->{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, $flags, $server_msg, $data) = @_;

    no warnings "uninitialized";
    $self->{parent}->log($main::LOG_DEBUG, "TacacsplusConnection Authentication REPLY $status, $flags, $server_msg, $data ");
    $self->{last_status} = $status;
    my $body = pack('CCnna*a*', $status, $flags, 
		   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);
}

#####################################################################
# 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);
}

#####################################################################
# 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 $flags;

    # check if we're doing encryption
    $flags = $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};
    
    my $msg = pack('CCCCNNa*', 
		   $version, 
		   $type,
		   $seq_no,
		   $flags,
		   $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);
    shutdown($self->{socket}, 1); # No more writing
    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 $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) = 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\n";
		s/$read_user $read_group/$user $group/;
		$user_match = 1;
	    }
	    else {
		print GDATA "$_";
	    }
	}
	elsif ( $action eq "get" && $read_user eq $user ) {
	    close(RDATA);
	    return $read_group;
	}
    }

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

1;