\ ========== 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 \ conditions are met: \ \ - 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 \ any nuclear facility. \ \ ========== Copyright Header End ============================================ id: @(#)dhcp.fth 1.1 04/09/07 purpose: DHCP support copyright: Copyright 2004 Sun Microsystems, Inc. All Rights Reserved copyright: Use is subject to license terms. \ RFC 2131: Dynamic Host Configuration Protocol \ RFC 2132: DHCP Options and BOOTP Vendor Extensions \ RFC 1534: Interoperation Between DHCP and BOOTP fload ${BP}/pkg/netinet/dhcp-h.fth headerless 0 instance value dhcp-sockid /insock instance buffer: dhcp-srv-addr /insock instance buffer: dhcp-cli-addr d# 32 instance buffer: dhcp-classid /ip-addr instance buffer: dhcp-offered-ip /ip-addr instance buffer: dhcp-server-id 0 instance value dhcp-sndbuf instance variable dhcp-sndbuflen 0 instance value dhcp-rcvbuf 0 instance value chosen-bootreply \ Best offer 0 instance value /chosen-bootreply 0 instance value best-offer-points false instance value bootp-config? \ Is best offer a BOOTREPLY? /timer instance buffer: dhcp-timer instance variable dhcp-state \ DHCP FSM state instance variable dhcp-xid \ Transaction identifier \ Read a byte and advance the pointer. : c@++ ( adr -- adr+1 c ) dup ca1+ swap c@ ; \ Find an option in the specified area of a packet. : (find-dhcp-option) ( adr len option# -- optadr optlen true | false ) >r over ca+ swap ( end start ) ( r: option# ) begin 2dup > while c@++ case CD_PAD of endof CD_END of r> 3drop false exit endof r@ of r> drop nip c@++ true exit endof ( default ) drop c@++ ca+ 0 endcase repeat r> 3drop false ; \ Find the specified DHCP option. Options in a DHCP message may extend \ to the 'sname' and 'file' fields if an 'option overload' option is \ present in the variable length options field. : find-dhcp-option ( pkt len option# -- optadr optlen true | false ) 2 pick >dhcp-cookie ntohl@ BOOTMAGIC <> if 3drop false exit then >r ( pkt,len ) ( r: opt# ) over >dhcp-options over /dhcp-header - ( pkt,len opts,len ) 2dup r@ (find-dhcp-option) if ( pkt,len opts,len optadr,len ) 2swap 2drop 2swap 2drop true ( optadr,len true ) else ( pkt,len opts,len ) CD_OPTION_OVERLOAD (find-dhcp-option) if ( pkt,len ovloption,len ) drop nip c@ dup 1 3 between if ( pkt ovlopt-value ) case 1 of >dhcp-file d# 128 endof 2 of >dhcp-sname d# 64 endof 3 of >dhcp-sname d# 192 endof endcase ( adr,len ) r@ (find-dhcp-option) ( optadr,len true | false ) else ( pkt n ) 2drop false ( false ) then ( optadr,len true | false ) else ( pkt,len ) 2drop false ( false ) then ( optadr,len true | false ) then ( optadr,len true | false ) r> drop ( optadr,len true | false ) ; \ Determine if the packet contains a specific option. : dhcp-option-found? ( pkt len option# -- found? ) find-dhcp-option if 2drop true else false then ; \ Find a vendor specific option. : find-vendor-option ( pkt len vendor-option# -- optadr optlen true | false ) >r ( pkt len ) ( r: opt# ) CD_VENDOR_SPEC find-dhcp-option if ( encap-options,len ) r@ (find-dhcp-option) ( optadr opten true | false ) else ( ) false ( false ) then ( optadr optlen true | false ) r> drop ( optadr optlen true | false ) ; \ Add an option with a 8-bit value to the packet : add-dhcpopt-byte ( adr code byte -- adr' ) rot >r ( code byte ) ( r: adr ) swap r@ >dhcpopt-code c! ( byte ) /c r@ >dhcpopt-len c! ( byte ) r@ >dhcpopt-data c! ( ) r> 3 ca+ ( adr' ) ( r: ) ; \ Add an option with a 16-bit value to the packet : add-dhcpopt-word ( adr code value -- adr' ) rot >r ( code value ) ( r: adr ) swap r@ >dhcpopt-code c! ( value ) /w r@ >dhcpopt-len c! ( value ) r@ >dhcpopt-data htonw! ( ) r> 4 ca+ ( adr' ) ( r: ) ; \ Add an option encoding a stream of bytes to the packet. : add-dhcpopt-bytes ( adr code data len -- adr' ) ?dup if ( adr code data len ) 3 roll >r ( code data len ) ( r: adr ) rot r@ >dhcpopt-code c! ( data len ) dup r@ >dhcpopt-len c! ( data len ) tuck r@ >dhcpopt-data swap move ( len ) r> swap 2+ ca+ ( adr' ) ( r: ) else ( adr code data ) 2drop ( adr' ) then ( adr' ) ; \ Maximum length of the DHCP message we are willing to accept. : /dhcp-maxmsg ( -- n ) if-mtu@ /udpip-header - ; \ The vendor class identifier is constructed from the root node's \ "name" property, with commas (,) replaced with periods (.). : init-dhcp-vendor-classid ( -- ) " /" " name" get-property decode-string 2swap 2drop ( $ ) dhcp-classid pack count bounds ?do ( ) i c@ ascii , = if ascii . i c! then ( ) loop ( ) ; \ DHCP initialization. Create a socket, initialize the client and \ server socket address structures, and bind local address to the \ socket. Allocate buffers to send/receive/store DHCP packets and \ determine the vendor class identifier to use. : dhcp-init ( -- ) AF_INET SOCK_DGRAM IPPROTO_UDP socreate to dhcp-sockid ( ) dhcp-cli-addr my-ip-addr IPPORT_BOOTPC insock-init ( ) dhcp-srv-addr inaddr-broadcast IPPORT_BOOTPS insock-init ( ) /dhcp-maxmsg dup alloc-mem to dhcp-sndbuf ( n ) dup alloc-mem to dhcp-rcvbuf ( n ) alloc-mem to chosen-bootreply ( ) dhcp-sockid dhcp-cli-addr /insock sobind ( ) init-dhcp-vendor-classid ( ) ; \ DHCP state cleanup. Free the DHCP packet buffers and close the \ connection. : dhcp-close ( -- ) dhcp-sndbuf /dhcp-maxmsg tuck free-mem ( n ) dhcp-rcvbuf over free-mem ( n ) chosen-bootreply swap free-mem ( ) dhcp-sockid soclose ( ) ; \ Filling in DHCP message options. All DHCP messages include the DHCP \ message type and the client identifier (if one is in use). DHCP_REQUEST \ and DHCP_DECLINE messages must fill the DHCP server identifier and the \ offered IP address. Messages other than DHCP_DECLINE must fill in the \ DHCP vendor class identifier, the maximum DHCP message size we are \ willing to accept, and the list of requested parameters. We explicitly \ request values for subnet mask (Option 1), Router (Option 3), Hostname \ (Option 12), and Vendor specific information (Option 43). : add-dhcp-options ( pkt type -- pktlen ) >r dup >dhcp-options ( pkt adr ) ( r: type ) CD_DHCP_TYPE r@ add-dhcpopt-byte CD_CLIENTID client-id count add-dhcpopt-bytes r@ DHCP_DECLINE <> if CD_CLASSID dhcp-classid count add-dhcpopt-bytes CD_REQUEST_LIST " "(01 03 0c 2b)" add-dhcpopt-bytes CD_MAXMSG_SIZE /dhcp-maxmsg add-dhcpopt-word CD_HOSTNAME hostname count add-dhcpopt-bytes then r> dup DHCP_REQUEST = swap DHCP_DECLINE = or if CD_SERVER_ID dhcp-server-id /ip-addr add-dhcpopt-bytes CD_REQ_IPADDR dhcp-offered-ip /ip-addr add-dhcpopt-bytes then CD_END over c! ca1+ swap - ( pktlen ) ; \ Common code to construct DHCP message to be sent. : init-dhcp-packet ( type -- ) dhcp-sndbuf dup >r /dhcp-maxmsg erase ( type ) ( r: pkt ) BOOTREQUEST r@ >dhcp-op c! if-htype@ r@ >dhcp-htype c! if-addrlen@ r@ >dhcp-hlen c! if-hwaddr r@ >dhcp-chaddr copy-hw-addr dhcp-xid @ r@ >dhcp-xid htonl! my-ip-addr r@ >dhcp-ciaddr copy-ip-addr BOOTMAGIC r@ >dhcp-cookie htonl! r> swap add-dhcp-options dhcp-sndbuflen ! ( ) ( r: ) ; \ Transmit formatted DHCP message. : send-dhcp-packet ( -- ) dhcp-sockid dhcp-sndbuf dhcp-sndbuflen @ ( sockid pkt len ) DHCP_MIN_PKTLEN max ( sockid pkt len' ) 0 dhcp-srv-addr /insock sosendto drop ( ) ; \ Managing DHCP retransmissions. Use a randomized exponential backoff \ to determine delay between retransmissions. On retries, the delay is \ doubled (for a maximum of 64 seconds), and randomized by a random \ number in the range +/-1.023 seconds. : dhcp-backoff ( -- ) dhcp-timer clear-timer 2* d# 64000 min ( timeout ) random dup d# 22 rshift swap 0< if negate then + ( timeout' ) dhcp-timer swap set-timer ( ) ; : retransmit-dhcp-packet ( -- ) send-dhcp-packet dhcp-backoff ; \ Determine DHCP packet type. BOOTP packets are tagged as type 0. : dhcp-packet-type ( pkt len -- type ) over >dhcp-cookie ntohl@ BOOTMAGIC = if ( pkt,len ) CD_DHCP_TYPE find-dhcp-option if drop c@ else 0 then ( type ) else ( pkt,len ) 2drop 0 ( 0 ) then ( type ) ; \ Receive data arriving on the socket. : (receive-dhcp-packet) ( -- pkt len ) dhcp-sockid dhcp-rcvbuf tuck /dhcp-maxmsg 0 0 0 sorecvfrom ; \ Incoming responses must be BOOTREPLY packets, and the xid should match. : receive-dhcp-packet ( -- pkt len true | false ) (receive-dhcp-packet) dup 0= if 2drop false exit then over >dhcp-op c@ BOOTREPLY <> if 2drop false exit then over >dhcp-xid ntohl@ dhcp-xid @ <> if 2drop false exit then true ; \ Receive OFFER messages from the server. BOOTP responses must be \ accepted as well. : receive-dhcp-offer ( -- pkt len true | false ) receive-dhcp-packet 0= if false exit then ( pkt len ) 2dup dhcp-packet-type ( pkt len type ) dup 0= if drop true exit then ( pkt len type ) DHCP_OFFER <> if 2drop false exit then ( pkt len ) 2dup CD_SERVER_ID find-dhcp-option if ( pkt len optadr,len ) 2drop true ( pkt len true ) else ( pkt len ) ." Ignoring OFFER with missing DHCP server identifier" cr 2drop false ( false ) then ( pkt len true | false ) ; \ Receive an ACK/NAK response from the server. : receive-dhcp-ack/nak ( -- pkt len true | false ) receive-dhcp-packet 0= if false exit then ( pkt len ) 2dup dhcp-packet-type ( pkt len type ) dup DHCP_ACK <> swap DHCP_NAK <> and if ( pkt len ) 2drop false ( false ) else ( pkt len ) true ( pkt len true ) then ( pkt len true | false ) ; \ Receive an ACK in response to the INFORM message we sent. Responses \ from a BOOTP server must be accepted as well. : receive-dhcpinform-response ( -- pkt len true | false ) receive-dhcp-packet 0= if false exit then ( pkt len ) 2dup dhcp-packet-type ( pkt len type ) dup DHCP_ACK <> swap 0<> and if ( pkt len ) 2drop false ( false ) else ( pkt len ) true ( pkt len true ) then ( pkt len true | false ) ; \ Stash away a response received from the server. : store-dhcp-response ( adr len -- ) dup >r chosen-bootreply swap move r> to /chosen-bootreply ; \ Wait for the expected response. : (dhcp-response-wait) ( xt -- pkt len true | false ) begin ( xt ) dhcp-timer timer-expired? ( xt timed-out? ) 0= while ( xt ) dup execute if ( xt pkt len ) rot drop true exit ( pkt len true ) then ( xt ) repeat ( xt ) drop false ( false ) ; \ Wait for expected response, retransmitting the sent packet if necessary. : dhcp-response-wait ( xt ntries -- pkt len true | false ) begin ( xt ntries ) over (dhcp-response-wait) if ( xt ntries pkt len ) 2swap 2drop true exit ( pkt len true ) then ( xt ntries ) ." Timed out waiting for BOOTP/DHCP reply" cr ( xt ntries ) 1- ( xt ntries' ) dup 0 u> while ( xt ntries' ) retransmit-dhcp-packet ( xt ntries' ) repeat ( xt ntries' ) 2drop false ( false ) ; \ Wait for a minimum of 10 seconds if restarting the configuration \ process after a failure. : dhcp-restart ( -- ) d# 10.000 ms DHCPS_INIT dhcp-state ! ; \ INIT state processing. Select a random transaction identifier to use \ in DHCP packets. Move to INFORM state if using an externally configured \ IP address; else move to SELECTING state. : dhcps-init ( -- ) random dhcp-xid l! my-ip-addr inaddr-any? if DHCPS_SELECTING else DHCPS_INFORM then dhcp-state ! ; \ INFORM state processing. Send a DHCPINFORM and wait for a DHCPACK. \ If a DHCPACK is not received even after 4 retries, enter CONFIGURED \ state and hope for the best. : dhcps-inform ( -- ) DHCP_INFORM init-dhcp-packet send-dhcp-packet ( ) dhcp-timer d# 4000 set-timer ( ) ['] receive-dhcpinform-response 4 dhcp-response-wait if ( pkt len ) store-dhcp-response ( ) DHCPS_BOUND dhcp-state ! ( ) else DHCPS_CONFIGURED dhcp-state ! ( ) then ( ) ; \ Selecting the best DHCPOFFER. We select the best OFFER from the possibly \ many incoming OFFER messages. OFFERs are evaluated using a points-based \ system we share with inetboot/wanboot. We prefer DHCP configurations \ which provide the most configuration information. : compute-offer-points ( pkt len -- #points ) over >dhcp-cookie ntohl@ BOOTMAGIC <> if 2drop 0 exit then d# 5 CD_DHCP_TYPE 2over rot dhcp-option-found? if d# 30 + then CD_VENDOR_SPEC 2over rot dhcp-option-found? if d# 80 + then CD_SUBNETMASK 2over rot dhcp-option-found? if 1+ then CD_ROUTER 2over rot dhcp-option-found? if 1+ then CD_HOSTNAME 2over rot dhcp-option-found? if d# 5 + then CD_OPTION_OVERLOAD 2over rot dhcp-option-found? 0= if 2 pick >dhcp-sname c@ 0<> if d# 10 + then 2 pick >dhcp-file c@ 0<> if d# 5 + then then 2 pick >dhcp-siaddr inaddr-any? 0= if d# 10 + then nip nip ; \ Process incoming offer and keep track of the best offer received. : process-offer ( pkt len -- ) 2dup compute-offer-points dup best-offer-points <= if ( pkt len pts ) 3drop exit ( ) then ( pkt len pts ) to best-offer-points ( pkt len ) store-dhcp-response ( ) ; \ Record information from the OFFER we selected. : process-best-offer ( -- ) chosen-bootreply /chosen-bootreply ( pkt len ) 2dup dhcp-packet-type 0= to bootp-config? ( pkt len ) over >dhcp-yiaddr dhcp-offered-ip copy-ip-addr ( pkt len ) CD_SERVER_ID find-dhcp-option if ( opt-adr,len ) drop dhcp-server-id copy-ip-addr ( ) then ( ) ; \ SELECTING state processing. Broadcast a DISCOVER and sift through \ the OFFERs to select the best one. We "collect" OFFERs for a period \ of 4 seconds after the first OFFER is received. If the best offer \ is a BOOTP configuration, move to the BOUND state, else move to the \ REQUESTING state. : dhcps-selecting ( -- ) DHCP_DISCOVER init-dhcp-packet send-dhcp-packet ( ) dhcp-timer d# 8000 set-timer ( ) ['] receive-dhcp-offer dhcp-max-retries ( xt ntries ) dhcp-response-wait 0= if ( ) ." No DHCP response after" dhcp-max-retries .d ." tries" cr -1 throw then ( pkt len ) process-offer ( ) dhcp-timer d# 4000 set-timer ( ) begin ( ) ['] receive-dhcp-offer (dhcp-response-wait) while ( pkt len ) process-offer ( ) repeat ( ) process-best-offer ( ) bootp-config? if DHCPS_BOUND else DHCPS_REQUESTING then dhcp-state ! ; \ REQUESTING state processing. Broadcast a DHCPREQUEST requesting offered \ parameters from one server (and implicitly declining OFFERS from other \ servers) and wait for a DHCPACK. On arrival of a DHCPACK, move to the \ VERIFYING state to perform a check on the offered IP address. \ \ If a DHCPNAK is received, or there is no response to the DHCPREQUEST \ even after 4 retries, restart the initialization process. : dhcps-requesting ( -- ) DHCP_REQUEST init-dhcp-packet send-dhcp-packet ( ) dhcp-timer d# 4000 set-timer ( ) ['] receive-dhcp-ack/nak 4 dhcp-response-wait if ( pkt len ) 2dup dhcp-packet-type DHCP_ACK = if ( pkt len ) store-dhcp-response ( ) DHCPS_VERIFYING dhcp-state ! ( ) else ( pkt len ) 2drop dhcp-restart ( ) then ( ) else ( ) dhcp-restart ( ) then ( ) ; \ VERIFYING state processing. Issue an ARP request for the offered \ IP address. If the IP address appears to be in use, send a DHCPDECLINE \ message to the server and restart the initialization process; else, \ move to the BOUND state. : dhcps-verifying ( -- ) dhcp-offered-ip 1 arp-check if ." IP Address " dhcp-offered-ip .ipaddr ." already in use" cr DHCP_DECLINE init-dhcp-packet send-dhcp-packet dhcp-restart else dhcp-offered-ip my-ip-addr copy-ip-addr DHCPS_BOUND dhcp-state ! then ; \ BOUND state processing. Extract n/w and boot configuration information \ we care about from the DHCP/BOOTP response. We dont deal with IP \ address lease times, pushing that responsibility to DHCP modules \ in the OS. : dhcp-set-bootsrv,file ( pkt len -- ) \ Check if boot server and filename are known. bootfile count is-uri? if 2drop exit then ( pkt len ) bootfile count nip if ( pkt len ) tftp-server-ip inaddr-any? 0= if 2drop exit then then ( pkt len ) \ If the package arguments did not specify use of TFTP, and \ the DHCP response provides a (TFTP or HTTP) URI, set the \ bootfile and exit. \ \ If the package arguments specifies use of TFTP, and the \ DHCP response provides a TFTP URI, then either the TFTP \ server or the filename is being overridden. Decode the \ URI and set those fields appropriately. \ \ Else, if TFTP must be used, but a HTTP URL was provided \ in the DHCP response, ignore the URL specification. 2dup VS_BOOT_URI find-vendor-option if ( pkt len $ ) 2dup check-uri$-form ( pkt len $ ) tftp-server-ip inaddr-any? bootfile count nip 0= and if ( pkt len $ ) bootfile pack drop 2drop exit ( ) then ( pkt len $ ) 2dup is-tftp-uri? if ( pkt len $ ) tftp-server-ip inaddr-any? if ( pkt len $ ) 2dup tftpuri>srv tftp-server-ip inet-aton drop ( pkt len $ ) then ( pkt len $ ) bootfile count nip 0= if ( pkt len $ ) 2dup tftpuri>file bootfile pack drop ( pkt len $ ) then ( pkt len $ ) 2drop 2drop exit ( ) then 2drop ( pkt len ) then ( pkt len ) \ Extract TFTP boot information from the standard bootfile \ and TFTP server fields. bootfile count nip 0= if ( pkt len ) 2dup CD_BOOTFILE_NAME find-dhcp-option 0= if ( pkt len ) over >dhcp-file dup cstrlen ( pkt len $ ) then bootfile pack drop ( pkt len ) then ( pkt len ) tftp-server-ip inaddr-any? if ( pkt len ) over >dhcp-siaddr tftp-server-ip copy-ip-addr ( pkt len ) then ( pkt len ) 2drop ( ) ; : dhcps-bound ( -- ) chosen-bootreply /chosen-bootreply ( pkt,len ) my-netmask inaddr-any? if ( pkt,len ) 2dup CD_SUBNETMASK find-dhcp-option if ( pkt,len adr,len ) drop my-netmask copy-ip-addr ( pkt,len ) then ( pkt,len ) then ( pkt,len ) router-ip inaddr-any? if ( pkt,len ) 2dup CD_ROUTER find-dhcp-option if ( pkt,len adr,len ) drop router-ip copy-ip-addr ( pkt,len ) then ( pkt,len ) then ( pkt,len ) 2dup dhcp-set-bootsrv,file ( pkt,len ) http-proxy count nip 0= if ( pkt,len ) 2dup VS_HTTP_PROXY find-vendor-option if ( pkt,len proxy$ ) 2dup check-htproxy$-form http-proxy pack drop ( pkt,len ) then ( pkt,len ) then ( pkt,len ) 2drop ( ) DHCPS_CONFIGURED dhcp-state ! ( ) ; : "bootp-response" ( -- $ ) " bootp-response" ; \ Space savings \ CONFIGURED state processing. Publish contents of DHCPACK, if one was \ received, in /chosen:bootp-response. : dhcps-configured ( -- ) chosen-bootreply /chosen-bootreply dup if encode-bytes "bootp-response" set-chosen-property else 2drop then ; : (do-dhcp) ( -- ) DHCPS_INIT dhcp-state ! begin dhcp-state @ case DHCPS_INIT of dhcps-init endof DHCPS_INFORM of dhcps-inform endof DHCPS_SELECTING of dhcps-selecting endof DHCPS_REQUESTING of dhcps-requesting endof DHCPS_VERIFYING of dhcps-verifying endof DHCPS_BOUND of dhcps-bound endof DHCPS_CONFIGURED of dhcps-configured exit endof endcase again ; : do-dhcp ( -- ) dhcp-init ( ) ['] (do-dhcp) catch ( throw? ) dhcp-close ( throw? ) throw ( ) ; headers