Use matcher-key-set/single and set-first

This commit is contained in:
Tony Garnock-Jones 2014-06-17 17:01:22 -04:00
parent c5530c7b9c
commit ccc5775f00
2 changed files with 13 additions and 14 deletions

View File

@ -122,15 +122,14 @@
(compile-gestalt-projection (ethernet-packet (ethernet-interface interface-name (?!)) ? ? ? ? ?)))
(define (gestalt->hwaddr g interface-name)
(define hwaddrs (matcher-key-set (gestalt-project g 0 0 #t (hwaddr-projection interface-name))))
(match (set->list hwaddrs)
['() #f]
[(list (list h)) h]
[(and hs (list* (list h) _))
(log-warning "gestalt->hwaddr: multiple addresses for interface ~a: ~v"
interface-name
hs)
h]))
(define hwaddrs
(matcher-key-set/single (gestalt-project g 0 0 #t (hwaddr-projection interface-name))))
(case (set-count hwaddrs)
[(0) #f]
[(1) (set-first hwaddrs)]
[else
(log-warning "gestalt->hwaddr: multiple addresses for interface ~a: ~v" interface-name hwaddrs)
(set-first hwaddrs)]))
(define (ethernet-packet-pattern interface-name from-wire? ethertype)
(ethernet-packet (ethernet-interface interface-name ?) from-wire? ? ? ethertype ?))

10
ip.rkt
View File

@ -141,13 +141,13 @@
(match e
[(routing-update g)
(define all-results
(set->list (matcher-key-set (gestalt-project g 0 0 #t arp-result-projection))))
(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")]
['() ;; no results yet, keep waiting
#f]
[(list* (list remote-hwaddr) rest)
(unless (null? rest)
[(? 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))