;;; -*- Mode: Common-Lisp; Package: NET; Base: 10.; Patch-File: T -*-
;;; Written 07-Dec-88 16:16:04 by Victor,
;;; Reason: Patched NET:HOST-EQUIVALENT-P to check if some class of addresses are equal.
;;; This makes the mailer work again, since it realizes that "ICU|John-Jameson"  "DNS|John-Jameson.DoCS.UU.SE".
;;; 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.117,
;;;  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.4,  microcode 534, Band Name: 4.61 w DNS&Prolog,
;;;  881122/Vic

#!C
; From file HOSTS.LISP#> RELEASE-4.NETWORK-SUPPORT; JJ:
#10R NET#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "NET"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: NETWORK-SUPPORT; HOSTS.#"


(defun host-equivalent-p (host1 host2)
  (setf host1 (net:parse-host host1 :no-error))
  (setf host2 (net:parse-host host2 :no-error))
  (cond ((and host1 host2 (eq host1 host2))
	 (return-from host-equivalent-p t))
	(t
	 (let* ((host-object1 (when host1 (name:lookup-object (send host1 :name) :host)))
		(host-object2 (when host2 (name:lookup-object (send host2 :name) :host)))
		(host1-alias  (when host-object1
				(net:parse-host
				  (name:get-attribute-value host-object1 name:*alias-of*)
				  :no-error)))
		(host2-alias  (when host-object2
				(net:parse-host
				  (name:get-attribute-value host-object2 name:*alias-of*)
				  :no-error))))
	   
	   (cond ((and host1-alias host2-alias)
		  (or (and (neq host2 host2-alias  )
			   (host-equivalent-p   host1        host2-alias))
		      (and (neq host1 host1-alias)
			   (host-equivalent-p   host1-alias  host2))
		      (and (neq host1 host1-alias  )
			   (neq host2 host2-alias  )
			   (host-equivalent-p   host1-alias  host2-alias))))
		 
		 ((and host1-alias (neq host1 host1-alias  ))
		  (host-equivalent-p host1-alias host2))
		 
		 ((and host2-alias (neq host2 host2-alias  ))
		  (host-equivalent-p host2-alias host1))
		 ;;[Vic 881207]  This is to test DNS hosts equivalence with NS hosts.
		 ;; If some class of addresses are equal, the hosts are deemed to be equivalent.
		 ((and host1 host2)
		  (let ((a1 (send host1 :addresses))
			(a2 (send host2 :addresses)))
		    (and a1 a2
			 (not (null (intersection a1 a2
				     :test #'(lambda (a b)
					       (and (eq (first a) (first b))
						    ;; Addresses are not ordered
						    (null (set-difference (rest a) (rest b)))))))))))
		 )))))

))