;;; -*- Mode: Common-Lisp; Package: NAME; Base: 10.; Patch-File: T -*-
;;; Patch file for STUB-RESOLVER version 1.4
;;; Reason: Apply search-list when looking in hash table.
;;; Written 06-Dec-88 21:41:04 by Victor,
;;; 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.#"


(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
	    (if (find #\. name :test #'char=)
		(with-stack-list* (key-space name class)
		  (gethash key-space namespace))
		;; Apply search-list when looking in hash table
		(dolist (search *dns-stub-domain-search-list*)
		  (with-stack-list* (key-space (string-append name "." search) class)
		    (let ((x (gethash key-space namespace)))
		      (when x (return x))))))))
      (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)))

))