(FILECREATED "12-Jun-84 15:43:13" {ERIS}<LISPCORE>LIBRARY>MINISERVE.;3 12353
changes to: (RECORDS TIMEBODY TIMEXIP)
(FNS \HANDLE.NS.TIMEREQ \HANDLE.PUP.LOOKUP)
(VARS MINISERVECOMS)
previous date: "26-May-84 14:49:30" {ERIS}<LISPCORE>LIBRARY>MINISERVE.;2)
(* Copyright (c) 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT MINISERVECOMS)
(RPAQQ MINISERVECOMS [(FNS STARTMINISERVER)
(FNS \NSTIMESERVER \HANDLE.NS.TIMEREQ)
(FNS \PUPTIMESERVER \HANDLE.PUP.ALTOTIMEREQ)
(DECLARE: EVAL@COMPILE DONTCOPY (RECORDS TIMEPUPCONTENTS TIMEXIP)
(CONSTANTS \TIMESOCKET \XIPT.EXCHANGE \EXTYPE.TIME \XIPT.OLDTIME
\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: "26-May-84 14:43")
(PROG ((SOCKET (OPENNSOCKET \TIMESOCKET T))
EVENT XIP)
(RESETSAVE NIL (LIST (QUOTE CLOSENSOCKET)
SOCKET))
(SETQ EVENT (NSOCKETEVENT SOCKET))
LP (COND
((SETQ XIP (GETXIP SOCKET))
(\HANDLE.NS.TIMEREQ SOCKET XIP)
(BLOCK))
(T (* Wait for a XIP)
(AWAIT.EVENT EVENT)))
(GO LP])
(\HANDLE.NS.TIMEREQ
[LAMBDA (SOCKET XIP) (* bvm: "12-Jun-84 15:15")
(DECLARE (GLOBALVARS \BeginDST \EndDST \TimeZoneComp))
(PROG (DAYTIME0 BUF LENGTH)
(SELECTC (fetch (XIP XIPTYPE) of (SETQ BUF XIP))
(\XIPT.EXCHANGE (* Official NS time protocol)
[COND
((OR (NEQ (fetch PACKETEXCHANGETYPE of XIP)
\EXTYPE.TIME)
(NEQ (fetch TIMEVERSION of XIP)
\TIMEVERSION))
(* Looking for client type Time and same version as we
implement)
(RETURN (RELEASE.XIP XIP]
(SETQ LENGTH (IPLUS \NSTIMELENGTH \XIPOVLEN)))
(\XIPT.OLDTIME (* Old format, omits client type and version)
(SETQ BUF (\ADDBASE XIP -2))
(SETQ LENGTH (IPLUS \NSTIMELENGTH \XIPOVLEN -4)))
(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 LENGTH)
(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)
)
(ACCESSFNS TIMEXIP ((TIMEBODY (fetch (PACKETEXCHANGEXIP PACKETEXCHANGEBODY) of DATUM)))
[BLOCKRECORD TIMEBODY ((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 2 WORD)
(TIMEVALUEHI WORD)
(TIMEVALUELO WORD])
]
(DECLARE: EVAL@COMPILE
(RPAQQ \TIMESOCKET 8)
(RPAQQ \XIPT.EXCHANGE 4)
(RPAQQ \EXTYPE.TIME 1)
(RPAQQ \XIPT.OLDTIME 123)
(RPAQQ \TIMEVERSION 2)
(RPAQQ \TIMEOP.TIMEREQUEST 1)
(RPAQQ \TIMEOP.TIMERESPONSE 2)
(RPAQQ \NSTIMELENGTH 24)
(RPAQQ \XIPOVLEN 30)
(CONSTANTS \TIMESOCKET \XIPT.EXCHANGE \EXTYPE.TIME \XIPT.OLDTIME \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: "12-Jun-84 15:14")
(* * 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 XIP)
\EXTYPE.REQUEST))
(RELEASE.XIP XIP))
(T (SETQ NSHOST# (\LOADNSHOSTNUMBER (fetch (PACKETEXCHANGEXIP PACKETEXCHANGEBODY)
of XIP)))
(* 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 XIP with \EXTYPE.RESPONSE)
(SETQ BUF (fetch (PACKETEXCHANGEXIP PACKETEXCHANGEBODY) of XIP))
(\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 XIP 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 (1223 1623 (STARTMINISERVER 1233 . 1621)) (1624 3998 (\NSTIMESERVER 1634 . 2157) (
\HANDLE.NS.TIMEREQ 2159 . 3996)) (3999 5851 (\PUPTIMESERVER 4009 . 4647) (\HANDLE.PUP.ALTOTIMEREQ 4649
. 5849)) (7848 12050 (\PUP.ID.SERVER 7858 . 8827) (\HANDLE.PUP.LOOKUP 8829 . 11526) (
\GET.PUP#.FROM.NS# 11528 . 12048)))))
STOP