Start experimenting with packet classification
This commit is contained in:
parent
92ec4c4815
commit
2599833904
|
@ -14,10 +14,15 @@
|
||||||
;; be sent.
|
;; be sent.
|
||||||
(struct udp-packet (body host port) #:transparent)
|
(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.
|
;; Starts a generic request/reply UDP server on the given port.
|
||||||
(define (start-udp-service
|
(define (start-udp-service
|
||||||
port-number ;; Uint16
|
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
|
initial-state ;; ServerState
|
||||||
#:packet-size-limit
|
#:packet-size-limit
|
||||||
[packet-size-limit 65536])
|
[packet-size-limit 65536])
|
||||||
|
@ -34,8 +39,13 @@
|
||||||
(dump-bytes! buffer packet-length)
|
(dump-bytes! buffer packet-length)
|
||||||
(flush-output)
|
(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)
|
(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)
|
(for-each (lambda (p)
|
||||||
(udp-send-to s (udp-packet-host p) (udp-packet-port p) (udp-packet-body p)))
|
(udp-send-to s (udp-packet-host p) (udp-packet-port p) (udp-packet-body p)))
|
||||||
|
|
|
@ -68,27 +68,24 @@
|
||||||
|
|
||||||
(start-udp-service
|
(start-udp-service
|
||||||
port-number
|
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
|
#f
|
||||||
#:packet-size-limit 512))
|
#:packet-size-limit 512))
|
||||||
|
|
||||||
(define (handle-request soa-rr zone request-packet)
|
(define (classify-dns-packet packet)
|
||||||
(match-define (udp-packet request-body request-host request-port) request-packet)
|
(match-define (udp-packet body host port) packet)
|
||||||
(define request-message (packet->dns-message request-body))
|
(with-handlers ((exn? (lambda (e) #f)))
|
||||||
|
(list (packet->dns-message body) host port)))
|
||||||
|
|
||||||
(define (make-error error-response-code)
|
;; UdpPacket -> ListOf<UdpPacket>
|
||||||
(bit-string-case request-body
|
(define (log-error packet)
|
||||||
([ (id :: bits 16) (:: binary) ]
|
(pretty-print `(bad-packet-received ,packet))
|
||||||
(list (udp-packet (dns-message->packet
|
(list))
|
||||||
(dns-message id 'response 'query
|
|
||||||
'non-authoritative 'not-truncated
|
(define (handle-request soa-rr zone request-data)
|
||||||
'no-recursion-desired 'no-recursion-available
|
(match-define (list request-message request-host request-port) request-data)
|
||||||
error-response-code '() '() '() '()))
|
|
||||||
request-host
|
|
||||||
request-port)))
|
|
||||||
(else
|
|
||||||
;; We don't even have enough information in the packet to reply.
|
|
||||||
(list))))
|
|
||||||
|
|
||||||
(define (make-reply name send-name-error? answers authorities additional)
|
(define (make-reply name send-name-error? answers authorities additional)
|
||||||
(dns-message (dns-message-id request-message)
|
(dns-message (dns-message-id request-message)
|
||||||
|
|
Loading…
Reference in New Issue