[OpenSPARC-T2-SAM] / obp / obp / pkg / netinet / arp.fth

\ ========== Copyright Header Begin ==========================================
\ 
\ Hypervisor Software File: arp.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: @(#)arp.fth 1.1 04/09/07
purpose: ARP support
copyright: Copyright 2004 Sun Microsystems, Inc.  All Rights Reserved
copyright: Use is subject to license terms.

\ RFC 826: Ethernet Address Resolution Protocol

fload ${BP}/pkg/netinet/arp-h.fth

headerless

\ The ARP cache maintains recent mappings of IP to hardware addresses.
\ Unresolved entries maintain a queue of datagrams to be sent when the 
\ address is resolved. We only queue the most recent datagram to be
\ sent to a specified destination while that address is being resolved.

\ Enqueue datagram waiting for ARP resolution.
: arpq-enqueue ( arpentry pkt -- )
   swap  >ae-pktq  dup queue-empty? 0=  if		( pkt queue )
      dup pkt-dequeue pkt-free				( pkt queue )
   then							( pkt queue )
   swap pkt-enqueue					( )
;

\ Send datagrams waiting for ARP resolution.
: arpq-send ( arpentry -- )
   dup >ae-pktq  swap >ae-hwaddr			( queue hwaddr )
   begin  over pkt-dequeue ?dup while			( queue hwaddr pkt )
      2dup ip-len@ swap IP_TYPE if-output drop		( queue hwaddr )
   repeat  2drop					( )
;

\ Destroy queued datagrams
: arpq-free ( entry -- )
   >ae-pktq  begin  dup pkt-dequeue  ?dup while  pkt-free  repeat  drop
;

\ Allocate an entry in the ARP table. Choose an unused entry if one
\ exists. Otherwise, entries are replaced in a round-robin fashion. 

0  instance value  ae-next	\ Next entry to replace/write

: arp-alloc-entry ( -- entry )
   ARP_TABLE_SIZE 0 do
      ae-next index>arp-entry ae-state@ AE_FREE =  if leave  then 
      ae-next 1+ ARP_TABLE_SIZE mod to ae-next
   loop
   ae-next index>arp-entry				( entry )
   dup ae-state@ AE_PENDING =  if			( entry )
      dup arpq-free					( entry )
   then							( entry )
   dup >ae-pktq queue-init				( entry )
   AE_PENDING over ae-state!				( entry )
   0 over >ae-attempts l!				( entry )
   ae-next 1+ ARP_TABLE_SIZE mod to ae-next		( entry )
;

\ Add a RESOLVED entry to the ARP cache.
: arp-add-entry ( ipaddr hwaddr -- )
   arp-alloc-entry					( ipaddr hwaddr entry )
   tuck		  >ae-hwaddr           copy-hw-addr	( ipaddr entry )
   tuck		  >ae-ipaddr           copy-ip-addr	( entry )
   ARP_ENTRY_TTL  over >ae-timer swap  set-timer	( entry )
   AE_RESOLVED    swap                 ae-state!	( )
;

\ Mark an entry as FREE. Free queued datagram, if any.
: arp-free-entry ( entry -- )
   dup ae-state@ AE_FREE <>  if				( entry )
      dup arpq-free					( entry )
   then							( entry )
   AE_FREE swap ae-state!				( )
;

\ Find ARP entry for specified protocol address.
: arp-find-entry ( ipaddr -- entry )
   ARP_TABLE_SIZE 0 do					( ipaddr )
      i index>arp-entry dup ae-state@ AE_FREE <>  if	( ipaddr adr )
         2dup >ae-ipaddr ip=  if			( ipaddr adr )
            nip unloop exit				( entry )
         then						( ipaddr adr )
      then  drop					( ipaddr )
   loop  drop 0
;

\ Handle ARP table updates. If a translation for the sender's IP address
\ already exists, update the sender's hardware address and "refresh"
\ the cache entry; if this address was pending resolution, mark the
\ cache entry as RESOLVED and send any queued packet. Else, create
\ an entry for the sender if we are the target of the request.

: arptable-update ( pkt -- )
   dup >arp-spa  arp-find-entry ?dup if			( pkt entry )
      swap >arp-sha  over >ae-hwaddr  copy-hw-addr	( entry )
      dup >ae-timer  ARP_ENTRY_TTL  set-timer		( entry )
      dup ae-state@  AE_PENDING =  if			( entry )
         AE_RESOLVED over ae-state!  			( entry )
         dup arpq-send					( entry ) 
      then  drop					( )
   else                                                 ( pkt )
      dup >arp-tpa my-ip-addr ip=  if			( pkt )
         dup >arp-spa  over >arp-sha  arp-add-entry	( pkt )
      then  drop					( )
   then                                                 ( )
;

: arp-packet-ok? ( pkt len -- ok? )
   over >arp-hwtype ntohw@  if-htype@ =  if		( pkt len )
      over >arp-prtype ntohw@  IP_TYPE =  if		( pkt len )
         nip /arp-packet >=  exit			( ok? )
      then						( pkt len )
   then							( pkt len )
   2drop false						( false )
;

\ ARP input packet processing. Respond to incoming ARP requests, and 
\ handle ARP cache updates.

: arp-input ( pkt len -- )

   over swap arp-packet-ok? 0=  if  pkt-free exit  then		( pkt )

   \ Process each packet for ARP cache updates. If address spoofing 
   \ is detected, an error is logged and a reply is sent even if 
   \ this host was not the target.

   dup >arp-spa my-ip-addr ip= if				( pkt )
      my-ip-addr inaddr-any? 0=  if
         dup >arp-sha if-showaddr ."  is also using "  my-ip-addr .ipaddr cr
         my-ip-addr  over >arp-tpa  copy-ip-addr
      then
   else
      dup arptable-update
   then								( pkt )

   \ If this is an ARP request and this host is the target, send a
   \ response. Dont respond to ARP requests until our IP address
   \ has been determined.

   my-ip-addr inaddr-any?         if  pkt-free exit  then	( pkt )
   dup >arp-tpa  my-ip-addr ip<>  if  pkt-free exit  then
   dup >arp-op ntohw@  ARP_REQ <> if  pkt-free exit  then

   ARP_REPLY     over >arp-op   htonw!				( pkt )
   dup >arp-sha  over >arp-tha  copy-hw-addr			( pkt )
   if-hwaddr     over >arp-sha  copy-hw-addr			( pkt )
   dup >arp-spa  over >arp-tpa  copy-ip-addr			( pkt )
   my-ip-addr    over >arp-spa  copy-ip-addr			( pkt )

   /arp-packet over >arp-tha ARP_TYPE if-output drop		( ) 
;
['] arp-input  to (arp-input)

\ Common code to construct and transmit ARP and RARP packets.
: send-arp/rarp-packet ( target.ip target.ha arp.op type -- )
   pkt-alloc ?dup 0=  if  2drop 2drop exit  then	( tpa tha op type pkt )
   swap >r						( tpa tha op pkt )
   if-htype@   over >arp-hwtype  htonw!			( tpa tha op pkt )
   IP_TYPE     over >arp-prtype  htonw!			( tpa tha op pkt )
   if-addrlen@ over >arp-hwlen   c!			( tpa tha op pkt )
   /ip-addr    over >arp-prlen   c!			( tpa tha op pkt )
   if-hwaddr   over >arp-sha     copy-hw-addr		( tpa tha op pkt )
   my-ip-addr  over >arp-spa     copy-ip-addr		( tpa tha op pkt )
   tuck             >arp-op      htonw!			( tpa tha pkt )
   tuck             >arp-tha     copy-hw-addr		( tpa pkt )
   tuck             >arp-tpa     copy-ip-addr		( pkt )
   /arp-packet if-broadcast r> if-output drop		( ) ( r: )
;

\ Transmit an ARP request for the sought IP address.
: arprequest ( ipaddr -- )
   if-broadcast ARP_REQ ARP_TYPE send-arp/rarp-packet
;

\ ARP address resolution. If a translation exists, the interface layer 
\ can send the packet.  If not, initiate an ARP query and queue this 
\ packet for transmission once the address is resolved. If the destination 
\ is pending address resolution, only the most recent datagram is held 
\ for transmission.

: arp-resolve ( pkt ipaddr -- hwaddr true | false ) 
   dup ip=broadcast? if				( pkt ipaddr )
      2drop if-broadcast true exit		( hwaddr true )
   then						( pkt ipaddr )
   dup arp-find-entry ?dup if			( pkt ipaddr entry )
      nip dup ae-state@ AE_RESOLVED =  if	( pkt entry )
         nip >ae-hwaddr true			( hwaddr true )
      else					( pkt entry )
         swap arpq-enqueue false		( false )
      then					( hwaddr true | false ) 
   else						( pkt ipaddr )
      arp-alloc-entry				( pkt ipaddr entry )
      2dup >ae-ipaddr copy-ip-addr		( pkt ipaddr entry )
      rot over swap arpq-enqueue		( ipaddr entry )
      swap arprequest				( entry )
      >ae-timer ARP_RETRY_INTERVAL set-timer	( )
      false					( false )
   then						( hwaddr true | false ) 
;

\ Handling timer expiration events. If this entry is pending address
\ resolution, retransmit the ARP request; if the retransmission limit 
\ has been reached, deallocate the queued packet and free the entry.
\ Else, if this is a resolved entry, its maximum time-to-live has 
\ expired, and the entry is freed.

: ae-do-timer-events ( arpentry -- )
   dup >ae-timer timer-expired? 0=  if  drop exit  then		( entry )
   dup ae-state@ AE_RESOLVED =  if				( entry )
      arp-free-entry						( )
   else								( entry )
      1 over >ae-attempts +!					( entry )
      dup >ae-attempts l@  ARP_MAX_RETRIES >  if		( entry )
         arp-free-entry						( )
      else							( entry )
         dup >ae-ipaddr arprequest				( entry )
         >ae-timer ARP_RETRY_INTERVAL set-timer			( )
      then							( )
   then								( )
;

\ Periodic ARP cache maintenance. Runs once every second; iterate through 
\ ARP cache entries checking for and handling timer expiration events. 

/timer  instance buffer:  arp-event-timer

: arp-do-timer-events ( -- )
   arp-event-timer timer-expired? if				( )
      arp-event-timer d# 1000 set-timer				( )
      ARP_TABLE_SIZE 0  do					( )
         i index>arp-entry  dup ae-state@ AE_FREE <>  if	( arpentry )
            dup ae-do-timer-events				( arpentry )
         then  drop						( )
      loop							( )
   then								( )
;

\ Check to see if a given IP address is already in use.
: arp-check ( sought-ip ntries -- in-use? )
   0 ?do						( ip )
      get-msecs ARP_RETRY_INTERVAL +			( ip timeout )
      over arprequest					( ip timeout )
      begin						( ip timeout )
         if-poll					( ip timeout )
         over arp-find-entry ?dup if			( ip timeout entry )
            ae-state@ AE_RESOLVED =  if			( ip timeout )
               2drop true unloop exit			( true )
            then  					( ip timeout )
         then						( ip timeout )
         dup timed-out?					( ip timeout flag )
      until  drop					( ip )
   loop  drop false					( false )
;

\ Initialize ARP layer state.
: arp-init ( -- )
   ARP_TABLE_SIZE /arp-entry * alloc-mem  to arp-table		( )
   ARP_TABLE_SIZE 0 do						( )
      AE_FREE i index>arp-entry ae-state!			( )
   loop								( )
   0 to ae-next							( )
   arp-event-timer d# 1000 set-timer				( )
;

\ Free all ARP resources. 
: arp-close ( -- )
   ARP_TABLE_SIZE 0 do  i index>arp-entry arp-free-entry  loop
   arp-table ARP_TABLE_SIZE /arp-entry * free-mem
   0 to arp-table
;

[ifdef] DEBUG

: show-arp-table ( -- )
   ARP_TABLE_SIZE 0 do
      i .d  2 spaces  
      i index>arp-entry  dup ae-state@  case
         AE_FREE     of  ." Free"  endof
         AE_PENDING  of
            ." Pending "  dup >ae-ipaddr .ipaddr
         endof
         AE_RESOLVED of
            ." Resolved "
            dup >ae-ipaddr .ipaddr  2 spaces 
            dup >ae-hwaddr if-showaddr
         endof
      endcase  drop cr
   loop
;

[then]

headers
Commit	Line	Data
920dae64 AT	1	\ ========== Copyright Header Begin ==========================================
	2	\
	3	\ Hypervisor Software File: arp.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: @(#)arp.fth 1.1 04/09/07
	43	purpose: ARP support
	44	copyright: Copyright 2004 Sun Microsystems, Inc. All Rights Reserved
	45	copyright: Use is subject to license terms.
	46
	47	\ RFC 826: Ethernet Address Resolution Protocol
	48
	49	fload ${BP}/pkg/netinet/arp-h.fth
	50
	51	headerless
	52
	53	\ The ARP cache maintains recent mappings of IP to hardware addresses.
	54	\ Unresolved entries maintain a queue of datagrams to be sent when the
	55	\ address is resolved. We only queue the most recent datagram to be
	56	\ sent to a specified destination while that address is being resolved.
	57
	58	\ Enqueue datagram waiting for ARP resolution.
	59	: arpq-enqueue ( arpentry pkt -- )
	60	swap >ae-pktq dup queue-empty? 0= if ( pkt queue )
	61	dup pkt-dequeue pkt-free ( pkt queue )
	62	then ( pkt queue )
	63	swap pkt-enqueue ( )
	64	;
65
66	\ Send datagrams waiting for ARP resolution.
67	: arpq-send ( arpentry -- )
68	dup >ae-pktq swap >ae-hwaddr ( queue hwaddr )
69	begin over pkt-dequeue ?dup while ( queue hwaddr pkt )
70	2dup ip-len@ swap IP_TYPE if-output drop ( queue hwaddr )
71	repeat 2drop ( )
72	;
73
74	\ Destroy queued datagrams
75	: arpq-free ( entry -- )
76	>ae-pktq begin dup pkt-dequeue ?dup while pkt-free repeat drop
77	;
78
79	\ Allocate an entry in the ARP table. Choose an unused entry if one
80	\ exists. Otherwise, entries are replaced in a round-robin fashion.
81
82	0 instance value ae-next \ Next entry to replace/write
83
84	: arp-alloc-entry ( -- entry )
85	ARP_TABLE_SIZE 0 do
86	ae-next index>arp-entry ae-state@ AE_FREE = if leave then
87	ae-next 1+ ARP_TABLE_SIZE mod to ae-next
88	loop
89	ae-next index>arp-entry ( entry )
90	dup ae-state@ AE_PENDING = if ( entry )
91	dup arpq-free ( entry )
92	then ( entry )
93	dup >ae-pktq queue-init ( entry )
94	AE_PENDING over ae-state! ( entry )
95	0 over >ae-attempts l! ( entry )
96	ae-next 1+ ARP_TABLE_SIZE mod to ae-next ( entry )
97	;
98
99	\ Add a RESOLVED entry to the ARP cache.
100	: arp-add-entry ( ipaddr hwaddr -- )
101	arp-alloc-entry ( ipaddr hwaddr entry )
102	tuck >ae-hwaddr copy-hw-addr ( ipaddr entry )
103	tuck >ae-ipaddr copy-ip-addr ( entry )
104	ARP_ENTRY_TTL over >ae-timer swap set-timer ( entry )
105	AE_RESOLVED swap ae-state! ( )
106	;
107
108	\ Mark an entry as FREE. Free queued datagram, if any.
109	: arp-free-entry ( entry -- )
110	dup ae-state@ AE_FREE <> if ( entry )
111	dup arpq-free ( entry )
112	then ( entry )
113	AE_FREE swap ae-state! ( )
114	;
115
116	\ Find ARP entry for specified protocol address.
117	: arp-find-entry ( ipaddr -- entry )
118	ARP_TABLE_SIZE 0 do ( ipaddr )
119	i index>arp-entry dup ae-state@ AE_FREE <> if ( ipaddr adr )
120	2dup >ae-ipaddr ip= if ( ipaddr adr )
121	nip unloop exit ( entry )
122	then ( ipaddr adr )
123	then drop ( ipaddr )
124	loop drop 0
125	;
126
127	\ Handle ARP table updates. If a translation for the sender's IP address
128	\ already exists, update the sender's hardware address and "refresh"
129	\ the cache entry; if this address was pending resolution, mark the
130	\ cache entry as RESOLVED and send any queued packet. Else, create
131	\ an entry for the sender if we are the target of the request.
132
133	: arptable-update ( pkt -- )
134	dup >arp-spa arp-find-entry ?dup if ( pkt entry )
135	swap >arp-sha over >ae-hwaddr copy-hw-addr ( entry )
136	dup >ae-timer ARP_ENTRY_TTL set-timer ( entry )
137	dup ae-state@ AE_PENDING = if ( entry )
138	AE_RESOLVED over ae-state! ( entry )
139	dup arpq-send ( entry )
140	then drop ( )
141	else ( pkt )
142	dup >arp-tpa my-ip-addr ip= if ( pkt )
143	dup >arp-spa over >arp-sha arp-add-entry ( pkt )
144	then drop ( )
145	then ( )
146	;
147
148	: arp-packet-ok? ( pkt len -- ok? )
149	over >arp-hwtype ntohw@ if-htype@ = if ( pkt len )
150	over >arp-prtype ntohw@ IP_TYPE = if ( pkt len )
151	nip /arp-packet >= exit ( ok? )
152	then ( pkt len )
153	then ( pkt len )
154	2drop false ( false )
155	;
156
157	\ ARP input packet processing. Respond to incoming ARP requests, and
158	\ handle ARP cache updates.
159
160	: arp-input ( pkt len -- )
161
162	over swap arp-packet-ok? 0= if pkt-free exit then ( pkt )
163
164	\ Process each packet for ARP cache updates. If address spoofing
165	\ is detected, an error is logged and a reply is sent even if
166	\ this host was not the target.
167
168	dup >arp-spa my-ip-addr ip= if ( pkt )
169	my-ip-addr inaddr-any? 0= if
170	dup >arp-sha if-showaddr ." is also using " my-ip-addr .ipaddr cr
171	my-ip-addr over >arp-tpa copy-ip-addr
172	then
173	else
174	dup arptable-update
175	then ( pkt )
176
177	\ If this is an ARP request and this host is the target, send a
178	\ response. Dont respond to ARP requests until our IP address
179	\ has been determined.
180
181	my-ip-addr inaddr-any? if pkt-free exit then ( pkt )
182	dup >arp-tpa my-ip-addr ip<> if pkt-free exit then
183	dup >arp-op ntohw@ ARP_REQ <> if pkt-free exit then
184
185	ARP_REPLY over >arp-op htonw! ( pkt )
186	dup >arp-sha over >arp-tha copy-hw-addr ( pkt )
187	if-hwaddr over >arp-sha copy-hw-addr ( pkt )
188	dup >arp-spa over >arp-tpa copy-ip-addr ( pkt )
189	my-ip-addr over >arp-spa copy-ip-addr ( pkt )
190
191	/arp-packet over >arp-tha ARP_TYPE if-output drop ( )
192	;
193	['] arp-input to (arp-input)
194
195	\ Common code to construct and transmit ARP and RARP packets.
196	: send-arp/rarp-packet ( target.ip target.ha arp.op type -- )
197	pkt-alloc ?dup 0= if 2drop 2drop exit then ( tpa tha op type pkt )
198	swap >r ( tpa tha op pkt )
199	if-htype@ over >arp-hwtype htonw! ( tpa tha op pkt )
200	IP_TYPE over >arp-prtype htonw! ( tpa tha op pkt )
201	if-addrlen@ over >arp-hwlen c! ( tpa tha op pkt )
202	/ip-addr over >arp-prlen c! ( tpa tha op pkt )
203	if-hwaddr over >arp-sha copy-hw-addr ( tpa tha op pkt )
204	my-ip-addr over >arp-spa copy-ip-addr ( tpa tha op pkt )
205	tuck >arp-op htonw! ( tpa tha pkt )
206	tuck >arp-tha copy-hw-addr ( tpa pkt )
207	tuck >arp-tpa copy-ip-addr ( pkt )
208	/arp-packet if-broadcast r> if-output drop ( ) ( r: )
209	;
210
211	\ Transmit an ARP request for the sought IP address.
212	: arprequest ( ipaddr -- )
213	if-broadcast ARP_REQ ARP_TYPE send-arp/rarp-packet
214	;
215
216	\ ARP address resolution. If a translation exists, the interface layer
217	\ can send the packet. If not, initiate an ARP query and queue this
218	\ packet for transmission once the address is resolved. If the destination
219	\ is pending address resolution, only the most recent datagram is held
220	\ for transmission.
221
222	: arp-resolve ( pkt ipaddr -- hwaddr true \| false )
223	dup ip=broadcast? if ( pkt ipaddr )
224	2drop if-broadcast true exit ( hwaddr true )
225	then ( pkt ipaddr )
226	dup arp-find-entry ?dup if ( pkt ipaddr entry )
227	nip dup ae-state@ AE_RESOLVED = if ( pkt entry )
228	nip >ae-hwaddr true ( hwaddr true )
229	else ( pkt entry )
230	swap arpq-enqueue false ( false )
231	then ( hwaddr true \| false )
232	else ( pkt ipaddr )
233	arp-alloc-entry ( pkt ipaddr entry )
234	2dup >ae-ipaddr copy-ip-addr ( pkt ipaddr entry )
235	rot over swap arpq-enqueue ( ipaddr entry )
236	swap arprequest ( entry )
237	>ae-timer ARP_RETRY_INTERVAL set-timer ( )
238	false ( false )
239	then ( hwaddr true \| false )
240	;
241
242	\ Handling timer expiration events. If this entry is pending address
243	\ resolution, retransmit the ARP request; if the retransmission limit
244	\ has been reached, deallocate the queued packet and free the entry.
245	\ Else, if this is a resolved entry, its maximum time-to-live has
246	\ expired, and the entry is freed.
247
248	: ae-do-timer-events ( arpentry -- )
249	dup >ae-timer timer-expired? 0= if drop exit then ( entry )
250	dup ae-state@ AE_RESOLVED = if ( entry )
251	arp-free-entry ( )
252	else ( entry )
253	1 over >ae-attempts +! ( entry )
254	dup >ae-attempts l@ ARP_MAX_RETRIES > if ( entry )
255	arp-free-entry ( )
256	else ( entry )
257	dup >ae-ipaddr arprequest ( entry )
258	>ae-timer ARP_RETRY_INTERVAL set-timer ( )
259	then ( )
260	then ( )
261	;
262
263	\ Periodic ARP cache maintenance. Runs once every second; iterate through
264	\ ARP cache entries checking for and handling timer expiration events.
265
266	/timer instance buffer: arp-event-timer
267
268	: arp-do-timer-events ( -- )
269	arp-event-timer timer-expired? if ( )
270	arp-event-timer d# 1000 set-timer ( )
271	ARP_TABLE_SIZE 0 do ( )
272	i index>arp-entry dup ae-state@ AE_FREE <> if ( arpentry )
273	dup ae-do-timer-events ( arpentry )
274	then drop ( )
275	loop ( )
276	then ( )
277	;
278
279	\ Check to see if a given IP address is already in use.
280	: arp-check ( sought-ip ntries -- in-use? )
281	0 ?do ( ip )
282	get-msecs ARP_RETRY_INTERVAL + ( ip timeout )
283	over arprequest ( ip timeout )
284	begin ( ip timeout )
285	if-poll ( ip timeout )
286	over arp-find-entry ?dup if ( ip timeout entry )
287	ae-state@ AE_RESOLVED = if ( ip timeout )
288	2drop true unloop exit ( true )
289	then ( ip timeout )
290	then ( ip timeout )
291	dup timed-out? ( ip timeout flag )
292	until drop ( ip )
293	loop drop false ( false )
294	;
295
296	\ Initialize ARP layer state.
297	: arp-init ( -- )
298	ARP_TABLE_SIZE /arp-entry * alloc-mem to arp-table ( )
299	ARP_TABLE_SIZE 0 do ( )
300	AE_FREE i index>arp-entry ae-state! ( )
301	loop ( )
302	0 to ae-next ( )
303	arp-event-timer d# 1000 set-timer ( )
304	;
305
306	\ Free all ARP resources.
307	: arp-close ( -- )
308	ARP_TABLE_SIZE 0 do i index>arp-entry arp-free-entry loop
309	arp-table ARP_TABLE_SIZE /arp-entry * free-mem
310	0 to arp-table
311	;
312
313	[ifdef] DEBUG
314
315	: show-arp-table ( -- )
316	ARP_TABLE_SIZE 0 do
317	i .d 2 spaces
318	i index>arp-entry dup ae-state@ case
319	AE_FREE of ." Free" endof
320	AE_PENDING of
321	." Pending " dup >ae-ipaddr .ipaddr
322	endof
323	AE_RESOLVED of
324	." Resolved "
325	dup >ae-ipaddr .ipaddr 2 spaces
326	dup >ae-hwaddr if-showaddr
327	endof
328	endcase drop cr
329	loop
330	;
331
332	[then]
333
334	headers