[OpenSPARC-T2-SAM] / obp / obp / pkg / dhcp / netload.fth

\ ========== Copyright Header Begin ==========================================
\ 
\ Hypervisor Software File: netload.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: @(#)netload.fth 2.24 03/08/20
purpose: Network loading using TFTP.
copyright: Copyright 1990-2003 Sun Microsystems, Inc.  All Rights Reserved
copyright: Use is subject to license terms.

\ DHCP/BOOTP syntax is
\ boot net:[bootp|dhcp][,server-ipaddr][,boot-filename][,client-ip-addr]
\            [,router-ip-addr][,boot-retries][,tftp-retries][,subnet-mask]

\ Network loading using TFTP. Loads one of
\ a) a named file using the "dload" command,
\ b) Or the default tftpboot file whose name is constructed from
\    the Internet address (derived from the Ethernet address with RARP)
\    and the CPU architecture type.
\ c) If using BOOTP/DHCP, loads the file specified on the command line, or
\    the default file specified by the BOOTP/DHCP server, or the file whose
\    name is constructed from the client class.

headerless

: (silent-mode? ( -- flag )
   false " silent-mode?" " /options" find-package  if
      get-package-property 0=  if
         nip
      then
   else
      2drop
   then
   diagnostic-mode?  and
;

create spinner$
   ascii | c,
   ascii / c,
   ascii - c,
   ascii \ c,

variable activity	\ packet counter
variable spinner
variable load-base

: show-status ( adr -- adr )
   activity @ 0= if  load-base @ u.  then
   1 activity tuck +! @ h# 3f and 0= if
       1 spinner tuck +! @ 3 and
       spinner$ + c@ emit bs emit
   then
;

: init-show-progress ( -- )
   (silent-mode?  if  ['] noop  else  ['] show-status  then  to show-progress
;

\ Construct the default file names for the second-stage boot program
\ Using the IP address and the architecture, if boot protocol is RARP
\ Using the client class identifier if boot protocol is DHCP/BOOTP

: (rarp-tftp-file  ( -- pstr )
   base @ >r hex
   my-ip-addr be-l@  <# u# u# u# u# u# u# u# u# u#>  2dup upper  ( adr len )
   r> base !
   tftp-file-buf pack drop
   tftp-file-buf
;

: (dhcp-tftp-file  ( -- pstr )   my-class-id   ;

: decimal-byte?  ( adr,len -- byte true -or- false )
   base @ >r  decimal  $number  r> base !
   if  false exit  then
   dup 0 d# 255 between  if  true  else  drop 0  then
;

: $ip#  ( ip-str -- ip# | 0 )
   0                            ( ip-str 0 )
   3 0 do                       ( ip-str 0 )
      >r                        ( ip-str )
      ascii . left-parse-string ( r-str l-str )
      decimal-byte?  if         ( r-str n )
         r> 8 << or             ( r-str n' )
      else                      ( r-str )
         r> drop 0 leave        ( r-str 0 )
      then                      ( r-str n' )
   loop                         ( r-str { n' | 0 } )
   dup  if                      ( r-str n' )
      -rot ?dup  if             ( n' r-str )
         decimal-byte?  if      ( n' byte )
            swap 8 << or        ( n" )
         else                   ( n' )
            drop 0              ( 0 )
         then                   ( n" | 0 )
      else                      ( n' adr )
         2drop 0                ( 0 )
      then                      ( n" | 0 )
   else                         ( r-str 0 )
      nip nip                   ( 0 )
   then                         ( ip# | 0 )
;

\ Split comma delimited string and strip leading & trailing blanks
: next-argument ( args$ -- rem$ first$ )
   ascii , left-parse-string  -trailing -leading
;

: parse-args  ( args$ -- )

   use-dhcp off                           ( args$ )
   tftp-file-buf off                      ( args$ )

   ?dup 0=  if  drop exit  then

   over dup  " bootp"  comp  0=
   swap  " dhcp"  comp  0=  or  if
      ascii , left-parse-string   2drop
      use-dhcp  on
   then
   ?dup 0=  if  drop exit  then           ( rem$ )

   next-argument ?dup  if                 ( rem$ server-ip$ )
      $ip# server-ip-addr be-l!
      server-ip-addr broadcast-ip-addr? 0=  to use-server?
   else
      drop
   then                                   ( rem$ )
   ?dup 0=  if  drop exit  then           ( rem$ )

   next-argument ?dup  if                 ( rem$ file$ )
      tftp-file-buf pack
      count bounds  ?do
         i c@ ascii | =  if  ascii / i c!  then
         i c@ ascii \ =  if  ascii / i c!  then
      loop
      ['] tftp-file-buf to tftp-file
   else
      drop
   then
   ?dup 0=  if  drop exit  then           ( rem$ )

   next-argument ?dup  if                 ( rem$ my-ip$ )
      $ip# my-ip-addr be-l!
   else
      drop
   then                                   ( rem$ )
   ?dup 0=  if  drop exit  then           ( rem$ )

   next-argument ?dup  if                 ( rem$ router-ip$ )
      $ip# router-ip-addr be-l!
      router-ip-addr broadcast-ip-addr? 0=  to use-router?
   else
      drop
   then                                   ( rem$ )
   ?dup 0=  if  drop exit  then           ( rem$ )

   next-argument ?dup  if                 ( rem$ dhcp-tries$ )
      $number 0=  if  ( .. boot-retry-count ) to dhcp-retries  then
   else
      drop
   then                                   ( rem$ )
   ?dup 0=  if  drop exit  then           ( rem$ )

   next-argument ?dup  if                 ( rem$ tftp-tries$ )
      $number 0=  if  ( .. tftp-retry-count ) to tftp-retries then
   else
      drop
   then                                   ( rem$ )
   ?dup 0=  if  drop exit  then           ( rem$ )

   next-argument ?dup  if                 ( rem$ subnet-mask$ )
      $ip# subnet-mask be-l!
   else
      drop
   then                                   ( rem$ )
   2drop                                  ( )
;

: init-net-params  ( -- )
   mac-address drop         my-en-addr   6  cmove
   0  my-ip-addr  be-l!
   broadcast-ip-addr server-ip-addr  4 cmove
   broadcast-en-addr his-en-addr     6 cmove
   broadcast-ip-addr subnet-mask     4 cmove
   broadcast-ip-addr router-ip-addr  4 cmove
;

: check-netconfig-params ( -- )
   server-ip-addr broadcast-ip-addr?  if
      ." TFTP server's IP address not known!"
      abort
   then
   need-router?  if
      router-ip-addr broadcast-ip-addr?  if
        ." Need router-ip to communicate with TFTP server"
        abort
      then
      router-ip-addr be-l@  on-my-net? 0=  if
         ." Router must be on network " my-netid .inetaddr
         abort
      then
   then
;

\ Get the next-hop routing information. If the server is on the 
\ connected network, the datagram is sent directly; otherwise,
\ it is routed to a gateway.
: set-dest-ip-en-addr ( -- )
   need-router?  if
      router-ip-addr his-ip-addr 4 cmove
      broadcast-en-addr his-en-addr 6 cmove
      do-arp
      server-ip-addr his-ip-addr 4 cmove
   else
      server-ip-addr his-ip-addr ip= 0=  if
         server-ip-addr his-ip-addr 4 cmove
         broadcast-en-addr his-en-addr 6 cmove
         do-arp
      then
   then
;

\ Show IP addresses of client, server and, if applicable, the gateway
: show-net-addresses  ( -- )
   ." Server IP address: " server-ip-addr be-l@  .inetaddr cr
   ." Client IP address: " my-ip-addr  be-l@  .inetaddr cr
   router-ip-addr broadcast-ip-addr?  0=  if
      ." Router IP address: "  router-ip-addr be-l@  .inetaddr cr
   then
   subnet-mask broadcast-ip-addr? 0=  if
      ." Subnet Mask      : " subnet-mask be-l@  .inetaddr cr
   then
;

external
\ Sun standard network package for booting support.

: read   ( buf len -- actual-len )  " read"  $call-parent  ;
: write  ( buf len -- actual-len )  " write" $call-parent  ;
: seek   ( offset-low offset-high -- okay? )  " seek" $call-parent  ;

: open   ( -- okay? )
   init-show-progress
   init-net-params
   my-args  ['] parse-args  catch  if
      2drop false
   else
      true
   then
;
: close  ( -- ) ;

: load  ( adr -- len )
   dup load-base ! activity off spinner off
   use-dhcp @  if
      ['] do-dhcp  catch  if  ." BOOTP/DHCP failed"  abort  then
      tftp-file-buf cstrlen  0=  if
         ['] (dhcp-tftp-file  to tftp-file
      then
   else
      do-rarp
      use-server? 0=  if  his-ip-addr server-ip-addr 4 cmove  then
      tftp-file-buf cstrlen  0=  if
         ['] (rarp-tftp-file  to  tftp-file
      then
   then

   \ It is legal for RARP replies to not contain the responder's IP address. 
   \ In this case, TFTP code will broadcast the tftpread request and lock 
   \ onto the server which responds. We validate configuration parameters 
   \ and determine next-hop information for all other cases.

   use-dhcp @ 0=  server-ip-addr broadcast-ip-addr?  and  0=  if
      check-netconfig-params  set-dest-ip-en-addr
   then

   tftp-file count tftpread
   diagnostic-mode?  if  cr show-net-addresses  then
;
Commit	Line	Data
920dae64 AT	1	\ ========== Copyright Header Begin ==========================================
	2	\
	3	\ Hypervisor Software File: netload.fth
	4	\
	5	\ Copyright (c) 2006 Sun Microsystems, Inc. All Rights Reserved.
	6	\
	7	\ - Do no alter or remove copyright notices
	8	\
	9	\ - Redistribution and use of this software in source and binary forms, with
	10	\ or without modification, are permitted provided that the following
	11	\ conditions are met:
	12	\
	13	\ - Redistribution of source code must retain the above copyright notice,
	14	\ this list of conditions and the following disclaimer.
	15	\
	16	\ - Redistribution in binary form must reproduce the above copyright notice,
	17	\ this list of conditions and the following disclaimer in the
	18	\ documentation and/or other materials provided with the distribution.
	19	\
	20	\ Neither the name of Sun Microsystems, Inc. or the names of contributors
	21	\ may be used to endorse or promote products derived from this software
	22	\ without specific prior written permission.
	23	\
	24	\ This software is provided "AS IS," without a warranty of any kind.
	25	\ ALL EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES,
	26	\ INCLUDING ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A
	27	\ PARTICULAR PURPOSE OR NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN
	28	\ MICROSYSTEMS, INC. ("SUN") AND ITS LICENSORS SHALL NOT BE LIABLE FOR
	29	\ ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR
	30	\ DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN
	31	\ OR ITS LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR
	32	\ FOR DIRECT, INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE
	33	\ DAMAGES, HOWEVER CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY,
	34	\ ARISING OUT OF THE USE OF OR INABILITY TO USE THIS SOFTWARE, EVEN IF
	35	\ SUN HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
	36	\
	37	\ You acknowledge that this software is not designed, licensed or
	38	\ intended for use in the design, construction, operation or maintenance of
	39	\ any nuclear facility.
	40	\
	41	\ ========== Copyright Header End ============================================
	42	id: @(#)netload.fth 2.24 03/08/20
	43	purpose: Network loading using TFTP.
	44	copyright: Copyright 1990-2003 Sun Microsystems, Inc. All Rights Reserved
	45	copyright: Use is subject to license terms.
	46
	47	\ DHCP/BOOTP syntax is
	48	\ boot net:[bootp\|dhcp][,server-ipaddr][,boot-filename][,client-ip-addr]
	49	\ [,router-ip-addr][,boot-retries][,tftp-retries][,subnet-mask]
	50
	51	\ Network loading using TFTP. Loads one of
	52	\ a) a named file using the "dload" command,
	53	\ b) Or the default tftpboot file whose name is constructed from
	54	\ the Internet address (derived from the Ethernet address with RARP)
	55	\ and the CPU architecture type.
	56	\ c) If using BOOTP/DHCP, loads the file specified on the command line, or
	57	\ the default file specified by the BOOTP/DHCP server, or the file whose
	58	\ name is constructed from the client class.
	59
	60	headerless
	61
	62	: (silent-mode? ( -- flag )
	63	false " silent-mode?" " /options" find-package if
	64	get-package-property 0= if
65	nip
66	then
67	else
68	2drop
69	then
70	diagnostic-mode? and
71	;
72
73	create spinner$
74	ascii \| c,
75	ascii / c,
76	ascii - c,
77	ascii \ c,
78
79	variable activity \ packet counter
80	variable spinner
81	variable load-base
82
83	: show-status ( adr -- adr )
84	activity @ 0= if load-base @ u. then
85	1 activity tuck +! @ h# 3f and 0= if
86	1 spinner tuck +! @ 3 and
87	spinner$ + c@ emit bs emit
88	then
89	;
90
91	: init-show-progress ( -- )
92	(silent-mode? if ['] noop else ['] show-status then to show-progress
93	;
94
95	\ Construct the default file names for the second-stage boot program
96	\ Using the IP address and the architecture, if boot protocol is RARP
97	\ Using the client class identifier if boot protocol is DHCP/BOOTP
98
99	: (rarp-tftp-file ( -- pstr )
100	base @ >r hex
101	my-ip-addr be-l@ <# u# u# u# u# u# u# u# u# u#> 2dup upper ( adr len )
102	r> base !
103	tftp-file-buf pack drop
104	tftp-file-buf
105	;
106
107	: (dhcp-tftp-file ( -- pstr ) my-class-id ;
108
109	: decimal-byte? ( adr,len -- byte true -or- false )
110	base @ >r decimal $number r> base !
111	if false exit then
112	dup 0 d# 255 between if true else drop 0 then
113	;
114
115	: $ip# ( ip-str -- ip# \| 0 )
116	0 ( ip-str 0 )
117	3 0 do ( ip-str 0 )
118	>r ( ip-str )
119	ascii . left-parse-string ( r-str l-str )
120	decimal-byte? if ( r-str n )
121	r> 8 << or ( r-str n' )
122	else ( r-str )
123	r> drop 0 leave ( r-str 0 )
124	then ( r-str n' )
125	loop ( r-str { n' \| 0 } )
126	dup if ( r-str n' )
127	-rot ?dup if ( n' r-str )
128	decimal-byte? if ( n' byte )
129	swap 8 << or ( n" )
130	else ( n' )
131	drop 0 ( 0 )
132	then ( n" \| 0 )
133	else ( n' adr )
134	2drop 0 ( 0 )
135	then ( n" \| 0 )
136	else ( r-str 0 )
137	nip nip ( 0 )
138	then ( ip# \| 0 )
139	;
140
141	\ Split comma delimited string and strip leading & trailing blanks
142	: next-argument ( args$ -- rem$ first$ )
143	ascii , left-parse-string -trailing -leading
144	;
145
146	: parse-args ( args$ -- )
147
148	use-dhcp off ( args$ )
149	tftp-file-buf off ( args$ )
150
151	?dup 0= if drop exit then
152
153	over dup " bootp" comp 0=
154	swap " dhcp" comp 0= or if
155	ascii , left-parse-string 2drop
156	use-dhcp on
157	then
158	?dup 0= if drop exit then ( rem$ )
159
160	next-argument ?dup if ( rem$ server-ip$ )
161	$ip# server-ip-addr be-l!
162	server-ip-addr broadcast-ip-addr? 0= to use-server?
163	else
164	drop
165	then ( rem$ )
166	?dup 0= if drop exit then ( rem$ )
167
168	next-argument ?dup if ( rem$ file$ )
169	tftp-file-buf pack
170	count bounds ?do
171	i c@ ascii \| = if ascii / i c! then
172	i c@ ascii \ = if ascii / i c! then
173	loop
174	['] tftp-file-buf to tftp-file
175	else
176	drop
177	then
178	?dup 0= if drop exit then ( rem$ )
179
180	next-argument ?dup if ( rem$ my-ip$ )
181	$ip# my-ip-addr be-l!
182	else
183	drop
184	then ( rem$ )
185	?dup 0= if drop exit then ( rem$ )
186
187	next-argument ?dup if ( rem$ router-ip$ )
188	$ip# router-ip-addr be-l!
189	router-ip-addr broadcast-ip-addr? 0= to use-router?
190	else
191	drop
192	then ( rem$ )
193	?dup 0= if drop exit then ( rem$ )
194
195	next-argument ?dup if ( rem$ dhcp-tries$ )
196	$number 0= if ( .. boot-retry-count ) to dhcp-retries then
197	else
198	drop
199	then ( rem$ )
200	?dup 0= if drop exit then ( rem$ )
201
202	next-argument ?dup if ( rem$ tftp-tries$ )
203	$number 0= if ( .. tftp-retry-count ) to tftp-retries then
204	else
205	drop
206	then ( rem$ )
207	?dup 0= if drop exit then ( rem$ )
208
209	next-argument ?dup if ( rem$ subnet-mask$ )
210	$ip# subnet-mask be-l!
211	else
212	drop
213	then ( rem$ )
214	2drop ( )
215	;
216
217	: init-net-params ( -- )
218	mac-address drop my-en-addr 6 cmove
219	0 my-ip-addr be-l!
220	broadcast-ip-addr server-ip-addr 4 cmove
221	broadcast-en-addr his-en-addr 6 cmove
222	broadcast-ip-addr subnet-mask 4 cmove
223	broadcast-ip-addr router-ip-addr 4 cmove
224	;
225
226	: check-netconfig-params ( -- )
227	server-ip-addr broadcast-ip-addr? if
228	." TFTP server's IP address not known!"
229	abort
230	then
231	need-router? if
232	router-ip-addr broadcast-ip-addr? if
233	." Need router-ip to communicate with TFTP server"
234	abort
235	then
236	router-ip-addr be-l@ on-my-net? 0= if
237	." Router must be on network " my-netid .inetaddr
238	abort
239	then
240	then
241	;
242
243	\ Get the next-hop routing information. If the server is on the
244	\ connected network, the datagram is sent directly; otherwise,
245	\ it is routed to a gateway.
246	: set-dest-ip-en-addr ( -- )
247	need-router? if
248	router-ip-addr his-ip-addr 4 cmove
249	broadcast-en-addr his-en-addr 6 cmove
250	do-arp
251	server-ip-addr his-ip-addr 4 cmove
252	else
253	server-ip-addr his-ip-addr ip= 0= if
254	server-ip-addr his-ip-addr 4 cmove
255	broadcast-en-addr his-en-addr 6 cmove
256	do-arp
257	then
258	then
259	;
260
261	\ Show IP addresses of client, server and, if applicable, the gateway
262	: show-net-addresses ( -- )
263	." Server IP address: " server-ip-addr be-l@ .inetaddr cr
264	." Client IP address: " my-ip-addr be-l@ .inetaddr cr
265	router-ip-addr broadcast-ip-addr? 0= if
266	." Router IP address: " router-ip-addr be-l@ .inetaddr cr
267	then
268	subnet-mask broadcast-ip-addr? 0= if
269	." Subnet Mask : " subnet-mask be-l@ .inetaddr cr
270	then
271	;
272
273	external
274	\ Sun standard network package for booting support.
275
276	: read ( buf len -- actual-len ) " read" $call-parent ;
277	: write ( buf len -- actual-len ) " write" $call-parent ;
278	: seek ( offset-low offset-high -- okay? ) " seek" $call-parent ;
279
280	: open ( -- okay? )
281	init-show-progress
282	init-net-params
283	my-args ['] parse-args catch if
284	2drop false
285	else
286	true
287	then
288	;
289	: close ( -- ) ;
290
291	: load ( adr -- len )
292	dup load-base ! activity off spinner off
293	use-dhcp @ if
294	['] do-dhcp catch if ." BOOTP/DHCP failed" abort then
295	tftp-file-buf cstrlen 0= if
296	['] (dhcp-tftp-file to tftp-file
297	then
298	else
299	do-rarp
300	use-server? 0= if his-ip-addr server-ip-addr 4 cmove then
301	tftp-file-buf cstrlen 0= if
302	['] (rarp-tftp-file to tftp-file
303	then
304	then
305
306	\ It is legal for RARP replies to not contain the responder's IP address.
307	\ In this case, TFTP code will broadcast the tftpread request and lock
308	\ onto the server which responds. We validate configuration parameters
309	\ and determine next-hop information for all other cases.
310
311	use-dhcp @ 0= server-ip-addr broadcast-ip-addr? and 0= if
312	check-netconfig-params set-dest-ip-en-addr
313	then
314
315	tftp-file count tftpread
316	diagnostic-mode? if cr show-net-addresses then
317	;