(FILECREATED " 1-NOV-83 17:25:32" {INDIGO}<LOOPS>TRUCKIN>MULTI>LOOPSGATEWAY.;2 30317
changes to: (VARS LOOPSGATEWAYCOMS)
previous date: " 8-AUG-83 20:29:00" {INDIGO}<LOOPS>TRUCKIN>MULTI>LOOPSGATEWAY.;1)
(* Copyright (c) 1983 by Xerox Corporation)
(PRETTYCOMPRINT LOOPSGATEWAYCOMS)
(RPAQQ LOOPSGATEWAYCOMS [(CLASSES Gateway MasterGateway SlaveGateway)
(COMS (* Items necessary for Postal Users)
(INITVARS (\MY.NSHOSTID NIL)
(\My.PupAddress NIL)
(\PostMaster.PupAddress NIL)
(POSTMAN NIL))
(GLOBALVARS \MY.NSHOSTNUMBER \MY.NSHOSTID \My.PupAddress
\PostMaster.PupAddress POSTMAN)
(DECLARE: DONTCOPY (MACROS PostMasterPupAddress HostAddresses))
(FNS RPCtoPO ReceiveMail ReceiveMailLst))
(COMS (* Items necessary for PostMaster)
(INITVARS (ALL.DL'S NIL)
(\MY.NSHOSTID NIL)
(\My.PupAddress NIL)
(PM.CATATONIC.WAIT.ms 10000))
(GLOBALVARS \MY.NSHOSTNUMBER ALL.DL'S \MY.NSHOSTID \My.PupAddress
PM.CATATONIC.WAIT.ms)
(DECLARE: DONTCOPY (MACROS HostAddresses))
(RECORDS PostalDL DLEntry)
(FNS PM.EstablishServices PM.Expunge PM.AddToDL PM.DelFromDLname
PM.DelFromDL PM.AddToMailQ RPCtoGateway POSTMONITOR)
(INITVARS (PM.StatsTimeDelta.ms 10000)
(%#MsgsDelivered 0)
(%#MsgsInSingleBag 0)
(%%MsgsInSingleBag 0.0)
(DeliveryAttempts 0)
(DeliveryTimeouts 0)
(%%DeliveryTimeout 0.0)
(AvMultiBagLen 0)
(DeliveryHistory NIL))
(GLOBALVARS PM.StatsTimeDelta.ms %#MsgsDelivered %#MsgsInSingleBag
%%MsgsInSingleBag DeliveryAttempts DeliveryTimeouts
%%DeliveryTimeout AvMultiBagLen NIL)
(FNS PM.InitDL PM.InitPostalServices PM.DistributeMail))
(METHODS Gateway.AddMeToDL Gateway.GetPostalBox Gateway.Out Gateway.OutP
Gateway.ProcessOutQ Gateway.Quit Gateway.Receive Gateway.ReceiveP
Gateway.Send Gateway.SendP Gateway.StoreIn
MasterGateway.GetPostalBox SlaveGateway.GetPostalBox)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA PM.EstablishServices)
(NLAML PM.AddToDL PM.DistributeMail PM.AddToMailQ
PM.DelFromDLname)
(LAMA])
(DEFCLASSES Gateway MasterGateway SlaveGateway)
[DEFCLASS Gateway
(MetaClass Class Edited: (* dgb: "12-JUL-83 16:56"))
(Supers Object)
(ClassVariables)
(InstanceVariables (inQ NIL doc (* queue of messages coming in from outside.
lastItem property is pointer to lastItem on queue)
lastItem NIL)
(outQ NIL doc (* queue of messages to be sent out.
lastItem property is pointer to lastItem on queue)
lastItem NIL)
(outProcess NIL doc (* Process serving the outgoing queue))
(postalName NIL doc (* name to appear on PostBox))
(postMasterAddresses NIL doc (* List of pupHostnum and NSHostID for correspondent
site.))
(postIDlst NIL doc (* "cached" list used as args for REMOTEVAL)
)
(receiver NIL doc (* name of postMaster distribution list which will be
receiving mail from you))
(lastSeqNum 0 doc (* Sequence number of the last message into inQ)
)
(lastOutNum 0 doc (* Sequence number of last message sent from outQ)
))]
[DEFCLASS MasterGateway
(MetaClass Class Edited: (* dgb: " 5-JUL-83 17:14"))
(Supers Gateway)
(ClassVariables)
(InstanceVariables)]
[DEFCLASS SlaveGateway
(MetaClass Class Edited: (* dgb: " 6-JUL-83 13:01"))
(Supers Gateway)
(ClassVariables)
(InstanceVariables)]
(* Items necessary for Postal Users)
(RPAQ? \MY.NSHOSTID NIL)
(RPAQ? \My.PupAddress NIL)
(RPAQ? \PostMaster.PupAddress NIL)
(RPAQ? POSTMAN NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \MY.NSHOSTNUMBER \MY.NSHOSTID \My.PupAddress \PostMaster.PupAddress POSTMAN)
)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS PostMasterPupAddress MACRO (NIL (CAR (@ postMasterAddresses))))
(PUTPROPS HostAddresses MACRO (NIL (LIST (ETHERHOSTNUMBER)
\MY.NSHOSTID)))
)
)
(DEFINEQ
(RPCtoPO
[LAMBDA (Fun ArgList multiplicity) (* dgb: " 7-JUL-83 20:46")
(COND
((EQ \My.PupAddress \PostMaster.PupAddress)
(APPLY Fun ArgList))
(T (REMOTEAPPLY Fun ArgList \PostMaster.PupAddress multiplicity])
(ReceiveMail
[LAMBDA (seqNum MSG) (* edited: "14-JUL-83 02:04")
(* Stores a message coming in over the net in a queue
for later servicing)
(← POSTMAN StoreIn seqNum MSG])
(ReceiveMailLst
[LAMBDA (seqNum MSGLST) (* edited: "14-JUL-83 02:10")
(* Stores a list of messages coming in over the net in a
queue for later servicing)
(← POSTMAN StoreIn seqNum MSGLST T])
)
(* Items necessary for PostMaster)
(RPAQ? ALL.DL'S NIL)
(RPAQ? \MY.NSHOSTID NIL)
(RPAQ? \My.PupAddress NIL)
(RPAQ? PM.CATATONIC.WAIT.ms 10000)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \MY.NSHOSTNUMBER ALL.DL'S \MY.NSHOSTID \My.PupAddress PM.CATATONIC.WAIT.ms)
)
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS HostAddresses MACRO (NIL (LIST (ETHERHOSTNUMBER)
\MY.NSHOSTID)))
)
)
[DECLARE: EVAL@COMPILE
(DATATYPE PostalDL ((DLName POINTER)
(SendToFilterFN POINTER)
(* The SendToFilterFN field is a function of two args -- DL name and POSTALNAME of sender -- which must return
non-NIL if the "mailing" is permitted.)
(UpdateFilterFN POINTER)
(* The UpdateFilterFN is a function of three args -- POSTALNAME of sender, DL name, and reason
(either ADD or DELETE) -- which must return non-NIL if the updating is permitted.)
(MSGQ POINTER)
(* The MSGQ field is a TCONC queue, where the first item is merely NIL -- The Patrons field is a list of DLEntry
items)
(Patrons POINTER)
(LetterWritersAlist POINTER)
(PostEVENT POINTER))
SendToFilterFN ←(FUNCTION TRUE)
UpdateFilterFN ←(FUNCTION TRUE)
MSGQ ←(TCONC (LIST NIL))
PostEVENT ←(CREATE.EVENT "ReceivedMail"))
(RECORD DLEntry (POSTALNAME lastSeqNum MSGQptr PUPNUM NSHOSTID DLProc)
(* The MSGQptr points into tails of the Q (in TCONC form) of messages sent to this DL. CAR of the ptr is the most
recent message sent to this patron (first message is NIL))
)
]
(/DECLAREDATATYPE (QUOTE PostalDL)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER)))
(DEFINEQ
(PM.EstablishServices
[NLAMBDA L (* dgb: " 6-JUL-83 09:24")
(* Machines with boxes are those on the DL
PostalPatrons)
(PROG [(POSTALNAME (APPLY (QUOTE PM.AddToDL)
(CONS (QUOTE PostalPatrons)
L]
(COND
(POSTALNAME (RETURN (CONS POSTALNAME (HostAddresses])
(PM.Expunge
[LAMBDA (NAME) (* dgb: "12-JUL-83 17:17")
[for DLNAME PAIR DL in ALL.DL'S
do (PM.DelFromDL NAME (SETQ DL (GETTOPVAL DLNAME)))
(AND (SETQ PAIR (FASSOC NAME (fetch LetterWritersAlist of DL)))
(replace LetterWritersAlist of DL with (DREMOVE PAIR (fetch LetterWritersAlist
of DL]
T])
(PM.AddToDL
(NLAMBDA (DLNAME NAME PUPNUM NSHOSTID) (* JonL " 8-AUG-83 19:00")
(* If successful, returns the Postal NAME which was added; returns NIL if the UpdateFilterFN rejects the request.
Errors out if DLNAME isn't a postal DL, or if there is already an entry with the same Postal Name but for a
different address.)
(PROG ((DL (GETTOPVAL DLNAME))
ENTRY PROCNAME)
(if (NOT (type? PostalDL DL))
then (ERROR "Not a DL name " DLNAME)
elseif (NULL (APPLY* (fetch UpdateFilterFN of DL)
NAME DLNAME (QUOTE ADD)))
then (RETURN))
(if (SETQ ENTRY (ASSOC NAME (fetch Patrons of DL)))
then (if (NOT (OR (EQ PUPNUM (fetch PUPNUM of ENTRY))
(EQ NSHOSTID (fetch NSHOSTID of ENTRY))))
then (ERROR "Machine Name already in use"))
else (push (fetch Patrons of DL)
(SETQ ENTRY (create DLEntry))))
(create DLEntry smashing ENTRY POSTALNAME ← NAME PUPNUM ← PUPNUM NSHOSTID ← NSHOSTID
MSGQptr ←(CAR (fetch MSGQ of DL))
lastSeqNum ← 0)
(if (NEQ DLNAME (QUOTE PostalPatrons))
then (* Currently, there is no mailing allowed to all Postal
patrons.)
(SETQ PROCNAME (PACK* NAME (QUOTE %.)
DLNAME
(QUOTE .Mailer)))
(DEL.PROCESS (FIND.PROCESS PROCNAME))
(SETQ PROCNAME (ADD.PROCESS (LIST (QUOTE PM.DistributeMail)
NAME DLNAME)
(QUOTE NAME)
PROCNAME
(QUOTE RESTARTABLE)
T))
(replace DLProc of ENTRY with PROCNAME)
(NOTIFY.EVENT (fetch PostEVENT of DL)))
(RETURN NAME))))
(PM.DelFromDLname
[NLAMBDA (DLNAME NAME PUPADDR NSHOSTID) (* dgb: " 7-JUL-83 20:22")
(* If successful, returns the Postal NAME which was deleted; returns NIL if the UpdateFilterFN rejects the
request. Errors out if DLNAME isn't a postal DL, or if there is already an entry with the same Postal Name but for
a different address.)
(PROG ((DL (GETTOPVAL DLNAME)))
(COND
((NOT (type? PostalDL DL))
(ERROR "Not a DL name " DLNAME))
((NULL (APPLY* (fetch UpdateFilterFN of DL)
NAME DLNAME (QUOTE DELETE)))
(RETURN)))
(PM.Del.aux NAME DL PUPADDR NSHOSTID)
(RETURN NAME])
(PM.DelFromDL
[LAMBDA (NAME DL PUPADDR NSHOSTID) (* dgb: "12-JUL-83 17:17")
(PROG [(ENTRY (ASSOC NAME (fetch Patrons of DL]
(COND
(ENTRY (AND (OR PUPADDR NSHOSTID)
(NOT (EQ PUPADDR (fetch PUPNUM of ENTRY)))
(NOT (EQ NSHOSTID (fetch NSHOSTID of ENTRY)))
(ERROR "Machine Name conflict when deleteing from DL")
(* At least one of the specified address is non-null,
but neither one matches this DLentry)
)
(DEL.PROCESS (fetch DLProc of ENTRY))
(replace Patrons of DL with (DREMOVE ENTRY (fetch Patrons of DL])
(PM.AddToMailQ
[NLAMBDA (DLNAME outNum MSG POSTALNAME) (* dgb: "12-JUL-83 17:11")
(* adds MSG to Queue on distribution list.
Each patron knows how much they have seen of the Q)
(PROG (WriterNumPair (DL (GETTOPVAL DLNAME)))
(COND
((NOT (type? PostalDL DL))
(ERROR "Not a DL name " DLNAME))
((NULL (APPLY* (fetch SendToFilterFN of DL)
DLNAME POSTALNAME))
(RETURN)))
(COND
([NULL (SETQ WriterNumPair (FASSOC POSTALNAME (fetch LetterWritersAlist of DL]
(SETQ WriterNumPair (CONS POSTALNAME 0))
(push (fetch LetterWritersAlist of DL)
WriterNumPair)))
(COND
((IEQP outNum (ADD1 (CDR WriterNumPair)))
(TCONC (fetch MSGQ of DL)
MSG)
(add (CDR WriterNumPair)
1)
(NOTIFY.EVENT (fetch PostEVENT of DL)))
((NOT (IEQP outNum (CDR WriterNumPair)))
(HELP outNum "Out of sequence")))
(RETURN T])
(RPCtoGateway
[LAMBDA (Fun ArgList Gateway.PupAddress multiplicity) (* dgb: " 7-JUL-83 20:15")
(COND
((EQ \My.PupAddress Gateway.PupAddress)
(APPLY Fun ArgList))
(T (REMOTEAPPLY Fun ArgList Gateway.PupAddress multiplicity])
(POSTMONITOR
(LAMBDA NIL (* JonL " 8-AUG-83 20:26")
(PROG NIL
LOOP(BLOCK PM.StatsTimeDelta.ms)
(SETQ AvMultiBagLen (FPLUS (FTIMES .625 AvMultiBagLen)
(FTIMES .375 (FQUOTIENT (IDIFFERENCE %#MsgsDelivered
%#MsgsInSingleBag)
(IDIFFERENCE DeliveryAttempts
DeliveryTimeouts)))))
(SETQ %%MsgsInSingleBag (FPLUS (FTIMES .625 %%MsgsInSingleBag)
(FTIMES .375 (FQUOTIENT %#MsgsInSingleBag %#MsgsDelivered))))
(SETQ %#MsgsDelivered 0)
(SETQ %#MsgsInSingleBag 0)
(SETQ %%DeliveryTimeout (FPLUS (FTIMES .625 %%DeliveryTimeout)
(FTIMES .375 (FQUOTIENT DeliveryTimeouts DeliveryAttempts))))
(push DeliveryHistory (LIST AvMultiBagLen %%MsgsInSingleBag %%DeliveryTimeout))
(SETQ DeliveryAttempts 0)
(SETQ DeliveryTimeouts 0)
(GO LOOP))))
)
(RPAQ? PM.StatsTimeDelta.ms 10000)
(RPAQ? %#MsgsDelivered 0)
(RPAQ? %#MsgsInSingleBag 0)
(RPAQ? %%MsgsInSingleBag 0.0)
(RPAQ? DeliveryAttempts 0)
(RPAQ? DeliveryTimeouts 0)
(RPAQ? %%DeliveryTimeout 0.0)
(RPAQ? AvMultiBagLen 0)
(RPAQ? DeliveryHistory NIL)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS PM.StatsTimeDelta.ms %#MsgsDelivered %#MsgsInSingleBag %%MsgsInSingleBag
DeliveryAttempts DeliveryTimeouts %%DeliveryTimeout AvMultiBagLen NIL)
)
(DEFINEQ
(PM.InitDL
[LAMBDA (DLNAME SendToFilterFN UpdateFilterFN) (* dgb: " 6-JUL-83 21:18")
(* Adds DL to the list of ALL.DL'S. Error if previously existing. Creates a process which will service each of the
patrons on this mail queue. Deletes previously existing processes of the same name)
(AND (FMEMB DLNAME ALL.DL'S)
(ERROR "DL name already in use" DLNAME))
[SETTOPVAL DLNAME (create PostalDL
DLName ← DLNAME
SendToFilterFN ←(OR SendToFilterFN (FUNCTION TRUE))
UpdateFilterFN ←(OR UpdateFilterFN (FUNCTION TRUE]
(push ALL.DL'S DLNAME)
DLNAME])
(PM.InitPostalServices
(LAMBDA NIL (* JonL " 8-AUG-83 20:23")
(* Clears ALL.DL'S and sets up the initial distribution
lists)
(SETQ EvalServerGaggedHosts) (* Just in case we want to REMOTEVAL to ourselves when
initially establishing Gateway postal services)
(OR (AND \MY.NSHOSTID (LITATOM \MY.NSHOSTID))
(SETQ \MY.NSHOSTID (CONCAT "#NSID." (CADR \MY.NSHOSTNUMBER)
"."
(CADDR \MY.NSHOSTNUMBER)
"."
(CADDDR \MY.NSHOSTNUMBER))))
(OR (SMALLP \My.PupAddress)
(SETQ \My.PupAddress (ETHERHOSTNUMBER)))
(MAP.PROCESSES (FUNCTION (LAMBDA (HANDLE NAME)
(COND
((EQ (STRPOS (QUOTE .Mailer)
NAME NIL NIL NIL T)
(ADD1 (NCHARS NAME)))
(DEL.PROCESS HANDLE))))))
(OR (FIND.PROCESS (QUOTE EvalServerListening))
(EVALSERVER))
(DEL.PROCESS (FIND.PROCESS (QUOTE POSTMONITOR)))
(SETQ %#MsgsDelivered 0)
(SETQ %#MsgsInSingleBag 0)
(SETQ %%MsgsInSingleBag 0.0)
(SETQ DeliveryAttempts 0)
(SETQ DeliveryTimeouts 0)
(SETQ %%DeliveryTimeout 0.0)
(SETQ DeliveryHistory)
(ADD.PROCESS (QUOTE (POSTMONITOR))
(QUOTE RESTARTABLE)
T)
(SETTOPVAL (QUOTE ALL.DL'S))
(PM.InitDL (QUOTE PostalPatrons))
(PM.InitDL (QUOTE WorldMaster))
(PM.InitDL (QUOTE Players))
(LIST \My.PupAddress \MY.NSHOSTID)))
(PM.DistributeMail
[NLAMBDA (PatronNAME DLNAME) (* edited: "14-JUL-83 05:12")
(* Send out one message for one patron on this
distribution list and then block.
If no mail wait for event)
(PROG (PatronDLEntry nextMsgPtr nextSeqNum msgLst (DL (GETTOPVAL DLNAME)))
(SETQ PatronDLEntry (ASSOC PatronNAME (fetch Patrons of DL)))
1PASS
[COND
[msgLst (* AHA! We've already bagged somethin up)
(SETQ nextSeqNum (ADD1 (fetch lastSeqNum of PatronDLEntry)))
(BLOCK (COND
((PROG1 (NLSETQ (RPCtoGateway (QUOTE ReceiveMailLst)
(LIST nextSeqNum msgLst)
(fetch PUPNUM of PatronDLEntry)
0))
(add DeliveryAttempts 1))
(* Delivering the mail means sending it, and updating
the patrons MSGQ pointer to the next message)
(replace MSGQptr of PatronDLEntry with nextMsgPtr)
(replace lastSeqNum of PatronDLEntry with nextSeqNum)
(PROG ((LEN (LENGTH msgLst)))
(add %#MsgsDelivered LEN)
(if (EQ 1 LEN)
then (add %#MsgsInSingleBag 1)))
(SETQ msgLst))
(T (add DeliveryTimeouts 1) (* If the RPC fails to get thru, then perhaps the client
is "catatonic" and we should wait a while.)
PM.CATATONIC.WAIT.ms]
([NULL (SETQ nextMsgPtr (CDR (fetch MSGQptr of PatronDLEntry]
(AWAIT.EVENT (fetch PostEVENT of DL)
5000) (* Notice that we check every five seconds or so just to
be sure.)
)
(T (* Try to bag up as many msgs as possible into the
msgLst)
(PROG ([lastCell (SETQ msgLst (LIST (CAR nextMsgPtr]
(lenRemaining 512)
(thisLen NIL))
LP (COND
([OR (NULL (CDR nextMsgPtr))
(ILEQ [SETQ lenRemaining (IDIFFERENCE lenRemaining
(IPLUS 2
(OR thisLen
(NCHARS (CAR nextMsgPtr]
(SETQ thisLen (NCHARS (CADR nextMsgPtr]
(* Note how cleverly this code omits calling NCHARS when
there is only one item in the msgQ)
(RETURN)))
(pop nextMsgPtr)
[SETQ lastCell (CDR (RPLACD lastCell (LIST (CAR nextMsgPtr]
(GO LP]
(GO 1PASS])
)
[METH Gateway AddMeToDL (DLName)
(* Add me to distribution list DLName on postMaster)]
[METH Gateway GetPostalBox (postalName postMasterAddress)
(* Contact PostMaster and request a post box under the name postalName)]
[METH Gateway Out NIL
(* Takes a message from outQ. Return NIL if none.)]
[METH Gateway OutP NIL
(* Test if anything on outQ to be sent)]
[METH Gateway ProcessOutQ NIL
(* Looping process for sending out messages on OutQ)]
[METH Gateway Quit NIL
(* Removes this guy from the postal services)]
[METH Gateway Receive NIL
(* Return a message from inQ. Return NIL if none.)]
[METH Gateway ReceiveP NIL
(* Test if there are any items on queue whichare unread)]
[METH Gateway Send (newMessage)
(* Store the new Message in the inQ)]
[METH Gateway SendP NIL
(* Test if anything on outQ to be sent)]
[METH Gateway StoreIn (newMessage)
(* Store the new Message in the inQ)]
[METH MasterGateway GetPostalBox (myName postMasterAddress)
(* Get a postal connection for the WorldMaster)]
[METH SlaveGateway GetPostalBox (myName postMasterAddress)
(* Get postal connection for the WorldMaster)]
(DEFINEQ
(Gateway.AddMeToDL
[LAMBDA (self DLName) (* dgb: " 7-JUL-83 19:30")
(* Add me to distribution list DLName on postMaster)
(OR (@ postalName)
(ERROR "Not yet Registerd with Post Master"))
(RPCtoPO (QUOTE PM.AddToDL)
(CONS DLName (@ postIDlst])
(Gateway.GetPostalBox
(LAMBDA (self postalName postMasterAddress) (* JonL " 8-AUG-83 20:28")
(* Contact PostMaster and request a post box under the
name postalName)
(OR postalName (ERROR "name must be given to establish PostalBox"))
(OR (SMALLP \My.PupAddress)
(SETQ \My.PupAddress (ETHERHOSTNUMBER)))
(OR (AND \MY.NSHOSTID (LITATOM \MY.NSHOSTID))
(SETQ \MY.NSHOSTID (CONCAT "#NSID." (CADR \MY.NSHOSTNUMBER)
"."
(CADDR \MY.NSHOSTNUMBER)
"."
(CADDDR \MY.NSHOSTNUMBER))))
(OR (FIND.PROCESS (QUOTE EvalServerListening))
(EVALSERVER))
(PROG ((postIDlst (CONS postalName (HostAddresses)))
RESULT)
(SETQ \PostMaster.PupAddress postMasterAddress) (* This is to communicate with RPCtoPO *before* the
address of the postmaster has been determined)
TRYAGAIN
(SETQ RESULT (NLSETQ (RPCtoPO (QUOTE PM.EstablishServices)
postIDlst)))
(COND
(RESULT (SETQ RESULT (CAR RESULT)))
(T (HELPCHECK "Request for service timed out.
Type OK to try again")
(GO TRYAGAIN)))
(COND
((NLISTP RESULT) (* Name refused at PostMaster)
(SETQ postalName (HELPCHECK postalName
"Name not acceptible. Type
RETURN '<newName>
to try again"))
(GO TRYAGAIN))) (* RESULT a list (assignedPostalName ehterNumber NSID))
(←@
postalName
(pop RESULT)) (* Store addresses to be used for postMaster)
(←@
postMasterAddresses RESULT)
(SETQ \PostMaster.PupAddress (CAR RESULT))
(←@
postIDlst postIDlst)
(←@
inQ
(←@
inQ:,lastItem
(CONS))) (* Empty In and Out Queue)
(←@
outQ
(←@
outQ:,lastItem
(CONS)))
(←@
outQ:,event
(CREATE.EVENT)) (* This object is now the POSTMAN)
(SETQ POSTMAN self) (* This GATEWAY object is actually the object to send
StoreIn messages to, for delivery of mail.)
(DEL.PROCESS (FIND.PROCESS (QUOTE POSTMAN)))
(ADD.PROCESS (LIST (QUOTE ←)
self
(QUOTE ProcessOutQ))
(QUOTE NAME)
(QUOTE POSTMAN)
(QUOTE RESTARTABLE)
T)
(RETURN (@ postalName)))))
(Gateway.Out
[LAMBDA (self) (* dgb: " 5-JUL-83 17:02")
(* Takes a message from outQ.
Return NIL if none.)
(COND
((NULL (CDR (@ outQ)))
NIL)
(T (CAR (←@
outQ
(CDR (@ outQ])
(Gateway.OutP
[LAMBDA (self) (* sm: " 8-JUL-83 14:15")
(* Test if anything on outQ to be sent)
(CDR (@ outQ])
(Gateway.ProcessOutQ
[LAMBDA (self) (* dgb: "12-JUL-83 18:09")
(* Looping process for sending out messages on OutQ)
(PROG (msg lastOutNum)
LP [COND
((SETQ msg (← self Out))
(←@
lastOutNum
(ADD1 (@ lastOutNum)))
(until (NLSETQ (RPCtoPO (QUOTE PM.AddToMailQ)
(LIST (@ receiver)
(@ lastOutNum)
msg
(@ postalName))
0))
do (BLOCK))
(COND
((← self OutP) (* If there is another message, yield and go around
again quickly)
(BLOCK)
(GO LP] (* No messages -- Wait for one to come or check in 5
seconds)
(AWAIT.EVENT (@ outQ:,event)
5000)
(GO LP])
(Gateway.Quit
[LAMBDA (self) (* dgb: "12-JUL-83 16:42")
(* Removes this guy from the postal services)
(AND (@ postalName)
(RPCtoPO (QUOTE PM.Expunge)
(@ postalName])
(Gateway.Receive
[LAMBDA (self) (* dgb: " 5-JUL-83 16:59")
(* Return a message from inQ.
Return NIL if none.)
(COND
((NULL (CDR (@ inQ)))
NIL)
(T (CAR (←@
inQ
(CDR (@ inQ])
(Gateway.ReceiveP
[LAMBDA (self) (* dgb: " 5-JUL-83 18:16")
(* Test if there are any items on queue whichare unread)
(CDR (@ inQ])
(Gateway.Send
[LAMBDA (self newMessage) (* dgb: " 7-JUL-83 19:44")
(* Store the new Message in the outQ)
[←@
outQ:,lastItem
(CDR (RPLACD (@ outQ:,lastItem)
(LIST newMessage]
(NOTIFY.EVENT (@ outQ:,event])
(Gateway.SendP
[LAMBDA (self) (* dgb: " 5-JUL-83 16:22")
(* Test if anything on outQ to be sent)
(CDR (@ outQ])
(Gateway.StoreIn
[LAMBDA (self seqNum newMessage listP) (* edited: "14-JUL-83 02:09")
(* Store the new Message in the inQ Note that newMessage
may actually be a list of "bagged" messages NIL)
(COND
[(IEQP seqNum (ADD1 (@ lastSeqNum)))
(←@
lastSeqNum seqNum)
(←@
inQ:,lastItem
(COND
(listP (LAST (RPLACD (@ inQ:,lastItem)
newMessage)))
(T (CDR (RPLACD (@ inQ:,lastItem)
(LIST newMessage]
((NOT (IEQP seqNum (@ lastSeqNum))) (* Catches any packet whose seqNum is not lastSeqNum
(thrown away) or 1+lastSeqNum
(stored))
(HELPCHECK seqNum " an out of order message from Postmaster"])
(MasterGateway.GetPostalBox
[LAMBDA (self myName postMasterAddress) (* dgb: " 6-JUL-83 19:08")
(* Get a postal connection for the WorldMaster)
(PROG (name)
(SETQ name (←Super
self GetPostalBox myName postMasterAddress))
(←@
receiver
(QUOTE Players))
(← self AddMeToDL (QUOTE WorldMaster))
(RETURN name])
(SlaveGateway.GetPostalBox
[LAMBDA (self myName postMasterAddress) (* dgb: " 6-JUL-83 19:09")
(* Get a postal connection for the WorldMaster)
(PROG (name)
(SETQ name (←Super
self GetPostalBox myName postMasterAddress))
(←@
receiver
(QUOTE WorldMaster))
(← self AddMeToDL (QUOTE Players))
(RETURN name])
)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA PM.EstablishServices)
(ADDTOVAR NLAML PM.AddToDL PM.DistributeMail PM.AddToMailQ PM.DelFromDLname)
(ADDTOVAR LAMA )
)
(PRETTYCOMPRINT LOOPSGATEWAYCOMS)
(RPAQQ LOOPSGATEWAYCOMS [(CLASSES Gateway MasterGateway SlaveGateway)
(COMS (* Items necessary for Postal Users)
(INITVARS (\MY.NSHOSTID NIL)
(\My.PupAddress NIL)
(\PostMaster.PupAddress NIL)
(POSTMAN NIL))
(GLOBALVARS \MY.NSHOSTNUMBER \MY.NSHOSTID \My.PupAddress
\PostMaster.PupAddress POSTMAN)
(DECLARE: DONTCOPY (MACROS PostMasterPupAddress HostAddresses))
(FNS RPCtoPO ReceiveMail ReceiveMailLst))
(COMS (* Items necessary for PostMaster)
(INITVARS (ALL.DL'S NIL)
(\MY.NSHOSTID NIL)
(\My.PupAddress NIL)
(PM.CATATONIC.WAIT.ms 10000))
(GLOBALVARS \MY.NSHOSTNUMBER ALL.DL'S \MY.NSHOSTID \My.PupAddress
PM.CATATONIC.WAIT.ms)
(DECLARE: DONTCOPY (MACROS HostAddresses))
(RECORDS PostalDL DLEntry)
(FNS PM.EstablishServices PM.Expunge PM.AddToDL PM.DelFromDLname
PM.DelFromDL PM.AddToMailQ RPCtoGateway POSTMONITOR)
(INITVARS (PM.StatsTimeDelta.ms 10000)
(%#MsgsDelivered 0)
(%#MsgsInSingleBag 0)
(%%MsgsInSingleBag 0.0)
(DeliveryAttempts 0)
(DeliveryTimeouts 0)
(%%DeliveryTimeout 0.0)
(AvMultiBagLen 0)
(DeliveryHistory NIL))
(GLOBALVARS PM.StatsTimeDelta.ms %#MsgsDelivered %#MsgsInSingleBag
%%MsgsInSingleBag DeliveryAttempts DeliveryTimeouts
%%DeliveryTimeout AvMultiBagLen NIL)
(FNS PM.InitDL PM.InitPostalServices PM.DistributeMail))
(METHODS Gateway.AddMeToDL Gateway.GetPostalBox Gateway.Out Gateway.OutP
Gateway.ProcessOutQ Gateway.Quit Gateway.Receive Gateway.ReceiveP
Gateway.Send Gateway.SendP Gateway.StoreIn
MasterGateway.GetPostalBox SlaveGateway.GetPostalBox)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDVARS (NLAMA PM.EstablishServices)
(NLAML PM.DistributeMail PM.AddToMailQ PM.DelFromDLname
PM.AddToDL)
(LAMA])
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA PM.EstablishServices)
(ADDTOVAR NLAML PM.DistributeMail PM.AddToMailQ PM.DelFromDLname PM.AddToDL)
(ADDTOVAR LAMA )
)
(PUTPROPS LOOPSGATEWAY COPYRIGHT ("Xerox Corporation" 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (4521 5419 (RPCtoPO 4531 . 4789) (ReceiveMail 4791 . 5095) (ReceiveMailLst 5097 . 5417))
(7155 13575 (PM.EstablishServices 7165 . 7598) (PM.Expunge 7600 . 8030) (PM.AddToDL 8032 . 9866) (
PM.DelFromDLname 9868 . 10568) (PM.DelFromDL 10570 . 11284) (PM.AddToMailQ 11286 . 12376) (
RPCtoGateway 12378 . 12633) (POSTMONITOR 12635 . 13573)) (14082 18919 (PM.InitDL 14092 . 14730) (
PM.InitPostalServices 14732 . 16243) (PM.DistributeMail 16245 . 18917)) (20185 27802 (
Gateway.AddMeToDL 20195 . 20567) (Gateway.GetPostalBox 20569 . 23154) (Gateway.Out 23156 . 23483) (
Gateway.OutP 23485 . 23717) (Gateway.ProcessOutQ 23719 . 24623) (Gateway.Quit 24625 . 24923) (
Gateway.Receive 24925 . 25253) (Gateway.ReceiveP 25255 . 25508) (Gateway.Send 25510 . 25847) (
Gateway.SendP 25849 . 26083) (Gateway.StoreIn 26085 . 26881) (MasterGateway.GetPostalBox 26883 . 27341
) (SlaveGateway.GetPostalBox 27343 . 27800)))))
STOP