#!/usr/bin/perl -w

# Replay a radius accounting 'detail' file.  This program was written
# to test a radius accounting server, using previously captured data.

# Copyright (c) 1998 Frank D. Cringle.
 
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.

use strict;

use Getopt::Std;
use FileHandle;
use IO::Socket;
use IO::Select;
use MD5;

my $usage = <<EOT;
$0 { -h host } { -p portno } -s secret detail-file...
EOT

use vars qw(%opt);

getopts('h:p:s:', \%opt);
my $host = $opt{h} || '127.0.0.1';
my $port = $opt{p} || 1646;
my $secret = $opt{'s'} or die "shared secret must be specified\n";

die $usage unless @ARGV;

@ARGV = map { /(.*)\.gz$/ ? "zcat $1|" : $_ } @ARGV;

my %dict = ('User-Name' => [ 1, 'str' ],
	    'NAS-IP-Address' => [ 4, 'ip' ],
	    'Client-Id' => [ 4, 'ip' ],		# compat
	    'NAS-Port-Id' => [ 5, 'int' ],
	    'Client-Port-Id' => [ 5, 'int' ],	# compat
	    'Service-Type' => [ 6, 'int', { 'Login-User' => 1,
					    'Framed-User' => 2,
					    'Callback-Login-User' => 3,
					    'Callback-Framed-User' => 4,
					    'Outbound-User' => 5,
					    'Administrative-User' => 6,
					    'NAS-Prompt-User' => 7 } ],
	    'Framed-Protocol' => [ 7, 'int', { PPP => 1,
					       SLIP => 2 } ],
	    'Framed-IP-Address' => [ 8, 'ip' ],
	    'Framed-Address' => [ 8, 'ip' ],	# compat
	    'Login-IP-Host' => [ 14, 'ip' ],
	    'Login-Host' => [ 14, 'ip' ],	# comat
	    'Login-Service' => [ 15, 'int', { Telnet => 0,
					      Rlogin => 1,
					      'TCP-Clear' => 2,
					      'PortMaster' => 3 } ],
	    'Calling-Station-Id' => [ 31, 'str' ],
	    'Acct-Status-Type' => [ 40, 'int', { Start => 1,
					       Stop => 2,
					       Alive => 3,
					       'Accounting-On' => 7,
					       'Accounting-Off' => 8 } ],
	    'Acct-Delay-Time' => [ 41, 'int' ],
	    'Acct-Input-Octets' => [ 42, 'int' ],
	    'Acct-Output-Octets' => [ 43, 'int' ],
	    'Acct-Session-Id' => [ 44, 'str' ],
	    'Acct-Authentic' => [ 45, 'int', { RADIUS => 1,
					       Local => 2 } ],
	    'Acct-Session-Time' => [ 46, 'int' ],
	    'Acct-Input-Packets' => [ 47, 'int' ],
	    'Acct-Output-Packets' => [ 48, 'int' ],
	    'Acct-Terminate-Cause' => [ 49, 'int', {'User-Request' => 1,
						  'Lost-Carrier' => 2,
						  'Lost-Service' => 3,
						  'Idle-Timeout' => 4,
						  'Session-Timeout' => 5,
						  'Admin-Reset' => 6,
						  'Admin-Reboot' => 7,
						  'Port-Error' => 8,
						  'NAS-Error' => 9,
						  'NAS-Request' => 10,
						  'NAS-Reboot' => 11,
						  'Port-Unneeded' => 12,
						  'Port-Preempted' => 13,
						  'Port-Suspended' => 14,
						  'Service-Unavailable' => 15,
						  'Callback' => 16,
						  'User-Error' => 17,
						  'Host-Request' => 18 } ],
 	    'NAS-Port-Type' => [ 61, 'int', { Async => 0,
					      Sync => 1,
					      ISDN => 2,
					      'ISDN-V120' => 3,
					      'ISDN-V110' => 4 } ]);
$/ = '';

my $socket = new IO::Socket::INET(PeerAddr => $host,
				  PeerPort => $port,
				  Type => SOCK_DGRAM,
				  Proto => 'udp',
				  TimeOut => 5);
my $select = IO::Select->new($socket);
my $id = 0;
my $md5 = MD5->new();

while (<>) {
    my(@lines) = split /\n/;
    shift @lines;		# ignore date stamp
    my $data = pack('CCx18', 4, $id);
    foreach my $line (@lines) {
	unless ($line =~ /^\s+(\S+) = (.*)/) {
	    warn $line;
	    next;
	}
	my($attr,$val) = ($1,$2);
	next if $attr eq 'Timestamp';
	next if $attr eq 'Request-Authenticator';
	warn "$attr ?\n" unless defined $dict{$attr};
	my $v = $dict{$attr};
	$val =~ s/^"(.*)"$/$1/;
	if ($v->[1] eq 'int') {
	    if (defined $v->[2]) {
		if (!defined $v->[2]{$val}) {
		    warn "unknown value: $line\n";
		    next;
		}
		$val = $v->[2]{$val};
	    }
	    $val = pack('N', $val);
	}
	elsif ($v->[1] eq 'ip') {
	    $val = inet_aton($val);
	}	
	$data .= pack('CC', $v->[0], length($val) + 2) . $val;
    }
    substr($data, 2, 2) = pack('n', length($data));
    $md5->reset;
    $md5->add($data, $secret);
    substr($data, 4, 16) = $md5->digest;
    $socket->send($data) or die "send: $!\n";
    $select->can_read(5) or die "select: $!\n";
    $socket->recv($data, 65536) or die "recv: $!\n";
    my($code,$rid,$len,$auth,$attr) = unpack('CCna16a*', $data);
    die "unexpected response: $code\n" unless $code == 5;
    die "unexpected response-id: $rid\n" unless $rid == $id;
    $id = ($id+1) & 255;
}