Update for route.rkt -> trie.rkt switch

This commit is contained in:
Tony Garnock-Jones 2016-03-15 10:55:50 -04:00
parent e400c1703a
commit dd4bd6aae8
5 changed files with 24 additions and 29 deletions

10
arp.rkt
View File

@ -70,7 +70,7 @@
(assertion (arp-interface-up interface-name))
(subscription (arp-assertion ? ? interface-name))
(subscription (observe (arp-query ? ? interface ?)))
(for/fold [(g (trie-empty))] [((k v) (in-hash cache))]
(for/fold [(g trie-empty)] [((k v) (in-hash cache))]
(assertion-set-union g (assertion (arp-query (cache-key-protocol k)
(cache-key-address k)
(cache-value-interface v)
@ -157,15 +157,15 @@
(compute-gestalt cache)))))
(else #f)))
(define queries-projection (compile-projection (observe (arp-query (?!) (?!) ? ?))))
(define queries-projection (observe (arp-query (?!) (?!) ? ?)))
(define (gestalt->queries g)
(for/set [(e (in-set (trie-project/set g queries-projection)))]
(for/set [(e (in-set (trie-project/set #:take 2 g queries-projection)))]
(match-define (list ptype pa) e)
(cache-key ptype pa)))
(define assertions-projection (compile-projection (arp-assertion (?!) (?!) ?)))
(define assertions-projection (arp-assertion (?!) (?!) ?))
(define (gestalt->assertions g)
(for/set [(e (in-set (trie-project/set g assertions-projection)))]
(for/set [(e (in-set (trie-project/set #:take 2 g assertions-projection)))]
(match-define (list ptype pa) e)
(cache-key ptype pa)))

18
ip.rkt
View File

@ -53,7 +53,7 @@
(define broadcast-ip-address (bytes 255 255 255 255))
(define local-ip-address-projector (compile-projection (host-route (?!) ? ?)))
(define local-ip-address-projector (host-route (?!) ? ?))
(define (gestalt->local-ip-addresses g) (trie-project/set/single g local-ip-address-projector))
(define observe-local-ip-addresses-gestalt (subscription (host-route ? ? ?)))
@ -127,9 +127,9 @@
(define (spawn-gateway-route network netmask gateway-addr interface-name)
(define the-route (gateway-route network netmask gateway-addr interface-name))
(define host-route-projector (compile-projection (host-route (?!) (?!) ?)))
(define gateway-route-projector (compile-projection (gateway-route (?!) (?!) ? ?)))
(define net-route-projector (compile-projection (net-route (?!) (?!) ?)))
(define host-route-projector (host-route (?!) (?!) ?))
(define gateway-route-projector (gateway-route (?!) (?!) ? ?))
(define net-route-projector (net-route (?!) (?!) ?))
(define gateway-arp-projector (arp-query IPv4-ethertype
gateway-addr
(?! (ethernet-interface interface-name ?))
@ -144,11 +144,11 @@
(spawn (lambda (e s)
(match e
[(scn g)
(define host-ips+netmasks (trie-project/set g host-route-projector))
(define gw-nets+netmasks (trie-project/set g gateway-route-projector))
(define net-nets+netmasks (trie-project/set g net-route-projector))
(define host-ips+netmasks (trie-project/set #:take 2 g host-route-projector))
(define gw-nets+netmasks (trie-project/set #:take 2 g gateway-route-projector))
(define net-nets+netmasks (trie-project/set #:take 2 g net-route-projector))
(define gw-ip+hwaddr
(let ((vs (trie-project/set g (compile-projection gateway-arp-projector))))
(let ((vs (trie-project/set #:take 2 g gateway-arp-projector)))
(and vs (not (set-empty? vs)) (set-first vs))))
(when (and gw-ip+hwaddr (not (gateway-route-state-gateway-hwaddr s)))
(log-info "Discovered gateway ~a at ~a on interface ~a."
@ -214,7 +214,7 @@
s
(lookup-arp destination
(ethernet-interface interface-name ?)
(trie-empty)
trie-empty
(lambda (interface destination-hwaddr)
(message (ethernet-packet interface
#f

View File

@ -26,8 +26,8 @@
(define (spawn-session them us)
(define user (gensym 'user))
(define remote-detector (compile-projection (at-meta (?!))))
(define peer-detector (compile-projection (advertise `(,(?!) says ,?))))
(define remote-detector (at-meta (?!)))
(define peer-detector (advertise `(,(?!) says ,?)))
(define (send-to-remote fmt . vs)
(message (at-meta (tcp-channel us them (string->bytes/utf-8 (apply format fmt vs))))))
(define (say who fmt . vs)

19
tcp.rkt
View File

@ -128,10 +128,8 @@
(lambda (e state)
(match e
[(scn g)
(define local-peer-absent?
(trie-empty? (trie-project g (compile-projection local-peer-traffic))))
(define remote-peer-absent?
(trie-empty? (trie-project g (compile-projection remote-peer-traffic))))
(define local-peer-absent? (trie-empty? (trie-project g local-peer-traffic)))
(define remote-peer-absent? (trie-empty? (trie-project g remote-peer-traffic)))
(define new-state (+ (if local-peer-absent? 0 1) (if remote-peer-absent? 0 1)))
(if (< new-state state)
(quit)
@ -234,12 +232,11 @@
(else #f))))
(else #f)))
(define statevec-projection
(compile-projection (observe (tcp-packet ? (?!) (?!) (?!) (?!) ? ? ? ? ? ?))))
(define statevec-projection (observe (tcp-packet ? (?!) (?!) (?!) (?!) ? ? ? ? ? ?)))
(define (analyze-gestalt g s)
(define local-ips (gestalt->local-ip-addresses g))
(define statevecs (trie-project/set g statevec-projection))
(define statevecs (trie-project/set #:take 4 g statevec-projection))
(log-info "gestalt yielded statevecs ~v and local-ips ~v" statevecs local-ips)
(transition (struct-copy codec-state s
[local-ips local-ips]
@ -396,7 +393,7 @@
(if (and (conn-state-syn-acked? s)
(not (buffer-finished? (conn-state-inbound s))))
(advertisement (tcp-channel src dst ?))
(trie-empty))))
trie-empty)))
(assertion-set-union (subscription (timer-expired (timer-name ?) ?))
worldward-facing-gestalt
appward-facing-gestalt))
@ -576,10 +573,8 @@
(match e
[(scn g)
(log-info "State vector routing-update:\n~a" (trie->pretty-string g))
(define local-peer-present?
(trie-non-empty? (trie-project g (compile-projection local-peer-detector))))
(define listening?
(trie-non-empty? (trie-project g (compile-projection listener-detector))))
(define local-peer-present? (trie-non-empty? (trie-project g local-peer-detector)))
(define listening? (trie-non-empty? (trie-project g listener-detector)))
(define new-s (struct-copy conn-state s [listener-listening? listening?]))
(cond
[(and local-peer-present? (not (conn-state-local-peer-seen? s)))

View File

@ -95,7 +95,7 @@
(match e
[(scn g)
(define new-local-ips (gestalt->local-ip-addresses g))
(if (trie-empty? (trie-project g (compile-projection local-peer-detector)))
(if (trie-empty? (trie-project g local-peer-detector))
(quit)
(transition new-local-ips (scn (compute-gestalt new-local-ips))))]
[(message (udp-packet (== local-user-addr) remote-addr bs))