client_simulator/dhcpgen.pl

#!/usr/bin/perl 

use strict;
use JSON;
use Data::Dumper;
use Net::Pcap;
use Time::HiRes qw(usleep);
use Socket qw(AF_INET6 inet_ntop inet_ntoa);
use Switch;
use warnings;

$Data::Dumper::Sortkeys = 1;

my $c = loadconf(defined $ARGV[0] ? $ARGV[0] : "dhcpgen.conf");

my $recv = recv_setup();
my $send = send_setup();
my $cli = gen_clients();
my $ip2mac = { };

# print Dumper($cli); exit;

while(1) {
	my $recv_pkt = [ ];
	recv_work($recv, $recv_pkt);
	print Dumper($recv_pkt);

	# process received packets
	foreach my $pkt ( @{$recv_pkt} ) {
		pkt_work($pkt);
	}

	# check what clients have to send
#	foreach my $mac ( keys %{$cli} ) {
#		cli_work($mac);
#	}

	usleep $c->{sleep};
}

sub gen_clients {
	my %cl;
	my $toff = 2;
	for(my $i=0; $i<$c->{clients}{count}; $i++) {
		my $mac = sprintf("%s%06X", $c->{clients}{baseoui}, $i);

		$toff++ if !($i % $c->{clients}{rampup});

		$cl{$mac}{ipv4} = {
			dhcp => {
				state => 0,
				timer => time() + $toff,
				retry => 0,
			},
		} if $c->{clients}{ipv4};

		$cl{$mac}{ipv6} = {
			dhcp => {
				state => 0,
				timer => time() + $toff,
				retry => 0,
			},
		} if $c->{clients}{ipv6};

		$cl{$mac}{queue} = [ ];
	}
	return \%cl;
}

sub loadconf {
	my($file) = @_;

	my $x='';
	open(F,$file) || die "No such file '$file'";
	while(<F>) { $x.=$_; }
	close(F);

	return from_json($x);
}

sub recv_setup {
	my $err = '';

	my $pcap = pcap_open_live($c->{pcap}{interface}, $c->{pcap}{snaplen}, 100, 100, \$err);

	my $filter;

	if ( pcap_compile($pcap, \$filter, $c->{pcap}{filter}, 1, 0) ne 0 ) {
		die "pcap_compile failed -> filter -> '$c->{pcap}{filter}'";
	}

	pcap_setfilter($pcap, $filter);

	return $pcap;
}

sub send_setup {
	my $x = { };
	return $x;
}

sub recv_work {
	my($ctx, $ret) = @_;

	pcap_loop($ctx, $c->{maxpkt}, \&recv_work_pkt, $ret);
}

sub pkt_work {
	my ($pkt) = @_;

	print Dumper("received packet", $pkt);

	if ( exists $pkt->{arp} ) {
		my $dstmac = $pkt->{arp}{dst}{eth};
		my $dstip  = $pkt->{arp}{dst}{addr};
		if ( exists $cli->{$dstmac} ) {
			push @{$cli->{$dstmac}{queue}}, make_arp_reply($pkt);
		}
		elsif ( exists $ip2mac->{$dstip} ) {
			push @{$cli->{$ip2mac->{$dstip}}{queue}}, make_arp_reply($pkt);
		}
	}
	elsif ( exists $pkt->{dhcp} ) {
		my $mac = $pkt->{eth}{dst};
		if ( $pkt->{ip}{version} eq 4 ) {
			push @{$cli->{$mac}{queue}}, make_dhcp_reply($pkt) if exists $cli->{$mac};
		}
		elsif ( $pkt->{ip}{version} eq 6 ) {
			push @{$cli->{$mac}{queue}}, make_dhcp6_reply($pkt) if exists $cli->{$mac};
		}
	}
	elsif ( exists $pkt->{icmp} && $pkt->{ip}{version} eq 6 ) {
		my $mac = $pkt->{eth}{dst};
		push @{$cli->{$mac}{queue}}, make_icmp_reply($pkt) if exists $cli->{$mac};
	}
}

