Project kick-off

1 files changed, 52 insertions, 0 deletions

diff --git a/src/publisher.lisp b/src/publisher.lisp
new file mode 100644
index 0000000..bcff655
--- /dev/null
+++ b/src/publisher.lisp
@@ -0,0 +1,52 @@
+;; Doesn't currently work. I'm unable to join the multicast group to listen for messages.
+(defpackage :cl-mdns/publisher
+  (:use :cl
+	:cl-mdns/packet)
+  (:local-nicknames (:nb :nibbles)
+                    (:f :fsocket)))
+(in-package :cl-mdns/publisher)
+
+(defvar *mdns-address* #(224 0 0 251))
+(defvar *mdns-port* 5353)
+
+; TODO: Bring cl-arrows lib so I can thread expressions
+(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
+		    (concatenate 'list acc (list (coerce (map 'list #'code-char (subseq msg 0 cnt)) 'string)))
+		    (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 (subseq query 12)))
+    (format nil "~{~A~^.~}"
+     (parse-query-body-message message))))
+
+(defun publish ()
+  (f:with-poll (pc)
+    (f:with-socket (sock :datagram)
+      (let ((addr (f:make-sockaddr-in :addr *mdns-address* :port *mdns-port*))
+            (laddr (f:make-sockaddr-in :port *mdns-port*))
+            (buffer (make-array 512 :element-type '(unsigned-byte 8))))
+
+        ;; Prepare multicast socket
+        (setf (f:socket-option sock :socket :reuseaddr) t)
+        (f:socket-bind sock laddr)
+        (f:multicast-join sock addr)
+
+        ;; Register for polling - we don't want to waste compute time on active listening
+        (f:poll-register pc (make-instance 'f:pollfd :fd sock :events (f:poll-events :pollin)))
+        (loop
+          (f:doevents (pollfd event) (f:poll pc)
+            (case event
+             (:pollin
+              (multiple-value-bind (count saddr) (f:socket-recvfrom sock buffer)
+                (format t "Recieved ~A from ~A, buffer: ~A" count saddr (subseq buffer 0 count))))
+             )))))))