diff options
Diffstat (limited to 'lisp/gnus/dns.el')
| -rw-r--r-- | lisp/gnus/dns.el | 93 |
1 files changed, 79 insertions, 14 deletions
diff --git a/lisp/gnus/dns.el b/lisp/gnus/dns.el index fdbe9258686..7910261125a 100644 --- a/lisp/gnus/dns.el +++ b/lisp/gnus/dns.el @@ -51,11 +51,13 @@ If nil, /etc/resolv.conf will be consulted.") (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) @@ -252,6 +254,12 @@ If TCP-P, the first two bytes of the package with be the length field." (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))) @@ -265,9 +273,27 @@ If TCP-P, the first two bytes of the package with be the length field." (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)))) @@ -281,17 +307,32 @@ If TCP-P, the first two bytes of the package with be the length field." (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)) @@ -308,13 +349,32 @@ If TCP-P, the first two bytes of the package with be the length field." ;; connection to the DNS server. (open-network-stream "dns" (current-buffer) server "domain"))))) -(defun query-dns (name &optional type fullp) +(defvar dns-cache (make-vector 4096 0)) + +(defun query-dns-cached (name &optional type fullp reversep) + (let* ((key (format "%s:%s:%s:%s" name type fullp reversep)) + (sym (intern-soft key dns-cache))) + (if (and sym + (boundp sym)) + (symbol-value sym) + (let ((result (query-dns name type fullp reversep))) + (set (intern key dns-cache) result) + result)))) + +(defun query-dns (name &optional type fullp reversep) "Query a DNS server for NAME of TYPE. -If FULLP, return the entire record returned." +If FULLP, return the entire record returned. +If REVERSEP, look up an IP address." (setq type (or type 'A)) (unless dns-servers (dns-parse-resolv-conf)) + (when reversep + (setq name (concat + (mapconcat 'identity (nreverse (split-string name "\\.")) ".") + ".in-addr.arpa") + type 'PTR)) + (if (not dns-servers) (message "No DNS server configuration found") (mm-with-unibyte-buffer @@ -339,6 +399,7 @@ If FULLP, return the entire record returned." tcp-p)) (while (and (zerop (buffer-size)) (> times 0)) + (sit-for (/ step 1000.0)) (accept-process-output process 0 step) (decf times step)) (ignore-errors @@ -347,13 +408,17 @@ If FULLP, return the entire record returned." (>= (buffer-size) 2)) (goto-char (point-min)) (delete-region (point) (+ (point) 2))) - (when (>= (buffer-size) 2) + (when (and (>= (buffer-size) 2) + ;; We had a time-out. + (> times 0)) (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))))))))))) + (if (eq type 'TXT) + (dns-get-txt-answer (dns-get 'answers result)) + (dns-get 'data answer)))))))))))) (provide 'dns) |