#!/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.52 2001/06/07 04:32:01 mikem Exp $

# 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 = (
		"random",
	       "h",        # Print usage
	       "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
	       "raw=s",      # Send raw data literally
	       "nostatus",   # Dont send a Server-Status request
	       "chap",       # Authenticate with CHAP
	       "mschap",     # Authenticate with MS-CHAP
	       "mschapv2",     # Authenticate with MS-CHAP V2
	       "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
	       "useoldascendpasswords",
	       "class=s",    # Use this class
	       "incrementuser", # Increment user name each cycle
	       "code=s",     # Send a message with the given code
		"calling_station_id=s",
		"called_station_id=s",
	       );

&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;

$mschap = 0;
$mschap = 1 if $opt_mschap;

$mschapv2 = 0;
$mschapv2 = 1 if $opt_mschapv2;

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

$class = $opt_class;

# 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 = $opt_dictionary if defined $opt_dictionary;
@dictionaries = qw(./dictionary /usr/local/etc/raddb/dictionary);
while (!defined $dictionary && @dictionaries)
{
    my $dict = shift @dictionaries;
    $dictionary = $dict if -r $dict;
}
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;

$called_station_id ='123456789';   #default
$called_station_id = $opt_called_station_id
    if defined $opt_called_station_id;

$calling_station_id ='987654321';    #default
$calling_station_id = $opt_calling_station_id
    if defined $opt_calling_station_id;
$random		= 'yup', if defined $opt_random ;

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;
    &sendCode($opt_code) if $opt_code;
    &sendRaw($opt_raw) if $opt_raw;
    $user++ if $opt_incrementuser;
}

#####################################################################
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);
	# generate a random phone number
	$calling_station_id	= sprintf("07%09d", int(rand(999999999))),
							if $random eq 'yup';
    $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::CALLED_STATION_ID, $called_station_id);
    $p->addAttrByNum($Radius::Radius::CALLING_STATION_ID, $calling_station_id);
#    $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);
    }
    elsif ($mschapv2)
    {
	# Pack as per draft-ietf-radius-ms-vsa-01.txt,
	# and RFC 2548
	require Radius::MSCHAP;
	my $ident = 1;
	my $challenge = pack('H*', 'D02E4386BCE91226');
	my $authchallenge = pack('H*', '5B5D7C7D7B3F2F3E3C2C602132262628');
	my $peerchallenge = pack('H*', '21402324255E262A28295F2B3A337C7E');
	my $flags = 0;
	my $ntresponse = 
	  Radius::MSCHAP::GenerateNTResponse($authchallenge, $peerchallenge, $user, Radius::MSCHAP::ASCIItoUnicode($password));
	$p->add_attr('MS-CHAP-Challenge', $authchallenge);
	$p->add_attr('MS-CHAP2-Response',
		     pack('C C a16 a8 a24', $ident, $flags, $peerchallenge, undef, $ntresponse));
    }
    elsif ($mschap)
    {
	# Pack as per draft-ietf-radius-mschap-attr-01.txt
	# We only use NT-Response type
	require Radius::MSCHAP;
	my $ident = 1;
	my $challenge = pack('H*', '102DB5DF085D3041');
	my $flags = 1; # use NT-Response
	my $ntresponse = 
	  Radius::MSCHAP::NtChallengeResponse
	      ($challenge, 
	     Radius::MSCHAP::ASCIItoUnicode($password));
	$p->add_attr('MS-CHAP-Challenge', $challenge);
	$p->add_attr('MS-CHAP-Response',
		     pack('C C a24 a24', $ident, $flags, undef, $ntresponse));
    }
    else
    {
	$p->addAttrByNum($Radius::Radius::USER_PASSWORD, $p->encode_password($password, $secret, $opt_useoldascendpasswords));
    }
    &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' )
	{
	    $replyMessage = $rp->getAttrByNum
		($Radius::Radius::REPLY_MESSAGE);
	    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: $replyMessage"), goto fail
		if $rp->code eq 'Access-Reject';

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

	    announceSuccess("OK");

	    # Take notice of the returned address unless we are forcing
	    # a particular framed address
	    my $address = $rp->get_attr('Framed-IP-Address');
	    $framed_ip_address = $address
		if defined $address and !defined $opt_framed_ip_address;

	    # Take notice of the returned class
	    $class = $rp->getAttrByNum($Radius::Radius::CLASS);


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

	# generate a random phone number
	$calling_station_id	= sprintf("07%09d", int(rand(999999999))),
							if $random eq 'yup';
	
    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);
        $p->addAttrByNum($Radius::Radius::CALLED_STATION_ID, $called_station_id);
        $p->addAttrByNum($Radius::Radius::CALLING_STATION_ID, $calling_station_id);
	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::CALLED_STATION_ID, $called_station_id);
        $p->addAttrByNum($Radius::Radius::CALLING_STATION_ID, $calling_station_id);
    }
    $p->addAttrByNum($Radius::Radius::STATE, $opt_state)
	if defined $opt_state;
    # Send any Class attribtue that we got from the most recent
    # access-reply
    $p->addAttrByNum($Radius::Radius::CLASS, $class)
	if defined $class;

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


#####################################################################
# Send an aribtrary request code
sub sendCode
{
    my ($code) = @_;

    my $p = new Radius::Radius $dict;
    $p->set_code($code);
    $p->set_identifier($identifier);
    $identifier = ($identifier + 1) & 0xff;
    $p->set_authenticator($auth_authenticator);
    &addExtraAttributes($p);

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

    return if $noreply;
    my $rp;
    if ($rp = &waitRecv(\*SOCKET, $replyTimeout, $p->identifier))
    {
	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:
	showdump($rp) if $trace_level >= 2;
    }
    else
    {
	announceFailure("No reply");
    }
}


#####################################################################
# Send an aribtrary data
sub sendRaw
{
    my ($raw) = @_;

    my $p = new Radius::Radius $dict;
    $raw =~ s/\s//g;
    $p->{Packet} = pack('H*', $raw);
    my $identifier = unpack('x C', $p->{Packet});

    &announceSending('raw');
    $p->sendTo(*SOCKET, $that_auth_paddr);
    return if $noreply;
    my $rp;
    if ($rp = &waitRecv(\*SOCKET, $replyTimeout, $identifier))
    {
	announceFailure("Bad identifier"), goto fail
	    if $rp->identifier != $identifier;

	announceFailure("Bad authenticator"), goto fail
	    if !$rp->check_authenticator($secret, $p->sent_authenticator);
	announceSuccess("OK");
      fail:
	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 =~ /([^=]*)=(.*)/)
	{
	    # Permit hex, octal etc as value
	    $p->add_attr($1, $2);
	}
    }
}

#####################################################################
sub usage
{
    print "usage: $0 [-h] [-time] [-iterations n] 
          [-trace] [-s server] [-secret secret] 
          [-noauth] [-noacct][-nostart] [-nostop] [-status] [-chap] [-mschap]
          [-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] 
          [-calling_station_id string] [-called_station_id string] 
          [-session_id string]
          [-delay_time n] [-session_time n] [-input_octets n]
          [-output_octets n] [-timeout n] [-dictionary file]
          [-gui] [-class string] [-useoldascendpasswords]
          [-code requestcode]
          [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";
}