#!/usr/bin/perl

use strict;
use IO::Socket;
use Getopt::Std;
use POSIX;
use Socket;

my $server_sock;
my $message;
my $remote_host;
my $BOOTP_REQUEST= 1;
my @BOOTP_FIELDS_IN_ORDER= ('op', 'htype', 'hlen', 'hops', 'xid', 'secs', 'flags', 'ciaddr', 'yiaddr', 'siaddr', 'giaddr', 'chaddr', 'sname', 'file', 'vend');
my @BOOTP_FIELDS_IN_ORDER_DISPLAY= ('n_op', 'n_htype', 'n_hlen', 'n_hops', 'n_xid', 'n_secs', 'n_flags', 'ciaddr', 'yiaddr', 'siaddr', 'giaddr', 'chaddr', 'sname', 'file', 'vend');
my $BOOTP_PACK_STRING= "a1 a1 a1 a1 a4 a2 a1 x1 a4 a4 a4 a4 a16 A64 A128 a64";
my $bootp_request;
my $bootptab;
my $logfile;
my $file;
my %options;
my $log_count= 0;
my $pid;
my $var_dir= '/var/nimol_bootreplyd';
my $pid_file= "$var_dir/pid";
my $processing= 0;
my @signal_queue;
my $signal_received= 0;
my @MAGIC_COOKIE= (99, 130, 83, 99);
my $server_name;
#lists below are [ vendor_code, delimiter ] for each supported bootptab entry, delimiter determines whether 
#the entry should be packed as a list of bytes (delimited by the delimiter) or a null-terminated string
#(empty string delimiter)
my %VENDOR_MAPPINGS= ( 'sm' => [1, '\.'],
					   'gw' => [3, '\.'],
					   'hostname' => [12, '']
					 );
my %NETWORK_TYPES= ( 'ethernet' => 1 ); #as specified in RFC 951
										#this implementation will only support ethernet for now

#----------MAIN----------------

getopts("f:lds:", \%options) or die "nimol_bootreplyd: usage: nimol_bootreplyd [-f bootptab] [-h server_addr] [-l] [-d]\n";

$file= $options{f} ? $options{f} : '/etc/nimoltab';
$logfile= "$var_dir/log" if $options{l};

if ($options{s})
{
	$server_name= $options{s};

	unless ($server_name =~ /^(?:[0-9]{1,3}\.){3}[0-9]{1,3}$/)
	{
		my $ip;
		$ip= (gethostbyname($server_name))[4];
		die "Couldn't resolve host $server_name: $!\n" unless ($ip);

		$server_name= inet_ntoa($ip);
	}
}

mkdir $var_dir unless (-d $var_dir);
&log_entry('msg', "================>>nimol_bootreplyd log started");

#read in the bootptab file
$bootptab= &read_bootptab($file);

#run as a daemon process?  if so fork and kill the parent
if ($options{d})
{
	#get ready to dissociate from terminal- cwd=/ , redirect stdin/out from/to /dev/null
	chdir '/' or die "/: $!\n";
        open (STDIN, "/dev/null") or die "/dev/null: $!\n";
	open (STDOUT, ">/dev/null") or die "/dev/null: $!\n";
        open (STDERR, ">/dev/null") or die "/dev/null: $!\n";

	$pid= fork;
	die "nimol_bootreplyd: fork error- could not start daemon process\n" unless (defined $pid);
	exit 0 if ($pid);

	#disassociate from the parent's terminal
	POSIX::setsid or die "nimol_bootreplyd: Cannot start a new session: $!\n";
}

#write pid to file
open PID, ">$pid_file" or die "nimol_bootreplyd: Could not open $pid_file: $!\n";
print PID "$$";
close PID;

#signal handlers
$SIG{HUP}= $SIG{INT}= $SIG{QUIT}= $SIG{TERM}= \&signal_handler;

#bind to UDP port 67
if ($server_name)
{
	$server_sock= IO::Socket::INET->new(LocalPort => 67, Proto => 'udp', LocalAddr => $server_name, ReuseAddr => 1) or die "nimol_bootreplyd: socket: $@\n";
}
else
{
	$server_sock= IO::Socket::INET->new(LocalPort => 67, Proto => 'udp') or die "nimol_bootreplyd: socket: $@\n";
}