sub cli_work {
	my($mac) = @_;

	print "check client tasks for mac $mac\n";
	my $cl = $cli->{$mac};

	if ( exists $cl->{ipv4} ) {
		if ( $cl->{ipv4}{dhcp}{timer} < time() ) {
			# send discover
			if ( $cl->{ipv4}{dhcp}{state} eq 0 ) {
				push @{$cl->{queue}}, make_dhcp($mac,"DISCOVER");
			}
			# expect offer
			elsif ( $cl->{ipv4}{dhcp}{state} eq 1 ) {
			}
			# send request
			elsif ( $cl->{ipv4}{dhcp}{state} eq 2 ) {
			}
			# expect ack
			elsif ( $cl->{ipv4}{dhcp}{state} eq 3 ) {
			}

		}
	}

	if ( exists $cl->{ipv6} ) {
		if ( $cl->{ipv6}{dhcp}{timer} < time() ) {
			# send solicit
			if ( $cl->{ipv4}{dhcp}{state} eq 0 ) {
				push @{$cl->{queue}}, make_dhcp6($mac,"DISCOVER");
			}
			# expect advertise
			elsif ( $cl->{ipv4}{dhcp}{state} eq 1 ) {
			}
			# send request
			elsif ( $cl->{ipv4}{dhcp}{state} eq 2 ) {
			}
			# expect reply
			elsif ( $cl->{ipv4}{dhcp}{state} eq 3 ) {
			}
		}
	}

	print Dumper($cl);

	while((my $pkt = shift(@{$cl->{queue}}))) {
		send_pkt($pkt);
	}

}

sub recv_work_pkt {
	my($ret, $hdr, $pkt) = @_;

	if ( $hdr->{caplen} ne $hdr->{len} ) {
		die "ERROR truncated packet, caplen $hdr->{caplen} < len $hdr->{len}. Increase snaplen!\n";
	}

	print Dumper("header",$hdr);
	hexdump($pkt,"Packet");

	my $dec = recv_work_dec($hdr,$pkt);
	$dec->{hdr} = $hdr;
	push @{$ret}, $dec;

}

