;;; -*- Mode: Common-Lisp; Package: NAME; Base: 10.; Patch-File: T -*-
;;; Written 16-Dec-88 16:40:09 by Victor,
;;; Reason: Made NAME:DNS-STUB-MAKE-HOST-OBJECT handle things better.  Also, if Italic-Lock is
;;; depressed, don't handle errors from stub resolver.
;;; while running on Jim Beam 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.3,
;;;  TI-PROLOG 2.11, GRAPHICS-WINDOW 4.1, GED 4.1, TREE 4.0, VISIDOC-SERVER 4.0, Experimental SYSTEM-PATCHES 3.118,
;;;  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.6,  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.#"



(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-if (not (dbg:debug-p :italic-lock)) (cond)
	       (values-list (append (multiple-value-list (dns:stub-canonicalize-case spec servers)) (list spec)))
	     (error nil))))
    (multiple-value-bind (cname addresses spec)
	(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))
	     (alias (and spec (nth-value 1 (dns:stub-get-canonical-name-of-name spec servers))))
	     (alias-name (and alias (format nil "~{~a~^.~}" alias)))
	     (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
				   :aliases ,(when alias (list alias-name))
				   :system-type ,(second hinfo)
				   :machine-type ,(first hinfo)
				   :services ((:status :tcp :ip-status)
					      ,@(or wks
						    (get :ip :default-network-services)))
				   (:addresses :group)
				   ,(loop for addr in addresses
					  collect (list :ip (ethernet:dotted-format-ip-address addr)))))))))

;;; Tremendous

))