Function: dns-read

dns-read is a byte-compiled function defined in dns.el.gz.

Signature

(dns-read PACKET &optional TCP-P)

Source Code

;; Defined in /usr/src/emacs/lisp/net/dns.el.gz
(defun dns-read (packet &optional tcp-p)
  (with-temp-buffer
    (set-buffer-multibyte nil)
    (let ((spec nil)
          queries answers authorities additionals)
      (insert packet)
      ;; When using TCP we have a 2 byte length field to ignore.
      (goto-char (+ (point-min)
                    (if tcp-p 2 0)))
      (push (list 'id (dns-read-bytes 2)) spec)
      (let ((byte (dns-read-bytes 1)))
        (push (list 'response-p (if (zerop (logand byte (ash 1 7))) nil t))
              spec)
        (let ((opcode (logand byte (ash 7 3))))
          (push (list 'opcode
                      (cond ((eq opcode 0) 'query)
                            ((eq opcode 1) 'inverse-query)
                            ((eq opcode 2) 'status)))
                spec))
        (push (list 'authoritative-p (if (zerop (logand byte (ash 1 2)))
                                         nil t)) spec)
        (push (list 'truncated-p (if (zerop (logand byte (ash 1 1))) nil t))
              spec)
        (push (list 'recursion-desired-p
                    (if (zerop (logand byte (ash 1 0))) nil t)) spec))
      (let ((rc (logand (dns-read-bytes 1) 15)))
        (push (list 'response-code
                    (cond
                     ((eq rc 0) 'no-error)
                     ((eq rc 1) 'format-error)
                     ((eq rc 2) 'server-failure)
                     ((eq rc 3) 'name-error)
                     ((eq rc 4) 'not-implemented)
                     ((eq rc 5) 'refused)))
              spec))
      (setq queries (dns-read-bytes 2))
      (setq answers (dns-read-bytes 2))
      (setq authorities (dns-read-bytes 2))
      (setq additionals (dns-read-bytes 2))
      (let ((qs nil))
        (dotimes (_ queries)
          (push (list (dns-read-name)
                      (list 'type (dns-inverse-get (dns-read-bytes 2)
                                                   dns-query-types))
                      (list 'class (dns-inverse-get (dns-read-bytes 2)
                                                    dns-classes)))
                qs))
        (push (list 'queries qs) spec))
      (cl-loop for (slot length) in `((answers ,answers)
                                      (authorities ,authorities)
                                      (additionals ,additionals))
               do (let ((qs nil)
                        type)
                    (dotimes (_ length)
                      (push (list (dns-read-name)
                                  (list 'type
                                        (setq type (dns-inverse-get
                                                    (dns-read-bytes 2)
                                                    dns-query-types)))
                                  (list 'class (dns-inverse-get
                                                (dns-read-bytes 2)
                                                dns-classes))
                                  (list 'ttl (dns-read-bytes 4))
                                  (let ((length (dns-read-bytes 2)))
                                    (list 'data
                                          (dns-read-type
                                           (buffer-substring
                                            (point)
                                            (progn (forward-char length)
                                                   (point)))
                                           type))))
                            qs))
                    (push (list slot qs) spec)))
      (nreverse spec))))