#!/usr/local/bin/perl
#
# radpwtst
# Simple client for testing radius servers
#
# Author: Mike McCauley (mikem@open.com.au)
# Copyright (C) 1997 Open System Consultants
# $Id: radpwtst,v 1.43 1999/04/14 11:43:23 mikem Exp mikem $

# Make sure we get the local libs for preference
BEGIN
{
    unshift(@INC, '.');
}

require 5.003;
require "timelocal.pl";
require "newgetopt.pl";
use Radius::RDict;
use Radius::Radius;
use Socket;
use MD5;

my @options = (
	       "time",     # Get the total response time
	       "iterations=i",
	       "trace",	   # Emit trace of events
	       "notrace",  # No tracing
	       "s=s",      # The server to send to 
	       "secret=s", # The secret to use with the server
	       "auth",     # Send authentication packet
	       "noauth",   # Dont send authentication packet
	       "acct",     # Send accounting packet
	       "noacct",   # Dont send accounting packet
	       "auth_port=s", # Port to use for auth requests
	       "acct_port=s", # Port to use for acct requests
	       "identifier=i", # Force this identifier
	       "user=s",   # Username
	       "password=s", # Users password
	       "nas_ip_address=s",
	       "nas_port=i",
	       "nas_port_type=s",
	       "service_type=s",
	       "session_id=s",
	       "delay_time=i",
	       "session_time=i",
	       "input_octets=i",
	       "output_octets=i",
	       "timeout=i",
	       "start",      # Send a accounting starts
	       "nostart",    # Dont send a accounting starts
	       "stop",       # Send accounting stops
	       "nostop",     # Dont send accounting stops
	       "status",     # send a Server-Status request
	       "nostatus",   # Dont send a Server-Status request
	       "chap",       # Authenticate with CHAP
	       "dictionary=s", # Alternate dictionary file
	       "noreply",    # Dont wait for a reply
	       "gui",        # run with the gui
	       "accton",     # Send accounting-on
	       "acctoff",    # Send accounting-off
 	       "framed_ip_address=s",
	       "state=s",    # Add this string as State
	       );

&NGetOpt(@options) || &usage;
&usage if $opt_h;

$errors = 0;
$reject = 0;

$replyTimeout = 5.0;
$replyTimeout = $opt_timeout if defined $opt_timeout;

$noreply = 0;
$noreply = 1 if $opt_noreply;

$chap = 0;
$chap = 1 if $opt_chap;

# REVISIT: is this really what I want?
$trace_level = 1;
$trace_level = 2 if $opt_trace;
$trace_level = 0 if $opt_notrace;

$iterations = 1;
$iterations = $opt_iterations if defined $opt_iterations;

$desthost = 'localhost';
$desthost = $opt_s if defined $opt_s;

$secret = 'mysecret';  # Shared secret on the term server
$secret = $opt_secret if defined $opt_secret;

$user = 'mikem';
$user = $opt_user if defined $opt_user;

$password = 'fred';
$password = $opt_password if defined $opt_password ;

$nas_ip_address = '203.63.154.1';
$nas_ip_address = $opt_nas_ip_address if defined $opt_nas_ip_address;

$nas_port = '1234';
$nas_port = $opt_nas_port if defined $opt_nas_port;

$nas_port_type = 'Async';
$nas_port_type = $opt_nas_port_type if defined $opt_nas_port_type;

$auth_authenticator = '1234567890123456'; # Should be random

$service_type = 'Framed-User';
$service_type = $opt_service_type if defined $opt_service_type;

$delay_time = '0';
$delay_time = $opt_delay_time if defined $opt_delay_time;

$session_time = '1000';
$session_time = $opt_session_time if defined $opt_session_time;

$input_octets = '20000';
$input_octets = $opt_input_octets if defined $opt_input_octets;

$output_octets = '30000';
$output_octets = $opt_output_octets if defined $opt_output_octets;

$session_id = '00001234';
$session_id = $opt_session_id if defined $opt_session_id;

# If its the same all the time, you can get confusing behaviour from
# radiusd unless DupInterval is 0
$identifier = time % 255; 
$identifier = $opt_identifier if defined $opt_identifier;

$dictionary = './dictionary';
$dictionary = $opt_dictionary if defined $opt_dictionary;
die "Can't open dictionary file $dictionary: $!"
    unless -r $dictionary;

$dict = new Radius::RDict $dictionary
    or die "Couldn't create dictionary";

