(FILECREATED "24-Jan-84 11:52:05" {PHYLUM}<LISPCORE>LIBRARY>MINISERVE.;3
 11961  

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

      previous date: "23-Jan-84 16:22:22" {PHYLUM}<LISPCORE>LIBRARY>MINISERVE.;2)


(* Copyright (c) 1984 by Xerox Corporation)

(PRETTYCOMPRINT MINISERVECOMS)

(RPAQQ MINISERVECOMS
 [(FNS STARTMINISERVER)
		      (FNS \NSTIMESERVER \HANDLE.NS.TIMEREQ)
		      (FNS \PUPTIMESERVER \HANDLE.PUP.ALTOTIMEREQ)
		      (DECLARE: EVAL@COMPILE DONTCOPY (RECORDS TIMEPUPCONTENTS TIMEBODY)
				(CONSTANTS \TIMESOCKET \XIPT.EXCHANGE \EXTYPE.TIME \TIMEVERSION 
					   \TIMEOP.TIMEREQUEST \TIMEOP.TIMERESPONSE \NSTIMELENGTH 
					   \XIPOVLEN)
				(CONSTANTS \PUPSOCKET.MISCSERVICES \PT.ALTOTIMEREQUEST 
					   \PT.ALTOTIMERESPONSE \PUPOVLEN \TIMEPUPLENGTH)
				(GLOBALVARS \BeginDST \EndDST \TimeZoneComp))
		      (COMS (* PUPIDSERVER)
			    (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])
(DEFINEQ

(STARTMINISERVER

  [LAMBDA NIL                                                (* bvm: "23-Jan-84 16:13")

    (ADD.PROCESS (QUOTE (\PUPTIMESERVER
))
		 (QUOTE RESTARTABLE)
		 (QUOTE HARDRESET))
    (ADD.PROCESS (QUOTE (\NSTIMESERVER
))
		 (QUOTE RESTARTABLE)
		 (QUOTE HARDRESET))
    (ADD.PROCESS (QUOTE (\PUP.ID.SERVER))
		 (QUOTE RESTARTABLE)
		 (QUOTE HARDRESET))
    T])
)
(DEFINEQ

(\NSTIMESERVER

  [LAMBDA NIL                                                (* bvm: "23-Jan-84 15:22")

    (PROG ((SOCKET (OPENNSOCKET \TIMESOCKET T))
	   EVENT XIP)
          (RESETSAVE NIL (LIST (QUOTE CLOSENSOCKET)
			       SOCKET))
          (SETQ EVENT (NSOCKETEVENT SOCKET))
      LP  (COND
	    ((SETQ XIP (GETXIP SOCKET))
	      (SELECTC (fetch
 (XIP XIPTYPE) of
 XIP)
		       (\XIPT.EXCHANGE (SELECTC (fetch
 PACKETEXCHANGETYPE
						   of
 (fetch
 XIPCONTENTS of
 XIP))
						(\EXTYPE.TIME (\HANDLE.NS.TIMEREQ
 SOCKET XIP))
						(RELEASE.XIP XIP)))
		       (RELEASE.XIP XIP))
	      (BLOCK))
	    (T                                               (* Wait for a XIP)

	       (AWAIT.EVENT EVENT)))
          (GO LP])

(\HANDLE.NS.TIMEREQ

  [LAMBDA (SOCKET XIP)                                       (* bvm: "23-Jan-84 15:48")

    (DECLARE
 (GLOBALVARS \BeginDST \EndDST \TimeZoneComp))
    (PROG (DAYTIME0 BUF)
          [COND
	    ((NEQ (fetch
 TIMEVERSION of
 (SETQ BUF (fetch
 XIPCONTENTS of
 XIP)))
		  \TIMEVERSION)
	      (RETURN (RELEASE.XIP XIP]
          (SELECTC (fetch
 TIMEOP of
 BUF)
		   (\TIMEOP.TIMEREQUEST [replace
 TIMEVALUEHI of
 BUF
					   with
 (\HINUM (SETQ DAYTIME0 (\DAYTIME0 (\CREATECELL \FIXP]
					(replace
 TIMEVALUELO of
 BUF with
 (\LONUM DAYTIME0))
					(replace
 TIMEZONEHOURS of
 BUF
					   with
 (COND
						  ((ILESSP \TimeZoneComp 0)
						    (replace
 TIMEZONESIGN of
 BUF with
 1)
						    (IMINUS \TimeZoneComp))
						  (T (replace
 TIMEZONESIGN of
 BUF with
 0)
						     \TimeZoneComp)))
					(replace
 TIMEBEGINDST of
 BUF with
 \BeginDST)
					(replace
 TIMEENDDST of
 BUF with
 \EndDST)
					(replace
 TIMEOP of
 BUF with
 \TIMEOP.TIMERESPONSE)
					(replace
 XIPLENGTH of
 XIP with
 (IPLUS \NSTIMELENGTH \XIPOVLEN)
						 )
					(SWAPXIPADDRESSES XIP)
					(SENDXIP SOCKET XIP))
		   (RELEASE.XIP XIP])
)
(DEFINEQ

(\PUPTIMESERVER

  [LAMBDA NIL                                                (* bvm: "23-Jan-84 16:21")

    (PROG ((PUPSOC (OPENPUPSOCKET \PUPSOCKET.MISCSERVICES T))
	   EVENT PUP)
          (RESETSAVE NIL (LIST (QUOTE CLOSEPUPSOCKET)
			       PUPSOC))
          (SETQ EVENT (PUPSOCKETEVENT PUPSOC))
      LP  (COND
	    ((SETQ PUP (GETPUP PUPSOC))
	      (SELECTC (fetch
 (PUP PUPTYPE) of
 PUP)
		       (\PT.ALTOTIMEREQUEST (\HANDLE.PUP.ALTOTIMEREQ
 PUPSOC PUP))
		       NIL)
	      (BLOCK))
	    (T                                               (* Wait for a Pup)

	       (AWAIT.EVENT EVENT)))
          (GO LP])

(\HANDLE.PUP.ALTOTIMEREQ

  [LAMBDA (MISCSOC PUP)                                      (* bvm: "16-NOV-83 10:48")


          (* * Alto time request)



    (PROG [(DATA (fetch
 (PUP PUPCONTENTS) of
 PUP))
	   (TIME (ALTO.TO.LISP.DATE (IDATE]
          (SWAPPUPPORTS PUP)
          (replace
 TIMEPUPVALUEHI of
 DATA with
 (\HINUM TIME))
          (replace
 TIMEPUPVALUELO of
 DATA with
 (\LONUM TIME))
          (COND
	    ((MINUSP \TimeZoneComp)
	      (replace
 TIMEPUPEASTP of
 DATA with
 T)
	      (replace
 TIMEPUPHOURS of
 DATA with
 (IMINUS \TimeZoneComp)))
	    (T (replace
 TIMEPUPEASTP of
 DATA with
 NIL)
	       (replace
 TIMEPUPHOURS of
 DATA with
 \TimeZoneComp)))
          (replace
 TIMEPUPMINUTES of
 DATA with
 0)
          (replace
 TIMEPUPBEGINDST of
 DATA with
 \BeginDST)
          (replace
 TIMEPUPENDDST of
 DATA with
 \EndDST)
          (replace
 (PUP PUPTYPE) of
 PUP with
 \PT.ALTOTIMERESPONSE)
          (replace
 (PUP PUPLENGTH) of
 PUP with
 (CONSTANT (IPLUS \PUPOVLEN \TIMEPUPLENGTH)))
          (SENDPUP MISCSOC PUP)
          (\RELEASE.ETHERPACKET PUP])
)
(DECLARE: EVAL@COMPILE DONTCOPY 
[DECLARE: EVAL@COMPILE 

(BLOCKRECORD TIMEPUPCONTENTS
 ((TIMEPUPVALUEHI WORD)
			      (TIMEPUPVALUELO WORD)
			      (TIMEPUPEASTP FLAG)
			      (TIMEPUPHOURS BITS 7)
			      (TIMEPUPMINUTES BITS 8)
			      (TIMEPUPBEGINDST WORD)
			      (TIMEPUPENDDST WORD))          (* format of alto time response)

			     )

(BLOCKRECORD TIMEBODY
 ((NIL 3 WORD)                          (* Packet exchange header)

		       (TIMEVERSION WORD)                    (* Protocol version)

		       (TIMEOP WORD)                         (* What kind of request/response)

		       (TIMEVALUE FIXP)
		       (TIMEZONESIGN WORD)                   (* 0 = west of prime meridian, 1 = east)

		       (TIMEZONEHOURS WORD)                  (* Hours from prime meridian)

		       (TIMEZONEMINUTES WORD)                (* Minutes ...)

		       (TIMEBEGINDST WORD)                   (* Day of year when DST starts)

		       (TIMEENDDST WORD)                     (* Day of year when DST stops)

		       )
		      (BLOCKRECORD TIMEBODY ((NIL 5 WORD)
				    (TIMEVALUEHI WORD)
				    (TIMEVALUELO WORD))))
]

(DECLARE: EVAL@COMPILE 

(RPAQQ \TIMESOCKET
 8)

(RPAQQ \XIPT.EXCHANGE
 4)

(RPAQQ \EXTYPE.TIME
 1)

(RPAQQ \TIMEVERSION
 2)

(RPAQQ \TIMEOP.TIMEREQUEST
 1)

(RPAQQ \TIMEOP.TIMERESPONSE
 2)

(RPAQQ \NSTIMELENGTH
 24)

(RPAQQ \XIPOVLEN
 30)

(CONSTANTS \TIMESOCKET \XIPT.EXCHANGE \EXTYPE.TIME \TIMEVERSION \TIMEOP.TIMEREQUEST 
	   \TIMEOP.TIMERESPONSE \NSTIMELENGTH \XIPOVLEN)
)

(DECLARE: EVAL@COMPILE 

(RPAQQ \PUPSOCKET.MISCSERVICES
 4)

(RPAQQ \PT.ALTOTIMEREQUEST
 134)

(RPAQQ \PT.ALTOTIMERESPONSE
 135)

(RPAQQ \PUPOVLEN
 22)

(RPAQQ \TIMEPUPLENGTH
 10)

(CONSTANTS \PUPSOCKET.MISCSERVICES \PT.ALTOTIMEREQUEST \PT.ALTOTIMERESPONSE \PUPOVLEN \TIMEPUPLENGTH)
)

(DECLARE: DOEVAL@COMPILE DONTCOPY

(ADDTOVAR GLOBALVARS \BeginDST \EndDST \TimeZoneComp)
)
)



(* PUPIDSERVER)


(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)
)
(PUTPROPS MINISERVE COPYRIGHT ("Xerox Corporation" 1984))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1115 1515 (STARTMINISERVER 1125 . 1513)) (1516 3535 (\NSTIMESERVER 1526 . 2286) (
\HANDLE.NS.TIMEREQ 2288 . 3533)) (3536 5388 (\PUPTIMESERVER 3546 . 4184) (\HANDLE.PUP.ALTOTIMEREQ 4186
 . 5386)) (7367 11658 (\PUP.ID.SERVER 7377 . 8346) (\HANDLE.PUP.LOOKUP 8348 . 11134) (
\GET.PUP#.FROM.NS# 11136 . 11656)))))
STOP