# Handler.pm
#
# Object for handling requests based on almost any 
# attribute in a packet
# We maintain a list of handlers in the same order they 
# appear in the config file
#
# Author: Mike McCauley (mikem@open.com.au)
# Copyright (C) 1997 Open System Consultants
# $Id: Handler.pm,v 1.9 2000/02/15 07:07:54 mikem Exp $

package Radius::Handler;
use Radius::AuthGeneric;
use Socket;
use File::Path;
use File::Basename;
use strict;

use vars qw($VERSION @ISA);
BEGIN 
{
    @ISA = qw(Radius::Configurable);
}

#####################################################################
# Name is a handler selection expression
sub new
{
    my ($class, $name, $file) = @_;

    my $self = $class->SUPER::new($file);
    $self->{Name} = $name;
    
    # Parse the handler selection expression into
    # an AttrVal for later evaluation
    $self->{Check} = Radius::AttrVal->new();
    $self->{Check}->parse($name);

    # Retain the order they appear in the config file
    push(@{$Radius::Handler::handlers}, $self);
    return $self;
}

#####################################################################
# Do per-instance default initialization
sub initialize
{
    my ($self) = @_;

    $self->SUPER::initialize;
    $self->{AuthByPolicy} = 'ContinueWhileIgnore';
}

#####################################################################
# Override the object function in Configurable
sub object
{
    my ($self, $file, $keyword, $args) = @_;

    if ($keyword eq 'AuthBy')
    {
	my $filename = "Radius/Auth$args.pm";
	if (eval("require \"$filename\""))
	{
	    my $class = "Radius::Auth$args";
	    # This will absorb the config file up until the 
	    # next </AuthBy>
	    my $handler = $class->new($file, $args);
	    push(@{$self->{AuthBy}}, $handler);
	}
	else
	{
	    &main::log($main::LOG_ERR, "Could not load authentication module $filename: $@");
	}
    }
    else
    {
	return 0;
    }
    return 1;
}

#####################################################################
# Override the keyword function in Configurable
sub keyword
{
    my ($self, $file, $keyword, $value) = @_;

    if ($keyword eq 'AcctLogFileName')
    {
	push (@{$self->{AcctLogFileName}}, $value);
    }
    elsif ($keyword eq 'AcctLogFileFormat')
    {
	$self->{AcctLogFileFormat} = $value;
    }
    elsif ($keyword eq 'WtmpFileName')
    {
	$self->{WtmpFileName} = $value;
    }
    elsif ($keyword eq 'PasswordLogFileName')
    {
	$self->{PasswordLogFileName} = $value;
    }
    elsif ($keyword eq 'ExcludeFromPasswordLog')
    {
	push @{$self->{ExcludeFromPasswordLog}}, split(/\s+/, $value);
    }
    elsif ($keyword eq 'ExcludeRegexFromPasswordLog')
    {
	$self->{ExcludeRegexFromPasswordLog} = $value;
    }
    elsif ($keyword eq 'RewriteUsername')
    {
	# allow more than 1 rewrite
	push @{$self->{RewriteUsername}}, $value;
    }
    elsif ($keyword eq 'MaxSessions')
    {
	$self->{MaxSessions} = int $value;
    }
    elsif ($keyword eq 'RewriteFunction')
    {
	$self->{RewriteFunction} = eval ("$value");
    }
    elsif ($keyword eq 'AccountingHandled')
    {
 	$self->{AccountingHandled}++;
    }
    elsif ($keyword eq 'AuthByPolicy')
    {
 	$self->{AuthByPolicy} = $value;
    }
    elsif ($keyword eq 'RejectHasReason')
    {
 	$self->{RejectHasReason}++;
    }
    elsif ($keyword eq 'SessionDatabase')
    {
 	$self->{SessionDatabase} = $value;
    }
    elsif ($keyword eq 'PreAuthHook')
    {
	# Get a reference to the code block
	$self->{PreAuthHook} = eval($value);
	&main::log($main::LOG_ERR, 
		   "Compilation error in PreAuthHook(): $@")
	    if $@;
    }
    elsif ($keyword eq 'PostAuthHook')
    {
	# Get a reference to the code block
	$self->{PostAuthHook} = eval($value);
	&main::log($main::LOG_ERR, 
		   "Compilation error in PostAuthHook(): $@")
	    if $@;
    }
    elsif ($keyword eq 'AuthBy')
    {
	my $auth_object;
	if ($auth_object = &Radius::AuthGeneric::find($value))
	{
	    push(@{$self->{AuthBy}}, $auth_object);
	}
	else
	{
	    &main::log($main::LOG_WARNING, 
		       "Could not find an <AuthBy> clause with Identifier for AuthBy $value");
	}
    }
    elsif ($keyword eq 'HandleAscendAccessEventRequest')
    {
 	$self->{HandleAscendAccessEventRequest}++;
    }
    else
    {
	return $self->SUPER::keyword($file, $keyword, $value);
    }
    return 1;
}

