1 ;;; dns.el --- Domain Name Service lookups
3 ;; Copyright (C) 2002-2015 Free Software Foundation, Inc.
5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
6 ;; Keywords: network comm
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
28 "How many seconds to wait when doing DNS queries.")
30 (defvar dns-servers nil
31 "List of DNS servers to query.
32 If nil, /etc/resolv.conf and nslookup will be consulted.")
34 (defvar dns-servers-valid-for-interfaces nil
35 "The return value of `network-interface-list' when `dns-servers' was set.
36 If the set of network interfaces and/or their IP addresses
37 change, then presumably the list of DNS servers needs to be
38 updated. Set this variable to t to disable the check.")
42 (defvar dns-query-types
65 "Names of query types and their values.")
72 "Classes of queries.")
74 (defun dns-write-bytes (value &optional length)
76 (dotimes (i (or length 1))
77 (push (% value 256) bytes)
78 (setq value (/ value 256)))
82 (defun dns-read-bytes (length)
85 (setq value (logior (* value 256) (following-char)))
89 (defun dns-get (type spec)
90 (cadr (assq type spec)))
92 (defun dns-inverse-get (value spec)
94 (while (and (not found)
96 (if (eq value (cadr (car spec)))
97 (setq found (caar spec))
101 (defun dns-write-name (name)
102 (dolist (part (split-string name "\\."))
103 (dns-write-bytes (length part))
107 (defun dns-read-string-name (string buffer)
109 (unless (featurep 'xemacs) (set-buffer-multibyte nil))
111 (goto-char (point-min))
112 (dns-read-name buffer)))
114 (defun dns-read-name (&optional buffer)
119 (setq length (dns-read-bytes 1))
120 (if (= 192 (logand length (lsh 3 6)))
121 (let ((offset (+ (* (logand 63 length) 256)
122 (dns-read-bytes 1))))
126 (goto-char (1+ offset))
127 (setq ended (dns-read-name buffer))))
130 (push (buffer-substring (point)
131 (progn (forward-char length) (point)))
136 (concat (mapconcat 'identity (nreverse name) ".") "." ended))
137 (mapconcat 'identity (nreverse name) "."))))
139 (defun dns-write (spec &optional tcp-p)
140 "Write a DNS packet according to SPEC.
141 If TCP-P, the first two bytes of the package with be the length field."
143 (unless (featurep 'xemacs) (set-buffer-multibyte nil))
144 (dns-write-bytes (dns-get 'id spec) 2)
147 (lsh (if (dns-get 'response-p spec) 1 0) -7)
150 ((eq (dns-get 'opcode spec) 'query) 0)
151 ((eq (dns-get 'opcode spec) 'inverse-query) 1)
152 ((eq (dns-get 'opcode spec) 'status) 2)
153 (t (error "No such opcode: %s" (dns-get 'opcode spec))))
155 (lsh (if (dns-get 'authoritative-p spec) 1 0) -2)
156 (lsh (if (dns-get 'truncated-p spec) 1 0) -1)
157 (lsh (if (dns-get 'recursion-desired-p spec) 1 0) 0)))
160 ((eq (dns-get 'response-code spec) 'no-error) 0)
161 ((eq (dns-get 'response-code spec) 'format-error) 1)
162 ((eq (dns-get 'response-code spec) 'server-failure) 2)
163 ((eq (dns-get 'response-code spec) 'name-error) 3)
164 ((eq (dns-get 'response-code spec) 'not-implemented) 4)
165 ((eq (dns-get 'response-code spec) 'refused) 5)
167 (dns-write-bytes (length (dns-get 'queries spec)) 2)
168 (dns-write-bytes (length (dns-get 'answers spec)) 2)
169 (dns-write-bytes (length (dns-get 'authorities spec)) 2)
170 (dns-write-bytes (length (dns-get 'additionals spec)) 2)
171 (dolist (query (dns-get 'queries spec))
172 (dns-write-name (car query))
173 (dns-write-bytes (cadr (assq (or (dns-get 'type query) 'A)
175 (dns-write-bytes (cadr (assq (or (dns-get 'class query) 'IN)
177 (dolist (slot '(answers authorities additionals))
178 (dolist (resource (dns-get slot spec))
179 (dns-write-name (car resource))
180 (dns-write-bytes (cadr (assq (dns-get 'type resource) dns-query-types))
182 (dns-write-bytes (cadr (assq (dns-get 'class resource) dns-classes))
184 (dns-write-bytes (dns-get 'ttl resource) 4)
185 (dns-write-bytes (length (dns-get 'data resource)) 2)
186 (insert (dns-get 'data resource))))
188 (goto-char (point-min))
189 (dns-write-bytes (buffer-size) 2))
192 (defun dns-read (packet)
194 (unless (featurep 'xemacs) (set-buffer-multibyte nil))
196 queries answers authorities additionals)
198 (goto-char (point-min))
199 (push (list 'id (dns-read-bytes 2)) spec)
200 (let ((byte (dns-read-bytes 1)))
201 (push (list 'response-p (if (zerop (logand byte (lsh 1 7))) nil t))
203 (let ((opcode (logand byte (lsh 7 3))))
205 (cond ((eq opcode 0) 'query)
206 ((eq opcode 1) 'inverse-query)
207 ((eq opcode 2) 'status)))
209 (push (list 'authoritative-p (if (zerop (logand byte (lsh 1 2)))
211 (push (list 'truncated-p (if (zerop (logand byte (lsh 1 2))) nil t))
213 (push (list 'recursion-desired-p
214 (if (zerop (logand byte (lsh 1 0))) nil t)) spec))
215 (let ((rc (logand (dns-read-bytes 1) 15)))
216 (push (list 'response-code
218 ((eq rc 0) 'no-error)
219 ((eq rc 1) 'format-error)
220 ((eq rc 2) 'server-failure)
221 ((eq rc 3) 'name-error)
222 ((eq rc 4) 'not-implemented)
223 ((eq rc 5) 'refused)))
225 (setq queries (dns-read-bytes 2))
226 (setq answers (dns-read-bytes 2))
227 (setq authorities (dns-read-bytes 2))
228 (setq additionals (dns-read-bytes 2))
231 (push (list (dns-read-name)
232 (list 'type (dns-inverse-get (dns-read-bytes 2)
234 (list 'class (dns-inverse-get (dns-read-bytes 2)
237 (push (list 'queries qs) spec))
238 (dolist (slot '(answers authorities additionals))
241 (dotimes (i (symbol-value slot))
242 (push (list (dns-read-name)
244 (setq type (dns-inverse-get (dns-read-bytes 2)
246 (list 'class (dns-inverse-get (dns-read-bytes 2)
248 (list 'ttl (dns-read-bytes 4))
249 (let ((length (dns-read-bytes 2)))
254 (progn (forward-char length) (point)))
257 (push (list slot qs) spec)))
260 (defun dns-read-int32 ()
261 ;; Full 32 bit Integers can't be handled by 32-bit Emacsen. If we
262 ;; use floats, it works.
263 (format "%.0f" (+ (* (dns-read-bytes 1) 16777216.0)
264 (dns-read-bytes 3))))
266 (defun dns-read-type (string type)
267 (let ((buffer (current-buffer))
271 (unless (featurep 'xemacs) (set-buffer-multibyte nil))
273 (goto-char (point-min))
278 (push (dns-read-bytes 1) bytes))
279 (mapconcat 'number-to-string (nreverse bytes) ".")))
283 (push (dns-read-bytes 2) hextets))
284 (mapconcat (lambda (n) (format "%x" n))
285 (nreverse hextets) ":")))
287 (list (list 'mname (dns-read-name buffer))
288 (list 'rname (dns-read-name buffer))
289 (list 'serial (dns-read-int32))
290 (list 'refresh (dns-read-int32))
291 (list 'retry (dns-read-int32))
292 (list 'expire (dns-read-int32))
293 (list 'minimum (dns-read-int32))))
295 (list (list 'priority (dns-read-bytes 2))
296 (list 'weight (dns-read-bytes 2))
297 (list 'port (dns-read-bytes 2))
298 (list 'target (dns-read-name buffer))))
300 (cons (dns-read-bytes 2) (dns-read-name buffer)))
301 ((or (eq type 'CNAME) (eq type 'NS) (eq type 'PTR))
302 (dns-read-string-name string buffer))
306 (declare-function network-interface-list "process.c")
308 (defun dns-servers-up-to-date-p ()
309 "Return false if we need to recheck the list of DNS servers."
311 (or (eq dns-servers-valid-for-interfaces t)
312 ;; `network-interface-list' was introduced in Emacs 22.1.
313 (not (fboundp 'network-interface-list))
314 (equal dns-servers-valid-for-interfaces
315 (network-interface-list)))))
317 (defun dns-set-servers ()
318 "Set `dns-servers' to a list of DNS servers or nil if none are found.
319 Parses \"/etc/resolv.conf\" or calls \"nslookup\"."
320 (or (when (file-exists-p "/etc/resolv.conf")
321 (setq dns-servers nil)
323 (insert-file-contents "/etc/resolv.conf")
324 (goto-char (point-min))
325 (while (re-search-forward "^nameserver[\t ]+\\([^ \t\n]+\\)" nil t)
326 (push (match-string 1) dns-servers))
327 (setq dns-servers (nreverse dns-servers))))
328 (when (executable-find "nslookup")
330 (call-process "nslookup" nil t nil "localhost")
331 (goto-char (point-min))
333 "^Address:[ \t]*\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" nil t)
334 (setq dns-servers (list (match-string 1))))))
335 (when (fboundp 'network-interface-list)
336 (setq dns-servers-valid-for-interfaces (network-interface-list))))
338 (defun dns-read-txt (string)
339 (if (> (length string) 1)
343 (defun dns-get-txt-answer (answers)