#loop forever reading messages
while (1)
{
	$signal_received= 0;

	unless ($server_sock->recv($message, 1024))
	{
		# check if system call was interrupted by a signal
		next if ($signal_received); # no error if interrupted system call
		last; #error if you're here
	}

	$signal_received= 0; 
	$processing= 1; #queue signals for later
	my ($port, $ip)= sockaddr_in($server_sock->peername);
	my $remote_host= gethostbyaddr($ip, AF_INET);
	my $entry;

	#ignore requests that didn't originate from port 68 and shorter than 300 bytes
	next if ($port != 68 || length($message) < 300);

	#parse the binary request data into perl strings
	$bootp_request= &extract_bootp_fields($message);
	&log_entry('request', $bootp_request, $ip);

	#find matching entry in bootptab
	$entry= &process_bootp_request($bootp_request);

	#send bootp reply if there is a matching entry in bootptab
	&send_bootp_reply($entry, $bootp_request) if ($entry);

	$processing= 0; #now we can handle signals
	&signal_handler('all');  # execute any queued signals
}

#socket error if we ever get here
die "nimol_bootreplyd: recv: $!\n";

#params- SCALAR(bootptab filename)
sub read_bootptab
{
    my $file= shift;
    my @line;
    my @field;
	my @all_entries;

    open(BOOTPTAB, "$file") or die "nimol_bootreplyd: Error opening $file : $! \n";

    while (<BOOTPTAB>)
    {
		my %bootptab_entry= (); #allocate new memory

		chomp;
        s/#.*$//;
        if ($_)
        {
            @line= split /:/, $_;
            $bootptab_entry{hostname}= shift @line;

            foreach (@line)
            {
                @field= split /=/, $_;
				$field[1]= lc $field[1] if ($field[0] eq "ha");
                $bootptab_entry{$field[0]}= $field[1];
            }

			#minimum required fields- ip,ht,bf,sa
			if ($bootptab_entry{ip} =~ /\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}/ && $bootptab_entry{sa} =~ /\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}/ && $bootptab_entry{ht} && $bootptab_entry{bf})
			{
				push @all_entries, \%bootptab_entry;
				&log_entry('bootptab_entry', \%bootptab_entry);
			}
		}
    }

	close BOOTPTAB;

	#die "nimol_bootreplyd: No valid bootptab entries. Terminating server...\n" unless (@all_entries > 0);

    \@all_entries;
}

#params: REF(hash bootp request)
sub process_bootp_request
{
    my $request= shift;
	my $haddr= "";
	my $ciaddr= "";
	my $hostname= "";
	my $the_one;

	$haddr= $request->{chaddr};
	$ciaddr= $request->{ciaddr};
	$hostname= $request->{hostname};

	#first- try to match hardware address
	#if hardware address is not found AND ciaddr is given:
	#   try to match ip with what's in ciaddr ONLY IF the entry does not have a hw addr defined

	if ($haddr)
	{
		foreach (@{$bootptab})
		{
			if ($_->{ha} eq $haddr)
			{
				#also make sure we support the requested net adapter type
				$the_one= $_ if ($request->{n_htype} == $NETWORK_TYPES{$_->{ht}});
			}
		}

		if (! $the_one && $ciaddr)
		{
			foreach (@{$bootptab})
			{
				#also make sure we support the requested net adapter type
				$the_one= $_ if ($_->{ip} eq $ciaddr && ! $_->{ha} && $request->{n_htype} == $NETWORK_TYPES{$_->{ht}});
			}
		}
	}

	$the_one;
}

