dhcp.tbs

' Po chamsku zerzniete z Tibba. Po to tu jest.

const DHCP_MAX_RETRIES=3 'This is how many times we will try to do DHCP
const DHCP_RANOM_RETRY_DELAY = 20

include "global.tbh"  

enum dhcp_phases
DHCP_PHASE_DISCOVER,
DHCP_PHASE_REQUEST
end enum

dim dhcp_phase as dhcp_phases
dim dhcp_server_ip as string(16)

declare sub send_dhcp(byref obtained_ip as string)
declare function proc_dhcp_reply(byref obtained_ip as string(16), byref obtained_gateway as string(16),
byref obtained_netmask as string(16), byref obtained_lease_time as dword) as ok_ng


'=============================================================
public function dhcp_obtain(byref obtained_ip as string, byref obtained_gateway as string,
byref obtained_netmask as string, byref obtained_lease_time as dword, device_name as string(32)) as ok_ng

	dim retry_ctr as byte 'we need to limit how much time we will spend here
	dim wait_period as word
	'setup the socket we need for DHCP communications
	if net.ip = "1.0.0.1" then net.ip = "0.0.0.0"
	sock.num=SOCK_DHCP
	
	'arrange buffer space
	sock.rxbuffrq(5)
	sock.txbuffrq(5)
	sys.buffalloc
	
	'setup the socket itself
	sock.protocol=0
	sock.targetport=67
	sock.outport=68
	sock.targetbcast=YES
	sock.acceptbcast=YES
	sock.connectiontout=600
	sock.inconmode=PL_SOCK_INCONMODE_ANY_IP_ANY_PORT
	sock.reconmode=PL_SOCK_RECONMODE_3
	sock.gendataarrivalevent=NO
	sock.num=SOCK_DHCP
	sock.connect

	wait_period = sys.timercount
	for retry_ctr=1 to DHCP_MAX_RETRIES
		while wait_period > sys.timercount
		wend
		
		dhcp_phase=DHCP_PHASE_DISCOVER
		send_dhcp(obtained_ip)
	
		if proc_dhcp_reply(obtained_ip,obtained_gateway,obtained_netmask,obtained_lease_time)=NG then
			goto try_again
		end if	
	
		dhcp_phase=DHCP_PHASE_REQUEST
		send_dhcp(obtained_ip)	
	
		if proc_dhcp_reply(obtained_ip,obtained_gateway,obtained_netmask,obtained_lease_time)=NG then
			goto try_again
		end if	
		
		'DHCP interaction completed successfully
		dhcp_obtain=OK
		goto release_buffer
 
try_again:
		'here when DHCP failed
		wait_period = asc(random(1))/DHCP_RANOM_RETRY_DELAY
		if sys.timercount < (65535 - wait_period) then wait_period = sys.timercount + wait_period			
	next retry_ctr
	obtained_lease_time = 180 'DHCP failed, try again in 3 mins
	dhcp_obtain=NG
	
release_buffer:
	'close the socket, deallocate space
	sock.inconmode=PL_SOCK_INCONMODE_NONE
	sock.discard
	while sock.statesimple<>PL_SSTS_CLOSED
	wend
	sock.gendataarrivalevent=YES
	sock.rxbuffrq(0)
	sock.txbuffrq(0)
	sys.buffalloc
end function


