Commit | Line | Data |
---|---|---|
920dae64 AT |
1 | \ ========== Copyright Header Begin ========================================== |
2 | \ | |
3 | \ Hypervisor Software File: tcp-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: @(#)tcp-input.fth 1.1 04/09/08 | |
43 | purpose: TCP input and FSM management | |
44 | copyright: Copyright 2004 Sun Microsystems, Inc. All Rights Reserved | |
45 | copyright: Use is subject to license terms. | |
46 | ||
47 | headerless | |
48 | ||
49 | : tcp-find-option ( pkt option# -- adr len true | false ) | |
50 | >r ( pkt ) ( r: option# ) | |
51 | dup dup tcpip-hlen@ ca+ swap >tcp-options ( end start ) | |
52 | begin 2dup > while ( end nxt ) | |
53 | dup c@ case | |
54 | TCPOPT_NOP of ca1+ endof | |
55 | TCPOPT_EOL of r> 3drop false exit endof | |
56 | r@ of | |
57 | nip dup ca1+ c@ r> drop true exit | |
58 | endof | |
59 | ( default ) | |
60 | drop dup ca1+ c@ ca+ 0 | |
61 | endcase | |
62 | repeat ( end nxt' ) | |
63 | r> 3drop false ( false ) ( r: ) | |
64 | ; | |
65 | ||
66 | \ Drop the connection in response to a bad incoming segment, marking the | |
67 | \ specified error in the TCB. Send an acceptable RST segment to peer. | |
68 | ||
69 | : tcp-abort ( tcb pkt error# -- ) | |
70 | >r over swap tcp-reset r> ( tcb error# ) | |
71 | over tcb-error! ( tcb ) | |
72 | TCPS_CLOSED over tcb-state! ( tcb ) | |
73 | tcb-kill-timers ( ) | |
74 | ; | |
75 | ||
76 | \ Determine if a received segment is acceptable (states >= SYN_RCVD). | |
77 | \ There are 4 cases for the acceptability test | |
78 | \ SEG.LEN RCV.WND Test | |
79 | \ 0 0 SEG.SEQ = RCV.NXT | |
80 | \ 0 >0 RCV.NXT =< SEG.SEQ < RCV.NXT+RCV.WND | |
81 | \ >0 0 not acceptable | |
82 | \ >0 >0 RCV.NXT =< SEG.SEQ < RCV.NXT+RCV.WND | |
83 | \ or RCV.NXT =< SEG.SEQ+SEG.LEN-1 < RCV.NXT+RCV.WND | |
84 | ||
85 | : tcp-segok? ( tcb pkt -- ok? ) | |
86 | over rcv-wnd@ 0= if ( tcb pkt ) | |
87 | dup seg-len@ 0= if ( tcb pkt ) | |
88 | seg-seq@ swap rcv-nxt@ seq= ( result ) | |
89 | else ( tcb pkt ) | |
90 | 2drop false ( result ) | |
91 | then ( result ) | |
92 | else ( tcb pkt ) | |
93 | >r ( tcb ) ( r: pkt ) | |
94 | dup rcv-nxt@ swap rcv-wnd@ over + ( wnd.start wnd.end ) | |
95 | 2dup r@ seg-seq@ -rot seq-within ( wnd.start wnd.end flag ) | |
96 | r@ seg-len@ if ( wnd.start wnd.end flag ) | |
97 | r@ seg-lastseq@ 2over seq-within or ( wnd.start wnd.end result ) | |
98 | then nip nip ( result ) | |
99 | r> drop ( result ) ( r: ) | |
100 | then ( result ) | |
101 | ; | |
102 | ||
103 | \ Generate an ACK in response to an incorrect incoming segment. The ACK | |
104 | \ reports the correctly received sequence and the current window size. | |
105 | \ An ACK is generated only if the incoming segment is not a RST segment. | |
106 | ||
107 | : tcp-sendack ( tcb pkt -- ) | |
108 | is-tcprst? 0= if ( tcb ) | |
109 | dup TF_ACKNOW tcb-set-flags tcp-output ( ) | |
110 | else ( tcb ) | |
111 | drop ( ) | |
112 | then ( ) | |
113 | ; | |
114 | ||
115 | \ Determine if the received ACK is acceptable (states >= ESTABLISHED). | |
116 | \ If this ACKs something not sent yet (SEG.ACK > SND.NXT), an ACK should | |
117 | \ be sent in response, and this segment must be dropped. | |
118 | ||
119 | : tcp-ackok? ( tcb pkt -- flag ) | |
120 | 2dup seg-ack@ swap snd-nxt@ seq> if ( tcb pkt ) | |
121 | tcp-sendack false ( false ) | |
122 | else ( tcb pkt ) | |
123 | 2drop true ( true ) | |
124 | then ( flag ) | |
125 | ; | |
126 | ||
127 | \ Process incoming SYN and schedule an immediate ACK. | |
128 | : tcp-process-syn ( tcb pkt -- ) | |
129 | 2dup seg-seq@ 1+ swap rcv-nxt! ( tcb pkt ) | |
130 | 2dup seg-wnd@ swap snd-wnd! ( tcb pkt ) | |
131 | 2dup seg-seq@ swap snd-wl1! ( tcb pkt ) | |
132 | TCPOPT_MSS tcp-find-option if ( tcb adr len ) | |
133 | drop 2 ca+ ntohw@ ( tcb mss ) | |
134 | else ( tcb ) | |
135 | TCP_DEFAULT_MSS ( tcb mss ) | |
136 | then ( tcb mss ) | |
137 | over tcb-mss@ min ( tcb mss' ) | |
138 | over 2dup tcb-mss! snd-cwnd! ( tcb ) | |
139 | TF_ACKNOW tcb-set-flags ( ) | |
140 | ; | |
141 | ||
142 | \ Handle send window updates from remote end. | |
143 | : tcp-swindow-update ( tcb pkt -- ) | |
144 | swap ( pkt tcb ) | |
145 | over seg-seq@ over snd-wl1@ seq< if ( pkt tcb ) | |
146 | 2drop exit ( ) | |
147 | then ( pkt tcb ) | |
148 | over seg-seq@ over snd-wl1@ seq= if ( pkt tcb ) | |
149 | over seg-ack@ over snd-wl2@ seq< if ( pkt tcb ) | |
150 | 2drop exit ( ) | |
151 | then ( pkt tcb ) | |
152 | then ( pkt tcb ) | |
153 | over seg-wnd@ over snd-wnd! ( pkt tcb ) | |
154 | over seg-seq@ over snd-wl1! ( pkt tcb ) | |
155 | swap seg-ack@ swap snd-wl2! ( ) | |
156 | ; | |
157 | ||
158 | \ ACK processing. Accept send window updates, remove acknowledged data | |
159 | \ from the retransmission queue, collect RTT estimates, manage the | |
160 | \ retransmission timer, and update congestion window. | |
161 | ||
162 | : tcp-process-ack ( tcb pkt -- ) | |
163 | ||
164 | \ Check for send window updates from all legal ACKs. | |
165 | 2dup tcp-swindow-update ( tcb pkt ) | |
166 | ||
167 | \ If the ACK is a duplicate, it can be ignored. | |
168 | swap ( pkt tcb ) | |
169 | over seg-ack@ over snd-una@ seq<= if ( pkt tcb ) | |
170 | 2drop exit ( ) | |
171 | then ( pkt tcb ) | |
172 | ||
173 | \ Remove acknowledged bytes from the send buffer. | |
174 | over seg-ack@ over snd-una@ - ( pkt tcb #acked ) | |
175 | over tcb>sndbuf swap tcpbuf-drop ( pkt tcb ) | |
176 | ||
177 | \ Update SND.UNA | |
178 | over seg-ack@ over snd-una! ( pkt tcb ) | |
179 | ||
180 | \ Update RTT estimators if this ACK acknowledges the | |
181 | \ sequence number being timed and the segment was | |
182 | \ not retransmitted. | |
183 | dup tcb-flags@ TF_RTTGET and if ( pkt tcb ) | |
184 | over seg-ack@ over >tcb-rttseq l@ seq>= if ( pkt tcb ) | |
185 | dup TF_RTTGET tcb-clear-flags ( pkt tcb ) | |
186 | dup tcp-retransmitting? 0= if ( pkt tcb ) | |
187 | dup dup >tcbt-rexmit get-timer ( pkt tcb tcb rtt ) | |
188 | tcp-update-rto ( pkt tcb ) | |
189 | then ( pkt tcb ) | |
190 | then ( pkt tcb ) | |
191 | then ( pkt tcb ) | |
192 | ||
193 | \ If all outstanding data has now been acknowledged, | |
194 | \ cancel the retransmission timer. Else, restart it | |
195 | \ using the current RTO estimate. | |
196 | over seg-ack@ over snd-max@ seq= if ( pkt tcb ) | |
197 | dup tcp-clear-rexmit-timer ( pkt tcb ) | |
198 | else ( pkt tcb ) | |
199 | dup tcp-set-rexmit-timer ( pkt tcb ) | |
200 | then ( pkt tcb ) | |
201 | ||
202 | \ Retransmitted data, if any, has now been ACKed. | |
203 | 0 over >tcb-nrexmits l! ( pkt tcb ) | |
204 | ||
205 | \ The congestion window is increased by 1 segment per | |
206 | \ ACK during slow start, or by MSS*MSS/SND.CWND for | |
207 | \ congestion avoidance. | |
208 | nip dup snd-cwnd@ 2dup swap ssthresh@ < if ( tcb cwnd ) | |
209 | over tcb-mss@ + ( tcb cwnd' ) | |
210 | else ( tcb cwnd ) | |
211 | over tcb-mss@ dup * over / + ( tcb cwnd' ) | |
212 | then ( tcb cwnd' ) | |
213 | swap snd-cwnd! ( ) | |
214 | ; | |
215 | ||
216 | \ Update receive sequence variables to reflect the sequence of | |
217 | \ contiguous data received successfully. | |
218 | : tcp-rcvspace-update ( tcb seq len -- ) | |
219 | + over rcv-nxt@ - dup if ( tcb n ) | |
220 | 2dup over rcv-nxt@ + swap rcv-nxt! ( tcb n ) | |
221 | 2dup over rcv-wnd@ swap - swap rcv-wnd! ( tcb n ) | |
222 | over tcb>rcvbuf over tcpbuf-count+! ( tcb n ) | |
223 | then 2drop ( ) | |
224 | ; | |
225 | ||
226 | \ Adding entries to the sequencing queue. When an out-of-order data | |
227 | \ segment arrives, record the sequence number and length of the | |
228 | \ segment in an entry and do an ordered insert. Sequencing queue | |
229 | \ entries are ordered on sequence numbers. | |
230 | ||
231 | : tcpseg-higher-seq#? ( n entry -- n flag ) | |
232 | >tseg-seq l@ over seq>= | |
233 | ; | |
234 | ||
235 | : tcp-segq-insert ( tcb seq len -- ) | |
236 | rot >tcb-segq >r ( seq len ) ( r: segq ) | |
237 | /tcp-segq-entry alloc-mem ( seq len entry ) | |
238 | tuck >tseg-len l! 2dup >tseg-seq l! ( seq entry ) | |
239 | swap r@ ['] tcpseg-higher-seq#? find-queue-entry ( entry seq elt ) | |
240 | nip dup if ( entry elt ) | |
241 | queue-prev swap insqueue ( ) | |
242 | else ( entry 0 ) | |
243 | drop r@ queue-last swap insqueue ( ) | |
244 | then ( ) | |
245 | r> drop ( ) ( r: ) | |
246 | ; | |
247 | ||
248 | \ Coalescing sequence queue entries. On arrival of an in-order data | |
249 | \ segment, check to see if this segment fills any "holes" in the list. | |
250 | \ The receive sequence space variables are updated to reflect the | |
251 | \ sequence of contiguous data that has been received successfully. | |
252 | ||
253 | : tcp-segq-join ( tcb seq len -- ) | |
254 | 2 pick >r tcp-rcvspace-update ( ) ( r: tcb ) | |
255 | r@ >tcb-segq dup queue-first ( segq elt ) | |
256 | begin ( segq elt ) | |
257 | 2dup queue-end? 0= if ( segq elt ) | |
258 | dup >tseg-seq l@ r@ rcv-nxt@ seq<= ( segq elt flag ) | |
259 | else ( segq elt ) | |
260 | false ( segq elt false ) | |
261 | then ( segq elt flag ) | |
262 | while ( segq elt ) | |
263 | r@ over dup >tseg-seq l@ swap >tseg-len l@ ( segq elt tcb seq len ) | |
264 | tcp-rcvspace-update ( segq elt ) | |
265 | dup queue-next over remqueue swap ( segq nextelt elt ) | |
266 | /tcp-segq-entry free-mem ( segq nextelt ) | |
267 | repeat 2drop ( ) | |
268 | r> drop ( ) ( r: ) | |
269 | ; | |
270 | ||
271 | \ Copy data from segment into the (circular) receive buffer. | |
272 | : tcp-copy-data ( tcb pkt seq len -- ) | |
273 | 2swap over >r ( seq len tcb pkt ) ( r: tcb ) | |
274 | swap tcb>rcvbuf swap ( seq len buf pkt ) | |
275 | 3 pick ( seq len buf pkt seq ) | |
276 | over seg-seq@ - /tcpip-header + + ( seq len buf adr ) | |
277 | rot 2swap swap ( adr len buf seq ) | |
278 | r@ rcv-nxt@ - over tcpbuf-count@ + ( adr len buf offset ) | |
279 | 2swap ( buf offset adr len ) | |
280 | tcpbuf-write ( len' ) | |
281 | r> 2drop ( ) ( r: ) | |
282 | ; | |
283 | ||
284 | \ Trim segment so that it contains only data within advertised window. | |
285 | : tcp-trim-data ( tcb pkt -- start.seq datalen ) | |
286 | over rcv-nxt@ over seg-seq@ 2dup seq> if ( tcb pkt rcv.nxt seq ) | |
287 | over swap - >r over seg-datalen@ r> - ( tcb pkt start.seq len ) | |
288 | else ( tcb pkt rcv.nxt seq ) | |
289 | nip over seg-datalen@ ( tcb pkt start.seq len ) | |
290 | then ( tcb pkt start.seq len ) | |
291 | 2swap ( start.seq len tcb pkt ) | |
292 | 2dup seg-lastseq@ swap rcv-lastseq@ seq> if ( start.seq len tcb pkt ) | |
293 | dup TH_FIN tcp-clear-flags ( start.seq len tcb pkt ) | |
294 | seg-lastseq@ swap rcv-lastseq@ - - ( start.seq len' ) | |
295 | else ( start.seq len tcb pkt ) | |
296 | 2drop ( start.seq len ) | |
297 | then ( start.seq datalen ) | |
298 | ; | |
299 | ||
300 | \ Processing segment data. Copy data from the segment into the receive | |
301 | \ buffer and update sequencing queue entries. We ACK every other segment | |
302 | \ received. Out of order segments must be ACKed immediately. If data | |
303 | \ is being "pushed", we record the push sequence number in the TCB. | |
304 | ||
305 | : tcp-process-data ( tcb pkt -- ) | |
306 | ||
307 | \ Check if the segment contains data. | |
308 | dup seg-datalen@ 0= if 2drop exit then ( tcb pkt ) | |
309 | ||
310 | \ Trim segment to fit in window. | |
311 | 2dup tcp-trim-data ( tcb pkt seq len ) | |
312 | ||
313 | \ Copy data from the segment. | |
314 | 2over 2over tcp-copy-data ( tcb pkt seq len ) | |
315 | ||
316 | \ Update sequencing queue entries and schedule an | |
317 | \ ACK as appropriate. | |
318 | 2swap >r ( seq len tcb )( r:pkt ) | |
319 | dup 2swap ( tcb tcb seq len ) | |
320 | 2 pick rcv-nxt@ 2 pick seq= if ( tcb tcb seq len ) | |
321 | tcp-segq-join ( tcb ) | |
322 | dup dup tcb-flags@ TF_DELACK and if ( tcb tcb ) | |
323 | TF_ACKNOW tcb-set-flags ( tcb ) | |
324 | else ( tcb tcb ) | |
325 | TF_DELACK tcb-set-flags ( tcb ) | |
326 | then ( tcb ) | |
327 | else ( tcb tcb seq len ) | |
328 | tcp-segq-insert ( tcb ) | |
329 | dup TF_ACKNOW tcb-set-flags ( tcb ) | |
330 | then ( tcb ) | |
331 | r> ( tcb pkt ) ( r: ) | |
332 | ||
333 | \ Record PUSH sequence number, if any | |
334 | dup is-tcppsh? if ( tcb pkt ) | |
335 | 2dup seg-lastseq@ 1+ swap >tcb-pushseq l! ( tcb pkt ) | |
336 | over TF_PUSH tcb-set-flags ( tcb pkt ) | |
337 | then 2drop ( ) | |
338 | ; | |
339 | ||
340 | \ FIN processing. Since segments can arrive out of order, we must | |
341 | \ handle delayed controls. On receiving a FIN, information about it | |
342 | \ is stored in the TCB. Once all data up though the FIN has been | |
343 | \ received, we extend the receive sequence space past the FIN. | |
344 | ||
345 | : tcp-process-fin ( tcb pkt -- ) | |
346 | ||
347 | \ If this a FIN, record its sequence number and | |
348 | \ schedule an immediate ACK. | |
349 | dup is-tcpfin? if ( tcb pkt ) | |
350 | 2dup seg-lastseq@ swap >tcb-finseq l! ( tcb pkt ) | |
351 | over TF_RCVDFIN TF_ACKNOW or tcb-set-flags ( tcb pkt ) | |
352 | then drop ( tcb ) | |
353 | ||
354 | \ Advance RCV.NXT over FIN. | |
355 | dup tcb-flags@ TF_RCVDFIN and if ( tcb ) | |
356 | dup rcv-nxt@ over >tcb-finseq l@ seq= if ( tcb ) | |
357 | dup rcv-nxt@ 1+ over rcv-nxt! ( tcb ) | |
358 | then ( tcb ) | |
359 | then drop ( ) | |
360 | ; | |
361 | ||
362 | \ Determine whether any more data can arrive on this connection. | |
363 | : tcp-receive-done? ( tcb -- flag ) | |
364 | dup tcb-flags@ TF_RCVDFIN and if ( tcb ) | |
365 | dup rcv-nxt@ swap >tcb-finseq l@ 1+ seq= ( flag ) | |
366 | else ( tcb ) | |
367 | drop false ( false ) | |
368 | then ( flag ) | |
369 | ; | |
370 | ||
371 | \ Check whether our FIN has been acknowledged. | |
372 | : tcp-ourfin-acked? ( tcb pkt -- flag ) | |
373 | over tcb-flags@ TF_SENTFIN and if ( tcb pkt ) | |
374 | seg-ack@ swap snd-max@ seq= ( flag ) | |
375 | else ( tcb pkt ) | |
376 | 2drop false ( false ) | |
377 | then ( flag ) | |
378 | ; | |
379 | ||
380 | \ CLOSED state processing. Respond to all incoming segments with | |
381 | \ an acceptable RST. | |
382 | ||
383 | : tcps-closed ( tcb pkt -- ) | |
384 | tcp-reset | |
385 | ; | |
386 | ||
387 | \ LISTEN state processing. We are waiting for incoming connections. Our | |
388 | \ simple implementation does not allocate a new TCB. On receipt of a SYN, | |
389 | \ determine MSS to use, record the sender's address and port numbers in | |
390 | \ the INPCB, initialize window information and enter SYN_RCVD state. | |
391 | ||
392 | : tcps-listen ( tcb pkt -- ) | |
393 | ||
394 | \ Ignore incoming RST segments. If the segment is | |
395 | \ an ACK, send an acceptable RST segment. Drop the | |
396 | \ segment if it is not a SYN. | |
397 | dup is-tcprst? if 2drop exit then ( tcb pkt ) | |
398 | dup is-tcpack? if tcp-reset exit then ( tcb pkt ) | |
399 | dup is-tcpsyn? 0= if 2drop exit then ( tcb pkt ) | |
400 | ||
401 | \ Record the remote client's IP address and port | |
402 | \ identifiers in our PCB. | |
403 | over tcb>inpcb ( tcb pkt pcb ) | |
404 | over dup >ip-src swap >tcp-sport ntohw@ ( tcb pkt faddr fport ) | |
405 | inpcb-connect ( tcb pkt ) | |
406 | ||
407 | \ Process SYN (schedules an immediate ACK) | |
408 | over swap tcp-process-syn ( tcb ) | |
409 | ||
410 | \ Initialize send sequence variables | |
411 | dup tcp-sendseq-init ( tcb ) | |
412 | ||
413 | \ Enter SYN_RCVD state and send <SYN,ACK> | |
414 | TCPS_SYN_RCVD over tcb-state! ( tcb ) | |
415 | tcp-output ( ) | |
416 | ; | |
417 | ||
418 | \ SYN_SENT state processing. We are waiting for our SYN to be ACKed. | |
419 | \ On receiving a SYN, determine MSS to use on this connection. If | |
420 | \ the segment ACKs our SYN, enter ESTABLISHED state. Else (no ACK), | |
421 | \ this is a simultaneous open, enter SYN_RCVD state. | |
422 | ||
423 | : tcps-synsent ( tcb pkt -- ) | |
424 | ||
425 | \ If this is an ACK, but not for our SYN, send a RST. | |
426 | dup is-tcpack? if ( tcb pkt ) | |
427 | over snd-nxt@ over seg-ack@ seq<> if ( tcb pkt ) | |
428 | tcp-reset exit ( ) | |
429 | then ( tcb pkt ) | |
430 | then ( tcb pkt ) | |
431 | ||
432 | \ If this is a RST, and the ACK was acceptable, drop | |
433 | \ the connection. Otherwise (no ACK), drop the segment | |
434 | \ and return. | |
435 | dup is-tcprst? if ( tcb pkt ) | |
436 | dup is-tcpack? if ( tcb pkt ) | |
437 | ECONNREFUSED tcp-abort exit ( ) | |
438 | then ( tcb pkt ) | |
439 | 2drop exit ( ) | |
440 | then ( tcb pkt ) | |
441 | ||
442 | \ If this is not a SYN, drop it and return. | |
443 | dup is-tcpsyn? 0= if 2drop exit then ( tcb pkt ) | |
444 | ||
445 | \ Process SYN (schedules immediate ACK). | |
446 | 2dup tcp-process-syn ( tcb pkt ) | |
447 | ||
448 | \ Make appropriate state transition. | |
449 | dup is-tcpack? if ( tcb pkt ) | |
450 | over swap tcp-process-ack ( tcb ) | |
451 | TCPS_ESTABLISHED over tcb-state! ( tcb ) | |
452 | else ( tcb pkt ) | |
453 | drop ( tcb ) | |
454 | TCPS_SYN_RCVD over tcb-state! ( tcb ) | |
455 | then ( tcb ) | |
456 | tcp-output ( ) | |
457 | ; | |
458 | ||
459 | \ SYN_RCVD state processing. This state is entered either as a result | |
460 | \ of a simultaneous open or after a SYN is received in the LISTEN state. | |
461 | \ We are waiting for our SYN to be ACKed to move to ESTABLISHED state. | |
462 | ||
463 | : tcps-synrcvd ( tcb pkt -- ) | |
464 | ||
465 | 2dup tcp-segok? 0= if tcp-sendack exit then ( tcb pkt ) | |
466 | ||
467 | \ Handle unacceptable segments. | |
468 | dup is-tcprst? over is-tcpsyn? or if ( tcb pkt ) | |
469 | ECONNRESET tcp-abort exit ( ) | |
470 | then ( tcb pkt ) | |
471 | ||
472 | \ If this is not an ACK, drop it and return | |
473 | dup is-tcpack? 0= if 2drop exit then ( tcb pkt ) | |
474 | ||
475 | \ If this ACK is not acceptable, send a RST. | |
476 | over snd-una@ over seg-ack@ seq> >r ( tcb pkt ) | |
477 | over snd-max@ over seg-ack@ swap seq> r> or if ( tcb pkt ) | |
478 | tcp-reset exit ( ) | |
479 | then ( tcb pkt ) | |
480 | ||
481 | \ Process the ACK. | |
482 | over swap tcp-process-ack ( tcb ) | |
483 | ||
484 | \ Enter ESTABLISHED state | |
485 | TCPS_ESTABLISHED swap tcb-state! ( tcb ) | |
486 | ; | |
487 | ||
488 | \ ESTABLISHED state processing. Once the connection has been established | |
489 | \ we remain in this state exchanging data and ACKs. Segments may | |
490 | \ arrive out of order. If a FIN has arrived, we transition to the | |
491 | \ CLOSE_WAIT state once all data up through the FIN has been received. | |
492 | ||
493 | : tcps-established ( tcb tcpip-pkt -- ) | |
494 | ||
495 | 2dup tcp-segok? 0= if tcp-sendack exit then ( tcb pkt ) | |
496 | ||
497 | \ Handle unacceptable segments. | |
498 | dup is-tcprst? over is-tcpsyn? or if ( tcb pkt ) | |
499 | ECONNRESET tcp-abort exit ( ) | |
500 | then ( tcb pkt ) | |
501 | ||
502 | \ Process incoming ACKs. | |
503 | dup is-tcpack? 0= if 2drop exit then ( tcb pkt ) | |
504 | 2dup tcp-ackok? 0= if 2drop exit then ( tcb pkt ) | |
505 | 2dup tcp-process-ack ( tcb pkt ) | |
506 | ||
507 | \ Process segment data and FIN. | |
508 | 2dup tcp-process-data ( tcb pkt ) | |
509 | 2dup tcp-process-fin ( tcb pkt ) | |
510 | ||
511 | \ If a FIN has arrived, and all data upto the FIN | |
512 | \ has been received, enter CLOSE_WAIT state. | |
513 | drop dup tcp-receive-done? if ( tcb ) | |
514 | TCPS_CLOSE_WAIT over tcb-state! ( tcb ) | |
515 | then ( tcb ) | |
516 | ||
517 | \ Send any necessary ACK | |
518 | tcp-output ( ) | |
519 | ; | |
520 | ||
521 | \ CLOSE_WAIT state processing. All data has been received, and the other | |
522 | \ end has issued a "half-close". We are waiting for the application | |
523 | \ to issue a "close" before moving to the LAST_ACK state. ACKs for | |
524 | \ any data we may send must be processed. | |
525 | ||
526 | : tcps-closewait ( tcb pkt -- ) | |
527 | ||
528 | 2dup tcp-segok? 0= if tcp-sendack exit then ( tcb pkt ) | |
529 | ||
530 | \ Handle unacceptable segments. | |
531 | dup is-tcprst? over is-tcpsyn? or if ( tcb pkt ) | |
532 | ECONNRESET tcp-abort exit ( ) | |
533 | then ( tcb pkt ) | |
534 | ||
535 | \ Process incoming ACKs. | |
536 | dup is-tcpack? 0= if 2drop exit then ( tcb pkt ) | |
537 | 2dup tcp-ackok? 0= if 2drop exit then ( tcb pkt ) | |
538 | tcp-process-ack ( ) | |
539 | ; | |
540 | ||
541 | \ LAST_ACK state processing. A FIN has been sent when the application | |
542 | \ issues a "close", and we are awaiting an ACK for our FIN. We can | |
543 | \ return from "close" once our FIN has been ACKed. | |
544 | ||
545 | : tcps-lastack ( tcb pkt -- ) | |
546 | ||
547 | 2dup tcp-segok? 0= if tcp-sendack exit then ( tcb pkt ) | |
548 | ||
549 | \ Handle unacceptable segments. | |
550 | dup is-tcprst? if 0 tcp-abort exit then ( tcb pkt ) | |
551 | dup is-tcpsyn? if ECONNRESET tcp-abort exit then ( tcb pkt ) | |
552 | ||
553 | \ Process incoming ACKs. | |
554 | dup is-tcpack? 0= if 2drop exit then ( tcb pkt ) | |
555 | 2dup tcp-ackok? 0= if 2drop exit then ( tcb pkt ) | |
556 | 2dup tcp-process-ack ( tcb pkt ) | |
557 | ||
558 | \ Enter CLOSED state once our FIN is ACKed. | |
559 | over swap tcp-ourfin-acked? if ( tcb ) | |
560 | TCPS_CLOSED over tcb-state! ( tcb ) | |
561 | then drop ( ) | |
562 | ; | |
563 | ||
564 | \ FIN_WAIT_1 state processing. A FIN has been sent on "close". The other | |
565 | \ end may respond with a ACK for our FIN or with its own FIN or both. If | |
566 | \ the ACK arrives alone, move to FIN_WAIT_2. If only the FIN arrives, | |
567 | \ move to CLOSING. If both arrive, move to TIME_WAIT state. | |
568 | ||
569 | : tcps-finwait1 ( tcb tcpip-pkt -- ) | |
570 | ||
571 | 2dup tcp-segok? 0= if tcp-sendack exit then ( tcb pkt ) | |
572 | ||
573 | \ Handle unacceptable segments. | |
574 | dup is-tcprst? over is-tcpsyn? or if ( tcb pkt ) | |
575 | ECONNRESET tcp-abort exit ( ) | |
576 | then ( tcb pkt ) | |
577 | ||
578 | \ Process incoming ACKs. | |
579 | dup is-tcpack? 0= if 2drop exit then ( tcb pkt ) | |
580 | 2dup tcp-ackok? 0= if 2drop exit then ( tcb pkt ) | |
581 | 2dup tcp-process-ack ( tcb pkt ) | |
582 | ||
583 | \ Process segment data and FIN. | |
584 | 2dup tcp-process-data ( tcb pkt ) | |
585 | 2dup tcp-process-fin ( tcb pkt ) | |
586 | ||
587 | \ Make appropriate state transition. | |
588 | over swap tcp-ourfin-acked? if ( tcb ) | |
589 | dup tcp-receive-done? if ( tcb ) | |
590 | TCPS_TIME_WAIT over tcb-state! ( tcb ) | |
591 | else ( tcb ) | |
592 | TCPS_FIN_WAIT_2 over tcb-state! ( tcb ) | |
593 | then ( tcb ) | |
594 | else ( tcb ) | |
595 | dup tcp-receive-done? if ( tcb ) | |
596 | TCPS_CLOSING over tcb-state! ( tcb ) | |
597 | then ( tcb ) | |
598 | then ( tcb ) | |
599 | ||
600 | \ Send any necessary ACK | |
601 | tcp-output ( ) | |
602 | ; | |
603 | ||
604 | \ CLOSING state processing. FINs have been exchanged, and we are | |
605 | \ waiting for our FIN to be ACKed. | |
606 | ||
607 | : tcps-closing ( tcb pkt -- ) | |
608 | ||
609 | 2dup tcp-segok? 0= if tcp-sendack exit then ( tcb pkt ) | |
610 | ||
611 | \ Handle unacceptable segments. | |
612 | dup is-tcprst? if 0 tcp-abort exit then ( tcb pkt ) | |
613 | dup is-tcpsyn? if ECONNRESET tcp-abort exit then ( tcb pkt ) | |
614 | ||
615 | \ Process incoming ACKs. | |
616 | dup is-tcpack? 0= if 2drop exit then ( tcb pkt ) | |
617 | 2dup tcp-ackok? 0= if 2drop exit then ( tcb pkt ) | |
618 | 2dup tcp-process-ack ( tcb pkt ) | |
619 | ||
620 | \ Enter CLOSED state. | |
621 | drop TCPS_CLOSED swap tcb-state! ( ) | |
622 | ; | |
623 | ||
624 | \ FIN_WAIT_2 state processing. Our FIN has been ACKed, and the connection | |
625 | \ is "half-closed". We must process any incoming data while waiting for | |
626 | \ a FIN from the other end. | |
627 | ||
628 | : tcps-finwait2 ( tcb pkt -- ) | |
629 | ||
630 | 2dup tcp-segok? 0= if tcp-sendack exit then ( tcb pkt ) | |
631 | ||
632 | \ Handle unacceptable segments. | |
633 | dup is-tcprst? over is-tcpsyn? or if ( tcb pkt ) | |
634 | ECONNRESET tcp-abort exit ( ) | |
635 | then ( tcb pkt ) | |
636 | ||
637 | \ Process incoming ACKs. | |
638 | dup is-tcpack? 0= if 2drop exit then ( tcb pkt ) | |
639 | 2dup tcp-ackok? 0= if 2drop exit then ( tcb pkt ) | |
640 | 2dup tcp-process-ack ( tcb pkt ) | |
641 | ||
642 | \ Process segment data and FIN. | |
643 | 2dup tcp-process-data ( tcb pkt ) | |
644 | 2dup tcp-process-fin ( tcb pkt ) | |
645 | ||
646 | drop dup tcp-receive-done? if ( tcb ) | |
647 | TCPS_TIME_WAIT over tcb-state! ( tcb ) | |
648 | then ( tcb ) | |
649 | tcp-output ( ) | |
650 | ; | |
651 | ||
652 | \ TIME_WAIT state processing. The only segment that should arrive is | |
653 | \ a retransmission of the remote FIN. Send an ACK. We dont implement | |
654 | \ the 2 MSL timer. | |
655 | ||
656 | : tcps-timewait ( tcb pkt -- ) | |
657 | 2dup tcp-segok? 0= if tcp-sendack exit then ( tcb pkt ) | |
658 | ||
659 | \ Handle unacceptable packets | |
660 | dup is-tcprst? if 0 tcp-abort exit then ( tcb pkt ) | |
661 | dup is-tcpsyn? if ECONNRESET tcp-abort exit then ( tcb pkt ) | |
662 | ||
663 | \ Process ACK | |
664 | dup is-tcpack? 0= if 2drop exit then ( tcb pkt ) | |
665 | over swap tcp-process-ack ( tcb ) | |
666 | ||
667 | \ Acknowledge receipt of segment | |
668 | dup TF_ACKNOW tcb-set-flags tcp-output ( ) | |
669 | ; | |
670 | ||
671 | \ TCP FSM state switch table. | |
672 | create tcp-state-table | |
673 | ' tcps-closed , \ CLOSED | |
674 | ' tcps-listen , \ LISTEN | |
675 | ' tcps-synsent , \ SYN_SENT | |
676 | ' tcps-synrcvd , \ SYN_RCVD | |
677 | ' tcps-established , \ ESTABLISHED | |
678 | ' tcps-closewait , \ CLOSE_WAIT | |
679 | ' tcps-finwait1 , \ FIN_WAIT_1 | |
680 | ' tcps-closing , \ CLOSING | |
681 | ' tcps-lastack , \ LAST_ACK | |
682 | ' tcps-finwait2 , \ FIN_WAIT_2 | |
683 | ' tcps-timewait , \ TIME_WAIT | |
684 | ||
685 | \ Switch to routine corresponding to the current input state to process | |
686 | \ the segment. | |
687 | : tcp-process-segment ( tcb pkt -- ) | |
688 | tcp-state-table 2 pick tcb-state@ na+ @ execute ( ) | |
689 | ; | |
690 | ||
691 | \ Check if segment is meant for this TCB/INPCB. | |
692 | : tcb-match? ( pkt inpcb -- pkt match? ) | |
693 | over >tcp-dport ntohw@ over in-lport@ <> if drop false exit then | |
694 | over >ip-dest over >in-laddr ip<> if drop false exit then | |
695 | dup inpcb>tcb tcb-state@ TCPS_LISTEN = if drop true exit then | |
696 | over >ip-src over >in-faddr ip<> if drop false exit then | |
697 | over >tcp-sport ntohw@ swap in-fport@ = | |
698 | ; | |
699 | ||
700 | \ TCP port demultiplexing. | |
701 | : tcb-locate ( pkt -- tcb | 0 ) | |
702 | tcp-inpcb-list ['] tcb-match? find-queue-entry nip dup if | |
703 | inpcb>tcb | |
704 | then | |
705 | ; | |
706 | ||
707 | \ Handle incoming segments. If no matching TCB is found, an acceptable | |
708 | \ RST is sent. | |
709 | : tcp-input ( pkt -- ) | |
710 | dup tcp-checksum 0= if ( pkt ) | |
711 | dup tcb-locate over ( pkt tcb pkt ) | |
712 | 2dup TR_INPUT 0 tcp-trace ( pkt tcb pkt ) | |
713 | over if ( pkt tcb pkt ) | |
714 | tcp-process-segment ( pkt ) | |
715 | else ( pkt 0 pkt ) | |
716 | tcp-reset ( pkt ) | |
717 | then ( pkt ) | |
718 | then ( pkt ) | |
719 | pkt-free ( ) | |
720 | ; | |
721 | ['] tcp-input to (tcp-input) | |
722 | ||
723 | : tcp-poll ( -- ) | |
724 | tcp-do-timer-events ip-poll | |
725 | ; | |
726 | ||
727 | \ Drain input. | |
728 | : tcp-drain-input ( -- ) | |
729 | get-msecs begin dup get-msecs = while tcp-poll repeat drop | |
730 | ; | |
731 | ||
732 | headers |