#params- REF(hash bootptab entry), REF(hash bootp request)
sub send_bootp_reply
{
	my $entry= shift;
	my $request= shift;
	my $reply;
	my @pack_list= ();
	my %bootp_reply= %{$request};
	my @vfield_list;
	my $vendor_fields= pack "C1 C1 C1 C1", @MAGIC_COOKIE;
	my $dest_addr;
	my $dest_port= 68;
	my $server_hostname;
	my $socket;
	my $sockerr= 0;
	my $each;
	my $perm_arp_entry= "";
	my $new_arp_entry= "";
	my $arp_ip;
	my $perm= 0;
	my $broadcast= 0;

	return unless ($entry);

	$server_hostname= gethostbyaddr(inet_aton($entry->{sa}), AF_INET) if ($entry->{sa});

	#build the hash representing the BOOTREPLY
	
	$bootp_reply{op}= chr(2);
	$bootp_reply{siaddr}= $entry->{sa};
	$bootp_reply{yiaddr}= $entry->{ip};
	$bootp_reply{file}= $entry->{bf};
	$bootp_reply{sname}= $server_hostname ? $server_hostname : "";

	#set vendor fields
	foreach $each (keys %{$entry})
	{
		#if there is a field number associated with this field in bootptab
		#then include field_num => field_val into the reply
		#
		#example: sm=255.255.255.0 would give 1 => 255.255.255.0
		#%vendor_fields{$VENDOR_MAPPINGS{$each}->[0]}= $entry->{$each} if ($VENDOR_MAPPINGS{$each});

		#vendor fields take on the following form in binary

		#1 byte= code, 1 byte=length, n bytes= data (size of n specified in previous byte)

		if ($VENDOR_MAPPINGS{$each})
		{
			#array positions in VENDOR_MAPPINGS- see the comment above its declaration in the global scope
			my $length;
			my $fmt= $VENDOR_MAPPINGS{$each}->[1] ? "C1" : "a1"; #pack as a byte array? or a string?

			$vendor_fields.= chr($VENDOR_MAPPINGS{$each}->[0]); #vendor field code
			
			@vfield_list= split /$VENDOR_MAPPINGS{$each}->[1]/, $entry->{$each};
			$length= @vfield_list;
			$vendor_fields.= chr($length); #field length (bytes)

			$vendor_fields.= pack "$fmt" x $length, @vfield_list;  #pack field byte by byte
		}
	}

	#vendor fields ends with a 255
	$vendor_fields.= chr(255);

	#figure out the address to send it to (see RFC 1542)

	if ($request->{ciaddr})
	{
		$dest_addr= $request->{ciaddr};
	}
	elsif ($request->{giaddr})
	{
		$dest_addr= $request->{giaddr};
		$dest_port= 67;
	}
	elsif ($request->{n_flags})
	{
		$dest_addr= inet_ntoa(INADDR_BROADCAST);
		$broadcast= 1;
	}
	else
	{
		$dest_addr= $bootp_reply{yiaddr};

		#in this case, RFC 1542 says you must specify a link layer address, so here goes...

		#if there's an arp entry for yiaddr, remove it from the arp cache, and save it for later if it's permanent
		($arp_ip, $perm)= &read_arp_entry($bootp_reply{chaddr});
		
		if ($arp_ip)
		{
			$perm_arp_entry= $arp_ip if ($perm);

			if (&remove_arp_entry($arp_ip))
			{
				#error removing the entry
				&log_entry('msg', "Error removing arp entry for $arp_ip");
				return 3;
			}
		}

		#create a static arp entry for yiaddr
		if (&add_arp_entry($dest_addr, $bootp_reply{chaddr}))
		{
			#error adding the arp entry
			&log_entry('msg', "Error adding arp entry $dest_addr -> $bootp_reply{chaddr}");
			return 4;
		}
		else
		{
			$new_arp_entry= $dest_addr;
		}
	}

	#build and send the reply, convert each field to binary
	$bootp_reply{siaddr}= inet_aton($bootp_reply{siaddr});
	$bootp_reply{ciaddr}= inet_aton($bootp_reply{ciaddr});
	$bootp_reply{giaddr}= inet_aton($bootp_reply{giaddr});
	$bootp_reply{yiaddr}= inet_aton($bootp_reply{yiaddr});
	$bootp_reply{chaddr}= pack "H16", $bootp_reply{chaddr};
	$bootp_reply{file}= pack "Z128", $bootp_reply{file};
	$bootp_reply{sname}= pack "Z64", $bootp_reply{sname};
	$bootp_reply{vend}= pack "Z64", $vendor_fields;

	foreach $each (@BOOTP_FIELDS_IN_ORDER)
	{
		push @pack_list, $bootp_reply{$each};
	}

	$reply= pack $BOOTP_PACK_STRING, @pack_list;

	#now send the reply out
	$socket= IO::Socket::INET->new(Proto => 'udp', PeerPort => $dest_port, PeerAddr => $dest_addr, Broadcast => $broadcast) or $sockerr= 1;

	if (defined $socket)
	{
		$socket->send($reply) or $sockerr= 2;
	}
	else
	{
		#the socket creation function could return true and an undefined socket, which is still an error
		$sockerr= 1;
	}

	if ($sockerr == 0) { &log_entry('reply', $entry, $reply, $dest_addr); } #xmit success
	elsif ($sockerr == 1) { &log_entry('msg', "ERROR connecting to $dest_addr , port $dest_port"); }
	elsif ($sockerr == 2) { &log_entry('msg', "ERROR sending reply to $dest_addr , port $dest_port"); }

	#remove static arp entry if one was created
	if ($new_arp_entry)
	{
		&log_entry('msg', "Error removing arp entry for $arp_ip after xmit attempt") if (&remove_arp_entry($new_arp_entry));

		#restore previous static arp entry if one was defined
		if ($perm_arp_entry)
		{
			&log_entry('msg', "Error restoring permanent arp entry $perm_arp_entry -> $bootp_reply{chaddr} after xmit attempt") if (&add_arp_entry($perm_arp_entry, $request->{chaddr}));
		}
	}

	$sockerr;
}

