#! /usr/bin/perl
#
#   File: gendhcp.p
# Author: Darin Davis, Copyright 1998
#   Date: 19 January 1998
# Update: 28 October 1998
#   Desc: gendhcp.p is designed to test the ability of a DHCP server
#	  to respond to a large number of DHCP client requests submitted
#	  in rapid succession.  Each DISCOVER message contains a unique:
#
#		- Hardware address (CHADDR), beginning with '0fffffff'
# 	  	  and ending with a unique 16-bit number (starting by
#		  default with 1).
#		- Client ID, identical to the hardware address
#		- XID, beginning with 'eeee' and ending with the same
#		  ending number as the hardware address
#		- Hostname, beginning with 'dhcp-client-' and ending
#		  with the same ending number as the hardware address
#		  except in decimal rather than hex
#
#	  The script logic can be outlined as follows:
#
#	  1 - Blast out all the DISCOVER msgs and optionally wait a
#	      user-specified number of seconds to give the server a chance
#	      to respond.
#
#	  2 - Send REQUESTS for all the OFFERs in my input socket.
#
#	  3 - Make note of any ACKs I receive.
#
#	  4 - If I haven't received all the OFFERs, then resend DISCOVERs
#	      for each DISCOVER as yet unOFFERed and optionally wait a
#	      user-specified number of seconds to give the server a chance
#	      to respond and go to step 2.
#
#	  5 - If I have received all the OFFERs but not all the ACKs, then
#	      resend a DISCOVER for each ACK I am missing and go to step 2.
#	      Note that this is a departure from the RFC which suggests the
#	      client should reREQUEST not reDISCOVER.  But the implementation
#	      was simpler this way.
#
#	      When the reDISCOVER is performed, the same XID is used.
#	      This can cause problems for later versions of the QIP DHCP
#	      server which have a configuration parameter "CheckTransactionID".
#	      This parameter defaults to TRUE, meaning that the server will
#	      not issue an address for a previously detected Transaction ID
#	      (XID)/MAC address tuple.  To suppress this behavior, set the
#	      "CheckTransactionID" policy to FALSE by putting the following
#	      into the dhcpd.pcy file:
#
#			CheckTransactionID=0
#
#	      Thanks to Gary DiFazio for providing this information about QIP.
#
#	  There are no timeouts in the script.  Only the optional wait.
#
#	  gendhcp.p simulates the four packet exchange DISCOVER-OFFER-
#	  REQUEST-ACK, and maintains two associative arrays, one for
#	  outstanding OFFERs and one for outstanding ACKs.  The arrays
#	  are indexed by the CHADDR of the DISCOVER packet.  gendhcp.p
#	  first blasts out all the DISCOVER messages, noting the CHADDRs
#	  in the Offers and Acks arrays, and then goes into a loop waiting
#	  for responses.  If it receives an OFFER, it sends a REQUEST and
#	  deletes the CHADDR from the Offers array.  If it receives an ACK,
#	  it deletes the CHADDR from the Acks array.  If there are no
#	  responses from a server to read but there are still outstanding
#	  OFFERs or ACKs, it reDISCOVERS everything in the Offers array (or
#	  if empty, the Acks array).  It continues this process until all
#	  ACKs have been received.
#
#	  Some DHCP servers send their OFFER messages to the IP broadcast
#	  address.  Others (such as NTS IPserver) address the OFFER to the
#	  IP address which it is offering.  Because the OFFER is not
#	  addressed to the machine on which you run gendhcp.p, gendhcp.p
#	  can't receive the offer.  So, to test a server of the latter
#	  variety, use the '-r' option.  This puts gendhcp.p in "relay
#	  agent" mode.  It puts your machine's address in the GIADDR field,
#	  convincing the unsuspecting DHCP server that your machine is
#	  actually a router.  So, the DHCP server addressees the OFFER to
#	  your machine.
#
#	  The author used tcpdump (on the same machine as gendhcp.p) in
#	  attempt to measure the effectiveness of the script.  tcpdump
#	  didn't capture all the packets sent and received.  Therefore,
#	  you would do well to use a standalone Sniffer-like device for
#	  any tracing.
#
# 	  gendhcp.p is intended for testing a single DHCP server.  If
#	  multiple DHCP servers are active, gendhcp.p will REQUEST only
#	  one IP address for a given hardware address (just as a normal
#	  DHCP client would).
#
#	  Developed for Linux with modifications for Solaris.
#
#  Usage: See &usage().


			########################
			### GLOBAL CONSTANTS ###
			########################

					# define which OS this is
