#
# Copyright (c) 1998 Sun Microsystems, Inc.
# 
# This software is provided by Sun ``AS IS'' and any express or implied
# warranties, including, but not limited to, the implied warranties of
# merchantability and fitness for a particular purpose are disclaimed.
# In no event shall Sun Microsystems be liable for any direct, indirect,
# incidental, special, exemplary, or consequential damages.
# 
# This software is not a product, and is provided for evaluation purposes
# only.
# 
# This software may not be resold without the express permission of
# Sun Microsystems.
# 
# Feedback on this tool may be sent to packet-shell-owner@sunroof.eng.sun.com.
# 
# 
# ident "@(#)protocol	1.2	98/02/23 SMI"
#

#
#  A DISCOVER should:
#	1) ciaddr, yiaddr, siaddr, giaddr must be INADDR_ANY.
#
proc doValidateDiscover { pkt } {

	global INADDR_ANY error_msg

	puts "\n\n****\tDISCOVER received\t****\n\n"
	puts [plist $pkt bootps]

	set chaddr [pget $pkt bootps chaddr]

	if { [pget $pkt bootps ciaddr] != $INADDR_ANY } {
		puts "FAIL($chaddr): DISCOVER has nonzero ciaddr field."
		set error_msg "DISCOVER nonzero ciaddr"
		return 1
	}
	if { [pget $pkt bootps yiaddr] != $INADDR_ANY } {
		puts "FAIL($chaddr): DISCOVER has nonzero yiaddr field."
		set error_msg "DISCOVER nonzero yiaddr"
		return 1
	}
	if { [pget $pkt bootps siaddr] != $INADDR_ANY } {
		puts "FAIL($chaddr): DISCOVER has nonzero siaddr field."
		set error_msg "DISCOVER nonzero siaddr"
		return 1
	}
	if { [pget $pkt bootps giaddr] != $INADDR_ANY } {
		puts "FAIL($chaddr): DISCOVER has nonzero giaddr field."
		set error_msg "DISCOVER nonzero giaddr"
		return 1
	}

	puts "\n\n***\tSUCCESS($chaddr): DISCOVER OK\t***\n\n"
	return 0
}

#
#  A REQUEST should:
#
proc doValidateRequest { pkt } {

	global INADDR_ANY error_msg

	puts "\n\n****\tREQUEST received\t****\n\n"
	puts [plist $pkt bootps]

	# There are three styles of requests - INIT, 
	# INIT-REBOOT, RENEW/REBIND. The difference?
	# INIT:
	#	a) server_id MUST BE present
	#	b) ciaddr MUST BE zero
	#	c) requested IP address MUST BE filled in with the value from
	#	   our offer's yiaddr.
	#
	# INIT-REBOOT:
	#	a) server_id MUST NOT be present
	#	b) ciaddr MUST BE zero
	#	c) requested IP address MUST BE filled in with the value our
	#	   client thinks it has. (for out purposes, $client_ip)
	#
	# RENEW/REBIND:
	#	a) server_id MUST NOT be present
	#	b) ciaddr MUST BE set (the client knows who it is)
	#	c) requested IP address MUST NOT BE present.

	set chaddr [pget $pkt bootps chaddr]
	set server_id [pget $pkt bootps opt "server id"]
	if { $server_id != ""} {
		# Must be INIT.
		if { [pget $pkt bootps ciaddr] != $INADDR_ANY } {
			puts "FAIL($chaddr): INIT REQUEST ciaddr MUST BE INADDR_ANY"
			set error_msg "INIT (REQUEST) ciaddr != 0"
			return 1
		}
		if { [pget $pkt bootps opt "requested IP address"] == \
		    $INADDR_ANY } {
			puts "FAIL($chaddr): INIT REQUEST MUST have \
			    requested IP address option set"
			set error_msg "INIT (REQUEST) w/o requested IP address"
			return 1
		}
	} else {
		# Could be INIT-REBOOT or RENEW/REBIND

		set reqIP [pget $pkt bootps opt "requested IP address"]
		set ciaddr [pget $pkt bootps ciaddr]

		if { $ciaddr != $INADDR_ANY && $reqIP != "" } {
			puts "FAIL($chaddr): ???? REQUEST has both requested IP address option and ciaddr set"
			set error_msg "???? (REQUEST) w/ both ciaddr & reqIP"
			return 1
		}
	}
	puts "\n\n***\tSUCCESS($chaddr): REQUEST OK\t***\n\n"
	return 0
}

#
#  A INFORM:
#	a) MUST NOT have a server identifier
#	b) MUST set ciaddr
#
proc doValidateInform { pkt } {
	global INADDR_ANY error_msg

	puts "\n\n****\tINFORM received\t****\n\n"
	puts [plist $pkt bootps]

	set ciaddr [pget $pkt bootps ciaddr]
	set chaddr [pget $pkt bootps chaddr]

	if { $ciaddr == $INADDR_ANY } {
		puts "FAIL($chaddr): INFORM with zero ciaddr"
		set error_msg "INFORM w/ zero ciaddr"
		return 1
	}

	set reqIP [pget $pkt bootps opt "requested IP address"]
	if { $reqIP != "" } {
		puts "FAIL($chaddr): INFORM with illegal requested IP address option"
		set error_msg "INFORM w/ illegal reqIP option"
		return 1
	}

	set serverid [pget $pkt bootps opt "server id"]
	if { $serverid != "" } {
		puts "FAIL($chaddr): INFORM with illegal Server id option"
		set error_msg "INFORM w/ server id"
		return 1
	}

	puts "\n\n***\tSUCCESS($chaddr): INFORM from $ciaddr OK\t***\n\n"
	return 0
}