#params- SCALAR(entry type), see below for the rest
sub log_entry
{
	my $type= shift;  # type can be 'msg' 'request' 'reply' 'bootptab_entry'
	my $message= "";
	my $each;
	my $bootp_packet;

	#make sure logging was turned on the the cmd line
	return unless ($logfile);

	#clear log every 1000 entries, to prevent log flooding
	if ($log_count >= 1000)
	{
		$log_count= 0;
		open(LOG, ">$logfile") or die "nimol_bootreplyd: Could not open log file $logfile: $!\n";
		print LOG "==========>> log reached 1000 entries, cleared at ".scalar(localtime)."\n\n";
		close LOG;
	}

	#post an aribtrary message string to the log
	if ($type eq 'msg')
	{
		$message= $_[0];
	}
	#post a bootptab entry that was just read in
	elsif ($type eq 'bootptab_entry')
	{
		# PARAMS ref
		#        ^bootptab entry

		$message= "Read this bootptab entry from $file : ";

		foreach $each (keys %{$_[0]})
		{
			$message.= $each."=".$_[0]->{$each}.":";
		}

		chop $message;
	}
	#post a valid BOOTREQUEST packet we just received- means that we checked our bootptab against it
	elsif ($type eq 'request')
	{
		#PARAMS REF,     SCALAR
		#		^request ^source IP
		#		 fields   address

		my $host;
		$host= gethostbyaddr($_[1], AF_INET) if ($_[1]);
		$host= $_[1] unless ($host);

		$message= "Received BOOTREQUEST from $host : ";

		#show fields of BOOTREQEST
		foreach $each (@BOOTP_FIELDS_IN_ORDER_DISPLAY)
		{
			$message.= $each."=".$_[0]->{$each}.",";
		}

		chop $message;
	}
	#post the details of any BOOTREPLY packet we send back out-
	#show its matching bootptab entry, its fields as formatted text,
	#and its fields in raw hex numbers byte by byte
	elsif ($type eq 'reply')
	{
		#PARAMS REF,      SCALAR, SCALAR
		#       ^matching ^bootp  ^destination
		#        bootptab  reply   IP address
		#		 entry     msg

		my $host= "";
		$host= gethostbyaddr($_[2], AF_INET) if ($_[2]);
		$host= $_[2] unless ($host);

		$message= "Sending BOOTREPLY to $host :\n";
		$message.= "   Matching bootptab entry: ";

		#show fields from matching bootptab entry
		foreach $each (keys %{$_[0]})
		{
			$message.= $each."=".$_[0]->{$each}.":";
		}
		chop $message;

		#show fields of BOOTREPLY
		$message.= "\n   BOOTREPLY:";
		$bootp_packet= &extract_bootp_fields($_[1]);
		foreach $each (@BOOTP_FIELDS_IN_ORDER_DISPLAY)
		{
			$message.= $each."=".$bootp_packet->{$each}.",";
		}
		chop $message;

		#show raw data in hex
		my $hex_num= unpack "H600", $_[1];
		$hex_num =~ s/([\da-f]{2})/$1../g;
		$message.= "\n   HEX:\n";
		$message.= $hex_num;
	}
	else
	{
		return;
	}

	$log_count++;

	open LOG, ">>$logfile" or die "nimol_bootreplyd: Could not open log file $logfile: $!\n";
	print LOG "PID: $$ ".scalar(localtime)." : ".$message."\n\n";
	close LOG;
}

