Use matcher-key-set/single and set-first
This commit is contained in:
parent
c5530c7b9c
commit
ccc5775f00
17
ethernet.rkt
17
ethernet.rkt
|
@ -122,15 +122,14 @@
|
||||||
(compile-gestalt-projection (ethernet-packet (ethernet-interface interface-name (?!)) ? ? ? ? ?)))
|
(compile-gestalt-projection (ethernet-packet (ethernet-interface interface-name (?!)) ? ? ? ? ?)))
|
||||||
|
|
||||||
(define (gestalt->hwaddr g interface-name)
|
(define (gestalt->hwaddr g interface-name)
|
||||||
(define hwaddrs (matcher-key-set (gestalt-project g 0 0 #t (hwaddr-projection interface-name))))
|
(define hwaddrs
|
||||||
(match (set->list hwaddrs)
|
(matcher-key-set/single (gestalt-project g 0 0 #t (hwaddr-projection interface-name))))
|
||||||
['() #f]
|
(case (set-count hwaddrs)
|
||||||
[(list (list h)) h]
|
[(0) #f]
|
||||||
[(and hs (list* (list h) _))
|
[(1) (set-first hwaddrs)]
|
||||||
(log-warning "gestalt->hwaddr: multiple addresses for interface ~a: ~v"
|
[else
|
||||||
interface-name
|
(log-warning "gestalt->hwaddr: multiple addresses for interface ~a: ~v" interface-name hwaddrs)
|
||||||
hs)
|
(set-first hwaddrs)]))
|
||||||
h]))
|
|
||||||
|
|
||||||
(define (ethernet-packet-pattern interface-name from-wire? ethertype)
|
(define (ethernet-packet-pattern interface-name from-wire? ethertype)
|
||||||
(ethernet-packet (ethernet-interface interface-name ?) from-wire? ? ? ethertype ?))
|
(ethernet-packet (ethernet-interface interface-name ?) from-wire? ? ? ethertype ?))
|
||||||
|
|
10
ip.rkt
10
ip.rkt
|
@ -141,13 +141,13 @@
|
||||||
(match e
|
(match e
|
||||||
[(routing-update g)
|
[(routing-update g)
|
||||||
(define all-results
|
(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
|
(match all-results
|
||||||
[#f (error 'ip "Someone has published a wildcard arp result")]
|
[#f (error 'ip "Someone has published a wildcard arp result")]
|
||||||
['() ;; no results yet, keep waiting
|
[(? set-empty?) #f] ;; no results yet, keep waiting
|
||||||
#f]
|
[_
|
||||||
[(list* (list remote-hwaddr) rest)
|
(define remote-hwaddr (set-first all-results))
|
||||||
(unless (null? rest)
|
(unless (= 1 (set-count all-results))
|
||||||
(log-warning "Ambiguous arp result for ~a: ~v"
|
(log-warning "Ambiguous arp result for ~a: ~v"
|
||||||
(ip-address->hostname remote-ip)
|
(ip-address->hostname remote-ip)
|
||||||
all-results))
|
all-results))
|
||||||
|
|
Loading…
Reference in New Issue