Start experimenting with packet classification

simple-udp-service.rkt

@@ -14,10 +14,15 @@
 ;; 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-handler ;; UdpPacket ServerState -> ListOf<UdpPacket> ServerState
+	 packet-classifier ;; UdpPacket -> Maybe<ClassifiedPacket>
+	 bad-packet-handler ;; UdpPacket ServerState -> ListOf<UdpPacket> ServerState
+	 good-packet-handler ;; ClassifiedPacket ServerState -> ListOf<UdpPacket> ServerState
 	 initial-state ;; ServerState
 	 #:packet-size-limit
 	   [packet-size-limit 65536])
@@ -34,8 +39,13 @@
     (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)
-      (packet-handler (udp-packet packet source-hostname source-port) old-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)
 		(udp-send-to s (udp-packet-host p) (udp-packet-port p) (udp-packet-body p)))

simplified-driver.rkt

@@ -68,27 +68,24 @@
 
   (start-udp-service
    port-number
-   (lambda (packet old-state) (values (handle-request soa-rr zone packet) old-state))
+   classify-dns-packet
+   (lambda (packet old-state) (values (log-error packet) old-state))
+   (lambda (message old-state) (values (handle-request soa-rr zone message) old-state))
    #f
    #:packet-size-limit 512))
 
-(define (handle-request soa-rr zone request-packet)
-  (match-define (udp-packet request-body request-host request-port) request-packet)
-  (define request-message (packet->dns-message request-body))
+(define (classify-dns-packet packet)
+  (match-define (udp-packet body host port) packet)
+  (with-handlers ((exn? (lambda (e) #f)))
+    (list (packet->dns-message body) host port)))
 
-  (define (make-error error-response-code)
-    (bit-string-case request-body
-      ([ (id :: bits 16) (:: binary) ]
-       (list (udp-packet (dns-message->packet
-			  (dns-message id 'response 'query
-				       'non-authoritative 'not-truncated
-				       'no-recursion-desired 'no-recursion-available
-				       error-response-code '() '() '() '()))
-			 request-host
-			 request-port)))
-      (else
-       ;; We don't even have enough information in the packet to reply.
-       (list))))
+;; UdpPacket -> ListOf<UdpPacket>
+(define (log-error packet)
+  (pretty-print `(bad-packet-received ,packet))
+  (list))
+
+(define (handle-request soa-rr zone request-data)
+  (match-define (list request-message request-host request-port) request-data)
 
   (define (make-reply name send-name-error? answers authorities additional)
     (dns-message (dns-message-id request-message)