sub recv_work_dec {
	my($hdr,$pkt) = @_;
	my $d = { };

	my $offset = 0;
	$d->{eth}{dst}  = unpack("H12", substr($pkt, $offset, 6)); $offset+=6;
	$d->{eth}{src}  = unpack("H12", substr($pkt, $offset, 6)); $offset+=6;
	$d->{eth}{type} = unpack("H4",  substr($pkt, $offset, 2)); $offset+=2;

	# dot1q
	if ( $d->{eth}{type} eq '8100' ) {
		$d->{eth}{vlan} = unpack("n",substr($pkt,$offset,2)); $offset+=2;
		$d->{eth}{vlan} &= 0x0fff;
		$d->{eth}{type} = unpack("H4",substr($pkt, $offset, 2)); $offset+=2;
	}
	# q-in-q
	elsif ( $d->{eth}{type} eq '88a8' ) {
		$d->{eth}{ovlan} = unpack("n",substr($pkt,$offset,2)); $offset+=2;
		$d->{eth}{ovlan} &= 0x0fff;
		$offset+=2; #skip next ethertype, it's supposed to be 8100 but we don't care
		$d->{eth}{ivlan} = unpack("n",substr($pkt,$offset,2)); $offset+=2;
		$d->{eth}{ivlan} &= 0x0fff;
	}

	# ARP
	if ( $d->{eth}{type} eq '0806' ) {
		$d->{eth}{child} = 'arp';
		$d->{arp}{htype}  = unpack("n",  substr($pkt, $offset, 2)); $offset+=2;
		$d->{arp}{ptype}  = unpack("H4", substr($pkt, $offset, 2)); $offset+=2;
		$d->{arp}{hlen}   = unpack("C",  substr($pkt, $offset, 1)); $offset++;
		$d->{arp}{plen}   = unpack("C",  substr($pkt, $offset, 1)); $offset++;
		$d->{arp}{opcode} = unpack("n",  substr($pkt, $offset, 2)); $offset+=2;

		switch ($d->{arp}{opcode}) {
			case '1' { $d->{arp}{opcode} = 'request';         }
			case '2' { $d->{arp}{opcode} = 'reply';           }
			case '3' { $d->{arp}{opcode} = 'request reverse'; }
			case '4' { $d->{arp}{opcode} = 'reply reverse';   }
		}

		# error handling
		$d->{error} = 'ARP: non ethernet arp'                 if $d->{arp}{htype} ne 1;
		$d->{error} = 'ARP: non IPv4 arp'                     if $d->{arp}{ptype} ne '0800';
		$d->{error} = 'ARP: ethernet addr isnt 6 octets long' if $d->{arp}{hlen}  ne 6;
		$d->{error} = 'ARP: IPv4 isnt 4 octets long'          if $d->{arp}{plen}  ne 4;

		return $d if exists $d->{error};
		
		$d->{arp}{src}{eth} = unpack("H*",substr($pkt, $offset, $d->{arp}{hlen}));
		$offset += $d->{arp}{hlen};

		$d->{arp}{src}{addr} = inet_ntoa(substr($pkt, $offset, $d->{arp}{plen}));
		$offset += $d->{arp}{plen};

		$d->{arp}{dst}{eth} = unpack("H*",substr($pkt, $offset, $d->{arp}{hlen}));
		$offset += $d->{arp}{hlen};

		$d->{arp}{dst}{addr} = inet_ntoa(substr($pkt, $offset, $d->{arp}{plen}));
		$offset += $d->{arp}{plen};
	}
	# IPv4
	elsif ( $d->{eth}{type} eq '0800' ) {
		$d->{eth}{child} = 'ip';
		my $hdrpos = $offset;
		$d->{ip}{version} = ( unpack("C",substr($pkt,$offset,1)) & 0xf0 ) >> 4;
		$d->{ip}{hdr_len} = unpack("C",substr($pkt,$offset,1)) & 0x0f; $offset++;
		$offset++; # skip diffserv
		$d->{ip}{tot_len} = unpack("n",substr($pkt, $offset, 2)); $offset+=2;
		$offset+=5; # skip identification, flags, fragment offset, ttl
		$d->{ip}{proto} = unpack("C",substr($pkt, $offset, 1)); $offset++;
		$offset+=2; #skip checksum
		$d->{ip}{src} = inet_ntoa(substr($pkt, $offset, 4)); $offset+=4;
		$d->{ip}{dst} = inet_ntoa(substr($pkt, $offset, 4)); $offset+=4;

		# skip the IP options
		$offset = $hdrpos + ( $d->{ip}{hdr_len} * 4 );

		# UDP
		if ( $d->{ip}{proto} eq '17' ) {
			$d->{ip}{child} = 'udp';
			$d->{udp}{src} = unpack("n",substr($pkt, $offset, 2)); $offset+=2;
			$d->{udp}{dst} = unpack("n",substr($pkt, $offset, 2)); $offset+=2;
			$d->{udp}{len} = unpack("n",substr($pkt, $offset, 2)); $offset+=2;
			$offset+=2; #skip checksum

			# DHCP
			if ( $d->{udp}{dst} eq 67 or $d->{udp}{dst} eq 68 ) {
				$d->{udp} = 'dhcp';
				$d->{dhcp}{opcode} = unpack("C",substr($pkt, $offset, 1)); $offset++;
				$d->{dhcp}{htype}  = unpack("C",substr($pkt, $offset, 1)); $offset++;
				$d->{dhcp}{hlen}   = unpack("C",substr($pkt, $offset, 1)); $offset++;
				$offset++; #skip hop count
				$d->{dhcp}{transid}= unpack("H*",substr($pkt, $offset, 4)); $offset+=4;
				$offset+=4; # secs, flags
				$d->{dhcp}{ciaddr} = inet_ntoa(substr($pkt, $offset, 4)); $offset+=4;
				$d->{dhcp}{yiaddr} = inet_ntoa(substr($pkt, $offset, 4)); $offset+=4;
				$d->{dhcp}{siaddr} = inet_ntoa(substr($pkt, $offset, 4)); $offset+=4;
				$d->{dhcp}{giaddr} = inet_ntoa(substr($pkt, $offset, 4)); $offset+=4;

				$d->{dhcp}{haddr}  = unpack("H*",substr($pkt, $offset, $d->{dhcp}{hlen})); $offset += 16;
				$offset+=64; #skip hostname
				$offset+=128; #skip filename
				$offset+=4; #skip magic

				while($offset<$hdr->{caplen}) {
					my $t = unpack("C",substr($pkt, $offset, 1)); $offset++;
					next if $t eq 0;
					last if $t eq 255;
					my $l = unpack("C",substr($pkt, $offset, 1)); $offset++;
					my $v = substr($pkt, $offset, $l); $offset+=$l;

					if ( $t eq 1 ) {
						$d->{dhcp}{opt}{netmask} = inet_ntoa($v);
					}
					elsif ( $t eq 3 ) {
						$d->{dhcp}{opt}{gateway} = inet_ntoa($v);
					}
					elsif ( $t eq 51 ) {
						$d->{dhcp}{opt}{leasetime} = unpack("N",$v);
					}
					elsif ( $t eq 53 ) {
						$d->{dhcp}{opt}{type} = unpack("C",$v);
						switch ($d->{dhcp}{opt}{type}) {
							case 1 { $d->{dhcp}{opt}{type} = 'DISCOVER'; }
							case 2 { $d->{dhcp}{opt}{type} = 'OFFER'; }
							case 3 { $d->{dhcp}{opt}{type} = 'REQUEST'; }
							case 4 { $d->{dhcp}{opt}{type} = 'DECLINE'; }
							case 5 { $d->{dhcp}{opt}{type} = 'ACK'; }
							case 6 { $d->{dhcp}{opt}{type} = 'NAK'; }
							case 7 { $d->{dhcp}{opt}{type} = 'RELEASE'; }
						}
					}
				}
			}
		}
	}
	# IPv6
	elsif ( $d->{eth}{type} eq '86dd' ) {
		$d->{eth}{child} = 'ip';
		$d->{ip}{version} = ( unpack("C",substr($pkt,$offset,1)) & 0xf0 ) >> 4;
		$offset++;
		$offset+=3; #skip flow label
		$d->{ip}{len} = unpack("n",substr($pkt,$offset,2)); $offset+=2;
		$d->{ip}{proto} = unpack("C",substr($pkt,$offset,1)); $offset++;
		$offset++; #skip ttl
		$d->{ip}{src} = inet_ntop(AF_INET6, substr($pkt,$offset,16)); $offset+=16;
		$d->{ip}{dst} = inet_ntop(AF_INET6, substr($pkt,$offset,16)); $offset+=16;

		# ICMPv6
		if ( $d->{ip}{proto} eq 58 ) {
			$d->{ip}{child} = 'icmp';
			$d->{icmp}{type} = unpack("C",substr($pkt,$offset,1)); $offset++;
			$d->{icmp}{code} = unpack("C",substr($pkt,$offset,1)); $offset++;
			$offset+=2; #skip checksum

			if ( $d->{icmp}{type} >= 133 && $d->{icmp}{type} <= 136 ) {

				my $chd;

				switch ($d->{icmp}{type}) {
					case 133 {  $chd = 'rs'; }
					case 134 {  $chd = 'ra'; }
					case 135 {  $chd = 'ns'; }
					case 136 {  $chd = 'na'; }
				}


				if ( $chd eq 'ns' ) {
					$offset+=4; #skip reserved
					$d->{$chd}{dst_addr} = inet_ntop(AF_INET6,substr($pkt,$offset,16));
					$offset+=16;
				}
				elsif ( $chd eq 'ra' ) {
					$offset+=12; #skip the whole fixed header
				}
				elsif ( $chd eq 'na' ) {
					$offset+=4; # skip RSO and Reserved
					$d->{$chd}{dst_addr} = inet_ntop(AF_INET6,substr($pkt,$offset,16));
					$offset+=16;
				}
				elsif ( $chd eq 'rs' ) {
					$offset+=4; #skip reserved
				}

				while($offset<$hdr->{caplen}) {
					my $t = unpack("C",substr($pkt,$offset,1)); $offset++;
					my $l = 8 * unpack("C",substr($pkt,$offset,1)); $offset++;
					last if !$l;
					my $v = substr($pkt,$offset,$l-2); $offset+=$l-2;


					if ( $t eq 1 ) {
						$d->{$chd}{src_lladdr} = unpack("H*",$v);
					}
					elsif ( $t eq 2 ) {
						$d->{$chd}{dst_lladdr} = unpack("H*",$v);
					}
					elsif ( $t eq 13 ) {
						$d->{$chd}{timestamp}{sec} = hex(unpack("H12",substr($v, 6, 6)));
						$d->{$chd}{timestamp}{frac} = unpack("n",substr($v,12,2));
					}
					elsif ( $t eq 14 ) {
						$d->{$chd}{nonce} = unpack("H*",$v);
					}
					else {
						$d->{$chd}{opt}{$t} = unpack("H*",$v);
					}
				}
			}
		}
		# UDP
		elsif ( $d->{ip}{proto} eq 17 ) {
			$d->{ip}{child} = 'udp';
			$d->{udp}{src} = unpack("n",substr($pkt, $offset, 2)); $offset+=2;
			$d->{udp}{dst} = unpack("n",substr($pkt, $offset, 2)); $offset+=2;
			$d->{udp}{len} = unpack("n",substr($pkt, $offset, 2)); $offset+=2;
			$offset+=2; #skip checksum

			# DHCP
			if ( $d->{udp}{dst} eq 546 or $d->{udp}{dst} eq 547 ) {
				$d->{udp}{child} = 'dhcp';

				$d->{dhcp}{msgtype}       = unpack("C", substr($pkt,$offset,1)); $offset++;
				$d->{dhcp}{transactionid} = unpack("H*",substr($pkt,$offset,3)); $offset+=3;

				while($offset<$hdr->{caplen}) {
					my $t = unpack("n",substr($pkt,$offset,2)); $offset+=2;
					my $l = unpack("n",substr($pkt,$offset,2)); $offset+=2;
					my $v = substr($pkt,$offset,$l); $offset+=$l;

					$d->{dhcp}{opt}{$t} = unpack("H*",$v);
				}
				
			}
		}
	}

	return $d;
}

sub hexdump {
	my($bin, $name) = @_;

	my $len = length($bin);

	print "=== hexdump $name ===\n";
	print "=== len: $len\n";
	my $b=0;
	while($b<$len) {
		printf("0x%04x:", $b);
		# print hex part
		for(my $h=0; $h<16; $h++) {
			print " "  if !($h % 2);
			# read octet is within length range
			if ( $b+$h<$len ) {
				printf("%02x", unpack("C",substr($bin, $b+$h, 1)));
			} else {
				print "  ";
			}
		}
		print " ";
		# print chars
		for(my $h=0; $h<16; $h++) {

			my $c = 32; # default char

			if ( $b+$h < $len ) {
				$c = unpack("C",substr($bin, $b+$h, 1));
				# clear non-printable chars (46 is .)
				$c = 46 if ( $c < 33 || $c > 126 );
			}

			# print the char
			printf("%c", $c);
		}
		print "\n";
		$b+=16;
	}
	print "=====================\n";
}