diff --git a/README.md b/README.md
index e97cbd3..5472577 100644
--- a/README.md
+++ b/README.md
@@ -2,7 +2,7 @@
This is a [Racket](http://racket-lang.org/) implementation of a DNS
server and iterative resolver. It's written to work with
-[Marketplace](https://github.com/tonyg/marketplace), but could readily
+[Syndicate](https://github.com/tonyg/syndicate), but could readily
be adapted to work with other I/O substrates. (It originally used
Racket's `sync` and events directly.)
@@ -18,9 +18,9 @@ equal to Racket 6.0 should work. Racket releases can be downloaded
Once you have Racket installed,
- raco pkg install marketplace bitsyntax
+ raco pkg install syndicate bitsyntax
-to install Marketplace (note: will take a long time) and
+to install Syndicate and
[bitsyntax](https://github.com/tonyg/racket-bitsyntax/), and then
raco make driver.rkt proxy.rkt
diff --git a/api-untyped.rkt b/api-untyped.rkt
index 4c9dce1..4ec6964 100644
--- a/api-untyped.rkt
+++ b/api-untyped.rkt
@@ -20,8 +20,6 @@
;;; along with marketplace-dns. If not, see
;;; .
-(require marketplace/struct-map)
-
(provide (struct-out domain)
downcase-labels
make-domain)
@@ -37,10 +35,7 @@
(struct domain (labels downcased-labels)
#:transparent
- #:property prop:equal+hash (list domain=? domain-hash-1/2 domain-hash-1/2)
- #:property prop:struct-map (lambda (f seed x)
- (let-values (((labels seed) (f (domain-labels x) seed)))
- (values (make-domain labels) seed))))
+ #:property prop:equal+hash (list domain=? domain-hash-1/2 domain-hash-1/2))
;; ListOf -> ListOf
;; Converts the 7-bit ASCII bytes in the argument to lower-case
diff --git a/api.rkt b/api.rkt
index 1067e68..2862400 100644
--- a/api.rkt
+++ b/api.rkt
@@ -63,8 +63,7 @@
(require "mapping.rkt")
(require racket/set)
(require racket/match)
-(require marketplace)
-(require marketplace/struct-map)
+(require syndicate)
;; A DomainName is a (domain ListOf), representing a domain
;; name. The head of the list is the leftmost label; for example,
diff --git a/driver.rkt b/driver.rkt
index 897578f..e3046d0 100644
--- a/driver.rkt
+++ b/driver.rkt
@@ -28,9 +28,9 @@
(require "codec.rkt")
(require "zonedb.rkt")
(require "resolver.rkt")
-(require marketplace/sugar)
-(require marketplace/support/spy)
-(require marketplace/drivers/udp)
+(require syndicate/ground)
+(require syndicate/actor)
+(require syndicate/drivers/udp)
(require "tk-dns.rkt")
;; Instantiated with a SOA record for the zone it is serving as well
@@ -58,18 +58,16 @@
(display ";; Ready.\n")
- (ground-vm (udp-driver)
- (generic-spy 'UDP)
- (spawn-vm
- (spawn (dns-spy))
- (spawn (dns-read-driver local-addr))
- (spawn (dns-write-driver local-addr))
- (subscriber (bad-dns-packet (wild) (wild) (wild) (wild))
- (on-message [p (begin (log-error (pretty-format p)) '())]))
- (subscriber (dns-request (wild) (wild) (wild))
- (on-message [(? dns-request? r)
- (let ((reply (handle-request soa-rr zone r)))
- (when reply (send-message reply)))])))))
+ (run-ground (spawn-udp-driver)
+ (dataspace (dns-spy)
+ (dns-read-driver local-addr)
+ (dns-write-driver local-addr)
+ (forever
+ (on (message ($ p (bad-dns-packet _ _ _ _)))
+ (log-error (pretty-format p)))
+ (on (message ($ r (dns-request _ _ _)))
+ (let ((reply (handle-request soa-rr zone r)))
+ (when reply (send! reply))))))))
;; (define-type ReplyMaker (DomainName Boolean (Setof RR) (Setof RR) (Setof RR) -> DNSMessage))
diff --git a/network-query.rkt b/network-query.rkt
index bebaf30..b72535c 100644
--- a/network-query.rkt
+++ b/network-query.rkt
@@ -23,9 +23,9 @@
(require "api.rkt")
(require "codec.rkt")
(require "zonedb.rkt")
-(require marketplace/sugar)
-(require marketplace/drivers/udp)
-(require marketplace/drivers/timer)
+(require syndicate/actor)
+(require syndicate/drivers/udp)
+(require syndicate/drivers/timer)
(require "tk-dns.rkt")
(provide network-query
@@ -228,14 +228,14 @@
;; UdpAddress Question DomainName (Listof DomainName) Any ->
;; (Action ParentState)))
(define (network-query s q zone-origin server-names unique-id)
- (name-process (list 'network-query q)
- (spawn (try-next-server
- (network-query-state (network-request s q zone-origin server-names unique-id)
- first-timeout
- #hash()
- '()
- #f
- server-names)))))
+ (spawn #:name (list 'network-query q)
+ (try-next-server
+ (network-query-state (network-request s q zone-origin server-names unique-id)
+ first-timeout
+ #hash()
+ '()
+ #f
+ server-names))))
;; (: try-next-server : NetworkQueryState -> (Transition NetworkQueryState))
(define (try-next-server w)
diff --git a/proxy.rkt b/proxy.rkt
index 597879e..a3cc58e 100644
--- a/proxy.rkt
+++ b/proxy.rkt
@@ -28,10 +28,10 @@
(require "zonedb.rkt")
(require "network-query.rkt")
(require "resolver.rkt")
-(require marketplace/sugar)
-(require marketplace/support/spy)
-(require marketplace/drivers/timer)
-(require marketplace/drivers/udp)
+(require syndicate)
+(require syndicate/actor)
+(require syndicate/drivers/timer)
+(require syndicate/drivers/udp)
(require "tk-dns.rkt")
(require racket/pretty)
diff --git a/tk-dns.rkt b/tk-dns.rkt
index 9e80332..1cc24b5 100644
--- a/tk-dns.rkt
+++ b/tk-dns.rkt
@@ -22,8 +22,8 @@
(require racket/set)
(require racket/match)
(require "codec.rkt")
-(require marketplace/sugar)
-(require marketplace/drivers/udp)
+(require syndicate/actor)
+(require syndicate/drivers/udp)
(provide (struct-out bad-dns-packet)
(struct-out dns-request)
@@ -36,55 +36,40 @@
(struct dns-request (message source sink) #:transparent)
(struct dns-reply (message source sink) #:transparent)
-;; (: dns-read-driver : UdpAddress -> (Transition Void))
(define (dns-read-driver s)
- (transition (void)
- (at-meta-level
- (subscriber (udp-packet (wild) s (wild))
- (on-message
- [(udp-packet source (== s) #"")
- (begin (log-info "Debug dump packet received")
- (send-message `(debug-dump)))]
- [(udp-packet source (== s) body)
- (send-message
- (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)))))])))))
+ (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)))))))))
+
+(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)))))
-;; (: dns-write-driver : UdpAddress -> (Transition Void))
(define (dns-write-driver s)
- ;; (: translate : DNSMessage UdpAddress -> (ActionTree Void))
- (define (translate message sink)
- (with-handlers ((exn:fail? (lambda (e)
- (send-message (bad-dns-packet message s sink 'unencodable)))))
- (at-meta-level
- (send-message (udp-packet s sink (dns-message->packet message))))))
- (transition (void)
- (subscriber (dns-request (wild) s (wild))
- (on-message
- [(dns-request message (== s) sink) (translate message sink)]))
- (subscriber (dns-reply (wild) s (wild))
- (on-message
- [(dns-reply message (== s) sink) (translate message sink)]))))
+ (actor (forever
+ (on (message (dns-request $message s $sink))
+ (translate message s sink))
+ (on (message (dns-reply $message s $sink))
+ (translate message s sink)))))
-;; (: dns-spy : -> (Transition Void))
(define (dns-spy)
- (transition (void)
- (observe-publishers (wild)
- (on-message
- [(dns-request message source sink)
- (begin (log-info (format "DNS: ~v asks ~v ~v~n : ~v"
- source sink (dns-message-id message)
- (dns-message-questions message)))
- (void))]
- [(dns-reply message source sink)
- (begin (log-info (format "DNS: ~v answers ~v~n : ~v"
- source sink
- message))
- (void))]
- [x
- (begin (log-info (format "DNS: ~v" x))
- (void))]))))
+ (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))))))