;;; -*- Mode: Common-Lisp; Package: NAME; Base: 10.; Patch-File: T -*- ;;; Written 06-Dec-88 21:21:43 by Victor, ;;; Reason: 1. Start using negative caching - timeout on *dns-stub-negative-cache-timeout* (5 minutes). ;;; 2. Use the SAFETY-BELT-SERVERS instance variable for servers to use!!! ;;; 3. Don't try a root name as last resort - there are no top level hosts. ;;; while running on George Ballantine from band LOD2 ;;; With SYSTEM 4.61, VIRTUAL-MEMORY 4.4, EH 4.5, MAKE-SYSTEM 4.5, MICRONET 4.5, LOCAL-FILE 4.1, ;;; BASIC-PATHNAME 4.12, NETWORK-SUPPORT-COLD 4.1, NAMESPACE 4.22, NETWORK-NAMESPACE 4.2, ;;; DISK-IO 4.13, DISK-LABEL 4.0, BASIC-FILE 4.7, MAC-PATHNAME 4.5, NETWORK-PATHNAME 4.1, ;;; COMPILER 4.13, TV 4.85, DATALINK 4.14, CHAOSNET 4.18, GC 4.3, MEMORY-AUX 4.0, ;;; NVRAM 4.6, SYSLOG 4.0, STREAMER-TAPE 4.4, UCL 4.1, INPUT-EDITOR 4.0, METER 4.3, ;;; ZWEI 4.18, DEBUG-TOOLS 4.2, NETWORK-SUPPORT 4.5, NETWORK-SERVICE 4.0, DATALINK-DISPLAYS 4.0, ;;; FONT-EDITOR 4.0, SERIAL 4.0, PRINTER 4.8, PRINTER-TYPES 4.2, IMAGEN 4.0, SUGGESTIONS 4.0, ;;; MAIL-DAEMON 4.7, MAIL-READER 4.6, TELNET 4.1, VT100 4.6, NAMESPACE-EDITOR 4.5, ;;; PROFILE 4.4, VISIDOC 4.5, IP 3.19, RPC 4.14, NFS 3.2, Experimental NFS-PATCHES 2.2, ;;; TI-PROLOG 2.11, GRAPHICS-WINDOW 4.1, GED 4.1, TREE 4.0, VISIDOC-SERVER 4.0, Experimental SYSTEM-PATCHES 3.115, ;;; Experimental ICU-DOCS 11.4, Experimental SYSTEM-ENHANCEMENTS 18.27, Experimental TCP-IMAGEN 9.5, ;;; Experimental NAME-DRAGON 3.2, Experimental TEXINFO 5.5, Experimental ICU-LIBRARY 13.10, ;;; Experimental DOMAIN 5.0, Experimental STUB-RESOLVER 1.2, microcode 534, Band Name: 4.61 w DNS&Prolog, ;;; 881122/Vic #!C ; From file STUB-NAMESPACE.LISP#> ICU.NETWORK.DNS; JJ: #10R NAME#: (COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "NAME")) (SI:*LISP-MODE* :COMMON-LISP) (*READTABLE* SYS:COMMON-LISP-READTABLE) (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*)) (COMPILER#:PATCH-SOURCE-FILE "DNS: DNS; STUB-NAMESPACE.#" (defvar *dns-stub-negative-cache-timeout* (* 60 5) "Number of seconds no cache negative answers. Should use DNS TTL instead.") )) #!C ; From file STUB-NAMESPACE.LISP#> ICU.NETWORK.DNS; JJ: #10R NAME#: (COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "NAME")) (SI:*LISP-MODE* :COMMON-LISP) (*READTABLE* SYS:COMMON-LISP-READTABLE) (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*)) (COMPILER#:PATCH-SOURCE-FILE "DNS: DNS; STUB-NAMESPACE.#" (defmethod (dns-stub-namespace :find-object) (name class) "Finds the actual object named NAME,CLASS in the namespace. Returns the actual database object or nil if the object does not exist. FOR INTERNAL USE BY THE NAMESPACE ONLY. Ignores delete status. In the DNS-STUB-NAMESPACE case, do a DNS lookup if the object isn't found, and save the result." (when *dns-stub-resolver-enabled* (let ((obj (with-stack-list* (key-space name class) (gethash key-space namespace)))) (cond ((null obj) ;Never heard of it, try to find it (setq obj (send self :very-internal-find-object name class)) (when (null obj) ;Not found, cache a miss (setq obj (send self :put-object (build-object name class nil))) (send self :mark-object-updated obj) (object-put-property obj :cache-miss t) (setf (object-deleted obj) t))) ((and (object-deleted obj) ;Cached a miss for this before? (object-get-property obj :cache-miss)) (if (< (- (get-universal-time) (object-get-property obj :last-update)) *dns-stub-negative-cache-timeout*) obj ;Hasn't timed out yet. ;;Cache miss timed out, try again to find it. (when (null (setq obj (send self :very-internal-find-object name class))) ;;Cache a miss again. (setq obj (send self :put-object (build-object name class nil))) (send self :mark-object-updated obj) (object-put-property obj :cache-miss t) (setf (object-deleted obj) t))))) (when (and obj (null (object-get-property obj :last-update))) (object-put-property obj :last-update 0)) obj))) )) #!C ; From file STUB-NAMESPACE.LISP#> ICU.NETWORK.DNS; JJ: #10R NAME#: (COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "NAME")) (SI:*LISP-MODE* :COMMON-LISP) (*READTABLE* SYS:COMMON-LISP-READTABLE) (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*)) (COMPILER#:PATCH-SOURCE-FILE "DNS: DNS; STUB-NAMESPACE.#" (defmethod (dns-stub-namespace :very-internal-find-object) (name class) (declare (values internal-object)) (when (eq class :host) (let ((object (dns-stub-make-host-object name safety-belt-servers))) (when object (send self :mark-object-updated object) (send self :put-object object)) object))) )) #!C ; From file STUB-NAMESPACE.LISP#> ICU.NETWORK.DNS; JJ: #10R NAME#: (COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "NAME")) (SI:*LISP-MODE* :COMMON-LISP) (*READTABLE* SYS:COMMON-LISP-READTABLE) (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*)) (COMPILER#:PATCH-SOURCE-FILE "DNS: DNS; STUB-NAMESPACE.#" (defun dns-stub-make-host-object (host servers) (flet ((find-cname-and-addresses (spec) (dbg:when-debug (format *trace-output* "~&Trying ~s..." spec)) (condition-case (cond) (dns:stub-canonicalize-case spec servers) (error nil)))) (multiple-value-bind (cname addresses) (cond ((char= #\. (char host (1- (length host)))) (find-cname-and-addresses host)) ((find #\. host :test #'char=) (find-cname-and-addresses (string-append host "."))) (t (loop with cname and addresses for search in *dns-stub-domain-search-list* as spec = (string-append host "." search ".") do (multiple-value-setq (cname addresses) (find-cname-and-addresses spec)) when (and (not (null cname)) (not (null addresses))) do (return (values cname addresses)) ;;Don't try top level - there are no top level hosts. ; finally ; (return ; (find-cname-and-addresses (string-append host "."))) ))) (when (or (null cname) (null addresses)) (return-from dns-stub-make-host-object nil)) (let ((name (format nil "~{~a~^.~}" cname)) (short-name (first cname)) ;**** Might want this only on local domain(s)? (in search-list?) (any (dns:stub-get-any-info-of-name cname servers)) (hinfo nil) (wks nil)) (if (and (assoc :hinfo any) (assoc :wks any)) (setq hinfo (canonicalize-hinfo (first (cdr (assoc :hinfo any)))) wks (make-services-from-ip-wks-records (cdr (assoc :wks any)))) (setq hinfo (canonicalize-hinfo (dns:stub-get-host-info-of-name cname servers)) wks (make-services-from-ip-wks-records (dns:stub-get-wks-of-name cname servers)))) (build-object name :host `(:short-name ,short-name :system-type ,(second hinfo) :machine-type ,(first hinfo) :services ,(or (get :ip :default-network-services) `((:status :tcp :ip-status) ,@wks)) (:addresses :group) ,(loop for addr in addresses collect (list :ip (ethernet:dotted-format-ip-address addr))))))))) ;;; Tremendous ))