#lang racket/base
;; DNS drivers using marketplace.
;;
;;; Copyright 2010, 2011, 2012, 2013 Tony Garnock-Jones <tonyg@ccs.neu.edu>
;;;
;;; This file is part of marketplace-dns.
;;;
;;; marketplace-dns is free software: you can redistribute it and/or
;;; modify it under the terms of the GNU General Public License as
;;; published by the Free Software Foundation, either version 3 of the
;;; License, or (at your option) any later version.
;;;
;;; marketplace-dns is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;; General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with marketplace-dns. If not, see
;;; <http://www.gnu.org/licenses/>.

(require racket/set)
(require racket/match)
(require "codec.rkt")
(require marketplace/sugar)
(require marketplace/drivers/udp)

(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) #:transparent)
(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)))))])))))

;; (: 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)]))))

;; (: 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))]))))