ip.scm

   1 ;;;; Lysiane Bouchard - Vincent St-Amour
   2 ;;;; ip.scm
   3
   4 ;; IP constants
   5 (define ip-protocol-icmp 1)
   6 (define ip-protocol-tcp  6)
   7 (define ip-protocol-udp  17)
   8 (define ip-dont-fragment 2)
   9  ;; TODO enable more addresses ?
  10
  11 ;; called when an IP datagram is received
  12 ;; it should be noted that any datagram containing options will be rejected
  13 ;; since we do not support options
  14 (define (ip-pkt-in)
  15   ;; TODO do a macro to abstract reception ?
  16   ;; TODO all these nots are quite ugly, also, do we inline the body of these checks ?
  17   (cond
  18    ((not (or (u8vector-equal-field? pkt ip-destination-ip my-ip 0 4) ; is it for us ?
  19              (u8vector-equal-field? pkt ip-destination-ip broadcast-ip 0 4)))
  20     #f)
  21    ;; if the packet has IP options (header longer than 20 bytes), we reject it
  22    ;; since the header length we accept is only 20, and the version is always
  23    ;; 4, we only have to see if the byte is equal to (4 << 4) + (20 / 4) = 69
  24    ((not (= (u8vector-ref pkt ip-version-and-header-length) 69))
  25     #f)
  26    ((not (= 65535 (pkt-checksum ip-header ip-options 0)))
  27     #f)
  28    ((not (> (u8vector-ref pkt ip-time-to-live) 0))
  29     (icmp-unreachable icmp-time-exceeded))
  30    ((not (let ((ip-frag-flags (quotient (u8vector-ref pkt ip-fragment-offset)
  31                                         32)))
  32            (or (= ip-frag-flags 0)
  33                (= ip-frag-flags ip-dont-fragment))))
  34     (icmp-send-ip-header-bad-error)) ; error, the packet is fragmented TODO we don't handle ? that's the error ?
  35     (else (let ((higher-protocol (u8vector-ref pkt ip-protocol)))
  36            (cond ((= higher-protocol ip-protocol-icmp) (icmp-pkt-in))
  37                  ((= higher-protocol ip-protocol-tcp)  (tcp-pkt-in))
  38                  ((= higher-protocol ip-protocol-udp)  (udp-pkt-in))
  39                  (else (icmp-unreachable icmp-protocol-unreachable)))))))
  40
  41
  42 (define (ip-encapsulation destination-ip chk-idx compute-checksum len)
  43   (let ((ip-len (+ 20 len)))
  44     (u8vector-set! pkt ip-time-to-live ip-original-time-to-live)
  45     (u8vector-set! pkt ip-fragment-offset (* ip-dont-fragment 32))
  46     (u8vector-set! pkt (+ ip-fragment-offset 1) 0) ;; TODO should we support fragementation ?
  47     (integer->pkt 0 ip-checksum 2)
  48     (u8vector-copy! destination-ip 0 pkt ip-destination-ip 4)
  49     (u8vector-copy! my-ip 0 pkt ip-source-ip 4)
  50     (integer->pkt (get-ip-identification) ip-identification 2)
  51     (integer->pkt ip-len ip-length 2)
  52     ;; we don't need to set the header length and version, since it does not
  53     ;; change, and we always send an IP datagram in response to another
  54     (u8vector-set! pkt ip-service 0)
  55     ;; higher-protocol chacksums must be calculated when the IP header is set
  56     ;; we therefore cannot calculate it during the higher-protocol encapsulation
  57     (integer->pkt (bitwise-xor 65535 (compute-checksum)) chk-idx 2)
  58     (integer->pkt (bitwise-xor 65535 (pkt-checksum ip-header ip-options 0))
  59                   ip-checksum 2)
  60     (ethernet-encapsulation ip-len)))