diff --git a/net/arp.lisp b/net/arp.lisp index 2fc8e089..a1557437 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))) diff --git a/net/tcp.lisp b/net/tcp.lisp index 60dea013..ea0f191c 100644 --- a/net/tcp.lisp +++ b/net/tcp.lisp @@ -1,17 +1,18 @@ ;;; TCP ;;; -;;; Transmission Control Protocol - Protocol Specification -;;; https://tools.ietf.org/html/rfc793 +;;; 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 ;;; -;;; 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) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; 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) @@ -20,38 +21,59 @@ (defconstant +tcp4-header-window-size+ 14) (defconstant +tcp4-header-checksum+ 16) (defconstant +tcp4-header-urgent-pointer+ 18) - -(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) - -;; DEFPARAMETER, not DEFCONSTANT, due to cross-compiler constraints. +(defconstant +tcp4-header-options+ 20) + +;;; 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 +;;; 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)") -(defparameter *initial-window-size* 8192) +;;; 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 *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 +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (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) -(defvar *tcp-connection-lock* (mezzano.supervisor:make-mutex "TCP connection list")) -(defvar *tcp-listeners* nil) -(defvar *tcp-listener-lock* (mezzano.supervisor:make-mutex "TCP listener list")) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Type Definitions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (deftype tcp-connection-state () "Possible states that a TCP connection can have." @@ -64,7 +86,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)) @@ -72,12 +95,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))))) + +(defun >u32 (x y) + "X > Y modulo 2^32 arithmetic" + (=u32 (x y) + "X >= Y modulo 2^32 arithmetic" + (<=u32 y x)) + +(defun =< (a b c) + "a <= b <= c modulo 2^32 arithmetic" + (if (< a c) + (<= a b c) + (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. @@ -99,7 +162,10 @@ Set to a value near 2^32 to test SND sequence number wrapping.") :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))) @@ -127,6 +193,16 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (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+) @@ -135,18 +211,11 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (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))) @@ -157,12 +226,12 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (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*) @@ -174,10 +243,18 @@ Set to a value near 2^32 to test SND sequence number wrapping.") :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) @@ -190,44 +267,69 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (%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) (%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) + ;; 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) - (%max-seg-size :accessor tcp-connection-max-seg-size :initarg :max-seg-size) - (%rx-data :accessor tcp-connection-rx-data :initform '()) + (%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) + ;; 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 - :max-seg-size 1000 - :last-ack-time nil + :max.snd.wnd 0 + :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 @@ -244,36 +346,36 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (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. (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 (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))) - ((:established - :close-wait - :last-ack - :fin-wait-1 - :fin-wait-2 - :closing) + (: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 :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)))))) + (arm-retransmit-timer connection))) + (: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) @@ -281,22 +383,19 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (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. (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-sent :syn-received :time-wait) (detach-tcp-connection connection)) (:closed) (t @@ -365,6 +464,7 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (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 @@ -377,14 +477,18 @@ Set to a value near 2^32 to test SND sequence number wrapping.") :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) (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)))) + (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))) ((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) @@ -425,8 +529,8 @@ Set to a value near 2^32 to test SND sequence number wrapping.") ;; 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*) @@ -443,15 +547,15 @@ Set to a value near 2^32 to test SND sequence number wrapping.") "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)) @@ -464,18 +568,14 @@ 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-packet connection - (tcp-connection-snd.nxt connection) - (tcp-connection-rcv.nxt connection) - nil - :ack-p t))) + (tcp4-send-ack connection))) (defun tcp-packet-sequence-number (packet start end) (declare (ignore end)) @@ -493,31 +593,84 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (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)))) -(defun acceptable-segment-p (connection 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)) + ((> (+ offset 2) end) + ;; Truncated option + (return)) + (t + (let ((length (aref packet (1+ offset)))) + (when (or (< length 2) (> (+ offset length) end)) + ;; Ignore silly options and partial options + (return)) + (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) + "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)) - (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))))))))) +(defun acceptable-ack-p (connection seg.ack) + "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) + (<= 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 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-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) - (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)) @@ -547,6 +700,35 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (max 0.01 (* 4 (tcp-connection-rttvar connection)))))) (tcp-connection-last-ack-time connection) nil))) +(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)) + (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))) + (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 ;; in here, so this avoids truncating the backtrace with :resignal-errors. @@ -555,206 +737,282 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (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))) - (when (and (not (eql (tcp-connection-state connection) :established)) - (logtest flags +tcp4-flag-rst+)) - ;; 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. - ;; 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 - ;; Active open - (cond ((and (logtest flags +tcp4-flag-ack+) + (cond ((logtest flags +tcp4-flag-rst+) + (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+) + (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))) - ;; 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)) - (setf (tcp-connection-snd.una connection) ack) - (when (not *netmangler-force-local-retransmit*) - (tcp4-send-packet connection ack (tcp-connection-rcv.nxt connection) nil)) + (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) + (update-window connection wnd seq ack) + (unless *netmangler-force-local-retransmit* + (tcp4-send-ack connection)) ;; Cancel retransmit (disarm-retransmit-timer connection) (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)) - (when (not *netmangler-force-local-retransmit*) + (update-window connection wnd seq ack) + (unless *netmangler-force-local-retransmit* (tcp4-send-packet connection ack (tcp-connection-rcv.nxt connection) nil - :ack-p t :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)))) + :syn-p t))))) (:syn-received - ;; Pasive open - (cond ((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 - (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)))) - ;; Ignore duplicated SYN packets - ((and (logtest flags +tcp4-flag-syn+) - (eql seq (-u32 (tcp-connection-rcv.nxt connection) 1)))) + (cond ((not (acceptable-segment-p connection seq data-length)) + (unless (logtest flags +tcp4-flag-rst+) + (challenge-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 + (set-connection-error 'connection-refused 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))) + (t + ;; 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)) + (challenge-ack 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) - (when (and listener - (tcp-listener-backlog listener)) - (remhash connection (tcp-listener-pending-connections listener)) - (decf (tcp-listener-n-pending-connections listener)))))) + (cond ((acceptable-ack-p connection ack) + ;; Pasive open + (initial-rtt-measurement connection) + (setf (tcp-connection-state connection) :established) + (update-window connection wnd seq ack) + (when listener + (remhash connection (tcp-listener-pending-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))) + (when (and (logtest flags +tcp4-flag-fin+) + (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) + ;; Cancel retransmit + (disarm-retransmit-timer connection) + (disarm-timeout-timer connection))))) (:established - (cond ((not (acceptable-segment-p connection packet start end)) - (when (not (logtest flags +tcp4-flag-rst+)) - (tcp4-send-packet connection - (tcp-connection-snd.nxt connection) - (tcp-connection-rcv.nxt connection) - nil - :ack-p t))) + (cond ((not (acceptable-segment-p connection seq data-length)) + (unless (logtest flags +tcp4-flag-rst+) + (challenge-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)) + (set-connection-error 'connection-reset connection) + (detach-tcp-connection connection)) + (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.next 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) - (<= ack (tcp-connection-snd.nxt connection))) - ;; In the middle of wraparound. - (or (< (tcp-connection-snd.una connection) ack) - (<= ack (tcp-connection-snd.nxt connection)))) - (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. - (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)))) - (if (endp (tcp-connection-retransmit-queue connection)) - (disarm-retransmit-timer connection) - (arm-retransmit-timer connection)) - (setf (tcp-connection-snd.una connection) ack) - (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 :ack-p t)) - (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))))) + ((not (rfc5961-mitigation-check-p connection ack)) + (challenge-ack connection)) + ((>u32 ack (tcp-connection-snd.nxt connection)) + ;; Remote acks something not yet sent + (challenge-ack connection)) + (t + (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+) + (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. - ;; 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+) + (challenge-ack connection))) + ((logtest flags +tcp4-flag-rst+) + (cond ((eql seq (tcp-connection-rcv.nxt connection)) + (set-connection-error 'connection-reset connection) + (detach-tcp-connection connection)) + (t + (challenge-ack connection)))) + ((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)) + (challenge-ack connection)) + ((>u32 ack (tcp-connection-snd.nxt connection)) + ;; Remote acks something not yet sent + (challenge-ack connection)) + (t + (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)) + (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+) + (challenge-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. + ((not (rfc5961-mitigation-check-p connection ack)) + (challenge-ack connection)) + (t + (when (eql ack (tcp-connection-snd.nxt 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. - (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-packet connection - (tcp-connection-snd.nxt connection) - (tcp-connection-rcv.nxt connection) - nil) - (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))) + (cond ((not (acceptable-segment-p connection seq data-length)) + (unless (logtest flags +tcp4-flag-rst+) + (challenge-ack connection))) + ((logtest flags +tcp4-flag-rst+) + (cond ((eql seq (tcp-connection-rcv.nxt connection)) + (set-connection-error 'connection-reset connection) + (detach-tcp-connection connection)) + (t + (challenge-ack connection)))) + ((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)) + (challenge-ack connection)) + ((>u32 ack (tcp-connection-snd.nxt connection)) + ;; Remote acks something not yet sent + (challenge-ack connection)) + (t + (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+) + (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) + (arm-timeout-timer (* 2 *msl*) connection)) + ((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)) + ((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. - (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-packet connection - (tcp-connection-snd.nxt connection) - (tcp-connection-rcv.nxt connection) - nil) - (detach-tcp-connection connection)) - (tcp4-receive-data connection data-length end header-length packet seq start))) + (cond ((not (acceptable-segment-p connection seq data-length)) + (unless (logtest flags +tcp4-flag-rst+) + (challenge-ack connection))) + ((logtest flags +tcp4-flag-rst+) + (cond ((eql seq (tcp-connection-rcv.nxt connection)) + (set-connection-error 'connection-reset connection) + (detach-tcp-connection connection)) + (t + (challenge-ack connection)))) + ((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)) + (challenge-ack connection)) + ((>u32 ack (tcp-connection-snd.nxt connection)) + ;; Remote acks something not yet sent + (challenge-ack connection)) + (t + (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+) + (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) + (arm-timeout-timer (* 2 *msl*) connection))))) (: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+) + (challenge-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. + ((not (rfc5961-mitigation-check-p connection ack)) + (challenge-ack connection)) + ((>u32 ack (tcp-connection-snd.nxt connection)) + ;; Remote acks something not yet sent + (challenge-ack connection)) + (t + (when-acceptable-ack-p connection ack seq wnd) + (when (eql seq (tcp-connection-rcv.nxt connection)) + (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)) + (tcp4-send-ack connection))))) + (:time-wait + (cond ((not (acceptable-segment-p connection seq data-length)) + (unless (logtest flags +tcp4-flag-rst+) + (challenge-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. + ((not (rfc5961-mitigation-check-p connection ack)) + (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)) + (tcp4-send-ack connection) + (disarm-timeout-timer 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))) @@ -787,6 +1045,20 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (when errors-escape (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) + nil)) + (defun compute-ip-pseudo-header-partial-checksum (src-ip dst-ip protocol length) (+ (logand src-ip #xFFFF) (logand (ash src-ip -16) #xFFFF) @@ -800,7 +1072,8 @@ Set to a value near 2^32 to test SND sequence number wrapping.") "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 @@ -808,7 +1081,7 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (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) @@ -823,6 +1096,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) + (when syn-p + (setf (aref header +tcp4-header-options+) 2 + (aref header (+ 1 +tcp4-header-options+)) 4 + (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) @@ -836,21 +1113,10 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (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 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*)) +(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) @@ -859,6 +1125,12 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (define-condition connection-closed (connection-error) ()) +(define-condition connection-closing (connection-error) + ()) + +(define-condition connection-refused (connection-error) + ()) + (define-condition connection-aborted (connection-error) ()) @@ -871,6 +1143,13 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (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: @@ -887,10 +1166,7 @@ Set to a value near 2^32 to test SND sequence number wrapping.") 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))))) @@ -902,7 +1178,7 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (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 @@ -923,7 +1199,7 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (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)) @@ -955,42 +1231,57 @@ Set to a value near 2^32 to test SND sequence number wrapping.") (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 :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 (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)) - (error 'connection-closed - :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))) + (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)) + (