if (system("test `uname` = SunOS") == 0) {
  $OS = "SunOS";
}
else { $OS = "Linux" }
#print "OS = $OS\n";

$AF_INET = 2;				# define address family

if ($OS eq "Linux") {			# Linux-specific definitions
  $SOCK_DGRAM = 2;			# define socket type
  $SO_BROADCAST = 6;
  $SOL_SOCKET = 1;
}
else {					# Solaris-specific definitions
  $SOCK_DGRAM = 1;			# define socket type
  $SO_BROADCAST = 32;
  $SOL_SOCKET = 65535;
}

$SOCKADDR_FMT = 'S n a4 x8';		# set pack format
$DHCP_SERVER_PORT = 67;
$DHCP_CLIENT_PORT = 68;
$MAX_LEN = 1024;			# max length of datagram
$FLAGS = 0;				# flags for recv()
$DISC_MAX = 65000;			# maximum number of discover msgs
					#   to be generated
$INADDR_ANY = pack("C4", split(/\./, "0.0.0.0"));
$SO_RCVBUF = 8;
$OPT_VAL = 1;
$TRUE = 1 == 1;
$DISC_MSG = 1;
$OFFER_MSG = 2;
$RQST_MSG = 3;
$ACK_MSG = 5;
$DELAY_MAX = 10;			# limit on how long to wait before
					#   reading server replies


			########################
			### GLOBAL VARIABLES ###
			########################

$Server_hostname = "255.255.255.255";	# default name of server host
$Server_pport;				# packed remote port number
@Server_ipaddr;				# server's IP address
@Client_ipaddr;				# my IP address
*CS;					# descriptor of socket bound to
					#   local DHCP client port
*SS;					# descriptor of socket bound to
					#   local DHCP server port
$Protocol_name;				# name of UDP protocol
$Protocol_aliases;			# aliases of UDP
$Protocol_number;			# UDP's protocol number
$Addr_family;				# client's address family
$Discover_count = 1;			# number of discover msgs to send
$Datagram;				# server's reply message
$Suppress_request = ! $TRUE;		# DO send requests
$Offer_cnt = 0;				# number of OFFERs received
$Ack_cnt = 0;				# number of ACKs received
$Relay = ! $TRUE;			# boolean flag: should I act like a
					#   BOOTP relay agent (by listening
					#   for offers on the BOOTPS port)?
$Haddr = 1;				# initial hardware address suffix
$Rc;					# Return Code for system calls
%Offers;				# outstanding (unreceived) OFFER msgs
%Acks;					# outstanding (unreceived) ACK msgs
@Start_times;				# user, system and elapsed start times
@End_times;				# user, system and elapsed end times
$Delay = 0;				# how long to wait before trying to
					#   read replies from server
$Retry = 0;				# how many times we have to reDISCOVER
$Last_ack_cnt = 0;			# last count of ACKs received
$Progress = ! $TRUE;			# boolean flag: should I show the
					#   number of ACKs received?

			###################
			### SUBROUTINES ###
			###################

					#####################################
					# defines functions needed to set
					# socket to non-blocking using fcntl
					#####################################
sub F_SETFL {4;}

if ($OS eq "Linux") {			# Linux-specific definition
  sub O_NONBLOCK {04000;}
}
else {					# Solaris-specific definition
  sub O_NONBLOCK {0x80;}
}
 
					###################################### 
					# creates socket and binds to
					# DHCP client port
					# GLOBAL VARS: Server_hostname,
					# Server_pport, Client_ipaddr, CS, SS
					###################################### 
