\ ========== Copyright Header Begin ==========================================
\ Hypervisor Software File: dhcp.fth
\ Copyright (c) 2006 Sun Microsystems, Inc. All Rights Reserved.
\ - Do no alter or remove copyright notices
\ - Redistribution and use of this software in source and binary forms, with
\ or without modification, are permitted provided that the following
\ - Redistribution of source code must retain the above copyright notice,
\ this list of conditions and the following disclaimer.
\ - Redistribution in binary form must reproduce the above copyright notice,
\ this list of conditions and the following disclaimer in the
\ documentation and/or other materials provided with the distribution.
\ Neither the name of Sun Microsystems, Inc. or the names of contributors
\ may be used to endorse or promote products derived from this software
\ without specific prior written permission.
\ This software is provided "AS IS," without a warranty of any kind.
\ ALL EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES,
\ INCLUDING ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A
\ PARTICULAR PURPOSE OR NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN
\ MICROSYSTEMS, INC. ("SUN") AND ITS LICENSORS SHALL NOT BE LIABLE FOR
\ ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR
\ DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN
\ OR ITS LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR
\ FOR DIRECT, INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE
\ DAMAGES, HOWEVER CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY,
\ ARISING OUT OF THE USE OF OR INABILITY TO USE THIS SOFTWARE, EVEN IF
\ SUN HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
\ You acknowledge that this software is not designed, licensed or
\ intended for use in the design, construction, operation or maintenance of
\ ========== Copyright Header End ============================================
id: @(#)dhcp.fth 1.7 02/11/27
copyright: Copyright 1997-2002 Sun Microsystems, Inc. All Rights Reserved
copyright: Use is subject to license terms.
\ Dynamic Host Configuration Protocol (DHCP) RFC 2131, RFC 2132
\ Bootstrap Protocol (BOOTP) RFC 951, RFC 1542
struct ( bootp/dhcp packet )
1 field >bp-op \ packet type: 1 = request, 2 = reply
1 field >bp-htype \ hardware addr type
1 field >bp-hlen \ hardware addr length
1 field >bp-hops \ gateway hops
4 field >bp-xid \ transaction ID
2 field >bp-secs \ seconds since boot began
4 field >bp-ciaddr \ client IP address
4 field >bp-yiaddr \ 'your' IP address
4 field >bp-siaddr \ server IP address
4 field >bp-giaddr \ gateway IP address
16 field >bp-chaddr \ client hardware address
64 field >bp-sname \ server host name
128 field >bp-file \ boot file name
4 field >bp-cookie \ Magic cookie
60 field >bp-options \ Can be longer, extending to end of packet
: bp-op ( -- adr ) active-struct@ >bp-op ;
: bp-htype ( -- adr ) active-struct@ >bp-htype ;
: bp-hlen ( -- adr ) active-struct@ >bp-hlen ;
: bp-hops ( -- adr ) active-struct@ >bp-hops ;
: bp-xid ( -- adr ) active-struct@ >bp-xid ;
: bp-secs ( -- adr ) active-struct@ >bp-secs ;
: bp-ciaddr ( -- adr ) active-struct@ >bp-ciaddr ;
: bp-yiaddr ( -- adr ) active-struct@ >bp-yiaddr ;
: bp-siaddr ( -- adr ) active-struct@ >bp-siaddr ;
: bp-giaddr ( -- adr ) active-struct@ >bp-giaddr ;
: bp-chaddr ( -- adr ) active-struct@ >bp-chaddr ;
: bp-sname ( -- adr ) active-struct@ >bp-sname ;
: bp-file ( -- adr ) active-struct@ >bp-file ;
: bp-cookie ( -- adr ) active-struct@ >bp-cookie ;
: bp-options ( -- adr ) active-struct@ >bp-options ;
\ DHCP State machine states
2 constant init-info-state
3 constant requesting-state
5 constant configured-state
instance variable dhcp-state
\ Generic BOOTP/DHCP option structure
struct ( bootp/dhcp-opt-header )
: op-code ( -- adr ) active-struct >op-code ;
: op-len ( -- adr ) active-struct >op-len ;
: op-data ( -- adr ) active-struct >op-data ;
\ RFC 1048 magic cookie 99.130.83.99
h# 63.82.53.63 constant boot-magic
\ Maximum possible size of BOOTP/DHCP packet
d# 1472 constant /dhcp-maxmsg
\ Base BOOTP/DHCP packet size - everything but the options, includes cookie
d# 240 constant bootp-base-pkt-size
instance variable dhcp-pkt-type
instance variable offered-ip-addr
instance variable dhcp-server-id
instance variable max-dhcp-pkt-size
instance variable dhcp-sndlen \ Actual length of packet to be sent
-1 instance value dhcp-retries
-1 instance value #max-retries
: dhcp-msg ( adr len -- )
debug-dhcp? if type cr else 2drop then
: too-many-boot-retries? ( -- flag )
#retries @ #max-retries u>=
\ Construct class identifier from the root node's "name"
\ property, replacing commas with periods
d# 32 buffer: my-class-id
: init-vend-class-id ( -- )
my-class-id pack count bounds
i c@ ascii , = if ascii . i c! then
\ Construct client-identifier. This should be
\ 1) The clientid option specified on command line, if any; or
\ 2) the clientid options specified in "network-boot-args", if any; or
\ 3) the root node "dhcp-clientid" property, if it exists.
\ Only 3 is implemented currently. 1 and 2 are dependent upon
\ wanboot which implements 1) revised parameter parsing
\ and 2) "network-boot-args".
d# 32 buffer: my-client-id
dhcp-clientid-prop 0= if ( adr,len )
my-client-id pack drop ( )
0 instance value bootreply-len
*buffer @ /ether-header + /ip-header + /udp-header +
bootreply-len ( bootreply-pkt-adr pkt-len )
dup to selected-reply-size ( bootreply-pkt-adr pkt-len )
selected-bootreply swap cmove ( )
d# 128 constant /options-max
next-option bp-options + c! next-option 1+ to next-option
bp-options /options-max erase 0 to next-option
: add-option ( adr len code -- )
option, dup option, bounds ?do i c@ option, loop
\ * DHCPDECLINE messages MUST NOT include
\ - option 57 (Max DHCP msg size)
\ - option 60 (Class identifier)
\ * DHCPREQUESTs and DHCPDECLINEs fill
\ - option 50 (Requested IP address)
\ - option 54 (DHCP server identifier)
\ identifying the offer being responded to
\ * All client messages MAY include option 61
: set-dhcp-msg-type ( -- ) dhcp-pkt-type 1 d# 53 add-option ;
: set-class-id ( -- ) my-class-id count d# 60 add-option ;
: set-max-dhcp-pkt-sz ( -- ) max-dhcp-pkt-size 2 d# 57 add-option ;
: set-offered-ipaddr ( -- ) offered-ip-addr 4 d# 50 add-option ;
: set-dhcp-server-id ( -- ) dhcp-server-id 4 d# 54 add-option ;
: set-req-params-list ( -- ) " "(01 03 0c 2b)" d# 55 add-option ;
my-client-id count ?dup if
: add-dhcp-options ( -- pktlen )
dhcp-pkt-type c@ DHCPDECLINE <> if ( )
set-class-id set-req-params-list set-max-dhcp-pkt-sz ( )
dhcp-pkt-type c@ dup DHCPREQUEST = swap DHCPDECLINE = or if ( )
set-dhcp-server-id set-offered-ipaddr ( )
bootp-base-pkt-size next-option + ( pktlen )
: setup-dhcp-pkt ( pkt-type -- )
( .. pkt-type ) dhcp-pkt-type c!
packet-to-send active-struct !
packet-to-send /dhcp-maxmsg erase
1 ( ARPHRD_ETHER ) bp-htype c! \ Hardware address type
6 bp-hlen c! \ Hardware address length
xid @ bp-xid be-l! \ "Random" transaction ID
my-ip-addr bp-ciaddr 4 cmove
my-en-addr bp-chaddr 6 cmove
boot-magic bp-cookie be-l!
add-dhcp-options dhcp-sndlen !
broadcast-ip-addr his-ip-addr 4 cmove
broadcast-en-addr his-en-addr 6 cmove
: setup-discover-pkt ( -- ) DHCPDISCOVER setup-dhcp-pkt ;
: setup-inform-pkt ( -- ) DHCPINFORM setup-dhcp-pkt ;
: setup-decline-pkt ( -- ) DHCPDECLINE setup-dhcp-pkt ;
: setup-request-pkt ( -- ) DHCPREQUEST setup-dhcp-pkt ;
: boot-magic? ( -- flag )
bp-cookie be-l@ boot-magic =
: c@++ ( adr -- adr+1 char ) dup ca1+ swap c@ ;
\ A 256 element array, indexed by DHCP option number. Each element
\ holds the pointer to "op-data". We interpret the options we are
: options-array ( index -- adr ) /n* options + ;
: field-scan ( adr len -- )
over ca+ >r ( adr ) ( r: end )
d# 255 of r> 2drop exit endof
>r c@++ over r> options-array ! ca+ 0
: option-overload-val ( -- val ) d# 52 options-array @ dup if c@ then ;
\ Determine options specified in the BOOTP/DHCP packet.
\ First scan the standard options fields. Then scan the specified additional
\ fields if "option overload" is set.
: scan-options ( bootreply-pkt-adr bootreply-len -- )
swap active-struct ! ( bootreply-len )
0 options-array d# 256 /n* erase \ Havent read anything yet
boot-magic? if ( bootreply-len )
\ Scan standard options fields
bp-options swap bootp-base-pkt-size - field-scan
option-overload-val ?dup if
( option-overload-val ) case
\ "bp-file" holds options
1 of bp-file d# 128 field-scan endof
\ "bp-sname" holds options
2 of bp-sname d# 64 field-scan endof
\ Both "bp-file" and "bp-sname" hold options
3 of bp-sname d# 192 field-scan endof
: receive-bootreply ( -- flag ) \ True if bootreply received
receive-udp-packet 0= if false exit then ( udp-adr udp-len )
swap active-struct ! ( udp-len )
udp-dest-port be-w@ BOOTPC <> ( udp-len flag )
/udp-header active-struct +!
bp-xid be-l@ xid @ <> or ( udp-len flag' )
bp-op c@ BOOTREPLY <> or ( udp-len flag'' )
/udp-header - ( bootp-len )
dup to bootreply-len ( bootp-len )
active-struct @ swap ( bootreply-pkt bootreply-len )
: bootreply-msg-type ( -- val ) d# 53 options-array @ dup if c@ then ;
instance variable rn \ Random number
instance variable dhcp-timeout-msecs
\ Retransmission delay is doubled with each transmission upto a maximum
\ of 64 seconds. Delay intervals are randomized by a period of +/- 1 second
: get-dhcp-retrans-time ( -- n )
rn @ d# 199961 * d# 524287 + h# 7FFFFFFF and rn !
rn @ d# 1000 /mod 2 /mod drop if negate then
dhcp-timeout-msecs @ + ( n )
dhcp-timeout-msecs @ d# 64000 < if
dhcp-timeout-msecs dup @ 2* swap !
packet-to-send dhcp-sndlen @ /dhcp-packet max ( pkt len )
prepare-udp-packet ( len )
get-dhcp-retrans-time set-timeout ( )
instance defer prepare-dhcp-pkt
instance defer receive-dhcp-reply
\ Basic DHCP packet exchange logic.
." Timeout waiting for BOOTP/DHCP reply. Retrying ... " cr
too-many-boot-retries? if false exit then
\ Set "random" transaction ID and random number generator seed
my-en-addr 5 + c@ get-msecs xor dup xid ! rn !
\ -------------------------- INIT state -------------------------------
false instance value bootp-config?
0 instance value best-offer-#points
: compute-offer-points ( - #points )
d# 43 options-array @ if d# 80 + then
d# 1 options-array @ if d# 5 + then
d# 3 options-array @ if d# 5 + then
d# 12 options-array @ if d# 5 + then
bp-siaddr broadcast-ip-addr? 0= if d# 10 + then
d# 52 options-array @ 0= if
bp-sname cstrlen 0<> if d# 10 + then
bp-file cstrlen 0<> if d# 10 + then
." This configuration has " dup .d ." points" cr
\ Accumulate replies from DHCP/BOOTP servers and pick the best offer.
: get-best-offer ( -- flag )
0 to best-offer-#points 0 to selected-reply-size
compute-offer-points ( #pts )
dup best-offer-#points > if
selected-bootreply selected-reply-size scan-options
bootreply-msg-type DHCPOFFER <> to bootp-config?
\ Decode contents of the selected BOOTP/DHCP reply.
selected-bootreply active-struct !
\ Accepted BOOTP configuration. Read my IP address
bp-yiaddr my-ip-addr 4 cmove
\ Received a DHCPOFFER. Record offered IP address and server identifier
bp-yiaddr offered-ip-addr 4 cmove
d# 54 options-array @ dhcp-server-id 4 cmove
\ Broadcast DHCPDISCOVER messages and wait for configuration parameters from
\ a BOOTP/DHCP server. If a BOOTP configuration is selected, move to
\ CONFIGURED state; else, go through other states of DHCP state machine
" Requesting an IP address ... " dhcp-msg
['] setup-discover-pkt to prepare-dhcp-pkt
['] get-best-offer to receive-dhcp-reply
d# 8000 dhcp-timeout-msecs !
dhcp-retries to #max-retries
." BOOTP/DHCP retry count exceeded" cr abort
bootp-config? if configured-state else requesting-state then
\ ------------------------------- INIT-INFO state ---------------------------
: get-config-params ( -- rcvd? ) \ true if reply rcvd from BOOTP/DHCP server
receive-bootreply 0= if false exit then
bootreply-msg-type dup 0= swap DHCPACK = or ?dup
\ Broadcast DHCPINFORM and move to CONFIGURED state once a DHCPACK/BOOTREPLY
\ is received. If no replies are received even after 4 tries, attempt to
\ proceed further in the booting process.
['] setup-inform-pkt to prepare-dhcp-pkt
['] get-config-params to receive-dhcp-reply
d# 4000 dhcp-timeout-msecs !
." Unable to receive config params " cr
." Attempting to boot anyway! ... " cr
configured-state dhcp-state !
\ ---------------------------- REQUESTING state ---------------------------
: get-ack/nak-pkt ( -- ack/nak-rcvd? )
receive-bootreply 0= if false exit then
bootreply-msg-type dup DHCPACK = swap DHCPNAK = or ?dup
\ Broadcast DHCPREQUESTs and move to VERIFY state after a DHCPACK is
\ received. If no reply is received even after 4 tries, or if a
\ DHCPNAK is received, revert back to INIT state
" Requesting offered parameters ..." dhcp-msg
['] setup-request-pkt to prepare-dhcp-pkt
['] get-ack/nak-pkt to receive-dhcp-reply
d# 4000 dhcp-timeout-msecs !
." Failed to receive config params" cr
." Restarting DHCP process ..." cr
10.000 ms \ Wait for 10 seconds
bootreply-msg-type DHCPNAK = if
." Server unable to satisfy request" cr
." Restarting DHCP process ..." cr
verify-state dhcp-state !
\ ------------------------ VERIFY state ----------------------------
\ Broadcast an ARP Reply announcing the IP address I am using and
\ clear outdated ARP cache entries on other machines.
: announce-my-addr ( -- )
my-ip-addr my-en-addr my-ip-addr my-en-addr ARP_REPLY ARP_TYPE
send-arp/rarp-packet drop
['] setup-decline-pkt to prepare-dhcp-pkt
['] true to receive-dhcp-reply \ Dont wait for a reply
: valid-ip-addr? ( -- valid? )
" Validating IP address ..." dhcp-msg
offered-ip-addr broadcast-en-addr my-ip-addr my-en-addr ARP_REQ ARP_TYPE
send-arp/rarp-packet drop
arp-timeout-msecs set-timeout
ARP_TYPE receive-ethernet-packet
drop /ether-header + active-struct !
arp-tpa my-ip-addr ip= if \ Addressed to me
arp-opcode be-w@ ARP_REPLY = if \ ARP reply
." ARP Reply from: " arp-spa be-l@ .inetaddr
arp-spa offered-ip-addr ip= if
debug-dhcp? if ." No ARP Reply " cr then
\ Check if the offered IP address is already in use. If yes, decline
\ this offer and start all over again
" Address validation successful ..." dhcp-msg
offered-ip-addr my-ip-addr 4 cmove
configured-state dhcp-state !
." IP address already in use by another client!" cr
." Restarting DHCP ..." cr
10.000 ms \ Wait for 10 seconds
\ --------------------------------------------------------------------
\ Navigate through DHCP state machine till state = CONFIGURED
\ Initialize DHCP client state
my-ip-addr l@ 0= if init-state else init-info-state then dhcp-state !
init-state of dhcp-init endof
init-info-state of dhcp-init-info endof
requesting-state of dhcp-requesting endof
verify-state of dhcp-verify endof
configured-state of exit endof
\ Initialize network configuration parameters. Read subnet mask,
\ TFTP server and router's IP addresses and bootfilename, if they
\ haven't been specified as cmd line arguments, from the
: init-config-params ( -- )
selected-bootreply selected-reply-size scan-options
subnet-mask broadcast-ip-addr? if
d# 1 options-array @ ?dup if subnet-mask 4 cmove then
router-ip-addr broadcast-ip-addr? if
d# 3 options-array @ ?dup if router-ip-addr 4 cmove then
server-ip-addr broadcast-ip-addr? if
bp-siaddr server-ip-addr 4 cmove
\ Read bootfilename from BOOTP/DHCP header OR from the
\ "bootfile name" option if "option overload" is specified
d# 67 options-array @ ?dup if
dup cstrlen tftp-file-buf pack drop
bp-file dup cstrlen tftp-file-buf pack drop
/dhcp-maxmsg alloc-mem to packet-to-send
/udp-pseudo-hdr alloc-mem is udp-pseudo-hdr
d# 256 /n * alloc-mem is options
d# 1514 alloc-mem to selected-bootreply
selected-bootreply d# 1514 erase
/dhcp-maxmsg max-dhcp-pkt-size be-w!
packet-to-send /dhcp-maxmsg free-mem
udp-pseudo-hdr /udp-pseudo-hdr free-mem
options d# 256 /n * free-mem
selected-bootreply d# 1514 free-mem
." Client IP : " my-ip-addr be-l@ .inetaddr cr
." Server IP : " server-ip-addr be-l@ .inetaddr cr
." Router IP : " router-ip-addr be-l@ .inetaddr cr
." Subnet Mask : " subnet-mask be-l@ .inetaddr cr
." TFTP filename : " tftp-file count type cr
." TFTP Retries : " tftp-retries .d cr
." DHCP Retries : " dhcp-retries .d cr
my-client-id count ?dup if
projects / OpenSPARC-T2-SAM / blob