57 lines
1.8 KiB
Racket
57 lines
1.8 KiB
Racket
#lang racket/base
|
|
|
|
;; DNS drivers using os-big-bang.rkt and os-udp.rkt.
|
|
|
|
(require racket/match)
|
|
(require "codec.rkt")
|
|
(require "../racket-matrix/os-big-bang.rkt")
|
|
(require "../racket-matrix/os-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)
|
|
(os-big-bang 'no-state
|
|
(subscribe 'packet-reader
|
|
(meta-message-handlers w
|
|
[(udp-packet source (== s) body)
|
|
(transition w
|
|
(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)))))
|
|
(send-meta-message (udp-packet s sink (dns-message->packet message)))))
|
|
(os-big-bang 'no-state
|
|
(subscribe 'packet-writer
|
|
(message-handlers w
|
|
[(dns-request message (== s) sink) (transition w (translate message sink))]
|
|
[(dns-reply message (== s) sink) (transition w (translate message sink))]))))
|
|
|
|
(require racket/pretty)
|
|
(define dns-spy
|
|
(os-big-bang 'none
|
|
(subscribe 'spy
|
|
(message-handlers w
|
|
[(dns-request message source sink)
|
|
(pretty-display `(DNS (,source asks ,sink) ,@(dns-message-questions message)))]
|
|
[(dns-reply message source sink)
|
|
(pretty-display `(DNS (,source answers ,sink) ,message))]
|
|
[x
|
|
(write `(DNS ,x))
|
|
(newline)]))))
|