'=============================================================
public sub send_dhcp(byref obtained_ip as string)

	dim s as string
	dim x as byte
	
	
	
	'1.1.6.0- opcode=rq, hware type= Ethernet, hardware addr len= 6, hop count=0
	s=ddval("1.1.6.0")
	
	'transaction ID- last 4 bytes of MAC address
	s=s+right(ddval(net.mac),4)

	'100.100- number of seconds
	'128.0- set broadcast flag
	s=s+ddval("100.100.128.0")

	select case dhcp_phase
	case DHCP_PHASE_DISCOVER:
		'for DISCOVER message all fields until MAC-address are unused
		s=s+ddval(net.ip)+ddval(net.ip)
		s=s+strgen(8,chr(0))
	
	case DHCP_PHASE_REQUEST:
		'our IP address and the field for server-suggested IP- fill with zeroes to avoid problems
		s=s+strgen(8,chr(0))
		
		'supply IP-address of the server (we obtained from the OFFER message)- this is required
		s=s+ddval(dhcp_server_ip)
	
		'no need to set gateway IP
		s=s+strgen(4,chr(0))
	
	case else:
	end select

	s=s+ddval(net.mac) 'client MAC
	sock.setdata(s)
	
	'now we just need 204 empty bytes
	s=strgen(202,chr(0))
	sock.setdata(s)
	
	'continue...
	s=ddval("99.130.83.99") 'magic cookie

	select case dhcp_phase
	case DHCP_PHASE_DISCOVER:
		'53.1.1- set message type to DISCOVER
		s=s+ddval("53.1.1")
		
		'116.1.1 - DHCP Auto Configuration
		s=s+ddval("116.1.1")
		
		'61.7 - Client Identifier
		s=s+ddval("61.7.1."+net.mac)
		
		'50.4- suggest our current IP only if IP was assigned already
		if obtained_ip <> "" then 
			s=s+ddval("50.4."+obtained_ip)	'suggest our current IP
		else
			s=s+ddval("50.4."+net.ip)
		end if
		'51.4.255.255.255.255- suggest maximum lease time
		s=s+ddval("51.4.255.255.255.255")
		
		'55.2.1.3- provide a list of parameters we need
		s=s+ddval("55.2.1.3")
	
	case DHCP_PHASE_REQUEST:
		'53.1.3- set message type to REQUEST
		'54.4- specify the DHCP server we are addressing
		s=s+ddval("53.1.3.54.4")
		
		s=s+ddval(dhcp_server_ip) 'DHCP server we are addressing
	
		'50.4- quote the IP-address being suggested by the DHCP server
		s=s+ddval("50.4")	
	
		s=s+ddval(obtained_ip) 'This is the IP-address that the DHCP server has suggested
	
		'55.2.1.3- provide a list of parameters we need
		s=s+ddval("55.2.1.3")
	
	case else:

	end select

	'add host name option if our owner name or device name is set
	'if device_name<>"" then
	'	s=s+chr(12)+chr(len(device_name))+device_name
	'end if
	
	'end of all options and send!
	'We pad the packet for compatibility to certain DHCP server that conforms to BOOTP packet size
	sock.setdata(s+CHR(255)+strgen(319-len(s),CHR(0)))	
	sock.send
end sub


