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

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

\ RFC 815: IP Datagram Reassembly Algorithms

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

headerless

/queue-head  instance buffer:  iprd-list	\ Reassembly descriptor list

\ Create a new frag hole descriptor entry
: ipfhd-create ( start end -- ipfhd )
   /ipf-hole-descriptor alloc-mem		( start end ipfhd )
   tuck >ipfhd-end l!  tuck >ipfhd-start l!	( ipfhd )
;

\ Free a frag hole descriptor entry
: ipfhd-free ( ipfhd -- )  /ipf-hole-descriptor free-mem  ;

\ Hole descriptor list initialization. The initial entry describes the 
\ datagram as being completely missing. 

: iprd-hdlist-init ( iprd -- )
   >iprd-hdlist  dup queue-init					( hdlist )
   0  IP_MAX_PKTSIZE /ip-header -  1- ipfhd-create enqueue	( )
;

\ Manage hole descriptor updates. If the arriving datagram fills a hole
\ described by a hole descriptor entry, that entry is destroyed, and
\ any new hole descriptors, if necessary, are created.

: ipfhd-update ( ipfhd pkt -- )
   swap						( pkt ipfhd )
   over ipf-start@  over ipfhd-end@  >  if	( pkt ipfhd )
      2drop exit				( )
   then						( pkt ipfhd )
   over ipf-end@   over ipfhd-start@ <  if	( pkt ipfhd )
      2drop exit				( )
   then						( pkt ipfhd )
   over ipf-start@  over ipfhd-start@ >  if	( pkt ipfhd )
      2dup ipfhd-start@  swap ipf-start@ 1-	( pkt ipfhd nhd-start,end )
      ipfhd-create				( pkt ipfhd ipfhd-new )
      over queue-prev  swap insqueue		( pkf ipfhd )
   then						( pkt ipfhd )
   over ipf-end@  over ipfhd-end@  <  if	( pkt ipfhd )
      over ipf-flags@ IP_MF and  if		( pkt ipfhd )
         over ipf-end@ 1+   over ipfhd-end@	( pkt ipfhd nhd-start,end )
         ipfhd-create				( pkt ipfhd ipfhd-new )
         over swap insqueue			( pkt ipfhd )
      then					( pkt ipfhd )
   then						( pkt ipfhd )
   nip  dup remqueue  ipfhd-free		( )
;

\ Updating the hole descriptor list. Clear any holes which the arriving
\ datagram may fill.