#####################################################################
# Find a Handler that can handle this packet
# This is a linear search, and might be slow
sub find
{
    my ($self, $p) = @_;

    my $h;
    foreach $h (@{$Radius::Handler::handlers})
    {
	# See if the selection expression for the handler true
	&main::log($main::LOG_DEBUG, "Check if Handler $h->{Name} should be used to handle this request");
	my ($result, $reason) = Radius::AuthGeneric::checkAttributes
		(undef, $h->{Check}, $p);
	return $h if $result == $main::ACCEPT;
    }
    return undef;
}

#####################################################################
# Handle a request for a Handler
sub handle_request
{
    my ($self, $p) = @_;

    # Remember which Handler processed the packet
    $p->{Handler} = $self;

    &main::log($main::LOG_DEBUG, 
	       "Handling request with Handler '$self->{Name}'");

    # Rewrite the user name if required
    my $name = $p->getUserName;
    if (defined $self->{RewriteFunction})
    {
	# Contributed by shawni@teleport.com, but undocumented.
	# RewriteFunction is a perl sub declaration. The sub
	# will be called to rewrite the username
	# Usage example:
	# RewriteFunction sub { my($a) = shift; $a =~ s/[\000]//g; $a =~ s/^([^@]+).*/$1/; $a =~ tr/[A-Z]/[a-z]/; $a =~ s/'//g; $a; }
	# We use an eval so an error in the pattern wont kill us.
	eval("\$name = &{\$self->{RewriteFunction}}(\$name);");
	&main::log($main::LOG_ERR, "Error in RewriteFunction($name): $@") if $@;
	$p->changeUserName($name);
 
	&main::log($main::LOG_DEBUG, "Rewrote user name to $name");
    } 
    elsif (defined $self->{RewriteUsername})
    {
	$name = $p->rewriteUsername($self->{RewriteUsername});
    }

    # Get the username before any rewriting. Need this to 
    # match users in the session database
    my $original_username = $p->{OriginalUserName}; 

    # Prepare a reply packet
    my $rp = new Radius::Radius $main::dictionary;
    $rp->set_identifier($p->identifier);
    $rp->set_authenticator($p->authenticator);

    # We keep some interesting attributes from the request
    # that will probably be needed
    my $nas_id = $p->getNasId();
    my $nas_port = $p->getAttrByNum($Radius::Radius::NAS_PORT);
    # 3com HiPerArc does not send NAS-Identifier EVER, and doesn't
    # send NAS-IP-Address w/Accounting-ON.  This is going to be
    # a problem is they start sending NAS-Identifier's with
    # Accounting-Starts and not Accounting-ON's.
    if (!defined $nas_id)
    {
	my ($port, $addr)
	    = Socket::unpack_sockaddr_in($p->{RecvFrom});
	$nas_id = Socket::inet_ntoa($addr);
    }
	
    my $sessdb = Radius::SessGeneric::find
	($self->{SessionDatabase});

    # See if the user will exceed the max number of sessions
    if ($p->code eq 'Access-Request')
    {
	# If we lost a Stop for this port, clean up the session database
	$sessdb->delete($original_username, $nas_id, $nas_port, $p);

	if (defined $self->{MaxSessions}
	    && $sessdb->exceeded($self->{MaxSessions}, $original_username, $p))
	{
	    # Issue a denial and bomb out
	    my $reason = "MaxSessions exceeded";
	    &main::log($main::LOG_INFO, "Access rejected for $name: $reason");
	    $rp->set_code('Access-Reject');
	    $rp->addAttrByNum($Radius::Radius::REPLY_MESSAGE, 
			      'Request Denied');
	    $rp->addAttrByNum($Radius::Radius::REPLY_MESSAGE, $reason)
		if $self->{RejectHasReason};
	    $p->{Client}->replyTo($rp, $p);
	    return;
	}
    }
    elsif ($p->code eq 'Accounting-Request')
    {
	# Add a pseudo attribute for the Timestamp 
	# (adjusted by Delay-Time)
	# Some modules (AuthSQL) and logfile scripts rely on it
	$p->add_attr('Timestamp', 
		     $p->{RecvTime} 
		     - int $p->getAttrByNum($Radius::Radius::ACCT_DELAY_TIME));

	# Log the packet
	
	my $status_type = $p->getAttrByNum($Radius::Radius::ACCT_STATUS_TYPE);
	my $session_id = $p->getAttrByNum($Radius::Radius::ACCT_SESSION_ID);
	my $current_time = time;
	 
	# Handle multiple accounting log files
	my $acctFileName;
	foreach $acctFileName (@{$self->{AcctLogFileName}})
	{
	    my $filename = &Radius::Util::format_special($acctFileName, $p, $rp);
	    # Make sure the log file directory exists.
	    if (! -d dirname($filename)) 
	    {
		mkpath(dirname($filename), 0, 0755);
	    }
	    open(LOG, ">>$filename")
		|| &main::log($main::LOG_ERR, "Could not open accounting log file '$filename': $!");
	    
	    # This is where the packet is formatted into the log file.
	    # If you want a different accounting log file format, you can
	    # change this bit
	    if (defined $self->{AcctLogFileFormat})
	    {
		# Format for accounting log file
		print LOG &Radius::Util::format_special
		    ($self->{AcctLogFileFormat},
		     $p, $rp), "\n";
	    }
	    else
	    {
		# No special format, do it the standard radius way
		print LOG scalar localtime($current_time) . "\n" . $p->format . "\n";
	    }
	    
	    close(LOG)
		|| &main::log($main::LOG_ERR, "Could not close accounting log file '$filename': $!");
	}
	
	if ($self->{WtmpFileName} ne '')
	{
	    my $filename = &Radius::Util::format_special($self->{WtmpFileName}, $p, $rp);
	    open(LOG, ">>$filename")
		|| &main::log($main::LOG_ERR, "Could not open wtmp file '$filename': $!");
	    
	    # This is where the packet is formatted into the wtmp file.
	    # If you want a different wtmp file format, you can
	    # change this bit
	    # Write to a wtmp compatible file
	    # If its a Start, make a USER_PROCESS (7) entry else a
	    # DEAD_PROCESS (8) entry
	    if ($^O eq 'linux')
	    {
		print LOG pack 's x x i a12 a2 x xL a8 a16 l',
		$status_type eq 'Start' ? 7 : 8, $$, 
		$nas_port, '?',
		$current_time, $name, 'RADIUS', 
		$p->getAttrByNum($Radius::Radius::FRAMED_IP_ADDRESS);
	    }		
	    elsif ($^O eq 'freebsd')
	    {
		print LOG pack 'a8 a16 a16 L',
		$nas_port,
		# FreeBSD uses NULL username as a DEAD_PROCESS
		# hope this is ok. Jason - 'godsey@fidalgo.net'
		$status_type eq 'Start' ? $name : '',
		$p->getAttrByNum($Radius::Radius::FRAMED_IP_ADDRESS),
		$current_time;
	    }
	    else
	    {
		print LOG pack 'a8 a4 a12 s s s s L',
		$name, '?', $nas_port, $$, 
		$status_type eq 'Start' ? 7 : 8, 0, 0, $current_time;
	    }
	    close(LOG)
		|| &main::log($main::LOG_ERR, "Could not close accounting log file '$filename': $!");
	}
	
	# Adjust the session details if we are in the parent
	# For each user, we keep a hash of session details
	# with a key of $nas_id:$nas_port
	# BUG ALERT: should we really do this every time. What
	# if its IGNOREd. What if the handler forked etc.
	if ($status_type eq 'Start' || $status_type eq 'Alive')
	{
	    # Some Ciscos dont send accounting-on, so we will
	    # detect a reboot with the first session (ID 00000001)
	    $sessdb->clearNas($nas_id, $p)
		if $session_id eq '00000001';
	    
	    # Ciscos sometimes sends Alive. Use them to make _sure_
	    # there is an entry in the database
	    $sessdb->add($original_username, $nas_id, $nas_port, $p);
	}
	elsif ($status_type eq 'Stop')
	{
	    $sessdb->delete($original_username, $nas_id, $nas_port, $p);
	}
	
	# Detect the various kinds of NAS reboots
	if ($status_type eq 'Accounting-On' 
	    || $status_type eq 'Accounting-Off'
	    || (   ($status_type eq 'Start' || $status_type eq 'Stop' )
		   && $session_id eq '00000000'))
	{
	    # Remove all session entries for a given NAS.
	    $sessdb->clearNas($nas_id, $p);
	}
    }
    elsif ($self->{HandleAscendAccessEventRequest}
	   && $p->code eq 'Ascend-Access-Event-Request')
    {
	# Ascend-Access-Event-Request has a count of the number
	# of sessions the NAS thinks it has in each Class. We can use
	# this to check whether out local session database is correct
	# provided its an SQL session database.
	# Sum the total number of sessions that this NAS thinks it has
	# and compare it to how many in the SessionDatabase.
	# If there is a discrepancy delete any 
	# dead sessions from SessionDatabase. Note that we never
	# add sessions to the session database, so this strategy
	# only corrects for lost Stops, not lost Starts.

	# Add up all the sessions for all classes
	my ($nascount, $detail);
	foreach $detail ($p->get_attr('Ascend-Number-Sessions'))
	{
	    # counts are in the format: 
	    # Ascend-Number-Sessions = "<0><0><0><1>classname"
	    my ($count, $class) = unpack('La*', $detail);
	    $nascount += $count;
	}
	&main::log($main::LOG_DEBUG, "Got a current session count of $nascount for NAS $nas_id");

	# Make sure its really an SQL SessionDatabase
	if (ref($sessdb) eq 'Radius::SessSQL')
	{
	    # Now find out how many sessions the SessionDatabase 
	    # thinks we have for this NAS
	    my ($result, @sessions)
		= $sessdb->sessionsOnNAS($nas_id, $p);
	    &main::log($main::LOG_DEBUG, "sessionsOnNAS reports $result, @sessions for NAS $nas_id");
	    
	    if ($result && @sessions > $nascount)
	    {
		# The counts dont agree, so poll the NAS for its list 
		# of current sessions, and remove dead ones from the 
		# session database
		&main::log($main::LOG_WARNING, "PORTLIMITCHECK SessionDatabase count does not agree with NAS");
		
		my ($sessresult, @nassessions) = 
		  Radius::Nas::activeSessions
		      ($p->{Client}->{NasType}, $nas_id, $p->{Client});

		if ($sessresult)
		{
		    # Now find sessions in our session database that are
		    # not in the NAS's list, and delete them
		    my $session;
		    my %nassessionhash;
		    # Make a hash for easy lookup of the existence of 
		    # a session
		    map { $nassessionhash{$_}++ } @nassessions;
		    foreach $session (@sessions)
		    {
			if (!exists $nassessionhash{$session})
			{
			    # The session is in our session database
			    # but not in the NAS
			    # Delete the session directly from the
			    # session database. This is pretty gross.
			    my $q = "delete from RADONLINE where NASIDENTIFIER='$nas_id' and ACCTSESSIONID = '$session'";
			    $sessdb->do($q);
			}
		    }
		}
	    }
	}
	else
	{
	    &main::log($main::LOG_ERR, 'No SQL SessionDatabase to use. Ignoring');
	}

	# Send a reply, no matter what happened
	$rp->set_code('Accounting-Response');
	$p->{Client}->replyTo($rp, $p);
	return;
    }

    # $handled can be IGNORE, ACCEPT or REJECT
    my $handled = $main::REJECT; # If there is no handlers

    # Make sure we always copy the Proxy-State
    my $ps = $p->getAttrByNum($Radius::Radius::PROXY_STATE);
    $rp->changeAttrByNum($Radius::Radius::PROXY_STATE, $ps)
	if defined $ps;
    # Also copy Proxy-Action, in case its merit asking us
    my $pa = $p->getAttrByNum($Radius::Radius::PROXY_ACTION);
    $rp->changeAttrByNum($Radius::Radius::PROXY_ACTION, $pa)
	if defined $pa;

    # Call the PreAuthHook, if there is one
    if (defined $self->{PreAuthHook})
    {
	# We use an eval so an error in the hook wont 
	# kill us.
	eval{ &{$self->{PreAuthHook}}(\$p, \$rp); };
	&main::log($main::LOG_ERR, 
		   "Error in PreAuthHook(): $@")
	    if $@;
    }

    # Try all the handlers in sequence until the AuthByPolicy
    # is satisfied
    # CAUTION: The handler might fork
    my ($handler, $reason);
    foreach $handler (@{$self->{AuthBy}})
    {
	($handled, $reason) = $handler->handle_request($p, $rp);
	my $stop = 0;

	# Is there a better way to express this?
	if ($self->{AuthByPolicy} eq 'ContinueWhileIgnore')
	{
	    $stop = ($handled != $main::IGNORE);
	}
	elsif ($self->{AuthByPolicy} eq 'ContinueUntilIgnore')
	{
	    $stop = ($handled == $main::IGNORE);
	}
	elsif ($self->{AuthByPolicy} eq 'ContinueWhileAccept')
	{
	    $stop = ($handled != $main::ACCEPT);
	}
	elsif ($self->{AuthByPolicy} eq 'ContinueUntilAccept')
	{
	    $stop = ($handled == $main::ACCEPT);
	}
	elsif ($self->{AuthByPolicy} eq 'ContinueWhileReject')
	{
	    $stop = ($handled != $main::REJECT 
		     && $handled != $main::REJECT_IMMEDIATE);
	}
	elsif ($self->{AuthByPolicy} eq 'ContinueUntilReject')
	{
	    $stop = ($handled == $main::REJECT
		     || $handled == $main::REJECT_IMMEDIATE);
	}
	last if $stop;
    }

    # Call the PostAuthHook, if there is one
    if (defined $self->{PostAuthHook})
    {
	# We use an eval so an error in the hook wont 
	# kill us.
	eval{ &{$self->{PostAuthHook}}(\$p, \$rp, \$handled); };
	&main::log($main::LOG_ERR, "Error in PostAuthHook(): $@")
	    if $@;
    }

    if ($p->code eq 'Access-Request')
    {
	if ($handled == $main::ACCEPT)
	{
	    &main::log($main::LOG_DEBUG, "Access accepted for $name");
	    $rp->set_code('Access-Accept');
	    $p->{Client}->replyTo($rp, $p);
	}
	elsif ($handled == $main::REJECT
	       || $handled == $main::REJECT_IMMEDIATE)
	{
	    &main::log($main::LOG_INFO, "Access rejected for $name: $reason");
	    $rp->set_code('Access-Reject');
	    $rp->addAttrByNum($Radius::Radius::REPLY_MESSAGE, 
			      'Request Denied');
	    $rp->addAttrByNum($Radius::Radius::REPLY_MESSAGE, $reason)
		if $self->{RejectHasReason};

	    $p->{Client}->replyTo($rp, $p);
	}
	elsif ($handled == $main::CHALLENGE)
	{
	    &main::log($main::LOG_DEBUG, "Access challenged for $name: $reason");
	    $rp->set_code('Access-Challenge');
	    $p->{Client}->replyTo($rp, $p);
	}
	# IGNORE means no reply
    }
    elsif ($p->code eq 'Accounting-Request')
    {
 	#
 	# AccountingHandled Patch <shawni@teleport.com>
 	#
 	# Sometimes we want to lie to the terminal server and tell
 	# it the accounting-request was handled, regardless of
 	# what the AuthBy handlers said.
 	#
 	if ($self->{AccountingHandled}
	    && $handled == $main::IGNORE)
	{
	    $handled = $main::ACCEPT;
 	}

	if ($handled == $main::ACCEPT)
	{
	    &main::log($main::LOG_DEBUG, "Accounting accepted");
	    $rp->set_code('Accounting-Response');
	    $p->{Client}->replyTo($rp, $p);
	}
    }
}

