[bpt/emacs.git] / lisp / gnus / dns.el

;;; dns.el --- Domain Name Service lookups

;; Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.

;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: network

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	 See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to the
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;;; Code:

(eval-when-compile (require 'cl))

(require 'mm-util)

(defvar dns-timeout 5
  "How many seconds to wait when doing DNS queries.")

(defvar dns-servers nil
  "Which DNS servers to query.
If nil, /etc/resolv.conf will be consulted.")

;;; Internal code:

(defvar dns-query-types
  '((A 1)
    (NS 2)
    (MD 3)
    (MF 4)
    (CNAME 5)
    (SOA 6)
    (MB 7)
    (MG 8)
    (MR 9)
    (NULL 10)
    (WKS 11)
    (PRT 12)
    (HINFO 13)
    (MINFO 14)
    (MX 15)
    (TXT 16)
    (AXFR 252)
    (MAILB 253)
    (MAILA 254)
    (* 255))
  "Names of query types and their values.")

(defvar dns-classes
  '((IN 1)
    (CS 2)
    (CH 3)
    (HS 4))
  "Classes of queries.")

(defun dns-write-bytes (value &optional length)
  (let (bytes)
    (dotimes (i (or length 1))
      (push (% value 256) bytes)
      (setq value (/ value 256)))
    (dolist (byte bytes)
      (insert byte))))

(defun dns-read-bytes (length)
  (let ((value 0))
    (dotimes (i length)
      (setq value (logior (* value 256) (following-char)))
      (forward-char 1))
    value))

(defun dns-get (type spec)
  (cadr (assq type spec)))

(defun dns-inverse-get (value spec)
  (let ((found nil))
    (while (and (not found)
		spec)
      (if (eq value (cadr (car spec)))
	  (setq found (caar spec))
	(pop spec)))
    found))

(defun dns-write-name (name)
  (dolist (part (split-string name "\\."))
    (dns-write-bytes (length part))
    (insert part))
  (dns-write-bytes 0))

(defun dns-read-string-name (string buffer)
  (mm-with-unibyte-buffer
    (insert string)
    (goto-char (point-min))
    (dns-read-name buffer)))

(defun dns-read-name (&optional buffer)
  (let ((ended nil)
	(name nil)
	length)
    (while (not ended)
      (setq length (dns-read-bytes 1))
      (if (= 192 (logand length (lsh 3 6)))
	  (let ((offset (+ (* (logand 63 length) 256)
			   (dns-read-bytes 1))))
	    (save-excursion
	      (when buffer
		(set-buffer buffer))
	      (goto-char (1+ offset))
	      (setq ended (dns-read-name buffer))))
	(if (zerop length)
	    (setq ended t)
	  (push (buffer-substring (point)
				  (progn (forward-char length) (point)))
		name))))
    (if (stringp ended)
	(if (null name)
	    ended
	  (concat (mapconcat 'identity (nreverse name) ".") "." ended))
      (mapconcat 'identity (nreverse name) "."))))

(defun dns-write (spec &optional tcp-p)
  "Write a DNS packet according to SPEC.
If TCP-P, the first two bytes of the package with be the length field."
  (with-temp-buffer
    (dns-write-bytes (dns-get 'id spec) 2)
    (dns-write-bytes
     (logior
      (lsh (if (dns-get 'response-p spec) 1 0) -7)
      (lsh
       (cond
	((eq (dns-get 'opcode spec) 'query) 0)
	((eq (dns-get 'opcode spec) 'inverse-query) 1)
	((eq (dns-get 'opcode spec) 'status) 2)
	(t (error "No such opcode: %s" (dns-get 'opcode spec))))
       -3)
      (lsh (if (dns-get 'authoritative-p spec) 1 0) -2)
      (lsh (if (dns-get 'truncated-p spec) 1 0) -1)
      (lsh (if (dns-get 'recursion-desired-p spec) 1 0) 0)))
    (dns-write-bytes
     (cond 
      ((eq (dns-get 'response-code spec) 'no-error) 0)
      ((eq (dns-get 'response-code spec) 'format-error) 1)
      ((eq (dns-get 'response-code spec) 'server-failure) 2)
      ((eq (dns-get 'response-code spec) 'name-error) 3)
      ((eq (dns-get 'response-code spec) 'not-implemented) 4)
      ((eq (dns-get 'response-code spec) 'refused) 5)
      (t 0)))
    (dns-write-bytes (length (dns-get 'queries spec)) 2)
    (dns-write-bytes (length (dns-get 'answers spec)) 2)
    (dns-write-bytes (length (dns-get 'authorities spec)) 2)
    (dns-write-bytes (length (dns-get 'additionals spec)) 2)
    (dolist (query (dns-get 'queries spec))
      (dns-write-name (car query))
      (dns-write-bytes (cadr (assq (or (dns-get 'type query) 'A)
				   dns-query-types)) 2)
      (dns-write-bytes (cadr (assq (or (dns-get 'class query) 'IN)
				   dns-classes)) 2))
    (dolist (slot '(answers authorities additionals))
      (dolist (resource (dns-get slot spec))
	(dns-write-name (car resource))
      (dns-write-bytes (cadr (assq (dns-get 'type resource) dns-query-types))
		       2)
      (dns-write-bytes (cadr (assq (dns-get 'class resource) dns-classes))
		       2)
      (dns-write-bytes (dns-get 'ttl resource) 4)
      (dns-write-bytes (length (dns-get 'data resource)) 2)
      (insert (dns-get 'data resource))))
    (when tcp-p
      (goto-char (point-min))
      (dns-write-bytes (buffer-size) 2))
    (buffer-string)))

(defun dns-read (packet)
  (mm-with-unibyte-buffer
    (let ((spec nil)
	  queries answers authorities additionals)
      (insert packet)
      (goto-char (point-min))
      (push (list 'id (dns-read-bytes 2)) spec)
      (let ((byte (dns-read-bytes 1)))
	(push (list 'response-p (if (zerop (logand byte (lsh 1 7))) nil t))
	      spec)
	(let ((opcode (logand byte (lsh 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 (lsh 1 2)))
					 nil t)) spec)
	(push (list 'truncated-p (if (zerop (logand byte (lsh 1 2))) nil t))
	      spec)
	(push (list 'recursion-desired-p
		    (if (zerop (logand byte (lsh 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 (i 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))
    (dolist (slot '(answers authorities additionals))
      (let ((qs nil)
	    type)
	(dotimes (i (symbol-value slot))
	  (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))))

(defun dns-read-type (string type)
  (let ((buffer (current-buffer))
	(point (point)))
    (prog1
	(mm-with-unibyte-buffer
	  (insert string)
	  (goto-char (point-min))
	  (cond
	   ((eq type 'A)
	    (let ((bytes nil))
	      (dotimes (i 4)
		(push (dns-read-bytes 1) bytes))
	      (mapconcat 'number-to-string (nreverse bytes) ".")))
	   ((eq type 'NS)
	    (dns-read-string-name string buffer))
	   ((eq type 'CNAME)
	    (dns-read-string-name string buffer))
	   (t string)))
      (goto-char point))))

(defun dns-parse-resolv-conf ()
  (when (file-exists-p "/etc/resolv.conf")
    (with-temp-buffer
      (insert-file-contents "/etc/resolv.conf")
      (goto-char (point-min))
      (while (re-search-forward "^nameserver[\t ]+\\([^ \t\n]+\\)" nil t)
	(push (match-string 1) dns-servers))
      (setq dns-servers (nreverse dns-servers)))))

;;; Interface functions.
(eval-when-compile
  (when (featurep 'xemacs)
    (require 'gnus-xmas)))

(defmacro dns-make-network-process (server)
  (if (featurep 'xemacs)
      `(let ((coding-system-for-read 'binary)
	     (coding-system-for-write 'binary))
	 (gnus-xmas-open-network-stream "dns" (current-buffer)
					,server "domain" 'udp))
    `(let ((server ,server)
	   (coding-system-for-read 'binary)
	   (coding-system-for-write 'binary))
       (if (fboundp 'make-network-process)
	   (make-network-process
	    :name "dns"
	    :coding 'binary
	    :buffer (current-buffer)
	    :host server
	    :service "domain"
	    :type 'datagram)
	 ;; Older versions of Emacs doesn't have
	 ;; `make-network-process', so we fall back on opening a TCP
	 ;; connection to the DNS server.
	 (open-network-stream "dns" (current-buffer) server "domain")))))

(defun query-dns (name &optional type fullp)
  "Query a DNS server for NAME of TYPE.
If FULLP, return the entire record returned."
  (setq type (or type 'A))
  (unless dns-servers
    (dns-parse-resolv-conf))

  (if (not dns-servers)
      (message "No DNS server configuration found")
    (mm-with-unibyte-buffer
      (let ((process (condition-case ()
			 (dns-make-network-process (car dns-servers))
		       (error
			(message "dns: Got an error while trying to talk to %s"
				 (car dns-servers))
			nil)))
	    (tcp-p (and (not (fboundp 'make-network-process))
			(not (featurep 'xemacs))))
	    (step 100)
	    (times (* dns-timeout 1000))
	    (id (random 65000)))
	(when process
	  (process-send-string
	   process
	   (dns-write `((id ,id)
			(opcode query)
			(queries ((,name (type ,type))))
			(recursion-desired-p t))
		      tcp-p))
	  (while (and (zerop (buffer-size))
		      (> times 0))
	    (accept-process-output process 0 step)
	    (decf times step))
	  (ignore-errors
	    (delete-process process))
	  (when (and tcp-p
		     (>= (buffer-size) 2))
	    (goto-char (point-min))
	    (delete-region (point) (+ (point) 2)))
	  (when (>= (buffer-size) 2)
	    (let ((result (dns-read (buffer-string))))
	      (if fullp
		  result
		(let ((answer (car (dns-get 'answers result))))
		  (when (eq type (dns-get 'type answer))
		    (dns-get 'data answer)))))))))))

(provide 'dns)

;;; arch-tag: d0edd0c4-4cce-4538-ae92-06c3356ee80a
;;; dns.el ends here
Commit	Line	Data
23f87bed	1	;;; dns.el --- Domain Name Service lookups
e84b4b86	2
88e6695f	3	;; Copyright (C) 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
23f87bed MB	4
	5	;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
	6	;; Keywords: network
	7
	8	;; This file is part of GNU Emacs.
	9
	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 2, or (at your option)
	13	;; any later version.
	14
	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.
	19
	20	;; You should have received a copy of the GNU General Public License
	21	;; along with GNU Emacs; see the file COPYING. If not, write to the
3a35cf56 LK	22	;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
3a35cf56 LK	23	;; Boston, MA 02110-1301, USA.
23f87bed MB	24
	25	;;; Commentary:
	26
	27	;;; Code:
	28
	29	(eval-when-compile (require 'cl))
	30
	31	(require 'mm-util)
	32
	33	(defvar dns-timeout 5
	34	"How many seconds to wait when doing DNS queries.")
	35
	36	(defvar dns-servers nil
	37	"Which DNS servers to query.
	38	If nil, /etc/resolv.conf will be consulted.")
	39
	40	;;; Internal code:
	41
	42	(defvar dns-query-types
	43	'((A 1)
	44	(NS 2)
	45	(MD 3)
	46	(MF 4)
	47	(CNAME 5)
	48	(SOA 6)
	49	(MB 7)
	50	(MG 8)
	51	(MR 9)
	52	(NULL 10)
	53	(WKS 11)
	54	(PRT 12)
	55	(HINFO 13)
	56	(MINFO 14)
	57	(MX 15)
	58	(TXT 16)
	59	(AXFR 252)
	60	(MAILB 253)
	61	(MAILA 254)
	62	(* 255))
	63	"Names of query types and their values.")
	64
	65	(defvar dns-classes
	66	'((IN 1)
	67	(CS 2)
	68	(CH 3)
	69	(HS 4))
	70	"Classes of queries.")
	71
	72	(defun dns-write-bytes (value &optional length)
	73	(let (bytes)
	74	(dotimes (i (or length 1))
	75	(push (% value 256) bytes)
	76	(setq value (/ value 256)))
	77	(dolist (byte bytes)
	78	(insert byte))))
	79
	80	(defun dns-read-bytes (length)
	81	(let ((value 0))
	82	(dotimes (i length)
	83	(setq value (logior (* value 256) (following-char)))
	84	(forward-char 1))
	85	value))
	86
	87	(defun dns-get (type spec)
88	(cadr (assq type spec)))
89
90	(defun dns-inverse-get (value spec)
91	(let ((found nil))
92	(while (and (not found)
93	spec)
94	(if (eq value (cadr (car spec)))
95	(setq found (caar spec))
96	(pop spec)))
97	found))
98
99	(defun dns-write-name (name)
100	(dolist (part (split-string name "\\."))
101	(dns-write-bytes (length part))
102	(insert part))
103	(dns-write-bytes 0))
104
105	(defun dns-read-string-name (string buffer)
106	(mm-with-unibyte-buffer
107	(insert string)
108	(goto-char (point-min))
109	(dns-read-name buffer)))
110
111	(defun dns-read-name (&optional buffer)
112	(let ((ended nil)
113	(name nil)
114	length)
115	(while (not ended)
116	(setq length (dns-read-bytes 1))
117	(if (= 192 (logand length (lsh 3 6)))
118	(let ((offset (+ (* (logand 63 length) 256)
119	(dns-read-bytes 1))))
120	(save-excursion
121	(when buffer
122	(set-buffer buffer))
123	(goto-char (1+ offset))
124	(setq ended (dns-read-name buffer))))
125	(if (zerop length)
126	(setq ended t)
127	(push (buffer-substring (point)
128	(progn (forward-char length) (point)))
129	name))))
130	(if (stringp ended)
131	(if (null name)
132	ended
133	(concat (mapconcat 'identity (nreverse name) ".") "." ended))
134	(mapconcat 'identity (nreverse name) "."))))
135
136	(defun dns-write (spec &optional tcp-p)
137	"Write a DNS packet according to SPEC.
138	If TCP-P, the first two bytes of the package with be the length field."
139	(with-temp-buffer
140	(dns-write-bytes (dns-get 'id spec) 2)
141	(dns-write-bytes
142	(logior
143	(lsh (if (dns-get 'response-p spec) 1 0) -7)
144	(lsh
145	(cond
146	((eq (dns-get 'opcode spec) 'query) 0)
147	((eq (dns-get 'opcode spec) 'inverse-query) 1)
148	((eq (dns-get 'opcode spec) 'status) 2)
149	(t (error "No such opcode: %s" (dns-get 'opcode spec))))
150	-3)
151	(lsh (if (dns-get 'authoritative-p spec) 1 0) -2)
152	(lsh (if (dns-get 'truncated-p spec) 1 0) -1)
153	(lsh (if (dns-get 'recursion-desired-p spec) 1 0) 0)))
154	(dns-write-bytes
155	(cond
156	((eq (dns-get 'response-code spec) 'no-error) 0)
157	((eq (dns-get 'response-code spec) 'format-error) 1)
158	((eq (dns-get 'response-code spec) 'server-failure) 2)
159	((eq (dns-get 'response-code spec) 'name-error) 3)
160	((eq (dns-get 'response-code spec) 'not-implemented) 4)
161	((eq (dns-get 'response-code spec) 'refused) 5)
162	(t 0)))
163	(dns-write-bytes (length (dns-get 'queries spec)) 2)
164	(dns-write-bytes (length (dns-get 'answers spec)) 2)
165	(dns-write-bytes (length (dns-get 'authorities spec)) 2)
166	(dns-write-bytes (length (dns-get 'additionals spec)) 2)
167	(dolist (query (dns-get 'queries spec))
168	(dns-write-name (car query))
169	(dns-write-bytes (cadr (assq (or (dns-get 'type query) 'A)
170	dns-query-types)) 2)
171	(dns-write-bytes (cadr (assq (or (dns-get 'class query) 'IN)
172	dns-classes)) 2))
173	(dolist (slot '(answers authorities additionals))
174	(dolist (resource (dns-get slot spec))
175	(dns-write-name (car resource))
176	(dns-write-bytes (cadr (assq (dns-get 'type resource) dns-query-types))
177	2)
178	(dns-write-bytes (cadr (assq (dns-get 'class resource) dns-classes))
179	2)
180	(dns-write-bytes (dns-get 'ttl resource) 4)
181	(dns-write-bytes (length (dns-get 'data resource)) 2)
182	(insert (dns-get 'data resource))))
183	(when tcp-p
184	(goto-char (point-min))
185	(dns-write-bytes (buffer-size) 2))
186	(buffer-string)))
187
188	(defun dns-read (packet)
189	(mm-with-unibyte-buffer
190	(let ((spec nil)
191	queries answers authorities additionals)
192	(insert packet)
193	(goto-char (point-min))
194	(push (list 'id (dns-read-bytes 2)) spec)
195	(let ((byte (dns-read-bytes 1)))
196	(push (list 'response-p (if (zerop (logand byte (lsh 1 7))) nil t))
197	spec)
198	(let ((opcode (logand byte (lsh 7 3))))
199	(push (list 'opcode
200	(cond ((eq opcode 0) 'query)
201	((eq opcode 1) 'inverse-query)
202	((eq opcode 2) 'status)))
203	spec))
204	(push (list 'authoritative-p (if (zerop (logand byte (lsh 1 2)))
205	nil t)) spec)
206	(push (list 'truncated-p (if (zerop (logand byte (lsh 1 2))) nil t))
207	spec)
208	(push (list 'recursion-desired-p
209	(if (zerop (logand byte (lsh 1 0))) nil t)) spec))
210	(let ((rc (logand (dns-read-bytes 1) 15)))
211	(push (list 'response-code
212	(cond
213	((eq rc 0) 'no-error)
214	((eq rc 1) 'format-error)
215	((eq rc 2) 'server-failure)
216	((eq rc 3) 'name-error)
217	((eq rc 4) 'not-implemented)
218	((eq rc 5) 'refused)))
219	spec))
220	(setq queries (dns-read-bytes 2))
221	(setq answers (dns-read-bytes 2))
222	(setq authorities (dns-read-bytes 2))
223	(setq additionals (dns-read-bytes 2))
224	(let ((qs nil))
225	(dotimes (i queries)
226	(push (list (dns-read-name)
227	(list 'type (dns-inverse-get (dns-read-bytes 2)
228	dns-query-types))
229	(list 'class (dns-inverse-get (dns-read-bytes 2)
230	dns-classes)))
231	qs))
232	(push (list 'queries qs) spec))
233	(dolist (slot '(answers authorities additionals))
234	(let ((qs nil)
235	type)
236	(dotimes (i (symbol-value slot))
237	(push (list (dns-read-name)
238	(list 'type
239	(setq type (dns-inverse-get (dns-read-bytes 2)
240	dns-query-types)))
241	(list 'class (dns-inverse-get (dns-read-bytes 2)
242	dns-classes))
243	(list 'ttl (dns-read-bytes 4))
244	(let ((length (dns-read-bytes 2)))
245	(list 'data
246	(dns-read-type
247	(buffer-substring
248	(point)
249	(progn (forward-char length) (point)))
250	type))))
251	qs))
252	(push (list slot qs) spec)))
253	(nreverse spec))))
254
255	(defun dns-read-type (string type)
256	(let ((buffer (current-buffer))
257	(point (point)))
258	(prog1
259	(mm-with-unibyte-buffer
260	(insert string)
261	(goto-char (point-min))
262	(cond
263	((eq type 'A)
264	(let ((bytes nil))
265	(dotimes (i 4)
266	(push (dns-read-bytes 1) bytes))
267	(mapconcat 'number-to-string (nreverse bytes) ".")))
268	((eq type 'NS)
269	(dns-read-string-name string buffer))
270	((eq type 'CNAME)
271	(dns-read-string-name string buffer))
272	(t string)))
273	(goto-char point))))
274
275	(defun dns-parse-resolv-conf ()
276	(when (file-exists-p "/etc/resolv.conf")
277	(with-temp-buffer
278	(insert-file-contents "/etc/resolv.conf")
279	(goto-char (point-min))
280	(while (re-search-forward "^nameserver[\t ]+\\([^ \t\n]+\\)" nil t)
281	(push (match-string 1) dns-servers))
282	(setq dns-servers (nreverse dns-servers)))))
283
284	;;; Interface functions.
285	(eval-when-compile
286	(when (featurep 'xemacs)
287	(require 'gnus-xmas)))
288
289	(defmacro dns-make-network-process (server)
290	(if (featurep 'xemacs)
291	`(let ((coding-system-for-read 'binary)
292	(coding-system-for-write 'binary))
293	(gnus-xmas-open-network-stream "dns" (current-buffer)
294	,server "domain" 'udp))
295	`(let ((server ,server)
296	(coding-system-for-read 'binary)
297	(coding-system-for-write 'binary))
298	(if (fboundp 'make-network-process)
299	(make-network-process
300	:name "dns"
301	:coding 'binary
302	:buffer (current-buffer)
303	:host server
304	:service "domain"
305	:type 'datagram)
306	;; Older versions of Emacs doesn't have
307	;; `make-network-process', so we fall back on opening a TCP
308	;; connection to the DNS server.
309	(open-network-stream "dns" (current-buffer) server "domain")))))
310
311	(defun query-dns (name &optional type fullp)
312	"Query a DNS server for NAME of TYPE.
313	If FULLP, return the entire record returned."
314	(setq type (or type 'A))
315	(unless dns-servers
316	(dns-parse-resolv-conf))
317
318	(if (not dns-servers)
319	(message "No DNS server configuration found")
320	(mm-with-unibyte-buffer
321	(let ((process (condition-case ()
322	(dns-make-network-process (car dns-servers))
323	(error
324	(message "dns: Got an error while trying to talk to %s"
325	(car dns-servers))
326	nil)))
327	(tcp-p (and (not (fboundp 'make-network-process))
328	(not (featurep 'xemacs))))
329	(step 100)
330	(times (* dns-timeout 1000))
331	(id (random 65000)))
332	(when process
333	(process-send-string
334	process
335	(dns-write `((id ,id)
336	(opcode query)
337	(queries ((,name (type ,type))))
338	(recursion-desired-p t))
339	tcp-p))
340	(while (and (zerop (buffer-size))
341	(> times 0))
342	(accept-process-output process 0 step)
343	(decf times step))
344	(ignore-errors
345	(delete-process process))
7dafe00b MB	346	(when (and tcp-p
7dafe00b MB	347	(>= (buffer-size) 2))
23f87bed MB	348	(goto-char (point-min))
23f87bed MB	349	(delete-region (point) (+ (point) 2)))
719120ef	350	(when (>= (buffer-size) 2)
23f87bed MB	351	(let ((result (dns-read (buffer-string))))
	352	(if fullp
	353	result
	354	(let ((answer (car (dns-get 'answers result))))
	355	(when (eq type (dns-get 'type answer))
	356	(dns-get 'data answer)))))))))))
	357
	358	(provide 'dns)
	359
	360	;;; arch-tag: d0edd0c4-4cce-4538-ae92-06c3356ee80a
	361	;;; dns.el ends here