#
#  A DECLINE:
#	a) ciaddr MUST BE zero
#	b) requested IP address option MUST contain declined address.
#	c) server id MUST BE present.
#	d) IP address lease time MUST NOT be set.
#
proc doValidateDecline { pkt } {
	global server_ip INADDR_ANY error_msg

	puts "\n\n****\tDECLINE received\t****\n\n"
	puts [plist $pkt bootps]

	set ciaddr [pget $pkt bootps ciaddr]
	set chaddr [pget $pkt bootps chaddr]

	if { $ciaddr != $INADDR_ANY } {
		puts "FAIL($chaddr): DECLINE with nonzero ciaddr ($ciaddr)"
		set error_msg "DECLINE ciaddr != 0"
		return 1
	}

	set reqIP [pget $pkt bootps opt "requested IP address"]
	if { $reqIP == "" } {
		puts "FAIL($chaddr): DECLINE is missing requested IP address option"
		set error_msg "DECLINE missing reqIP option"
		return 1
	}

	set serverid [lindex [pget $pkt bootps opt "server id"] 0]
	if { $serverid == "" } {
		puts "FAIL($chaddr): DECLINE missing mandatory Server id option"
		set error_msg "DECLINE missing server id"
		return 1
	}

	if { $serverid != $server_ip} {
		puts "FAIL($chaddr): DECLINE server id wrong: $serverid != $server_ip"
		set error_msg "DECLINE with incorrect server id"
		return 1
	}

	set iplease [pget $pkt bootps opt "ip address lease"]
	if { $iplease  != "" } {
		puts "FAIL($chaddr): DECLINE with illegal lease time option"
		set error_msg "DECLINE with inlegal lease time option"
		return 1
	}
	puts "\n\n***\tSUCCESS($chaddr): DECLINE OK\t***\n\n"
	return 0
}

#
#  A RELEASE:
#	a) ciaddr MUST BE IP address to release.
#	b) requested IP address option MUST NOT be set.
#	c) server id MUST BE present.
#	d) IP address lease time MUST NOT be set.
#
proc doValidateRelease { pkt } {
	global server_ip INADDR_ANY error_msg

	puts "\n\n****\tRELEASE received\t****\n\n"
	puts [plist $pkt bootps]

	set ciaddr [pget $pkt bootps ciaddr]
	set chaddr [pget $pkt bootps chaddr]

	if { $ciaddr == $INADDR_ANY } {
		puts "FAIL($chaddr): RELEASE missing ciaddr field"
		set error_msg "RELEASE missing ciaddr"
		return 1
	}

	set reqIP [pget $pkt bootps opt "requested IP address"]
	if { $reqIP != "" } {
		puts "FAIL($chaddr): RELEASE with illegal requested IP address option"
		set error_msg "RELEASE w/ illegal reqIP option"
		return 1
	}

	set serverid [lindex [pget $pkt bootps opt "server id"] 0]
	if { $serverid == "" } {
		puts "FAIL($chaddr): RELEASE missing mandatory Server id option"
		set error_msg "RELEASE missing server id"
		return 1
	}

	if { $serverid != $server_ip} {
		puts "FAIL($chaddr): RELEASE server id wrong: $serverid != $server_ip"
		set error_msg "RELEASE w/ incorrect server id"
		return 1
	}

	set iplease [pget $pkt bootps opt "ip address lease"]
	if { $iplease  != "" } {
		puts "FAIL($chaddr): RELEASE with illegal lease time option"
		set error_msg "RELEASE w/ illegal lease option"
		return 1
	}
	puts "\n\n***\tSUCCESS($chaddr): RELEASE OK\t***\n\n"
	return 0
}

#
# Respond to a DISCOVER message
#
proc doHandleDiscover { pkt offer_ip } {

	global ep client_netmask lease_time server_ip
	global INADDR_BROADCAST bootpc

	# First set fixed fields, many values come from client's DISCOVER
	pinit bootps offer - - offer
	set xid [pget $pkt bootps xid]
	pset offer bootps xid $xid
	pset offer bootps yiaddr $offer_ip
	set flags [pget $pkt bootps flags]
	pset offer bootps flags $flags
	set chaddr [pget $pkt bootps chaddr]
	eval pset offer bootps chaddr $chaddr

	# Now options
	pset offer bootps opt subnet $client_netmask
	pset offer bootps opt "ip address lease" $lease_time
	pset offer bootps opt "server identifier" $server_ip

	# send.... Broadcast if necessary.
	set iflags [lindex $flags 0]
	if { $iflags == 0x8000 } {
		set destination $INADDR_BROADCAST
	} else {
		set destination $offer_ip
		make_arp_entry $chaddr $offer_ip
	}
	puts "sending OFFER ($offer_ip) to $destination"
	puts [plist offer bootps]
	ep.sendto offer 0 $destination/$bootpc
	if { $iflags != 0x8000 } {
		delete_arp_entry $offer_ip
	}

	pfree offer

	return 0
}