sub setup_socket {
  local($client_hostname,		# name of this host
	$client_pport			# packed local port number
	);

  chop($client_hostname = `hostname`);	# get my hostname

					# get UDP's protocol number
  ($Protocol_name,$Protocol_aliases,$Protocol_number) = getprotobyname('udp');

					# get my IP address
  ($Protocol_name,$Protocol_aliases,$type,$len,@Client_ipaddr) = gethostbyname($client_hostname);

					# get server's IP address
  ($Protocol_name,$Protocol_aliases,$type,$len,@Server_ipaddr) = gethostbyname($Server_hostname);

					# define fully-specified port addrs
  $client_pport = pack($SOCKADDR_FMT, $AF_INET, $DHCP_CLIENT_PORT, $INADDR_ANY);
  $Server_pport = pack($SOCKADDR_FMT, $AF_INET, $DHCP_SERVER_PORT, $Server_ipaddr[0]);

					# create UDP socket
  socket(CS, $AF_INET, $SOCK_DGRAM, $Protocol_number) ||
	die("$0: cannot create CS socket ($!)");

					# set socket to non-blocking
  ($Rc = fcntl(CS, &F_SETFL, &O_NONBLOCK)) ||
	printf("error (%d) setting CS to non-blocking\n", $Rc);


					# enable send/recv broadcasts
  $Rc = setsockopt(CS, $SOL_SOCKET, $SO_BROADCAST, $OPT_VAL);
  if (! defined($Rc)) { print "error calling setsockopt(SO_BROADCAST) for CS\n"; }

					# bind to the socket
  bind(CS, $client_pport) || die("$0: cannot bind CS socket to DHCP client port ($!)");

					# setup extra socket in case we
					# have to act as the relay agent
  if ($Relay) {
    $client_pport = pack($SOCKADDR_FMT, $AF_INET, $DHCP_SERVER_PORT, $INADDR_ANY);

					# create UDP socket
    socket(SS, $AF_INET, $SOCK_DGRAM, $Protocol_number) ||
	die("$0: cannot create SS socket ($!)");

					# set socket to non-blocking
    ($Rc = fcntl(SS, &F_SETFL, &O_NONBLOCK)) ||
	printf("error (%d) setting SS to non-blocking\n", $Rc);

					# enable send/recv broadcasts
    $Rc = setsockopt(SS, $SOL_SOCKET, $SO_BROADCAST, $OPT_VAL);
    if (! defined($Rc)) { print "error calling setsockopt(SO_BROADCAST) for SS\n"; }

					# bind to the socket
    bind(SS, $client_pport) || die("$0: cannot bind SS socket to DHCP server port ($!)");
  }
}

					#####################################
					# builds and sends $discover_count
					# number of DHCP DISCOVER messages
					# GLOBAL VARS: CS, FLAGS, Server_pport
					# Haddr
					#####################################
sub send_discovers {
  local($discover_count) = @_;
  local($xid, $msg, $hostname, $hnlen, $tmp);

  $xid = $Haddr;			# initialize incremental variables

					# build and send DISCOVER messages
  while ($discover_count-- > 0) {

    $msg = sprintf("0fffffff%04x", $Haddr);
    $Offers{$msg} = $TRUE;		# this DISCOVER msg has an outstanding
					# OFFER msg
    $Acks{$msg} = $TRUE;		# this DISCOVER msg has an outstanding
					# ACK msg

					# op, htype, hlen, hops
    $msg = pack("H2" x 4, "01", "01", "06", "00");
					# xid, secs, flags
    $msg .= pack("H4 n H8", "eeee", $xid++, 0);
					# ciaddr, yiaddr, siaddr, giaddr
    if ($Relay) {
      $msg .= pack("H8 H8 H8 C4", 0, 0, 0, unpack("C4", $Client_ipaddr[0]));
    }
    else { $msg .= pack("H8 H8 H8 H8", 0, 0, 0, 0); }

					# chaddr
    $msg .= pack("H8 n H20", "0fffffff", $Haddr, 0);
    $msg .= pack("H384", "0");		# sname, file
    $msg .= pack("H8", "63825363");	# magic cookie
    $msg .= pack("H6", "350101");	# message type DISCOVER
					# client ID = chaddr
    $msg .= pack("H4 H8 n", "3d06", "0fffffff", $Haddr);

					### create unique hostname ###
    $tmp = sprintf("dhcp-client-%05d", $Haddr++);
    $hostname = "";
    while (length($tmp) > 0) {		# convert string to hex
      $hostname .= sprintf("%02x", ord($tmp));
      $tmp =~ s/^.//;
    }
    $hnlen = length($hostname);		# hostname length
    $msg .= pack("H2 C H$hnlen", "0c", $hnlen/2, "$hostname");

    $msg .= pack("H2", "ff");		# end of options
					# send msg
    send(CS, $msg, $FLAGS, $Server_pport);
  }
}
					#####################################
					# resends DHCP DISCOVER messages
					# for each HW addr in %Offers
					# GLOBAL VARS: CS, FLAGS, Server_pport
					# Haddr, Retry, Delay
					# RETURNS: number of DISCOVERs sent
					#####################################