# Set up the network socket (must have radius in /etc/services)
$proto = getprotobyname('udp');
socket(SOCKET, Socket::PF_INET, Socket::SOCK_DGRAM, $proto)
    || die "socket: $!";

$auth_port = 1645;
$auth_port = $opt_auth_port if defined $opt_auth_port;

$acct_port = 1646;
$acct_port = $opt_acct_port if defined $opt_acct_port;

$send_auth = 1;
$send_auth = 0 if defined $opt_noauth;
$send_auth = 1 if defined $opt_auth;

$send_acct_start = 1;
$send_acct_start = 0 if defined $opt_nostart || defined $opt_noacct;
$send_acct_start = 1 if defined $opt_start || defined $op_acct;

$send_acct_stop = 1;
$send_acct_stop = 0 if defined $opt_nostop || defined $opt_noacct;
$send_acct_stop = 1 if defined $opt_stop || defined $op_acct;

$send_acct_on = 0;
$send_acct_on = 1 if defined $opt_accton;

$send_acct_off = 0;
$send_acct_off = 1 if defined $opt_acctoff;

$send_server_status = 0;
$send_server_status = 0 if defined $opt_nostatus;
$send_server_status = 1 if defined $opt_status;

$framed_ip_address = '0.0.0.0';
$framed_ip_address = $opt_framed_ip_address 
    if defined $opt_framed_ip_address;

if ($opt_gui)
{
    # Defer all subsequent processing to the gui
    # It will return when the main window is destroyed
    require "Radius/RadpwtstGui.pm";
}
else
{
    &sendAll;
}

# Exit with 2 if errors, 1 if a rejection, 0 if all ok
exit ($errors ? 2 : ($reject ? 1 : 0));
    
#####################################################################
# Send the requested number of iterations
sub sendAll
{
    # Convert port names to numbers
    my $n_auth_port = Radius::Radius::get_port($auth_port);
    my $n_acct_port = Radius::Radius::get_port($acct_port);

    # Get the destination addresses
    my $destaddr = Socket::inet_aton($desthost);
    die "Could not resolve destination host name $desthost"
	unless defined $destaddr;

    $that_auth_paddr 
	= Socket::sockaddr_in($n_auth_port, $destaddr);
    $that_acct_paddr 
	= Socket::sockaddr_in($n_acct_port, $destaddr);

    my $start_time = time;
    my $i;
    $stopSending = 0;
    for ($i = 0; $i < $iterations && !$stopSending; $i++)
    {
	&sendOnce;
    }
    my $end_time = time;
    my $elapsed_time = $end_time - $start_time;
    announce("time for $iterations iterations: $elapsed_time s\n")
	if $opt_time;
}

#####################################################################
# Send one iteration of the selected message types
sub sendOnce
{
    &sendAuthReq if $send_auth;
    return if $stopSending;
    &sendAcctReq('Start') if $send_acct_start;
    return if $stopSending;
    &sendAcctReq('Stop') if $send_acct_stop;
    return if $stopSending;
    &sendAcctReq('Accounting-On') if $send_acct_on;
    return if $stopSending;
    &sendAcctReq('Accounting-Off') if $send_acct_off;
    return if $stopSending;
    &sendStatusReq if $send_server_status;
}

