Fix up patterns for new stricter TR checking.
This commit is contained in:
parent
c4fa8e1881
commit
d6af03bf02
|
@ -64,10 +64,10 @@
|
||||||
(spawn: #:parent : Void #:child : Void (dns-spy))
|
(spawn: #:parent : Void #:child : Void (dns-spy))
|
||||||
(spawn: #:parent : Void #:child : Void (dns-read-driver local-addr))
|
(spawn: #:parent : Void #:child : Void (dns-read-driver local-addr))
|
||||||
(spawn: #:parent : Void #:child : Void (dns-write-driver local-addr))
|
(spawn: #:parent : Void #:child : Void (dns-write-driver local-addr))
|
||||||
(endpoint: : Void #:subscriber (bad-dns-packet (wild) (wild) (wild) (wild))
|
(endpoint: : Void #:subscriber (bad-dns-packet-pattern (wild) (wild) (wild) (wild))
|
||||||
[p (begin (log-error (pretty-format p))
|
[p (begin (log-error (pretty-format p))
|
||||||
'())])
|
'())])
|
||||||
(endpoint: : Void #:subscriber (dns-request (wild) (wild) (wild))
|
(endpoint: : Void #:subscriber (dns-request-pattern (wild) (wild) (wild))
|
||||||
[(? dns-request? r)
|
[(? dns-request? r)
|
||||||
(begin (define reply (handle-request soa-rr zone r))
|
(begin (define reply (handle-request soa-rr zone r))
|
||||||
(when reply (send-message reply)))]))))
|
(when reply (send-message reply)))]))))
|
||||||
|
|
|
@ -285,7 +285,7 @@
|
||||||
[remaining-names remaining-names]) : NetworkQueryState
|
[remaining-names remaining-names]) : NetworkQueryState
|
||||||
(send-message subq)
|
(send-message subq)
|
||||||
(endpoint: w : NetworkQueryState
|
(endpoint: w : NetworkQueryState
|
||||||
#:subscriber (answered-question subq (wild))
|
#:subscriber (answered-question-pattern subq (wild))
|
||||||
#:let-name subq-id
|
#:let-name subq-id
|
||||||
[(answered-question (== subq) ans)
|
[(answered-question (== subq) ans)
|
||||||
(let ((ips (map make-dns-address
|
(let ((ips (map make-dns-address
|
||||||
|
@ -357,7 +357,7 @@
|
||||||
(send-message (set-timer timeout-id (* timeout 1000) 'relative))
|
(send-message (set-timer timeout-id (* timeout 1000) 'relative))
|
||||||
;; TODO: Restore this to a "join" when proper pattern-unions are implemented
|
;; TODO: Restore this to a "join" when proper pattern-unions are implemented
|
||||||
(endpoint: w : NetworkQueryState
|
(endpoint: w : NetworkQueryState
|
||||||
#:subscriber (timer-expired timeout-id (wild))
|
#:subscriber (timer-expired-pattern timeout-id (wild))
|
||||||
#:name timeout-id
|
#:name timeout-id
|
||||||
[(timer-expired (== timeout-id) _)
|
[(timer-expired (== timeout-id) _)
|
||||||
(begin
|
(begin
|
||||||
|
@ -370,7 +370,7 @@
|
||||||
(delete-endpoint reply-wait-id)
|
(delete-endpoint reply-wait-id)
|
||||||
(send-message (list 'release-query-id query-id))))])
|
(send-message (list 'release-query-id query-id))))])
|
||||||
(endpoint: w : NetworkQueryState
|
(endpoint: w : NetworkQueryState
|
||||||
#:subscriber (dns-reply (wild) (wild) s)
|
#:subscriber (dns-reply-pattern (wild) (wild) s)
|
||||||
#:name reply-wait-id
|
#:name reply-wait-id
|
||||||
[(dns-reply reply-message source (== s))
|
[(dns-reply reply-message source (== s))
|
||||||
;; TODO: maybe receive only specifically from the queried IP address?
|
;; TODO: maybe receive only specifically from the queried IP address?
|
||||||
|
|
|
@ -256,7 +256,7 @@
|
||||||
(let-values (((new-zone timers) (incorporate-complete-answer answer zone #t)))
|
(let-values (((new-zone timers) (incorporate-complete-answer answer zone #t)))
|
||||||
(transition-and-set-timers new-zone timers))])
|
(transition-and-set-timers new-zone timers))])
|
||||||
(endpoint: zone : CompiledZone
|
(endpoint: zone : CompiledZone
|
||||||
#:subscriber (timer-expired (list 'check-dns-expiry (wild)) (wild))
|
#:subscriber (timer-expired-pattern (list 'check-dns-expiry (wild)) (wild))
|
||||||
[(timer-expired (list 'check-dns-expiry (? domain? name)) (? number? now-msec))
|
[(timer-expired (list 'check-dns-expiry (? domain? name)) (? number? now-msec))
|
||||||
(transition: (zone-expire-name zone name (/ now-msec 1000.0)) : CompiledZone)])))
|
(transition: (zone-expire-name zone name (/ now-msec 1000.0)) : CompiledZone)])))
|
||||||
|
|
||||||
|
|
|
@ -101,10 +101,10 @@
|
||||||
(send-message (udp-packet s sink (dns-message->packet message))))))
|
(send-message (udp-packet s sink (dns-message->packet message))))))
|
||||||
(transition: (void) : Void
|
(transition: (void) : Void
|
||||||
(endpoint: : Void
|
(endpoint: : Void
|
||||||
#:subscriber (dns-request (wild) s (wild))
|
#:subscriber (dns-request-pattern (wild) s (wild))
|
||||||
[(dns-request message (== s) sink) (translate message sink)])
|
[(dns-request message (== s) sink) (translate message sink)])
|
||||||
(endpoint: : Void
|
(endpoint: : Void
|
||||||
#:subscriber (dns-reply (wild) s (wild))
|
#:subscriber (dns-reply-pattern (wild) s (wild))
|
||||||
[(dns-reply message (== s) sink) (translate message sink)])))
|
[(dns-reply message (== s) sink) (translate message sink)])))
|
||||||
|
|
||||||
(: dns-spy : -> (Transition Void))
|
(: dns-spy : -> (Transition Void))
|
||||||
|
|
Loading…
Reference in New Issue