sub rediscover {
  local($xid, $msg, $cnt, $hostname, $hnlen, $tmp);

  $cnt = 0;
  $Retry++;
					# build and send DISCOVER messages
  foreach $Haddr (keys %Offers) {
    $xid = $Haddr;
    $xid =~ s/^0fffffff//;		# behead MAC addr prefix

					# op, htype, hlen, hops
    $msg = pack("H2" x 4, "01", "01", "06", "00");
					# xid, secs, flags
    $msg .= pack("H4 n H8", "eeee", $xid, 0);
					# ciaddr, yiaddr, siaddr, giaddr
    if ($Relay) {
      $msg .= pack("H8 H8 H8 C4", 0, 0, 0, unpack("C4", $Client_ipaddr[0]));
    }
    else { $msg .= pack("H8 H8 H8 H8", 0, 0, 0, 0); }

					# chaddr
    $msg .= pack("H12 H20", $Haddr, 0);
    $msg .= pack("H384", "0");		# sname, file
    $msg .= pack("H8", "63825363");	# magic cookie
    $msg .= pack("H6", "350101");	# message type DISCOVER
					# client ID = chaddr
    $msg .= pack("H4 H12", "3d06", $Haddr);

					### create unique hostname ###
    $tmp = sprintf("dhcp-client-%05d", $xid);
    $hostname = "";
    while (length($tmp) > 0) {		# convert string to hex
      $hostname .= sprintf("%02x", ord($tmp));
      $tmp =~ s/^.//;
    }
    $hnlen = length($hostname);		# hostname length
    $msg .= pack("H2 C H$hnlen", "0c", $hnlen/2, "$hostname");

    $msg .= pack("H2", "ff");		# end of options

					# send msg
    send(CS, $msg, $FLAGS, $Server_pport);
    $cnt++;				# incr count of msgs sent
  } 

  if ($Delay > 0) { sleep($Delay); }	# give server a chance to respond
  return($cnt);
}
					###################################
					# builds and sends a single DHCP
					# REQUEST message (if the message
					# from the server is an OFFER not
					# an ACK)
					# GLOBAL VARS: CS and almost every
					# other "local" var used herein
					# RETURNS: DHCP msg type
					###################################
