177 lines
3.8 KiB
Forth
177 lines
3.8 KiB
Forth
( DHCP: Dynamic Host Configuration Protocol JCB 13:13 08/24/10)
|
|
module[ dhcp"
|
|
|
|
\ Since DHCP alarm is only used when there is no lease, it is
|
|
\ safe to use the ip-subnetmask for the same purpose.
|
|
|
|
ip-subnetmask constant dhcp-alarm
|
|
|
|
: dhcp-xid
|
|
ip-router 2@
|
|
;
|
|
|
|
: dhcp-xid!
|
|
ip-router 2!
|
|
;
|
|
|
|
: dhcp-option \ ( ... n code -- )
|
|
mac-pkt-c,
|
|
dup mac-pkt-c,
|
|
0do
|
|
mac-pkt-c,
|
|
loop
|
|
;
|
|
|
|
: dhcp-common \ ( messagetype -- )
|
|
d# 67 d# 68
|
|
d# 0 invert dup
|
|
d# 0 dup
|
|
d# 0 \ broadcast ethaddr
|
|
( dst-port src-port dst-ip src-ip *ethaddr -- )
|
|
udp-header
|
|
h# 0101 h# 0600 mac-pkt-2,
|
|
dhcp-xid mac-pkt-2,
|
|
d# 10 mac-pkt-,0
|
|
net-my-mac mac-pkt-3,
|
|
d# 101 mac-pkt-,0 \ d# 5 + d# 96 zeroes
|
|
|
|
h# 6382 h# 5363
|
|
mac-pkt-2,
|
|
|
|
\ DHCP option 53: DHCP Discover
|
|
\ messagetype
|
|
d# 1 d# 53 \ messagetype 1 53
|
|
dhcp-option
|
|
|
|
\ DHCP option 50: 192.168.1.100 requested
|
|
|
|
\ DHCP option 55: Parameter Request List:
|
|
\ Request Subnet Mask (1), Router (3),
|
|
\ Domain Name Server (6)
|
|
d# 1 d# 3 d# 6 d# 3 d# 55 dhcp-option
|
|
;
|
|
|
|
: dhcp-wrapup
|
|
\ Finish options
|
|
h# ff mac-pkt-c,
|
|
\ mac-wrptr @ d# 1 and
|
|
d# 1 if \ XXX
|
|
h# ff mac-pkt-c,
|
|
then
|
|
|
|
udp-wrapup
|
|
mac-send
|
|
;
|
|
|
|
\ memory layout is little-endian
|
|
|
|
: macc@++ ( c-addr -- c-addr+1 c )
|
|
dup 1+ swap macc@ ;
|
|
|
|
: dhcp-field \ ( match -- ptr/0 )
|
|
OFFSET_DHCP_OPTIONS d# 4 + mac-inoffset
|
|
\ match ptr
|
|
begin
|
|
macc@++ \ match ptr code
|
|
dup h# ff <>
|
|
while \ match ptr code
|
|
d# 2 pick =
|
|
if
|
|
nip \ ptr
|
|
exit
|
|
then \ match ptr
|
|
macc@++ + \ match ptr'
|
|
repeat
|
|
\ fail - return false
|
|
2drop false
|
|
;
|
|
|
|
: dhcp-yiaddr
|
|
d# 2 OFFSET_DHCP_YIADDR mac-inoffset mac@n
|
|
;
|
|
|
|
: dhcp-field4
|
|
dhcp-field d# 1 +
|
|
macc@++ swap macc@++ swap macc@++ swap macc@
|
|
( a b c d )
|
|
swap d# 8 lshift or -rot
|
|
swap d# 8 lshift or
|
|
swap
|
|
;
|
|
|
|
build-debug? [IF]
|
|
: .pad ( ip. c-addr u -- ) d# 14 typepad ip-pretty cr ;
|
|
|
|
: dhcp-status
|
|
ip-addr 2@ s" IP" .pad
|
|
ip-router 2@ s" router" .pad
|
|
ip-subnetmask 2@ s" subnetmask" .pad
|
|
;
|
|
[ELSE]
|
|
: dhcp-status ;
|
|
[THEN]
|
|
|
|
: lease-setalarm
|
|
d# 0 >r
|
|
begin
|
|
2dup d# 63. d>
|
|
while
|
|
d2/ r> 1+ >r
|
|
repeat
|
|
r>
|
|
hex4 space hex8 cr
|
|
;
|
|
|
|
: dhcp-wait-offer
|
|
h# 11 ip-isproto
|
|
OFFSET_UDP_SOURCEPORT packet@ d# 67 = and
|
|
OFFSET_UDP_DESTPORT packet@ d# 68 = and
|
|
d# 2 OFFSET_DHCP_XID mac-inoffset mac@n dhcp-xid d= and
|
|
if
|
|
snap
|
|
d# 53 dhcp-field ?dup
|
|
snap
|
|
if
|
|
d# 1 + macc@
|
|
snap
|
|
dup d# 2 =
|
|
if
|
|
\ [char] % emit
|
|
d# 3 dhcp-common
|
|
|
|
\ option 50: request IP
|
|
h# 3204
|
|
dhcp-yiaddr
|
|
mac-pkt-3,
|
|
|
|
\ Option 54: server
|
|
h# 3604
|
|
d# 54 dhcp-field4
|
|
mac-pkt-3,
|
|
|
|
dhcp-wrapup
|
|
then
|
|
d# 5 =
|
|
if
|
|
\ clrwdt
|
|
\ [char] & emit
|
|
|
|
dhcp-yiaddr ip-addr 2!
|
|
d# 1 dhcp-field4 ip-subnetmask 2!
|
|
\ For the router and DNS server, send out ARP requests right now. This
|
|
\ reduces start-up time.
|
|
d# 3 dhcp-field4 2dup ip-router 2! arp-lookup drop
|
|
d# 6 dhcp-field4 2dup ip-dns 2! arp-lookup drop
|
|
\ Option 51: lease time
|
|
s" expires in " type
|
|
d# 51 dhcp-field4 swap d. cr
|
|
then
|
|
then
|
|
snap
|
|
then
|
|
;
|
|
|
|
: dhcp-discover d# 1 dhcp-common dhcp-wrapup ;
|
|
|
|
]module
|