Update for route.rkt -> trie.rkt switch
This commit is contained in:
parent
e400c1703a
commit
dd4bd6aae8
10
arp.rkt
10
arp.rkt
|
@ -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
18
ip.rkt
|
@ -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
|
||||
|
|
4
main.rkt
4
main.rkt
|
@ -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
19
tcp.rkt
|
@ -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)))
|
||||
|
|
2
udp.rkt
2
udp.rkt
|
@ -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))
|
||||
|
|
Loading…
Reference in New Issue