Move relevant parts to packet.lisp; add arrow-macros

1 files changed, 32 insertions, 2 deletions

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))))