#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)])))