: iprd-hdlist-update ( iprd pkt -- )
   >r						( iprd ) ( r: pkt )
   >iprd-hdlist  dup queue-first		( hdlist ipfhd )
   begin  2dup queue-end? 0=  while		( hdlist ipfhd )
      dup queue-next swap			( hdlist ipfhd' ipfhd )
      r@ ipfhd-update				( hdlist ipfhd' )
   repeat  					( hdlist ipfhd' )
   r> 3drop					( ) ( r: )
;

\ Checking for completion of reassembly. Reassembly is complete if the
\ hole descriptor list is now empty.

: iprd-dgram-complete? ( iprd -- flag )
   >iprd-hdlist queue-empty?
;

\ Constructing the final datagram. Once all fragments have been received,
\ build a valid datagram header and return it.

: iprd-make-datagram ( iprd -- dgram )
   dup >iprd-dgram @					( iprd dgram )
   swap >iprd-dglen w@  over >ip-len       htonw!	( dgram )
   0                    over >ip-fraginfo  htonw!	( dgram )
;

\ Set reassembly timeout.
: iprd-set-ttl ( iprd -- )  >iprd-ttl IP_REASM_TTL set-timer ;

\ Check for reassembly timer expiry
: iprd-timer-expired? ( iprd -- flag )  >iprd-ttl timer-expired?  ;

\ Create reassembly descriptor for the incoming fragment. If a reassembly
\ buffer cannot be allocated, the packet will be dropped.
 
: iprd-create ( ippkt -- iprd | 0 )
   lrgpkt-alloc ?dup 0=  if  drop 0 exit  then		( pkt lrgpkt )

   /ipreasm-descriptor alloc-mem			( pkt lrgpkt iprd )
   dup iprd-hdlist-init					( pkt lrgpkt iprd )

   tuck                    >iprd-dgram     !		( pkt iprd )
   0                  over >iprd-dglen     w!		( pkt iprd )
   over >ip-src       over >iprd-src       copy-ip-addr	( pkt iprd )
   over >ip-dest      over >iprd-dest      copy-ip-addr	( pkt iprd )
   over >ip-id ntohw@ over >iprd-dgid      w!		( pkt iprd )
   swap ip-protocol@  over >iprd-protocol  c!		( iprd )

   dup iprd-set-ttl					( iprd )
   iprd-list over enqueue				( iprd )
;

\ Free datagram reassembly descriptor
: iprd-free ( iprd -- )
   dup remqueue  /ipreasm-descriptor free-mem
;

\ Destroy all resources held for reassembling a datagram.
: iprd-destroy ( iprd -- )
   dup >iprd-dgram @  pkt-free			( iprd )
   dup >iprd-hdlist				( iprd hdlist )
   begin  dup dequeue  ?dup while		( iprd hdlist hd )
      ipfhd-free				( iprd hdlist )
   repeat  drop					( iprd )
   iprd-free					( )
;

\ Check if this reassembly descriptor is for the incoming fragment.
: iprd-match? ( pkt iprd -- pkt match? )
   over >ip-id ntohw@  over >iprd-dgid w@  =  if		( pkt iprd )
      over >ip-src  over >iprd-src  ip=  if			( pkt iprd )
         over >ip-dest  over >iprd-dest  ip=  if		( pkt iprd )
            over ip-protocol@  over >iprd-protocol c@ =  if	( pkt iprd )
               drop true exit					( pkt true )
            then						( pkt iprd )
         then							( pkt iprd )
      then							( pkt iprd )
   then								( pkt iprd )
   drop false							( pkt false )
;

\ Locate the reassembly descriptor for the incoming fragment.
: iprd-locate ( pkt -- iprd | 0 )
   iprd-list ['] iprd-match? find-queue-entry nip
;

\ Fragmented packets must have a non-zero data length.  All fragments except 
\ the last must have a length which is a multiple of 8 octets. 

: ipf-ok? ( pkt -- ok? )
   dup ip-datalen@  dup if				( pkt len )
      over ipf-flags@  IP_MF and  if			( pkt len )
         dup  3 rshift  3 lshift =			( pkt ok? ) 
      else						( pkt len )
         drop true					( pkt ok? )
      then						( pkt ok? )
   then  nip						( ok? )
;

\ Fragment processing. Copy data from the incoming fragment at the proper
\ offset in the reassembly buffer. If this is the first fragment, the IP 
\ header is copied. If this is the last fragment, the total length of the 
\ datagram is computed. 

: ipf-process-data ( iprd pkt -- )

   \ Record datagram length from the last fragment 
   dup ipf-flags@  IP_MF and  0=  if			( iprd pkt )
      2dup ipf-end@ 1+  /ip-header +			( iprd pkt iprd dglen )
      swap >iprd-dglen w!				( iprd pkt )
   then							( iprd pkt )

   \ Get pointer to reassembly buffer
   swap >iprd-dgram @					( pkt dgram )

   \ Copy IP header from the first fragment
   over ipf-start@  0= if				( pkt dgram )
      2dup /ip-header move				( pkt dgram )
   then							( pkt dgram )

   \ Copy fragment data into reassembly buffer
   over ipf-start@ +  /ip-header +			( pkt adr )
   over ippkt>payload  rot swap move			( pkt )

   pkt-free						( )
;

\ Reassembling fragmented datagrams. Locate the reassembly descriptor
\ associated with the incoming fragment, and create one if a match isn't 
\ found. If a reassembly buffer cannot be allocated, the fragment is
\ discarded. If reassembly is complete, return the complete datagram.

: ip-reassemble ( pkt -- dgram | 0 )
   dup iprd-locate  ?dup 0=  if				( pkt )
      dup iprd-create  ?dup 0=  if			( pkt )
         pkt-free 0 exit				( 0 )
      then						( pkt iprd )
   then							( pkt iprd )
   over ipf-end@ 1+  IP_MAX_PKTSIZE >  if		( pkt iprd )
      iprd-destroy  pkt-free 0 exit			( 0 )
   then							( pkt iprd )
   swap 2dup iprd-hdlist-update				( iprd pkt )
   over swap ipf-process-data				( iprd )
   dup iprd-dgram-complete?  if				( iprd )
      dup iprd-make-datagram  swap iprd-free		( dgram )
   else							( iprd )
      drop 0						( 0 )
   then							( dgram | 0 )
;

\ Check reassembly descriptor queue and release resources held by
\ entries whose reassembly timers have expired.

: ipf-do-timer-events ( -- )
   iprd-list dup queue-first			( list iprd )
   begin  2dup queue-end?  0=  while		( list iprd )
      dup queue-next swap			( list iprd' iprd )
      dup iprd-timer-expired?  if		( list iprd' iprd )
         dup iprd-destroy			( list iprd' iprd )
      then  drop				( list iprd' )
   repeat  2drop				( )
;

\ Initialize reassembly descriptor queue
: ipreasm-init  ( -- )  iprd-list queue-init ;

\ Destroy all reassembly descriptors
: ipreasm-close ( -- )
   iprd-list begin  dup dequeue  ?dup while  iprd-destroy  repeat  drop
;

\ Validate IP packet before further processing.
: ip-packet-ok? ( pkt -- ok? )
   dup ip-ver@  IP_VERSION =  if		( pkt ) 
      dup ip-hlen@  /ip-header >=  if		( pkt )
         dup ip-checksum 0=  if			( pkt )
            drop true exit			( true )
         then					( pkt )
      then					( pkt )
   then						( pkt )
   drop false					( false )
;

\ Accept broadcast packets and packets addressed to us. If we dont know
\ our IP address yet, accept all incoming datagrams.

: ip-accept-packet? ( pkt -- accept? )
   dup >ip-dest ip=broadcast?  if		( pkt )
      drop true					( true )
   else						( pkt )
      my-ip-addr inaddr-any?  if		( pkt )
         drop true				( true )
      else					( pkt )
         >ip-dest my-ip-addr ip=		( accept? )
      then					( accept? )
   then						( accept? )
;

\ IP option processing. We dont handle IP options; any options present in 
\ incoming datagrams are deleted after the IP checksum is verified.

: ip-strip-options ( ippkt -- )
   dup ip-hlen@ /ip-header <>  if			( pkt )
      dup >r						( pkt ) ( r: pkt )
      dup ip-len@  over ip-hlen@  encapsulated-data	( data datalen )
      dup /ip-header +  r@ ip-len!			( data datalen )
      /ip-header        r@ ip-hlen!			( data datalen )
      r@ /ip-header + swap move				( )
      r>						( pkt ) ( r: )
   then  drop						( )
;

: ip-process-packet ( pkt -- dgram | 0 )
   dup ip-strip-options					( pkt )
   dup >ip-fraginfo ntohw@  IP_MF IP_FRAGOFF or and if	( pkt )
      dup ipf-ok?  if					( pkt )
         ip-reassemble					( dgram | 0 )
      else						( pkt )
         pkt-free 0					( 0 )
      then						( dgram | 0 )
   then							( dgram | 0 )
;

defer (tcp-input)   ' drop to (tcp-input)	\ Forward reference
defer (udp-input)   ' drop to (udp-input)	\ Forward reference
defer (icmp-input)  ' drop to (icmp-input)	\ Forward reference

: ip-input ( pkt len -- )
   drop							( pkt )
   dup ip-packet-ok?  over ip-accept-packet? and if	( pkt )
      ip-process-packet ?dup if				( dgram )
         dup ip-protocol@  case	
            IPPROTO_TCP  of  (tcp-input)   endof
            IPPROTO_UDP  of  (udp-input)   endof
            IPPROTO_ICMP of  (icmp-input)  endof
            ( default )  swap pkt-free
         endcase
      then						( )
   else							( pkt )
      pkt-free						( )
   then							( )
; 
['] ip-input to (ip-input)

: ip-poll ( -- )
   ipf-do-timer-events  arp-do-timer-events  if-poll
;

headers
Commit	Line	Data
920dae64 AT	1	\ ========== Copyright Header Begin ==========================================
	2	\
	3	\ Hypervisor Software File: ip-input.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: @(#)ip-input.fth 1.1 04/09/07
	43	purpose: IP input routines
	44	copyright: Copyright 2004 Sun Microsystems, Inc. All Rights Reserved
	45	copyright: Use is subject to license terms.
	46
	47	\ RFC 815: IP Datagram Reassembly Algorithms
	48
	49	fload ${BP}/pkg/netinet/ipreasm-h.fth
	50
	51	headerless
	52
	53	/queue-head instance buffer: iprd-list \ Reassembly descriptor list
	54
	55	\ Create a new frag hole descriptor entry
	56	: ipfhd-create ( start end -- ipfhd )
	57	/ipf-hole-descriptor alloc-mem ( start end ipfhd )
	58	tuck >ipfhd-end l! tuck >ipfhd-start l! ( ipfhd )
	59	;
	60
	61	\ Free a frag hole descriptor entry
	62	: ipfhd-free ( ipfhd -- ) /ipf-hole-descriptor free-mem ;
	63
	64	\ Hole descriptor list initialization. The initial entry describes the
65	\ datagram as being completely missing.
66
67	: iprd-hdlist-init ( iprd -- )
68	>iprd-hdlist dup queue-init ( hdlist )
69	0 IP_MAX_PKTSIZE /ip-header - 1- ipfhd-create enqueue ( )
70	;
71
72	\ Manage hole descriptor updates. If the arriving datagram fills a hole
73	\ described by a hole descriptor entry, that entry is destroyed, and
74	\ any new hole descriptors, if necessary, are created.
75
76	: ipfhd-update ( ipfhd pkt -- )
77	swap ( pkt ipfhd )
78	over ipf-start@ over ipfhd-end@ > if ( pkt ipfhd )
79	2drop exit ( )
80	then ( pkt ipfhd )
81	over ipf-end@ over ipfhd-start@ < if ( pkt ipfhd )
82	2drop exit ( )
83	then ( pkt ipfhd )
84	over ipf-start@ over ipfhd-start@ > if ( pkt ipfhd )
85	2dup ipfhd-start@ swap ipf-start@ 1- ( pkt ipfhd nhd-start,end )
86	ipfhd-create ( pkt ipfhd ipfhd-new )
87	over queue-prev swap insqueue ( pkf ipfhd )
88	then ( pkt ipfhd )
89	over ipf-end@ over ipfhd-end@ < if ( pkt ipfhd )
90	over ipf-flags@ IP_MF and if ( pkt ipfhd )
91	over ipf-end@ 1+ over ipfhd-end@ ( pkt ipfhd nhd-start,end )
92	ipfhd-create ( pkt ipfhd ipfhd-new )
93	over swap insqueue ( pkt ipfhd )
94	then ( pkt ipfhd )
95	then ( pkt ipfhd )
96	nip dup remqueue ipfhd-free ( )
97	;
98
99	\ Updating the hole descriptor list. Clear any holes which the arriving
100	\ datagram may fill.
101
102	: iprd-hdlist-update ( iprd pkt -- )
103	>r ( iprd ) ( r: pkt )
104	>iprd-hdlist dup queue-first ( hdlist ipfhd )
105	begin 2dup queue-end? 0= while ( hdlist ipfhd )
106	dup queue-next swap ( hdlist ipfhd' ipfhd )
107	r@ ipfhd-update ( hdlist ipfhd' )
108	repeat ( hdlist ipfhd' )
109	r> 3drop ( ) ( r: )
110	;
111
112	\ Checking for completion of reassembly. Reassembly is complete if the
113	\ hole descriptor list is now empty.
114
115	: iprd-dgram-complete? ( iprd -- flag )
116	>iprd-hdlist queue-empty?
117	;
118
119	\ Constructing the final datagram. Once all fragments have been received,
120	\ build a valid datagram header and return it.
121
122	: iprd-make-datagram ( iprd -- dgram )
123	dup >iprd-dgram @ ( iprd dgram )
124	swap >iprd-dglen w@ over >ip-len htonw! ( dgram )
125	0 over >ip-fraginfo htonw! ( dgram )
126	;
127
128	\ Set reassembly timeout.
129	: iprd-set-ttl ( iprd -- ) >iprd-ttl IP_REASM_TTL set-timer ;
130
131	\ Check for reassembly timer expiry
132	: iprd-timer-expired? ( iprd -- flag ) >iprd-ttl timer-expired? ;
133
134	\ Create reassembly descriptor for the incoming fragment. If a reassembly
135	\ buffer cannot be allocated, the packet will be dropped.
136
137	: iprd-create ( ippkt -- iprd \| 0 )
138	lrgpkt-alloc ?dup 0= if drop 0 exit then ( pkt lrgpkt )
139
140	/ipreasm-descriptor alloc-mem ( pkt lrgpkt iprd )
141	dup iprd-hdlist-init ( pkt lrgpkt iprd )
142
143	tuck >iprd-dgram ! ( pkt iprd )
144	0 over >iprd-dglen w! ( pkt iprd )
145	over >ip-src over >iprd-src copy-ip-addr ( pkt iprd )
146	over >ip-dest over >iprd-dest copy-ip-addr ( pkt iprd )
147	over >ip-id ntohw@ over >iprd-dgid w! ( pkt iprd )
148	swap ip-protocol@ over >iprd-protocol c! ( iprd )
149
150	dup iprd-set-ttl ( iprd )
151	iprd-list over enqueue ( iprd )
152	;
153
154	\ Free datagram reassembly descriptor
155	: iprd-free ( iprd -- )
156	dup remqueue /ipreasm-descriptor free-mem
157	;
158
159	\ Destroy all resources held for reassembling a datagram.
160	: iprd-destroy ( iprd -- )
161	dup >iprd-dgram @ pkt-free ( iprd )
162	dup >iprd-hdlist ( iprd hdlist )
163	begin dup dequeue ?dup while ( iprd hdlist hd )
164	ipfhd-free ( iprd hdlist )
165	repeat drop ( iprd )
166	iprd-free ( )
167	;
168
169	\ Check if this reassembly descriptor is for the incoming fragment.
170	: iprd-match? ( pkt iprd -- pkt match? )
171	over >ip-id ntohw@ over >iprd-dgid w@ = if ( pkt iprd )
172	over >ip-src over >iprd-src ip= if ( pkt iprd )
173	over >ip-dest over >iprd-dest ip= if ( pkt iprd )
174	over ip-protocol@ over >iprd-protocol c@ = if ( pkt iprd )
175	drop true exit ( pkt true )
176	then ( pkt iprd )
177	then ( pkt iprd )
178	then ( pkt iprd )
179	then ( pkt iprd )
180	drop false ( pkt false )
181	;
182
183	\ Locate the reassembly descriptor for the incoming fragment.
184	: iprd-locate ( pkt -- iprd \| 0 )
185	iprd-list ['] iprd-match? find-queue-entry nip
186	;
187
188	\ Fragmented packets must have a non-zero data length. All fragments except
189	\ the last must have a length which is a multiple of 8 octets.
190
191	: ipf-ok? ( pkt -- ok? )
192	dup ip-datalen@ dup if ( pkt len )
193	over ipf-flags@ IP_MF and if ( pkt len )
194	dup 3 rshift 3 lshift = ( pkt ok? )
195	else ( pkt len )
196	drop true ( pkt ok? )
197	then ( pkt ok? )
198	then nip ( ok? )
199	;
200
201	\ Fragment processing. Copy data from the incoming fragment at the proper
202	\ offset in the reassembly buffer. If this is the first fragment, the IP
203	\ header is copied. If this is the last fragment, the total length of the
204	\ datagram is computed.
205
206	: ipf-process-data ( iprd pkt -- )
207
208	\ Record datagram length from the last fragment
209	dup ipf-flags@ IP_MF and 0= if ( iprd pkt )
210	2dup ipf-end@ 1+ /ip-header + ( iprd pkt iprd dglen )
211	swap >iprd-dglen w! ( iprd pkt )
212	then ( iprd pkt )
213
214	\ Get pointer to reassembly buffer
215	swap >iprd-dgram @ ( pkt dgram )
216
217	\ Copy IP header from the first fragment
218	over ipf-start@ 0= if ( pkt dgram )
219	2dup /ip-header move ( pkt dgram )
220	then ( pkt dgram )
221
222	\ Copy fragment data into reassembly buffer
223	over ipf-start@ + /ip-header + ( pkt adr )
224	over ippkt>payload rot swap move ( pkt )
225
226	pkt-free ( )
227	;
228
229	\ Reassembling fragmented datagrams. Locate the reassembly descriptor
230	\ associated with the incoming fragment, and create one if a match isn't
231	\ found. If a reassembly buffer cannot be allocated, the fragment is
232	\ discarded. If reassembly is complete, return the complete datagram.
233
234	: ip-reassemble ( pkt -- dgram \| 0 )
235	dup iprd-locate ?dup 0= if ( pkt )
236	dup iprd-create ?dup 0= if ( pkt )
237	pkt-free 0 exit ( 0 )
238	then ( pkt iprd )
239	then ( pkt iprd )
240	over ipf-end@ 1+ IP_MAX_PKTSIZE > if ( pkt iprd )
241	iprd-destroy pkt-free 0 exit ( 0 )
242	then ( pkt iprd )
243	swap 2dup iprd-hdlist-update ( iprd pkt )
244	over swap ipf-process-data ( iprd )
245	dup iprd-dgram-complete? if ( iprd )
246	dup iprd-make-datagram swap iprd-free ( dgram )
247	else ( iprd )
248	drop 0 ( 0 )
249	then ( dgram \| 0 )
250	;
251
252	\ Check reassembly descriptor queue and release resources held by
253	\ entries whose reassembly timers have expired.
254
255	: ipf-do-timer-events ( -- )
256	iprd-list dup queue-first ( list iprd )
257	begin 2dup queue-end? 0= while ( list iprd )
258	dup queue-next swap ( list iprd' iprd )
259	dup iprd-timer-expired? if ( list iprd' iprd )
260	dup iprd-destroy ( list iprd' iprd )
261	then drop ( list iprd' )
262	repeat 2drop ( )
263	;
264
265	\ Initialize reassembly descriptor queue
266	: ipreasm-init ( -- ) iprd-list queue-init ;
267
268	\ Destroy all reassembly descriptors
269	: ipreasm-close ( -- )
270	iprd-list begin dup dequeue ?dup while iprd-destroy repeat drop
271	;
272
273	\ Validate IP packet before further processing.
274	: ip-packet-ok? ( pkt -- ok? )
275	dup ip-ver@ IP_VERSION = if ( pkt )
276	dup ip-hlen@ /ip-header >= if ( pkt )
277	dup ip-checksum 0= if ( pkt )
278	drop true exit ( true )
279	then ( pkt )
280	then ( pkt )
281	then ( pkt )
282	drop false ( false )
283	;
284
285	\ Accept broadcast packets and packets addressed to us. If we dont know
286	\ our IP address yet, accept all incoming datagrams.
287
288	: ip-accept-packet? ( pkt -- accept? )
289	dup >ip-dest ip=broadcast? if ( pkt )
290	drop true ( true )
291	else ( pkt )
292	my-ip-addr inaddr-any? if ( pkt )
293	drop true ( true )
294	else ( pkt )
295	>ip-dest my-ip-addr ip= ( accept? )
296	then ( accept? )
297	then ( accept? )
298	;
299
300	\ IP option processing. We dont handle IP options; any options present in
301	\ incoming datagrams are deleted after the IP checksum is verified.
302
303	: ip-strip-options ( ippkt -- )
304	dup ip-hlen@ /ip-header <> if ( pkt )
305	dup >r ( pkt ) ( r: pkt )
306	dup ip-len@ over ip-hlen@ encapsulated-data ( data datalen )
307	dup /ip-header + r@ ip-len! ( data datalen )
308	/ip-header r@ ip-hlen! ( data datalen )
309	r@ /ip-header + swap move ( )
310	r> ( pkt ) ( r: )
311	then drop ( )
312	;
313
314	: ip-process-packet ( pkt -- dgram \| 0 )
315	dup ip-strip-options ( pkt )
316	dup >ip-fraginfo ntohw@ IP_MF IP_FRAGOFF or and if ( pkt )
317	dup ipf-ok? if ( pkt )
318	ip-reassemble ( dgram \| 0 )
319	else ( pkt )
320	pkt-free 0 ( 0 )
321	then ( dgram \| 0 )
322	then ( dgram \| 0 )
323	;
324
325	defer (tcp-input) ' drop to (tcp-input) \ Forward reference
326	defer (udp-input) ' drop to (udp-input) \ Forward reference
327	defer (icmp-input) ' drop to (icmp-input) \ Forward reference
328
329	: ip-input ( pkt len -- )
330	drop ( pkt )
331	dup ip-packet-ok? over ip-accept-packet? and if ( pkt )
332	ip-process-packet ?dup if ( dgram )
333	dup ip-protocol@ case
334	IPPROTO_TCP of (tcp-input) endof
335	IPPROTO_UDP of (udp-input) endof
336	IPPROTO_ICMP of (icmp-input) endof
337	( default ) swap pkt-free
338	endcase
339	then ( )
340	else ( pkt )
341	pkt-free ( )
342	then ( )
343	;
344	['] ip-input to (ip-input)
345
346	: ip-poll ( -- )
347	ipf-do-timer-events arp-do-timer-events if-poll
348	;
349
350	headers