sub send_request {
  local($datagram) = @_;
  local($server_id, $msg_type, $tmp_chaddr,
	$client_id, $tmp, $hostname, $hnlen);

  $msg_type = 0;			# init local vars
  $server_id = "";

  $DHCP_STRUCT = "H2 H2 H2 H2 H8 H4 H4 H8 H8 H8 H8 H32 H384 H8 H*";
  ($op, $htype, $hlen, $hops, $xid, $secs, $flags, $ciaddr, $yiaddr, $siaddr, $giaddr, $chaddr, $sname_file, $cookie, $options) = unpack($DHCP_STRUCT, $datagram);

  $tmp_opt = $options;
  $tmp_chaddr = substr($chaddr, 0, 12); # trunc trailing zeros

					# determine whether this is an ACK
					# or OFFER by searching through
					# options
  while (length($tmp_opt) > 3) {
					# ASSUMES no pad options!
    $option = substr($tmp_opt, 0, 2);	# extract option
    $length = substr($tmp_opt, 2, 2);	# extract length
					# extract value
    $value = substr($tmp_opt, 4, 2 * hex($length));
					# behead leading option
    $tmp_opt = substr($tmp_opt, 4 + 2 * hex($length));

    if ($option eq "35") {		# if this is DHCP_Msg_Type option 
      $msg_type = hex($value);
      if ($msg_type == $ACK_MSG) {	# if this is an ACK

					# if I haven't yet seen this addr's ACK
	if (defined($Acks{$tmp_chaddr})) {
	  delete($Acks{$tmp_chaddr});	# remove addr from ACK list
	  $Ack_cnt++;			# increment number of ACKs recv'd
	}
	return($msg_type);		# stop processing
      }

      if ($msg_type != $OFFER_MSG) {	# if this is NOT an OFFER
	return($msg_type);		# then stop processing
      }
    }

    if ($option eq "36") {		# if this is Server_ID option 
      $server_id = $value;
    }
  }

  if ($msg_type != $OFFER_MSG) {	# there was no DHCP_Msg_Type option
    return($msg_type);			#   so stop processing
  }
					# this addr no longer has an
					# outstanding OFFER
  if (defined($Offers{$tmp_chaddr})) {
    delete($Offers{$tmp_chaddr});	# remove addr from list
    $Offer_cnt++;			# increment number of OFFERs recv'd
  }
  else { return($msg_type); }

  $rqst_msg = "350103";			# build REQUEST message type
  $addr_rqst = "3204$yiaddr";		# build address request
  if ($server_id) {
    $srvr_id = "3604$server_id";	# server identifier
  }
  else { $srvr_id = "3604$siaddr"; }

  $client_id = "3d06$tmp_chaddr";	# client identifier

					### create unique hostname ###
  $tmp_chaddr =~ s/^0fffffff//;		# behead prefix
  $tmp = sprintf("dhcp-client-%05d", hex($tmp_chaddr));
  $hostname = "";
  while (length($tmp) > 0) {		# convert string to hex
    $hostname .= sprintf("%02x", ord($tmp));
    $tmp =~ s/^.//;
  }
  $hnlen = length($hostname);		# hostname length
  $hostname = sprintf("0c%02x$hostname", $hnlen/2);

  $end_opt = "ff";			# end of options

  $datagram = pack($DHCP_STRUCT, "01", $htype, $hlen, $hops, $xid, $secs, $flags, $ciaddr, "00000000", "00000000", $giaddr, $chaddr, $sname_file, $cookie, "$rqst_msg$addr_rqst$srvr_id$client_id$hostname$end_opt");

					# send REQUEST msg
  send(CS, $datagram, $FLAGS, $Server_pport);

  return($msg_type);
}
					#########################
					# prints program usage
					#########################
sub usage {
  print <<END_USAGE;

Usage: $0 <flag> <value>

\tFlags\tValues
\t-a\tstarting hardware Address (default: 1)
\t-d\tnumber of Discover messages to send (default: 1)
\t-h, -?\tshow Help
\t-p\tshow Progress (number of ACKs received)
\t-r\tact like a Relay agent
\t-R\tsuppress sending REQUEST messages
\t-s\tServer hostname or IP address (default: broadcast)
\t-w\tWait time (in seconds) between retries (default: 0)

END_USAGE

  exit;
}

			#################
			### MAIN CODE ###
			#################

$| = 1;					# flush writes

					# ensure we're root so we can
					# bind to priviledged sockets
chomp($USER = `whoami`);
if ($USER ne "root") {
  print "\n\t*** You must be root to run this program. ***\n";
  &usage;
}

					# process arguments
