From 1113751ff65d228221c006cb8bc12b1db0f6b0d2 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Mon, 19 Feb 2024 02:23:40 +0100 Subject: [PATCH 01/65] tcp: Remove redundant :ack-p t :ack-p t is the default. --- net/tcp.lisp | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index 60dea0138..add47ffd8 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -383,7 +383,7 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (setf (tcp-connection-last-ack-time connection) (get-internal-run-time)) (when (not *netmangler-force-local-retransmit*) - (tcp4-send-packet connection iss (+u32 irs 1) nil :ack-p t :syn-p t)))) + (tcp4-send-packet connection iss (+u32 irs 1) nil :syn-p t)))) ((logtest flags +tcp4-flag-rst+)) ; Do nothing for resets addressed to nobody. (t (let* ((seq (if (logtest flags +tcp4-flag-ack+) @@ -474,8 +474,7 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (tcp4-send-packet connection (tcp-connection-snd.nxt connection) (tcp-connection-rcv.nxt connection) - nil - :ack-p t))) + nil))) (defun tcp-packet-sequence-number (packet start end) (declare (ignore end)) @@ -593,7 +592,7 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (tcp-connection-rcv.nxt connection) (+u32 seq 1)) (when (not *netmangler-force-local-retransmit*) (tcp4-send-packet connection ack (tcp-connection-rcv.nxt connection) nil - :ack-p t :syn-p t)) + :syn-p t)) ;; Cancel retransmit (disarm-retransmit-timer connection) (disarm-timeout-timer connection)) @@ -637,8 +636,7 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (tcp4-send-packet connection (tcp-connection-snd.nxt connection) (tcp-connection-rcv.nxt connection) - nil - :ack-p t))) + nil))) ((logtest flags +tcp4-flag-rst+) (setf (tcp-connection-pending-error connection) (make-condition 'connection-reset @@ -700,7 +698,7 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (setf (mezzano.supervisor:event-state (tcp-connection-receive-event connection)) t) - (tcp4-send-packet connection ack (+u32 seq 1) nil :ack-p t)) + (tcp4-send-packet connection ack (+u32 seq 1) nil)) (tcp4-receive-data connection data-length end header-length packet seq start))) ((eql (tcp-connection-snd.una connection) ack) ;; TODO: slow start/duplicate ack detection/fast retransmit/etc. From 3b0fe687f3973cfe42bd08888f7fb7b609ef315d Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Mon, 26 Feb 2024 00:30:05 +0100 Subject: [PATCH 02/65] tcp: Update the protocol specification link to rfc9293 --- net/tcp.lisp | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index add47ffd8..6631901d3 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -1,14 +1,8 @@ ;;; TCP ;;; ;;; Transmission Control Protocol - Protocol Specification -;;; https://tools.ietf.org/html/rfc793 +;;; https://datatracker.ietf.org/doc/html/rfc9293 ;;; -;;; EFSM/SDL modeling of the original TCP standard (RFC793) and the -;;; Congestion Control Mechanism of TCP Reno -;;; http://www.medianet.kent.edu/techreports/TR2005-07-22-tcp-EFSM.pdf -;;; -;;; Computing TCP's Retransmission Timer -;;; https://tools.ietf.org/html/rfc6298 (in-package :mezzano.network.tcp) From ef54dfb443c5525d426d055148c8111f1dc219e9 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Mon, 26 Feb 2024 00:33:24 +0100 Subject: [PATCH 03/65] tcp: Do nothing to finish segments when in state :closed or :listen --- net/tcp.lisp | 1 + 1 file changed, 1 insertion(+) diff --git a/net/tcp.lisp b/net/tcp.lisp index 6631901d3..4b4e6f911 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -379,6 +379,7 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (when (not *netmangler-force-local-retransmit*) (tcp4-send-packet connection iss (+u32 irs 1) nil :syn-p t)))) ((logtest flags +tcp4-flag-rst+)) ; Do nothing for resets addressed to nobody. + ((logtest flags +tcp4-flag-fin+)) ; Do nothing for finish since the SEG.SEQ cannot be validated (t (let* ((seq (if (logtest flags +tcp4-flag-ack+) (tcp-packet-acknowledgment-number packet start end) From c140f05c83cc17cbfa5999a5b332d1bf09e98f23 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Mon, 26 Feb 2024 00:37:27 +0100 Subject: [PATCH 04/65] tcp: Fix errata --- net/tcp.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index 4b4e6f911..a08d621b0 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -645,7 +645,7 @@ Set to a value near 2^32 to test SND sequence number wrapping.") :port (tcp-connection-remote-port connection))) (detach-tcp-connection connection) (tcp4-send-packet connection - (tcp-connection-snd.next connection) + (tcp-connection-snd.nxt connection) 0 ; ??? nil :ack-p nil From d2c38744be5ea942006e901397dbfc2c749d0821 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Mon, 26 Feb 2024 00:41:42 +0100 Subject: [PATCH 05/65] tcp: Refactor acceptable-segment-p --- net/tcp.lisp | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index a08d621b0..a21257d81 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -490,16 +490,15 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (defun tcp-packet-data-length (packet start end) (- end (+ start (tcp-packet-header-length packet start end)))) -(defun acceptable-segment-p (connection packet start end) +(defun acceptable-segment-p (connection seg.seq seg.len) (let ((rcv.wnd (tcp-connection-rcv.wnd connection)) - (rcv.nxt (tcp-connection-rcv.nxt connection)) - (seg.seq (tcp-packet-sequence-number packet start end)) - (seg.len (tcp-packet-data-length packet start end))) + (rcv.nxt (tcp-connection-rcv.nxt connection))) (if (eql rcv.wnd 0) (and (eql seg.len 0) (eql seg.seq rcv.nxt)) ;; Arithmetic here is not wrapping, so as to avoid wrap-around problems. - (and (and (<= rcv.nxt seg.seq) (< seg.seq (+ rcv.nxt rcv.wnd))) + (and (<= rcv.nxt seg.seq) + (< seg.seq (+ rcv.nxt rcv.wnd)) (or (eql seg.len 0) (let ((seq-end (+ seg.seq seg.len -1))) (and (<= rcv.nxt seq-end) (< seq-end (+ rcv.nxt rcv.wnd))))))))) @@ -626,7 +625,7 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (remhash connection (tcp-listener-pending-connections listener)) (decf (tcp-listener-n-pending-connections listener)))))) (:established - (cond ((not (acceptable-segment-p connection packet start end)) + (cond ((not (acceptable-segment-p connection seq data-length)) (when (not (logtest flags +tcp4-flag-rst+)) (tcp4-send-packet connection (tcp-connection-snd.nxt connection) From 8c0a1c15443b95dfaaab973be1d7499520b2d9ce Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Wed, 20 Mar 2024 13:04:30 +0100 Subject: [PATCH 06/65] tcp: Add tcp4-send-ack --- net/tcp.lisp | 26 ++++++++++---------------- 1 file changed, 10 insertions(+), 16 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index a21257d81..eab0d6740 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -466,10 +466,7 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (when (<= seq (tcp-connection-rcv.nxt connection)) ;; Don't check *netmangler-force-local-retransmit* here, ;; or no acks will ever get through. - (tcp4-send-packet connection - (tcp-connection-snd.nxt connection) - (tcp-connection-rcv.nxt connection) - nil))) + (tcp4-send-ack connection))) (defun tcp-packet-sequence-number (packet start end) (declare (ignore end)) @@ -627,10 +624,7 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (:established (cond ((not (acceptable-segment-p connection seq data-length)) (when (not (logtest flags +tcp4-flag-rst+)) - (tcp4-send-packet connection - (tcp-connection-snd.nxt connection) - (tcp-connection-rcv.nxt connection) - nil))) + (tcp4-send-ack connection))) ((logtest flags +tcp4-flag-rst+) (setf (tcp-connection-pending-error connection) (make-condition 'connection-reset @@ -714,10 +708,7 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (cond ((logtest flags +tcp4-flag-fin+) (setf (tcp-connection-rcv.nxt connection) (+u32 (tcp-connection-rcv.nxt connection) 1)) - (tcp4-send-packet connection - (tcp-connection-snd.nxt connection) - (tcp-connection-rcv.nxt connection) - nil) + (tcp4-send-ack connection) (if (logtest flags +tcp4-flag-ack+) ;; Remote saw our FIN and closed as well. (detach-tcp-connection connection) @@ -735,10 +726,7 @@ Set to a value near 2^32 to test SND sequence number wrapping.") ;; Remote has sent FIN and waiting for ACK (setf (tcp-connection-rcv.nxt connection) (+u32 (tcp-connection-rcv.nxt connection) 1)) - (tcp4-send-packet connection - (tcp-connection-snd.nxt connection) - (tcp-connection-rcv.nxt connection) - nil) + (tcp4-send-ack connection) (detach-tcp-connection connection)) (tcp4-receive-data connection data-length end header-length packet seq start))) (:closing @@ -779,6 +767,12 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (when errors-escape (error c)))))) +(defun tcp4-send-ack (connection) + (tcp4-send-packet connection + (tcp-connection-snd.nxt connection) + (tcp-connection-rcv.nxt connection) + nil)) + (defun compute-ip-pseudo-header-partial-checksum (src-ip dst-ip protocol length) (+ (logand src-ip #xFFFF) (logand (ash src-ip -16) #xFFFF) From e8b7f35e8710fb37aa6350af9254222a675fb59b Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Wed, 20 Mar 2024 13:12:55 +0100 Subject: [PATCH 07/65] tcp: Add challenge-ack --- net/tcp.lisp | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/net/tcp.lisp b/net/tcp.lisp index eab0d6740..45dacdd7a 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -773,6 +773,12 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (tcp-connection-rcv.nxt connection) nil)) +(defun challenge-ack (connection) + (tcp4-send-packet connection + (tcp-connection-snd.nxt connection) + (tcp-connection-rcv.nxt connection) + nil)) + (defun compute-ip-pseudo-header-partial-checksum (src-ip dst-ip protocol length) (+ (logand src-ip #xFFFF) (logand (ash src-ip -16) #xFFFF) From 0e6ca64712eae978230c108e52944e2b44909b0e Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Wed, 20 Mar 2024 14:18:28 +0100 Subject: [PATCH 08/65] tcp: Check the sequence numbers before accepting RST in :syn-sent --- net/tcp.lisp | 31 ++++++++++++++++++++++++------- 1 file changed, 24 insertions(+), 7 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index 45dacdd7a..6267605d6 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -500,6 +500,16 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (let ((seq-end (+ seg.seq seg.len -1))) (and (<= rcv.nxt seq-end) (< seq-end (+ rcv.nxt rcv.wnd))))))))) +(defun acceptable-ack-p (connection seg.ack) + "If SND.UNA < SEG.ACK <= SND.NXT, then the ACK is acceptable." + (if (< (tcp-connection-snd.una connection) + (tcp-connection-snd.nxt connection)) + (and (< (tcp-connection-snd.una connection) seg.ack) + (<= seg.ack (tcp-connection-snd.nxt connection))) + ;; Sequence numbers wrapped. + (or (< (tcp-connection-snd.una connection) seg.ack) + (<= seg.ack (tcp-connection-snd.nxt connection))))) + (defun update-timeout-timer (connection) (when (not (eql (tcp-connection-state connection) :syn-sent)) (disarm-timeout-timer connection) @@ -546,12 +556,13 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (flags (tcp-packet-flags packet start end)) (header-length (tcp-packet-header-length packet start end)) (data-length (tcp-packet-data-length packet start end))) - (when (and (not (eql (tcp-connection-state connection) :established)) - (logtest flags +tcp4-flag-rst+)) + (when (and (logtest flags +tcp4-flag-rst+) + (not (or (eql (tcp-connection-state connection) :syn-sent) + (eql (tcp-connection-state connection) :established)))) ;; FIXME: This code isn't correct, it needs to check the sequence numbers ;; before accepting this packet and resetting the connection. This is - ;; currently only done correctly in the :ESTABLISHED state, but should - ;; be done for the other states too. + ;; currently only done correctly in the states: :SYN-SENT, :ESTABLISHED + ;; But should be done for the other states too. ;; Remote has sent RST, aborting connection (setf (tcp-connection-pending-error connection) (make-condition 'connection-reset @@ -563,11 +574,17 @@ Set to a value near 2^32 to test SND sequence number wrapping.") ;; :CLOSED should never be seen here (ecase (tcp-connection-state connection) (:syn-sent - ;; Active open - (cond ((and (logtest flags +tcp4-flag-ack+) + (cond ((logtest flags +tcp4-flag-rst+) + (when (acceptable-ack-p connection ack) + (setf (tcp-connection-pending-error connection) + (make-condition 'connection-reset + :host (tcp-connection-remote-ip connection) + :port (tcp-connection-remote-port connection))) + (detach-tcp-connection connection))) + ((and (logtest flags +tcp4-flag-ack+) (logtest flags +tcp4-flag-syn+) (eql ack (tcp-connection-snd.nxt connection))) - ;; Remote has sent SYN+ACK and waiting for ACK + ;; Active open (initial-rtt-measurement connection) (setf (tcp-connection-state connection) :established) (setf (tcp-connection-rcv.nxt connection) (+u32 seq 1)) From bce312d90b8100388f29587983be8d7a7c4c375b Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Wed, 20 Mar 2024 14:31:20 +0100 Subject: [PATCH 09/65] tcp: Send RST when package is from old connection in :syn-sent state --- net/tcp.lisp | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index 6267605d6..604da7bf7 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -581,6 +581,11 @@ Set to a value near 2^32 to test SND sequence number wrapping.") :host (tcp-connection-remote-ip connection) :port (tcp-connection-remote-port connection))) (detach-tcp-connection connection))) + ((and (logtest flags +tcp4-flag-ack+) + (not (acceptable-ack-p connection ack))) + ;; Segment comes from an old connection + (unless *netmangler-force-local-retransmit* + (tcp4-send-packet connection ack seq nil :ack-p nil :rst-p t))) ((and (logtest flags +tcp4-flag-ack+) (logtest flags +tcp4-flag-syn+) (eql ack (tcp-connection-snd.nxt connection))) @@ -603,15 +608,7 @@ Set to a value near 2^32 to test SND sequence number wrapping.") :syn-p t)) ;; Cancel retransmit (disarm-retransmit-timer connection) - (disarm-timeout-timer connection)) - (t - ;; Aborting connection - (tcp4-send-packet connection ack seq nil :rst-p t) - (setf (tcp-connection-pending-error connection) - (make-condition 'connection-aborted - :host (tcp-connection-remote-ip connection) - :port (tcp-connection-remote-port connection))) - (detach-tcp-connection connection)))) + (disarm-timeout-timer connection)))) (:syn-received ;; Pasive open (cond ((and (eql flags +tcp4-flag-ack+) From fb4e21540a3fc8a53045626837962b6b8818f3ff Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Wed, 20 Mar 2024 14:49:42 +0100 Subject: [PATCH 10/65] tcp: Refactor tcp4-connection-receive :syn-sent state --- net/tcp.lisp | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index 604da7bf7..cefa134d0 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -591,11 +591,11 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (eql ack (tcp-connection-snd.nxt connection))) ;; Active open (initial-rtt-measurement connection) - (setf (tcp-connection-state connection) :established) - (setf (tcp-connection-rcv.nxt connection) (+u32 seq 1)) - (setf (tcp-connection-snd.una connection) ack) - (when (not *netmangler-force-local-retransmit*) - (tcp4-send-packet connection ack (tcp-connection-rcv.nxt connection) nil)) + (setf (tcp-connection-state connection) :established + (tcp-connection-rcv.nxt connection) (+u32 seq 1) + (tcp-connection-snd.una connection) ack) + (unless *netmangler-force-local-retransmit* + (tcp4-send-ack connection)) ;; Cancel retransmit (disarm-retransmit-timer connection) (disarm-timeout-timer connection)) @@ -603,7 +603,8 @@ Set to a value near 2^32 to test SND sequence number wrapping.") ;; Simultaneous open (setf (tcp-connection-state connection) :syn-received (tcp-connection-rcv.nxt connection) (+u32 seq 1)) - (when (not *netmangler-force-local-retransmit*) + ;; TODO: Update window + (unless *netmangler-force-local-retransmit* (tcp4-send-packet connection ack (tcp-connection-rcv.nxt connection) nil :syn-p t)) ;; Cancel retransmit From e91e108f273b9b72584e4131e21a21841b4465ff Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Wed, 20 Mar 2024 15:22:34 +0100 Subject: [PATCH 11/65] tcp: ACK non RST incoming unacceptable segments --- net/tcp.lisp | 89 ++++++++++++++++++++++++++++++---------------------- 1 file changed, 52 insertions(+), 37 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index cefa134d0..31f4f26ea 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -611,11 +611,13 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (disarm-retransmit-timer connection) (disarm-timeout-timer connection)))) (:syn-received - ;; Pasive open - (cond ((and (eql flags +tcp4-flag-ack+) + (cond ((not (acceptable-segment-p connection seq data-length)) + (unless (logtest flags +tcp4-flag-rst+) + (tcp4-send-ack connection))) + ((and (eql flags +tcp4-flag-ack+) (eql seq (tcp-connection-rcv.nxt connection)) (eql ack (tcp-connection-snd.nxt connection))) - ;; Remote has sent ACK, connection established + ;; Pasive open (initial-rtt-measurement connection) (setf (tcp-connection-state connection) :established) (when listener @@ -638,7 +640,7 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (decf (tcp-listener-n-pending-connections listener)))))) (:established (cond ((not (acceptable-segment-p connection seq data-length)) - (when (not (logtest flags +tcp4-flag-rst+)) + (unless (logtest flags +tcp4-flag-rst+) (tcp4-send-ack connection))) ((logtest flags +tcp4-flag-rst+) (setf (tcp-connection-pending-error connection) @@ -709,47 +711,60 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (tcp4-receive-data connection data-length end header-length packet seq start))))) (:close-wait ;; Remote has closed, local can still send data. - ;; Not much to do here, just waiting for the application to close. - ) + (cond ((not (acceptable-segment-p connection seq data-length)) + (unless (logtest flags +tcp4-flag-rst+) + (tcp4-send-ack connection))))) (:last-ack - ;; Local closed, waiting for remote to ACK. - (when (logtest flags +tcp4-flag-ack+) - ;; Remote has sent ACK, connection closed - (detach-tcp-connection connection))) + (cond ((not (acceptable-segment-p connection seq data-length)) + (unless (logtest flags +tcp4-flag-rst+) + (tcp4-send-ack connection))) + ((logtest flags +tcp4-flag-ack+) + (detach-tcp-connection connection)))) (:fin-wait-1 ;; Local closed, waiting for remote to close. - (if (zerop data-length) - (when (= seq (tcp-connection-rcv.nxt connection)) - (cond ((logtest flags +tcp4-flag-fin+) + (cond ((not (acceptable-segment-p connection seq data-length)) + (unless (logtest flags +tcp4-flag-rst+) + (tcp4-send-ack connection))) + (t + (if (zerop data-length) + (when (= seq (tcp-connection-rcv.nxt connection)) + (cond ((logtest flags +tcp4-flag-fin+) + (setf (tcp-connection-rcv.nxt connection) + (+u32 (tcp-connection-rcv.nxt connection) 1)) + (tcp4-send-ack connection) + (if (logtest flags +tcp4-flag-ack+) + ;; Remote saw our FIN and closed as well. + (detach-tcp-connection connection) + ;; Simultaneous close + (setf (tcp-connection-state connection) :closing))) + ((logtest flags +tcp4-flag-ack+) + ;; Remote saw our FIN + (setf (tcp-connection-state connection) :fin-wait-2)))) + (tcp4-receive-data connection data-length end header-length packet seq start))))) + (:fin-wait-2 + ;; Local closed, still waiting for remote to close. + (cond ((not (acceptable-segment-p connection seq data-length)) + (unless (logtest flags +tcp4-flag-rst+) + (tcp4-send-ack connection))) + (t + (if (zerop data-length) + (when (and (= seq (tcp-connection-rcv.nxt connection)) + (logtest flags +tcp4-flag-fin+)) + ;; Remote has sent FIN and waiting for ACK (setf (tcp-connection-rcv.nxt connection) (+u32 (tcp-connection-rcv.nxt connection) 1)) (tcp4-send-ack connection) - (if (logtest flags +tcp4-flag-ack+) - ;; Remote saw our FIN and closed as well. - (detach-tcp-connection connection) - ;; Simultaneous close - (setf (tcp-connection-state connection) :closing))) - ((logtest flags +tcp4-flag-ack+) - ;; Remote saw our FIN - (setf (tcp-connection-state connection) :fin-wait-2)))) - (tcp4-receive-data connection data-length end header-length packet seq start))) - (:fin-wait-2 - ;; Local closed, still waiting for remote to close. - (if (zerop data-length) - (when (and (= seq (tcp-connection-rcv.nxt connection)) - (logtest flags +tcp4-flag-fin+)) - ;; Remote has sent FIN and waiting for ACK - (setf (tcp-connection-rcv.nxt connection) - (+u32 (tcp-connection-rcv.nxt connection) 1)) - (tcp4-send-ack connection) - (detach-tcp-connection connection)) - (tcp4-receive-data connection data-length end header-length packet seq start))) + (detach-tcp-connection connection)) + (tcp4-receive-data connection data-length end header-length packet seq start))))) (:closing ;; Waiting for ACK - (when (and (eql seq (tcp-connection-rcv.nxt connection)) - (logtest flags +tcp4-flag-ack+)) - ;; Remote has sent ACK, connection closed - (detach-tcp-connection connection))))) + (cond ((not (acceptable-segment-p connection seq data-length)) + (unless (logtest flags +tcp4-flag-rst+) + (tcp4-send-ack connection))) + ((and (eql seq (tcp-connection-rcv.nxt connection)) + (logtest flags +tcp4-flag-ack+)) + ;; Remote has sent ACK, connection closed + (detach-tcp-connection connection)))))) (update-timeout-timer connection) ;; Notify any waiters that something may have changed. (mezzano.supervisor:condition-notify (tcp-connection-cvar connection) t))) From 5a6d095229688e28a74e22c2f8e8495b6b338451 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Wed, 20 Mar 2024 15:43:43 +0100 Subject: [PATCH 12/65] tcp: Check incomming RST segments --- net/tcp.lisp | 84 +++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 63 insertions(+), 21 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index 31f4f26ea..8ca7fde18 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -556,21 +556,6 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (flags (tcp-packet-flags packet start end)) (header-length (tcp-packet-header-length packet start end)) (data-length (tcp-packet-data-length packet start end))) - (when (and (logtest flags +tcp4-flag-rst+) - (not (or (eql (tcp-connection-state connection) :syn-sent) - (eql (tcp-connection-state connection) :established)))) - ;; FIXME: This code isn't correct, it needs to check the sequence numbers - ;; before accepting this packet and resetting the connection. This is - ;; currently only done correctly in the states: :SYN-SENT, :ESTABLISHED - ;; But should be done for the other states too. - ;; Remote has sent RST, aborting connection - (setf (tcp-connection-pending-error connection) - (make-condition 'connection-reset - :host (tcp-connection-remote-ip connection) - :port (tcp-connection-remote-port connection))) - (detach-tcp-connection connection) - (mezzano.supervisor:condition-notify (tcp-connection-cvar connection) t) - (return-from tcp4-connection-receive)) ;; :CLOSED should never be seen here (ecase (tcp-connection-state connection) (:syn-sent @@ -614,6 +599,22 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (cond ((not (acceptable-segment-p connection seq data-length)) (unless (logtest flags +tcp4-flag-rst+) (tcp4-send-ack connection))) + ((logtest flags +tcp4-flag-rst+) + (cond ((not (eql seq (tcp-connection-rcv.nxt connection))) + (challenge-ack connection)) + ((and listener + (gethash connection (tcp-listener-pending-connections listener))) + ;; Connection comes from pasive OPEN + (remhash connection (tcp-listener-pending-connections listener)) + (decf (tcp-listener-n-pending-connections listener)) + (detach-tcp-connection connection)) + (t + ;; Connection comes from active OPEN + (setf (tcp-connection-pending-error connection) + (make-condition 'connection-refused + :host (tcp-connection-remote-ip connection) + :port (tcp-connection-remote-port connection))) + (detach-tcp-connection connection)))) ((and (eql flags +tcp4-flag-ack+) (eql seq (tcp-connection-rcv.nxt connection)) (eql ack (tcp-connection-snd.nxt connection))) @@ -643,11 +644,14 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (unless (logtest flags +tcp4-flag-rst+) (tcp4-send-ack connection))) ((logtest flags +tcp4-flag-rst+) - (setf (tcp-connection-pending-error connection) - (make-condition 'connection-reset - :host (tcp-connection-remote-ip connection) - :port (tcp-connection-remote-port connection))) - (detach-tcp-connection connection)) + (cond ((eql seq (tcp-connection-rcv.nxt connection)) + (setf (tcp-connection-pending-error connection) + (make-condition 'connection-reset + :host (tcp-connection-remote-ip connection) + :port (tcp-connection-remote-port connection))) + (detach-tcp-connection connection)) + (t + (challenge-ack connection)))) ((logtest flags +tcp4-flag-syn+) (setf (tcp-connection-pending-error connection) (make-condition 'connection-reset @@ -713,11 +717,24 @@ Set to a value near 2^32 to test SND sequence number wrapping.") ;; Remote has closed, local can still send data. (cond ((not (acceptable-segment-p connection seq data-length)) (unless (logtest flags +tcp4-flag-rst+) - (tcp4-send-ack connection))))) + (tcp4-send-ack connection))) + ((logtest flags +tcp4-flag-rst+) + (cond ((eql seq (tcp-connection-rcv.nxt connection)) + (setf (tcp-connection-pending-error connection) + (make-condition 'connection-reset + :host (tcp-connection-remote-ip connection) + :port (tcp-connection-remote-port connection))) + (detach-tcp-connection connection)) + (t + (challenge-ack connection)))))) (:last-ack (cond ((not (acceptable-segment-p connection seq data-length)) (unless (logtest flags +tcp4-flag-rst+) (tcp4-send-ack connection))) + ((logtest flags +tcp4-flag-rst+) + (if (eql seq (tcp-connection-rcv.nxt connection)) + (detach-tcp-connection connection) + (challenge-ack connection))) ((logtest flags +tcp4-flag-ack+) (detach-tcp-connection connection)))) (:fin-wait-1 @@ -725,6 +742,15 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (cond ((not (acceptable-segment-p connection seq data-length)) (unless (logtest flags +tcp4-flag-rst+) (tcp4-send-ack connection))) + ((logtest flags +tcp4-flag-rst+) + (cond ((eql seq (tcp-connection-rcv.nxt connection)) + (setf (tcp-connection-pending-error connection) + (make-condition 'connection-reset + :host (tcp-connection-remote-ip connection) + :port (tcp-connection-remote-port connection))) + (detach-tcp-connection connection)) + (t + (challenge-ack connection)))) (t (if (zerop data-length) (when (= seq (tcp-connection-rcv.nxt connection)) @@ -746,6 +772,15 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (cond ((not (acceptable-segment-p connection seq data-length)) (unless (logtest flags +tcp4-flag-rst+) (tcp4-send-ack connection))) + ((logtest flags +tcp4-flag-rst+) + (cond ((eql seq (tcp-connection-rcv.nxt connection)) + (setf (tcp-connection-pending-error connection) + (make-condition 'connection-reset + :host (tcp-connection-remote-ip connection) + :port (tcp-connection-remote-port connection))) + (detach-tcp-connection connection)) + (t + (challenge-ack connection)))) (t (if (zerop data-length) (when (and (= seq (tcp-connection-rcv.nxt connection)) @@ -761,6 +796,10 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (cond ((not (acceptable-segment-p connection seq data-length)) (unless (logtest flags +tcp4-flag-rst+) (tcp4-send-ack connection))) + ((logtest flags +tcp4-flag-rst+) + (if (eql seq (tcp-connection-rcv.nxt connection)) + (detach-tcp-connection connection) + (challenge-ack connection))) ((and (eql seq (tcp-connection-rcv.nxt connection)) (logtest flags +tcp4-flag-ack+)) ;; Remote has sent ACK, connection closed @@ -881,6 +920,9 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (define-condition connection-closed (connection-error) ()) +(define-condition connection-refused (connection-error) + ()) + (define-condition connection-aborted (connection-error) ()) From 53363c98f1de3a660d5980b295202b21beddee72 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Wed, 20 Mar 2024 16:27:23 +0100 Subject: [PATCH 13/65] tcp: Don't abort connection when resiving segment in :syn-received state --- net/tcp.lisp | 14 +------------- 1 file changed, 1 insertion(+), 13 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index 8ca7fde18..b826785e2 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -626,19 +626,7 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (mezzano.sync:mailbox-send connection (tcp-listener-connections listener)))) ;; Ignore duplicated SYN packets ((and (logtest flags +tcp4-flag-syn+) - (eql seq (-u32 (tcp-connection-rcv.nxt connection) 1)))) - (t - ;; Aborting connection - (tcp4-send-packet connection ack seq nil :rst-p t) - (setf (tcp-connection-pending-error connection) - (make-condition 'connection-aborted - :host (tcp-connection-remote-ip connection) - :port (tcp-connection-remote-port connection))) - (detach-tcp-connection connection) - (when (and listener - (tcp-listener-backlog listener)) - (remhash connection (tcp-listener-pending-connections listener)) - (decf (tcp-listener-n-pending-connections listener)))))) + (eql seq (-u32 (tcp-connection-rcv.nxt connection) 1)))))) (:established (cond ((not (acceptable-segment-p connection seq data-length)) (unless (logtest flags +tcp4-flag-rst+) From cc921f76d47d96e1ee489c8ccd6e288eea3234ef Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Wed, 20 Mar 2024 16:40:36 +0100 Subject: [PATCH 14/65] tcp: Remove connection from listener when getting SYN in state :syn-received --- net/tcp.lisp | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/net/tcp.lisp b/net/tcp.lisp index b826785e2..bc4812d92 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -615,6 +615,12 @@ Set to a value near 2^32 to test SND sequence number wrapping.") :host (tcp-connection-remote-ip connection) :port (tcp-connection-remote-port connection))) (detach-tcp-connection connection)))) + ((logtest flags +tcp4-flag-syn+) + (cond ((and listener + (gethash connection (tcp-listener-pending-connections listener))) + ;; Connection comes from pasive OPEN + (remhash connection (tcp-listener-pending-connections listener)) + (decf (tcp-listener-n-pending-connections listener))))) ((and (eql flags +tcp4-flag-ack+) (eql seq (tcp-connection-rcv.nxt connection)) (eql ack (tcp-connection-snd.nxt connection))) From d6029818104ab34649ddbc0c3fcaa78bebcc0e48 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Wed, 20 Mar 2024 16:42:40 +0100 Subject: [PATCH 15/65] tcp: Challenge any SYN segment when not in :syn-sent state --- net/tcp.lisp | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index bc4812d92..39eb3a5cf 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -620,7 +620,10 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (gethash connection (tcp-listener-pending-connections listener))) ;; Connection comes from pasive OPEN (remhash connection (tcp-listener-pending-connections listener)) - (decf (tcp-listener-n-pending-connections listener))))) + (decf (tcp-listener-n-pending-connections listener))) + (t + ;; Connection comes from active OPEN + (challenge-ack connection)))) ((and (eql flags +tcp4-flag-ack+) (eql seq (tcp-connection-rcv.nxt connection)) (eql ack (tcp-connection-snd.nxt connection))) @@ -629,10 +632,7 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (setf (tcp-connection-state connection) :established) (when listener (remhash connection (tcp-listener-pending-connections listener)) - (mezzano.sync:mailbox-send connection (tcp-listener-connections listener)))) - ;; Ignore duplicated SYN packets - ((and (logtest flags +tcp4-flag-syn+) - (eql seq (-u32 (tcp-connection-rcv.nxt connection) 1)))))) + (mezzano.sync:mailbox-send connection (tcp-listener-connections listener)))))) (:established (cond ((not (acceptable-segment-p connection seq data-length)) (unless (logtest flags +tcp4-flag-rst+) @@ -647,17 +647,7 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (t (challenge-ack connection)))) ((logtest flags +tcp4-flag-syn+) - (setf (tcp-connection-pending-error connection) - (make-condition 'connection-reset - :host (tcp-connection-remote-ip connection) - :port (tcp-connection-remote-port connection))) - (detach-tcp-connection connection) - (tcp4-send-packet connection - (tcp-connection-snd.nxt connection) - 0 ; ??? - nil - :ack-p nil - :rst-p t)) + (challenge-ack connection)) ((not (logtest flags +tcp4-flag-ack+))) ; Ignore packets without ACK set. ((if (< (tcp-connection-snd.una connection) (tcp-connection-snd.nxt connection)) (and (< (tcp-connection-snd.una connection) ack) @@ -720,7 +710,9 @@ Set to a value near 2^32 to test SND sequence number wrapping.") :port (tcp-connection-remote-port connection))) (detach-tcp-connection connection)) (t - (challenge-ack connection)))))) + (challenge-ack connection)))) + ((logtest flags +tcp4-flag-syn+) + (challenge-ack connection)))) (:last-ack (cond ((not (acceptable-segment-p connection seq data-length)) (unless (logtest flags +tcp4-flag-rst+) @@ -729,6 +721,8 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (if (eql seq (tcp-connection-rcv.nxt connection)) (detach-tcp-connection connection) (challenge-ack connection))) + ((logtest flags +tcp4-flag-syn+) + (challenge-ack connection)) ((logtest flags +tcp4-flag-ack+) (detach-tcp-connection connection)))) (:fin-wait-1 @@ -745,6 +739,8 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (detach-tcp-connection connection)) (t (challenge-ack connection)))) + ((logtest flags +tcp4-flag-syn+) + (challenge-ack connection)) (t (if (zerop data-length) (when (= seq (tcp-connection-rcv.nxt connection)) @@ -775,6 +771,8 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (detach-tcp-connection connection)) (t (challenge-ack connection)))) + ((logtest flags +tcp4-flag-syn+) + (challenge-ack connection)) (t (if (zerop data-length) (when (and (= seq (tcp-connection-rcv.nxt connection)) @@ -794,6 +792,8 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (if (eql seq (tcp-connection-rcv.nxt connection)) (detach-tcp-connection connection) (challenge-ack connection))) + ((logtest flags +tcp4-flag-syn+) + (challenge-ack connection)) ((and (eql seq (tcp-connection-rcv.nxt connection)) (logtest flags +tcp4-flag-ack+)) ;; Remote has sent ACK, connection closed From 352172cf336fbac7c70175940c5423546e9cd72a Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Wed, 20 Mar 2024 18:39:52 +0100 Subject: [PATCH 16/65] tcp: Add :time-wait state --- net/tcp.lisp | 56 ++++++++++++++++++++++++++++++++++------------------ 1 file changed, 37 insertions(+), 19 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index 39eb3a5cf..48825620e 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -58,7 +58,8 @@ Set to a value near 2^32 to test SND sequence number wrapping.") :last-ack :fin-wait-1 :fin-wait-2 - :closing)) + :closing + :time-wait)) (deftype tcp-port-number () '(unsigned-byte 16)) @@ -258,7 +259,8 @@ Set to a value near 2^32 to test SND sequence number wrapping.") :last-ack :fin-wait-1 :fin-wait-2 - :closing) + :closing + :time-wait) (let ((packet (first (tcp-connection-retransmit-queue connection)))) (apply #'tcp4-send-packet connection packet) (setf (tcp-connection-rto connection) @@ -743,16 +745,17 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (challenge-ack connection)) (t (if (zerop data-length) - (when (= seq (tcp-connection-rcv.nxt connection)) + (when (eql seq (tcp-connection-rcv.nxt connection)) (cond ((logtest flags +tcp4-flag-fin+) - (setf (tcp-connection-rcv.nxt connection) - (+u32 (tcp-connection-rcv.nxt connection) 1)) + (setf (tcp-connection-rcv.nxt connection) (+u32 seq 1)) (tcp4-send-ack connection) - (if (logtest flags +tcp4-flag-ack+) - ;; Remote saw our FIN and closed as well. - (detach-tcp-connection connection) - ;; Simultaneous close - (setf (tcp-connection-state connection) :closing))) + (cond ((logtest flags +tcp4-flag-ack+) + ;; Remote saw our FIN + ;; TODO: Start the time-wait timer, turn off the other timers. + (setf (tcp-connection-state connection) :time-wait)) + (t + ;; Simultaneous close + (setf (tcp-connection-state connection) :closing)))) ((logtest flags +tcp4-flag-ack+) ;; Remote saw our FIN (setf (tcp-connection-state connection) :fin-wait-2)))) @@ -775,13 +778,13 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (challenge-ack connection)) (t (if (zerop data-length) - (when (and (= seq (tcp-connection-rcv.nxt connection)) - (logtest flags +tcp4-flag-fin+)) + (when (and (logtest flags +tcp4-flag-fin+) + (eql seq (tcp-connection-rcv.nxt connection))) ;; Remote has sent FIN and waiting for ACK - (setf (tcp-connection-rcv.nxt connection) - (+u32 (tcp-connection-rcv.nxt connection) 1)) - (tcp4-send-ack connection) - (detach-tcp-connection connection)) + ;; TODO: Start the time-wait timer, turn off the other timers. + (setf (tcp-connection-state connection) :time-wait + (tcp-connection-rcv.nxt connection) (+u32 seq 1)) + (tcp4-send-ack connection)) (tcp4-receive-data connection data-length end header-length packet seq start))))) (:closing ;; Waiting for ACK @@ -796,8 +799,23 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (challenge-ack connection)) ((and (eql seq (tcp-connection-rcv.nxt connection)) (logtest flags +tcp4-flag-ack+)) - ;; Remote has sent ACK, connection closed - (detach-tcp-connection connection)))))) + (setf (tcp-connection-state connection) :time-wait)))) + (:time-wait + (cond ((not (acceptable-segment-p connection seq data-length)) + (unless (logtest flags +tcp4-flag-rst+) + (tcp4-send-ack connection))) + ((logtest flags +tcp4-flag-rst+) + (if (eql seq (tcp-connection-rcv.nxt connection)) + (detach-tcp-connection connection) + (challenge-ack connection))) + ((logtest flags +tcp4-flag-syn+) + (challenge-ack connection)) + ((not (logtest flags +tcp4-flag-ack+))) ; Ignore packets without ACK set. + ((and (logtest flags +tcp4-flag-fin+) + (eql seq (tcp-connection-rcv.nxt connection))) + ;; TODO: Restart the 2 MSL timeout. + (setf (tcp-connection-rcv.nxt connection) (+u32 seq 1)) + (tcp4-send-ack connection)))))) (update-timeout-timer connection) ;; Notify any waiters that something may have changed. (mezzano.supervisor:condition-notify (tcp-connection-cvar connection) t))) @@ -1234,7 +1252,7 @@ Set to a value near 2^32 to test SND sequence number wrapping.") nil :fin-p t :errors-escape t))) - ((:last-ack :fin-wait-1 :fin-wait-2 :closed)))) + ((:last-ack :fin-wait-1 :fin-wait-2 :closed :time-wait)))) (defmethod close ((stream tcp-octet-stream) &key abort) ;; TODO: ABORT should abort the connection entirely. From 663c7995925dcf89b82d2728889712f3fef83c44 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Fri, 22 Mar 2024 17:46:50 +0100 Subject: [PATCH 17/65] tcp: Add =< --- net/tcp.lisp | 39 ++++++++++++++++++++++----------------- 1 file changed, 22 insertions(+), 17 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index 48825620e..5861c5d65 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -73,6 +73,14 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (defun -u32 (x y) (ldb (byte 32 0) (- x y))) +(defun =< (a b c) + "a <= b <= c" + (if (< a c) + (<= a b c) + ;; Sequence numbers wrapped. + (or (<= a b) + (<= b c)))) + ;; FIXME: Inbound connections need to timeout if state :syn-received don't change. ;; TODO: Better locking on this is probably needed. It looks like it is accesed ;; from the network serial queue and from user threads. @@ -662,23 +670,20 @@ Set to a value near 2^32 to test SND sequence number wrapping.") ;; TODO: Update the send window. ;; Remove from the retransmit queue any segments that ;; were fully acknowledged by this ACK. - (flet ((seq-cmp (x) - "Test SND.UNA =< X =< SEG.ACK" - (if (< (tcp-connection-snd.una connection) ack) - (<= (tcp-connection-snd.una connection) x ack) - ;; Sequence numbers wrapped. - (or (<= (tcp-connection-snd.una connection) x) - (<= x ack))))) - (loop - (when (endp (tcp-connection-retransmit-queue connection)) - (return)) - (let* ((rtx-start-seq (first (first (tcp-connection-retransmit-queue connection)))) - (rtx-end-seq (+u32 rtx-start-seq (length (third (first (tcp-connection-retransmit-queue connection))))))) - (when (not (and (seq-cmp rtx-start-seq) - (seq-cmp rtx-end-seq))) - ;; This segment not fully acked. - (return))) - (pop (tcp-connection-retransmit-queue connection)))) + (loop + (when (endp (tcp-connection-retransmit-queue connection)) + (return)) + (let* ((rtx-start-seq (first (first (tcp-connection-retransmit-queue connection)))) + (rtx-end-seq (+u32 rtx-start-seq (length (third (first (tcp-connection-retransmit-queue connection))))))) + (unless (and (=< (tcp-connection-snd.una connection) + rtx-start-seq + ack) + (=< (tcp-connection-snd.una connection) + rtx-end-seq + ack)) + ;; This segment not fully acked. + (return))) + (pop (tcp-connection-retransmit-queue connection))) (if (endp (tcp-connection-retransmit-queue connection)) (disarm-retransmit-timer connection) (arm-retransmit-timer connection)) From 9688f2510034359672da2f5312b3489bc3121a47 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Fri, 22 Mar 2024 18:13:37 +0100 Subject: [PATCH 18/65] tcp: Deal with wrap around sequence numbers correctly --- net/tcp.lisp | 30 ++++++++++++++++++++++++++++-- 1 file changed, 28 insertions(+), 2 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index 5861c5d65..dfa8e01ca 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -73,6 +73,32 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (defun -u32 (x y) (ldb (byte 32 0) (- x y))) +(defun x y) + (> (- x y) + (ash 1 31))))) + +(defun >u32 (x y) + "Bigger wrapped y number may actually be considered smaller than x due +to wrap around logic" + (=u32 (x y) + "Bigger wrapped y number may actually be considered smaller than x due +to wrap around logic" + (<=u32 y x)) + (defun =< (a b c) "a <= b <= c" (if (< a c) @@ -469,11 +495,11 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (tcp-connection-receive-event connection)) t)) ;; Add future packet to tcp-connection-rx-data-unordered - ((> seq (tcp-connection-rcv.nxt connection)) + ((>u32 seq (tcp-connection-rcv.nxt connection)) (unless (gethash seq (tcp-connection-rx-data-unordered connection)) (setf (gethash seq (tcp-connection-rx-data-unordered connection)) (list packet (+ start header-length) end data-length))))) - (when (<= seq (tcp-connection-rcv.nxt connection)) + (when (<=u32 seq (tcp-connection-rcv.nxt connection)) ;; Don't check *netmangler-force-local-retransmit* here, ;; or no acks will ever get through. (tcp4-send-ack connection))) From 08e01fb99cc21afa286775c0e3fce35789930fbf Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Fri, 22 Mar 2024 18:16:19 +0100 Subject: [PATCH 19/65] tcp: Small refactor --- net/tcp.lisp | 7 +------ 1 file changed, 1 insertion(+), 6 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index dfa8e01ca..313a1f70b 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -685,12 +685,7 @@ to wrap around logic" ((logtest flags +tcp4-flag-syn+) (challenge-ack connection)) ((not (logtest flags +tcp4-flag-ack+))) ; Ignore packets without ACK set. - ((if (< (tcp-connection-snd.una connection) (tcp-connection-snd.nxt connection)) - (and (< (tcp-connection-snd.una connection) ack) - (<= ack (tcp-connection-snd.nxt connection))) - ;; In the middle of wraparound. - (or (< (tcp-connection-snd.una connection) ack) - (<= ack (tcp-connection-snd.nxt connection)))) + ((acceptable-ack-p connection ack) (when (tcp-connection-last-ack-time connection) (subsequent-rtt-measurement connection)) ;; TODO: Update the send window. From f6fa477da18f521c8d7115804a4445c14d962f97 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Fri, 22 Mar 2024 19:34:22 +0100 Subject: [PATCH 20/65] tcp: Send RST to segments of old connections in :syn-received state --- net/tcp.lisp | 22 +++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index 313a1f70b..ac939eafb 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -660,15 +660,19 @@ to wrap around logic" (t ;; Connection comes from active OPEN (challenge-ack connection)))) - ((and (eql flags +tcp4-flag-ack+) - (eql seq (tcp-connection-rcv.nxt connection)) - (eql ack (tcp-connection-snd.nxt connection))) - ;; Pasive open - (initial-rtt-measurement connection) - (setf (tcp-connection-state connection) :established) - (when listener - (remhash connection (tcp-listener-pending-connections listener)) - (mezzano.sync:mailbox-send connection (tcp-listener-connections listener)))))) + ((not (logtest flags +tcp4-flag-ack+))) ; Ignore packets without ACK set. + (t + (cond ((acceptable-ack-p connection ack) + ;; Pasive open + (initial-rtt-measurement connection) + (setf (tcp-connection-state connection) :established) + ;; TODO: Update window + (when listener + (remhash connection (tcp-listener-pending-connections listener)) + (mezzano.sync:mailbox-send connection (tcp-listener-connections listener)))) + (t + ;; Segment from an old connection + (tcp4-send-packet connection ack seq nil :ack-p nil :rst-p t)))))) (:established (cond ((not (acceptable-segment-p connection seq data-length)) (unless (logtest flags +tcp4-flag-rst+) From 327843401707f8f8b671a67c729394586c9dbf8a Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Fri, 22 Mar 2024 19:41:37 +0100 Subject: [PATCH 21/65] tcp: Handle FIN in :syn-received state --- net/tcp.lisp | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index ac939eafb..93f8059ca 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -672,7 +672,12 @@ to wrap around logic" (mezzano.sync:mailbox-send connection (tcp-listener-connections listener)))) (t ;; Segment from an old connection - (tcp4-send-packet connection ack seq nil :ack-p nil :rst-p t)))))) + (tcp4-send-packet connection ack seq nil :ack-p nil :rst-p t))) + (when (and (logtest flags +tcp4-flag-fin+) + (eql seq (tcp-connection-rcv.nxt connection))) + (setf (tcp-connection-rcv.nxt connection) (+u32 seq 1) + (tcp-connection-state connection) :close-wait) + (tcp4-send-ack connection))))) (:established (cond ((not (acceptable-segment-p connection seq data-length)) (unless (logtest flags +tcp4-flag-rst+) From 180b7b471e45ade4121243e2de7dccc22e73c4a0 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Fri, 22 Mar 2024 19:53:39 +0100 Subject: [PATCH 22/65] tcp: Chenck ACK sequence number in :last-ack state before ending it --- net/tcp.lisp | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index 93f8059ca..d7082ea56 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -760,8 +760,10 @@ to wrap around logic" (challenge-ack connection))) ((logtest flags +tcp4-flag-syn+) (challenge-ack connection)) - ((logtest flags +tcp4-flag-ack+) - (detach-tcp-connection connection)))) + ((not (logtest flags +tcp4-flag-ack+))) ; Ignore packets without ACK set. + (t + (when (eql ack (tcp-connection-snd.nxt connection)) + (detach-tcp-connection connection))))) (:fin-wait-1 ;; Local closed, waiting for remote to close. (cond ((not (acceptable-segment-p connection seq data-length)) From 3334d7913d0dbc117eef75232c5e2eccaf996359 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Fri, 22 Mar 2024 19:57:16 +0100 Subject: [PATCH 23/65] tcp: Hangle FIN in :last-ack state --- net/tcp.lisp | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index d7082ea56..880b1bcfe 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -763,7 +763,11 @@ to wrap around logic" ((not (logtest flags +tcp4-flag-ack+))) ; Ignore packets without ACK set. (t (when (eql ack (tcp-connection-snd.nxt connection)) - (detach-tcp-connection connection))))) + (detach-tcp-connection connection)) + (when (and (logtest flags +tcp4-flag-fin+) + (eql seq (tcp-connection-rcv.nxt connection))) + (setf (tcp-connection-rcv.nxt connection) (+u32 seq 1)) + (tcp4-send-ack connection))))) (:fin-wait-1 ;; Local closed, waiting for remote to close. (cond ((not (acceptable-segment-p connection seq data-length)) From 0c28348a6a6dc82371c0980a78093e335f19972a Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Fri, 22 Mar 2024 21:27:39 +0100 Subject: [PATCH 24/65] tcp: Ignore SYN or RST packets without ACK --- net/tcp.lisp | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index 880b1bcfe..ff5c3f3f9 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -749,7 +749,8 @@ to wrap around logic" (t (challenge-ack connection)))) ((logtest flags +tcp4-flag-syn+) - (challenge-ack connection)))) + (challenge-ack connection)) + ((not (logtest flags +tcp4-flag-ack+))))) ; Ignore packets without ACK set. (:last-ack (cond ((not (acceptable-segment-p connection seq data-length)) (unless (logtest flags +tcp4-flag-rst+) @@ -784,6 +785,7 @@ to wrap around logic" (challenge-ack connection)))) ((logtest flags +tcp4-flag-syn+) (challenge-ack connection)) + ((not (logtest flags +tcp4-flag-ack+))) ; Ignore packets without ACK set. (t (if (zerop data-length) (when (eql seq (tcp-connection-rcv.nxt connection)) @@ -817,6 +819,7 @@ to wrap around logic" (challenge-ack connection)))) ((logtest flags +tcp4-flag-syn+) (challenge-ack connection)) + ((not (logtest flags +tcp4-flag-ack+))) ; Ignore packets without ACK set. (t (if (zerop data-length) (when (and (logtest flags +tcp4-flag-fin+) @@ -838,6 +841,7 @@ to wrap around logic" (challenge-ack connection))) ((logtest flags +tcp4-flag-syn+) (challenge-ack connection)) + ((not (logtest flags +tcp4-flag-ack+))) ; Ignore packets without ACK set. ((and (eql seq (tcp-connection-rcv.nxt connection)) (logtest flags +tcp4-flag-ack+)) (setf (tcp-connection-state connection) :time-wait)))) From c9a2b0dd8d1995105e420d591cac3f822e69cd82 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Fri, 22 Mar 2024 23:53:40 +0100 Subject: [PATCH 25/65] tcp: Allow sending data in half open connection --- net/tcp.lisp | 69 +++++++++++++++++++++++++++++----------------------- 1 file changed, 39 insertions(+), 30 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index ff5c3f3f9..1efeef69a 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -583,6 +583,32 @@ to wrap around logic" (max 0.01 (* 4 (tcp-connection-rttvar connection)))))) (tcp-connection-last-ack-time connection) nil))) +(defun when-acceptable-ack-p (connection ack seq) + (when (acceptable-ack-p connection ack) + (when (tcp-connection-last-ack-time connection) + (subsequent-rtt-measurement connection)) + (setf (tcp-connection-snd.una connection) ack) + ;; Remove from the retransmit queue any segments that were fully acknowledged by this ACK. + (loop + (when (endp (tcp-connection-retransmit-queue connection)) + (return)) + (let* ((rtx-start-seq (first (first (tcp-connection-retransmit-queue connection)))) + (rtx-end-seq (+u32 rtx-start-seq (length (third (first (tcp-connection-retransmit-queue connection))))))) + (unless (and (=< (tcp-connection-snd.una connection) + rtx-start-seq + ack) + (=< (tcp-connection-snd.una connection) + rtx-end-seq + ack)) + ;; This segment not fully acked. + (return))) + (pop (tcp-connection-retransmit-queue connection))) + (if (endp (tcp-connection-retransmit-queue connection)) + (disarm-retransmit-timer connection) + (arm-retransmit-timer connection))) + ;; TODO: Update window + ) + (defun tcp4-connection-receive (connection packet start end listener) ;; Don't use WITH-TCP-CONNECTION-LOCKED here. No errors should occur ;; in here, so this avoids truncating the backtrace with :resignal-errors. @@ -694,30 +720,8 @@ to wrap around logic" ((logtest flags +tcp4-flag-syn+) (challenge-ack connection)) ((not (logtest flags +tcp4-flag-ack+))) ; Ignore packets without ACK set. - ((acceptable-ack-p connection ack) - (when (tcp-connection-last-ack-time connection) - (subsequent-rtt-measurement connection)) - ;; TODO: Update the send window. - ;; Remove from the retransmit queue any segments that - ;; were fully acknowledged by this ACK. - (loop - (when (endp (tcp-connection-retransmit-queue connection)) - (return)) - (let* ((rtx-start-seq (first (first (tcp-connection-retransmit-queue connection)))) - (rtx-end-seq (+u32 rtx-start-seq (length (third (first (tcp-connection-retransmit-queue connection))))))) - (unless (and (=< (tcp-connection-snd.una connection) - rtx-start-seq - ack) - (=< (tcp-connection-snd.una connection) - rtx-end-seq - ack)) - ;; This segment not fully acked. - (return))) - (pop (tcp-connection-retransmit-queue connection))) - (if (endp (tcp-connection-retransmit-queue connection)) - (disarm-retransmit-timer connection) - (arm-retransmit-timer connection)) - (setf (tcp-connection-snd.una connection) ack) + (t + (when-acceptable-ack-p connection ack seq) (if (zerop data-length) (when (and (eql seq (tcp-connection-rcv.nxt connection)) (logtest flags +tcp4-flag-fin+)) @@ -750,7 +754,9 @@ to wrap around logic" (challenge-ack connection)))) ((logtest flags +tcp4-flag-syn+) (challenge-ack connection)) - ((not (logtest flags +tcp4-flag-ack+))))) ; Ignore packets without ACK set. + ((not (logtest flags +tcp4-flag-ack+))) ; Ignore packets without ACK set. + (t + (when-acceptable-ack-p connection ack seq)))) (:last-ack (cond ((not (acceptable-segment-p connection seq data-length)) (unless (logtest flags +tcp4-flag-rst+) @@ -787,6 +793,7 @@ to wrap around logic" (challenge-ack connection)) ((not (logtest flags +tcp4-flag-ack+))) ; Ignore packets without ACK set. (t + (when-acceptable-ack-p connection ack seq) (if (zerop data-length) (when (eql seq (tcp-connection-rcv.nxt connection)) (cond ((logtest flags +tcp4-flag-fin+) @@ -821,6 +828,7 @@ to wrap around logic" (challenge-ack connection)) ((not (logtest flags +tcp4-flag-ack+))) ; Ignore packets without ACK set. (t + (when-acceptable-ack-p connection ack seq) (if (zerop data-length) (when (and (logtest flags +tcp4-flag-fin+) (eql seq (tcp-connection-rcv.nxt connection))) @@ -842,9 +850,10 @@ to wrap around logic" ((logtest flags +tcp4-flag-syn+) (challenge-ack connection)) ((not (logtest flags +tcp4-flag-ack+))) ; Ignore packets without ACK set. - ((and (eql seq (tcp-connection-rcv.nxt connection)) - (logtest flags +tcp4-flag-ack+)) - (setf (tcp-connection-state connection) :time-wait)))) + (t + (when-acceptable-ack-p connection ack seq) + (when (eql seq (tcp-connection-rcv.nxt connection)) + (setf (tcp-connection-state connection) :time-wait))))) (:time-wait (cond ((not (acceptable-segment-p connection seq data-length)) (unless (logtest flags +tcp4-flag-rst+) @@ -1090,8 +1099,8 @@ to wrap around logic" (check-connection-error connection) (update-timeout-timer connection) ;; No sending when the connection is closing. - ;; Half-closed connections seem too weird to be worth dealing with. - (when (not (eql (tcp-connection-state connection) :established)) + (when (not (or (eql (tcp-connection-state connection) :established) + (eql (tcp-connection-state connection) :close-wait))) (error 'connection-closed :host (tcp-connection-remote-ip connection) :port (tcp-connection-remote-port connection))) From d4bf1371c8edf9c4b20c6a07e34a4851b830d83b Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Sat, 23 Mar 2024 00:17:38 +0100 Subject: [PATCH 26/65] tcp: Add rfc5961 mitigation --- net/tcp.lisp | 22 ++++++++++++++++++++++ 1 file changed, 22 insertions(+) diff --git a/net/tcp.lisp b/net/tcp.lisp index 1efeef69a..81f62f830 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -546,6 +546,12 @@ to wrap around logic" (or (< (tcp-connection-snd.una connection) seg.ack) (<= seg.ack (tcp-connection-snd.nxt connection))))) +(defun rfc5961-mitigation-check-p (connection seg.ack) + "If ((SND.UNA - MAX.SND.WND) =< SEG.ACK =< SND.NXT) the ACK is acceptable." + (let ((x (- (tcp-connection-snd.una connection) + (tcp-connection-max.snd.wnd connection)))) + (=< x seg.ack (tcp-connection-snd.nxt connection)))) + (defun update-timeout-timer (connection) (when (not (eql (tcp-connection-state connection) :syn-sent)) (disarm-timeout-timer connection) @@ -687,6 +693,8 @@ to wrap around logic" ;; Connection comes from active OPEN (challenge-ack connection)))) ((not (logtest flags +tcp4-flag-ack+))) ; Ignore packets without ACK set. + ((not (rfc5961-mitigation-check-p connection ack)) + (tcp4-send-ack connection)) (t (cond ((acceptable-ack-p connection ack) ;; Pasive open @@ -720,6 +728,8 @@ to wrap around logic" ((logtest flags +tcp4-flag-syn+) (challenge-ack connection)) ((not (logtest flags +tcp4-flag-ack+))) ; Ignore packets without ACK set. + ((not (rfc5961-mitigation-check-p connection ack)) + (tcp4-send-ack connection)) (t (when-acceptable-ack-p connection ack seq) (if (zerop data-length) @@ -755,6 +765,8 @@ to wrap around logic" ((logtest flags +tcp4-flag-syn+) (challenge-ack connection)) ((not (logtest flags +tcp4-flag-ack+))) ; Ignore packets without ACK set. + ((not (rfc5961-mitigation-check-p connection ack)) + (tcp4-send-ack connection)) (t (when-acceptable-ack-p connection ack seq)))) (:last-ack @@ -768,6 +780,8 @@ to wrap around logic" ((logtest flags +tcp4-flag-syn+) (challenge-ack connection)) ((not (logtest flags +tcp4-flag-ack+))) ; Ignore packets without ACK set. + ((not (rfc5961-mitigation-check-p connection ack)) + (tcp4-send-ack connection)) (t (when (eql ack (tcp-connection-snd.nxt connection)) (detach-tcp-connection connection)) @@ -792,6 +806,8 @@ to wrap around logic" ((logtest flags +tcp4-flag-syn+) (challenge-ack connection)) ((not (logtest flags +tcp4-flag-ack+))) ; Ignore packets without ACK set. + ((not (rfc5961-mitigation-check-p connection ack)) + (tcp4-send-ack connection)) (t (when-acceptable-ack-p connection ack seq) (if (zerop data-length) @@ -827,6 +843,8 @@ to wrap around logic" ((logtest flags +tcp4-flag-syn+) (challenge-ack connection)) ((not (logtest flags +tcp4-flag-ack+))) ; Ignore packets without ACK set. + ((not (rfc5961-mitigation-check-p connection ack)) + (tcp4-send-ack connection)) (t (when-acceptable-ack-p connection ack seq) (if (zerop data-length) @@ -850,6 +868,8 @@ to wrap around logic" ((logtest flags +tcp4-flag-syn+) (challenge-ack connection)) ((not (logtest flags +tcp4-flag-ack+))) ; Ignore packets without ACK set. + ((not (rfc5961-mitigation-check-p connection ack)) + (tcp4-send-ack connection)) (t (when-acceptable-ack-p connection ack seq) (when (eql seq (tcp-connection-rcv.nxt connection)) @@ -865,6 +885,8 @@ to wrap around logic" ((logtest flags +tcp4-flag-syn+) (challenge-ack connection)) ((not (logtest flags +tcp4-flag-ack+))) ; Ignore packets without ACK set. + ((not (rfc5961-mitigation-check-p connection ack)) + (tcp4-send-ack connection)) ((and (logtest flags +tcp4-flag-fin+) (eql seq (tcp-connection-rcv.nxt connection))) ;; TODO: Restart the 2 MSL timeout. From 98af63635aea222fed77f2f1b072ca2a842407df Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Sat, 23 Mar 2024 00:27:51 +0100 Subject: [PATCH 27/65] tcp: Send ACK to segments that acknowledges something not yet sent --- net/tcp.lisp | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/net/tcp.lisp b/net/tcp.lisp index 81f62f830..50a74d05e 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -730,6 +730,9 @@ to wrap around logic" ((not (logtest flags +tcp4-flag-ack+))) ; Ignore packets without ACK set. ((not (rfc5961-mitigation-check-p connection ack)) (tcp4-send-ack connection)) + ((>u32 ack (tcp-connection-snd.nxt connection)) + ;; Remote acks something not yet sent + (tcp4-send-ack connection)) (t (when-acceptable-ack-p connection ack seq) (if (zerop data-length) @@ -767,6 +770,9 @@ to wrap around logic" ((not (logtest flags +tcp4-flag-ack+))) ; Ignore packets without ACK set. ((not (rfc5961-mitigation-check-p connection ack)) (tcp4-send-ack connection)) + ((>u32 ack (tcp-connection-snd.nxt connection)) + ;; Remote acks something not yet sent + (tcp4-send-ack connection)) (t (when-acceptable-ack-p connection ack seq)))) (:last-ack @@ -808,6 +814,9 @@ to wrap around logic" ((not (logtest flags +tcp4-flag-ack+))) ; Ignore packets without ACK set. ((not (rfc5961-mitigation-check-p connection ack)) (tcp4-send-ack connection)) + ((>u32 ack (tcp-connection-snd.nxt connection)) + ;; Remote acks something not yet sent + (tcp4-send-ack connection)) (t (when-acceptable-ack-p connection ack seq) (if (zerop data-length) @@ -845,6 +854,9 @@ to wrap around logic" ((not (logtest flags +tcp4-flag-ack+))) ; Ignore packets without ACK set. ((not (rfc5961-mitigation-check-p connection ack)) (tcp4-send-ack connection)) + ((>u32 ack (tcp-connection-snd.nxt connection)) + ;; Remote acks something not yet sent + (tcp4-send-ack connection)) (t (when-acceptable-ack-p connection ack seq) (if (zerop data-length) @@ -870,6 +882,9 @@ to wrap around logic" ((not (logtest flags +tcp4-flag-ack+))) ; Ignore packets without ACK set. ((not (rfc5961-mitigation-check-p connection ack)) (tcp4-send-ack connection)) + ((>u32 ack (tcp-connection-snd.nxt connection)) + ;; Remote acks something not yet sent + (tcp4-send-ack connection)) (t (when-acceptable-ack-p connection ack seq) (when (eql seq (tcp-connection-rcv.nxt connection)) From bfb920a0fd42d45593e780c18b02e99f959b2b79 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Sat, 23 Mar 2024 00:56:05 +0100 Subject: [PATCH 28/65] tcp: Hangle FIN in :closing state --- net/tcp.lisp | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index 50a74d05e..2717e1d13 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -888,7 +888,11 @@ to wrap around logic" (t (when-acceptable-ack-p connection ack seq) (when (eql seq (tcp-connection-rcv.nxt connection)) - (setf (tcp-connection-state connection) :time-wait))))) + (setf (tcp-connection-state connection) :time-wait)) + (when (and (logtest flags +tcp4-flag-fin+) + (eql seq (tcp-connection-rcv.nxt connection))) + (setf (tcp-connection-rcv.nxt connection) (+u32 seq 1)) + (tcp4-send-ack connection))))) (:time-wait (cond ((not (acceptable-segment-p connection seq data-length)) (unless (logtest flags +tcp4-flag-rst+) From dd953470c1a648ebdf43b3499f0eca07ca1e28f3 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Sat, 23 Mar 2024 01:03:38 +0100 Subject: [PATCH 29/65] tcp: Hangle FIN in :close-wait state --- net/tcp.lisp | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index 2717e1d13..49cc9a888 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -774,7 +774,11 @@ to wrap around logic" ;; Remote acks something not yet sent (tcp4-send-ack connection)) (t - (when-acceptable-ack-p connection ack seq)))) + (when-acceptable-ack-p connection ack seq) + (when (and (logtest flags +tcp4-flag-fin+) + (eql seq (tcp-connection-rcv.nxt connection))) + (setf (tcp-connection-rcv.nxt connection) (+u32 seq 1)) + (tcp4-send-ack connection))))) (:last-ack (cond ((not (acceptable-segment-p connection seq data-length)) (unless (logtest flags +tcp4-flag-rst+) From 0d07fa77b7d7736917c2d28b5c3beb912eb52465 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Sat, 23 Mar 2024 02:09:36 +0100 Subject: [PATCH 30/65] tcp: Allow to resive data and control in the same segment --- net/tcp.lisp | 79 ++++++++++++++++++++++++---------------------------- 1 file changed, 36 insertions(+), 43 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index 49cc9a888..3df681f99 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -709,8 +709,8 @@ to wrap around logic" (tcp4-send-packet connection ack seq nil :ack-p nil :rst-p t))) (when (and (logtest flags +tcp4-flag-fin+) (eql seq (tcp-connection-rcv.nxt connection))) - (setf (tcp-connection-rcv.nxt connection) (+u32 seq 1) - (tcp-connection-state connection) :close-wait) + (setf (tcp-connection-state connection) :close-wait + (tcp-connection-rcv.nxt connection) (+u32 seq 1)) (tcp4-send-ack connection))))) (:established (cond ((not (acceptable-segment-p connection seq data-length)) @@ -735,22 +735,14 @@ to wrap around logic" (tcp4-send-ack connection)) (t (when-acceptable-ack-p connection ack seq) - (if (zerop data-length) - (when (and (eql seq (tcp-connection-rcv.nxt connection)) - (logtest flags +tcp4-flag-fin+)) - ;; Remote has sent FIN and waiting for ACK - (setf (tcp-connection-state connection) :close-wait - (tcp-connection-rcv.nxt connection) - (+u32 seq 1)) - (setf (mezzano.supervisor:event-state - (tcp-connection-receive-event connection)) - t) - (tcp4-send-packet connection ack (+u32 seq 1) nil)) - (tcp4-receive-data connection data-length end header-length packet seq start))) - ((eql (tcp-connection-snd.una connection) ack) - ;; TODO: slow start/duplicate ack detection/fast retransmit/etc. - (when (not (eql data-length 0)) - (tcp4-receive-data connection data-length end header-length packet seq start))))) + (unless (zerop data-length) + (tcp4-receive-data connection data-length end header-length packet seq start)) + (when (and (logtest flags +tcp4-flag-fin+) + (eql seq (tcp-connection-rcv.nxt connection))) + ;; Remote has sent FIN and waiting for ACK + (setf (tcp-connection-state connection) :close-wait + (tcp-connection-rcv.nxt connection) (+u32 seq 1)) + (tcp4-send-ack connection))))) (:close-wait ;; Remote has closed, local can still send data. (cond ((not (acceptable-segment-p connection seq data-length)) @@ -823,22 +815,23 @@ to wrap around logic" (tcp4-send-ack connection)) (t (when-acceptable-ack-p connection ack seq) - (if (zerop data-length) - (when (eql seq (tcp-connection-rcv.nxt connection)) - (cond ((logtest flags +tcp4-flag-fin+) - (setf (tcp-connection-rcv.nxt connection) (+u32 seq 1)) - (tcp4-send-ack connection) - (cond ((logtest flags +tcp4-flag-ack+) - ;; Remote saw our FIN - ;; TODO: Start the time-wait timer, turn off the other timers. - (setf (tcp-connection-state connection) :time-wait)) - (t - ;; Simultaneous close - (setf (tcp-connection-state connection) :closing)))) - ((logtest flags +tcp4-flag-ack+) - ;; Remote saw our FIN - (setf (tcp-connection-state connection) :fin-wait-2)))) - (tcp4-receive-data connection data-length end header-length packet seq start))))) + (unless (zerop data-length) + (tcp4-receive-data connection data-length end header-length packet seq start)) + (when (eql seq (tcp-connection-rcv.nxt connection)) + (cond ((logtest flags +tcp4-flag-fin+) + (setf (tcp-connection-rcv.nxt connection) (+u32 seq 1)) + (tcp4-send-ack connection) + (cond ((logtest flags +tcp4-flag-ack+) + ;; Remote saw our FIN + (setf (tcp-connection-state connection) :time-wait) + ;; TODO: Start the time-wait timer, turn off the other timers. + ) + (t + ;; Simultaneous close + (setf (tcp-connection-state connection) :closing)))) + ((logtest flags +tcp4-flag-ack+) + ;; Remote saw our FIN + (setf (tcp-connection-state connection) :fin-wait-2))))))) (:fin-wait-2 ;; Local closed, still waiting for remote to close. (cond ((not (acceptable-segment-p connection seq data-length)) @@ -863,15 +856,15 @@ to wrap around logic" (tcp4-send-ack connection)) (t (when-acceptable-ack-p connection ack seq) - (if (zerop data-length) - (when (and (logtest flags +tcp4-flag-fin+) - (eql seq (tcp-connection-rcv.nxt connection))) - ;; Remote has sent FIN and waiting for ACK - ;; TODO: Start the time-wait timer, turn off the other timers. - (setf (tcp-connection-state connection) :time-wait - (tcp-connection-rcv.nxt connection) (+u32 seq 1)) - (tcp4-send-ack connection)) - (tcp4-receive-data connection data-length end header-length packet seq start))))) + (unless (zerop data-length) + (tcp4-receive-data connection data-length end header-length packet seq start)) + (when (and (logtest flags +tcp4-flag-fin+) + (eql seq (tcp-connection-rcv.nxt connection))) + (setf (tcp-connection-state connection) :time-wait + (tcp-connection-rcv.nxt connection) (+u32 seq 1)) + (tcp4-send-ack connection) + ;; TODO: Start the time-wait timer, turn off the other timers. + )))) (:closing ;; Waiting for ACK (cond ((not (acceptable-segment-p connection seq data-length)) From 5a15692eee1e6c602b18c233f874944c6d49f38e Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Sat, 23 Mar 2024 02:40:21 +0100 Subject: [PATCH 31/65] tcp: Refactor tcp4-connection-receive :fin-wait-1 state --- net/tcp.lisp | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index 3df681f99..8b1277cfe 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -817,21 +817,21 @@ to wrap around logic" (when-acceptable-ack-p connection ack seq) (unless (zerop data-length) (tcp4-receive-data connection data-length end header-length packet seq start)) - (when (eql seq (tcp-connection-rcv.nxt connection)) - (cond ((logtest flags +tcp4-flag-fin+) - (setf (tcp-connection-rcv.nxt connection) (+u32 seq 1)) - (tcp4-send-ack connection) - (cond ((logtest flags +tcp4-flag-ack+) - ;; Remote saw our FIN - (setf (tcp-connection-state connection) :time-wait) - ;; TODO: Start the time-wait timer, turn off the other timers. - ) - (t - ;; Simultaneous close - (setf (tcp-connection-state connection) :closing)))) - ((logtest flags +tcp4-flag-ack+) - ;; Remote saw our FIN - (setf (tcp-connection-state connection) :fin-wait-2))))))) + (cond ((and (logtest flags +tcp4-flag-fin+) + (eql seq (tcp-connection-rcv.nxt connection))) + (setf (tcp-connection-state connection) :time-wait + (tcp-connection-rcv.nxt connection) (+u32 seq 1)) + (tcp4-send-ack connection) + ;; TODO: Start the time-wait timer, turn off the other timers. + ) + ((eql seq (tcp-connection-rcv.nxt connection)) + (setf (tcp-connection-state connection) :fin-wait-2)) + ((and (logtest flags +tcp4-flag-fin+) + (eql seq (tcp-connection-rcv.nxt connection))) + ;; Simultaneous close + (setf (tcp-connection-state connection) :closing + (tcp-connection-rcv.nxt connection) (+u32 seq 1)) + (tcp4-send-ack connection)))))) (:fin-wait-2 ;; Local closed, still waiting for remote to close. (cond ((not (acceptable-segment-p connection seq data-length)) From 7cf7956db939bf9de0da46b2fc8cd54f851d85ad Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Wed, 27 Mar 2024 18:44:05 +0100 Subject: [PATCH 32/65] tcp: Update window size --- net/tcp.lisp | 40 ++++++++++++++++++++++++++++++---------- 1 file changed, 30 insertions(+), 10 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index 8b1277cfe..4ba1b2087 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -224,6 +224,14 @@ to wrap around logic" :type tcp-sequence-number) (%snd.una :accessor tcp-connection-snd.una :initarg :snd.una) + (%snd.wnd :accessor tcp-connection-snd.wnd + :initarg :snd.wnd) + (%max.snd.wnd :accessor tcp-connection-max.snd.wnd + :initarg :max.snd.wnd) + (%snd.wl1 :accessor tcp-connection-snd.wl1 + :initarg :snd.wl1) + (%snd.wl2 :accessor tcp-connection-snd.wl2 + :initarg :snd.wl2) (%rcv.nxt :accessor tcp-connection-rcv.nxt :initarg :rcv.nxt :type tcp-sequence-number) @@ -251,6 +259,7 @@ to wrap around logic" :initarg :boot-id)) (:default-initargs :max-seg-size 1000 + :max.snd.wnd 0 :last-ack-time nil :srtt nil :rttvar nil @@ -520,6 +529,10 @@ to wrap around logic" (declare (ignore end)) (* (ldb (byte 4 12) (ub16ref/be packet (+ start +tcp4-header-flags-and-data-offset+))) 4)) +(defun tcp-packet-window-size (packet start end) + (declare (ignore end)) + (ub16ref/be packet (+ start +tcp4-header-window-size+))) + (defun tcp-packet-data-length (packet start end) (- end (+ start (tcp-packet-header-length packet start end)))) @@ -552,6 +565,13 @@ to wrap around logic" (tcp-connection-max.snd.wnd connection)))) (=< x seg.ack (tcp-connection-snd.nxt connection)))) +(defun update-window (connection seg.wnd seg.seq seg.ack) + (when (> seg.wnd (tcp-connection-max.snd.wnd connection)) + (setf (tcp-connection-max.snd.wnd connection) seg.wnd)) + (setf (tcp-connection-snd.wnd connection) seg.wnd + (tcp-connection-snd.wl1 connection) seg.seq + (tcp-connection-snd.wl2 connection) seg.ack)) + (defun update-timeout-timer (connection) (when (not (eql (tcp-connection-state connection) :syn-sent)) (disarm-timeout-timer connection) @@ -589,7 +609,7 @@ to wrap around logic" (max 0.01 (* 4 (tcp-connection-rttvar connection)))))) (tcp-connection-last-ack-time connection) nil))) -(defun when-acceptable-ack-p (connection ack seq) +(defun when-acceptable-ack-p (connection ack seq wnd) (when (acceptable-ack-p connection ack) (when (tcp-connection-last-ack-time connection) (subsequent-rtt-measurement connection)) @@ -612,8 +632,7 @@ to wrap around logic" (if (endp (tcp-connection-retransmit-queue connection)) (disarm-retransmit-timer connection) (arm-retransmit-timer connection))) - ;; TODO: Update window - ) + (update-window connection wnd seq ack)) (defun tcp4-connection-receive (connection packet start end listener) ;; Don't use WITH-TCP-CONNECTION-LOCKED here. No errors should occur @@ -623,6 +642,7 @@ to wrap around logic" (ack (tcp-packet-acknowledgment-number packet start end)) (flags (tcp-packet-flags packet start end)) (header-length (tcp-packet-header-length packet start end)) + (wnd (tcp-packet-window-size packet start end)) (data-length (tcp-packet-data-length packet start end))) ;; :CLOSED should never be seen here (ecase (tcp-connection-state connection) @@ -656,7 +676,7 @@ to wrap around logic" ;; Simultaneous open (setf (tcp-connection-state connection) :syn-received (tcp-connection-rcv.nxt connection) (+u32 seq 1)) - ;; TODO: Update window + (update-window connection wnd seq ack) (unless *netmangler-force-local-retransmit* (tcp4-send-packet connection ack (tcp-connection-rcv.nxt connection) nil :syn-p t)) @@ -700,7 +720,7 @@ to wrap around logic" ;; Pasive open (initial-rtt-measurement connection) (setf (tcp-connection-state connection) :established) - ;; TODO: Update window + (update-window connection wnd seq ack) (when listener (remhash connection (tcp-listener-pending-connections listener)) (mezzano.sync:mailbox-send connection (tcp-listener-connections listener)))) @@ -734,7 +754,7 @@ to wrap around logic" ;; Remote acks something not yet sent (tcp4-send-ack connection)) (t - (when-acceptable-ack-p connection ack seq) + (when-acceptable-ack-p connection ack seq wnd) (unless (zerop data-length) (tcp4-receive-data connection data-length end header-length packet seq start)) (when (and (logtest flags +tcp4-flag-fin+) @@ -766,7 +786,7 @@ to wrap around logic" ;; Remote acks something not yet sent (tcp4-send-ack connection)) (t - (when-acceptable-ack-p connection ack seq) + (when-acceptable-ack-p connection ack seq wnd) (when (and (logtest flags +tcp4-flag-fin+) (eql seq (tcp-connection-rcv.nxt connection))) (setf (tcp-connection-rcv.nxt connection) (+u32 seq 1)) @@ -814,7 +834,7 @@ to wrap around logic" ;; Remote acks something not yet sent (tcp4-send-ack connection)) (t - (when-acceptable-ack-p connection ack seq) + (when-acceptable-ack-p connection ack seq wnd) (unless (zerop data-length) (tcp4-receive-data connection data-length end header-length packet seq start)) (cond ((and (logtest flags +tcp4-flag-fin+) @@ -855,7 +875,7 @@ to wrap around logic" ;; Remote acks something not yet sent (tcp4-send-ack connection)) (t - (when-acceptable-ack-p connection ack seq) + (when-acceptable-ack-p connection ack seq wnd) (unless (zerop data-length) (tcp4-receive-data connection data-length end header-length packet seq start)) (when (and (logtest flags +tcp4-flag-fin+) @@ -883,7 +903,7 @@ to wrap around logic" ;; Remote acks something not yet sent (tcp4-send-ack connection)) (t - (when-acceptable-ack-p connection ack seq) + (when-acceptable-ack-p connection ack seq wnd) (when (eql seq (tcp-connection-rcv.nxt connection)) (setf (tcp-connection-state connection) :time-wait)) (when (and (logtest flags +tcp4-flag-fin+) From b3659158dc9ae6add76938f456f0bbe6358073df Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Mon, 1 Jul 2024 18:13:46 +0200 Subject: [PATCH 33/65] arp: Use correct function to get the time --- net/arp.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/net/arp.lisp b/net/arp.lisp index 2fc8e0898..a15574372 100644 --- a/net/arp.lisp +++ b/net/arp.lisp @@ -130,7 +130,7 @@ Returns NIL if there is no entry currently in the cache, this will trigger a loo nil) (defun arp-expiration () - (let ((time (1+ (get-internal-real-time)))) + (let ((time (1+ (get-universal-time)))) (mezzano.supervisor:with-mutex (*arp-lock*) (setf *arp-table* (remove-if #'(lambda (arp) (>= time (fourth arp))) From 4f2bd69e7fbc39901947553ca946cad3544af926 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Mon, 1 Jul 2024 18:53:53 +0200 Subject: [PATCH 34/65] tcp: Report connection-closing in tcp-send when connetion is closing --- net/tcp.lisp | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index 4ba1b2087..7fe45abdd 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -1044,6 +1044,9 @@ to wrap around logic" (define-condition connection-closed (connection-error) ()) +(define-condition connection-closing (connection-error) + ()) + (define-condition connection-refused (connection-error) ()) @@ -1156,12 +1159,21 @@ to wrap around logic" (with-tcp-connection-locked connection (check-connection-error connection) (update-timeout-timer connection) - ;; No sending when the connection is closing. - (when (not (or (eql (tcp-connection-state connection) :established) - (eql (tcp-connection-state connection) :close-wait))) + (when (or (eql (tcp-connection-state connection) :syn-sent) + (eql (tcp-connection-state connection) :syn-received)) + ;; TODO: If in state :syn-sent or :syn-received queue the data for processing after the ESTABLISHED state has been reached (error 'connection-closed :host (tcp-connection-remote-ip connection) :port (tcp-connection-remote-port connection))) + ;; No sending when the connection is closing. + (when (or (eql (tcp-connection-state connection) :fin-wait-1) + (eql (tcp-connection-state connection) :fin-wait-2) + (eql (tcp-connection-state connection) :closing) + (eql (tcp-connection-state connection) :last-ack) + (eql (tcp-connection-state connection) :time-wait)) + (error 'connection-closing + :host (tcp-connection-remote-ip connection) + :port (tcp-connection-remote-port connection))) (unless (tcp-connection-last-ack-time connection) (setf (tcp-connection-last-ack-time connection) (get-internal-run-time))) From c229bc9f0647f3d642ec4d0a495cb2bbb390e460 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Mon, 1 Jul 2024 20:01:37 +0200 Subject: [PATCH 35/65] tcp: Implemented abort close TCP specification (rfc9293) says to send a reset segment --- net/tcp.lisp | 45 ++++++++++++++++++++++++++++++--------------- 1 file changed, 30 insertions(+), 15 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index 7fe45abdd..c136cf823 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -1026,17 +1026,6 @@ to wrap around logic" :do (unless (get-tcp-connection ip port local-ip local-port) (return local-port)))) -(defun abort-connection (connection) - (mezzano.sync.dispatch:dispatch-async - (lambda () - (tcp4-send-packet connection - (tcp-connection-snd.nxt connection) - (tcp-connection-rcv.nxt connection) - nil - :rst-p t) - (detach-tcp-connection connection)) - net::*network-serial-queue*)) - (define-condition connection-error (net:network-error) ((host :initarg :host :reader connection-error-host) (port :initarg :port :reader connection-error-port))) @@ -1341,6 +1330,33 @@ to wrap around logic" (defmethod gray:stream-write-sequence ((stream tcp-octet-stream) sequence &optional (start 0) end) (tcp-send (tcp-stream-connection stream) sequence start end)) +(defun abort-connection (connection) + (ecase (tcp-connection-state connection) + (:syn-sent + (setf (tcp-connection-pending-error connection) + (make-condition 'connection-reset + :host (tcp-connection-remote-ip connection) + :port (tcp-connection-remote-port connection)))) + ((:syn-received :established :fin-wait-1 :fin-wait-2 :close-wait) + (setf (tcp-connection-pending-error connection) + (make-condition 'connection-reset + :host (tcp-connection-remote-ip connection) + :port (tcp-connection-remote-port connection))) + (tcp4-send-packet connection + (tcp-connection-snd.nxt connection) + (tcp-connection-rcv.nxt connection) + nil + :ack-p nil + :rst-p t)) + ((:closing :last-ack :time-wait) + (tcp4-send-packet connection + (tcp-connection-snd.nxt connection) + (tcp-connection-rcv.nxt connection) + nil)) + (:closed)) + (mezzano.supervisor:condition-notify (tcp-connection-cvar connection) t) + (detach-tcp-connection connection)) + (defun close-connection (connection) (ecase (tcp-connection-state connection) (:established @@ -1379,12 +1395,11 @@ to wrap around logic" ((:last-ack :fin-wait-1 :fin-wait-2 :closed :time-wait)))) (defmethod close ((stream tcp-octet-stream) &key abort) - ;; TODO: ABORT should abort the connection entirely. - ;; Don't even bother sending RST packets, just detatch the connection. - (declare (ignore abort)) (let ((connection (tcp-stream-connection stream))) (with-tcp-connection-locked connection - (close-connection connection)))) + (if abort + (abort-connection connection) + (close-connection connection))))) (defmethod open-stream-p ((stream tcp-octet-stream)) (with-tcp-connection-locked (tcp-stream-connection stream) From 24ea270da42ed129e49964c97b4a68f3b6a0dd71 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Tue, 9 Jul 2024 12:47:37 +0200 Subject: [PATCH 36/65] tcp: Refactor tcp-send --- net/tcp.lisp | 62 +++++++++++++++++++++++++--------------------------- 1 file changed, 30 insertions(+), 32 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index c136cf823..c33810420 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -1148,38 +1148,36 @@ to wrap around logic" (with-tcp-connection-locked connection (check-connection-error connection) (update-timeout-timer connection) - (when (or (eql (tcp-connection-state connection) :syn-sent) - (eql (tcp-connection-state connection) :syn-received)) - ;; TODO: If in state :syn-sent or :syn-received queue the data for processing after the ESTABLISHED state has been reached - (error 'connection-closed - :host (tcp-connection-remote-ip connection) - :port (tcp-connection-remote-port connection))) - ;; No sending when the connection is closing. - (when (or (eql (tcp-connection-state connection) :fin-wait-1) - (eql (tcp-connection-state connection) :fin-wait-2) - (eql (tcp-connection-state connection) :closing) - (eql (tcp-connection-state connection) :last-ack) - (eql (tcp-connection-state connection) :time-wait)) - (error 'connection-closing - :host (tcp-connection-remote-ip connection) - :port (tcp-connection-remote-port connection))) - (unless (tcp-connection-last-ack-time connection) - (setf (tcp-connection-last-ack-time connection) - (get-internal-run-time))) - (let ((mss (tcp-connection-max-seg-size connection))) - (cond ((>= start end)) - ((> (- end start) mss) - ;; Send multiple packets. - (loop - for offset from start by mss - while (> (- end offset) mss) - do - (tcp-send-1 connection data offset (+ offset mss)) - finally - (tcp-send-1 connection data offset end :psh-p t))) - (t - ;; Send one packet. - (tcp-send-1 connection data start end :psh-p t)))))) + (ecase (tcp-connection-state connection) + ((:syn-sent :syn-received) + ;; Data associated with SEND may be sent with SYN segment or queued for transmission after entering ESTABLISHED state + ;; TODO: If in state :syn-sent or :syn-received queue the data for processing after the ESTABLISHED state has been reached + (error 'connection-closed + :host (tcp-connection-remote-ip connection) + :port (tcp-connection-remote-port connection))) + ((:established :close-wait) + (unless (tcp-connection-last-ack-time connection) + (setf (tcp-connection-last-ack-time connection) + (get-internal-run-time))) + (let ((mss (tcp-connection-max-seg-size connection))) + (cond ((>= start end)) + ((> (- end start) mss) + ;; Send multiple packets. + (loop :for offset :from start :by mss + :while (> (- end offset) mss) + :do (tcp-send-1 connection data offset (+ offset mss)) + :finally (tcp-send-1 connection data offset end :psh-p t))) + (t + ;; Send one packet. + (tcp-send-1 connection data start end :psh-p t))))) + ((:fin-wait-1 :fin-wait-2 :closing :last-ack :time-wait) + (error 'connection-closing + :host (tcp-connection-remote-ip connection) + :port (tcp-connection-remote-port connection))) + (:closed + (error 'connection-closed + :host (tcp-connection-remote-ip connection) + :port (tcp-connection-remote-port connection)))))) (defclass tcp-octet-stream (gray:fundamental-binary-input-stream gray:fundamental-binary-output-stream) From 94ebcb65dce00264ddc776b88c3d04d5e38383a0 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Tue, 9 Jul 2024 14:52:05 +0200 Subject: [PATCH 37/65] tcp: Add missing :closed case Make sure the Mezzano compilation does not fail due to missing :closed case --- net/tcp.lisp | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index c33810420..5e3be6dc6 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -308,7 +308,8 @@ to wrap around logic" (apply #'tcp4-send-packet connection packet) (setf (tcp-connection-rto connection) (min *maximum-rto* (* 2 (tcp-connection-rto connection)))) - (arm-retransmit-timer connection)))))) + (arm-retransmit-timer connection))) + (:closed)))) (defun arm-timeout-timer (seconds connection) (mezzano.supervisor:timer-arm seconds From dc3eced22e0ebbf8a5cc09b2af040ade9622d151 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Wed, 10 Jul 2024 14:08:46 +0200 Subject: [PATCH 38/65] tcp: Implemented time-wait timeout --- net/tcp.lisp | 33 ++++++++++++++++++--------------- 1 file changed, 18 insertions(+), 15 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index 5e3be6dc6..5d65bce0c 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -32,6 +32,7 @@ (defparameter *tcp-initial-retransmit-time* 1) (defparameter *minimum-rto* 1) ;; in seconds (defparameter *maximum-rto* 60) ;; in seconds +(defparameter *msl* 120) ;; in seconds (defparameter *initial-window-size* 8192) @@ -336,7 +337,7 @@ to wrap around logic" :port (tcp-connection-remote-port connection))) (mezzano.supervisor:condition-notify (tcp-connection-cvar connection) t) (case (tcp-connection-state connection) - (:syn-sent + ((:syn-sent :time-wait) (detach-tcp-connection connection)) (:closed) (t @@ -574,13 +575,14 @@ to wrap around logic" (tcp-connection-snd.wl2 connection) seg.ack)) (defun update-timeout-timer (connection) - (when (not (eql (tcp-connection-state connection) :syn-sent)) - (disarm-timeout-timer connection) - (let ((timeout (tcp-connection-timeout connection))) - (when (and timeout - (not (member (tcp-connection-state connection) - '(:fin-wait-1 :fin-wait-2 :last-ack :closed)))) - (arm-timeout-timer timeout connection))))) + (case (tcp-connection-state connection) + ((:fin-wait-1 :fin-wait-2) + (disarm-timeout-timer connection)) + ((:syn-sent :syn-received :established :closing) + (disarm-timeout-timer connection) + (let ((timeout (tcp-connection-timeout connection))) + (when timeout + (arm-timeout-timer timeout connection)))))) (defun initial-rtt-measurement (connection) (let ((delta-time (float (/ (- (get-internal-run-time) (tcp-connection-last-ack-time connection)) @@ -843,8 +845,7 @@ to wrap around logic" (setf (tcp-connection-state connection) :time-wait (tcp-connection-rcv.nxt connection) (+u32 seq 1)) (tcp4-send-ack connection) - ;; TODO: Start the time-wait timer, turn off the other timers. - ) + (arm-timeout-timer (* 2 *msl*) connection)) ((eql seq (tcp-connection-rcv.nxt connection)) (setf (tcp-connection-state connection) :fin-wait-2)) ((and (logtest flags +tcp4-flag-fin+) @@ -884,8 +885,7 @@ to wrap around logic" (setf (tcp-connection-state connection) :time-wait (tcp-connection-rcv.nxt connection) (+u32 seq 1)) (tcp4-send-ack connection) - ;; TODO: Start the time-wait timer, turn off the other timers. - )))) + (arm-timeout-timer (* 2 *msl*) connection))))) (:closing ;; Waiting for ACK (cond ((not (acceptable-segment-p connection seq data-length)) @@ -906,7 +906,9 @@ to wrap around logic" (t (when-acceptable-ack-p connection ack seq wnd) (when (eql seq (tcp-connection-rcv.nxt connection)) - (setf (tcp-connection-state connection) :time-wait)) + (setf (tcp-connection-state connection) :time-wait) + (disarm-timeout-timer connection) + (arm-timeout-timer (* 2 *msl*) connection)) (when (and (logtest flags +tcp4-flag-fin+) (eql seq (tcp-connection-rcv.nxt connection))) (setf (tcp-connection-rcv.nxt connection) (+u32 seq 1)) @@ -926,9 +928,10 @@ to wrap around logic" (tcp4-send-ack connection)) ((and (logtest flags +tcp4-flag-fin+) (eql seq (tcp-connection-rcv.nxt connection))) - ;; TODO: Restart the 2 MSL timeout. (setf (tcp-connection-rcv.nxt connection) (+u32 seq 1)) - (tcp4-send-ack connection)))))) + (tcp4-send-ack connection) + (disarm-timeout-timer connection) + (arm-timeout-timer (* 2 *msl*) connection)))))) (update-timeout-timer connection) ;; Notify any waiters that something may have changed. (mezzano.supervisor:condition-notify (tcp-connection-cvar connection) t))) From 1690e24378260f7524ef313c880d61f595d472d1 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Fri, 12 Jul 2024 15:32:35 +0200 Subject: [PATCH 39/65] tcp: Add :closed case to tcp4-connection-receive --- net/tcp.lisp | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index 5d65bce0c..752497d04 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -647,7 +647,6 @@ to wrap around logic" (header-length (tcp-packet-header-length packet start end)) (wnd (tcp-packet-window-size packet start end)) (data-length (tcp-packet-data-length packet start end))) - ;; :CLOSED should never be seen here (ecase (tcp-connection-state connection) (:syn-sent (cond ((logtest flags +tcp4-flag-rst+) @@ -931,7 +930,8 @@ to wrap around logic" (setf (tcp-connection-rcv.nxt connection) (+u32 seq 1)) (tcp4-send-ack connection) (disarm-timeout-timer connection) - (arm-timeout-timer (* 2 *msl*) connection)))))) + (arm-timeout-timer (* 2 *msl*) connection)))) + (:closed))) (update-timeout-timer connection) ;; Notify any waiters that something may have changed. (mezzano.supervisor:condition-notify (tcp-connection-cvar connection) t))) From fe6ae64e019fbff86817c4c72e95a81e93f13b20 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Fri, 12 Jul 2024 19:42:04 +0200 Subject: [PATCH 40/65] tcp: Add close for :syn-sent and :syn-received cases --- net/tcp.lisp | 29 +++++++++++++++++++++++++++-- 1 file changed, 27 insertions(+), 2 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index 752497d04..53d6b26d9 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -1361,6 +1361,30 @@ to wrap around logic" (defun close-connection (connection) (ecase (tcp-connection-state connection) + (:syn-sent + (setf (tcp-connection-pending-error connection) + (make-condition 'connection-closing + :host (tcp-connection-remote-ip connection) + :port (tcp-connection-remote-port connection))) + (detach-tcp-connection connection)) + (:syn-received + ;; TODO: If there is data to send queue for processing after entering ESTABLISHED state. + (setf (tcp-connection-state connection) :fin-wait-1) + (setf (tcp-connection-retransmit-queue connection) + (append (tcp-connection-retransmit-queue connection) + (list (list (tcp-connection-snd.nxt connection) + (tcp-connection-rcv.nxt connection) + nil + :fin-p t + :errors-escape t)))) + (arm-retransmit-timer connection) + (when (not *netmangler-force-local-retransmit*) + (tcp4-send-packet connection + (tcp-connection-snd.nxt connection) + (tcp-connection-rcv.nxt connection) + nil + :fin-p t + :errors-escape t))) (:established (setf (tcp-connection-state connection) :fin-wait-1) (setf (tcp-connection-retransmit-queue connection) @@ -1368,7 +1392,8 @@ to wrap around logic" (list (list (tcp-connection-snd.nxt connection) (tcp-connection-rcv.nxt connection) nil - :fin-p t)))) + :fin-p t + :errors-escape t)))) (arm-retransmit-timer connection) (when (not *netmangler-force-local-retransmit*) (tcp4-send-packet connection @@ -1394,7 +1419,7 @@ to wrap around logic" nil :fin-p t :errors-escape t))) - ((:last-ack :fin-wait-1 :fin-wait-2 :closed :time-wait)))) + ((:last-ack :fin-wait-1 :fin-wait-2 :closing :time-wait :closed)))) (defmethod close ((stream tcp-octet-stream) &key abort) (let ((connection (tcp-stream-connection stream))) From eafa3ebb24d566ca35c87e4259c88de30000ef4f Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Sun, 19 Jan 2025 17:58:46 +0100 Subject: [PATCH 41/65] tcp: Default MSS for IPv4 is 536 --- net/tcp.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index 53d6b26d9..6c5b2c3c9 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -259,7 +259,7 @@ to wrap around logic" (%boot-id :reader tcp-connection-boot-id :initarg :boot-id)) (:default-initargs - :max-seg-size 1000 + :max-seg-size 536 :max.snd.wnd 0 :last-ack-time nil :srtt nil From 8f75902db9670840157e31343796686b7656d268 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Mon, 20 Jan 2025 18:41:00 +0100 Subject: [PATCH 42/65] tcp: Support the mandatory option set --- net/tcp.lisp | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) diff --git a/net/tcp.lisp b/net/tcp.lisp index 6c5b2c3c9..a535f7b0c 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -3,6 +3,7 @@ ;;; Transmission Control Protocol - Protocol Specification ;;; https://datatracker.ietf.org/doc/html/rfc9293 ;;; +;;; TODO: Sending MSS (Must-14) (in-package :mezzano.network.tcp) @@ -14,6 +15,7 @@ (defconstant +tcp4-header-window-size+ 14) (defconstant +tcp4-header-checksum+ 16) (defconstant +tcp4-header-urgent-pointer+ 18) +(defconstant +tcp4-header-options+ 20) (defconstant +tcp4-flag-fin+ #b00000001) (defconstant +tcp4-flag-syn+ #b00000010) @@ -24,6 +26,13 @@ (defconstant +tcp4-flag-ece+ #b01000000) (defconstant +tcp4-flag-cwr+ #b10000000) +;;; TCP options +(defconstant +tcp-option-eol+ 0 "End of options (RFC793)") +(defconstant +tcp-option-nop+ 1 "Padding (RFC793)") +(defconstant +tcp-option-mss+ 2 "Segment size negotiating (RFC793)") + +(defconstant +tcp-option-mss-length+ 4) + ;; DEFPARAMETER, not DEFCONSTANT, due to cross-compiler constraints. (defparameter +ip-wildcard+ (mezzano.network.ip:make-ipv4-address "0.0.0.0")) (defconstant +port-wildcard+ 0) @@ -406,6 +415,7 @@ to wrap around logic" (let* ((irs (ub32ref/be packet (+ start +tcp4-header-sequence-number+))) (iss (or *netmangler-iss* (random #x100000000))) + (header-length (tcp-packet-header-length packet start end)) (connection (make-instance 'tcp-connection :state :syn-received :local-port local-port @@ -418,6 +428,7 @@ to wrap around logic" :rcv.wnd *initial-window-size* :boot-id (mezzano.supervisor:current-boot-id)))) (mezzano.supervisor:with-mutex (*tcp-connection-lock*) + (tcp-packet-options connection packet start header-length) (push connection *tcp-connections*)) (setf (gethash connection (tcp-listener-pending-connections listener)) connection) @@ -538,6 +549,27 @@ to wrap around logic" (defun tcp-packet-data-length (packet start end) (- end (+ start (tcp-packet-header-length packet start end)))) +(defun tcp-packet-options (connection packet start header-length) + (when (> header-length +tcp4-header-options+) + (loop :with offset := (+ start +tcp4-header-options+) + :with end := (+ start header-length) + :always (< offset end) + :do (let ((kind (aref packet offset))) + (cond ((= kind +tcp-option-eol+) + (return)) + ((= kind +tcp-option-nop+) + (incf offset)) + (t + (let ((length (aref packet (1+ offset)))) + (when (> 2 length end) + ;; Ignore silly options and partial options + (return)) + (when (= kind +tcp-option-mss+) + (when (= length +tcp-option-mss-length+) + (let ((mss (ub16ref/be packet (+ offset 2)))) + (setf (tcp-connection-max-seg-size connection) mss)))) + (incf offset length)))))))) + (defun acceptable-segment-p (connection seg.seq seg.len) (let ((rcv.wnd (tcp-connection-rcv.wnd connection)) (rcv.nxt (tcp-connection-rcv.nxt connection))) @@ -666,6 +698,7 @@ to wrap around logic" (eql ack (tcp-connection-snd.nxt connection))) ;; Active open (initial-rtt-measurement connection) + (tcp-packet-options connection packet start header-length) (setf (tcp-connection-state connection) :established (tcp-connection-rcv.nxt connection) (+u32 seq 1) (tcp-connection-snd.una connection) ack) @@ -676,6 +709,7 @@ to wrap around logic" (disarm-timeout-timer connection)) ((logtest flags +tcp4-flag-syn+) ;; Simultaneous open + (tcp-packet-options connection packet start header-length) (setf (tcp-connection-state connection) :syn-received (tcp-connection-rcv.nxt connection) (+u32 seq 1)) (update-window connection wnd seq ack) From 09b45ead0512e180e94c6c1ab566057ee60a02ba Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Wed, 29 Jan 2025 18:54:02 +0100 Subject: [PATCH 43/65] tcp: Set own MSS to 1460 --- net/tcp.lisp | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index a535f7b0c..b3833beca 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -3,7 +3,6 @@ ;;; Transmission Control Protocol - Protocol Specification ;;; https://datatracker.ietf.org/doc/html/rfc9293 ;;; -;;; TODO: Sending MSS (Must-14) (in-package :mezzano.network.tcp) @@ -1023,7 +1022,8 @@ to wrap around logic" "Build a full TCP & IP header." (let* ((checksum 0) (payload-size (length payload)) - (header (make-array 20 :element-type '(unsigned-byte 8))) + (header-length (if syn-p 24 20)) + (header (make-array header-length :element-type '(unsigned-byte 8))) (packet (list header payload))) ;; Assemble the TCP header. (setf (ub16ref/be header +tcp4-header-source-port+) src-port @@ -1031,7 +1031,7 @@ to wrap around logic" (ub32ref/be header +tcp4-header-sequence-number+) seq-num (ub32ref/be header +tcp4-header-acknowledgment-number+) ack-num ;; Data offset/header length (5 32-bit words) and flags. - (ub16ref/be header +tcp4-header-flags-and-data-offset+) (logior #x5000 + (ub16ref/be header +tcp4-header-flags-and-data-offset+) (logior (ash (ceiling header-length 4) 12) (if fin-p +tcp4-flag-fin+ 0) (if syn-p +tcp4-flag-syn+ 0) (if rst-p +tcp4-flag-rst+ 0) @@ -1046,6 +1046,11 @@ to wrap around logic" (ub16ref/be header +tcp4-header-checksum+) 0 ;; Urgent pointer. (ub16ref/be header +tcp4-header-urgent-pointer+) 0) + ;; MSS TODO: MUST-16, SHLD-6 and MUST-67 + (when syn-p + (setf (aref header +tcp4-header-options+) 2 + (aref header (+ 1 +tcp4-header-options+)) 4 + (ub16ref/be header (+ 2 +tcp4-header-options+)) 1460)) ;; Compute the final checksum. (setf checksum (compute-ip-pseudo-header-partial-checksum (mezzano.network.ip::ipv4-address-address src-ip) From 966c5570550dc6bc9133206513426ed55cd691ef Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Fri, 14 Feb 2025 13:01:50 +0100 Subject: [PATCH 44/65] tcp: Add checks for updating send window https://datatracker.ietf.org/doc/html/rfc9293#section-3.10.7.4-2.5.2.2.2.3.2.2 --- net/tcp.lisp | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index b3833beca..55eb36b54 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -666,7 +666,11 @@ to wrap around logic" (if (endp (tcp-connection-retransmit-queue connection)) (disarm-retransmit-timer connection) (arm-retransmit-timer connection))) - (update-window connection wnd seq ack)) + (when (and (=< (tcp-connection-snd.una connection) ack (tcp-connection-snd.nxt connection)) + (or (>u32 seq (tcp-connection-snd.wl1 connection)) + (and (= seq (tcp-connection-snd.wl1 connection)) + (>=u32 ack (tcp-connection-snd.wl2 connection))))) + (update-window connection wnd seq ack))) (defun tcp4-connection-receive (connection packet start end listener) ;; Don't use WITH-TCP-CONNECTION-LOCKED here. No errors should occur From 0d6923be5f2c2cf60e4b3cc027f6cb63a755581a Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Tue, 18 Feb 2025 16:32:14 +0100 Subject: [PATCH 45/65] tcp: Fix errata --- net/tcp.lisp | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index 55eb36b54..de4c85942 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -1394,10 +1394,7 @@ to wrap around logic" :ack-p nil :rst-p t)) ((:closing :last-ack :time-wait) - (tcp4-send-packet connection - (tcp-connection-snd.nxt connection) - (tcp-connection-rcv.nxt connection) - nil)) + (tcp4-send-ack connection)) (:closed)) (mezzano.supervisor:condition-notify (tcp-connection-cvar connection) t) (detach-tcp-connection connection)) From 55cf9d16ff353bb6894d52150469c09cac37fc61 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Tue, 18 Feb 2025 18:19:57 +0100 Subject: [PATCH 46/65] tcp: Handle retransmision and timeout in :syn-received state --- net/tcp.lisp | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index de4c85942..6add36830 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -306,6 +306,11 @@ to wrap around logic" (let ((seq (-u32 (tcp-connection-snd.nxt connection) 1))) (tcp4-send-packet connection seq 0 nil :ack-p nil :syn-p t) (arm-retransmit-timer connection))) + (:syn-received + (let* ((iss (tcp-connection-snd.una connection)) + (irs (tcp-connection-rcv.nxt connection))) + (tcp4-send-packet connection iss irs nil :syn-p t) + (arm-retransmit-timer connection))) ((:established :close-wait :last-ack @@ -345,7 +350,7 @@ to wrap around logic" :port (tcp-connection-remote-port connection))) (mezzano.supervisor:condition-notify (tcp-connection-cvar connection) t) (case (tcp-connection-state connection) - ((:syn-sent :time-wait) + ((:syn-sent :syn-received :time-wait) (detach-tcp-connection connection)) (:closed) (t @@ -434,7 +439,9 @@ to wrap around logic" (setf (tcp-connection-last-ack-time connection) (get-internal-run-time)) (when (not *netmangler-force-local-retransmit*) - (tcp4-send-packet connection iss (+u32 irs 1) nil :syn-p t)))) + (tcp4-send-packet connection iss (+u32 irs 1) nil :syn-p t)) + (arm-retransmit-timer connection) + (arm-timeout-timer *tcp-connect-timeout* connection))) ((logtest flags +tcp4-flag-rst+)) ; Do nothing for resets addressed to nobody. ((logtest flags +tcp4-flag-fin+)) ; Do nothing for finish since the SEG.SEQ cannot be validated (t From fb3d8ff978edb5a99f69e751f751cfb10badb06f Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Tue, 18 Feb 2025 18:57:58 +0100 Subject: [PATCH 47/65] tcp: Add missing update-window --- net/tcp.lisp | 1 + 1 file changed, 1 insertion(+) diff --git a/net/tcp.lisp b/net/tcp.lisp index 6add36830..779a42bdf 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -712,6 +712,7 @@ to wrap around logic" (setf (tcp-connection-state connection) :established (tcp-connection-rcv.nxt connection) (+u32 seq 1) (tcp-connection-snd.una connection) ack) + (update-window connection wnd seq ack) (unless *netmangler-force-local-retransmit* (tcp4-send-ack connection)) ;; Cancel retransmit From dad5bfa75f4187b3a6815ec2acd5ae0058638847 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Thu, 20 Feb 2025 11:46:57 +0100 Subject: [PATCH 48/65] tcp: Better docstrings for acceptable-segment-p and acceptable-ack-p --- net/tcp.lisp | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index 779a42bdf..ca0e563f1 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -577,6 +577,7 @@ to wrap around logic" (incf offset length)))))))) (defun acceptable-segment-p (connection seg.seq seg.len) + "If (RCV.NXT <= SEG.SEQ < RCV.NXT+RCV.WND) the segment is inside the receive window." (let ((rcv.wnd (tcp-connection-rcv.wnd connection)) (rcv.nxt (tcp-connection-rcv.nxt connection))) (if (eql rcv.wnd 0) @@ -590,7 +591,7 @@ to wrap around logic" (and (<= rcv.nxt seq-end) (< seq-end (+ rcv.nxt rcv.wnd))))))))) (defun acceptable-ack-p (connection seg.ack) - "If SND.UNA < SEG.ACK <= SND.NXT, then the ACK is acceptable." + "If (SND.UNA < SEG.ACK <= SND.NXT) the ACK is acceptable." (if (< (tcp-connection-snd.una connection) (tcp-connection-snd.nxt connection)) (and (< (tcp-connection-snd.una connection) seg.ack) From 545685107b1f251c36a1aec750e8a83a5f66c502 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Sat, 19 Apr 2025 00:50:10 +0200 Subject: [PATCH 49/65] tcp: Cancel retransmit after 3-Way Handshake Fixes crash when accepting listener connection --- net/tcp.lisp | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index ca0e563f1..c86c3306c 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -727,10 +727,7 @@ to wrap around logic" (update-window connection wnd seq ack) (unless *netmangler-force-local-retransmit* (tcp4-send-packet connection ack (tcp-connection-rcv.nxt connection) nil - :syn-p t)) - ;; Cancel retransmit - (disarm-retransmit-timer connection) - (disarm-timeout-timer connection)))) + :syn-p t))))) (:syn-received (cond ((not (acceptable-segment-p connection seq data-length)) (unless (logtest flags +tcp4-flag-rst+) @@ -771,7 +768,10 @@ to wrap around logic" (update-window connection wnd seq ack) (when listener (remhash connection (tcp-listener-pending-connections listener)) - (mezzano.sync:mailbox-send connection (tcp-listener-connections listener)))) + (mezzano.sync:mailbox-send connection (tcp-listener-connections listener))) + ;; Cancel retransmit + (disarm-retransmit-timer connection) + (disarm-timeout-timer connection)) (t ;; Segment from an old connection (tcp4-send-packet connection ack seq nil :ack-p nil :rst-p t))) From 59f75a56b1ace95536d2d0658658985bf250d01a Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Sun, 27 Apr 2025 17:02:12 +0200 Subject: [PATCH 50/65] tcp: Cancel retransmit when getting FIN in :syn-received --- net/tcp.lisp | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index c86c3306c..c21e5e558 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -779,7 +779,10 @@ to wrap around logic" (eql seq (tcp-connection-rcv.nxt connection))) (setf (tcp-connection-state connection) :close-wait (tcp-connection-rcv.nxt connection) (+u32 seq 1)) - (tcp4-send-ack connection))))) + (tcp4-send-ack connection) + ;; Cancel retransmit + (disarm-retransmit-timer connection) + (disarm-timeout-timer connection))))) (:established (cond ((not (acceptable-segment-p connection seq data-length)) (unless (logtest flags +tcp4-flag-rst+) From ab40c0532c757d54201ae3639c6283299bcc6276 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Tue, 3 Jun 2025 21:23:45 +0200 Subject: [PATCH 51/65] tcp: Update snd.nxt when sending FIN --- net/tcp.lisp | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index c21e5e558..c32e0aa74 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -1404,7 +1404,9 @@ to wrap around logic" (tcp-connection-rcv.nxt connection) nil :ack-p nil - :rst-p t)) + :rst-p t) + (setf (tcp-connection-snd.nxt connection) + (+u32 (tcp-connection-snd.nxt connection) 1))) ((:closing :last-ack :time-wait) (tcp4-send-ack connection)) (:closed)) @@ -1436,7 +1438,9 @@ to wrap around logic" (tcp-connection-rcv.nxt connection) nil :fin-p t - :errors-escape t))) + :errors-escape t)) + (setf (tcp-connection-snd.nxt connection) + (+u32 (tcp-connection-snd.nxt connection) 1))) (:established (setf (tcp-connection-state connection) :fin-wait-1) (setf (tcp-connection-retransmit-queue connection) @@ -1453,7 +1457,9 @@ to wrap around logic" (tcp-connection-rcv.nxt connection) nil :fin-p t - :errors-escape t))) + :errors-escape t)) + (setf (tcp-connection-snd.nxt connection) + (+u32 (tcp-connection-snd.nxt connection) 1))) (:close-wait (setf (tcp-connection-state connection) :last-ack) (setf (tcp-connection-retransmit-queue connection) @@ -1470,7 +1476,9 @@ to wrap around logic" (tcp-connection-rcv.nxt connection) nil :fin-p t - :errors-escape t))) + :errors-escape t)) + (setf (tcp-connection-snd.nxt connection) + (+u32 (tcp-connection-snd.nxt connection) 1))) ((:last-ack :fin-wait-1 :fin-wait-2 :closing :time-wait :closed)))) (defmethod close ((stream tcp-octet-stream) &key abort) From 0f28d521e9f1fd6bae0e4ee82a3791fd1b7b42c2 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Fri, 6 Jun 2025 19:32:21 +0200 Subject: [PATCH 52/65] tcp: Refactor implementation for clarity and configurability - Reorganized code with section headers for better structure - Added detailed comments for constants and parameters - Replaced hardcoded MSS values with *default-max-seg-size* and *max-seg-size* - Replaced `(when (not ...))` with `(unless ...)` for readability - Improved documentation of TCP flags and options --- net/tcp.lisp | 105 ++++++++++++++++++++++++++++++--------------------- 1 file changed, 63 insertions(+), 42 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index c32e0aa74..e811f8cb3 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -6,6 +6,11 @@ (in-package :mezzano.network.tcp) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; TCP protocol constants +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; TCP header offsets in octets (defconstant +tcp4-header-source-port+ 0) (defconstant +tcp4-header-destination-port+ 2) (defconstant +tcp4-header-sequence-number+ 4) @@ -16,44 +21,60 @@ (defconstant +tcp4-header-urgent-pointer+ 18) (defconstant +tcp4-header-options+ 20) -(defconstant +tcp4-flag-fin+ #b00000001) -(defconstant +tcp4-flag-syn+ #b00000010) -(defconstant +tcp4-flag-rst+ #b00000100) -(defconstant +tcp4-flag-psh+ #b00001000) -(defconstant +tcp4-flag-ack+ #b00010000) -(defconstant +tcp4-flag-urg+ #b00100000) -(defconstant +tcp4-flag-ece+ #b01000000) -(defconstant +tcp4-flag-cwr+ #b10000000) - -;;; TCP options -(defconstant +tcp-option-eol+ 0 "End of options (RFC793)") -(defconstant +tcp-option-nop+ 1 "Padding (RFC793)") -(defconstant +tcp-option-mss+ 2 "Segment size negotiating (RFC793)") - -(defconstant +tcp-option-mss-length+ 4) - -;; DEFPARAMETER, not DEFCONSTANT, due to cross-compiler constraints. +;;; TCP control flags (bitmask values) +(defconstant +tcp4-flag-fin+ #b00000001 "Finish flag (RFC 793)") +(defconstant +tcp4-flag-syn+ #b00000010 "Synchronize flag (RFC 793)") +(defconstant +tcp4-flag-rst+ #b00000100 "Reset flag (RFC 793)") +(defconstant +tcp4-flag-psh+ #b00001000 "Push flag (RFC 793)") +(defconstant +tcp4-flag-ack+ #b00010000 "Acknowledgment flag (RFC 793)") +(defconstant +tcp4-flag-urg+ #b00100000 "Urgent flag (RFC 793)") +(defconstant +tcp4-flag-ece+ #b01000000 "ECN-Echo flag (RFC 3168)") +(defconstant +tcp4-flag-cwr+ #b10000000 "Congestion Window Reduced flag (RFC 3168)") + +;;; TCP option types +(defconstant +tcp-option-eol+ 0 "End of options (RFC 793)") +(defconstant +tcp-option-nop+ 1 "No operation/Padding (RFC 793)") +(defconstant +tcp-option-mss+ 2 "Maximum Segment Size (RFC 793)") +(defconstant +tcp-option-mss-length+ 4 "MSS option length in octets") + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Network configuration parameters +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Wildcard address/port definitions +;; DEFPARAMETER used for +ip-wildcard+ due to cross-compiler constraints (defparameter +ip-wildcard+ (mezzano.network.ip:make-ipv4-address "0.0.0.0")) (defconstant +port-wildcard+ 0) -(defparameter *tcp-connect-timeout* 10) -(defparameter *tcp-initial-retransmit-time* 1) -(defparameter *minimum-rto* 1) ;; in seconds -(defparameter *maximum-rto* 60) ;; in seconds -(defparameter *msl* 120) ;; in seconds +;;; Connection time management +(defparameter *tcp-connect-timeout* 10 "Connection establishment timeout in seconds") +(defparameter *tcp-initial-retransmit-time* 1 "Initial RTO value in seconds (RFC 6298)") +(defparameter *minimum-rto* 1 "Minimum retransmission timeout in seconds (RFC 6298)") +(defparameter *maximum-rto* 60 "Maximum retransmission timeout in seconds (RFC 6298)") +(defparameter *msl* 120 "Maximum Segment Lifetime in seconds (RFC 793)") + +;;; Window and Segment Sizing +(defparameter *initial-window-size* 8192 "Initial congestion window size in octets") +(defparameter *default-max-seg-size* 536 "Default maximum segment size in octets") +(defparameter *max-seg-size* 1460 "Maximum segment size in octets") -(defparameter *initial-window-size* 8192) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Debugging and testing parameters +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defparameter *netmangler-force-local-retransmit* nil - "If true, then all data segments will be initially dropped -and forced to be sent from the retransmit queue.") + "When T, force all data segments through retransmit queue (simulates packet loss)") (defparameter *netmangler-iss* nil "Force the ISS to this value. Set to a value near 2^32 to test SND sequence number wrapping.") -(defvar *tcp-connections* nil) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Connection state management +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar *tcp-connections* nil "List of active TCP connections") (defvar *tcp-connection-lock* (mezzano.supervisor:make-mutex "TCP connection list")) -(defvar *tcp-listeners* nil) +(defvar *tcp-listeners* nil "List of active TCP listeners") (defvar *tcp-listener-lock* (mezzano.supervisor:make-mutex "TCP listener list")) (deftype tcp-connection-state () @@ -267,7 +288,7 @@ to wrap around logic" (%boot-id :reader tcp-connection-boot-id :initarg :boot-id)) (:default-initargs - :max-seg-size 536 + :max-seg-size *default-max-seg-size* :max.snd.wnd 0 :last-ack-time nil :srtt nil @@ -291,8 +312,8 @@ to wrap around logic" (values)) (defun retransmit-timer-handler (connection) - (when (not (mezzano.supervisor:timer-expired-p - (tcp-connection-retransmit-timer connection))) + (unless (mezzano.supervisor:timer-expired-p + (tcp-connection-retransmit-timer connection)) ;; Timer is either still pending or isn't actually running. ;; This can happen if the timer expires but some other task reconfigures ;; a new retransmit time. @@ -335,8 +356,8 @@ to wrap around logic" (values)) (defun timeout-timer-handler (connection) - (when (not (mezzano.supervisor:timer-expired-p - (tcp-connection-timeout-timer connection))) + (unless (mezzano.supervisor:timer-expired-p + (tcp-connection-timeout-timer connection)) ;; Timer is either still pending or isn't actually running. ;; This can happen if the timer expires but some other task reconfigures ;; a new timeout time. @@ -438,7 +459,7 @@ to wrap around logic" connection) (setf (tcp-connection-last-ack-time connection) (get-internal-run-time)) - (when (not *netmangler-force-local-retransmit*) + (unless *netmangler-force-local-retransmit* (tcp4-send-packet connection iss (+u32 irs 1) nil :syn-p t)) (arm-retransmit-timer connection) (arm-timeout-timer *tcp-connect-timeout* connection))) @@ -1066,7 +1087,7 @@ to wrap around logic" (when syn-p (setf (aref header +tcp4-header-options+) 2 (aref header (+ 1 +tcp4-header-options+)) 4 - (ub16ref/be header (+ 2 +tcp4-header-options+)) 1460)) + (ub16ref/be header (+ 2 +tcp4-header-options+)) *max-seg-size*)) ;; Compute the final checksum. (setf checksum (compute-ip-pseudo-header-partial-checksum (mezzano.network.ip::ipv4-address-address src-ip) @@ -1162,7 +1183,7 @@ to wrap around logic" (push connection *tcp-connections*)) (setf (tcp-connection-last-ack-time connection) (get-internal-run-time)) - (when (not *netmangler-force-local-retransmit*) + (unless *netmangler-force-local-retransmit* (tcp4-send-packet connection iss 0 nil :ack-p nil :syn-p t)) (arm-retransmit-timer connection) (arm-timeout-timer *tcp-connect-timeout* connection)) @@ -1194,7 +1215,7 @@ to wrap around logic" (append (tcp-connection-retransmit-queue connection) (list (list snd.nxt rcv.nxt data :psh-p psh-p)))) (arm-retransmit-timer connection) - (when (not *netmangler-force-local-retransmit*) + (unless *netmangler-force-local-retransmit* (tcp4-send-packet connection snd.nxt rcv.nxt data @@ -1330,7 +1351,7 @@ to wrap around logic" (defmethod gray:stream-read-byte ((stream tcp-octet-stream)) (with-tcp-connection-locked (tcp-stream-connection stream) (check-connection-error (tcp-stream-connection stream)) - (when (not (refill-tcp-packet-buffer stream)) + (unless (refill-tcp-packet-buffer stream) (return-from gray:stream-read-byte :eof)) (let* ((packet (tcp-stream-packet stream)) (byte (aref (first packet) (second packet)))) @@ -1343,7 +1364,7 @@ to wrap around logic" (with-tcp-connection-locked (tcp-stream-connection stream) (check-connection-error (tcp-stream-connection stream)) (refill-tcp-packet-buffer-no-hang stream) - (when (not (tcp-stream-packet stream)) + (unless (tcp-stream-packet stream) (return-from gray:stream-read-byte-no-hang (if (connection-may-have-additional-data-p (tcp-stream-connection stream)) nil @@ -1356,7 +1377,7 @@ to wrap around logic" byte))) (defmethod gray:stream-read-sequence ((stream tcp-octet-stream) sequence &optional (start 0) end) - (when (not end) + (unless end (setf end (length sequence))) (with-tcp-connection-locked (tcp-stream-connection stream) (check-connection-error (tcp-stream-connection stream)) @@ -1432,7 +1453,7 @@ to wrap around logic" :fin-p t :errors-escape t)))) (arm-retransmit-timer connection) - (when (not *netmangler-force-local-retransmit*) + (unless *netmangler-force-local-retransmit* (tcp4-send-packet connection (tcp-connection-snd.nxt connection) (tcp-connection-rcv.nxt connection) @@ -1451,7 +1472,7 @@ to wrap around logic" :fin-p t :errors-escape t)))) (arm-retransmit-timer connection) - (when (not *netmangler-force-local-retransmit*) + (unless *netmangler-force-local-retransmit* (tcp4-send-packet connection (tcp-connection-snd.nxt connection) (tcp-connection-rcv.nxt connection) @@ -1470,7 +1491,7 @@ to wrap around logic" :fin-p t :errors-escape t)))) (arm-retransmit-timer connection) - (when (not *netmangler-force-local-retransmit*) + (unless *netmangler-force-local-retransmit* (tcp4-send-packet connection (tcp-connection-snd.nxt connection) (tcp-connection-rcv.nxt connection) From e825280a3dd0cc36a6599298b16d7edb0e7be624 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Tue, 1 Jul 2025 08:16:48 +0200 Subject: [PATCH 53/65] tcp: Fix simultaneous close handling in :fin-wait-1 state --- net/tcp.lisp | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index e811f8cb3..690be39cb 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -915,14 +915,14 @@ to wrap around logic" (tcp-connection-rcv.nxt connection) (+u32 seq 1)) (tcp4-send-ack connection) (arm-timeout-timer (* 2 *msl*) connection)) - ((eql seq (tcp-connection-rcv.nxt connection)) - (setf (tcp-connection-state connection) :fin-wait-2)) ((and (logtest flags +tcp4-flag-fin+) (eql seq (tcp-connection-rcv.nxt connection))) ;; Simultaneous close (setf (tcp-connection-state connection) :closing (tcp-connection-rcv.nxt connection) (+u32 seq 1)) - (tcp4-send-ack connection)))))) + (tcp4-send-ack connection)) + ((eql seq (tcp-connection-rcv.nxt connection)) + (setf (tcp-connection-state connection) :fin-wait-2)))))) (:fin-wait-2 ;; Local closed, still waiting for remote to close. (cond ((not (acceptable-segment-p connection seq data-length)) From fdd77276c2f27427ba5ac7ed5233d14660d68918 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Tue, 15 Jul 2025 16:49:23 +0200 Subject: [PATCH 54/65] tcp: Rename max-seg-size to mss --- net/tcp.lisp | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index 690be39cb..e6e9f1f5b 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -55,8 +55,8 @@ ;;; Window and Segment Sizing (defparameter *initial-window-size* 8192 "Initial congestion window size in octets") -(defparameter *default-max-seg-size* 536 "Default maximum segment size in octets") -(defparameter *max-seg-size* 1460 "Maximum segment size in octets") +(defparameter *default-mss* 536 "Default maximum segment size in octets") +(defparameter *mss* 1460 "Maximum segment size in octets") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Debugging and testing parameters @@ -266,7 +266,7 @@ to wrap around logic" :initarg :rcv.nxt :type tcp-sequence-number) (%rcv.wnd :accessor tcp-connection-rcv.wnd :initarg :rcv.wnd) - (%max-seg-size :accessor tcp-connection-max-seg-size :initarg :max-seg-size) + (%mss :accessor tcp-connection-mss :initarg :mss) (%rx-data :accessor tcp-connection-rx-data :initform '()) ;; Doesn't need to be synchronized, only accessed from the network serial queue. (%rx-data-unordered :reader tcp-connection-rx-data-unordered @@ -288,7 +288,7 @@ to wrap around logic" (%boot-id :reader tcp-connection-boot-id :initarg :boot-id)) (:default-initargs - :max-seg-size *default-max-seg-size* + :mss *default-mss* :max.snd.wnd 0 :last-ack-time nil :srtt nil @@ -594,7 +594,7 @@ to wrap around logic" (when (= kind +tcp-option-mss+) (when (= length +tcp-option-mss-length+) (let ((mss (ub16ref/be packet (+ offset 2)))) - (setf (tcp-connection-max-seg-size connection) mss)))) + (setf (tcp-connection-mss connection) mss)))) (incf offset length)))))))) (defun acceptable-segment-p (connection seg.seq seg.len) @@ -1087,7 +1087,7 @@ to wrap around logic" (when syn-p (setf (aref header +tcp4-header-options+) 2 (aref header (+ 1 +tcp4-header-options+)) 4 - (ub16ref/be header (+ 2 +tcp4-header-options+)) *max-seg-size*)) + (ub16ref/be header (+ 2 +tcp4-header-options+)) *mss*)) ;; Compute the final checksum. (setf checksum (compute-ip-pseudo-header-partial-checksum (mezzano.network.ip::ipv4-address-address src-ip) @@ -1239,7 +1239,7 @@ to wrap around logic" (unless (tcp-connection-last-ack-time connection) (setf (tcp-connection-last-ack-time connection) (get-internal-run-time))) - (let ((mss (tcp-connection-max-seg-size connection))) + (let ((mss (tcp-connection-mss connection))) (cond ((>= start end)) ((> (- end start) mss) ;; Send multiple packets. From 0f947cd12669da48d2173574f335ef9d294738ee Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Tue, 15 Jul 2025 16:55:24 +0200 Subject: [PATCH 55/65] tcp: Use MTU to calculate MSS --- net/tcp.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index e6e9f1f5b..c4c00476b 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -56,7 +56,7 @@ ;;; Window and Segment Sizing (defparameter *initial-window-size* 8192 "Initial congestion window size in octets") (defparameter *default-mss* 536 "Default maximum segment size in octets") -(defparameter *mss* 1460 "Maximum segment size in octets") +(defparameter *mss* (- (mezzano.driver.network-card:mtu (first (mezzano.sync:watchable-set-items mezzano.driver.network-card::*nics*))) 40) "Maximum segment size in octets") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Debugging and testing parameters From 16081bfdab344c569ed3995009e07c602c1926ee Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Tue, 15 Jul 2025 17:31:11 +0200 Subject: [PATCH 56/65] tcp: Rename MSS parameters to clarify sender/receiver roles --- net/tcp.lisp | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index c4c00476b..730a1eba0 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -55,8 +55,8 @@ ;;; Window and Segment Sizing (defparameter *initial-window-size* 8192 "Initial congestion window size in octets") -(defparameter *default-mss* 536 "Default maximum segment size in octets") -(defparameter *mss* (- (mezzano.driver.network-card:mtu (first (mezzano.sync:watchable-set-items mezzano.driver.network-card::*nics*))) 40) "Maximum segment size in octets") +(defparameter *default-snd.mss* 536 "Default maximum segment size in octets") +(defparameter *rcv.mss* (- (mezzano.driver.network-card:mtu (first (mezzano.sync:watchable-set-items mezzano.driver.network-card::*nics*))) 40) "Maximum segment size in octets") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Debugging and testing parameters @@ -266,7 +266,7 @@ to wrap around logic" :initarg :rcv.nxt :type tcp-sequence-number) (%rcv.wnd :accessor tcp-connection-rcv.wnd :initarg :rcv.wnd) - (%mss :accessor tcp-connection-mss :initarg :mss) + (%snd.mss :accessor tcp-connection-snd.mss :initarg :snd.mss) (%rx-data :accessor tcp-connection-rx-data :initform '()) ;; Doesn't need to be synchronized, only accessed from the network serial queue. (%rx-data-unordered :reader tcp-connection-rx-data-unordered @@ -288,7 +288,7 @@ to wrap around logic" (%boot-id :reader tcp-connection-boot-id :initarg :boot-id)) (:default-initargs - :mss *default-mss* + :snd.mss *default-snd.mss* :max.snd.wnd 0 :last-ack-time nil :srtt nil @@ -593,8 +593,8 @@ to wrap around logic" (return)) (when (= kind +tcp-option-mss+) (when (= length +tcp-option-mss-length+) - (let ((mss (ub16ref/be packet (+ offset 2)))) - (setf (tcp-connection-mss connection) mss)))) + (let ((snd.mss (ub16ref/be packet (+ offset 2)))) + (setf (tcp-connection-snd.mss connection) snd.mss)))) (incf offset length)))))))) (defun acceptable-segment-p (connection seg.seq seg.len) @@ -1087,7 +1087,7 @@ to wrap around logic" (when syn-p (setf (aref header +tcp4-header-options+) 2 (aref header (+ 1 +tcp4-header-options+)) 4 - (ub16ref/be header (+ 2 +tcp4-header-options+)) *mss*)) + (ub16ref/be header (+ 2 +tcp4-header-options+)) *rcv.mss*)) ;; Compute the final checksum. (setf checksum (compute-ip-pseudo-header-partial-checksum (mezzano.network.ip::ipv4-address-address src-ip) @@ -1239,13 +1239,13 @@ to wrap around logic" (unless (tcp-connection-last-ack-time connection) (setf (tcp-connection-last-ack-time connection) (get-internal-run-time))) - (let ((mss (tcp-connection-mss connection))) + (let ((snd.mss (tcp-connection-snd.mss connection))) (cond ((>= start end)) - ((> (- end start) mss) + ((> (- end start) snd.mss) ;; Send multiple packets. - (loop :for offset :from start :by mss - :while (> (- end offset) mss) - :do (tcp-send-1 connection data offset (+ offset mss)) + (loop :for offset :from start :by snd.mss + :while (> (- end offset) snd.mss) + :do (tcp-send-1 connection data offset (+ offset snd.mss)) :finally (tcp-send-1 connection data offset end :psh-p t))) (t ;; Send one packet. From 53d7c1b2f56b6cfbb3b1478b1922a97a12dca78f Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Mon, 6 Oct 2025 00:11:25 +0200 Subject: [PATCH 57/65] tcp: Refactor and add documentation --- net/tcp.lisp | 333 ++++++++++++++++++++++++--------------------------- 1 file changed, 154 insertions(+), 179 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index 730a1eba0..7c5787991 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -56,6 +56,7 @@ ;;; Window and Segment Sizing (defparameter *initial-window-size* 8192 "Initial congestion window size in octets") (defparameter *default-snd.mss* 536 "Default maximum segment size in octets") +;; TODO: Make it less hacky (defparameter *rcv.mss* (- (mezzano.driver.network-card:mtu (first (mezzano.sync:watchable-set-items mezzano.driver.network-card::*nics*))) 40) "Maximum segment size in octets") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -69,14 +70,9 @@ Set to a value near 2^32 to test SND sequence number wrapping.") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; Connection state management +;;; Type Definitions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(defvar *tcp-connections* nil "List of active TCP connections") -(defvar *tcp-connection-lock* (mezzano.supervisor:make-mutex "TCP connection list")) -(defvar *tcp-listeners* nil "List of active TCP listeners") -(defvar *tcp-listener-lock* (mezzano.supervisor:make-mutex "TCP listener list")) - (deftype tcp-connection-state () "Possible states that a TCP connection can have." '(member @@ -97,46 +93,52 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (deftype tcp-sequence-number () '(unsigned-byte 32)) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Sequence Number Arithmetic +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (defun +u32 (x y) + "X + Y modulo 2^32 arithmetic" (ldb (byte 32 0) (+ x y))) (defun -u32 (x y) + "X - Y modulo 2^32 arithmetic" (ldb (byte 32 0) (- x y))) (defun x y) - (> (- x y) - (ash 1 31))))) + (> (- x y) (ash 1 31))))) (defun >u32 (x y) - "Bigger wrapped y number may actually be considered smaller than x due -to wrap around logic" + "X > Y modulo 2^32 arithmetic" (=u32 (x y) - "Bigger wrapped y number may actually be considered smaller than x due -to wrap around logic" + "X >= Y modulo 2^32 arithmetic" (<=u32 y x)) (defun =< (a b c) - "a <= b <= c" + "a <= b <= c modulo 2^32 arithmetic" (if (< a c) (<= a b c) - ;; Sequence numbers wrapped. (or (<= a b) (<= b c)))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; TCP Listener +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar *tcp-listeners* nil "List of active TCP listeners") +(defvar *tcp-listener-lock* (mezzano.supervisor:make-mutex "TCP listener list")) + ;; FIXME: Inbound connections need to timeout if state :syn-received don't change. ;; TODO: Better locking on this is probably needed. It looks like it is accesed ;; from the network serial queue and from user threads. @@ -158,7 +160,10 @@ to wrap around logic" :type integer) (backlog :reader tcp-listener-backlog :initarg :backlog)) - (:default-initargs :n-pending-connections 0)) + (:default-initargs + :pending-connections (make-hash-table :test 'equalp :synchronized t) + :connections (mezzano.sync:make-mailbox :name "TCP Listener") + :n-pending-connections 0)) (defmethod mezzano.sync:get-object-event ((object tcp-listener)) (mezzano.sync:get-object-event (tcp-listener-connections object))) @@ -186,6 +191,16 @@ to wrap around logic" (mezzano.supervisor:with-mutex (*tcp-listener-lock*) (get-tcp-listener-without-lock local-ip local-port))) +(defun find-available-port (port-check) + (loop :for port := (+ (random 32768) 32768) + :unless (funcall port-check port) + :do (return port))) + +(defun allocate-listener-local-port (source-address) + (find-available-port + #'(lambda (local-port) + (get-tcp-listener-without-lock source-address local-port)))) + (defun tcp-listen (local-host local-port &key backlog) (let* ((local-ip (mezzano.network:resolve-address local-host)) (source-address (if (mezzano.network.ip:address-equal local-ip +ip-wildcard+) @@ -194,18 +209,11 @@ to wrap around logic" (nth-value 1 (mezzano.network.ip:ipv4-route local-ip)))))) (mezzano.supervisor:with-mutex (*tcp-listener-lock*) (let* ((local-port (cond ((eql local-port +port-wildcard+) - ;; find a suitable port number - (loop :for local-port := (+ (random 32768) 32768) - :unless (get-tcp-listener-without-lock source-address local-port) - :do (return local-port))) + (allocate-listener-local-port source-address)) ((get-tcp-listener-without-lock source-address local-port) (error "Server already listening on port ~D" local-port)) - (t - local-port))) + (t local-port))) (listener (make-instance 'tcp-listener - :pending-connections (make-hash-table :test 'equalp :synchronized t) - :connections (mezzano.sync:make-mailbox - :name "TCP Listener") :backlog backlog :local-port local-port :local-ip source-address))) @@ -216,12 +224,12 @@ to wrap around logic" (let ((connection (mezzano.sync:mailbox-receive (tcp-listener-connections listener) :wait-p wait-p))) - (cond (connection - (when (tcp-listener-backlog listener) - (decf (tcp-listener-n-pending-connections listener))) - (tcp4-accept-connection connection :element-type element-type :external-format external-format)) - (t - nil)))) + (when connection + (when (tcp-listener-backlog listener) + (decf (tcp-listener-n-pending-connections listener))) + (tcp4-accept-connection connection + :element-type element-type + :external-format external-format)))) (defun close-tcp-listener (listener) (mezzano.supervisor:with-mutex (*tcp-listener-lock*) @@ -233,10 +241,18 @@ to wrap around logic" :do (with-tcp-connection-locked connection (abort-connection connection)))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; TCP Connection +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defvar *tcp-connections* nil "List of active TCP connections") +(defvar *tcp-connection-lock* (mezzano.supervisor:make-mutex "TCP connection list")) + (defclass tcp-connection () ((%state :accessor tcp-connection-state :initarg :state :type tcp-connection-state) + ;; Addressing (%local-port :reader tcp-connection-local-port :initarg :local-port :type tcp-port-number) @@ -249,6 +265,7 @@ to wrap around logic" (%remote-ip :reader tcp-connection-remote-ip :initarg :remote-ip :type mezzano.network.ip::ipv4-address) + ;; Send sequence space (%snd.nxt :accessor tcp-connection-snd.nxt :initarg :snd.nxt :type tcp-sequence-number) @@ -258,44 +275,59 @@ to wrap around logic" :initarg :snd.wnd) (%max.snd.wnd :accessor tcp-connection-max.snd.wnd :initarg :max.snd.wnd) + ;; Receive sequence space + (%rcv.nxt :accessor tcp-connection-rcv.nxt + :initarg :rcv.nxt + :type tcp-sequence-number) + (%rcv.wnd :accessor tcp-connection-rcv.wnd + :initarg :rcv.wnd) + ;; Flow control and options + (%snd.mss :accessor tcp-connection-snd.mss + :initarg :snd.mss) (%snd.wl1 :accessor tcp-connection-snd.wl1 :initarg :snd.wl1) (%snd.wl2 :accessor tcp-connection-snd.wl2 :initarg :snd.wl2) - (%rcv.nxt :accessor tcp-connection-rcv.nxt - :initarg :rcv.nxt - :type tcp-sequence-number) - (%rcv.wnd :accessor tcp-connection-rcv.wnd :initarg :rcv.wnd) - (%snd.mss :accessor tcp-connection-snd.mss :initarg :snd.mss) - (%rx-data :accessor tcp-connection-rx-data :initform '()) + ;; Data buffers + (%rx-data :accessor tcp-connection-rx-data + :initform '()) ;; Doesn't need to be synchronized, only accessed from the network serial queue. (%rx-data-unordered :reader tcp-connection-rx-data-unordered :initform (make-hash-table)) - (%last-ack-time :accessor tcp-connection-last-ack-time :initarg :last-ack-time) - (%srtt :accessor tcp-connection-srtt :initarg :srtt) - (%rttvar :accessor tcp-connection-rttvar :initarg :rttvar) - (%rto :accessor tcp-connection-rto :initarg :rto) - (%retransmit-queue :accessor tcp-connection-retransmit-queue :initform '()) + ;; Retransmission + (%retransmit-queue :accessor tcp-connection-retransmit-queue + :initform '()) + (%retransmit-timer :reader tcp-connection-retransmit-timer) + (%retransmit-source :reader tcp-connection-retransmit-source) + (%rto :accessor tcp-connection-rto + :initarg :rto) + ;; RTT estimation + (%srtt :accessor tcp-connection-srtt + :initarg :srtt) + (%rttvar :accessor tcp-connection-rttvar + :initarg :rttvar) + (%last-ack-time :accessor tcp-connection-last-ack-time + :initarg :last-ack-time) + ;; Connection management (%lock :reader tcp-connection-lock) (%cvar :reader tcp-connection-cvar) (%receive-event :reader tcp-connection-receive-event) - (%pending-error :accessor tcp-connection-pending-error :initform nil) - (%retransmit-timer :reader tcp-connection-retransmit-timer) - (%retransmit-source :reader tcp-connection-retransmit-source) + (%pending-error :accessor tcp-connection-pending-error + :initform nil) (%timeout-timer :reader tcp-connection-timeout-timer) (%timeout-source :reader tcp-connection-timeout-source) (%timeout :initarg :timeout :reader tcp-connection-timeout) (%boot-id :reader tcp-connection-boot-id :initarg :boot-id)) (:default-initargs - :snd.mss *default-snd.mss* :max.snd.wnd 0 - :last-ack-time nil + :snd.mss *default-snd.mss* + :rto *tcp-initial-retransmit-time* :srtt nil :rttvar nil - :rto *tcp-initial-retransmit-time* - :boot-id nil - :timeout nil)) + :last-ack-time nil + :timeout nil + :boot-id nil)) (defun (setf tcp-connection-timeout) (timeout connection) (with-tcp-connection-locked connection @@ -320,7 +352,7 @@ to wrap around logic" (return-from retransmit-timer-handler)) (mezzano.supervisor:with-mutex ((tcp-connection-lock connection)) ;; Disarm it so it stops triggering the source - (mezzano.supervisor:timer-disarm (tcp-connection-retransmit-timer connection)) + (disarm-retransmit-timer connection) ;; What're we retransmitting? (ecase (tcp-connection-state connection) (:syn-sent @@ -328,27 +360,20 @@ to wrap around logic" (tcp4-send-packet connection seq 0 nil :ack-p nil :syn-p t) (arm-retransmit-timer connection))) (:syn-received - (let* ((iss (tcp-connection-snd.una connection)) - (irs (tcp-connection-rcv.nxt connection))) + (let ((iss (tcp-connection-snd.una connection)) + (irs (tcp-connection-rcv.nxt connection))) (tcp4-send-packet connection iss irs nil :syn-p t) (arm-retransmit-timer connection))) - ((:established - :close-wait - :last-ack - :fin-wait-1 - :fin-wait-2 - :closing - :time-wait) + ((:established :close-wait :last-ack :fin-wait-1 :fin-wait-2 :closing :time-wait) (let ((packet (first (tcp-connection-retransmit-queue connection)))) (apply #'tcp4-send-packet connection packet) (setf (tcp-connection-rto connection) (min *maximum-rto* (* 2 (tcp-connection-rto connection)))) (arm-retransmit-timer connection))) - (:closed)))) + (:closed nil)))) (defun arm-timeout-timer (seconds connection) - (mezzano.supervisor:timer-arm seconds - (tcp-connection-timeout-timer connection)) + (mezzano.supervisor:timer-arm seconds (tcp-connection-timeout-timer connection)) (values)) (defun disarm-timeout-timer (connection) @@ -364,11 +389,8 @@ to wrap around logic" (return-from timeout-timer-handler)) (mezzano.supervisor:with-mutex ((tcp-connection-lock connection)) ;; Disarm it so it stops triggering the source - (mezzano.supervisor:timer-disarm (tcp-connection-timeout-timer connection)) - (setf (tcp-connection-pending-error connection) - (make-condition 'connection-timed-out - :host (tcp-connection-remote-ip connection) - :port (tcp-connection-remote-port connection))) + (disarm-timeout-timer connection) + (set-connection-error 'connection-timed-out connection) (mezzano.supervisor:condition-notify (tcp-connection-cvar connection) t) (case (tcp-connection-state connection) ((:syn-sent :syn-received :time-wait) @@ -505,8 +527,8 @@ to wrap around logic" ;; 1) It stops the timer from hanging around if it was active. ;; 2) If the source handler is pending, then it'll return immediately. (setf (tcp-connection-state connection) :closed) - (mezzano.supervisor:timer-disarm (tcp-connection-retransmit-timer connection)) - (mezzano.supervisor:timer-disarm (tcp-connection-timeout-timer connection)) + (disarm-retransmit-timer connection) + (disarm-timeout-timer connection) (mezzano.sync.dispatch:cancel (tcp-connection-retransmit-source connection)) (mezzano.sync.dispatch:cancel (tcp-connection-timeout-source connection)) (mezzano.supervisor:with-mutex (*tcp-connection-lock*) @@ -523,15 +545,15 @@ to wrap around logic" "Try to find any out-of-order data in CONNECTION that is now in-order." ;; Check if the next packet is in tcp-connection-rx-data-unordered (loop - :for (packet start end data-length) - := (gethash (tcp-connection-rcv.nxt connection) - (tcp-connection-rx-data-unordered connection)) - :always packet - :do (remhash (tcp-connection-rcv.nxt connection) + :for (packet start end data-length) + := (gethash (tcp-connection-rcv.nxt connection) (tcp-connection-rx-data-unordered connection)) - :do (append-data-packet connection (list packet start end)) - :do (setf (tcp-connection-rcv.nxt connection) - (+u32 (tcp-connection-rcv.nxt connection) data-length)))) + :always packet + :do (remhash (tcp-connection-rcv.nxt connection) + (tcp-connection-rx-data-unordered connection)) + :do (append-data-packet connection (list packet start end)) + :do (setf (tcp-connection-rcv.nxt connection) + (+u32 (tcp-connection-rcv.nxt connection) data-length)))) (defun tcp4-receive-data (connection data-length end header-length packet seq start) (cond ((= seq (tcp-connection-rcv.nxt connection)) @@ -715,10 +737,7 @@ to wrap around logic" (:syn-sent (cond ((logtest flags +tcp4-flag-rst+) (when (acceptable-ack-p connection ack) - (setf (tcp-connection-pending-error connection) - (make-condition 'connection-reset - :host (tcp-connection-remote-ip connection) - :port (tcp-connection-remote-port connection))) + (set-connection-error 'connection-reset connection) (detach-tcp-connection connection))) ((and (logtest flags +tcp4-flag-ack+) (not (acceptable-ack-p connection ack))) @@ -764,10 +783,7 @@ to wrap around logic" (detach-tcp-connection connection)) (t ;; Connection comes from active OPEN - (setf (tcp-connection-pending-error connection) - (make-condition 'connection-refused - :host (tcp-connection-remote-ip connection) - :port (tcp-connection-remote-port connection))) + (set-connection-error 'connection-refused connection) (detach-tcp-connection connection)))) ((logtest flags +tcp4-flag-syn+) (cond ((and listener @@ -810,10 +826,7 @@ to wrap around logic" (tcp4-send-ack connection))) ((logtest flags +tcp4-flag-rst+) (cond ((eql seq (tcp-connection-rcv.nxt connection)) - (setf (tcp-connection-pending-error connection) - (make-condition 'connection-reset - :host (tcp-connection-remote-ip connection) - :port (tcp-connection-remote-port connection))) + (set-connection-error 'connection-reset connection) (detach-tcp-connection connection)) (t (challenge-ack connection)))) @@ -842,10 +855,7 @@ to wrap around logic" (tcp4-send-ack connection))) ((logtest flags +tcp4-flag-rst+) (cond ((eql seq (tcp-connection-rcv.nxt connection)) - (setf (tcp-connection-pending-error connection) - (make-condition 'connection-reset - :host (tcp-connection-remote-ip connection) - :port (tcp-connection-remote-port connection))) + (set-connection-error 'connection-reset connection) (detach-tcp-connection connection)) (t (challenge-ack connection)))) @@ -890,10 +900,7 @@ to wrap around logic" (tcp4-send-ack connection))) ((logtest flags +tcp4-flag-rst+) (cond ((eql seq (tcp-connection-rcv.nxt connection)) - (setf (tcp-connection-pending-error connection) - (make-condition 'connection-reset - :host (tcp-connection-remote-ip connection) - :port (tcp-connection-remote-port connection))) + (set-connection-error 'connection-reset connection) (detach-tcp-connection connection)) (t (challenge-ack connection)))) @@ -930,10 +937,7 @@ to wrap around logic" (tcp4-send-ack connection))) ((logtest flags +tcp4-flag-rst+) (cond ((eql seq (tcp-connection-rcv.nxt connection)) - (setf (tcp-connection-pending-error connection) - (make-condition 'connection-reset - :host (tcp-connection-remote-ip connection) - :port (tcp-connection-remote-port connection))) + (set-connection-error 'connection-reset connection) (detach-tcp-connection connection)) (t (challenge-ack connection)))) @@ -1101,10 +1105,10 @@ to wrap around logic" (setf (ub16ref/be header +tcp4-header-checksum+) checksum) packet)) -(defun allocate-local-tcp-port (local-ip ip port) - (loop :for local-port := (+ (random 32768) 32768) - :do (unless (get-tcp-connection ip port local-ip local-port) - (return local-port)))) +(defun allocate-connection-local-port (local-ip ip port) + (find-available-port + #'(lambda (local-port) + (get-tcp-connection ip port local-ip local-port)))) (define-condition connection-error (net:network-error) ((host :initarg :host :reader connection-error-host) @@ -1131,6 +1135,13 @@ to wrap around logic" (define-condition connection-stale (connection-error) ()) +(defun set-connection-error (condition-type connection) + "Set a pending error condition on the TCP connection." + (setf (tcp-connection-pending-error connection) + (make-condition condition-type + :host (tcp-connection-remote-ip connection) + :port (tcp-connection-remote-port connection)))) + (defun flush-stale-connections () ;; Called with snapshot inhibited to prevent more connections becoming stale. ;; Lock ordering note: @@ -1147,10 +1158,7 @@ to wrap around logic" collect connection)))) (dolist (connection stale-connections) (mezzano.supervisor:with-mutex ((tcp-connection-lock connection)) - (setf (tcp-connection-pending-error connection) - (make-condition 'connection-stale - :host (tcp-connection-remote-ip connection) - :port (tcp-connection-remote-port connection))) + (set-connection-error 'connection-stale connection) (mezzano.supervisor:condition-notify (tcp-connection-cvar connection) t) (detach-tcp-connection connection))))) @@ -1162,7 +1170,7 @@ to wrap around logic" (defun tcp-connect (ip port &key persist timeout) (let* ((interface (nth-value 1 (mezzano.network.ip:ipv4-route ip))) (source-address (mezzano.network.ip:ipv4-interface-address interface)) - (source-port (allocate-local-tcp-port source-address ip port)) + (source-port (allocate-connection-local-port source-address ip port)) (iss (or *netmangler-iss* (random #x100000000))) (connection (make-instance 'tcp-connection @@ -1259,6 +1267,10 @@ to wrap around logic" :host (tcp-connection-remote-ip connection) :port (tcp-connection-remote-port connection)))))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; TCP Stream +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + (defclass tcp-octet-stream (gray:fundamental-binary-input-stream gray:fundamental-binary-output-stream) ((connection :initarg :connection :reader tcp-stream-connection) @@ -1411,15 +1423,9 @@ to wrap around logic" (defun abort-connection (connection) (ecase (tcp-connection-state connection) (:syn-sent - (setf (tcp-connection-pending-error connection) - (make-condition 'connection-reset - :host (tcp-connection-remote-ip connection) - :port (tcp-connection-remote-port connection)))) + (set-connection-error 'connection-reset connection)) ((:syn-received :established :fin-wait-1 :fin-wait-2 :close-wait) - (setf (tcp-connection-pending-error connection) - (make-condition 'connection-reset - :host (tcp-connection-remote-ip connection) - :port (tcp-connection-remote-port connection))) + (set-connection-error 'connection-reset connection) (tcp4-send-packet connection (tcp-connection-snd.nxt connection) (tcp-connection-rcv.nxt connection) @@ -1434,72 +1440,41 @@ to wrap around logic" (mezzano.supervisor:condition-notify (tcp-connection-cvar connection) t) (detach-tcp-connection connection)) +(defun tcp4-send-fin (connection) + "Queue and send a FIN packet." + (let ((packet (list (tcp-connection-snd.nxt connection) + (tcp-connection-rcv.nxt connection) + nil + :fin-p t + :errors-escape t))) + (setf (tcp-connection-retransmit-queue connection) + (append (tcp-connection-retransmit-queue connection) (list packet)))) + (arm-retransmit-timer connection) + (unless *netmangler-force-local-retransmit* + (tcp4-send-packet connection + (tcp-connection-snd.nxt connection) + (tcp-connection-rcv.nxt connection) + nil + :fin-p t + :errors-escape t)) + (setf (tcp-connection-snd.nxt connection) + (+u32 (tcp-connection-snd.nxt connection) 1))) + (defun close-connection (connection) (ecase (tcp-connection-state connection) (:syn-sent - (setf (tcp-connection-pending-error connection) - (make-condition 'connection-closing - :host (tcp-connection-remote-ip connection) - :port (tcp-connection-remote-port connection))) + (set-connection-error 'connection-closing connection) (detach-tcp-connection connection)) (:syn-received ;; TODO: If there is data to send queue for processing after entering ESTABLISHED state. (setf (tcp-connection-state connection) :fin-wait-1) - (setf (tcp-connection-retransmit-queue connection) - (append (tcp-connection-retransmit-queue connection) - (list (list (tcp-connection-snd.nxt connection) - (tcp-connection-rcv.nxt connection) - nil - :fin-p t - :errors-escape t)))) - (arm-retransmit-timer connection) - (unless *netmangler-force-local-retransmit* - (tcp4-send-packet connection - (tcp-connection-snd.nxt connection) - (tcp-connection-rcv.nxt connection) - nil - :fin-p t - :errors-escape t)) - (setf (tcp-connection-snd.nxt connection) - (+u32 (tcp-connection-snd.nxt connection) 1))) + (tcp4-send-fin connection)) (:established (setf (tcp-connection-state connection) :fin-wait-1) - (setf (tcp-connection-retransmit-queue connection) - (append (tcp-connection-retransmit-queue connection) - (list (list (tcp-connection-snd.nxt connection) - (tcp-connection-rcv.nxt connection) - nil - :fin-p t - :errors-escape t)))) - (arm-retransmit-timer connection) - (unless *netmangler-force-local-retransmit* - (tcp4-send-packet connection - (tcp-connection-snd.nxt connection) - (tcp-connection-rcv.nxt connection) - nil - :fin-p t - :errors-escape t)) - (setf (tcp-connection-snd.nxt connection) - (+u32 (tcp-connection-snd.nxt connection) 1))) + (tcp4-send-fin connection)) (:close-wait (setf (tcp-connection-state connection) :last-ack) - (setf (tcp-connection-retransmit-queue connection) - (append (tcp-connection-retransmit-queue connection) - (list (list (tcp-connection-snd.nxt connection) - (tcp-connection-rcv.nxt connection) - nil - :fin-p t - :errors-escape t)))) - (arm-retransmit-timer connection) - (unless *netmangler-force-local-retransmit* - (tcp4-send-packet connection - (tcp-connection-snd.nxt connection) - (tcp-connection-rcv.nxt connection) - nil - :fin-p t - :errors-escape t)) - (setf (tcp-connection-snd.nxt connection) - (+u32 (tcp-connection-snd.nxt connection) 1))) + (tcp4-send-fin connection)) ((:last-ack :fin-wait-1 :fin-wait-2 :closing :time-wait :closed)))) (defmethod close ((stream tcp-octet-stream) &key abort) From ce491c8eea91e59cce68e6708b24d417fb517f12 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Tue, 7 Oct 2025 03:13:26 +0200 Subject: [PATCH 58/65] tcp: Add missing rfc5961 mitigation in state :syn-sent --- net/tcp.lisp | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index 7c5787991..85c4d12fd 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -736,7 +736,8 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (ecase (tcp-connection-state connection) (:syn-sent (cond ((logtest flags +tcp4-flag-rst+) - (when (acceptable-ack-p connection ack) + (when (and (acceptable-ack-p connection ack) + (eql seq (tcp-connection-rcv.nxt connection))) (set-connection-error 'connection-reset connection) (detach-tcp-connection connection))) ((and (logtest flags +tcp4-flag-ack+) From c846c94f346688edd22a3b73b9f2bd45a38682f4 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Tue, 7 Oct 2025 04:03:56 +0200 Subject: [PATCH 59/65] tcp: Use challenge-ack in places where ACKs are defensive --- net/tcp.lisp | 42 +++++++++++++++++++++--------------------- 1 file changed, 21 insertions(+), 21 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index 85c4d12fd..c64e9a8c5 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -772,7 +772,7 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (:syn-received (cond ((not (acceptable-segment-p connection seq data-length)) (unless (logtest flags +tcp4-flag-rst+) - (tcp4-send-ack connection))) + (challenge-ack connection))) ((logtest flags +tcp4-flag-rst+) (cond ((not (eql seq (tcp-connection-rcv.nxt connection))) (challenge-ack connection)) @@ -797,7 +797,7 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (challenge-ack connection)))) ((not (logtest flags +tcp4-flag-ack+))) ; Ignore packets without ACK set. ((not (rfc5961-mitigation-check-p connection ack)) - (tcp4-send-ack connection)) + (challenge-ack connection)) (t (cond ((acceptable-ack-p connection ack) ;; Pasive open @@ -824,7 +824,7 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (:established (cond ((not (acceptable-segment-p connection seq data-length)) (unless (logtest flags +tcp4-flag-rst+) - (tcp4-send-ack connection))) + (challenge-ack connection))) ((logtest flags +tcp4-flag-rst+) (cond ((eql seq (tcp-connection-rcv.nxt connection)) (set-connection-error 'connection-reset connection) @@ -835,10 +835,10 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (challenge-ack connection)) ((not (logtest flags +tcp4-flag-ack+))) ; Ignore packets without ACK set. ((not (rfc5961-mitigation-check-p connection ack)) - (tcp4-send-ack connection)) + (challenge-ack connection)) ((>u32 ack (tcp-connection-snd.nxt connection)) ;; Remote acks something not yet sent - (tcp4-send-ack connection)) + (challenge-ack connection)) (t (when-acceptable-ack-p connection ack seq wnd) (unless (zerop data-length) @@ -853,7 +853,7 @@ Set to a value near 2^32 to test SND sequence number wrapping.") ;; Remote has closed, local can still send data. (cond ((not (acceptable-segment-p connection seq data-length)) (unless (logtest flags +tcp4-flag-rst+) - (tcp4-send-ack connection))) + (challenge-ack connection))) ((logtest flags +tcp4-flag-rst+) (cond ((eql seq (tcp-connection-rcv.nxt connection)) (set-connection-error 'connection-reset connection) @@ -864,10 +864,10 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (challenge-ack connection)) ((not (logtest flags +tcp4-flag-ack+))) ; Ignore packets without ACK set. ((not (rfc5961-mitigation-check-p connection ack)) - (tcp4-send-ack connection)) + (challenge-ack connection)) ((>u32 ack (tcp-connection-snd.nxt connection)) ;; Remote acks something not yet sent - (tcp4-send-ack connection)) + (challenge-ack connection)) (t (when-acceptable-ack-p connection ack seq wnd) (when (and (logtest flags +tcp4-flag-fin+) @@ -877,7 +877,7 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (:last-ack (cond ((not (acceptable-segment-p connection seq data-length)) (unless (logtest flags +tcp4-flag-rst+) - (tcp4-send-ack connection))) + (challenge-ack connection))) ((logtest flags +tcp4-flag-rst+) (if (eql seq (tcp-connection-rcv.nxt connection)) (detach-tcp-connection connection) @@ -886,7 +886,7 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (challenge-ack connection)) ((not (logtest flags +tcp4-flag-ack+))) ; Ignore packets without ACK set. ((not (rfc5961-mitigation-check-p connection ack)) - (tcp4-send-ack connection)) + (challenge-ack connection)) (t (when (eql ack (tcp-connection-snd.nxt connection)) (detach-tcp-connection connection)) @@ -898,7 +898,7 @@ Set to a value near 2^32 to test SND sequence number wrapping.") ;; Local closed, waiting for remote to close. (cond ((not (acceptable-segment-p connection seq data-length)) (unless (logtest flags +tcp4-flag-rst+) - (tcp4-send-ack connection))) + (challenge-ack connection))) ((logtest flags +tcp4-flag-rst+) (cond ((eql seq (tcp-connection-rcv.nxt connection)) (set-connection-error 'connection-reset connection) @@ -909,10 +909,10 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (challenge-ack connection)) ((not (logtest flags +tcp4-flag-ack+))) ; Ignore packets without ACK set. ((not (rfc5961-mitigation-check-p connection ack)) - (tcp4-send-ack connection)) + (challenge-ack connection)) ((>u32 ack (tcp-connection-snd.nxt connection)) ;; Remote acks something not yet sent - (tcp4-send-ack connection)) + (challenge-ack connection)) (t (when-acceptable-ack-p connection ack seq wnd) (unless (zerop data-length) @@ -935,7 +935,7 @@ Set to a value near 2^32 to test SND sequence number wrapping.") ;; Local closed, still waiting for remote to close. (cond ((not (acceptable-segment-p connection seq data-length)) (unless (logtest flags +tcp4-flag-rst+) - (tcp4-send-ack connection))) + (challenge-ack connection))) ((logtest flags +tcp4-flag-rst+) (cond ((eql seq (tcp-connection-rcv.nxt connection)) (set-connection-error 'connection-reset connection) @@ -946,10 +946,10 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (challenge-ack connection)) ((not (logtest flags +tcp4-flag-ack+))) ; Ignore packets without ACK set. ((not (rfc5961-mitigation-check-p connection ack)) - (tcp4-send-ack connection)) + (challenge-ack connection)) ((>u32 ack (tcp-connection-snd.nxt connection)) ;; Remote acks something not yet sent - (tcp4-send-ack connection)) + (challenge-ack connection)) (t (when-acceptable-ack-p connection ack seq wnd) (unless (zerop data-length) @@ -964,7 +964,7 @@ Set to a value near 2^32 to test SND sequence number wrapping.") ;; Waiting for ACK (cond ((not (acceptable-segment-p connection seq data-length)) (unless (logtest flags +tcp4-flag-rst+) - (tcp4-send-ack connection))) + (challenge-ack connection))) ((logtest flags +tcp4-flag-rst+) (if (eql seq (tcp-connection-rcv.nxt connection)) (detach-tcp-connection connection) @@ -973,10 +973,10 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (challenge-ack connection)) ((not (logtest flags +tcp4-flag-ack+))) ; Ignore packets without ACK set. ((not (rfc5961-mitigation-check-p connection ack)) - (tcp4-send-ack connection)) + (challenge-ack connection)) ((>u32 ack (tcp-connection-snd.nxt connection)) ;; Remote acks something not yet sent - (tcp4-send-ack connection)) + (challenge-ack connection)) (t (when-acceptable-ack-p connection ack seq wnd) (when (eql seq (tcp-connection-rcv.nxt connection)) @@ -990,7 +990,7 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (:time-wait (cond ((not (acceptable-segment-p connection seq data-length)) (unless (logtest flags +tcp4-flag-rst+) - (tcp4-send-ack connection))) + (challenge-ack connection))) ((logtest flags +tcp4-flag-rst+) (if (eql seq (tcp-connection-rcv.nxt connection)) (detach-tcp-connection connection) @@ -999,7 +999,7 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (challenge-ack connection)) ((not (logtest flags +tcp4-flag-ack+))) ; Ignore packets without ACK set. ((not (rfc5961-mitigation-check-p connection ack)) - (tcp4-send-ack connection)) + (challenge-ack connection)) ((and (logtest flags +tcp4-flag-fin+) (eql seq (tcp-connection-rcv.nxt connection))) (setf (tcp-connection-rcv.nxt connection) (+u32 seq 1)) From 87c9ab604b3df73a23c42e85f301c882b9ed5470 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Tue, 7 Oct 2025 04:29:44 +0200 Subject: [PATCH 60/65] tcp: Document the purpose of tcp4-send-ack and challenge-ack --- net/tcp.lisp | 2 ++ 1 file changed, 2 insertions(+) diff --git a/net/tcp.lisp b/net/tcp.lisp index c64e9a8c5..93189c5c5 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -1040,12 +1040,14 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (error c)))))) (defun tcp4-send-ack (connection) + "Send a standard ACK segment in response to valid segments." (tcp4-send-packet connection (tcp-connection-snd.nxt connection) (tcp-connection-rcv.nxt connection) nil)) (defun challenge-ack (connection) + "Send a challenge ACK segment in response to suspicious segments (RFC5961)." (tcp4-send-packet connection (tcp-connection-snd.nxt connection) (tcp-connection-rcv.nxt connection) From 35c20449b6ba7a5f14ee61533b832ff45abb2020 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Tue, 7 Oct 2025 05:08:25 +0200 Subject: [PATCH 61/65] tcp: Add link to rfc5961 --- net/tcp.lisp | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index 93189c5c5..c62a343a2 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -1,7 +1,9 @@ ;;; TCP ;;; -;;; Transmission Control Protocol - Protocol Specification +;;; Transmission Control Protocol (TCP) ;;; https://datatracker.ietf.org/doc/html/rfc9293 +;;; Improving TCP's Robustness to Blind In-Window Attacks +;;; https://datatracker.ietf.org/doc/html/rfc5961 ;;; (in-package :mezzano.network.tcp) From c9f2516cebc47b419d7ea3c5d2f9eef083049f92 Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Mon, 13 Oct 2025 04:06:34 +0200 Subject: [PATCH 62/65] tcp: Use effective send and receive mss MUST-16 DONE SHLD-6 DONE as MTU does not change MUST-67 DONE --- net/tcp.lisp | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index c62a343a2..cc909f84a 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -59,7 +59,7 @@ (defparameter *initial-window-size* 8192 "Initial congestion window size in octets") (defparameter *default-snd.mss* 536 "Default maximum segment size in octets") ;; TODO: Make it less hacky -(defparameter *rcv.mss* (- (mezzano.driver.network-card:mtu (first (mezzano.sync:watchable-set-items mezzano.driver.network-card::*nics*))) 40) "Maximum segment size in octets") +(defparameter *mtu* (mezzano.driver.network-card:mtu (first (mezzano.sync:watchable-set-items mezzano.driver.network-card::*nics*))) "Maximum segment size in octets") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Debugging and testing parameters @@ -617,8 +617,9 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (return)) (when (= kind +tcp-option-mss+) (when (= length +tcp-option-mss-length+) - (let ((snd.mss (ub16ref/be packet (+ offset 2)))) - (setf (tcp-connection-snd.mss connection) snd.mss)))) + (let* ((snd.mss (ub16ref/be packet (+ offset 2))) + (eff.snd.mss (- (min (+ snd.mss 20) *mtu*) 20 20))) + (setf (tcp-connection-snd.mss connection) eff.snd.mss)))) (incf offset length)))))))) (defun acceptable-segment-p (connection seg.seq seg.len) @@ -1092,11 +1093,10 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (ub16ref/be header +tcp4-header-checksum+) 0 ;; Urgent pointer. (ub16ref/be header +tcp4-header-urgent-pointer+) 0) - ;; MSS TODO: MUST-16, SHLD-6 and MUST-67 (when syn-p (setf (aref header +tcp4-header-options+) 2 (aref header (+ 1 +tcp4-header-options+)) 4 - (ub16ref/be header (+ 2 +tcp4-header-options+)) *rcv.mss*)) + (ub16ref/be header (+ 2 +tcp4-header-options+)) (- *mtu* 20))) ;; Compute the final checksum. (setf checksum (compute-ip-pseudo-header-partial-checksum (mezzano.network.ip::ipv4-address-address src-ip) From 7d0e9fe700f72be860b31a0eb6f49a0ee928701e Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Wed, 17 Dec 2025 10:36:21 +0100 Subject: [PATCH 63/65] tcp: Fix TCP option reading checks --- net/tcp.lisp | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index cc909f84a..99bf10417 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -610,16 +610,19 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (return)) ((= kind +tcp-option-nop+) (incf offset)) + ((> (+ offset 2) end) + ;; Truncated option + (return)) (t (let ((length (aref packet (1+ offset)))) - (when (> 2 length end) + (when (or (< length 2) (> (+ offset length) end)) ;; Ignore silly options and partial options (return)) - (when (= kind +tcp-option-mss+) - (when (= length +tcp-option-mss-length+) - (let* ((snd.mss (ub16ref/be packet (+ offset 2))) - (eff.snd.mss (- (min (+ snd.mss 20) *mtu*) 20 20))) - (setf (tcp-connection-snd.mss connection) eff.snd.mss)))) + (when (and (= kind +tcp-option-mss+) + (= length +tcp-option-mss-length+)) + (let* ((snd.mss (ub16ref/be packet (+ offset 2))) + (eff.snd.mss (- (min (+ snd.mss 20) *mtu*) 20 20))) + (setf (tcp-connection-snd.mss connection) eff.snd.mss))) (incf offset length)))))))) (defun acceptable-segment-p (connection seg.seq seg.len) From 85b7569310e4f2eec055ac703e115d4f72fce68a Mon Sep 17 00:00:00 2001 From: Bruno Cichon Date: Wed, 17 Dec 2025 12:16:59 +0100 Subject: [PATCH 64/65] tcp: Add flow control to send --- net/tcp.lisp | 28 ++++++++++++++++------------ 1 file changed, 16 insertions(+), 12 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index 99bf10417..ea0f191c5 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -1238,7 +1238,6 @@ Set to a value near 2^32 to test SND sequence number wrapping.") :psh-p psh-p :errors-escape t)))) -;; TODO: Respect the send window, buffer data when it fills up. (defun tcp-send (connection data &optional (start 0) end) (setf end (or end (length data))) (with-tcp-connection-locked connection @@ -1255,17 +1254,22 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (unless (tcp-connection-last-ack-time connection) (setf (tcp-connection-last-ack-time connection) (get-internal-run-time))) - (let ((snd.mss (tcp-connection-snd.mss connection))) - (cond ((>= start end)) - ((> (- end start) snd.mss) - ;; Send multiple packets. - (loop :for offset :from start :by snd.mss - :while (> (- end offset) snd.mss) - :do (tcp-send-1 connection data offset (+ offset snd.mss)) - :finally (tcp-send-1 connection data offset end :psh-p t))) - (t - ;; Send one packet. - (tcp-send-1 connection data start end :psh-p t))))) + (loop :with offset := start + :for segment-size := (min (tcp-connection-snd.mss connection) + (- end offset) + (-u32 (+u32 (tcp-connection-snd.una connection) + (tcp-connection-snd.wnd connection)) + (tcp-connection-snd.nxt connection))) + :while (< offset end) + :do (cond ((= segment-size 0) + (mezzano.supervisor:condition-wait-for ((tcp-connection-cvar connection) + (tcp-connection-lock connection)) + ( Date: Wed, 6 May 2026 20:34:02 +0200 Subject: [PATCH 65/65] tcp: Refactor rtt-measurement --- net/tcp.lisp | 40 ++++++++++++++++++---------------------- 1 file changed, 18 insertions(+), 22 deletions(-) diff --git a/net/tcp.lisp b/net/tcp.lisp index ea0f191c5..f7e0f6054 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -673,31 +673,27 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (arm-timeout-timer timeout connection)))))) (defun initial-rtt-measurement (connection) - (let ((delta-time (float (/ (- (get-internal-run-time) (tcp-connection-last-ack-time connection)) - internal-time-units-per-second)))) - (setf (tcp-connection-srtt connection) delta-time - (tcp-connection-rttvar connection) (/ delta-time 2)) - (setf (tcp-connection-rto connection) - (min *maximum-rto* - (max *minimum-rto* - (+ (tcp-connection-srtt connection) - (max 0.01 (* 4 (tcp-connection-rttvar connection)))))) + (let* ((delta-time (float (/ (- (get-internal-run-time) (tcp-connection-last-ack-time connection)) + internal-time-units-per-second))) + (rttvar (/ delta-time 2)) + (srtt delta-time) + (rto (min *maximum-rto* (max *minimum-rto* (+ srtt (max 0.01 (* 4 rttvar))))))) + (setf (tcp-connection-rttvar connection) rttvar + (tcp-connection-srtt connection) srtt + (tcp-connection-rto connection) rto (tcp-connection-last-ack-time connection) nil))) (defun subsequent-rtt-measurement (connection) - (let ((delta-time (float (/ (- (get-internal-run-time) (tcp-connection-last-ack-time connection)) - internal-time-units-per-second)))) - (setf (tcp-connection-rttvar connection) - (+ (* 0.75 (tcp-connection-rttvar connection)) - (* 0.25 (- (tcp-connection-srtt connection) delta-time)))) - (setf (tcp-connection-srtt connection) - (+ (* 0.875 (tcp-connection-srtt connection)) - (* 0.125 delta-time))) - (setf (tcp-connection-rto connection) - (min *maximum-rto* - (max *minimum-rto* - (+ (tcp-connection-srtt connection) - (max 0.01 (* 4 (tcp-connection-rttvar connection)))))) + (let* ((delta-time (float (/ (- (get-internal-run-time) (tcp-connection-last-ack-time connection)) + internal-time-units-per-second))) + (rttvar (+ (* 0.75 (tcp-connection-rttvar connection)) + (* 0.25 (- (tcp-connection-srtt connection) delta-time)))) + (srtt (+ (* 0.875 (tcp-connection-srtt connection)) + (* 0.125 delta-time))) + (rto (min *maximum-rto* (max *minimum-rto* (+ srtt (max 0.01 (* 4 rttvar))))))) + (setf (tcp-connection-rttvar connection) rttvar + (tcp-connection-srtt connection) srtt + (tcp-connection-rto connection) rto (tcp-connection-last-ack-time connection) nil))) (defun when-acceptable-ack-p (connection ack seq wnd)