blob: bcff6555f174486d1f26ea910f5ae68b9c8352cc (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
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))))
)))))))
|