#####################################################################
sub sendAuthReq
{
    my $p = new Radius::Radius $dict;
    $p->set_code('Access-Request');
    $p->set_identifier($identifier);
    $identifier = ($identifier + 1) & 0xff;
    $p->set_authenticator($auth_authenticator);
    $p->addAttrByNum($Radius::Radius::USER_NAME, $user);
    $p->addAttrByNum($Radius::Radius::SERVICE_TYPE, $service_type);
    $p->addAttrByNum($Radius::Radius::NAS_IP_ADDRESS, $nas_ip_address);
    $p->addAttrByNum($Radius::Radius::NAS_PORT, $nas_port);
#    $nas_port = ($nas_port + 1) % 64; # TEST
    $p->addAttrByNum($Radius::Radius::NAS_PORT_TYPE, $nas_port_type);
#    $p->addAttrByNum($Radius::Radius::CONNECT_INFO, '33600 LAPM/V42BIS');
#    $p->addAttrByNum($Radius::Radius::PROXY_ACTION, 'AUTHENTICATE');
#    $p->addAttrByNum($Radius::Radius::PROXY_STATE, "\000\000\001\000");
    $p->addAttrByNum($Radius::Radius::STATE, $opt_state)
	if defined $opt_state;
    if ($framed_ip_address ne '0.0.0.0')
    {
	$p->addAttrByNum($Radius::Radius::FRAMED_IP_ADDRESS, 
			 $framed_ip_address);
    }
    if ($chap)
    {
	my $chap_id = '5';
	my $chap_challenge = '1234567890123456';
	$p->addAttrByNum($Radius::Radius::CHAP_PASSWORD,
		     $chap_id . MD5->hash($chap_id . $password . $chap_challenge));
	$p->addAttrByNum($Radius::Radius::CHAP_CHALLENGE, $chap_challenge);
    }
    else
    {
	$p->addAttrByNum($Radius::Radius::USER_PASSWORD, $p->encode_password($password, $secret));
    }
    &addExtraAttributes($p);

    $p->assemble_packet($secret);
    showdump($p) if $trace_level >= 2;
    &announceSending('Access-Request');
    $p->sendTo(*SOCKET, $that_auth_paddr);


    return if $noreply;
    my $rp;
    if ($rp = &waitRecv(\*SOCKET, $replyTimeout, $p->identifier))
    {
	if ($rp->code eq 'Access-Accept'
	    || $rp->code eq 'Access-Reject'
	    || $rp->code eq 'Access-Challenge' )
	{
	    announceFailure("Bad identifier"), goto fail
		if $rp->identifier != $p->identifier;

	    announceFailure("Bad authenticator"), goto fail
		if !$rp->check_authenticator($secret, $p->sent_authenticator);
	    
	    announceRejection("Rejected"), goto fail
		if $rp->code eq 'Access-Reject';

	    announceRejection("Challenge"), goto fail
		if $rp->code eq 'Access-Challenge';

	    announceSuccess("OK");
	  fail:
	}
	else
	{
	    announceFailure("Unexpected reply type")
	}
	showdump($rp) if $trace_level >= 2;

    }
    else
    {
	announceFailure("No reply")
    }
}

#####################################################################
sub sendStatusReq
{
    my $p = new Radius::Radius $dict;
    $p->set_code('Status-Server');
    $p->set_identifier($identifier);
    $identifier = ($identifier + 1) & 0xff;
    $p->set_authenticator($auth_authenticator);

    $p->addAttrByNum($Radius::Radius::STATE, $opt_state)
	if defined $opt_state;

    &addExtraAttributes($p);

    $p->assemble_packet($secret);
    showdump($p) if $trace_level >= 2;
    &announceSending('Status-Request');
    $p->sendTo(*SOCKET, $that_auth_paddr);

    return if $noreply;
    my $rp;
    if ($rp = &waitRecv(\*SOCKET, $replyTimeout, $p->identifier))
    {
	if ($rp->code eq 'Access-Accept'
	    || $rp->code eq 'Access-Reject')
	{
	    announceFailure("Bad identifier"), goto fail
		if $rp->identifier != $p->identifier;

	    announceFailure("Bad authenticator"), goto fail
		if !$rp->check_authenticator($secret, $p->sent_authenticator);
	    
	    announceRejection("Rejected"), goto fail
		if $rp->code eq 'Access-Reject';

	    announceSuccess("OK");
	  fail:
	}
	else
	{
	    announceFailure("Unexpected reply type");
	}
	showdump($rp) if $trace_level >= 2;
    }
    else
    {
	announceFailure("No reply");
    }
}

