dhcp_protect/bin/perftest.pl

#!/usr/bin/perl

use strict;
use IO::Socket::INET;
use IO::Socket::INET6;
use Time::HiRes qw(sleep);
use warnings;

$| = 1;



my($clients, $leasetime, $floodclients, $floodpps, $dest, $destport) = @ARGV;

usage() if !defined $destport;

if ( $clients !~ /^\d+$/ || $clients < 1 ) {
	print STDERR "clients count must be a positive integer\n";
	exit 1;
}

if ( $leasetime !~ /^\d+$/ || $leasetime < 3 ) {
	print STDERR "leasetime must be at least 3\n";
	exit 1;
}

if ( $floodclients !~ /^\d+$/ || $floodclients < 0 ) {
	print STDERR "floodclients must be a 0 or more\n";
	exit 1;
}

if ( $floodpps !~ /^\d+$/ || $floodpps < 0 ) {
	print STDERR "floodpps must be 0 or more\n";
	exit 1;
}

if ( $dest !~ /^(\d+\.\d+\.\d+\.\d+)$/ && $dest !~ /^[0-9a-fA-F:]+$/ ) {
	print STDERR "destination IP must be a valid IPv4/IPv6 address\n";
	exit 1;
}

if ( $destport !~ /^\d+$/ || $destport < 1 || $destport > 65535 ) {
	print STDERR "destport must be between 1 and 65535\n";
	exit 1;
}

main($clients, $leasetime, $floodclients, $floodpps, $dest, $destport);

sub usage {
	print STDERR <<EOF;

==============================================
= DHCP Protect testing client                =
= This is only to test dhcp_protect          =
= DO NOT SEND THIS TO YOUR DHCP SERVER !!!!  =
==============================================

Usage: $0 <clients> <leasetime> <floodclients> <floodpps> <destination> <port>

clients      : number of 'normal' dhcp clients to simulator.
leasetime    : the desired leasetime.
floodclients : number of client flood the server.
floodpps     : packet rate at which the floodclients flood the server (per client).
destination  : target IP address.
port         : targer UDP port.
EOF
	exit 1;
}


sub main {
	my($clients, $leasetime, $floodclients, $floodpps, $dest, $destport)=@_;

	my $hdr = "";
	my $sock;

	if ( $dest =~ /:/ ) { # IPv6
		$sock = IO::Socket::INET6->new(
			Proto => 'udp',
			PeerAddr => $dest,
			PeerPort => $destport,
		);

		$hdr .= pack("H2", "01"); # msg-type
		$hdr .= pack("H6", "000000"); # transaction-id
		$hdr .= pack("n", 1); # DUID option
		$hdr .= pack("n", 6); # DUID length
	}
	else { # IPv4
		$sock = IO::Socket::INET->new(
			Proto => 'udp',
			PeerAddr => "$dest:$destport",
		);
		# pseudo packet, the only really relevant thing
		# is that option 82 is present and at the right place
		$hdr .= pack("H2","01"); # Opcode, bootrequest
		$hdr .= pack("H2","01"); # Hardware type, ethernet
		$hdr .= pack("H2","06"); # HW addr len, MAC = 6
		$hdr .= pack("H2","01"); # hops, 1 relay
		$hdr .= pack("H8","00000000"); # transaction ID
		$hdr .= pack("H4","0000"); # secs
		$hdr .= pack("H4","0000"); # flags
		$hdr .= pack("H8","00000000"); # ciaddr
		$hdr .= pack("H8","00000000"); # yiaddr
		$hdr .= pack("H8","00000000"); # siaddr
		$hdr .= pack("H8","00000000"); # giaddr
		$hdr .= pack("H32","0"x32); # cihwaddr
		$hdr .= pack("H128","0"x128); # hostname
		$hdr .= pack("H256","0"x256); # boot filename
		$hdr .= pack("H8","63825363"); # magic cookie

		$hdr .= pack("C", 82); # opt 82
		$hdr .= pack("C", 21); # opt 82 len
		$hdr .= pack("C", 1); # subopt 1 (circuitid)
		$hdr .= pack("C", 11); # subopt 1 len
		$hdr .= "Hello World";
		$hdr .= pack("C", 2); # subopt 2 (remoteid)
		$hdr .= pack("C", 6); # subopt 2 len (mac)
	}




	if ( $floodclients > 0 ) {
		my $pid = fork();
		# flood client
		if ( !$pid ) {

			my $int = 1/$floodpps/$floodclients;

			while(1) {
				for(my $i=0; $i<$floodclients; $i++) {
					my $pkt = $hdr;
					$pkt .= pack("H12", sprintf("66666666%04x", $i));
					$sock->send($pkt);
					sleep($int);
				}
			}
			exit;
		}
	}

	my $int = $leasetime/3/$clients;

	while(1) {
		for(my $i=0; $i<$clients; $i++) {
			my $pkt = $hdr;
			$pkt .= pack("H12", sprintf("00112233%04x",$i));
			$sock->send($pkt);
			sleep($int);
		}
	}
}