#
# Respond to a REQUEST message
#
proc doHandleRequest { pkt ack_ip } {

	global client_netmask lease_time server_ip
	global bootpc INADDR_BROADCAST INADDR_ANY

	set chaddr [pget $pkt bootps chaddr]
	set error 0

	# First set fixed fields, many values come from client's REQUEST
	pinit bootps ack - - ack
	set xid [pget $pkt bootps xid]
	pset ack bootps xid $xid
	pset ack bootps yiaddr $ack_ip
	set flags [pget $pkt bootps flags]
	pset ack bootps flags $flags
	set chaddr [pget $pkt bootps chaddr]
	eval pset ack bootps chaddr $chaddr

	# Now options
	pset ack bootps opt subnet $client_netmask
	pset ack bootps opt "ip address lease" $lease_time
	pset ack bootps opt "server identifier" $server_ip

	set server_id [pget $pkt bootps opt "server id"]
	if { $server_id != "" } {
		set server_id [lindex $server_id 0]
		# INIT client Give them the address.
		if { $server_id != $server_ip } {
			puts "INIT REQUEST($chaddr) other server: $server_id"
			pfree ack
			return 0
		}
		set reqIP [pget $pkt bootps opt "requested ip address"]
		if { $reqIP != $ack_ip } {
			puts "FAIL($chaddr): INIT REQUEST requested IP address  option is not what we OFFERED $reqIP != $ack_ip"
			pfree ack
			return 0
		}

		# send.... Broadcast if necessary.
		set iflags [lindex $flags 0]
		if { $iflags == 0x8000 } {
			set destination $INADDR_BROADCAST
		} else {
			set destination $ack_ip
			make_arp_entry $chaddr $ack_ip
		}
		puts "INIT: sending ACK to $destination"
		puts [plist ack bootps]
		ep.sendto ack 0 $destination/$bootpc
		if { $iflags != 0x8000 } {
			delete_arp_entry $ack_ip
		}
	} else {
		# INIT-REBOOT, RENEW/REBIND....
		set ciaddr [pget $pkt bootps ciaddr]
		if { $ciaddr == $INADDR_ANY } {
			# INIT-REBOOT
			if { $ciaddr != $ack_ip } {
				puts "FAIL($chaddr): INIT-REQUEST requested IP address  option is not what we assigned $ciaddr != $ack_ip"
				pinit bootps nak - - nak
				set xid [pget $pkt bootps xid]
				pset nak bootps xid $xid
				set flags [pget $pkt bootps flags]
				pset nak bootps flags $flags
				set chaddr [pget $pkt bootps chaddr]
				eval pset nak bootps chaddr $chaddr

				# Now options
				pset ack bootps opt "Message" \
				    "You are on the wrong network"
				# send....
				puts "INIT-REBOOT: sending NAK to $INADDR_BROADCAST"
				puts [plist nak bootps]
				ep.sendto nak 0 $INADDR_BROADCAST/$bootpc
				pfree nak
				set error 1
			} else {
				# send.... Broadcast if necessary.
				set iflags [lindex $flags 0]
				if { $iflags == 0x8000 } {
					set destination $INADDR_BROADCAST
				} else {
					set destination $ack_ip
					make_arp_entry $chaddr $ack_ip
				}
				puts "INIT-REBOOT: sending ACK to $destination"
				puts [plist ack bootps]
				ep.sendto ack 0 $destination/$bootpc
				if { $iflags != 0x8000 } {
					delete_arp_entry $ack_ip
				}
			}
		} else {
			# RENEW/REBIND.
			puts "RENEW/REBIND: sending ACK to $ack_ip"
			puts [plist ack bootps]
			ep.sendto ack 0 $ack_ip/$bootpc
		}
	}
	pfree ack
	if { $error == 0 } {
		puts "\n\n****\tSUCCESS($chaddr) Client is well-behaved.\t****\n\n"
	}
	return $error
}

#
# Respond to a INFORM message
#
proc doHandleInform { pkt } {

	global ep server_ip INADDR_ANY bootpc

	pinit bootps ack - - ack

	# Send ACK. No lease time or yiaddr!
	set xid [pget $pkt bootps xid]
	pset ack bootps xid $xid
	set flags [pget $pkt bootps flags]
	pset ack bootps flags $flags
	pset ack bootps yiaddr $INADDR_ANY

	set clnt_ip [pget $pkt bootps ciaddr]

	# Now options
	pset ack bootps opt subnet $client_netmask
	pset ack bootps opt "server identifier" $server_ip

	# send....
	puts "INFORM: sending ACK to $clnt_ip"
	puts [plist $ack bootps]
	ep.sendto ack 0 $clnt_ip/$bootpc

	pfree ack
	return 0
}

