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

First steps of port to typed-matrix kernel.

This commit is contained in:
Tony Garnock-Jones 2012-10-31 16:48:43 -04:00
parent 7aa56a424d
commit 8ad9dd34a2
10 changed files with 88 additions and 89 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
api.rkt
View File

@ -54,7 +54,7 @@
#:transparent
#:property prop:equal+hash (list domain=? domain-hash-1/2 domain-hash-1/2))
(require "../racket-matrix/struct-map.rkt")
(require racket-typed-matrix/struct-map)
(install-struct-mapper! struct:domain
(lambda (f seed x)
(let-values (((labels seed) (f (domain-labels x) seed)))

2
codec.rkt
View File

@ -18,7 +18,7 @@
(require "mapping.rkt")
(require racket/match)
(require "../racket-bitsyntax/main.rkt")
(require racket-bitsyntax)
;; An Opcode is a Symbol or a Number, one of the possibilities given
;; in the following define-mapping. It represents a DNS message

35
driver.rkt
View File

@ -5,14 +5,15 @@
(require racket/match)
(require racket/set)
(require racket/bool)
(require "../racket-bitsyntax/main.rkt")
(require racket-bitsyntax)
(require "api.rkt")
(require "codec.rkt")
(require "zonedb.rkt")
(require "resolver.rkt")
(require "../racket-matrix/os2.rkt")
(require "../racket-matrix/os2-udp.rkt")
(require "os2-dns.rkt")
(require racket-typed-matrix/sugar-untyped)
(require racket-typed-matrix/support/spy)
(require racket-typed-matrix/drivers/udp-untyped)
(require "tk-dns.rkt")
;; Instantiated with a SOA record for the zone it is serving as well
;; as a zone's worth of DNS data which is used to answer queries
@ -39,21 +40,17 @@
(display ";; Ready.\n")
(ground-vm
(transition 'no-state
;; (spawn udp-spy #:debug-name 'udp-spy)
(spawn udp-driver #:debug-name 'udp-driver)
(spawn (nested-vm #:debug-name 'dns-vm
(transition 'no-state
(spawn dns-spy #:debug-name 'dns-spy)
(spawn (dns-read-driver local-addr) #:debug-name 'dns-read-driver)
(spawn (dns-write-driver local-addr) #:debug-name 'dns-write-driver)
(role (topic-subscriber (bad-dns-packet (wild) (wild) (wild) (wild)))
[p (begin (log-error (pretty-format p))
'())])
(role (topic-subscriber (dns-request (wild) (wild) (wild)))
[r (map send-message (handle-request soa-rr zone r))])))
#:debug-name 'dns-vm))))
(ground-vm (udp-driver)
(generic-spy 'UDP)
(nested-vm
(dns-spy)
(spawn #:child (dns-read-driver local-addr))
(spawn #:child (dns-write-driver local-addr))
(endpoint #:subscriber (bad-dns-packet (wild) (wild) (wild) (wild))
[p (begin (log-error (pretty-format p))
'())])
(endpoint #:subscriber (dns-request (wild) (wild) (wild))
[r (map send-message (handle-request soa-rr zone r))]))))
(define (handle-request soa-rr zone request)
(match-define (dns-request request-message request-source request-sink) request)

63
os2-dns.rkt
View File

@ -1,63 +0,0 @@
#lang racket/base
;; DNS drivers using os2.rkt and os2-udp.rkt.
(require racket/set)
(require racket/match)
(require "codec.rkt")
(require "../racket-matrix/os2.rkt")
(require "../racket-matrix/os2-udp.rkt")
(provide (struct-out bad-dns-packet)
(struct-out dns-request)
(struct-out dns-reply)
dns-read-driver
dns-write-driver
dns-spy)
(struct bad-dns-packet (detail source sink reason) #:prefab)
(struct dns-request (message source sink) #:prefab)
(struct dns-reply (message source sink) #:prefab)
(define (dns-read-driver s)
(transition 'no-state
(at-meta-level
(role (topic-subscriber (udp-packet (wild) s (wild)))
[(udp-packet source (== s) #"")
(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)))))]))))
(define (dns-write-driver s)
(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 'no-state
(role (set (topic-subscriber (dns-request (wild) s (wild)))
(topic-subscriber (dns-reply (wild) s (wild))))
[(dns-request message (== s) sink) (translate message sink)]
[(dns-reply message (== s) sink) (translate message sink)])))
(define dns-spy
(transition 'none
(role (topic-subscriber (wild) #:monitor? #t)
[(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)))
(void)]
[(dns-reply message source sink)
(log-info (format "DNS: ~v answers ~v~n : ~v"
source sink
message))
(void)]
[x
(log-info (format "DNS: ~v" x))
(void)])))

2
proxy.rkt
View File

@ -5,7 +5,7 @@
(require racket/match)
(require racket/set)
(require racket/bool)
(require "../racket-bitsyntax/main.rkt")
(require racket-bitsyntax)
(require "api.rkt")
(require "codec.rkt")
(require "zonedb.rkt")

2
simple-udp-service.rkt
View File

@ -5,7 +5,7 @@
(require racket/match)
(require racket/udp)
(require (only-in srfi/1 append-reverse))
(require "../racket-matrix/dump-bytes.rkt")
(require racket-typed-matrix/support/dump-bytes)
(provide (struct-out udp-packet)
message-handlers

2
simplified-driver.rkt
View File

@ -6,7 +6,7 @@
(require racket/match)
(require racket/set)
(require racket/bool)
(require "../racket-bitsyntax/main.rkt")
(require racket-bitsyntax)
(require "api.rkt")
(require "codec.rkt")
(require "zonedb.rkt")

2
stress.rkt
View File

@ -5,7 +5,7 @@
(require racket/udp)
(require racket/set)
(require "../racket-bitsyntax/main.rkt")
(require racket-bitsyntax)
(require "api.rkt")
(require "codec.rkt")
(require "test-rrs.rkt")

65
tk-dns.rkt Normal file
View File

@ -0,0 +1,65 @@
#lang racket/base
;; DNS drivers using racket-typed-matrix.
(require racket/set)
(require racket/match)
(require "codec.rkt")
(require racket-typed-matrix/sugar-untyped)
(require racket-typed-matrix/drivers/udp-untyped)
(provide (struct-out bad-dns-packet)
(struct-out dns-request)
(struct-out dns-reply)
dns-read-driver
dns-write-driver
dns-spy)
(struct bad-dns-packet (detail source sink reason) #:prefab)
(struct dns-request (message source sink) #:prefab)
(struct dns-reply (message source sink) #:prefab)
(define (dns-read-driver s)
(transition 'no-state
(at-meta-level
(endpoint #:subscriber (udp-packet-pattern (wild) s (wild))
[(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)))))]))))
(define (dns-write-driver s)
(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 'no-state
(endpoint #:subscriber (dns-request (wild) s (wild))
[(dns-request message (== s) sink) (translate message sink)])
(endpoint #:subscriber (dns-reply (wild) s (wild))
[(dns-reply message (== s) sink) (translate message sink)])))
(define (dns-spy)
(spawn #:child
(transition 'none
(endpoint #:subscriber (wild) #:observer
[(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))]))))

2
zonedb.rkt
View File

@ -6,7 +6,7 @@
(require racket/match)
(require "api.rkt")
(require "codec.rkt")
(require "../racket-bitsyntax/main.rkt")
(require racket-bitsyntax)
(provide zone-ref
zone-includes-name?