tcp.scm

   1 ;;;; Lysiane Bouchard - Vincent St-Amour
   2 ;;;; tcp.scm
   3
   4 ;; TODO say what's really in here
   5 ;;;  - tcp state functions
   6 ;;;  - procedure called when a TCP packet is received:
   7 ;;;    see "tcp-pkt-in"
   8
   9
  10 ;; specific manipulations of some subfields
  11 (define (get-tcp-flags) (modulo (u8vector-ref pkt tcp-flags) 64)) ;; TODO inline ?
  12
  13 ;; called when a TCP packet is received
  14 (define (tcp-pkt-in)
  15   ;; 40 is the sum of the sizesof the IP and TCP headers
  16   (cond ((not (= (u8vector-ref pkt tcp-header-length-offset) 80)) ;; TODO have this 80 in a variable ?
  17          ;; the packet has TCP options (header longer than 20 bytes), we reject
  18          ;; it. since the length is then always 20 bytes, followed by 4 reserved
  19          ;; bits (which must be set to 0), we simply must check if the byte is
  20          ;; equal to (20 / 4) << 4 = 80
  21          #f))
  22   (if (or (= (pkt-ref-2 tcp-checksum) 0) ; valid or no checksum ?
  23           (= 65535 (compute-tcp-checksum)))
  24       (let ((port (search-port (pkt-ref-2 tcp-destination-portnum)
  25                                tcp-ports)))
  26         (if (and port (pass-app-filter? tcp-source-portnum port))
  27             (begin
  28               (set! curr-port port)
  29               (let ((target-connection
  30                      (memp (lambda (c)
  31                              (and (=conn-info-pkt? tcp-source-portnum c conn-peer-portnum 2)
  32                                   (=conn-info-pkt? ip-source-ip c conn-peer-ip 4)
  33                                   (=conn-info-pkt? ip-destination-ip c conn-self-ip 4)))
  34                            (get-curr-conns))))
  35                 (if target-connection
  36                     (begin (set! curr-conn target-connection)
  37                            ;; call the current state function
  38                            ((vector-ref target-connection conn-state-function)))
  39                     ;; no matching connection was found, if we have not yet
  40                     ;; reached the maximum number of connections, establish a
  41                     ;; new one
  42                     (if (and (< (length (get-curr-conns)) ; TODO do something if false ?
  43                                 (conf-ref curr-port conf-max-conns))
  44                              ;; the handshake must begin with a SYN
  45                              (exclusive-tcp-flag? SYN))
  46                         (begin (new-conn) ; this sets the new connection as the current one
  47                                (self-acknowledgement) ;; TODO was in the call to transferts controller, but does it make any sense ?
  48                                (increment-curr-conn-info! tcp-peer-seqnum 4 1) ;; TODO 1, really ?
  49                                (pass-to-another-state tcp-syn-recv)
  50                                (tcp-transfers-controller (+ SYN ACK) 0))))))
  51             (icmp-unreachable icmp-port-unreachable)))))
  52
  53
  54 (define (compute-tcp-checksum)
  55   (pkt-checksum
  56    ip-source-ip
  57    ;; the UDP pseudo-header uses values located before the TCP header
  58    (+ ip-header (pkt-ref-2 ip-length)) ; end of the TCP data
  59    ;; start with the values of the pseudo-header that are not adjacent to the
  60    ;; rest of the pseudo-header
  61    (add-16bits-1comp 6 ; TCP protocol ID, with leading zeroes up to 16 bits
  62                      (- (pkt-ref-2 ip-length) ip-header-length)))) ; TCP length
  63
  64
  65
  66 ;;----------tcp state functions --------------------------------------------
  67
  68
  69 ;; each one of those function garanties the behaviour of
  70 ;; the tcp protocol according to a specific standard tcp state.
  71
  72 ;; tcp state time-wait
  73 (define (tcp-time-wait)
  74   (tcp-state-function (lambda () #t)))
  75
  76 ;; tcp state fin-wait-2
  77 (define (tcp-fin-wait-2) ;; TODO most of the thunks sent to tcp-state-function are a test (usually for a flag, maybe more) and 1-2 thunks, maybe there is a way to optimize ? however, sometimes, there are actions after the if, or more than one if
  78   (tcp-state-function
  79    (lambda ()
  80      (tcp-receive-data)
  81      (if (inclusive-tcp-flag? FIN)
  82          (begin (increment-curr-conn-info! tcp-peer-seqnum 4 1) ;; TODO 1, really ?
  83                 (pass-to-another-state tcp-time-wait)
  84                 (tcp-transfers-controller ACK 0))
  85          (tcp-transfers-controller 0 0)))))
  86
  87
  88 ;; tcp state closing
  89 (define (tcp-closing)
  90   (tcp-state-function
  91    (lambda () (if (and (inclusive-tcp-flag? ACK)
  92                        (valid-acknum?))
  93                   (begin (conn-info-set! curr-conn tcp-self-ack-units 1) ;; TODO 1, really ?
  94                          (pass-to-another-state tcp-time-wait)
  95                          (tcp-transfers-controller ACK 0))))))
  96
  97
  98 ;; tcp state fin-wait-1
  99 (define (tcp-fin-wait-1)
 100   (tcp-state-function
 101    (lambda ()
 102      (tcp-receive-data)
 103      (if (inclusive-tcp-flag? FIN)
 104          (begin
 105            (if (and (inclusive-tcp-flag? ACK)
 106                     (valid-acknum?))
 107                (begin (conn-info-set! curr-conn tcp-self-ack-units 1) ;; TODO 1, really ?
 108                       (increment-curr-conn-info! tcp-peer-seqnum 4 1) ;; TODO 1, really ?
 109                       (pass-to-another-state tcp-time-wait))
 110                (begin (increment-curr-conn-info! tcp-peer-seqnum 4 1) ;; TODO 1, really ?
 111                       (pass-to-another-state tcp-closing)))
 112            (tcp-transfers-controller ACK 0)) ;; TODO make sure this does what we want
 113          (begin (if (and (inclusive-tcp-flag? ACK)
 114                          (valid-acknum?))
 115                     (begin (conn-info-set! curr-conn tcp-self-ack-units 1) ;; TODO 1, really ?
 116                            (pass-to-another-state tcp-fin-wait-2)))
 117                 (tcp-transfers-controller 0 0))))))
 118
 119
 120 ;; tcp state last-ack
 121 (define (tcp-last-ack)
 122   (tcp-state-function
 123    (lambda () (if (and (inclusive-tcp-flag? ACK)
 124                        (valid-acknum?))
 125                   (detach-curr-conn)))))
 126
 127
 128 ;; tcp state close-wait
 129 (define (tcp-close-wait)
 130   (tcp-state-function
 131    (lambda ()
 132      (if (and (inclusive-tcp-flag? ACK) (valid-acknum?))
 133          (self-acknowledgement))
 134      (tcp-send-data 0))))
 135
 136
 137 ;; tcp state established
 138 (define (tcp-established)
 139   (tcp-state-function
 140    (lambda ()
 141      (if (and (inclusive-tcp-flag? ACK) (valid-acknum?))
 142          ;; we have received an ACK, we can consume the data that was
 143          ;; acknowledged
 144          (buf-consume (vector-ref curr-conn conn-output)
 145                       (self-acknowledgement)))
 146      (tcp-receive-data)
 147      (if (inclusive-tcp-flag? FIN)
 148          (begin (conn-info-set! curr-conn tcp-self-ack-units 1) ;; TODO 1, really ?
 149                 (increment-curr-conn-info! tcp-peer-seqnum 4 1) ;; TODO 1, really ?
 150                 (pass-to-another-state tcp-close-wait)
 151                 (tcp-send-data ACK))
 152          (tcp-send-data 0)))))
 153
 154 ;; tcp state syn-received
 155 (define (tcp-syn-recv)
 156   (tcp-state-function
 157    (lambda () (cond ((inclusive-tcp-flag? FIN)
 158                      (tcp-abort))
 159                     ((and (inclusive-tcp-flag? ACK) (valid-acknum?))
 160                      (link-to-app)
 161                      (conn-info-set! curr-conn tcp-self-ack-units 1) ;; TODO 1, really ?
 162                      (pass-to-another-state tcp-established)
 163                      (tcp-receive-data)
 164                      (tcp-send-data 0))))))
 165
 166
 167 ;; Tools for TCP state functions
 168
 169 ;; some codes for the TCP flags
 170 (define FIN 1)
 171 (define SYN 2)
 172 (define RST 4)
 173 (define PSH 8)
 174 (define ACK 16)
 175 (define URG 32)
 176
 177
 178 ;; set the general connection state to ABORTED
 179 ;; which means the connection cannot be used anymore because of a protocol
 180 ;; error or a too long inactivity period.
 181 (define (tcp-abort)
 182   (tcp-transfers-controller RST)
 183   (detach-curr-conn)) ;; TODO abstract that last call ?
 184
 185 (define (tcp-state-function phase2)
 186   (if (or (> (get-curr-elapsed-time) tcp-max-life-time) ; did the connection time out ?
 187           ;; were there too many retransmission attempts for this packet
 188           ;; already ?
 189           (> (conn-info-ref curr-conn tcp-attempts-count) tcp-attempts-limit))
 190       (tcp-abort)
 191       (if (not (inclusive-tcp-flag? SYN)) ;; TODO do anything if it's a syn ?
 192           (cond ((not (=conn-info-pkt? tcp-seqnum curr-conn
 193                                        tcp-peer-seqnum 4))
 194                  ;; we have received data (the peer's seqnum is ahead), ACK it TODO is that really it ? make sure wih the standard, perhaps this means we received data that is too far ahead, and we should wait for what comes before ?
 195                  (tcp-transfers-controller ACK))
 196                 ((inclusive-tcp-flag? RST)
 197                  (tcp-abort))
 198                 (else (phase2))))))
 199
 200
 201 (define (pass-to-another-state new-state-function)
 202   (vector-set! curr-conn conn-state-function new-state-function)
 203   (conn-info-set! curr-conn tcp-attempts-count 0)
 204   (set-timestamp!)) ;; TODO now we have some repetition, all the 3 flags that were tested here and which called some functions, well, these functions are now called before this, all in the same way.
 205
 206
 207 (define (tcp-receive-data)
 208   (let ((in-amount (- (pkt-ref-2 ip-length) 40))) ; 40 is the sum of the IP and TCP header lengths TODO have in a var, or make picobit optimize these arithmetic operations
 209     (if (> in-amount 0)
 210         (begin (set-timestamp!)
 211                (if (<= in-amount ;; TODO was restructured, the original didn't care whether input succeeded or not and just acnowledged without checking
 212                        (buf-free-space (vector-ref curr-conn conn-input)))
 213                    (begin
 214                      ;; copy data to connection input buffer
 215                      (copy-u8vector->buffer! pkt
 216                                              tcp-data
 217                                              (vector-ref curr-conn conn-input)
 218                                              in-amount)
 219                      (buf-inc-amount (vector-ref curr-conn conn-input) ;; TODO cache the buffer
 220                                      in-amount)
 221                      (increment-curr-conn-info! tcp-peer-seqnum 4 in-amount)
 222                      (turn-tcp-flag-on ACK)))))))
 223
 224 (define (tcp-send-data flags)
 225   (let ((out-amount
 226          (if (and (> (conn-info-ref curr-conn tcp-self-ack-units) 0)
 227                   (>= (get-curr-elapsed-time) tcp-retransmission-delay))
 228              ;; a retransmission is needed
 229              (conn-info-ref curr-conn tcp-self-ack-units)
 230              (curr-buf-get-amount))))
 231     (if (> out-amount 0)
 232         (begin
 233           ;; copy data to connection output buffer
 234           (copy-buffer->u8vector! (vector-ref curr-conn conn-output)
 235                                   pkt
 236                                   tcp-data
 237                                   out-amount)
 238           (increment-curr-conn-info! tcp-attempts-count 1 1)
 239           (conn-info-set! curr-conn tcp-self-ack-units out-amount)
 240           (turn-tcp-flag-on PSH)))
 241     (tcp-transfers-controller flags out-amount)))
 242
 243 ;; TODO this is disgusting, it's called with booleans and there's no way to see what's going on without jumping to the definition
 244 ;; TODO maybe use symbols to say what operations we will be making, keywords would be nice
 245 (define (tcp-transfers-controller flags output-length) ;; TODO rethink this part, I doubt this really needs to be this way
 246   (u8vector-set! pkt tcp-flags flags)
 247   (if (> (u8vector-ref pkt tcp-flags) 0) ;; TODO flags were passed, and maybe psh was set, so maybe we can tell without a ref
 248       (begin
 249         (if (> flags 0) (increment-curr-conn-info! tcp-attempts-count 1 1)) ;; TODO what ? understand the rationale behind this
 250         (set-timestamp!)
 251         (tcp-encapsulation output-length))))
 252
 253
 254 ;; to know if a particular tcp-flag is set
 255 (define (inclusive-tcp-flag? tcp-flag)
 256   (= (modulo (quotient (get-tcp-flags) tcp-flag) 2) 1))
 257
 258 ;; to know if only a particular tcp-flag is set
 259 (define (exclusive-tcp-flag? flag)
 260   (= flag (get-tcp-flags)))
 261
 262 ;; valid acknowledgement number ?
 263 (define (valid-acknum?)
 264   (let ((new-acknum (u8vector-ref-field (vector-ref curr-conn 0)
 265                                         tcp-self-seqnum
 266                                         4)))
 267     (u8vector-increment! new-acknum 0 4 (conn-info-ref curr-conn tcp-self-ack-units))
 268     (u8vector-equal-field? pkt tcp-acknum new-acknum 0 4)))
 269
 270 (define (turn-tcp-flag-on flag)
 271   (u8vector-set! pkt tcp-flags (bitwise-ior flag (u8vector-ref pkt tcp-flags))))
 272
 273
 274 (define (self-acknowledgement) ;; TODO that's data that was sent but not acknowledged yet
 275   (let ((ack-units (conn-info-ref curr-conn tcp-self-ack-units)))
 276     (increment-curr-conn-info! tcp-self-seqnum 4 ack-units)
 277     (conn-info-set! curr-conn tcp-self-ack-units 0)
 278     (conn-info-set! curr-conn tcp-attempts-count 0)
 279     ack-units))
 280
 281
 282 ;; output
 283 (define (tcp-encapsulation output-length)
 284   (let ((len (+ tcp-header-length output-length)))
 285     (integer->pkt 0 tcp-urgent-data-pointer 2)
 286     (integer->pkt 0 tcp-checksum 2)
 287     (integer->pkt (buf-free-space (vector-ref curr-conn conn-input))
 288                   tcp-window 2)
 289     ;; the header length (in bytes) converted to 32-bit words and shifted 4
 290     ;; bits to the left (4 reserved bits must be set to 0) which gives :
 291     ;; (* (quotient tcp-header-length 4) 16)
 292     (u8vector-set! pkt tcp-header-length-offset 80)
 293     (copy-curr-conn-info->pkt tcp-acknum tcp-peer-seqnum 4)
 294     (copy-curr-conn-info->pkt tcp-seqnum tcp-self-seqnum 4)
 295     (copy-curr-conn-info->pkt tcp-destination-portnum conn-peer-portnum 2)
 296     (integer->pkt (conf-ref curr-port conf-portnum) tcp-source-portnum 2)
 297     (ip-encapsulation
 298      (u8vector-ref-field (vector-ref curr-conn conn-info) conn-peer-ip 4)
 299      tcp-checksum
 300      compute-tcp-checksum
 301      len)))