module Network.TCP.LTS.In
( tcp_deliver_in_packet
)
where
import Foreign
import Foreign.C
import Data.List as List
import Control.Exception
import Control.Monad
import Network.TCP.Type.Base
import Network.TCP.Type.Syscall
import Network.TCP.Type.Timer
import Network.TCP.Type.Socket
import Network.TCP.Type.Datagram
import Network.TCP.Aux.Param
import Network.TCP.Aux.Misc
import Network.TCP.Aux.Output
import Network.TCP.Aux.HostMonad
import Network.TCP.Aux.SockMonad
import Network.TCP.Aux.Output
import Network.TCP.LTS.InPassive
import Network.TCP.LTS.InActive
import Network.TCP.LTS.InData
import Network.TCP.LTS.User
import Network.TCP.LTS.Out
tcp_deliver_in_packet seg = do
let sid = SocketID ((get_port $ tcp_dst seg), tcp_src seg)
ok <- has_sock sid
if ok
then tcp_deliver_packet_to_sock sid seg
else if tcp_SYN seg && (not $ tcp_ACK seg) && (not $ tcp_RST seg)
then tcp_deliver_syn_packet seg
else emit_segs $ dropwithreset seg
tcp_deliver_packet_to_sock :: SocketID -> TCPSegment -> HMonad t ()
tcp_deliver_packet_to_sock sid seg =
do h <- get_host
sock <- lookup_sock sid
let tcb = cb sock
rcb = cb_rcv sock
scb = cb_snd sock
seqnum = seq_flip_ltof $ tcp_seq seg
acknum = seq_flip_ftol $ tcp_ack seg
success <- header_prediction seg h sid sock tcb rcb scb seqnum acknum
when (not success) $
case st sock of
CLOSED -> assert (False) return ()
LISTEN -> assert (False) return ()
SYN_SENT -> let goodack = (iss tcb) < acknum && acknum <= (snd_max scb) in
if tcp_RST seg then
when (tcp_ACK seg && goodack) $ tcp_close sid
else
if tcp_SYN seg && tcp_ACK seg then
if goodack then runSMonad sid $ deliver_in_2 seg
else emit_segs $ dropwithreset seg
else return ()
SYN_RECEIVED ->
let invalidack = acknum <= snd_una scb || acknum > snd_max scb in
if tcp_RST seg then
tcp_close sid
else if tcp_SYN seg || not (tcp_ACK seg) then
return ()
else if invalidack || (seqnum < (irs tcb)) then
return ()
else do
sock <- runSMonad sid $ deliver_in_3 seg
if st sock == CLOSED then
tcp_close sid
else when (st sock /= SYN_RECEIVED) $
di3_socks_update sid
_ -> if tcp_RST seg then
when (st sock /= TIME_WAIT) $ tcp_close sid
else if tcp_SYN seg then
when (st sock==TIME_WAIT) $ emit_segs $ dropwithreset seg
else
if st sock `elem` [FIN_WAIT_1, CLOSING, LAST_ACK, FIN_WAIT_2, TIME_WAIT]
&& seqnum `seq_plus` (bufc_length $ tcp_data seg) > (rcv_nxt rcb)
then return ()
else do sock <- runSMonad sid $ deliver_in_3 seg
when (st sock == CLOSED) $ tcp_close sid
header_prediction seg h sid sock tcb rcb scb seqnum acknum =
if st sock == ESTABLISHED
&& not (tcp_SYN seg)
&& not (tcp_FIN seg)
&& not (tcp_URG seg)
&& not (tcp_RST seg)
&& tcp_ACK seg
&& seqnum == rcv_nxt rcb
&& snd_wnd scb == (tcp_win seg) `shiftL` (snd_scale tcb)
&& snd_max scb == snd_nxt scb
then if bufc_length (tcp_data seg) == 0
&& acknum > (snd_una scb)
&& acknum <= (snd_max scb)
&& snd_cwnd scb >= snd_wnd scb
&& t_dupacks scb < 3
then do
let emission_time = case (tcp_ts seg, t_rttseg scb) of
(Just (ts_val, ts_ecr), _ ) -> Just (ts_ecr `seq_minus` 1)
(Nothing, Just (ts0, seq0)) -> if acknum > seq0 then Just ts0 else Nothing
(Nothing, Nothing) -> Nothing
let t_rttinf' = case emission_time of
Just emtime -> assert ((ticks h) >= emtime) $
update_rtt ( ((ticks h) `seq_diff` emtime)*10000 ) (t_rttinf scb)
Nothing -> t_rttinf scb
let tt_rexmt' = if acknum == snd_max scb then
Nothing
else case mode_of (tt_rexmt scb) of
Nothing -> start_tt_rexmt 0 True t_rttinf' (clock h)
Just Rexmt -> start_tt_rexmt 0 True t_rttinf' (clock h)
_ -> tt_rexmt scb
let acked = acknum `seq_diff` (snd_una scb)
let snd_wnd' = snd_wnd scb acked
let sndq' = bufferchain_drop acked (sndq scb)
runSMonad sid $ do
modify_sock $ \s -> s { cb_snd = scb
{ sndq = sndq'
, t_dupacks = 0
, t_rttinf = t_rttinf'
, tt_rexmt = tt_rexmt'
, t_rttseg = if emission_time == Nothing then t_rttseg scb else Nothing
, snd_cwnd = expand_cwnd (snd_ssthresh tcb)
(t_maxseg tcb)
(tcp_maxwin `shiftL` (snd_scale tcb))
(snd_cwnd scb)
, snd_wnd = snd_wnd'
, snd_una = acknum
}
}
tcp_wakeup
tcp_output_all
return True
else if acknum == snd_una scb
&& List.null (t_segq rcb)
&& bufc_length (tcp_data seg) < (freebsd_so_rcvbuf (bufc_length $ rcvq rcb))
then do
return False
else do
return False
else do
return False