summaryrefslogtreecommitdiff
path: root/src/client.lisp
blob: fd0b581721211bccd5940d602065d18c4fa89eb7 (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
(defpackage :cl-mdns/client
  (:use :cl
	:cl-mdns/packet)
  (:local-nicknames (:nb :nibbles)
                    (:f :fsocket))
  (:export :lookup)) 
(in-package :cl-mdns/client)

(defvar *mdns-address* #(224 0 0 251))
(defvar *mdns-port* 5353)

(defun parse-ipv4-response (packet)
  "Extracts the first IPv4 address found in a DNS response packet."
  (let* ((qdcount (+ (ash (aref packet 4) 8) (aref packet 5)))
         (ancount (+ (ash (aref packet 6) 8) (aref packet 7)))
         (pos 12)) ; Start after header
    
    ;; Skip Question section
    (loop repeat qdcount do
      (loop while (not (zerop (aref packet pos))) 
            do (incf pos (1+ (aref packet pos))))
      (incf pos 5)) ; Skip null byte + Type(2) + Class(2)
      
    ;; Parse Answer section
    (if (> ancount 0)
        (let ((type (+ (ash (aref packet (+ pos 2)) 8) (aref packet (+ pos 3))))
              ;(rdlen (+ (ash (aref packet (+ pos 10)) 8) (aref packet (+ pos 11))))
              )
          ;; If Type is 1 (A record), return the next 4 bytes as an IP string
          (if (= type 1)
              (format nil "~D.~D.~D.~D" 
                      (aref packet (+ pos 12)) (aref packet (+ pos 13))
                      (aref packet (+ pos 14)) (aref packet (+ pos 15)))
              "Non-IPv4 record received"))
        "No answers found")))

(defun lookup (domain)
  (let ((fd (f:open-socket :type :datagram))
        (packet (build-query-packet domain))
        (buffer (make-array 512 :element-type '(unsigned-byte 8))))
    (unwind-protect
         (progn 
           (f:socket-bind fd (f:make-sockaddr-in))
           (f:socket-sendto fd packet (f:make-sockaddr-in :addr *mdns-address* :port *mdns-port*))
           (multiple-value-bind (count raddr) (f:socket-recvfrom fd buffer)
             (declare (ignore raddr))
             (parse-ipv4-response (subseq buffer 0 count))))
      (f:close-socket fd))))