racket-dns-2012/simple-udp-service.rkt

#lang racket/base

;; Simple imperative UDP server harness.

(require racket/match)
(require racket/udp)
(require "dump-bytes.rkt")

(provide (struct-out udp-packet)
	 start-udp-service)

;; A UdpPacket is a (udp-packet Bytes String Uint16), and represents
;; either a received UDP packet and the source of the packet, or a UDP
;; packet ready to be sent along with the address to which it should
;; be sent.
(struct udp-packet (body host port) #:transparent)

;; TODO: Should packet-classifier be permitted to examine (or possibly
;; even transform!) the ServerState?

;; Starts a generic request/reply UDP server on the given port.
(define (start-udp-service
	 port-number ;; Uint16
	 packet-classifier ;; UdpPacket -> Maybe<ClassifiedPacket>
	 bad-packet-handler ;; UdpPacket ServerState -> ListOf<ClassifiedPacket> ServerState
	 good-packet-handler ;; ClassifiedPacket ServerState -> ListOf<ClassifiedPacket> ServerState
	 packet-encoder ;; ClassifiedPacket -> UdpPacket
	 initial-state ;; ServerState
	 #:packet-size-limit
	   [packet-size-limit 65536])
  (define s (udp-open-socket #f #f)) ;; the server socket
  (udp-bind! s #f port-number) ;; bind it to the port we were given

  (define (read-and-process-request old-state)
    (define buffer (make-bytes packet-size-limit))
    (define-values (packet-length source-hostname source-port)
      (udp-receive! s buffer))
    (define packet (subbytes buffer 0 packet-length))

    (printf "----------------------------------------~n~v~n" packet)
    (dump-bytes! buffer packet-length)
    (flush-output)

    (define packet-and-source (udp-packet packet source-hostname source-port))
    (define classified-packet (packet-classifier packet-and-source))

    (define-values (reply-packets new-state)
      (cond
       ((eq? classified-packet #f) (bad-packet-handler packet-and-source old-state))
       (else (good-packet-handler classified-packet old-state))))

    (for-each (lambda (p)
		(match-define (udp-packet body host port) (packet-encoder p))
		(udp-send-to s host port body))
	      reply-packets)
    new-state)

  (let service-loop ((state initial-state))
    (service-loop (read-and-process-request state))))