syndicate-lang
/
marketplace-dns-2014
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Updates for #:meta-level -> inbound/outbound and for (actor(relay...))->(actor...)

This commit is contained in:
Tony Garnock-Jones 2016-09-05 14:33:28 +01:00
parent b7bdb4065e
commit aea344fd81
1 changed files with 25 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
tk-dns.rkt
View File

@ -23,6 +23,7 @@
(require racket/match)
(require "codec.rkt")
(require syndicate/actor)
(require syndicate/protocol/standard-relay)
(require syndicate/drivers/udp)
(provide (struct-out bad-dns-packet)
@ -38,38 +39,35 @@
(define (dns-read-driver s)
(actor
(forever
(on (message (udp-packet $source s #"") #:meta-level 1)
(log-info "Debug dump packet received")
(send! `(debug-dump)))
(on (message (udp-packet $source s $body) #:meta-level 1)
(send!
(with-handlers ((exn:fail? (lambda (e)
(bad-dns-packet body source s 'unparseable))))
(define message (packet->dns-message body))
(case (dns-message-direction message)
((request) (dns-request message source s))
((response) (dns-reply message source s)))))))))
(on (message (inbound (udp-packet $source s #"")))
(log-info "Debug dump packet received")
(send! `(debug-dump)))
(on (message (inbound (udp-packet $source s $body)))
(send!
(with-handlers ((exn:fail? (lambda (e)
(bad-dns-packet body source s 'unparseable))))
(define message (packet->dns-message body))
(case (dns-message-direction message)
((request) (dns-request message source s))
((response) (dns-reply message source s))))))))
(define (translate message s sink)
(with-handlers ((exn:fail? (lambda (e)
(send! (bad-dns-packet message s sink 'unencodable)))))
(send! #:meta-level 1 (udp-packet s sink (dns-message->packet message)))))
(send! (outbound (udp-packet s sink (dns-message->packet message))))))
(define (dns-write-driver s)
(actor (forever
(on (message (dns-request $message s $sink))
(translate message s sink))
(on (message (dns-reply $message s $sink))
(translate message s sink)))))
(actor (on (message (dns-request $message s $sink))
(translate message s sink))
(on (message (dns-reply $message s $sink))
(translate message s sink))))
(define (dns-spy)
(actor (forever
(on (message (dns-request $message $source $sink))
(log-info (format "DNS: ~v asks ~v ~v~n : ~v"
source sink (dns-message-id message)
(dns-message-questions message))))
(on (message (dns-reply $message $source $sink))
(log-info (format "DNS: ~v answers ~v~n : ~v"
source sink
message))))))
(actor (on (message (dns-request $message $source $sink))
(log-info (format "DNS: ~v asks ~v ~v~n : ~v"
source sink (dns-message-id message)
(dns-message-questions message))))
(on (message (dns-reply $message $source $sink))
(log-info (format "DNS: ~v answers ~v~n : ~v"
source sink
message)))))