;;; dns.el --- Domain Name Service lookups
-;; Copyright (C) 2002 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: network
;;; 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
(MR 9)
(NULL 10)
(WKS 11)
- (PRT 12)
+ (PTR 12)
(HINFO 13)
(MINFO 14)
(MX 15)
(TXT 16)
+ (AAAA 28) ; RFC3596
(AXFR 252)
(MAILB 253)
(MAILA 254)
(progn (forward-char length) (point)))
name))))
(if (stringp ended)
- (concat (mapconcat 'identity (nreverse name) ".") "." ended)
+ (if (null name)
+ ended
+ (concat (mapconcat 'identity (nreverse name) ".") "." ended))
(mapconcat 'identity (nreverse name) "."))))
-(defun dns-write (spec)
- "Write a DNS packet according to SPEC."
+(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
(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)
(push (list slot qs) spec)))
(nreverse spec))))
+(defun dns-read-int32 ()
+ ;; Full 32 bit Integers can't be handled by Emacs. If we use
+ ;; floats, it works.
+ (format "%.0f" (+ (* (dns-read-bytes 1) 16777216.0)
+ (dns-read-bytes 3))))
+
(defun dns-read-type (string type)
(let ((buffer (current-buffer))
(point (point)))
(dotimes (i 4)
(push (dns-read-bytes 1) bytes))
(mapconcat 'number-to-string (nreverse bytes) ".")))
- ((eq type 'NS)
+ ((eq type 'AAAA)
+ (let (hextets)
+ (dotimes (i 8)
+ (push (dns-read-bytes 2) hextets))
+ (mapconcat (lambda (n) (format "%x" n)) (nreverse hextets) ":")))
+ ((eq type 'SOA)
+ (list (list 'mname (dns-read-name buffer))
+ (list 'rname (dns-read-name buffer))
+ (list 'serial (dns-read-int32))
+ (list 'refresh (dns-read-int32))
+ (list 'retry (dns-read-int32))
+ (list 'expire (dns-read-int32))
+ (list 'minimum (dns-read-int32))))
+ ((eq type 'MX)
+ (cons (dns-read-bytes 2) (dns-read-name buffer)))
+ ((or (eq type 'CNAME) (eq type 'NS) (eq type 'PTR))
(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))
+ (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)
- "Query a DNS server for NAME of TYPE."
+(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))
- (mm-with-unibyte-buffer
- (let ((coding-system-for-read 'binary)
- (coding-system-for-write 'binary))
- (let ((process
- (make-network-process
- :name "dns"
- :coding 'binary
- :buffer (current-buffer)
- :host "ns2.netfonds.no"
- :service "domain"
- :type 'datagram))
+ (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)))
- (process-send-string
- process
- (dns-write `((id 4)
- (opcode query)
- (queries ((,name (type ,type))))
- (recursion-desired-p t))))
- (while (and (zerop (buffer-size))
- (> times 0))
- (accept-process-output process 0 step)
- (decf times step))
- (ignore-errors
- (delete-process process))
- (let ((answer (car (dns-get 'answers (dns-read (buffer-string))))))
- (when (eq type (dns-get 'type answer))
- (dns-get 'data answer)))))))
-
+ (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 tcp-p
+ (goto-char (point-min))
+ (delete-region (point) (+ (point) 2)))
+ (unless (zerop (buffer-size))
+ (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)
;;; dns.el ends here
projects / gnus / blobdiff