'=============================================================
public function proc_dhcp_reply(byref obtained_ip as string(16), byref obtained_gateway as string(16),
byref obtained_netmask as string(16), byref obtained_lease_time as dword) as ok_ng

	dim s as string
	dim s2 as string(32)
	dim x,f as byte
	dim message_type as byte
	dim t1_found as no_yes
	dim w as word

	'first, wait for the DHCP packet to arrive
	w=sys.timercount
	while sock.rxlen=0
		if sys.timercount-w>10 then
			proc_dhcp_reply=NG 'timeout while waiting for reply!
			exit function
		end if
	wend

	sock.nextpacket
	s=sock.getdata(236) 'read all the data up to a magic cookie
	
	'verify opcode: must be "reply" (2)
	'verify hardware type: must be "ethernet" (1)
	'verify hardware address length: must be (6)
	if ddstr(mid(s,1,3))<>"2.1.6" then
		proc_dhcp_reply=NG
		exit function
	end if

	'verify transaction ID (must match our last 4 digits of MAC address)
	if ddstr(mid(s,5,4))<>ddstr(right(ddval(net.mac),4)) then
		proc_dhcp_reply=NG
		exit function
	end if

	'branch according to the phase
	select case dhcp_phase 
	case DHCP_PHASE_DISCOVER:
		'make sure IP-address being offered is valid
		'first number cannot exceed 223
		if asc(mid(s,17,1))>223 then
			proc_dhcp_reply=NG
			exit function
		end if
		
		'last number cannot be 0 or 255
		x=asc(mid(s,20,1))
		if x=0 or x=255 then
			proc_dhcp_reply=NG
			exit function
		end if
		
		'IP-address being offered is correct- extract it!
		obtained_ip=ddstr(mid(s,17,4))
	
	case DHCP_PHASE_REQUEST:
	
		'Make sure that the IP-address the DHCP supplied now (ACK) is the same as in OFFER message
		'(or the same we've been using if we are extending the lease)
		if obtained_ip<>ddstr(mid(s,17,4)) then
			proc_dhcp_reply=NG
			exit function
		end if

	case else:
	
	end select

	'This part is common for all types of replies received from the DHCP server.
	'Extract and verify our own MAC (must be returned by the server)
	if ddstr(mid(s,29,6))<>net.mac then
			proc_dhcp_reply=NG
			exit function
	end if	
		
	'Read magic cookie and options
	s=sock.getdata(255) 
	
	'Check magic cookie
	if ddstr(mid(s,1,4))<>"99.130.83.99" then
			proc_dhcp_reply=NG
			exit function
	end if	

	obtained_lease_time=4294967295 'first, assume max lease time
	t1_found=NO

	'Look through options and extract the ones we need. Only one option-
	'message type is REALLY a mast
	for f=5 to len(s)
		select case asc(mid(s,f,1))
		case 255: 'reached the end of all options
			goto exit_options
		
		case 0: 'this is a "padding"- just skip it
			goto next_option		

		case 53: 'OK, we HAD to have this option (message type)- make sure its length is 1
			if asc(mid(s,f+1,1))<>1 then
				proc_dhcp_reply=NG
				exit function
			end if	
			'now get the message type and see if it is correct
			message_type=asc(mid(s,f+2,1))
			select case dhcp_phase
			case DHCP_PHASE_DISCOVER:
				if message_type<>2 then
					proc_dhcp_reply=NG
					exit function
				end if
			
			case DHCP_PHASE_REQUEST:
				if message_type<>5 then
					proc_dhcp_reply=NG
					exit function
				end if
			
			case else:

			end select
			f=f+2
				
		case 1: 'netmask option!- make sure its length is 5
			if asc(mid(s,f+1,1))<>4 then
				proc_dhcp_reply=NG
				exit function
			end if
			obtained_netmask=ddstr(mid(s,f+2,4))
			f=f+5								

		case 3: 'default gateway IP option!- there can be N gateways, length must be 4*n
			x=asc(mid(s,f+1,1))
			if x<4 or x-(x/4)*4<>0 then
				proc_dhcp_reply=NG
				exit function
			end if
			obtained_gateway=ddstr(mid(s,f+2,4))
			f=f+1+x								

		case 51: 'offered lease time
			'only process this if no T1 option was encountered yet
			if t1_found=NO then
				goto get_lease
			end if
			f=f+5
		
		case 59: 'T1- renewal time
			t1_found=YES
get_lease:	if asc(mid(s,f+1,1))<>4 then
				proc_dhcp_reply=NG
				exit function
			end if

			'renewal time is a 4-byte value (in seconds)
			obtained_lease_time= asc(mid(s,f+2,1))*16777216+asc(mid(s,f+3,1))*65536+asc(mid(s,f+4,1))*256+asc(mid(s,f+5,1))
			f=f+5
		
		case 54: 'server identifier option
			if asc(mid(s,f+1,1))<>4 then
				proc_dhcp_reply=NG
				exit function
			end if
			dhcp_server_ip=ddstr(mid(s,f+2,4))
			f=f+5		
			
		case else: 'some other option: just skip it
			x=asc(mid(s,f+1,1))
			f=f+x+1			
		
		end select
next_option:	
	next f

exit_options:	
	proc_dhcp_reply=OK
end function