;;; dns.el --- Domain Name Service lookups
-;; Copyright (C) 2002, 2003 Free Software Foundation, Inc.
+;; Copyright (C) 2002, 2003, 2004 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: network
(MR 9)
(NULL 10)
(WKS 11)
- (PRT 12)
+ (PTR 12)
(HINFO 13)
(MINFO 14)
(MX 15)
(TXT 16)
+ (AAAA 28) ; RFC3596
+ (SRV 33) ; RFC2782
(AXFR 252)
(MAILB 253)
(MAILA 254)
(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)
- (dns-read-string-name string buffer))
- ((eq type 'CNAME)
+ ((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 'SRV)
+ (list (list 'priority (dns-read-bytes 2))
+ (list 'weight (dns-read-bytes 2))
+ (list 'port (dns-read-bytes 2))
+ (list 'target (dns-read-name buffer))))
+ ((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))))
(push (match-string 1) dns-servers))
(setq dns-servers (nreverse dns-servers)))))
-;;; Interface functions.
-(eval-when-compile
- (when (featurep 'xemacs)
- (require 'gnus-xmas)))
+(defun dns-read-txt (string)
+ (if (> (length string) 1)
+ (substring string 1)
+ string))
+(defun dns-get-txt-answer (answers)
+ (let ((result "")
+ (do-next nil))
+ (dolist (answer answers)
+ (dolist (elem answer)
+ (when (consp elem)
+ (cond
+ ((eq (car elem) 'type)
+ (setq do-next (eq (cadr elem) 'TXT)))
+ ((eq (car elem) 'data)
+ (when do-next
+ (setq result (concat result (dns-read-txt (cadr elem))))))))))
+ result))
+
+;;; Interface functions.
(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))
+ (open-network-stream "dns" (current-buffer)
+ ,server "domain" 'udp))
`(let ((server ,server)
(coding-system-for-read 'binary)
(coding-system-for-write 'binary)
result
(let ((answer (car (dns-get 'answers result))))
(when (eq type (dns-get 'type answer))
- (dns-get 'data answer)))))))))))
+ (if (eq type 'TXT)
+ (dns-get-txt-answer (dns-get 'answers result))
+ (dns-get 'data answer))))))))))))
(provide 'dns)