From ea9660d83db0ad0448e1038b3b29b670fb1444c2 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Thu, 19 Jun 2014 23:10:50 -0400 Subject: [PATCH] Be more explicit about gateway routes having specific interfaces, to avoid ARP reqs on the wrong interface. --- configuration.rkt | 4 +++- ip.rkt | 61 ++++++++++++++++++++++++++++------------------- main.rkt | 4 ++-- 3 files changed, 41 insertions(+), 28 deletions(-) diff --git a/configuration.rkt b/configuration.rkt index abc4431..665320c 100644 --- a/configuration.rkt +++ b/configuration.rkt @@ -2,14 +2,16 @@ (provide (struct-out ethernet-interface) (struct-out host-route) + (struct-out gateway-route) (struct-out net-route)) (struct ethernet-interface (name hwaddr) #:prefab) ;; A Route is one of ;; - (host-route IpAddrBytes NetmaskNat InterfaceName), an own-IP route -;; - (net-route NetAddrBytes NetmaskNat IpAddrBytes), a gateway route for a subnet +;; - (gateway-route NetAddrBytes NetmaskNat IpAddrBytes InterfaceName), a gateway for a subnet ;; - (net-route NetAddrBytes NetmaskNat InterfaceName), an ethernet route for a subnet ;; NetmaskNat in a net-route is a default route. (struct host-route (ip-addr netmask interface-name) #:prefab) +(struct gateway-route (network-addr netmask gateway-addr interface-name) #:prefab) (struct net-route (network-addr netmask link) #:prefab) diff --git a/ip.rkt b/ip.rkt index 8168fc7..a8f9ab5 100644 --- a/ip.rkt +++ b/ip.rkt @@ -64,6 +64,9 @@ (spawn-demand-matcher (host-route (?!) (?!) (?!)) #:supply-level 1 spawn-host-route) + (spawn-demand-matcher (gateway-route (?!) (?!) (?!) (?!)) + #:supply-level 1 + spawn-gateway-route) (spawn-demand-matcher (net-route (?!) (?!) (?!)) #:supply-level 1 spawn-net-route))) @@ -71,6 +74,9 @@ (define (host-route-supply ip-addr netmask interface-name) (sub (host-route ip-addr netmask interface-name) #:level 1)) +(define (gateway-route-supply network-addr netmask gateway-addr interface-name) + (sub (gateway-route network-addr netmask gateway-addr interface-name) #:level 1)) + (define (net-route-supply network-addr netmask link) (sub (net-route network-addr netmask link) #:level 1)) @@ -123,27 +129,21 @@ (pub (arp-assertion IPv4-ethertype my-address interface-name)) (host-route-supply my-address netmask interface-name))))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; General net route - -(define (spawn-net-route network-addr netmask link) - (cond - [(bytes? link) (spawn-gateway-ip-route network-addr netmask link)] - [(string? link) (spawn-normal-ip-route (net-route-supply network-addr netmask link) - network-addr - netmask - link)] - [else (error 'ip "Invalid net-route: ~v ~v ~v" network-addr netmask link)])) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Gateway IP route (struct gateway-route-state (routes gateway-interface gateway-hwaddr) #:transparent) -(define (spawn-gateway-ip-route network netmask gateway-addr) +(define (spawn-gateway-route network netmask gateway-addr interface-name) + (define gestalt-for-supply (gateway-route-supply network netmask gateway-addr interface-name)) + (define host-route-projector (project-subs (host-route (?!) ? ?))) + (define gateway-route-projector (project-subs (gateway-route (?!) (?!) ? ?))) (define net-route-projector (project-subs (net-route (?!) (?!) ?))) - (define gateway-arp-projector (project-pubs (arp-query IPv4-ethertype gateway-addr (?!) (?!)))) + (define gateway-arp-projector (project-pubs (arp-query IPv4-ethertype + gateway-addr + (?! (ethernet-interface interface-name ?)) + (?!)))) (define (covered-by-some-other-route? addr routes) (for/or ([r (in-set routes)]) @@ -155,22 +155,28 @@ (match e [(routing-update g) (define host-ips (gestalt-project/single g host-route-projector)) - (define net-ips+netmasks (gestalt-project/keys g net-route-projector)) + (define gw-nets+netmasks (gestalt-project/keys g gateway-route-projector)) + (define net-nets+netmasks (gestalt-project/keys g net-route-projector)) (define gw-ip+hwaddr (let ((vs (gestalt-project/keys 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." + (ip-address->hostname gateway-addr) + (ethernet-interface-name (car gw-ip+hwaddr)) + (pretty-bytes (cadr gw-ip+hwaddr)))) (transition (gateway-route-state - (set-union (for/set ([ip host-ips]) (list ip 32)) net-ips+netmasks) + (set-union (for/set ([ip host-ips]) (list ip 32)) + gw-nets+netmasks + net-nets+netmasks) (and gw-ip+hwaddr (car gw-ip+hwaddr)) (and gw-ip+hwaddr (cadr gw-ip+hwaddr))) - (when (gestalt-empty? (gestalt-filter g (net-route-supply network - netmask - gateway-addr))) - (quit)))] + (when (gestalt-empty? (gestalt-filter g gestalt-for-supply)) (quit)))] [(message (? ip-packet? p) _ _) (define gw-if (gateway-route-state-gateway-interface s)) (when (not gw-if) - (log-warning "Gateway hwaddr for ~a not known, packet dropped" - (ip-address->hostname gateway-addr))) + (log-warning "Gateway hwaddr for ~a not known, packet dropped: ~v" + (ip-address->hostname gateway-addr) + p)) (and gw-if (not (equal? (ip-packet-source-interface p) (ethernet-interface-name gw-if))) (not (covered-by-some-other-route? (ip-packet-destination p) @@ -184,17 +190,22 @@ (format-ip-packet p)))))] [_ #f])) (gateway-route-state (set) #f #f) - (gestalt-union (if (zero? netmask) - (net-route-supply network netmask gateway-addr) - (gestalt-empty)) + (gestalt-union gestalt-for-supply (sub (ip-packet ? ? ? ? ? ?)) (pub (ip-packet ? ? ? ? ? ?)) observe-local-ip-addresses-gestalt (sub (net-route ? ? ?) #:level 2) + (sub (gateway-route ? ? ? ?) #:level 2) (projection->gestalt gateway-arp-projector)))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; General net route + +(define (spawn-net-route network-addr netmask link) + (spawn-normal-ip-route (net-route-supply network-addr netmask link) network-addr netmask link)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Normal IP route diff --git a/main.rkt b/main.rkt index b1896f5..d76871f 100644 --- a/main.rkt +++ b/main.rkt @@ -23,12 +23,12 @@ (void) (match (gethostname) ["hop" - (gestalt-union (pub (net-route (bytes 0 0 0 0) 0 (bytes 192 168 1 1))) + (gestalt-union (pub (gateway-route (bytes 0 0 0 0) 0 (bytes 192 168 1 1) "wlan0")) (pub (host-route (bytes 192 168 1 222) 24 "wlan0")))] ["stockholm.ccs.neu.edu" (gestalt-union (pub (host-route (bytes 129 10 115 94) 24 "eth0")) (pub (host-route (bytes 192 168 56 222) 24 "vboxnet0")) - (pub (net-route (bytes 0 0 0 0) 0 (bytes 129 10 115 1))))] + (pub (gateway-route (bytes 0 0 0 0) 0 (bytes 129 10 115 1) "eth0")))] [else (error 'stack-configuration "No setup for hostname ~a" (gethostname))]))