From 3692466424e33278e22faaa8c0c3ae61ac95ffd5 Mon Sep 17 00:00:00 2001 From: soukev Date: Tue, 9 Jun 2026 11:02:54 +0200 Subject: Move relevant parts to packet.lisp; add arrow-macros --- src/packet.lisp | 34 ++++++++++++++++++++++++++++++++-- 1 file changed, 32 insertions(+), 2 deletions(-) (limited to 'src/packet.lisp') diff --git a/src/packet.lisp b/src/packet.lisp index 12b8926..f66b61c 100644 --- a/src/packet.lisp +++ b/src/packet.lisp @@ -1,7 +1,7 @@ (defpackage :cl-mdns/packet - (:use :cl) + (:use :cl :arrow-macros) (:local-nicknames (:nb :nibbles)) - (:export :build-query-packet)) + (:export :build-query-packet :build-response :make-ip-from-string :encode-name :parse-query)) (in-package :cl-mdns/packet) @@ -58,6 +58,13 @@ (deftype ip-addr-list () '(satisfies ip-addr-list-p)) +(defun make-ip-from-string (ip-str) + (-<>> (uiop:split-string ip-str :separator ".") + (mapcar #'parse-integer) + (lambda (x) (if (typep x 'ip-addr-list) + x + (error "~S is not in valid ipv4 format." ip-str))))) + (defun make-ip-body (ip) (destructuring-bind (ip-a ip-b ip-c ip-d) ip (let ((buffer (make-array 14 :element-type '(unsigned-byte 8) :initial-element 0)) @@ -81,3 +88,26 @@ (name (encode-name domain-name)) (ip-part (make-ip-body ip))) (concatenate '(vector (unsigned-byte 8)) header name ip-part))) + +(defun parse-query-body-message (lst) + "Parses the body of message. +The rest of the packet (meaning the tail) is ignored." + (labels ((parse-rec (acc rem-lst) + (destructuring-bind (cnt &rest msg) rem-lst + (if (or (null cnt) (zerop cnt)) + acc + (parse-rec + (-<>> (subseq msg 0 cnt) + (mapcar #'code-char) + (coerce <> 'string) + list + (concatenate 'list acc)) + (nthcdr cnt msg)))))) + (parse-rec nil lst))) + +(defun parse-query (query) + "Parses question/query and returns domain name. +Completely ignores header and tail of packet for now." + (let ((message (coerce (subseq query 12) 'list))) + (format nil "~{~A~^.~}" + (parse-query-body-message message)))) -- cgit v1.2.3