Doc fix.
authorLars Magne Ingebrigtsen <larsi@gnus.org>
Sun, 31 Mar 2002 01:56:19 +0000 (01:56 +0000)
committerLars Magne Ingebrigtsen <larsi@gnus.org>
Sun, 31 Mar 2002 01:56:19 +0000 (01:56 +0000)
lisp/ChangeLog
lisp/dns.el

index 5a9d6ca..5222cda 100644 (file)
@@ -1,3 +1,7 @@
+2002-03-31  Lars Magne Ingebrigtsen  <larsi@gnus.org>
+
+       * dns.el: New file.
+
 2002-03-28  Simon Josefsson  <jas@extundo.com>
 
        * gnus-sum.el (gnus-summary-dummy-line-format):
index f509a21..5f81a21 100644 (file)
 
 ;;; Code:
 
+(require 'mm-util)
+
+(defvar dns-timeout 5
+  "How many seconds to wait when doing DNS queries.")
+
+;;; Internal code:
+
 (defvar dns-query-types
   '((A 1)
     (NS 2)
       (mapconcat 'identity (nreverse name) "."))))
 
 (defun dns-write (spec)
-  "Write a DNS packet according to SPEC.
-\(dns-write '((id 2) (opcode query) (queries (("www.gnus.org")))))"
+  "Write a DNS packet according to SPEC."
   (with-temp-buffer
     (dns-write-bytes (dns-get 'id spec) 2)
     (dns-write-bytes
 
 (defun query-dns (name &optional type)
   "Query a DNS server for NAME of TYPE."
+  (setq type (or type 'A))
   (mm-with-unibyte-buffer
     (let ((coding-system-for-read 'binary)
          (coding-system-for-write 'binary))
              :buffer (current-buffer)
              :host "ns2.netfonds.no"
              :service "domain"
-             :type 'datagram)))
+             :type 'datagram))
+           (step 100)
+           (times (* dns-timeout 1000)))
        (process-send-string
         process
         (dns-write `((id 4)
                      (opcode query)
-                     (queries ((,name)))
+                     (queries ((,name (type ,type))))
                      (recursion-desired-p t))))
-       (while (zerop (buffer-size))
-         (accept-process-output process 1))
-       (dns-read (buffer-string))))))
+       (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)))))))
     
-
 (provide 'dns)
 
 ;;; dns.el ends here