#####################################################################
# Reinitialize this module
sub reinitialize
{
    # This will DESTROY any objects left from a previous initialization
    $Radius::Handler::handlers = ();
    # This should be implemented more cleanly, but we need this
    # so that the radius reply socket is reregistered
    $AuthRADIUS::initialized = 0;
}

#####################################################################
# Maybe log success or fail of password checking
sub logPassword
{
    my ($self, $user, $submitted_pw, $correct_pw, $result, $p) = @_;


    if (defined $self->{PasswordLogFileName})
    {
	# Dont log for any of the names in ExcludeFromPasswordLog
	return 
	    if defined $self->{ExcludeFromPasswordLog}
	       && grep {$_ eq $user} @{$self->{ExcludeFromPasswordLog}};

  	# Dont log for any of the names that match ExcludeRegex FromPasswordLog
  	return 
  	    if defined $self->{ExcludeRegexFromPasswordLog}
 		&& $user =~ /$self->{ExcluderegexFromPasswordLog}/;
  
	my $filename = &Radius::Util::format_special($self->{PasswordLogFileName}, $p);
	my $time = time;
	my $ctime = localtime($time);
	my $r = $result ? 'PASS' : 'FAIL';
	open(LOG, ">>$filename")
	    || &main::log($main::LOG_ERR, "Could not open password log file '$filename': $!");
	#print LOG "$ctime:$time:$user:$submitted_pw:$correct_pw:$r\n";
        my $nas_name = $p->getNasId();
	if ($r eq 'PASS') {
		print LOG "$ctime: Login OK: [$user] ($nas_name)\n";
	} else {
		print LOG "$ctime: Login incorrect: [$user/$submitted_pw] ($nas_name)\n";
	}
	close(LOG)
	    || &main::log($main::LOG_ERR, "Could not close password log file '$filename': $!");
	
    }
}


1;