syndicate-lang
/
syndicate-2017
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

ip-interface gestalt; remove ttl from user-accessible fields

This commit is contained in:
Tony Garnock-Jones 2014-06-16 17:52:53 -04:00
parent 630d0e29bd
commit ed6f535266
1 changed files with 63 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

113
ip.rkt
View File

@ -1,6 +1,9 @@
#lang racket/base #lang racket/base
(provide ;; (struct-out ip-packet) (provide (struct-out ip-packet)
(struct-out ip-interface)
ip-address->hostname
broadcast-ip-address
spawn-ip-driver) spawn-ip-driver)
(require racket/set) (require racket/set)
@ -15,7 +18,8 @@
(require "ethernet.rkt") (require "ethernet.rkt")
(require "arp.rkt") (require "arp.rkt")
(struct ip-packet (source destination ttl protocol options body) #:prefab) ;; TODO: more fields (struct ip-packet (source destination protocol options body) #:prefab) ;; TODO: more fields
(struct ip-interface (address ethernet) #:prefab)
(define IPv4-ethertype #x0800) (define IPv4-ethertype #x0800)
@ -28,6 +32,10 @@
(define default-ttl 64) (define default-ttl 64)
(define (ip-address->hostname bs)
(bit-string-case bs
([ a b c d ] (format "~a.~a.~a.~a" a b c d))))
(define broadcast-ip-address (bytes 255 255 255 255)) (define broadcast-ip-address (bytes 255 255 255 255))
(struct state (hwaddr) #:transparent) (struct state (hwaddr) #:transparent)
@ -57,13 +65,12 @@
(or (equal? destination-ip my-address) (or (equal? destination-ip my-address)
(equal? destination-ip broadcast-ip-address)) (equal? destination-ip broadcast-ip-address))
(>= header-length 5) (>= header-length 5)
(>= (bit-string-length body) (* header-length 4))) (>= (bit-string-byte-count body) (* header-length 4)))
(bit-string-case rest (bit-string-case rest
([ (opts :: binary bytes options-length) ([ (opts :: binary bytes options-length)
(data :: binary) ] (data :: binary) ]
(transition s (send (ip-packet (bit-string->bytes source-ip) (transition s (send (ip-packet (bit-string->bytes source-ip)
(bit-string->bytes destination-ip) (bit-string->bytes destination-ip)
ttl
protocol protocol
(bit-string->bytes opts) (bit-string->bytes opts)
(bit-string->bytes data)))))) (bit-string->bytes data))))))
@ -73,56 +80,63 @@
(define (analyze-gestalt g s) (define (analyze-gestalt g s)
(define hwaddr (gestalt->hwaddr g interface-name)) (define hwaddr (gestalt->hwaddr g interface-name))
(define new-s (struct-copy state s [hwaddr hwaddr])) (define new-s (struct-copy state s [hwaddr hwaddr]))
(transition new-s '())) (transition new-s (routing-update (compute-gestalt new-s))))
(define (compute-gestalt s)
(gestalt-union
(pub (arp-assertion IPv4-ethertype my-address))
(sub (ethernet-packet-pattern interface-name #t IPv4-ethertype))
(sub (ethernet-packet-pattern interface-name #t IPv4-ethertype) #:level 1)
(pub (ethernet-packet-pattern interface-name #f IPv4-ethertype))
(sub (ip-packet my-address ? ? ? ?))
(pub (ip-packet ? my-address ? ? ?))
(if (state-hwaddr s)
(pub (ip-interface my-address (ethernet-interface interface-name (state-hwaddr s))))
(gestalt-empty))))
(list (list
(spawn-icmp-driver my-address) (spawn-icmp-driver my-address)
(spawn (lambda (e s) (let ((state0 (state #f)))
(match e (spawn (lambda (e s)
[(routing-update g) (match e
(analyze-gestalt g s)] [(routing-update g)
[(message (ethernet-packet _ _ _ _ _ body) _ _) (analyze-gestalt g s)]
(analyze-incoming-packet body s)] [(message (ethernet-packet _ _ _ _ _ body) _ _)
[(message (ip-packet _ peer-address ttl protocol options body) _ _) (analyze-incoming-packet body s)]
(define header-length ;; TODO: ensure options is a multiple of 4 bytes [(message (ip-packet _ peer-address protocol options body) _ _)
(+ IP-MINIMUM-HEADER-LENGTH (quotient (bit-string-length options) 32))) (define header-length ;; TODO: ensure options is a multiple of 4 bytes
(define header0 (+ IP-MINIMUM-HEADER-LENGTH (quotient (bit-string-byte-count options) 4)))
(bit-string (IP-VERSION :: bits 4) (define header0
(header-length :: bits 4) (bit-string (IP-VERSION :: bits 4)
0 ;; TODO: service type (header-length :: bits 4)
((+ (* header-length 4) 0 ;; TODO: service type
(/ (bit-string-length body) 8)) ((+ (* header-length 4) (bit-string-byte-count body))
:: bits 16) :: bits 16)
(0 :: bits 16) ;; TODO: identifier (0 :: bits 16) ;; TODO: identifier
(0 :: bits 3) ;; TODO: flags (0 :: bits 3) ;; TODO: flags
(0 :: bits 13) ;; TODO: fragments (0 :: bits 13) ;; TODO: fragments
ttl default-ttl
protocol protocol
(0 :: bits 16) (0 :: bits 16)
(my-address :: binary bits 32) (my-address :: binary bits 32)
(peer-address :: binary bits 32) (peer-address :: binary bits 32)
(options :: binary))) (options :: binary)))
(transition s (send (ethernet-packet (ethernet-interface interface-name (transition s (send (ethernet-packet (ethernet-interface interface-name
(state-hwaddr s)) (state-hwaddr s))
#f #f
(state-hwaddr s) (state-hwaddr s)
broadcast-ethernet-address broadcast-ethernet-address
IPv4-ethertype IPv4-ethertype
(bit-string ((ip-checksum 10 header0) :: binary) (bit-string ((ip-checksum 10 header0) :: binary)
(body :: binary)))))] (body :: binary)))))]
[_ #f])) [_ #f]))
(state #f) state0
(gestalt-union (compute-gestalt state0)))))
(pub (arp-assertion IPv4-ethertype my-address))
(sub (ethernet-packet-pattern interface-name #t IPv4-ethertype))
(sub (ethernet-packet-pattern interface-name #t IPv4-ethertype) #:level 1)
(pub (ethernet-packet-pattern interface-name #f IPv4-ethertype))
(sub (ip-packet my-address ? ? ? ? ?))))))
(define (spawn-icmp-driver my-address) (define (spawn-icmp-driver my-address)
(spawn (lambda (e s) (spawn (lambda (e s)
(match e (match e
[(message (ip-packet peer-address _ _ _ _ body) _ _) [(message (ip-packet peer-address _ _ _ body) _ _)
(bit-string-case body (bit-string-case body
([ type code (checksum :: integer bytes 2) (rest :: binary) ] ;; TODO: check cksum ([ type code (checksum :: integer bytes 2) (rest :: binary) ] ;; TODO: check cksum
(case type (case type
@ -136,7 +150,6 @@
(rest :: binary))) (rest :: binary)))
(transition s (send (ip-packet my-address (transition s (send (ip-packet my-address
peer-address peer-address
default-ttl
PROTOCOL-ICMP PROTOCOL-ICMP
#"" #""
(ip-checksum 2 reply-data0))))] (ip-checksum 2 reply-data0))))]
@ -152,5 +165,5 @@
(else #f))] (else #f))]
[_ #f])) [_ #f]))
(void) (void)
(gestalt-union (pub (ip-packet my-address ? ? PROTOCOL-ICMP ? ?)) (gestalt-union (pub (ip-packet my-address ? PROTOCOL-ICMP ? ?))
(sub (ip-packet ? my-address ? PROTOCOL-ICMP ? ?))))) (sub (ip-packet ? my-address PROTOCOL-ICMP ? ?)))))