module Network.TCP.LTS.InPassive where
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.Misc
import Network.TCP.Aux.Param
import Network.TCP.Aux.Output
import Network.TCP.Aux.HostMonad
import Network.TCP.Aux.SockMonad
import Network.TCP.LTS.Out
import Network.TCP.LTS.User
tcp_deliver_syn_packet seg = do
let sidlisten = SocketID ((get_port $ tcp_dst seg), TCPAddr (IPAddr 0,0))
h <- get_host
haslisten <- has_sock sidlisten
if not haslisten then return () else do
sock <- lookup_sock sidlisten
if st sock /= LISTEN then return () else do
if accept_incoming_q0 (sock_listen sock)
then deliver_in_1 sidlisten sock seg
else return ()
deliver_in_1 sid sock seg =
do let newsid = SocketID ((get_port $ tcp_dst seg), tcp_src seg)
h <- get_host
let lis1 = sock_listen sock
should_drop = drop_from_q0 lis1
drop_sid = head $ lis_q0 lis1
oldq = lis_q0 lis1
newq = if should_drop then tail oldq else oldq
lis2 = lis1 { lis_q0 = newq++[newsid]}
update_sock sid $ \_ -> sock { sock_listen = lis2 }
when should_drop $ tcp_close drop_sid
let advmss = mssdflt
advmss' = Nothing
tf_rcvd_tstmp = case tcp_ts seg of Just _ -> True; Nothing -> False
tf_doing_tstmp' = False
(rcvbufsize', sndbufsize', t_maxseg', snd_cwnd') =
calculate_buf_sizes advmss (tcp_mss seg) Nothing False
(freebsd_so_rcvbuf) (freebsd_so_sndbuf) tf_doing_tstmp'
tf_doing_ws' = False
rcv_scale' = 0
snd_scale' = 0
rcv_window = min tcp_maxwin freebsd_so_rcvbuf
newiss = SeqLocal 1000
t_rttseg' = Just (ticks h, newiss)
seqnum = seq_flip_ltof $ tcp_seq seg
acknum = seq_flip_ftol $ tcp_ack seg
ack' = seqnum `seq_plus` 1
cb_time' = (cb_time sock)
{ tt_keep = Just (create_timer (clock h) tcptv_keep_idle)
, ts_recent = case (tcp_ts seg) of
Nothing -> ts_recent (cb_time sock)
Just (ts_val, ts_ecr) -> create_timewindow (clock h) (dtsinval) ts_val
}
cb_snd' = (cb_snd sock)
{ tt_rexmt = start_tt_rexmt 0 False (t_rttinf (cb_snd sock)) (clock h)
, snd_una = newiss
, snd_max = newiss `seq_plus` 1
, snd_nxt = newiss `seq_plus` 1
, snd_cwnd = snd_cwnd'
, t_rttseg = t_rttseg'
}
cb_rcv' = (cb_rcv sock)
{ rcv_wnd = rcv_window
, tf_rxwin0sent = (rcv_window == 0)
, last_ack_sent = ack'
, rcv_adv = ack' `seq_plus` rcv_window
, rcv_nxt = ack'
}
cb' = (cb sock)
{ iss = newiss
, irs = seqnum
, rcv_up = seqnum `seq_plus` 1
, t_maxseg = t_maxseg'
, t_advmss = advmss'
, rcv_scale = rcv_scale'
, snd_scale = snd_scale'
, tf_doing_ws = tf_doing_ws'
, tf_req_tstmp = tf_doing_tstmp'
, tf_doing_tstmp = tf_doing_tstmp'
, local_addr = tcp_dst seg
, remote_addr = tcp_src seg
, self_id = newsid
, parent_id = sid
}
let newsock = initial_tcp_socket
{ st = SYN_RECEIVED
, cb = cb'
, cb_time = cb_time'
, cb_snd = cb_snd'
, cb_rcv = cb_rcv'
}
insert_sock newsid newsock
emit_segs [TCPMessage $ make_syn_ack_segment (clock h) newsock
(tcp_dst seg) (tcp_src seg) (ticks h) ]
di3_socks_update sid = do
h <- get_host
newsock <- lookup_sock sid
let tcb = cb newsock
rcb = cb_rcv newsock
sidlisten = parent_id tcb
haslisten <- has_sock sidlisten
assert (haslisten) return ()
listensock <- lookup_sock sidlisten
let lis1 = sock_listen listensock
assert (sid `elem` (lis_q0 lis1)) return ()
if accept_incoming_q lis1 then do
let lis2 = lis1 { lis_q0 = List.delete sid (lis_q0 lis1)
, lis_q = sid : (lis_q lis1)
}
let rcv_window = calculate_bsd_rcv_wnd newsock
let newcb = (cb_rcv newsock) { rcv_wnd = rcv_window
, rcv_adv = (rcv_nxt rcb) `seq_plus` (rcv_wnd rcb)
}
update_sock sidlisten $ \_ -> listensock { sock_listen = lis2 }
update_sock sid $ \_ -> newsock { cb_rcv = newcb }
runSMonad sidlisten $ tcp_wakeup
else do
let lis2 = lis1 { lis_q0 = List.delete sid (lis_q0 lis1) }
update_sock sidlisten $ \_ -> listensock { sock_listen = lis2 }
tcp_close sid
--endif