while($#ARGV >= 0) {
  ARG_SWITCH: {
    if ($ARGV[0] =~ /^(-h|-\?)$/) { &usage; }

					# show progress
    if ($ARGV[0] =~ /^-p$/) {
	shift(@ARGV);			# discard flag
	$Progress = $TRUE;
	last ARG_SWITCH;
    }
					# don't send request messages
    if ($ARGV[0] =~ /^-R$/) {
	shift(@ARGV);			# discard flag
	$Suppress_request = $TRUE;
	last ARG_SWITCH;
    }
					# act as a relay agent
    if ($ARGV[0] =~ /^-r$/) {
	shift(@ARGV);			# discard flag
	$Relay = $TRUE;
	last ARG_SWITCH;
    }
					# user specified server
    if ($ARGV[0] =~ /^-s$/) {
	shift(@ARGV);			# discard flag
	$Server_hostname = $ARGV[0];
	shift(@ARGV);			# discard server hostname
	last ARG_SWITCH;
    }
					# user specified DISCOVER count
    if ($ARGV[0] =~ /^-d$/) {
	shift(@ARGV);			# discard flag
	$Discover_count = $ARGV[0];
	if ($Discover_count < 1 || $Discover_count > $DISC_MAX) {
	  print "Discover count must be between 1 and $DISC_MAX.\n";
	  exit;
	}
	shift(@ARGV);			# discard server hostname
	last ARG_SWITCH;
    }
					# user specified Wait time
    if ($ARGV[0] =~ /^-w$/) {
	shift(@ARGV);			# discard flag
	$Delay = $ARGV[0];
	if ($Delay < 0 || $Delay > $DELAY_MAX) {
	  print "Wait time be between 0 and $DELAY_MAX.\n";
	  exit;
	}
	shift(@ARGV);			# discard Wait time
	last ARG_SWITCH;
    }
					# user specified starting HW addr
    if ($ARGV[0] =~ /^-a$/) {
	shift(@ARGV);			# discard flag
	$Haddr = $ARGV[0];
	if ($Haddr < 1 || $Haddr > $DISC_MAX) {
	  print "Starting hardware address must be between 1 and $DISC_MAX.\n";
	  exit;
	}
	shift(@ARGV);			# discard server hostname
	last ARG_SWITCH;
    }
    print "Unknown flag '$ARGV[0]'.\n";
    exit;
  }
}
					# create socket capable of broadcasts
&setup_socket($Server_hostname);

					# get the start user, system, and...
($Start_times[0], $Start_times[1], $junk, $junk) = times;
$Start_times[2] = time;			# ...absolute times

					# blast out all the DISCOVER msgs
print "Sending $Discover_count DISCOVER messages...\n";
&send_discovers($Discover_count);

if ($Delay > 0) { sleep($Delay); }	# give server a chance to respond

if ($Suppress_request) { exit; }	# should I process the OFFER msgs?

					# yes
print "Waiting for $Discover_count ACKs...\n";
while ($Ack_cnt < $Discover_count) {

					# if I'm supposed to report progress
					# then do so
  if ($Progress) {
    if (($Ack_cnt % 10) == 0 && $Ack_cnt > $Last_ack_cnt) {
      print "$Ack_cnt ACKs...\n";
      $Last_ack_cnt = $Ack_cnt;
    }
  }
					# receive the OFFER/ACK msg
  if ($Relay) {
    $Rc = recv(SS, $Datagram, $MAX_LEN, $FLAGS);
  }
  else { $Rc = recv(CS, $Datagram, $MAX_LEN, $FLAGS); }

  if (! defined($Rc)) {			# if no more incoming messages
					# to process
    if ($Offer_cnt < $Discover_count) {
      &rediscover;
    }
    else {				# we've received all the OFFERs

      if ($Ack_cnt < $Discover_count) { # if we're missing some ACKs
	%Offers = %Acks;		# then reDISCOVER (rather than
					# reREQUEST as advised in RFC2131;
					# this choice is for the sake of
					# simplicity in this program)
	$Offer_cnt = $Ack_cnt;
	&rediscover;
      }
    }
  }
  else {				# I have a reply to process
    &send_request($Datagram);		# send the REQUEST msg
  }
}
					### print statistics ###

print "Received $Ack_cnt Acks.\n";

					# get the ending user, system, and...
($End_times[0], $End_times[1], $junk, $junk) = times;
$End_times[2] = time;			# ...absolute times

printf("\nTimes: %.2f user, %.2f system, %d elapsed\n",
	$End_times[0] - $Start_times[0],
	$End_times[1] - $Start_times[1],
	$End_times[2] - $Start_times[2]);

print "Number of reDISCOVERies: $Retry\n";

close(CS);				# close client socket

if ($Relay) { close(SS); }		# close server socket