#extract bootp fields into a readable form in a hash
#params- SCALAR(binary bootp request packet)
sub extract_bootp_fields
{
	my $datagram= shift;
	my %bootp_contents;
	my $i= 0;
	my @fields;
	my $each;

	# extract each field of bytes from the request
	@fields= unpack $BOOTP_PACK_STRING, $datagram;

	# put each value in the hash to correspond to its field
	foreach $each (@BOOTP_FIELDS_IN_ORDER)
	{
		$bootp_contents{$each}= $fields[$i];
		$i++;
	}

	$bootp_contents{n_op}= ord($bootp_contents{op});
	$bootp_contents{n_hlen}= ord($bootp_contents{hlen});
	$bootp_contents{n_hops}= ord($bootp_contents{hops});
	$bootp_contents{n_xid}= ord($bootp_contents{xid});
	$bootp_contents{n_secs}= ord($bootp_contents{secs});
	$bootp_contents{n_htype}= ord($bootp_contents{htype});
	$bootp_contents{n_flags}= ord($bootp_contents{flags});
	
	$bootp_contents{hostname}= gethostbyaddr($bootp_contents{ciaddr}, AF_INET) if ($bootp_contents{ciaddr});
	$bootp_contents{ciaddr}= join(".", unpack "C1 C1 C1 C1", $bootp_contents{ciaddr});
	$bootp_contents{giaddr}= join(".", unpack "C1 C1 C1 C1", $bootp_contents{giaddr});
	$bootp_contents{siaddr}= join(".", unpack "C1 C1 C1 C1", $bootp_contents{siaddr});
	$bootp_contents{yiaddr}= join(".", unpack "C1 C1 C1 C1", $bootp_contents{yiaddr});
	$bootp_contents{chaddr}= join("", unpack "H2 H2 H2 H2 H2 H2", $bootp_contents{chaddr});

	$bootp_contents{ciaddr}= "" if ($bootp_contents{ciaddr} eq '0.0.0.0');
	$bootp_contents{siaddr}= "" if ($bootp_contents{siaddr} eq '0.0.0.0');
	$bootp_contents{giaddr}= "" if ($bootp_contents{giaddr} eq '0.0.0.0');
	$bootp_contents{yiaddr}= "" if ($bootp_contents{yiaddr} eq '0.0.0.0');

	\%bootp_contents;
}

#params- SCALAR(signal name)
sub signal_handler
{
	local $SIG{INT}= 'IGNORE';
	local $SIG{QUIT}= 'IGNORE';
	local $SIG{TERM}= 'IGNORE';
	local $SIG{HUP}= 'IGNORE';  # ignore all signals while in here

	my $signal= shift;
	$signal_received= 1;

	#queue the request if processing a request right now
        if ($processing)
        {
                push @signal_queue, $signal unless ($signal eq 'all' || ! $signal);
        }
        #here, handling all queued requests
        elsif ($signal eq 'all')
        {
                while (@signal_queue)
                {
                        &signal_handler(shift @signal_queue);
                }
        }
        #here, handle rehash (reread bootptab)
        elsif ($signal eq 'HUP')
        {
                &rehash;
        }
        # terminate on all other signals
        else
        {
                &terminate($signal);
        }
}

#params- SCALAR(mac address)
sub read_arp_entry
{
	my $mac_addr= shift;
	my $ip_addr= "";
	my $perm= 0;
	my @fields;
	my $each_ip;
	my $each_mac;
	my $each_perm;
	my $output;

	# put :'s in the mac address and make all letters uppercase
	$mac_addr=~ s/([0-9a-fA-F]{2})/$1:/g;
	chop $mac_addr;
	$mac_addr= uc $mac_addr;

	open (ARP, "/sbin/arp -an |");

	while (<ARP>)
	{
		chomp;
		($each_ip, $each_mac, $each_perm)= (split)[1,3,5];

		if ($each_mac eq $mac_addr)
		{
			$ip_addr= $each_ip;
			$perm= 1 if ($each_perm eq 'PERM');
			last;
		}
	}

	close ARP;
	#strip out ()'s around IP address
	$ip_addr=~ s/\((.*)\)/$1/ if ($ip_addr);

	return ($ip_addr, $perm);
}

#params- SCALAR(ip address)
sub remove_arp_entry
{
	my $ip_addr= shift;
	my $output= "";
	
	$output= `/sbin/arp -d $ip_addr`;

	$?;
}

#params- SCALAR(ip address), SCALAR(mac address)
sub add_arp_entry
{
	my $ip_addr= shift;
	my $mac_addr= shift;
	my $output= "";

	# put :'s in the mac address
	$mac_addr=~ s/([0-9a-fA-F]{2})/$1:/g;
	chop $mac_addr;

	$output= `/sbin/arp -s $ip_addr $mac_addr`;

	$?;
}

#called when SIGHUP is received
sub rehash
{
	#re-read the bootptab file
	&log_entry('msg', "Caught SIGHUP: reading bootptab file $file");

	#read in the bootptab file
	$bootptab= &read_bootptab($file);
}

#shut down the server gracefully with a signal
#params- SCALAR(signal name)
sub terminate
{
	my $signal= shift;
	&log_entry('msg', "TERMINATING with signal SIG$signal...\n");

	#won't need this anymore
	unlink $pid_file;

	exit 0;
}
