| 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 |