;;; -*- Mode:Lisp; Readtable:CL; Package:USER; Base:10; Patch-File:T -*-
;;; Patch file for System version 121.5
;;; Reason:
;;;  Make sure main name comes last in list of host names
;;;   when parsing a HOSTS2 table.
;;; Written 13-Jan-87 14:37:45 by PHILIPP at site LMI Cambridge
;;; while running on Curley from band 2
;;; with Experimental System 121.4, Experimental Lambda-Diag 15.0, Experimental ZMail 70.0, Experimental KERMIT 32.0, Experimental Unix-Interface 10.0, Experimental Local-File 72.0, Experimental FILE-Server 21.0, Experimental Tape 13.0, Experimental TCP-Kernel 41.0, Experimental TCP-User 64.0, Experimental TCP-Server 47.0, Experimental DOE-Macsyma 22.0, microcode 1730, SDU Boot Tape 3.14, SDU ROM 103.



; From file DJ: L.NETWORK; TABLE.LISP#8 at 13-Jan-87 14:37:46
#10R NETWORK#: 
(COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "NETWORK")))
  (COMPILER::PATCH-SOURCE-FILE "SYS: NETWORK; TABLE  "

(DEFUN GENERATE-FROM-HOSTS2-TABLE-2 (INPUT-FILE OUTPUT-STREAM)
  (WITH-OPEN-FILE (INPUT-STREAM INPUT-FILE :DIRECTION :INPUT :CHARACTERS T)
    (DO ((LINE) (EOF)
	 (I) (J)
	 (NI) (NJ)
	 (HOSTL) (DELIM)
	 (RESULT))
	(NIL)
      (MULTIPLE-VALUE (LINE EOF)
	(SEND INPUT-STREAM :LINE-IN NIL))
      (AND EOF (RETURN RESULT))
      (MULTIPLE-VALUE (I J)
	(PARSE-HOSTS2-TABLE-TOKEN LINE 0))
      (COND ((AND I (STRING-EQUAL LINE "HOST" :START1 I :END1 J))
	     ;; Host name
	     (MULTIPLE-VALUE (NI NJ)
	       (PARSE-HOSTS2-TABLE-TOKEN LINE (1+ J)))
	     (MULTIPLE-VALUE (I J DELIM)
	       (PARSE-HOSTS2-TABLE-TOKEN LINE (1+ NJ)))
	     (SETQ HOSTL (NCONS (SUBSTRING LINE NI NJ)))
	     (IF (CHAR= DELIM #\[)
		 (DO ((L NIL)
		      (I1) (J1))
		     ((CHAR= DELIM #\])
		      (INCF J)
		      (NREVERSE L))
		   (MULTIPLE-VALUE (I1 J1 DELIM)
		     (PARSE-HOSTS2-TABLE-TOKEN LINE (1+ J)))
		   (IF (CHAR= DELIM #\SP)
		       (MULTIPLE-VALUE (I J DELIM)
			 (PARSE-HOSTS2-TABLE-TOKEN LINE (1+ J1)))
		       (SETQ I I1 J J1 J1 I1))
		   (ADD-HOSTS2-TABLE-ADDRESS LINE I1 J1 I J HOSTL))
		 (LET ((I1 I) (J1 J))
		   (IF (char= DELIM #\SP)
		       (MULTIPLE-VALUE (I J)
			 (PARSE-HOSTS2-TABLE-TOKEN LINE (1+ J)))
		       (SETQ I I1 J J1 J1 I1))
		   (ADD-HOSTS2-TABLE-ADDRESS LINE I1 J1 I J HOSTL)))
;	     (COND ((OR (GET HOSTL :CHAOS)	;If there were any chaosnet addresses
;			;; Include some popular ARPA sites for speed in SUPDUP/TELNET, etc.
;			(SYS:MEMBER-EQUAL (CAR HOSTL) INCLUDED-NON-CHAOS-HOSTS))
	     (DOTIMES (K 2)
	       (MULTIPLE-VALUE (I J DELIM)
		 (PARSE-HOSTS2-TABLE-TOKEN LINE (1+ J))))
	     (WHEN I
	       (PUTPROP HOSTL (INTERN (SUBSTRING LINE I J) "") :SYSTEM-TYPE))
	     (MULTIPLE-VALUE (I J DELIM)
	       (PARSE-HOSTS2-TABLE-TOKEN LINE (1+ J)))
	     (WHEN I
	       (PUTPROP HOSTL (INTERN (SUBSTRING LINE I J) "") :MACHINE-TYPE))
	     (MULTIPLE-VALUE (I J DELIM)
	       (PARSE-HOSTS2-TABLE-TOKEN LINE (1+ J)))
	     (OR I (SETQ DELIM -1))
	     (let* ((first-name (car hostl))
		    (namel (ncons first-name)))
	       (AND (CHAR= DELIM #\[)
		    (DO () ((CHAR= DELIM #\])
			    (SETQ NAMEL (STABLE-SORT NAMEL
						     #'(LAMBDA (X Y)
							 ;; EQ is OK here...
							 (and (not (eq x first-name))
							      (< (STRING-LENGTH X)
								 (STRING-LENGTH Y)))))))
		      (MULTIPLE-VALUE (I J DELIM)
			(PARSE-HOSTS2-TABLE-TOKEN LINE (1+ J)))
		      (unless (equal i j) ;kmc-dle's suggestion for avoiding null hostnames
			(PUSH (SUBSTRING LINE I J) NAMEL))))
	       (setf (get hostl :host-names) namel))
	     (if output-stream
		 (let ((*package* (or (find-package si:*force-package*) *package*)))
		      (format output-stream "(~S ~S~{~%  '~S '~S~})~2%"
			      'si::define-host (car hostl) (cdr hostl)))
	       (push hostl result)))))))

))