Reask ARP questions periodically until we get answers or stop caring.
This commit is contained in:
parent
61c59250ee
commit
39b19ba624
93
arp.rkt
93
arp.rkt
|
@ -78,7 +78,7 @@
|
||||||
(cache-value-interface v)
|
(cache-value-interface v)
|
||||||
(cache-value-address v)))))))
|
(cache-value-address v)))))))
|
||||||
|
|
||||||
(define (build-packet s dest-mac ptype oper sender-ha sender-pa target-ha target-pa)
|
(define (build-packet dest-mac ptype oper sender-ha sender-pa target-ha target-pa)
|
||||||
(define hlen (bytes-length target-ha))
|
(define hlen (bytes-length target-ha))
|
||||||
(define plen (bytes-length target-pa))
|
(define plen (bytes-length target-pa))
|
||||||
(define packet (bit-string->bytes
|
(define packet (bit-string->bytes
|
||||||
|
@ -118,12 +118,19 @@
|
||||||
(define sender-protocol-address (bit-string->bytes sender-protocol-address0))
|
(define sender-protocol-address (bit-string->bytes sender-protocol-address0))
|
||||||
(define sender-hardware-address (bit-string->bytes sender-hardware-address0))
|
(define sender-hardware-address (bit-string->bytes sender-hardware-address0))
|
||||||
(define target-protocol-address (bit-string->bytes target-protocol-address0))
|
(define target-protocol-address (bit-string->bytes target-protocol-address0))
|
||||||
;; (log-info "~a ARP Adding ~a = ~a to cache"
|
(define learned-key (cache-key ptype sender-protocol-address))
|
||||||
;; interface-name
|
(when (and (set-member? (state-queries s) learned-key) ;; it is relevant to our interests
|
||||||
;; (pretty-bytes sender-protocol-address)
|
(not (equal? sender-hardware-address
|
||||||
;; (pretty-bytes sender-hardware-address))
|
(cache-value-address (hash-ref (state-cache s)
|
||||||
|
learned-key
|
||||||
|
(lambda ()
|
||||||
|
(cache-value #f #f #f)))))))
|
||||||
|
(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))
|
(define cache (hash-set (expire-cache (state-cache s))
|
||||||
(cache-key ptype sender-protocol-address)
|
learned-key
|
||||||
(cache-value (+ (current-inexact-milliseconds)
|
(cache-value (+ (current-inexact-milliseconds)
|
||||||
cache-entry-lifetime-msec)
|
cache-entry-lifetime-msec)
|
||||||
interface
|
interface
|
||||||
|
@ -135,8 +142,7 @@
|
||||||
[(1) ;; request
|
[(1) ;; request
|
||||||
(if (set-member? (state-assertions s)
|
(if (set-member? (state-assertions s)
|
||||||
(cache-key ptype target-protocol-address))
|
(cache-key ptype target-protocol-address))
|
||||||
(send (build-packet s
|
(send (build-packet sender-hardware-address
|
||||||
sender-hardware-address
|
|
||||||
ptype
|
ptype
|
||||||
2 ;; reply
|
2 ;; reply
|
||||||
hwaddr
|
hwaddr
|
||||||
|
@ -162,51 +168,19 @@
|
||||||
(cache-key ptype pa)))
|
(cache-key ptype pa)))
|
||||||
|
|
||||||
(define (analyze-gestalt g s)
|
(define (analyze-gestalt g s)
|
||||||
(define new-queries (gestalt->queries g))
|
|
||||||
(define new-assertions (gestalt->assertions 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 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 [queries (gestalt->queries g)] [assertions new-assertions]))
|
||||||
(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))
|
|
||||||
['() #f]
|
|
||||||
[(list* k _) (cache-key-address k)]))
|
|
||||||
;; (log-info "analyze-gestalt: g:\n~a" (gestalt->pretty-string g))
|
|
||||||
;; (log-info "analyze-gestalt: new-queries ~v" new-queries)
|
|
||||||
;; (log-info "analyze-gestalt: new-assertions ~v" new-assertions)
|
|
||||||
;; (log-info "analyze-gestalt: added-queries ~v" added-queries)
|
|
||||||
;; (log-info "analyze-gestalt: added-assertions ~v" added-assertions)
|
|
||||||
;; (log-info "analyze-gestalt: unanswered-queries ~v" unanswered-queries)
|
|
||||||
;; (log-info "analyze-gestalt: new-s ~v" new-s)
|
|
||||||
(transition new-s
|
(transition new-s
|
||||||
(list
|
(list
|
||||||
(when (gestalt-empty? (gestalt-filter g (gestalt-for-supply interface-name)))
|
(when (gestalt-empty? (gestalt-filter g (gestalt-for-supply interface-name)))
|
||||||
(quit))
|
(quit))
|
||||||
(for/list [(q (in-set unanswered-queries))]
|
|
||||||
(define pa (some-asserted-pa (cache-key-protocol q)))
|
|
||||||
(log-info "~a ARP Asking for ~a from ~a"
|
|
||||||
interface-name
|
|
||||||
(pretty-bytes (cache-key-address q))
|
|
||||||
(and pa (pretty-bytes pa)))
|
|
||||||
(if pa
|
|
||||||
(send (build-packet new-s
|
|
||||||
broadcast-ethernet-address
|
|
||||||
(cache-key-protocol q)
|
|
||||||
1 ;; request
|
|
||||||
hwaddr
|
|
||||||
pa
|
|
||||||
zero-ethernet-address
|
|
||||||
(cache-key-address q)))
|
|
||||||
'()))
|
|
||||||
(for/list [(a (in-set added-assertions))]
|
(for/list [(a (in-set added-assertions))]
|
||||||
(log-info "~a ARP Announcing ~a as ~a"
|
(log-info "~a ARP Announcing ~a as ~a"
|
||||||
interface-name
|
interface-name
|
||||||
(pretty-bytes (cache-key-address a))
|
(pretty-bytes (cache-key-address a))
|
||||||
(pretty-bytes hwaddr))
|
(pretty-bytes hwaddr))
|
||||||
(send (build-packet new-s
|
(send (build-packet broadcast-ethernet-address
|
||||||
broadcast-ethernet-address
|
|
||||||
(cache-key-protocol a)
|
(cache-key-protocol a)
|
||||||
2 ;; reply -- gratuitous announcement
|
2 ;; reply -- gratuitous announcement
|
||||||
hwaddr
|
hwaddr
|
||||||
|
@ -214,20 +188,47 @@
|
||||||
hwaddr
|
hwaddr
|
||||||
(cache-key-address a)))))))
|
(cache-key-address a)))))))
|
||||||
|
|
||||||
|
(define (send-questions s)
|
||||||
|
(define unanswered-queries
|
||||||
|
(set-subtract (state-queries s) (list->set (hash-keys (state-cache s)))))
|
||||||
|
(define (some-asserted-pa ptype)
|
||||||
|
(match (filter (lambda (k) (equal? (cache-key-protocol k) ptype))
|
||||||
|
(set->list (state-assertions s)))
|
||||||
|
['() #f]
|
||||||
|
[(list* k _) (cache-key-address k)]))
|
||||||
|
(transition s
|
||||||
|
(for/list [(q (in-set unanswered-queries))]
|
||||||
|
(define pa (some-asserted-pa (cache-key-protocol q)))
|
||||||
|
(log-info "~a ARP Asking for ~a from ~a"
|
||||||
|
interface-name
|
||||||
|
(pretty-bytes (cache-key-address q))
|
||||||
|
(and pa (pretty-bytes pa)))
|
||||||
|
(when pa
|
||||||
|
(send (build-packet broadcast-ethernet-address
|
||||||
|
(cache-key-protocol q)
|
||||||
|
1 ;; request
|
||||||
|
hwaddr
|
||||||
|
pa
|
||||||
|
zero-ethernet-address
|
||||||
|
(cache-key-address q)))))))
|
||||||
|
|
||||||
(list (set-wakeup-alarm)
|
(list (set-wakeup-alarm)
|
||||||
(spawn (lambda (e s)
|
(spawn (lambda (e s)
|
||||||
;; (log-info "ARP ~a ~a: ~v // ~v" interface-name (pretty-bytes hwaddr) e s)
|
;; (log-info "ARP ~a ~a: ~v // ~v" interface-name (pretty-bytes hwaddr) e s)
|
||||||
(match e
|
(match e
|
||||||
[(routing-update g)
|
[(routing-update g)
|
||||||
(analyze-gestalt g s)]
|
(sequence-transitions (analyze-gestalt g s)
|
||||||
|
send-questions)]
|
||||||
[(message (ethernet-packet _ _ source destination _ body) _ _)
|
[(message (ethernet-packet _ _ source destination _ body) _ _)
|
||||||
(analyze-incoming-packet source destination body s)]
|
(analyze-incoming-packet source destination body s)]
|
||||||
[(message (timer-expired _ _) _ _)
|
[(message (timer-expired _ _) _ _)
|
||||||
(define new-s (struct-copy state s
|
(define new-s (struct-copy state s
|
||||||
[cache (expire-cache (state-cache s))]))
|
[cache (expire-cache (state-cache s))]))
|
||||||
(transition new-s
|
(define new-g (compute-gestalt (state-cache new-s)))
|
||||||
(list (set-wakeup-alarm)
|
(sequence-transitions (transition new-s
|
||||||
(routing-update (compute-gestalt (state-cache new-s)))))]
|
(list (set-wakeup-alarm)
|
||||||
|
(routing-update new-g)))
|
||||||
|
send-questions)]
|
||||||
[_ #f]))
|
[_ #f]))
|
||||||
(state (hash) (set) (set))
|
(state (hash) (set) (set))
|
||||||
(compute-gestalt (hash)))))
|
(compute-gestalt (hash)))))
|
||||||
|
|
Loading…
Reference in New Issue