#####################################################################
sub sendAcctReq
{
    my ($type) = @_;

    my $p = new Radius::Radius $dict;
    $p->set_code('Accounting-Request');
    $p->set_identifier($identifier);
    $identifier = ($identifier + 1) & 0xff;
    $p->set_authenticator("\000" x 16);
    if ($type eq 'Start' || $type eq 'Stop')
    {
        $p->addAttrByNum($Radius::Radius::USER_NAME, $user);
        $p->addAttrByNum($Radius::Radius::SERVICE_TYPE, $service_type);
        $p->addAttrByNum($Radius::Radius::NAS_IP_ADDRESS, $nas_ip_address);
        $p->addAttrByNum($Radius::Radius::NAS_PORT, $nas_port);
	$p->addAttrByNum($Radius::Radius::NAS_PORT_TYPE, $nas_port_type);
        $p->addAttrByNum($Radius::Radius::ACCT_SESSION_ID, $session_id);
        $p->addAttrByNum($Radius::Radius::ACCT_STATUS_TYPE, $type);
	if ($framed_ip_address ne '0.0.0.0')
	{
	    $p->addAttrByNum($Radius::Radius::FRAMED_IP_ADDRESS, 
			     $framed_ip_address);
	}
    }
    if ($type eq 'Stop')
    {
	$p->addAttrByNum($Radius::Radius::ACCT_DELAY_TIME, $delay_time);
	$p->addAttrByNum($Radius::Radius::ACCT_SESSION_TIME, $session_time++);
	$p->addAttrByNum($Radius::Radius::ACCT_INPUT_OCTETS, $input_octets++);
	$p->addAttrByNum($Radius::Radius::ACCT_OUTPUT_OCTETS, $output_octets++);
	$session_id++;
    }
    if ($type eq 'Accounting-On' || $type eq 'Accounting-Off')
    {
        $p->addAttrByNum($Radius::Radius::NAS_IP_ADDRESS, $nas_ip_address);
        $p->addAttrByNum($Radius::Radius::ACCT_DELAY_TIME, $delay_time);
        $p->addAttrByNum($Radius::Radius::ACCT_STATUS_TYPE, $type);
    }
    $p->addAttrByNum($Radius::Radius::STATE, $opt_state)
	if defined $opt_state;

    &addExtraAttributes($p);

    $p->assemble_packet($secret);
    showdump($p) if $trace_level >= 2;
    &announceSending("Accounting-Request $type");
    $p->sendTo(*SOCKET, $that_acct_paddr);

    return if $noreply;
    my $rp;
    if ($rp = &waitRecv(\*SOCKET, $replyTimeout, $p->identifier))
    {
	if ($rp->code eq 'Accounting-Response')
	{
	    announceFailure("Bad identifier"), goto fail
		if $rp->identifier != $p->identifier;

	    announceFailure("Bad authenticator"), goto fail
		if !$rp->check_authenticator($secret, $p->sent_authenticator);
	    announceSuccess("OK");
	  fail:
	}
	else
	{
	    announceFailure("Unexpected reply type");
	}
	showdump($rp) if $trace_level >= 2;
    }
    else
    {
	announceFailure("No reply");
    }
}


#####################################################################
# Add all the extra attributes described on the command line
# each one is in the form name=value
sub addExtraAttributes
{
    my ($p) = @_;

    my $arg;

    foreach $arg (@ARGV)
    {
	if ($arg =~ /(.*)=(.*)/)
	{
	    $p->add_attr($1, $2);
	}
    }
}

#####################################################################
sub usage
{
    print "usage: $0 [-time] [-iterations n] 
          [-trace] [-s server] [-secret secret] 
          [-noauth] [-noacct][-nostart] [-nostop] [-status] [-chap]
          [-accton] [-acctoff] [-framed_ip_address address]
          [-auth_port port] [-acct_port port] [-identifier n]
          [-user username] [-password password] [-nas_ip_address address]
          [-nas_port port] [-nas_port_type type] [-service_type service] 
          [-session_id string]
          [-delay_time n] [-session_time n] [-input_octets n]
          [-output_octets n] [-timeout n] [-dictionary file]
          [-gui] [attribute=value]... \n";
    exit;
}

#####################################################################
# Wait for readable on the socekt $s for at most $timeout seconds
sub waitForSocket
{
    my ($s, $timeout) = @_;

    my $rin, $rout;
    vec($rin, fileno($s), 1) = 1;
    return select($rout = $rin, undef, undef, $timeout);
}

#####################################################################
# Wait for a packet on the socket and return it
# Returns undef if no packet arrives within the timeout period
sub waitRecv
{
    my ($s, $timeout, $expectedid) = @_;

    my $p;
    
    while (!$p && &waitForSocket($s, $timeout) && !$stopSending)
    {
	$p = Radius::Radius->newRecvFrom($s, $dict);
	# Only return when we get the one we expected
	# protect against failures in newRecvFrom
	if ($p && $p->identifier != $expectedid)
	{
	    $p = undef;
	}
    }
    return $p;
}

# These will be from errors inside the library. Always print them
sub log
{
    my ($p, $s) = @_;

    print $s, "\n";
}

sub announceSending
{
    my ($msg) = @_;
    print "sending $msg...\n" if $trace_level >= 1;
}

sub announceSuccess
{
    my ($msg) = @_;
    print $msg, "\n" if $trace_level >= 1;
}

sub announceFailure
{
    my ($msg) = @_;
    
    $errors++;
    print $msg, "\n"  if $trace_level >= 1;
}

sub announceRejection
{
    my ($msg) = @_;
    
    $reject++;
    print $msg, "\n"  if $trace_level >= 1;
}

sub showdump
{
    my ($p) = @_;

    print $p->dump;
}

sub announce
{
    my ($msg) = @_;
    
    print $msg, "\n";
}