diff --git a/arp.rkt b/arp.rkt
index 40f5f0f..f3071a7 100644
--- a/arp.rkt
+++ b/arp.rkt
@@ -4,6 +4,7 @@
 
 (provide (struct-out arp-query)
 	 (struct-out arp-assertion)
+	 (struct-out arp-interface)
 	 spawn-arp-driver)
 
 (require racket/set)
@@ -14,10 +15,12 @@
 (require bitsyntax)
 
 (require "dump-bytes.rkt")
+(require "configuration.rkt")
 (require "ethernet.rkt")
 
-(struct arp-query (protocol protocol-address hardware-address) #:prefab)
-(struct arp-assertion (protocol protocol-address) #:prefab)
+(struct arp-query (protocol protocol-address interface link-address) #:prefab)
+(struct arp-assertion (protocol protocol-address interface-name) #:prefab)
+(struct arp-interface (interface-name) #:prefab)
 
 (define ARP-ethertype #x0806)
 (define cache-entry-lifetime-msec (* 14400 1000))
@@ -25,12 +28,31 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(define (spawn-arp-driver)
+  (spawn-demand-matcher (arp-interface (?!))
+			#:supply-level 1
+			spawn-arp-interface))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (struct cache-key (protocol address) #:transparent)
-(struct cache-value (expiry address) #:transparent)
+(struct cache-value (expiry interface address) #:transparent)
 
-(struct state (hwaddr cache queries assertions) #:transparent)
+(struct state (cache queries assertions) #:transparent)
+
+(define (spawn-arp-interface interface-name)
+  (log-info "spawn-arp-interface ~v" interface-name)
+  (lookup-ethernet-hwaddr (gestalt-for-supply interface-name)
+			  interface-name
+			  (lambda (hwaddr) (spawn-arp-interface* interface-name hwaddr))))
+
+(define (gestalt-for-supply interface-name)
+  (sub (arp-interface interface-name) #:level 1))
+
+(define (spawn-arp-interface* interface-name hwaddr)
+  (log-info "spawn-arp-interface* ~v ~v" interface-name hwaddr)
+  (define interface (ethernet-interface interface-name hwaddr))
 
-(define (spawn-arp-driver interface-name)
   (define (expire-cache cache)
     (define now (current-inexact-milliseconds))
     (define (not-expired? v) (< now (cache-value-expiry v)))
@@ -47,11 +69,13 @@
 		   (sub (ethernet-packet-pattern interface-name #t ARP-ethertype))
 		   (sub (ethernet-packet-pattern interface-name #t ARP-ethertype) #:level 1)
 		   (pub (ethernet-packet-pattern interface-name #f ARP-ethertype))
-		   (sub (arp-assertion ? ?) #:level 1)
-		   (pub (arp-query ? ? ?) #:level 2)
+		   (gestalt-for-supply interface-name)
+		   (sub (arp-assertion ? ? interface-name) #:level 1)
+		   (pub (arp-query ? ? interface ?) #:level 2)
 		   (for/fold [(g (gestalt-empty))] [((k v) (in-hash cache))]
 		     (gestalt-union g (pub (arp-query (cache-key-protocol k)
 						      (cache-key-address k)
+						      (cache-value-interface v)
 						      (cache-value-address v)))))))
 
   (define (build-packet s dest-mac ptype oper sender-ha sender-pa target-ha target-pa)
@@ -67,9 +91,9 @@
 				(sender-pa :: binary bytes plen)
 				(target-ha :: binary bytes hlen)
 				(target-pa :: binary bytes plen))))
-    (ethernet-packet (ethernet-interface interface-name (state-hwaddr s))
+    (ethernet-packet interface
 		     #f
-		     (state-hwaddr s)
+		     hwaddr
 		     dest-mac
 		     ARP-ethertype
 		     packet))
@@ -84,15 +108,24 @@
 	 (sender-hardware-address0 :: binary bytes hlen)
 	 (sender-protocol-address0 :: binary bytes plen)
 	 (target-hardware-address0 :: binary bytes hlen)
-	 (target-protocol-address0 :: binary bytes plen) ]
+	 (target-protocol-address0 :: binary bytes plen)
+	 (:: binary) ;; TODO: are the extra zeros coming from the
+		     ;; router real, or an artifact of my
+		     ;; packet-capture implementation?
+	 ]
        (let ()
 	 (define sender-protocol-address (bit-string->bytes sender-protocol-address0))
 	 (define sender-hardware-address (bit-string->bytes sender-hardware-address0))
 	 (define target-protocol-address (bit-string->bytes target-protocol-address0))
+	 ;; (log-info "~a ARP Adding ~a = ~a to cache"
+	 ;; 	   interface-name
+	 ;; 	   (pretty-bytes sender-protocol-address)
+	 ;; 	   (pretty-bytes sender-hardware-address))
 	 (define cache (hash-set (expire-cache (state-cache s))
 				 (cache-key ptype sender-protocol-address)
 				 (cache-value (+ (current-inexact-milliseconds)
 						 cache-entry-lifetime-msec)
+					      interface
 					      sender-hardware-address)))
 	 (transition (struct-copy state s
 		       [cache cache])
@@ -105,7 +138,7 @@
 						 sender-hardware-address
 						 ptype
 						 2 ;; reply
-						 (state-hwaddr s)
+						 hwaddr
 						 target-protocol-address
 						 sender-hardware-address
 						 sender-protocol-address))
@@ -115,29 +148,25 @@
 		      (routing-update (compute-gestalt cache))))))
       (else #f)))
 
-  (define queries-projection (compile-gestalt-projection (arp-query (?!) (?!) ?)))
+  (define queries-projection (project-subs #:level 1 (arp-query (?!) (?!) ? ?)))
   (define (gestalt->queries g)
-    (for/set [(e (in-set (matcher-key-set (gestalt-project g 0 1 #f queries-projection))))]
+    (for/set [(e (in-set (gestalt-project/keys g queries-projection)))]
       (match-define (list ptype pa) e)
       (cache-key ptype pa)))
 
-  (define assertions-projection (compile-gestalt-projection (arp-assertion (?!) (?!))))
+  (define assertions-projection (project-pubs (arp-assertion (?!) (?!) ?)))
   (define (gestalt->assertions g)
-    (for/set [(e (matcher-key-set (gestalt-project g 0 0 #t assertions-projection)))]
+    (for/set [(e (in-set (gestalt-project/keys g assertions-projection)))]
       (match-define (list ptype pa) e)
       (cache-key ptype pa)))
 
   (define (analyze-gestalt g s)
-    (define hwaddr (gestalt->hwaddr g interface-name))
     (define new-queries (gestalt->queries g))
     (define new-assertions (gestalt->assertions g))
     (define added-queries (set-subtract new-queries (state-queries s)))
     (define added-assertions (set-subtract new-assertions (state-assertions s)))
     (define unanswered-queries (set-subtract added-queries (list->set (hash-keys (state-cache s)))))
-    (define new-s (struct-copy state s
-		    [hwaddr hwaddr]
-		    [queries new-queries]
-		    [assertions (if hwaddr new-assertions (state-assertions s))]))
+    (define new-s (struct-copy state s [queries new-queries] [assertions new-assertions]))
     (define (some-asserted-pa ptype)
       (match (filter (lambda (k) (equal? (cache-key-protocol k) ptype))
 		     (set->list new-assertions))
@@ -152,9 +181,12 @@
     ;; (log-info "analyze-gestalt: new-s ~v" new-s)
     (transition new-s
 		(list
+		 (when (gestalt-empty? (gestalt-filter g (gestalt-for-supply interface-name)))
+		   (quit))
 		 (for/list [(q (in-set unanswered-queries))]
 		   (define pa (some-asserted-pa (cache-key-protocol q)))
-		   (log-info "Asking for ~a from ~a"
+		   (log-info "~a ARP Asking for ~a from ~a"
+			     interface-name
 			     (pretty-bytes (cache-key-address q))
 			     (and pa (pretty-bytes pa)))
 		   (if pa
@@ -167,23 +199,23 @@
 					   zero-ethernet-address
 					   (cache-key-address q)))
 		       '()))
-		 (when hwaddr ;; don't announce until we know our own hwaddr
-		   (for/list [(a (in-set added-assertions))]
-		     (log-info "Announcing ~a as ~a"
-			       (pretty-bytes (cache-key-address a))
-			       (pretty-bytes hwaddr))
-		     (send (build-packet new-s
-					 broadcast-ethernet-address
-					 (cache-key-protocol a)
-					 2 ;; reply -- gratuitous announcement
-					 hwaddr
-					 (cache-key-address a)
-					 hwaddr
-					 (cache-key-address a))))))))
+		 (for/list [(a (in-set added-assertions))]
+		   (log-info "~a ARP Announcing ~a as ~a"
+			     interface-name
+			     (pretty-bytes (cache-key-address a))
+			     (pretty-bytes hwaddr))
+		   (send (build-packet new-s
+				       broadcast-ethernet-address
+				       (cache-key-protocol a)
+				       2 ;; reply -- gratuitous announcement
+				       hwaddr
+				       (cache-key-address a)
+				       hwaddr
+				       (cache-key-address a)))))))
 
   (list (set-wakeup-alarm)
 	(spawn (lambda (e s)
-		 ;; (log-info "ARP: ~v // ~v" e s)
+		 ;; (log-info "ARP ~a ~a: ~v // ~v" interface-name (pretty-bytes hwaddr) e s)
 		 (match e
 		   [(routing-update g)
 		    (analyze-gestalt g s)]
@@ -196,5 +228,5 @@
 				(list (set-wakeup-alarm)
 				      (routing-update (compute-gestalt (state-cache new-s)))))]
 		   [_ #f]))
-	       (state #f (hash) (set) (set))
+	       (state (hash) (set) (set))
 	       (compute-gestalt (hash)))))
diff --git a/configuration.rkt b/configuration.rkt
new file mode 100644
index 0000000..abc4431
--- /dev/null
+++ b/configuration.rkt
@@ -0,0 +1,15 @@
+#lang racket/base
+
+(provide (struct-out ethernet-interface)
+	 (struct-out host-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
+;;  - (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 net-route (network-addr netmask link) #:prefab)
diff --git a/ethernet.rkt b/ethernet.rkt
index c3b6da9..8ae6da1 100644
--- a/ethernet.rkt
+++ b/ethernet.rkt
@@ -1,14 +1,15 @@
 #lang racket/base
 ;; Ethernet driver
 
-(provide (struct-out ethernet-interface)
-	 (struct-out ethernet-packet)
+(provide (struct-out ethernet-packet)
 	 zero-ethernet-address
 	 broadcast-ethernet-address
 	 interface-names
 	 spawn-ethernet-driver
+	 ethernet-hwaddr-projection
 	 gestalt->hwaddr
-	 ethernet-packet-pattern)
+	 ethernet-packet-pattern
+	 lookup-ethernet-hwaddr)
 
 (require racket/set)
 (require racket/match)
@@ -20,9 +21,9 @@
 (require packet-socket)
 (require bitsyntax)
 
+(require "configuration.rkt")
 (require "dump-bytes.rkt")
 
-(struct ethernet-interface (name hwaddr) #:prefab)
 (struct ethernet-packet (interface from-wire? source destination ethertype body) #:prefab)
 
 (define zero-ethernet-address (bytes 0 0 0 0 0 0))
@@ -50,6 +51,7 @@
     (spawn (lambda (e h)
 	     (match e
 	       [(routing-update g)
+
 		(if (gestalt-empty? g)
 		    (begin (async-channel-put control-ch 'quit)
 			   (transition #f (quit)))
@@ -118,12 +120,11 @@
 	       (ethertype :: integer bytes 2)
 	       (body :: binary))))
 
-(define (hwaddr-projection interface-name)
-  (compile-gestalt-projection (ethernet-packet (ethernet-interface interface-name (?!)) ? ? ? ? ?)))
+(define (ethernet-hwaddr-projection interface-name)
+  (project-pubs (ethernet-packet (ethernet-interface interface-name (?!)) #t ? ? ? ?)))
 
 (define (gestalt->hwaddr g interface-name)
-  (define hwaddrs
-    (matcher-key-set/single (gestalt-project g 0 0 #t (hwaddr-projection interface-name))))
+  (define hwaddrs (gestalt-project/single g (ethernet-hwaddr-projection interface-name)))
   (case (set-count hwaddrs)
     [(0) #f]
     [(1) (set-first hwaddrs)]
@@ -133,3 +134,15 @@
 
 (define (ethernet-packet-pattern interface-name from-wire? ethertype)
   (ethernet-packet (ethernet-interface interface-name ?) from-wire? ? ? ethertype ?))
+
+(define (lookup-ethernet-hwaddr base-gestalt interface-name k)
+  (on-gestalt #:timeout-msec 5000
+	      #:on-timeout (lambda ()
+			     (log-info "Lookup of ethernet interface ~v failed" interface-name)
+			     '())
+	      (lambda (_g hwaddrss)
+		(and (not (set-empty? hwaddrss))
+		     (let ((hwaddr (car (set-first hwaddrss))))
+		       (k hwaddr))))
+	      base-gestalt
+	      (ethernet-hwaddr-projection interface-name)))
diff --git a/ip.rkt b/ip.rkt
index bd565a5..2f7d999 100644
--- a/ip.rkt
+++ b/ip.rkt
@@ -1,8 +1,11 @@
 #lang racket/base
 
 (provide (struct-out ip-packet)
-	 (struct-out ip-interface)
 	 ip-address->hostname
+	 apply-netmask
+	 ip-address-in-subnet?
+	 gestalt->local-ip-addresses
+	 observe-local-ip-addresses-gestalt
 	 broadcast-ip-address
 	 spawn-ip-driver)
 
@@ -14,12 +17,208 @@
 (require bitsyntax)
 
 (require "dump-bytes.rkt")
+(require "configuration.rkt")
 (require "checksum.rkt")
 (require "ethernet.rkt")
 (require "arp.rkt")
 
-(struct ip-packet (source destination protocol options body) #:prefab) ;; TODO: more fields
-(struct ip-interface (address ethernet) #:prefab)
+(struct ip-packet (source-interface ;; string for an ethernet interface, or #f for local interfaces
+		   source
+		   destination
+		   protocol
+		   options
+		   body)
+	#:prefab) ;; TODO: more fields
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (ip-address->hostname bs)
+  (bit-string-case bs
+    ([ a b c d ] (format "~a.~a.~a.~a" a b c d))))
+
+(define (apply-netmask addr netmask)
+  (bit-string-case addr
+    ([ (n :: integer bytes 4) ]
+     (bit-string ((bitwise-and n (arithmetic-shift #x-100000000 (- netmask)))
+		  :: integer bytes 4)))))
+
+(define (ip-address-in-subnet? addr network netmask)
+  (equal? (apply-netmask network netmask)
+	  (apply-netmask addr netmask)))
+
+(define broadcast-ip-address (bytes 255 255 255 255))
+
+(define local-ip-address-projector (project-pubs (host-route (?!) ? ?)))
+(define (gestalt->local-ip-addresses g) (gestalt-project/single g local-ip-address-projector))
+(define observe-local-ip-addresses-gestalt (sub (host-route ? ? ?) #:level 2))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (spawn-ip-driver)
+  (list
+   (spawn-demand-matcher (host-route (?!) (?!) (?!))
+			 #:supply-level 1
+			 spawn-host-route)
+   (spawn-demand-matcher (net-route (?!) (?!) (?!))
+			 #:supply-level 1
+			 spawn-net-route)))
+
+(define (host-route-supply ip-addr netmask interface-name)
+  (sub (host-route ip-addr netmask interface-name) #:level 1))
+
+(define (net-route-supply network-addr netmask link)
+  (sub (net-route network-addr netmask link) #:level 1))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Local IP route
+
+(define (spawn-host-route my-address netmask interface-name)
+  (list
+   (let ((network-addr (apply-netmask my-address netmask)))
+     (spawn-normal-ip-route (host-route-supply my-address netmask interface-name)
+			    network-addr
+			    netmask
+			    interface-name))
+   (spawn (lambda (e s)
+	    (match e
+	      [(routing-update g)
+	       (transition s (when (gestalt-empty? g) (quit)))]
+	      [(message (ip-packet _ peer-address _ _ _ body) _ _)
+	       (bit-string-case body
+		 ([ type code (checksum :: integer bytes 2) (rest :: binary) ] ;; TODO: check cksum
+		  (case type
+		    [(8) ;; ECHO (0 is ECHO-REPLY)
+		     (log-info "Ping of ~a from ~a"
+			       (pretty-bytes my-address)
+			       (pretty-bytes peer-address))
+		     (define reply-data0 (bit-string 0
+						     code
+						     (0 :: integer bytes 2) ;; TODO
+						     (rest :: binary)))
+		     (transition s (send (ip-packet #f
+						    my-address
+						    peer-address
+						    PROTOCOL-ICMP
+						    #""
+						    (ip-checksum 2 reply-data0))))]
+		    [else
+		     (log-info "ICMP ~a/~a (cksum ~a) to ~a from ~a:\n~a"
+			       type
+			       code
+			       checksum
+			       (pretty-bytes my-address)
+			       (pretty-bytes peer-address)
+			       (dump-bytes->string rest))
+		     #f]))
+		 (else #f))]
+	      [_ #f]))
+	  (void)
+	  (gestalt-union (pub (ip-packet ? my-address ? PROTOCOL-ICMP ? ?))
+			 (sub (ip-packet ? ? my-address PROTOCOL-ICMP ? ?))
+			 (pub (arp-assertion IPv4-ethertype my-address interface-name))
+			 (host-route-supply my-address netmask interface-name)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Gateway IP 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)]))
+
+(define (spawn-gateway-ip-route network netmask gateway-addr)
+  (lookup-arp gateway-addr
+	      ?
+	      (net-route-supply network netmask gateway-addr)
+	      (lambda (interface gateway-hwaddr)
+		(spawn-gateway-ip-route* network netmask gateway-addr interface gateway-hwaddr))))
+
+(define (spawn-gateway-ip-route* network netmask gateway-addr interface gateway-hwaddr)
+  (define host-route-projector (project-subs (host-route (?!) ? ?)))
+  (define net-route-projector (project-subs (net-route (?!) (?!) ?)))
+
+  (define (covered-by-some-other-route? addr routes)
+    (for/or ([r (in-set routes)])
+      (match-define (list net msk) r)
+      (and (positive? msk)
+	   (ip-address-in-subnet? addr net msk))))
+
+  (spawn (lambda (e routes)
+	   (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))
+	      (transition (set-union (for/set ([ip host-ips]) (list ip 32)) net-ips+netmasks)
+			  (when (gestalt-empty? (gestalt-filter g (net-route-supply network
+										    netmask
+										    gateway-addr)))
+			    (quit)))]
+	     [(message (? ip-packet? p) _ _)
+	      (and (not (equal? (ip-packet-source-interface p) (ethernet-interface-name interface)))
+		   (not (covered-by-some-other-route? (ip-packet-destination p) routes))
+		   (transition routes
+			       (send (ethernet-packet interface
+						      #f
+						      (ethernet-interface-hwaddr interface)
+						      gateway-hwaddr
+						      IPv4-ethertype
+						      (format-ip-packet p)))))]
+	     [_ #f]))
+	 (set)
+	 (gestalt-union (if (zero? netmask)
+			    (net-route-supply network netmask gateway-addr)
+			    (gestalt-empty))
+			observe-local-ip-addresses-gestalt
+			(sub (ip-packet ? ? ? ? ? ?))
+			(pub (ip-packet ? ? ? ? ? ?)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Normal IP route
+
+(define (spawn-normal-ip-route gestalt-for-supply network netmask interface-name)
+  (spawn (lambda (e s)
+	   (match e
+	     [(routing-update g)
+	      (log-info "normal-ip route ~v/~v/~v quitting:\n~a"
+			network
+			netmask
+			interface-name
+			(gestalt->pretty-string g))
+	      (transition s (when (gestalt-empty? g) (quit)))]
+	     [(message (ethernet-packet _ _ _ _ _ body) _ _)
+	      (define p (parse-ip-packet interface-name body))
+	      (and p (transition s (send p)))]
+	     [(message (? ip-packet? p) _ _)
+	      (define destination (ip-packet-destination p))
+	      (and (not (equal? (ip-packet-source-interface p) interface-name))
+		   (ip-address-in-subnet? destination network netmask)
+		   (transition
+		    s
+		    (lookup-arp destination
+				(ethernet-interface interface-name ?)
+				(gestalt-empty)
+				(lambda (interface destination-hwaddr)
+				  (send (ethernet-packet interface
+							 #f
+							 (ethernet-interface-hwaddr interface)
+							 destination-hwaddr
+							 IPv4-ethertype
+							 (format-ip-packet p)))))))]
+	     [_ #f]))
+	 (void)
+	 (gestalt-union gestalt-for-supply
+			(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))
+			(pub (arp-interface interface-name))
+			(sub (ip-packet ? ? ? ? ? ?))
+			(pub (ip-packet ? ? ? ? ? ?)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (define IPv4-ethertype #x0800)
 
@@ -32,174 +231,83 @@
 
 (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 (parse-ip-packet interface-name body)
+  ;; (log-info "IP ~a got body ~a" (pretty-bytes my-address) (pretty-bytes body))
+  (bit-string-case body
+    ([ (= IP-VERSION :: bits 4)
+       (header-length :: bits 4)
+       service-type
+       (total-length :: bits 16)
+       (id :: bits 16)
+       (flags :: bits 3)
+       (fragment-offset :: bits 13)
+       ttl
+       protocol
+       (header-checksum :: bits 16) ;; TODO: check checksum
+       (source-ip0 :: binary bits 32)
+       (destination-ip0 :: binary bits 32)
+       (rest :: binary) ]
+     (let ((source-ip (bit-string->bytes source-ip0))
+	   (destination-ip (bit-string->bytes destination-ip0))
+	   (options-length (* 4 (- header-length IP-MINIMUM-HEADER-LENGTH))))
+       (if (and (>= header-length 5)
+		(>= (bit-string-byte-count body) (* header-length 4)))
+	   (bit-string-case rest
+	     ([ (opts :: binary bytes options-length)
+		(data :: binary) ]
+	      (ip-packet interface-name
+			 (bit-string->bytes source-ip)
+			 (bit-string->bytes destination-ip)
+			 protocol
+			 (bit-string->bytes opts)
+			 (bit-string->bytes data))))
+	   #f)))
+    (else #f)))
 
-(define broadcast-ip-address (bytes 255 255 255 255))
+(define (format-ip-packet p)
+  (match-define (ip-packet _ src dst protocol options body) p)
 
-(struct state (hwaddr) #:transparent)
+  (define header-length ;; TODO: ensure options is a multiple of 4 bytes
+    (+ IP-MINIMUM-HEADER-LENGTH (quotient (bit-string-byte-count options) 4)))
 
-(define (spawn-ip-driver interface-name my-address)
+  (define header0 (bit-string (IP-VERSION :: bits 4)
+			      (header-length :: bits 4)
+			      0 ;; TODO: service type
+			      ((+ (* header-length 4) (bit-string-byte-count body))
+			       :: bits 16)
+			      (0 :: bits 16)  ;; TODO: identifier
+			      (0 :: bits 3)   ;; TODO: flags
+			      (0 :: bits 13)  ;; TODO: fragments
+			      default-ttl
+			      protocol
+			      (0 :: bits 16)
+			      (src :: binary bits 32)
+			      (dst :: binary bits 32)
+			      (options :: binary)))
+  (define full-packet (bit-string ((ip-checksum 10 header0) :: binary) (body :: binary)))
 
-  (define (analyze-incoming-packet body s)
-    ;; (log-info "IP ~a got body ~a" (pretty-bytes my-address) (pretty-bytes body))
-    (bit-string-case body
-      ([ (= IP-VERSION :: bits 4)
-	 (header-length :: bits 4)
-	 service-type
-	 (total-length :: bits 16)
-	 (id :: bits 16)
-	 (flags :: bits 3)
-	 (fragment-offset :: bits 13)
-	 ttl
-	 protocol
-	 (header-checksum :: bits 16) ;; TODO: check checksum
-	 (source-ip0 :: binary bits 32)
-	 (destination-ip0 :: binary bits 32)
-	 (rest :: binary) ]
-       (let ((source-ip (bit-string->bytes source-ip0))
-	     (destination-ip (bit-string->bytes destination-ip0))
-	     (options-length (* 4 (- header-length IP-MINIMUM-HEADER-LENGTH))))
-	 (if (and (not (equal? source-ip my-address))
-		  (or (equal? destination-ip my-address)
-		      (equal? destination-ip broadcast-ip-address))
-		  (>= header-length 5)
-		  (>= (bit-string-byte-count body) (* header-length 4)))
-	     (bit-string-case rest
-	       ([ (opts :: binary bytes options-length)
-		  (data :: binary) ]
-		(transition s (send (ip-packet (bit-string->bytes source-ip)
-					       (bit-string->bytes destination-ip)
-					       protocol
-					       (bit-string->bytes opts)
-					       (bit-string->bytes data))))))
-	     #f)))
-      (else #f)))
+  full-packet)
 
-  (define (analyze-gestalt g s)
-    (define hwaddr (gestalt->hwaddr g interface-name))
-    (define new-s (struct-copy state s [hwaddr hwaddr]))
-    (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
-   (spawn-icmp-driver my-address)
-   (let ((state0 (state #f)))
-     (spawn (lambda (e s)
-	      (match e
-		[(routing-update g)
-		 (analyze-gestalt g s)]
-		[(message (ethernet-packet _ _ _ _ _ body) _ _)
-		 (analyze-incoming-packet body s)]
-		[(message (ip-packet _ peer-address protocol options body) _ _)
-		 (define header-length ;; TODO: ensure options is a multiple of 4 bytes
-		   (+ IP-MINIMUM-HEADER-LENGTH (quotient (bit-string-byte-count options) 4)))
-		 (define header0
-		   (bit-string (IP-VERSION :: bits 4)
-			       (header-length :: bits 4)
-			       0 ;; TODO: service type
-			       ((+ (* header-length 4) (bit-string-byte-count body))
-				:: bits 16)
-			       (0 :: bits 16) ;; TODO: identifier
-			       (0 :: bits 3)  ;; TODO: flags
-			       (0 :: bits 13) ;; TODO: fragments
-			       default-ttl
-			       protocol
-			       (0 :: bits 16)
-			       (my-address :: binary bits 32)
-			       (peer-address :: binary bits 32)
-			       (options :: binary)))
-		 (define full-packet (bit-string ((ip-checksum 10 header0) :: binary)
-						 (body :: binary)))
-		 (transition s (spawn-packet-sender interface-name
-						    (state-hwaddr s)
-						    peer-address
-						    full-packet))]
-		[_ #f]))
-	    state0
-	    (compute-gestalt state0)))))
-
-(define arp-result-projection (compile-gestalt-projection (arp-query ? ? (?!))))
-
-(define (spawn-packet-sender interface-name local-hwaddr remote-ip full-packet)
-  (define timer-id (list (gensym 'packet) remote-ip))
-  (list
-   (send (set-timer timer-id 5000 'relative))
-   (spawn (lambda (e s)
-	    (match e
-	      [(routing-update g)
-	       (define all-results
-		 (matcher-key-set/single (gestalt-project g 0 0 #t arp-result-projection)))
-	       (match all-results
-		 [#f (error 'ip "Someone has published a wildcard arp result")]
-		 [(? set-empty?) #f] ;; no results yet, keep waiting
-		 [_
-		  (define remote-hwaddr (set-first all-results))
-		  (unless (= 1 (set-count all-results))
-		    (log-warning "Ambiguous arp result for ~a: ~v"
-				 (ip-address->hostname remote-ip)
-				 all-results))
-		  (transition s
-			      (list
-			       (send (ethernet-packet (ethernet-interface interface-name
-									  local-hwaddr)
-						      #f
-						      local-hwaddr
-						      remote-hwaddr
-						      IPv4-ethertype
-						      full-packet))
-			       (quit)))])]
-	      [(message (timer-expired _ _) _ _)
-	       (log-warning "ARP lookup failed, packet dropped")
-	       (transition s (quit))]
-	      [_ #f]))
-	  (void)
-	  (gestalt-union (sub (timer-expired timer-id ?))
-			 (sub (arp-query IPv4-ethertype remote-ip ?) #:level 1)))))
-
-(define (spawn-icmp-driver my-address)
-  (spawn (lambda (e s)
-	   (match e
-	     [(message (ip-packet peer-address _ _ _ body) _ _)
-	      (bit-string-case body
-		([ type code (checksum :: integer bytes 2) (rest :: binary) ] ;; TODO: check cksum
-		 (case type
-		   [(8) ;; ECHO (0 is ECHO-REPLY)
-		    (log-info "Ping of ~a from ~a"
-			      (pretty-bytes my-address)
-			      (pretty-bytes peer-address))
-		    (define reply-data0 (bit-string 0
-						    code
-						    (0 :: integer bytes 2) ;; TODO
-						    (rest :: binary)))
-		    (transition s (send (ip-packet my-address
-						   peer-address
-						   PROTOCOL-ICMP
-						   #""
-						   (ip-checksum 2 reply-data0))))]
-		   [else
-		    (log-info "ICMP ~a/~a (cksum ~a) to ~a from ~a:\n~a"
-			      type
-			      code
-			      checksum
-			      (pretty-bytes my-address)
-			      (pretty-bytes peer-address)
-			      (dump-bytes->string rest))
-		    #f]))
-		(else #f))]
-	     [_ #f]))
-	 (void)
-	 (gestalt-union (pub (ip-packet my-address ? PROTOCOL-ICMP ? ?))
-			(sub (ip-packet ? my-address PROTOCOL-ICMP ? ?)))))
+(define (lookup-arp ipaddr query-interface-pattern base-gestalt k)
+  (on-gestalt (lambda (_g arp-results)
+		(if (not arp-results)
+		    (error 'ip "Someone has published a wildcard arp result")
+		    (and (not (set-empty? arp-results))
+			 (match (set-first arp-results)
+			   [(list interface hwaddr)
+			    (log-info "ARP lookup yielded ~a on ~a for ~a"
+				      (pretty-bytes hwaddr)
+				      (ethernet-interface-name interface)
+				      (ip-address->hostname ipaddr))
+			    (when (> (set-count arp-results) 1)
+			      (log-warning "Ambiguous ARP result for ~a: ~v"
+					   (ip-address->hostname ipaddr)
+					   arp-results))
+			    (k interface hwaddr)]))))
+	      base-gestalt
+	      (project-pubs (arp-query IPv4-ethertype ipaddr (?! query-interface-pattern) (?!)))
+	      #:timeout-msec 5000
+	      #:on-timeout (lambda ()
+			     (log-warning "ARP lookup of ~a failed, packet dropped"
+					  (ip-address->hostname ipaddr))
+			     '())))
diff --git a/main.rkt b/main.rkt
index fb6d194..ff4fd5c 100644
--- a/main.rkt
+++ b/main.rkt
@@ -2,28 +2,35 @@
 
 (require minimart/demand-matcher)
 (require minimart/drivers/timer)
+(require "configuration.rkt")
 (require "ethernet.rkt")
 (require "arp.rkt")
 (require "ip.rkt")
 (require "tcp.rkt")
 
-(define interface "vboxnet0")
-
 ;;(log-events-and-actions? #t)
 
 (spawn-timer-driver)
 (spawn-ethernet-driver)
-(spawn-arp-driver interface)
-(spawn-ip-driver interface (bytes 192 168 56 222))
+(spawn-arp-driver)
+(spawn-ip-driver)
 (spawn-tcp-driver)
 
+(spawn (lambda (e s) #f)
+       (void)
+       (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)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (let ()
   (local-require racket/set racket/string)
 
   (define (spawn-session them us)
     (define user (gensym 'user))
-    (define remote-detector (compile-gestalt-projection (?!)))
-    (define peer-detector (compile-gestalt-projection `(,(?!) says ,?)))
+    (define remote-detector (project-pubs #:meta-level 1 (?!)))
+    (define peer-detector (project-pubs `(,(?!) says ,?)))
     (define (send-to-remote fmt . vs)
       (send #:meta-level 1 (tcp-channel us them (string->bytes/utf-8 (apply format fmt vs)))))
     (define (say who fmt . vs)
@@ -38,12 +45,10 @@
 		     [(message `(,who says ,what) 0 #f)
 		      (transition old-peers (say who "says: ~a" what))]
 		     [(routing-update g)
-		      (define new-peers
-			(matcher-key-set/single (gestalt-project g 0 0 #t peer-detector)))
+		      (define new-peers (gestalt-project/single g peer-detector))
 		      (transition
 		       new-peers
-		       (list (when (matcher-empty? (gestalt-project g 1 0 #t remote-detector))
-			       (quit))
+		       (list (when (matcher-empty? (gestalt-project g remote-detector)) (quit))
 			     (for/list [(who (set-subtract new-peers old-peers))]
 			       (say who "arrived."))
 			     (for/list [(who (set-subtract old-peers new-peers))]
@@ -68,15 +73,18 @@
 	 (local-require racket/pretty)
 	 (match e
 	   [(message m _ _)
-	    (pretty-write `(MAIN ,m))]
+	    ;; (pretty-write `(MAIN ,m))
+	    (void)]
 	   [(routing-update g)
-	    (printf "MAIN gestalt:\n")
-	    (pretty-print-gestalt g)]
+	    ;; (printf "MAIN gestalt:\n")
+	    ;; (pretty-print-gestalt g)
+	    (void)]
 	   [_ (void)])
 	 (flush-output)
 	 #f)
        (void)
        (gestalt-union
-	;;(sub ? #:level 5)
-	(sub (tcp-channel ? ? ?) #:level 5)
+	(sub ? #:level 5)
+	(pub ? #:level 5)
+	;;(sub (tcp-channel ? ? ?) #:level 5)
 	))
diff --git a/tcp.rkt b/tcp.rkt
index 62d9716..0bbfe34 100644
--- a/tcp.rkt
+++ b/tcp.rkt
@@ -70,10 +70,8 @@
 (struct port-allocator-state (used-ports local-ips) #:transparent)
 
 (define (spawn-port-allocator)
-  (define port-projection (tcp-channel (tcp-address (?!) (?!)) (tcp-address (?!) (?!)) ?))
-  (define port-compproj (compile-gestalt-projection port-projection))
-  (define ip-projection (ip-interface (?!) ?))
-  (define ip-compproj (compile-gestalt-projection ip-projection))
+  (define port-projection
+    (project-subs (tcp-channel (tcp-address (?!) (?!)) (tcp-address (?!) (?!)) ?)))
 
   ;; TODO: Choose a sensible IP address for the outbound connection.
   ;; We don't have enough information to do this well at the moment,
@@ -90,18 +88,17 @@
   (spawn (lambda (e s)
 	   (match e
 	     [(routing-update g)
-	      (define extracted-ips (matcher-key-set (gestalt-project g 0 0 #t ip-compproj)))
-	      (define extracted-ports (matcher-key-set (gestalt-project g 0 0 #f port-compproj)))
-	      (if (or (not extracted-ports) (not extracted-ips))
+	      (define local-ips (gestalt->local-ip-addresses g))
+	      (define extracted-ports (gestalt-project/keys g port-projection))
+	      (if (or (not extracted-ports) (not local-ips))
 		  (error 'tcp "Someone has published a wildcard TCP address or IP interface")
-		  (transition (let ((local-ips (for/set [(e (in-set extracted-ips))] (car e))))
-				(port-allocator-state
-				 (for/fold [(s (set))] [(e (in-set extracted-ports))]
-				   (match-define (list si sp di dp) e)
-				   (let* ((s (if (set-member? local-ips si) (set-add s sp) s))
-					  (s (if (set-member? local-ips di) (set-add s dp) s)))
-				     s))
-				 local-ips))
+		  (transition (port-allocator-state
+			       (for/fold [(s (set))] [(e (in-set extracted-ports))]
+				 (match-define (list si sp di dp) e)
+				 (let* ((s (if (set-member? local-ips si) (set-add s sp) s))
+					(s (if (set-member? local-ips di) (set-add s dp) s)))
+				   s))
+			       local-ips)
 			      '()))]
 	     [(message (tcp-port-allocation-request local-addr remote-addr) _ _)
 	      (define currently-used-ports (port-allocator-state-used-ports s))
@@ -117,8 +114,8 @@
 	     [_ #f]))
 	 (port-allocator-state (set) (set))
 	 (gestalt-union (sub (tcp-port-allocation-request ? ?))
-			(sub (projection->pattern ip-projection) #:level 1)
-			(pub (projection->pattern port-projection) #:level 1))))
+			observe-local-ip-addresses-gestalt
+			(pub (tcp-channel (tcp-address ? ?) (tcp-address ? ?) ?) #:level 1))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Relay between kernel-level and user-level
@@ -159,17 +156,12 @@
 
 (define PROTOCOL-TCP 6)
 
-(struct codec-state (active-state-vectors) #:transparent)
+(struct codec-state (local-ips active-state-vectors) #:transparent)
 
 (define (spawn-kernel-tcp-driver)
 
-  (define (flip-statevec statevec)
-    (match-define (list si sp di dp) statevec)
-    (list di dp si sp))
-
   (define (state-vector-active? statevec s)
-    (or (set-member? (codec-state-active-state-vectors s) statevec)
-	(set-member? (codec-state-active-state-vectors s) (flip-statevec statevec))))
+    (set-member? (codec-state-active-state-vectors s) statevec))
 
   (define (analyze-incoming-packet src-ip dst-ip body s)
     (bit-string-case body
@@ -237,14 +229,15 @@
 	   (else #f))))
       (else #f)))
 
-  (define statevec-projection
-    (compile-gestalt-projection
-     (tcp-packet ? (?!) (?!) (?!) (?!) ? ? ? ? ? ?)))
+  (define statevec-projection (project-subs (tcp-packet ? (?!) (?!) (?!) (?!) ? ? ? ? ? ?)))
 
   (define (analyze-gestalt g s)
-    (define statevecs (matcher-key-set (gestalt-project g 0 0 #f statevec-projection)))
-    (log-info "gestalt yielded statevecs ~v" statevecs)
-    (transition (struct-copy codec-state s [active-state-vectors statevecs]) '()))
+    (define local-ips (gestalt->local-ip-addresses g))
+    (define statevecs (gestalt-project/keys 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]
+		  [active-state-vectors statevecs]) '()))
 
   (define (deliver-outbound-packet p s)
     (match-define (tcp-packet #f
@@ -294,26 +287,29 @@
 				      0
 				      PROTOCOL-TCP
 				      ((bit-string-byte-count payload) :: integer bytes 2)))
-    (transition s (send (ip-packet src-ip dst-ip PROTOCOL-TCP #""
+    (transition s (send (ip-packet #f src-ip dst-ip PROTOCOL-TCP #""
 				   (ip-checksum 16 payload #:pseudo-header pseudo-header)))))
 
   (spawn (lambda (e s)
+	   (log-info "xxxxx TCP ~v" e)
 	   (match e
 	     [(routing-update g)
 	      (analyze-gestalt g s)]
-	     [(message (ip-packet src dst _ _ body) _ _)
+	     [(message (ip-packet source-if src dst _ _ body) _ _)
+	      #:when (and source-if ;; source-if == #f iff packet originates locally
+			  (set-member? (codec-state-local-ips s) dst))
 	      (analyze-incoming-packet src dst body s)]
 	     [(message (? tcp-packet? p) _ _)
 	      #:when (not (tcp-packet-from-wire? p))
 	      (deliver-outbound-packet p s)]
 	     [_ #f]))
-	 (codec-state (set))
-	 (gestalt-union (pub (ip-packet ? ? PROTOCOL-TCP ? ?))
-			(sub (ip-packet ? ? PROTOCOL-TCP ? ?))
+	 (codec-state (set) (set))
+	 (gestalt-union (pub (ip-packet #f ? ? PROTOCOL-TCP ? ?))
+			(sub (ip-packet ? ? ? PROTOCOL-TCP ? ?))
 			(sub (tcp-packet #f ? ? ? ? ? ? ? ? ? ?))
 			(pub (tcp-packet #t ? ? ? ? ? ? ? ? ? ?))
-			(pub (tcp-packet #t ? ? ? ? ? ? ? ? ? ?)
-			     #:level 1))))
+			(pub (tcp-packet #t ? ? ? ? ? ? ? ? ? ?) #:level 1)
+			observe-local-ip-addresses-gestalt)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Per-connection state vector process