openbios/openboot/obp/pkg/netinet/tcp-input.fth

Branch - branch -master

• Show log

  Commit

• Hash : 1a08f436
  Author :
  Date : 2010-08-25T09:23:17
  

  change to well-formed svn directory structure. git-svn-id: svn://coreboot.org/openboot/trunk@2 4486e004-3823-0410-90c7-fb508cc143bb

Download

• obp/pkg/netinet/tcp-input.fth

• \ ========== Copyright Header Begin ==========================================
  \ 
  \ Hypervisor Software File: tcp-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: @(#)tcp-input.fth 1.1 04/09/08
  purpose: TCP input and FSM management
  copyright: Copyright 2004 Sun Microsystems, Inc.  All Rights Reserved
  copyright: Use is subject to license terms.
  
  headerless
  
  : tcp-find-option ( pkt option# -- adr len true | false )
     >r							( pkt ) ( r: option#  )
     dup  dup tcpip-hlen@ ca+  swap >tcp-options		( end start )
     begin  2dup >  while					( end nxt )
        dup c@  case
           TCPOPT_NOP of  ca1+                 endof
           TCPOPT_EOL of  r> 3drop false exit  endof
           r@         of
              nip dup ca1+ c@  r> drop  true exit
           endof
           ( default )
           drop dup ca1+ c@ ca+ 0
        endcase
     repeat						( end nxt' )
     r> 3drop  false					( false ) ( r: )
  ;
  
  \ Drop the connection in response to a bad incoming segment, marking the
  \ specified error in the TCB. Send an acceptable RST segment to peer.
  
  : tcp-abort ( tcb pkt error# -- )
     >r  over swap tcp-reset  r>			( tcb error# )
     over tcb-error!				( tcb )
     TCPS_CLOSED over tcb-state!			( tcb )
     tcb-kill-timers				( )
  ;
  
  \ Determine if a received segment is acceptable (states >= SYN_RCVD).
  \ There are 4 cases for the acceptability test 
  \   SEG.LEN     RCV.WND         Test
  \     0            0        SEG.SEQ = RCV.NXT
  \     0           >0        RCV.NXT =< SEG.SEQ < RCV.NXT+RCV.WND
  \    >0            0        not acceptable
  \    >0           >0        RCV.NXT =< SEG.SEQ < RCV.NXT+RCV.WND
  \                           or RCV.NXT =< SEG.SEQ+SEG.LEN-1 < RCV.NXT+RCV.WND
  
  : tcp-segok? ( tcb pkt -- ok? )
     over rcv-wnd@ 0=  if				( tcb pkt )
        dup seg-len@ 0=  if			( tcb pkt )
           seg-seq@  swap rcv-nxt@  seq=		( result )
        else					( tcb pkt )
           2drop false				( result )
        then					( result )
     else						( tcb pkt )
        >r					( tcb ) ( r: pkt )
        dup rcv-nxt@  swap rcv-wnd@  over +	( wnd.start wnd.end )
        2dup  r@ seg-seq@  -rot  seq-within	( wnd.start wnd.end flag )
        r@ seg-len@  if				( wnd.start wnd.end flag )
           r@ seg-lastseq@  2over seq-within or	( wnd.start wnd.end result )
        then  nip nip				( result )
        r> drop					( result ) ( r: )
     then						( result )
  ;
  
  \ Generate an ACK in response to an incorrect incoming segment. The ACK
  \ reports the correctly received sequence and the current window size. 
  \ An ACK is generated only if the incoming segment is not a RST segment. 
   
  : tcp-sendack ( tcb pkt -- )
     is-tcprst? 0=  if					( tcb )
        dup TF_ACKNOW tcb-set-flags  tcp-output		( )
     else							( tcb )
        drop						( )
     then							( )
  ;
  
  \ Determine if the received ACK is acceptable (states >= ESTABLISHED).
  \ If this ACKs something not sent yet (SEG.ACK > SND.NXT), an ACK should
  \ be sent in response, and this segment must be dropped.
  
  : tcp-ackok? ( tcb pkt -- flag )
     2dup seg-ack@  swap snd-nxt@  seq>  if		( tcb pkt )
        tcp-sendack false					( false )
     else							( tcb pkt )
        2drop true					( true )
     then							( flag )
  ;
  
  \ Process incoming SYN and schedule an immediate ACK.
  : tcp-process-syn ( tcb pkt -- )
     2dup seg-seq@ 1+  swap rcv-nxt!			( tcb pkt )
     2dup seg-wnd@     swap snd-wnd!			( tcb pkt )
     2dup seg-seq@     swap snd-wl1!			( tcb pkt )
     TCPOPT_MSS tcp-find-option  if			( tcb adr len )
        drop 2 ca+ ntohw@					( tcb mss )
     else							( tcb )
        TCP_DEFAULT_MSS					( tcb mss )
     then							( tcb mss )
     over tcb-mss@ min					( tcb mss' )
     over 2dup tcb-mss!  snd-cwnd!			( tcb )
     TF_ACKNOW tcb-set-flags				( )
  ;
  
  \ Handle send window updates from remote end.
  : tcp-swindow-update ( tcb pkt -- )
     swap							( pkt tcb )
     over seg-seq@  over snd-wl1@  seq<  if		( pkt tcb )
        2drop exit					( )
     then							( pkt tcb )
     over seg-seq@  over snd-wl1@  seq=  if		( pkt tcb )
        over seg-ack@  over snd-wl2@  seq<  if		( pkt tcb )
           2drop exit					( )
        then						( pkt tcb )
     then							( pkt tcb )
     over seg-wnd@  over snd-wnd!				( pkt tcb )
     over seg-seq@  over snd-wl1!				( pkt tcb )
     swap seg-ack@  swap snd-wl2!				( )
  ;
  
  \ ACK processing. Accept send window updates, remove acknowledged data
  \ from the retransmission queue, collect RTT estimates, manage the
  \ retransmission timer, and update congestion window.
  
  : tcp-process-ack ( tcb pkt -- )
  
     \ Check for send window updates from all legal ACKs.
     2dup tcp-swindow-update				( tcb pkt )
  
     \ If the ACK is a duplicate, it can be ignored.
     swap							( pkt tcb )
     over seg-ack@  over snd-una@  seq<=  if		( pkt tcb )
        2drop exit					( )
     then							( pkt tcb )
  
     \ Remove acknowledged bytes from the send buffer.
     over seg-ack@  over snd-una@ -			( pkt tcb #acked )
     over tcb>sndbuf swap  tcpbuf-drop			( pkt tcb )
  
     \ Update SND.UNA
     over seg-ack@  over snd-una!				( pkt tcb )
  
     \ Update RTT estimators if this ACK acknowledges the
     \ sequence number being timed and the segment was
     \ not retransmitted.
     dup tcb-flags@ TF_RTTGET and  if			( pkt tcb )
        over seg-ack@  over >tcb-rttseq l@  seq>=  if	( pkt tcb )
           dup TF_RTTGET tcb-clear-flags			( pkt tcb )
           dup tcp-retransmitting? 0=  if			( pkt tcb )
              dup dup >tcbt-rexmit get-timer		( pkt tcb tcb rtt )
              tcp-update-rto				( pkt tcb )
           then						( pkt tcb )
        then						( pkt tcb )
     then							( pkt tcb )
  
     \ If all outstanding data has now been acknowledged, 
     \ cancel the retransmission timer. Else, restart it
     \ using the current RTO estimate.
     over seg-ack@  over snd-max@  seq=  if		( pkt tcb )
        dup tcp-clear-rexmit-timer			( pkt tcb )
     else							( pkt tcb )
        dup tcp-set-rexmit-timer				( pkt tcb )
     then							( pkt tcb )
  
     \ Retransmitted data, if any, has now been ACKed.
     0  over >tcb-nrexmits  l!				( pkt tcb )
  
     \ The congestion window is increased by 1 segment per
     \ ACK during slow start, or by MSS*MSS/SND.CWND for 
     \ congestion avoidance.
     nip  dup snd-cwnd@  2dup swap ssthresh@  <  if	( tcb cwnd )
        over tcb-mss@ +					( tcb cwnd' )
     else							( tcb cwnd )
        over tcb-mss@  dup *  over /  +			( tcb cwnd' )
     then							( tcb cwnd' )
     swap snd-cwnd!					( )
  ;
  
  \ Update receive sequence variables to reflect the sequence of
  \ contiguous data received successfully. 
  : tcp-rcvspace-update ( tcb seq len -- )
     +  over rcv-nxt@ -  dup if				( tcb n )
        2dup over rcv-nxt@ +       swap rcv-nxt!		( tcb n )
        2dup over rcv-wnd@ swap -  swap rcv-wnd!		( tcb n )
        over tcb>rcvbuf over       tcpbuf-count+!		( tcb n )
     then  2drop						( )
  ;
  
  \ Adding entries to the sequencing queue. When an out-of-order data
  \ segment arrives, record the sequence number and length of the
  \ segment in an entry and do an ordered insert. Sequencing queue
  \ entries are ordered on sequence numbers.
  
  : tcpseg-higher-seq#? ( n entry -- n flag )
     >tseg-seq l@ over seq>=
  ;
  
  : tcp-segq-insert ( tcb seq len -- )
     rot >tcb-segq >r					( seq len ) ( r: segq )
     /tcp-segq-entry alloc-mem				( seq len entry )
     tuck >tseg-len l!  2dup >tseg-seq l!			( seq entry )
     swap r@ ['] tcpseg-higher-seq#? find-queue-entry	( entry seq elt )
     nip  dup if						( entry elt )
        queue-prev swap insqueue				( )
     else							( entry 0 )
        drop r@ queue-last swap insqueue			( )
     then							( )
     r> drop						( ) ( r: )
  ;
  
  \ Coalescing sequence queue entries. On arrival of an in-order data
  \ segment, check to see if this segment fills any "holes" in the list.
  \ The receive sequence space variables are updated to reflect the
  \ sequence of contiguous data that has been received successfully.
  
  : tcp-segq-join ( tcb seq len -- )
     2 pick >r   tcp-rcvspace-update			( ) ( r: tcb )
     r@ >tcb-segq  dup queue-first			( segq elt )
     begin						( segq elt )
        2dup queue-end? 0=  if				( segq elt )
           dup >tseg-seq l@  r@ rcv-nxt@  seq<=		( segq elt flag )
        else						( segq elt )
           false						( segq elt false )
        then						( segq elt flag )
     while						( segq elt )
        r@ over dup >tseg-seq l@ swap >tseg-len l@	( segq elt tcb seq len )
        tcp-rcvspace-update				( segq elt )
        dup queue-next  over remqueue  swap		( segq nextelt elt )
        /tcp-segq-entry free-mem				( segq nextelt )
     repeat  2drop					( )
     r> drop						( ) ( r: )
  ;
  
  \ Copy data from segment into the (circular) receive buffer.
  : tcp-copy-data ( tcb pkt seq len -- )
     2swap over >r				( seq len tcb pkt ) ( r: tcb )
     swap tcb>rcvbuf swap				( seq len buf pkt )
     3 pick					( seq len buf pkt seq )
     over seg-seq@ - /tcpip-header + +		( seq len buf adr )
     rot  2swap  swap				( adr len buf seq )
     r@ rcv-nxt@ -  over tcpbuf-count@ +		( adr len buf offset )
     2swap 					( buf offset adr len )
     tcpbuf-write					( len' )
     r> 2drop					( ) ( r: )
  ;
  
  \ Trim segment so that it contains only data within advertised window. 
  : tcp-trim-data ( tcb pkt -- start.seq datalen )
     over rcv-nxt@  over seg-seq@  2dup seq> if	( tcb pkt rcv.nxt seq )
        over swap - >r  over seg-datalen@  r> -	( tcb pkt start.seq len )
     else						( tcb pkt rcv.nxt seq )
        nip  over seg-datalen@			( tcb pkt start.seq len )
     then						( tcb pkt start.seq len )
     2swap					( start.seq len tcb pkt )
     2dup seg-lastseq@ swap rcv-lastseq@ seq> if	( start.seq len tcb pkt )
        dup TH_FIN tcp-clear-flags		( start.seq len tcb pkt )
        seg-lastseq@  swap rcv-lastseq@ -  -	( start.seq len' )
     else						( start.seq len tcb pkt )
        2drop					( start.seq len )
     then						( start.seq datalen )
  ;
  
  \ Processing segment data. Copy data from the segment into the receive
  \ buffer and update sequencing queue entries. We ACK every other segment
  \ received. Out of order segments must be ACKed immediately. If data
  \ is being "pushed", we record the push sequence number in the TCB.
  
  : tcp-process-data ( tcb pkt -- )
  
     \ Check if the segment contains data.
     dup seg-datalen@ 0=  if  2drop exit  then		( tcb pkt )
  
     \ Trim segment to fit in window. 
     2dup tcp-trim-data					( tcb pkt seq len )
  
     \ Copy data from the segment.
     2over 2over tcp-copy-data				( tcb pkt seq len )
  
     \ Update sequencing queue entries and schedule an
     \ ACK as appropriate.
     2swap >r						( seq len tcb )( r:pkt )
     dup 2swap						( tcb tcb seq len )
     2 pick rcv-nxt@  2 pick  seq=  if			( tcb tcb seq len )
        tcp-segq-join					( tcb )
        dup  dup tcb-flags@  TF_DELACK and  if		( tcb tcb )
           TF_ACKNOW tcb-set-flags			( tcb )
        else						( tcb tcb )
           TF_DELACK tcb-set-flags			( tcb )
        then						( tcb )
     else							( tcb tcb seq len )
        tcp-segq-insert					( tcb )
        dup TF_ACKNOW tcb-set-flags			( tcb )
     then							( tcb )
     r>							( tcb pkt ) ( r: )
  
     \ Record PUSH sequence number, if any
     dup is-tcppsh?  if					( tcb pkt )
        2dup seg-lastseq@ 1+  swap >tcb-pushseq l!	( tcb pkt )
        over TF_PUSH tcb-set-flags			( tcb pkt )
     then  2drop						( )
  ;
  
  \ FIN processing. Since segments can arrive out of order, we must
  \ handle delayed controls. On receiving a FIN, information about it
  \ is stored in the TCB. Once all data up though the FIN has been
  \ received, we extend the receive sequence space past the FIN. 
  
  : tcp-process-fin ( tcb pkt -- )
  
     \ If this a FIN, record its sequence number and
     \ schedule an immediate ACK.
     dup is-tcpfin?  if					( tcb pkt )
        2dup seg-lastseq@  swap >tcb-finseq l!		( tcb pkt )
        over TF_RCVDFIN TF_ACKNOW or tcb-set-flags	( tcb pkt )
     then  drop						( tcb )
  
     \ Advance RCV.NXT over FIN.
     dup tcb-flags@ TF_RCVDFIN and  if			( tcb )
        dup rcv-nxt@  over >tcb-finseq l@  seq=  if	( tcb )
           dup rcv-nxt@ 1+  over rcv-nxt!			( tcb )
        then						( tcb )
     then  drop						( )
  ;
  
  \ Determine whether any more data can arrive on this connection.
  : tcp-receive-done? ( tcb -- flag )
     dup tcb-flags@ TF_RCVDFIN and  if			( tcb )
        dup rcv-nxt@  swap >tcb-finseq l@ 1+  seq=	( flag )
     else							( tcb )
        drop false					( false )
     then							( flag )
  ;
  
  \ Check whether our FIN has been acknowledged.
  : tcp-ourfin-acked? ( tcb pkt -- flag )
     over tcb-flags@ TF_SENTFIN and  if			( tcb pkt )
        seg-ack@  swap snd-max@  seq=			( flag )
     else							( tcb pkt )
        2drop false					( false )
     then							( flag )
  ;
  
  \ CLOSED state processing. Respond to all incoming segments with
  \ an acceptable RST.
  
  : tcps-closed ( tcb pkt -- )
     tcp-reset
  ;
  
  \ LISTEN state processing. We are waiting for incoming connections. Our
  \ simple implementation does not allocate a new TCB. On receipt of a SYN, 
  \ determine MSS to use, record the sender's address and port numbers in 
  \ the INPCB, initialize window information and enter SYN_RCVD state.
  
  : tcps-listen ( tcb pkt -- )
  
     \ Ignore incoming RST segments. If the segment is
     \ an ACK, send an acceptable RST segment. Drop the
     \ segment if it is not a SYN.
     dup is-tcprst?     if  2drop exit      then		( tcb pkt )
     dup is-tcpack?     if  tcp-reset exit  then		( tcb pkt )
     dup is-tcpsyn? 0=  if  2drop exit      then		( tcb pkt )
  
     \ Record the remote client's IP address and port
     \ identifiers in our PCB.
     over tcb>inpcb					( tcb pkt pcb )
     over dup >ip-src swap >tcp-sport ntohw@		( tcb pkt faddr fport )
     inpcb-connect					( tcb pkt )
  
     \ Process SYN (schedules an immediate ACK)
     over swap tcp-process-syn				( tcb )
  
     \ Initialize send sequence variables
     dup tcp-sendseq-init					( tcb )
  
     \ Enter SYN_RCVD state and send <SYN,ACK>
     TCPS_SYN_RCVD over tcb-state!			( tcb )
     tcp-output						( )
  ;
  
  \ SYN_SENT state processing. We are waiting for our SYN to be ACKed.
  \ On receiving a SYN, determine MSS to use on this connection. If 
  \ the segment ACKs our SYN, enter ESTABLISHED state. Else (no ACK), 
  \ this is a simultaneous open, enter SYN_RCVD state.
  
  : tcps-synsent ( tcb pkt -- )
  
     \ If this is an ACK, but not for our SYN, send a RST.
     dup is-tcpack?  if					( tcb pkt )
        over snd-nxt@  over seg-ack@  seq<>  if		( tcb pkt )
           tcp-reset exit					( )
        then						( tcb pkt )
     then							( tcb pkt )
  
     \ If this is a RST, and the ACK was acceptable, drop
     \ the connection. Otherwise (no ACK), drop the segment
     \ and return.
     dup is-tcprst?  if					( tcb pkt )
        dup is-tcpack?  if				( tcb pkt )
           ECONNREFUSED tcp-abort exit			( )
        then						( tcb pkt )
        2drop exit					( )
     then							( tcb pkt )
  
     \ If this is not a SYN, drop it and return.
     dup is-tcpsyn? 0=  if  2drop exit  then		( tcb pkt )
  
     \ Process SYN (schedules immediate ACK).
     2dup tcp-process-syn					( tcb pkt )
  
     \ Make appropriate state transition.
     dup is-tcpack?   if					( tcb pkt )
        over swap tcp-process-ack				( tcb )
        TCPS_ESTABLISHED over tcb-state!			( tcb )
     else							( tcb pkt )
        drop						( tcb )
        TCPS_SYN_RCVD over tcb-state!			( tcb )
     then                                                 ( tcb )
     tcp-output						( )
  ;
  
  \ SYN_RCVD state processing. This state is entered either as a result
  \ of a simultaneous open or after a SYN is received in the LISTEN state.
  \ We are waiting for our SYN to be ACKed to move to ESTABLISHED state.
  
  : tcps-synrcvd ( tcb pkt -- )
  
     2dup tcp-segok? 0=  if  tcp-sendack exit  then	( tcb pkt )
  
     \ Handle unacceptable segments.
     dup is-tcprst?  over is-tcpsyn?  or  if		( tcb pkt )
        ECONNRESET tcp-abort exit				( )
     then							( tcb pkt )
  
     \ If this is not an ACK, drop it and return
     dup is-tcpack? 0=  if  2drop exit  then		( tcb pkt )
  
     \ If this ACK is not acceptable, send a RST.
     over snd-una@  over seg-ack@  seq>  >r		( tcb pkt )
     over snd-max@  over seg-ack@  swap seq>  r> or  if	( tcb pkt )
        tcp-reset exit					( )
     then							( tcb pkt )
  
     \ Process the ACK.
     over swap tcp-process-ack				( tcb )
  
     \ Enter ESTABLISHED state
     TCPS_ESTABLISHED swap tcb-state!			( tcb )
  ;
  
  \ ESTABLISHED state processing. Once the connection has been established
  \ we remain in this state exchanging data and ACKs. Segments may
  \ arrive out of order. If a FIN has arrived, we transition to the
  \ CLOSE_WAIT state once all data up through the FIN has been received.
  
  : tcps-established ( tcb tcpip-pkt -- )
  
     2dup tcp-segok? 0=  if  tcp-sendack exit  then	( tcb pkt )
  
     \ Handle unacceptable segments.
     dup is-tcprst?  over is-tcpsyn?  or  if		( tcb pkt )
        ECONNRESET tcp-abort exit				( )
     then							( tcb pkt )
  
     \ Process incoming ACKs.
     dup  is-tcpack? 0=  if  2drop exit  then		( tcb pkt )
     2dup tcp-ackok? 0=  if  2drop exit  then		( tcb pkt )
     2dup tcp-process-ack					( tcb pkt )
  
     \ Process segment data and FIN.
     2dup tcp-process-data				( tcb pkt )
     2dup tcp-process-fin					( tcb pkt )
  
     \ If a FIN has arrived, and all data upto the FIN 
     \ has been received, enter CLOSE_WAIT state. 
     drop  dup tcp-receive-done?  if			( tcb )
        TCPS_CLOSE_WAIT over tcb-state!			( tcb )
     then  						( tcb )
  
     \ Send any necessary ACK
     tcp-output						( )
  ;
  
  \ CLOSE_WAIT state processing. All data has been received, and the other
  \ end has issued a "half-close". We are waiting for the application
  \ to issue a "close" before moving to the LAST_ACK state. ACKs for
  \ any data we may send must be processed.
  
  : tcps-closewait ( tcb pkt -- )
  
     2dup tcp-segok? 0=  if  tcp-sendack exit  then	( tcb pkt )
  
     \ Handle unacceptable segments.
     dup is-tcprst?  over is-tcpsyn?  or  if		( tcb pkt )
        ECONNRESET tcp-abort  exit			( )
     then							( tcb pkt )
  
     \ Process incoming ACKs. 
     dup  is-tcpack? 0=  if  2drop exit  then		( tcb pkt )
     2dup tcp-ackok? 0=  if  2drop exit  then		( tcb pkt )
     tcp-process-ack					( ) 
  ;
  
  \ LAST_ACK state processing.  A FIN has been sent when the application 
  \ issues a "close", and we are awaiting an ACK for our FIN. We can 
  \ return from "close" once our FIN has been ACKed.
  
  : tcps-lastack ( tcb pkt -- )
  
     2dup tcp-segok? 0=  if  tcp-sendack exit  then	( tcb pkt )
  
     \ Handle unacceptable segments.
     dup is-tcprst?  if  0 tcp-abort exit          then	( tcb pkt )
     dup is-tcpsyn?  if  ECONNRESET tcp-abort exit then	( tcb pkt )
  
     \ Process incoming ACKs.
     dup  is-tcpack? 0=  if  2drop exit  then		( tcb pkt )
     2dup tcp-ackok? 0=  if  2drop exit  then		( tcb pkt )
     2dup tcp-process-ack					( tcb pkt )
  
     \ Enter CLOSED state once our FIN is ACKed.
     over swap tcp-ourfin-acked?  if			( tcb )
        TCPS_CLOSED over tcb-state!			( tcb )
     then  drop						( )
  ;
  
  \ FIN_WAIT_1 state processing. A FIN has been sent on "close". The other 
  \ end may respond with a ACK for our FIN or with its own FIN or both. If 
  \ the ACK arrives alone, move to FIN_WAIT_2. If only the FIN arrives, 
  \ move to CLOSING. If both arrive, move to TIME_WAIT state.
  
  : tcps-finwait1 ( tcb tcpip-pkt -- )
  
     2dup tcp-segok? 0=  if  tcp-sendack exit  then	( tcb pkt )
  
     \ Handle unacceptable segments.
     dup is-tcprst?  over is-tcpsyn?  or  if		( tcb pkt )
        ECONNRESET tcp-abort exit				( )
     then							( tcb pkt )
  
     \ Process incoming ACKs.
     dup  is-tcpack? 0=  if  2drop exit  then		( tcb pkt )
     2dup tcp-ackok? 0=  if  2drop exit  then		( tcb pkt )
     2dup tcp-process-ack					( tcb pkt )
  
     \ Process segment data and FIN.
     2dup tcp-process-data				( tcb pkt )
     2dup tcp-process-fin					( tcb pkt )
  
     \ Make appropriate state transition.
     over swap  tcp-ourfin-acked?  if			( tcb )
        dup tcp-receive-done?  if				( tcb )
           TCPS_TIME_WAIT over tcb-state!			( tcb )
        else						( tcb )
           TCPS_FIN_WAIT_2 over tcb-state!		( tcb )
        then						( tcb )
     else							( tcb )
        dup tcp-receive-done?  if				( tcb )
           TCPS_CLOSING over tcb-state!			( tcb )
        then  						( tcb )     
     then							( tcb )
  
     \ Send any necessary ACK
     tcp-output						( )
  ;
  
  \ CLOSING state processing. FINs have been exchanged, and we are
  \ waiting for our FIN to be ACKed.
  
  : tcps-closing ( tcb pkt -- )
  
     2dup tcp-segok? 0=  if  tcp-sendack exit  then	( tcb pkt )
  
     \ Handle unacceptable segments.
     dup is-tcprst?  if  0 tcp-abort exit          then	( tcb pkt )
     dup is-tcpsyn?  if  ECONNRESET tcp-abort exit then	( tcb pkt )
  
     \ Process incoming ACKs.
     dup  is-tcpack? 0=  if  2drop exit  then		( tcb pkt )
     2dup tcp-ackok? 0=  if  2drop exit  then		( tcb pkt )
     2dup tcp-process-ack					( tcb pkt )
  
     \ Enter CLOSED state.
     drop  TCPS_CLOSED swap tcb-state!			( )
  ;
  
  \ FIN_WAIT_2 state processing. Our FIN has been ACKed, and the connection
  \ is "half-closed". We must process any incoming data while waiting for 
  \ a FIN from the other end.
  
  : tcps-finwait2 ( tcb pkt -- )
  
     2dup tcp-segok? 0=  if  tcp-sendack exit  then	( tcb pkt )
  
     \ Handle unacceptable segments.
     dup is-tcprst?  over is-tcpsyn? or  if		( tcb pkt )
        ECONNRESET tcp-abort exit				( )
     then							( tcb pkt )
  
     \ Process incoming ACKs.
     dup  is-tcpack? 0=  if  2drop exit  then		( tcb pkt )
     2dup tcp-ackok? 0=  if  2drop exit  then		( tcb pkt )
     2dup tcp-process-ack					( tcb pkt )
  
     \ Process segment data and FIN.
     2dup tcp-process-data				( tcb pkt )
     2dup tcp-process-fin					( tcb pkt )
  
     drop  dup tcp-receive-done?  if			( tcb )
        TCPS_TIME_WAIT over tcb-state!			( tcb )
     then							( tcb )
     tcp-output						( )
  ;
  
  \ TIME_WAIT state processing. The only segment that should arrive is
  \ a retransmission of the remote FIN. Send an ACK. We dont implement
  \ the 2 MSL timer.
  
  : tcps-timewait ( tcb pkt -- )
     2dup tcp-segok? 0=  if  tcp-sendack exit  then	( tcb pkt )
  
     \ Handle unacceptable packets
     dup is-tcprst?  if  0 tcp-abort exit          then	( tcb pkt )
     dup is-tcpsyn?  if  ECONNRESET tcp-abort exit then	( tcb pkt )
  
     \ Process ACK
     dup is-tcpack? 0=  if  2drop exit  then		( tcb pkt )
     over swap tcp-process-ack				( tcb )
  
     \ Acknowledge receipt of segment
     dup TF_ACKNOW tcb-set-flags  tcp-output		( )
  ;
  
  \ TCP FSM state switch table.
  create tcp-state-table
     ' tcps-closed	,	\ CLOSED
     ' tcps-listen	,	\ LISTEN
     ' tcps-synsent	,	\ SYN_SENT
     ' tcps-synrcvd	,	\ SYN_RCVD
     ' tcps-established	,	\ ESTABLISHED
     ' tcps-closewait	,	\ CLOSE_WAIT
     ' tcps-finwait1	,	\ FIN_WAIT_1
     ' tcps-closing	,	\ CLOSING
     ' tcps-lastack	,	\ LAST_ACK
     ' tcps-finwait2	,	\ FIN_WAIT_2
     ' tcps-timewait	,	\ TIME_WAIT
  
  \ Switch to routine corresponding to the current input state to process
  \ the segment.
  : tcp-process-segment ( tcb pkt -- )
     tcp-state-table  2 pick tcb-state@  na+ @  execute		( )
  ;
  
  \ Check if segment is meant for this TCB/INPCB. 
  : tcb-match? ( pkt inpcb -- pkt match? )
     over >tcp-dport ntohw@   over in-lport@   <>  if  drop false exit  then
     over >ip-dest            over >in-laddr ip<>  if  drop false exit  then
     dup inpcb>tcb tcb-state@ TCPS_LISTEN      =   if  drop true  exit  then
     over >ip-src             over >in-faddr ip<>  if  drop false exit  then
     over >tcp-sport ntohw@  swap in-fport@    =
  ;
  
  \ TCP port demultiplexing.
  : tcb-locate ( pkt -- tcb | 0 )
     tcp-inpcb-list  ['] tcb-match?  find-queue-entry nip  dup if
        inpcb>tcb
     then
  ;
  
  \ Handle incoming segments. If no matching TCB is found, an acceptable 
  \ RST is sent.
  : tcp-input ( pkt -- )
     dup tcp-checksum 0=  if			( pkt )
        dup tcb-locate  over			( pkt tcb pkt )
        2dup TR_INPUT 0 tcp-trace			( pkt tcb pkt )
        over if					( pkt tcb pkt )
           tcp-process-segment			( pkt )
        else					( pkt 0 pkt )
           tcp-reset				( pkt )
        then					( pkt )
     then						( pkt )
     pkt-free					( )
  ;
  ['] tcp-input to (tcp-input)
  
  : tcp-poll ( -- )
     tcp-do-timer-events  ip-poll
  ;
  
  \ Drain input.
  : tcp-drain-input ( -- )
     get-msecs  begin  dup get-msecs =  while  tcp-poll  repeat  drop
  ;
  
  headers
  

Download