(FILECREATED "24-Jan-84 11:53:46" {PHYLUM}<LISPCORE>LIBRARY>PUPIDSERVER.;1
 5385   

      changes to:  (FNS \HANDLE.PUP.LOOKUP)

      previous date: "28-OCT-83 16:36:18" {PHYLUM}<LISP>LIBRARY>PUPIDSERVER.;3)


(* Copyright (c) 1983, 1984 by Xerox Corporation)

(PRETTYCOMPRINT PUPIDSERVERCOMS)

(RPAQQ PUPIDSERVERCOMS
 [(FNS \PUP.ID.SERVER \HANDLE.PUP.LOOKUP \GET.PUP#.FROM.NS#)
			(INITVARS NS.TO.PUP.ALIST NS.TO.PUP.FILE)
			(DECLARE: EVAL@COMPILE DONTCOPY (GLOBALVARS NS.TO.PUP.ALIST NS.TO.PUP.FILE)
				  (FILES (LOADCOMP)
					 LLNS))
			(DECLARE: DONTEVAL@LOAD DOCOPY (P (* For old GATEWAY)
							  (/MOVD (QUOTE \PUP.ID.SERVER)
								 (QUOTE \PUPLOOKUP])
(DEFINEQ

(\PUP.ID.SERVER

  [LAMBDA (TRACEFLG)                                         (* bvm: "28-OCT-83 15:59")


          (* * Server that provides pup numbers given NS numbers. Works off alist NS.TO.PUP.ALIST)



    (RESETLST (PROG ((SOC (OPENNSOCKET \NS.WKS.PUPLOOKUP T))
		     XIP EVENT)
		    (RESETSAVE NIL (LIST (QUOTE CLOSENSOCKET)
					 SOC))
		    (COND
		      (TRACEFLG (printout
 TRACEFLG "Pup ID server started at " (DATE)
					  T)))
		RETRY
		    [COND
		      ((NLISTP NS.TO.PUP.ALIST)
			(COND
			  (NS.TO.PUP.FILE (SETQ NS.TO.PUP.ALIST (READFILE NS.TO.PUP.FILE)))
			  ((GETD (QUOTE NetDirNameLookup))   (* For use with GATEWAY, we are ok)

			    )
			  (T (ERROR 
			  "NS.TO.PUP.ALIST is empty, and there is no NS.TO.PUP.FILE to read from")
			     (GO RETRY]
		    (SETQ EVENT (NSOCKETEVENT SOC))
		LP  (COND
		      ((SETQ XIP (GETXIP SOC))
			(\HANDLE.PUP.LOOKUP
 SOC XIP TRACEFLG))
		      (T (AWAIT.EVENT EVENT)))
		    (GO LP])

(\HANDLE.PUP.LOOKUP

  [LAMBDA (NSOC XIP TRACEFILE)                               (* bvm: "24-Jan-84 11:48")


          (* * Handle requests for Pup lookup from NS hosts. This is designed to be called both from withing GATEWAY and in 

	  the standalone PUPIDSERVER)



    (DECLARE
 (GLOBALVARS \10MBLOCALNDB))
    (PROG (BUF PUP# NSHOST#)
          (COND
	    ((OR (NEQ (fetch
 (XIP XIPTYPE) of
 XIP)
		      \XIPT.PUPLOOKUP)
		 (NEQ (fetch
 (PACKETEXCHANGEXIP PACKETEXCHANGETYPE) of
 (SETQ BUF (fetch
 (XIP 
										      XIPCONTENTS)
										    of
 XIP)))
		      \EXTYPE.REQUEST))
	      (RELEASE.XIP XIP))
	    (T [SETQ NSHOST# (\LOADNSHOSTNUMBER (LOCF (fetch
 (PACKETEXCHANGEXIP PACKETEXCHANGEBODY)
							 of
 BUF]
                                                             (* Note: The following only handles 32 bit host numbers 

							     at the moment!)

	       [COND
		 [(SETQ PUP# (\GET.PUP#.FROM.NS#
 NSHOST#))
		   [AND \10MBLOCALNDB (push
 (ffetch
 (NDB NDBTRANSLATIONS) of
 \10MBLOCALNDB)
					    (CONS (fetch
 PUPHOST# of
 PUP#)
						  (LIST NSHOST# (CLOCK 0]
                                                             (* Add pup/ns translation to our table)

		   (replace
 (XIP XIPLENGTH) of
 XIP with
 (IPLUS \XIPOVLEN (UNFOLD 6 BYTESPERWORD)))

          (* Data: 2 words for ID, 1 for PACKETEXCHANGETYPE, 1 for PUP#. That's only 4, but Mesa 10.0 seems to want 6 words,

	  the last 2 being zero)



		   (replace
 (PACKETEXCHANGEXIP PACKETEXCHANGETYPE) of
 BUF with
 \EXTYPE.RESPONSE)
		   (SETQ BUF (LOCF (fetch
 (PACKETEXCHANGEXIP PACKETEXCHANGEBODY) of
 BUF)))
		   (\PUTBASE BUF 0 PUP#)
		   (\PUTBASE BUF 1 0)
		   (\PUTBASE BUF 2 0)
		   (COND
		     (TRACEFILE (PRINTNSHOSTNUMBER NSHOST# TRACEFILE)
				(printout
 TRACEFILE " = " (PORTSTRING PUP#)
					  T]
		 (T (RETURN (RELEASE.XIP XIP)))
		 (NIL 

          (* This is what to do for a negative response. However, the current state of the world is that we can't reliably 

	  give negative responses (someone else might know better), so skip this)



		      (replace
 (PACKETEXCHANGEXIP PACKETEXCHANGETYPE) of
 BUF with
 \EXTYPE.NEGATIVE)
		      (replace
 (XIP XIPLENGTH) of
 XIP with
 (IPLUS \XIPOVLEN (UNFOLD 3 BYTESPERWORD)))
		      (COND
			(TRACEFILE (printout
 TRACEFILE "No pup number for ")
				   (PRINTNSHOSTNUMBER NSHOST# TRACEFILE)
				   (TERPRI TRACEFILE]
	       (SWAPXIPADDRESSES XIP)
	       (replace
 (XIP XIPSOURCEHOST) of
 XIP with
 (\LOCALNSHOSTNUMBER))
	       (replace
 (XIP XIPSOURCENET) of
 XIP with
 (\LOCALNSNETNUMBER))
	       (replace
 EPREQUEUE of
 XIP with
 (QUOTE FREE))
	       (SENDXIP NSOC XIP])

(\GET.PUP#.FROM.NS#

  [LAMBDA (NSHOST#)                                          (* bvm: "28-OCT-83 16:35")

    (OR [AND (PROG1 (GETD (QUOTE NetDirNameLookup))          (* For use with GATEWAY)

		    )
	     (CAAR (NetDirNameLookup (MAKEOCTALSTRING (LIST (fetch
 (NSHOSTNUMBER NSHOST0)
							       of
 NSHOST#)
							    (fetch
 (NSHOSTNUMBER NSHOST1)
							       of
 NSHOST#)
							    (fetch
 (NSHOSTNUMBER NSHOST2)
							       of
 NSHOST#]
	(CDR (SASSOC NSHOST# NS.TO.PUP.ALIST])
)

(RPAQ? NS.TO.PUP.ALIST
 NIL)

(RPAQ? NS.TO.PUP.FILE
 NIL)
(DECLARE: EVAL@COMPILE DONTCOPY 
(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS NS.TO.PUP.ALIST NS.TO.PUP.FILE)
)

(FILESLOAD (LOADCOMP)
	   LLNS)
)
(DECLARE: DONTEVAL@LOAD DOCOPY 
(* For old GATEWAY)
(/MOVD (QUOTE \PUP.ID.SERVER)
       (QUOTE \PUPLOOKUP))
)
(PUTPROPS PUPIDSERVER COPYRIGHT ("Xerox Corporation" 1983 1984))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (673 4964 (\PUP.ID.SERVER 683 . 1652) (\HANDLE.PUP.LOOKUP 1654 . 4440) (
\GET.PUP#.FROM.NS# 4442 . 4962)))))
STOP