(FILECREATED "23-Aug-85 12:29:36" {ERIS}<LISPUSERS>SERVERSTATUS.;6 16692
changes to: (VARS SERVERSTATUSCOMS)
(FNS ServerStatusEchoTest)
previous date: "11-Aug-85 01:17:02" {ERIS}<LISPUSERS>SERVERSTATUS.;5)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT SERVERSTATUSCOMS)
(RPAQQ SERVERSTATUSCOMS ((GLOBALVARS (Server.Status.Process.Handle NIL))
(FNS ServerStatusTesterStart ServerStatusMainLoop ServerStatusTestAndDisplay
ServerStatusEchoTest ServerStatusDisplayWindow ServerStatusTakeAction
ServerStatusProcessInfo ServerStatusGetServerStatus
ServerStatusTestToInfo ServerStatusGetServerType
ServerStatusButtonEventFn ServerStatusChangeFrequency)
(INITVARS [Server.Status.Test.Spec (QUOTE ((PHYLUM NIL)
(ERIS NIL)
(QUAKE NIL]
(Server.Status.Title.Font (QUOTE (Gacha 10 MRR)))
(Server.Status.Delay 5))
(CONSTANTS (Server.Status.Attempts 3))
(RECORDS serverStatus)
(LOCALVARS . T)
(P (ServerStatusTesterStart))))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS (Server.Status.Process.Handle NIL))
)
(DEFINEQ
(ServerStatusTesterStart
[LAMBDA (testSpec) (* rdh: "11-Jul-85 12:05")
(* * PRE: testSpec is a list of server specs. A server spec is a list containing a server name and the name of a
function to call when the status of that server changes. POST: there is a process running the main loop, and it is
using the info supplied in test spec to do the checking.)
(if (OR (NULL Server.Status.Process.Handle)
(NOT (PROCESSP Server.Status.Process.Handle)))
then (SETQ Server.Status.Process.Handle (ADD.PROCESS (QUOTE (ServerStatusMainLoop))
(QUOTE NAME)
"Server Status"
(QUOTE INFOHOOK)
(FUNCTION ServerStatusProcessInfo)
(QUOTE SUSPEND)
T))
(PROCESSPROP Server.Status.Process.Handle (QUOTE serverStatusWindow)
NIL)
else (while (EQUAL (PROCESSPROP Server.Status.Process.Handle (QUOTE running))
(QUOTE runningNow))
do (printout PROMPTWINDOW "Server Status busy, waiting..." T)
(DISMISS 10000)))
(PROCESSPROP Server.Status.Process.Handle (QUOTE serverStatusInfo)
(ServerStatusTestToInfo (if (NULL testSpec)
then Server.Status.Test.Spec
else testSpec)))
(WAKE.PROCESS Server.Status.Process.Handle])
(ServerStatusMainLoop
[LAMBDA NIL (* edited: " 5-Jul-85 22:55")
(* * PRE: the specification of the servers to test is encoded in the serverStatusInfo property of the process
running this function. POST: none. does not terminate. ACTIVITY: tests the status of the servers periodically.)
(PROG (stream triggerEvent)
(* *)
(PROCESSPROP (THIS.PROCESS)
(QUOTE running)
(QUOTE runningNow))
(PROCESSPROP (THIS.PROCESS)
(QUOTE lastRunTime)
(CLOCK 0))
(* * Open a stream to be used with PUP.ECHOUSER when testing to see if the servers are up. This is done here to
avoid the cost of re-opening every time through.)
(DECLARE (SPECVARS stream))
(SETQ stream (OPENSTREAM (QUOTE {NODIRCORE})
(QUOTE BOTH)))
[WHENCLOSE stream (QUOTE EOF)
(QUOTE (LAMBDA NIL (RETFROM (QUOTE ServerStatusEchoTest)
(QUOTE Down]
(* * Create an event to be used to trigger testing before timer runs out.)
(SETQ triggerEvent (CREATE.EVENT (QUOTE ServerStatusTriggerEvent)))
(PROCESSPROP (THIS.PROCESS)
(QUOTE TriggerEvent)
triggerEvent)
(* *)
(while T
do (PROCESSPROP (THIS.PROCESS)
(QUOTE running)
(QUOTE runningNow))
(ServerStatusTestAndDisplay (PROCESSPROP (THIS.PROCESS)
(QUOTE serverStatusInfo)))
(PROCESSPROP (THIS.PROCESS)
(QUOTE lastRunTime)
(CLOCK 0))
(PROCESSPROP (THIS.PROCESS)
(QUOTE running)
(QUOTE waiting))
(if (ILESSP Server.Status.Delay 1)
then (SETQ Server.Status.Delay 1))
(AWAIT.EVENT triggerEvent (ITIMES Server.Status.Delay 60000])
(ServerStatusTestAndDisplay
[LAMBDA (serverStatus) (* edited: " 5-Jul-85 19:03")
(* * Co-ordinates collection of status info and taking actions. PRE: serverStatus is initialized.
POST: serverStatus is updated to refect current stati. Action routines have been called for servers whose status
changed. Status window has been updated if it is open.)
(PROG (anyChanges? newStatus)
(SETQ anyChanges? NIL)
[for serverInfo in serverStatus
do (SETQ newStatus (ServerStatusEchoTest serverInfo))
(with serverStatus serverInfo (if (NOT (EQUAL status newStatus))
then (SETQ status newStatus)
(SETQ changed T)
(SETQ anyChanges? T)
else (SETQ changed NIL]
(* *)
(if (NOT (NULL anyChanges?))
then (ServerStatusDisplayWindow)
(ServerStatusTakeAction serverStatus])
(ServerStatusEchoTest
[LAMBDA (serverInfo) (* edited: " 8-Jul-85 15:14")
(* * Does the real status testing by echoing to the server. The server is given lots of time.)
(PROG (courierStream returnValue printerStatus)
(if (EQUAL (fetch (serverStatus type) of serverInfo)
(QUOTE PUP))
then
(* wipe stream clean in case echo echos nothing -- i.e. server does not exist. If you don't do this, and the server
doesn't exist, the status of the non-existent server is the same as for the previous server in the list.
stream is declared in ServerStatusMainLoop.)
(SETFILEPTR stream 0)
(PRIN1 (QUOTE !)
stream)
(SPACES (CONSTANT (ITIMES Server.Status.Attempts 2))
stream)
(SETFILEPTR stream 0)
(PUP.ECHOUSER (fetch (serverStatus canonicalName) of serverInfo)
stream 3000 Server.Status.Attempts)
(SETFILEPTR stream 0)
[while (NOT (EQUAL (READC stream)
(QUOTE !]
(if (IEQP (for i from 1 to (CONSTANT (SUB1 (ITIMES Server.Status.Attempts 2)))
count (EQUAL (READC stream)
(QUOTE +)))
0)
then (SETQ printerStatus (PRINTERSTATUS (fetch (serverStatus canonicalName)
of serverInfo)))
(if (AND (NOT (NULL printerStatus))
(NOT (IEQP (CAR printerStatus)
1)))
then (SETQ returnValue (QUOTE Up))
else (SETQ returnValue (QUOTE Down)))
else (SETQ returnValue (QUOTE Up)))
(* * Is NS server.)
else (SETQ courierStream (COURIER.OPEN (fetch (serverStatus canonicalName) of serverInfo)
NIL T))
(if (NULL courierStream)
then (SETQ returnValue (QUOTE Down))
else (SETQ returnValue (QUOTE Up))
(CLOSEF courierStream)))
(RETURN returnValue])
(ServerStatusDisplayWindow
[LAMBDA NIL (* rdh " 7-Aug-85 18:18")
(* * PRE: Global variable File.Sever.Status is set. POST: if the window is open the server stati are displayed in
the window.)
(PROG (window titleFont)
(SETQ window (PROCESSPROP Server.Status.Process.Handle (QUOTE serverStatusWindow)))
(if (OPENWP window)
then (DSPRESET window)
(BITBLT window 0 0 window 0 0 NIL NIL (QUOTE INVERT)
(QUOTE REPLACE))
(SETQ titleFont (WINDOWTITLEFONT Server.Status.Title.Font))
(WINDOWPROP window (QUOTE TITLE)
(CONCAT "Status at " (SUBSTRING (DATE)
11 15)))
(WINDOWTITLEFONT titleFont)
(DISMISS 200)
(BITBLT window 0 0 window 0 0 NIL NIL (QUOTE INVERT)
(QUOTE REPLACE))
(for sStatus in (PROCESSPROP Server.Status.Process.Handle (QUOTE serverStatusInfo))
do (with serverStatus sStatus (printout window name 11 status T])
(ServerStatusTakeAction
[LAMBDA (serverStatus) (* rdh " 8-Aug-85 10:32")
(* * Eval action routines for servers that have changed.)
(for serverInfo in serverStatus
do (with serverStatus serverInfo (if changed
then (SETQ changed NIL)
(SELECTQ status
(Up [if (EQUAL (MACHINETYPE)
(QUOTE DANDELION))
then (PLAYTUNE
(QUOTE ((175 . 8000)
(NIL . 1000)
(350 . 14000]
(printout PROMPTWINDOW T
"Server Status: "
name " came up at " (DATE)))
(Down [if (EQUAL (MACHINETYPE)
(QUOTE DANDELION))
then
(PLAYTUNE (QUOTE ((350 . 8000)
(NIL . 1000)
(175 . 14000]
(printout PROMPTWINDOW T
"Server Status: "
name " went down at "
(DATE)))
(SHOULDNT "New status not matched."))
(if (NOT (NULL function))
then (ERSETQ (APPLY* function name status])
(ServerStatusProcessInfo
[LAMBDA NIL (* rdh " 8-Aug-85 10:46")
(* * INFOHOOK for the server status process. Creates the window if necessary, and updates the display.)
(PROG (window titleFont)
(SETQ window (PROCESSPROP Server.Status.Process.Handle (QUOTE serverStatusWindow)))
(if (NULL window)
then (SETQ titleFont (WINDOWTITLEFONT Server.Status.Title.Font))
(SETQ window (CREATEW [GETBOXREGION 120 (ITIMES 13
(ADD1 (LENGTH (PROCESSPROP
Server.Status.Process.Handle
(QUOTE
serverStatusInfo]
"Server Status"))
(WINDOWTITLEFONT titleFont)
(WINDOWPROP window (QUOTE RESHAPEFN)
(FUNCTION ServerStatusDisplayWindow))
(WINDOWPROP window (QUOTE BUTTONEVENTFN)
(FUNCTION ServerStatusButtonEventFn))
(PROCESSPROP Server.Status.Process.Handle (QUOTE serverStatusWindow)
window))
(* *)
(if (NOT (OPENWP window))
then (DSPRESET window))
(ServerStatusButtonEventFn window])
(ServerStatusGetServerStatus
[LAMBDA (server) (* edited: " 8-Jul-85 12:15")
(* * PRE: Server.Status.Process.Handle is the process handle of a process with the serverStatusInfo property set.
POST: the status of server is returned.)
(PROG (returnValue canonicalServerName)
(SETQ canonicalServerName (CANONICAL.HOSTNAME server))
(for sStatus in (PROCESSPROP Server.Status.Process.Handle (QUOTE serverStatusInfo))
do (with serverStatus sStatus (if (EQUAL canonicalName canonicalServerName)
then (SETQ returnValue status)))
while (NULL returnValue))
(RETURN returnValue])
(ServerStatusTestToInfo
[LAMBDA (testSpec) (* edited: " 8-Jul-85 12:16")
(* * PRE: testSpec is a list of server specifications of the form (name function) where name is a server name and
function is a function to be called, or nill. POST: the information is converted to a list of serverStatus records,
and returned.)
(PROG (info)
[for spec in testSpec do (SETQ info (APPEND info (LIST (create serverStatus
name ←(CAR spec)
canonicalName ←(
CANONICAL.HOSTNAME
(CAR spec))
function ←(CADR spec)
changed ← NIL
status ←(QUOTE Up)
type ←(
ServerStatusGetServerType
(CAR spec]
(RETURN info])
(ServerStatusGetServerType
[LAMBDA (name) (* edited: " 4-Jul-85 12:58")
(* * PRE: name is something that can be mkstring'ed into a string. POST: NS is returned if there is a : in name,
else PUP is returned.)
(if (STRPOSL (QUOTE (:))
(MKSTRING name))
then (QUOTE NS)
else (QUOTE PUP])
(ServerStatusButtonEventFn
[LAMBDA (window) (* rdh " 8-Aug-85 10:34")
(* * The ordering of things in here is tricky. This is to allow this function to be called from the process info
funtion.)
(PROG (last next)
(if (NOT (PROCESSP Server.Status.Process.Handle))
then (UNTILMOUSESTATE (NOT (OR LEFT MIDDLE)))
(printout PROMPTWINDOW T "Server status no longer running.")
(RETURN NIL))
(if (MOUSESTATE MIDDLE)
then [COND
((NOT (TYPENAMEP (WINDOWPROP window (QUOTE RunMenu))
(QUOTE MENU)))
(WINDOWPROP window (QUOTE RunMenu)
(create MENU
ITEMS ←(QUOTE ((Restart (QUOTE doRestart)
"Runs ServerStatusTesterStart on Server.Status.Test.Spec to restart system with new list of servers.")
(Run% NOW (QUOTE doRunNow)
"Spawns test process now. NOTE: test process takes several minutes.")
(Change% Frequency (QUOTE
doChangeFrequency)
"Change interval between runs."]
(SELECTQ (MENU (WINDOWPROP window (QUOTE RunMenu)))
(doNothing NIL)
(doRestart (ServerStatusTesterStart Server.Status.Test.Spec))
[doRunNow (NOTIFY.EVENT (PROCESSPROP Server.Status.Process.Handle
(QUOTE TriggerEvent]
(doChangeFrequency (ServerStatusChangeFrequency))
(PROGN NIL))
else (UNTILMOUSESTATE (NOT LEFT))
(SETQ last (IQUOTIENT (IDIFFERENCE (CLOCK 0)
(PROCESSPROP Server.Status.Process.Handle
(QUOTE lastRunTime)))
60000))
(SETQ next (IDIFFERENCE Server.Status.Delay last))
(ServerStatusDisplayWindow)
(if (EQUAL (QUOTE runningNow)
(PROCESSPROP Server.Status.Process.Handle (QUOTE running)))
then (printout PROMPTWINDOW T "Server status last ran " last " minutes ago."
" Running now.")
else (printout PROMPTWINDOW T "Server status last ran " last " minutes ago."
" Runs again in "
next "."])
(ServerStatusChangeFrequency
[LAMBDA NIL (* edited: " 5-Jul-85 22:57")
(* *)
(SETQ Server.Status.Delay (MKATOM (PROMPTFORWORD "Interval between tests (in minutes):"
Server.Status.Delay NIL PROMPTWINDOW)))
(printout PROMPTWINDOW T)
(NOTIFY.EVENT (PROCESSPROP Server.Status.Process.Handle (QUOTE TriggerEvent])
)
(RPAQ? Server.Status.Test.Spec (QUOTE ((PHYLUM NIL)
(ERIS NIL)
(QUAKE NIL))))
(RPAQ? Server.Status.Title.Font (QUOTE (Gacha 10 MRR)))
(RPAQ? Server.Status.Delay 5)
(DECLARE: EVAL@COMPILE
(RPAQQ Server.Status.Attempts 3)
(CONSTANTS (Server.Status.Attempts 3))
)
[DECLARE: EVAL@COMPILE
(RECORD serverStatus (name canonicalName type status changed function))
]
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(ServerStatusTesterStart)
(PUTPROPS SERVERSTATUS COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1169 16122 (ServerStatusTesterStart 1179 . 2622) (ServerStatusMainLoop 2624 . 4638) (
ServerStatusTestAndDisplay 4640 . 5670) (ServerStatusEchoTest 5672 . 7803) (ServerStatusDisplayWindow
7805 . 8933) (ServerStatusTakeAction 8935 . 10114) (ServerStatusProcessInfo 10116 . 11371) (
ServerStatusGetServerStatus 11373 . 12137) (ServerStatusTestToInfo 12139 . 13009) (
ServerStatusGetServerType 13011 . 13419) (ServerStatusButtonEventFn 13421 . 15684) (
ServerStatusChangeFrequency 15686 . 16120)))))
STOP