(FILECREATED " 7-Nov-85 23:11:41" {ERIS}<LISPCORE>SOURCES>IDLER.;76 29846
changes to: (VARS IDLERCOMS)
(FNS IDLE.SET.OPTION IDLE.BITMAP)
previous date: " 5-Nov-85 23:48:16" {ERIS}<LISPCORE>SOURCES>IDLER.;74)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT IDLERCOMS)
(RPAQQ IDLERCOMS ([COMS
(* * Basic idling facility)
(FNS IDLE IDLE.SET.OPTION IDLE.SHOW.OPTIONS IDLE.SHOW.OPTION \IDLER \IDLE.TIME \IDLE.OUT
\IDLE.EXIT? \IDLE.PROMPTING.WINDOW \IDLE.IS.PREVIOUS \IDLE.ISMEMBER \IDLE.AUTHENTICATE)
(INITVARS (IDLE.PROFILE (QUOTE (ALLOWED.LOGINS (T *)
FORGET T TIMEOUT 20 DISPLAYFN
IDLE.BOUNCING.BOX SAVEVM 10 AUTHENTICATE T)))
(\IDLING)
(CH.DEFAULT.DOMAIN)
(DEFAULTREGISTRY))
(ADDVARS (IDLE.SUSPEND.PROCESS.NAMES MOUSE LAFITEMAILWATCH CROCK.PROCESS SPACEWINDOW
REMINDERS.WATCHDOG)
(IDLE.RESETVARS (PUPTRACEFLG NIL)
(XIPTRACEFLG NIL)))
(GLOBALVARS IDLE.PROFILE \IDLING \LASTUSERACTION IDLE.RESETVARS IDLE.SUSPEND.PROCESS.NAMES
CH.DEFAULT.DOMAIN DEFAULTREGISTRY \AFTERLOGINFNS SAVINGCURSOR
\VMEM.INHIBIT.WRITE \IDLE.PASSWORD.SET)
(LOCALVARS . T)
(DECLARE:
DONTEVAL@LOAD DOCOPY (P (FONTCREATE (QUOTE TIMESROMAND)
36))
[ADDVARS
(BACKGROUNDFNS \IDLE.OUT)
(BackgroundMenuCommands
(Idle (QUOTE (IDLE))
"Enter Idle mode"
(SUBITEMS ("Show Profile" (QUOTE (IDLE.SHOW.OPTIONS))
"Print current idle options in prompt window")
("Set Timeout" (QUOTE (IDLE.SET.OPTION (QUOTE TIMEOUT)))
"Set how long before idling started")
("Choose Display" (QUOTE (IDLE.SET.OPTION (QUOTE DISPLAYFN)))
"Choose idle display")
("Forget" (QUOTE (IDLE.SHOW.OPTION (QUOTE FORGET)))
"Erase password when leaving idle mode?"
(SUBITEMS ("Do" (QUOTE (IDLE.SET.OPTION (QUOTE FORGET)
T))
"Erase password upon exiting idle mode")
("Don't" (QUOTE (IDLE.SET.OPTION (QUOTE FORGET)
NIL))
"Retain password through idle mode (unless someone logs in)")))
["Allowed Logins"
(QUOTE (IDLE.SHOW.OPTION (QUOTE ALLOWED.LOGINS)))
"Who can exit idle mode"
(SUBITEMS ("Unlocked" (QUOTE (IDLE.SET.OPTION (QUOTE ALLOWED.LOGINS)
(QUOTE UNLOCKED)))
"No login required to exit idle mode")
("Locked" [QUOTE (IDLE.SET.OPTION (QUOTE ALLOWED.LOGINS)
(QUOTE (T]
"Only the current user may exit idle mode")
("Any Login" [QUOTE (IDLE.SET.OPTION (QUOTE
ALLOWED.LOGINS)
(QUOTE (*]
"Any user may exit, but require login")
("Group" (QUOTE (IDLE.SET.OPTION (QUOTE ALLOWED.LOGINS)
(QUOTE ADD)))
"Only allow specific users and/or groups to exit"
(SUBITEMS ("Include Previous User"
(QUOTE (IDLE.SET.OPTION
(QUOTE ALLOWED.LOGINS)
T))
"If current user exits, check old password")
("Add Member"
(QUOTE (IDLE.SET.OPTION
(QUOTE ALLOWED.LOGINS)
(QUOTE ADD)))
"Add a group or username")
("Remove Member"
(QUOTE (IDLE.SET.OPTION
(QUOTE ALLOWED.LOGINS)
(QUOTE REMOVE)))
"Remove a group or username"]
("Authenticate" (QUOTE (IDLE.SHOW.OPTION (QUOTE AUTHENTICATE)))
"Authenticate user upon exiting idle mode?"
(SUBITEMS ("Do" (QUOTE (IDLE.SET.OPTION (QUOTE
AUTHENTICATE)
T))
"User will be authenticated upon exiting idle mode")
("Don't" (QUOTE (IDLE.SET.OPTION
(QUOTE AUTHENTICATE)
NIL))
"Accept any password--no authentication check"]
(VARS (BackgroundMenu))
(P (\DAYTIME0 \LASTUSERACTION]
(COMS (* * Default idle display)
(FNS IDLE.BOUNCING.BOX IDLE.BITMAP)
[INITVARS (IDLE.BOUNCING.BOX "Interlisp-D")
(IDLE.FUNCTIONS (QUOTE (("Bouncing Box" (QUOTE IDLE.BOUNCING.BOX))
("Bouncing Username" (QUOTE (LAMBDA
(W)
(IDLE.BOUNCING.BOX
W
(USERNAME NIL NIL T]
(GLOBALVARS IDLE.FUNCTIONS IDLE.BOUNCING.BOX))))
(* * Basic idling facility)
(DEFINEQ
(IDLE
[LAMBDA (FROMTIMEOUT) (* bvm: " 5-Nov-85 15:11")
(OR (FNTYP (LISTGET IDLE.PROFILE (QUOTE DISPLAYFN)))
(LISTPUT IDLE.PROFILE (QUOTE DISPLAYFN)
(QUOTE IDLE.BOUNCING.BOX)))
(\CARET.DOWN)
(SETQ \IDLING T)
(ADD.PROCESS (LIST (QUOTE \IDLER)
(KWOTE FROMTIMEOUT))
(QUOTE RESTARTABLE)
T
(QUOTE NAME)
(QUOTE IDLE])
(IDLE.SET.OPTION
[LAMBDA (OPTION X) (* bvm: " 7-Nov-85 22:53")
(CLEARW PROMPTWINDOW)
(IDLE.SHOW.OPTION OPTION "Old")
(LET ((OLD.OPTION (LISTGET IDLE.PROFILE OPTION)))
(LISTPUT
IDLE.PROFILE OPTION
(SELECTQ
OPTION
(DISPLAYFN (OR X (MENU (create MENU
ITEMS ← IDLE.FUNCTIONS))
OLD.OPTION))
(TIMEOUT (LET [(MINS (if (FGETD (QUOTE RNUMBER))
then (RNUMBER "Idle Timeout (in minutes)" NIL NIL NIL T)
else (MKATOM (PROMPTFORWORD "Idle Timeout:" NIL NIL
PROMPTWINDOW NIL (QUOTE
TTY]
(if (NULL MINS)
then OLD.OPTION
elseif (AND (SMALLP MINS)
(GREATERP MINS 0))
then MINS
else NIL)))
(ALLOWED.LOGINS
(SELECTQ X
(UNLOCKED NIL)
(T (UNION (LIST T)
OLD.OPTION))
[ADD (LET [(GROUP (PROMPTFORWORD "Add to allowed login list:" NIL NIL
PROMPTWINDOW NIL (QUOTE TTY]
(TERPRI PROMPTWINDOW)
(COND
((NULL GROUP)
OLD.OPTION)
([OR (NOT (LISTGET IDLE.PROFILE (QUOTE AUTHENTICATE)))
(STREQUAL GROUP "*")
(STREQUAL GROUP "T")
(PROGN (PRINTOUT PROMPTWINDOW "Checking..")
(COND
([OR (AND CH.DEFAULT.DOMAIN
(STRPOS ":" GROUP)
(CH.LOOKUP.OBJECT GROUP))
(AND DEFAULTREGISTRY
(LISTP (GV.READENTRY GROUP]
(PRINTOUT PROMPTWINDOW "..ok" T)
T)
(T (EQ (QUOTE Y)
(RESETFORM (TTYDISPLAYSTREAM
PROMPTWINDOW)
(ASKUSER NIL NIL
" no such name/group. Add anyway? "]
(CONS GROUP (LISTP OLD.OPTION)))
(T OLD.OPTION]
(REMOVE (AND OLD.OPTION
(REMOVE (MENU (create MENU
TITLE ← "Remove group "
CENTERFLG ← T
ITEMS ← OLD.OPTION))
OLD.OPTION)))
(OR (LISTP X)
OLD.OPTION)))
X)))
(IDLE.SHOW.OPTION OPTION "New"])
(IDLE.SHOW.OPTIONS
[LAMBDA NIL (* bvm: "16-Oct-85 00:23")
(FRESHLINE PROMPTWINDOW)
(for TAIL on IDLE.PROFILE by (CDDR TAIL) do (IDLE.SHOW.OPTION (CAR TAIL)
NIL
(COND
((CDDR TAIL)
", ")
(T "."])
(IDLE.SHOW.OPTION
[LAMBDA (OPTION STRING SEPR) (* bvm: "16-Oct-85 00:23")
(LET ((VALUE (LISTGET IDLE.PROFILE OPTION)))
(OR SEPR (FRESHLINE PROMPTWINDOW))
(COND
(STRING (printout PROMPTWINDOW STRING " ")))
(OR SEPR (printout PROMPTWINDOW "Idle "))
(printout PROMPTWINDOW (SELECTQ OPTION
(ALLOWED.LOGINS "Allowed Logins")
(L-CASE OPTION T))
": "
(SELECTQ OPTION
((SAVEVM TIMEOUT)
(COND
[(AND (SMALLP VALUE)
(GREATERP VALUE 0))
(CONCAT VALUE " minute" (COND
((EQ VALUE 1)
"")
(T "s"]
(T "never")))
(ALLOWED.LOGINS (COND
((LISTP VALUE)
(SUBPAIR (QUOTE (T *))
(QUOTE ("<Previous User>" "<Anyone>"))
VALUE))
(T "Unlocked")))
(MKSTRING VALUE)))
(COND
(SEPR (printout PROMPTWINDOW SEPR))
(T (TERPRI PROMPTWINDOW])
(\IDLER
[LAMBDA (FROMTIMEOUT) (* bvm: " 5-Nov-85 23:08")
[RESETLST (RESETSAVE NIL (QUOTE (SETTOPVAL \IDLING NIL)))
(PROG ((START.TIME (ALTO.TO.LISP.DATE \LASTUSERACTION))
W SAVEVM.TIMER IDLE.PROCESS NO.ERROR EXIT? INTERRUPTED.STRING)
(SETQ \IDLE.PASSWORD.SET)
(PROGN (* do things like dump cache listings and flush files
to servers *before* passwords get smashed)
(\USEREVENT (QUOTE BEFORESAVEVM))
(\DEVICEEVENT (QUOTE BEFORESAVEVM))
(\USEREVENT (QUOTE AFTERDOSAVEVM))
(\DEVICEEVENT (QUOTE AFTERDOSAVEVM)))
[for X in IDLE.SUSPEND.PROCESS.NAMES bind PROC
do (* Turn off things like CROCK, LAFITEMAILWATCH,
SPACEWINDOW, REMINDERS)
(COND
((SETQ PROC (FIND.PROCESS X))
(RESETSAVE NIL (LIST (FUNCTION WAKE.PROCESS)
PROC))
(SUSPEND.PROCESS PROC]
(RESETSAVE (GCGAG NIL))
(RESETSAVE \AFTERLOGINFNS NIL) (* So that SETPASSWORD doesn't trigger any activity)
[for X in IDLE.RESETVARS
do (* turn off things like pup-trace, xiptrace and the
like)
(RESETSAVE (SETTOPVAL (CAR X)
(EVAL (CADR X)))
(LIST (FUNCTION SETTOPVAL)
(CAR X)
(GETTOPVAL (CAR X]
(* so that mouse buttons will trigger READP)
(COND
((EQ (LISTGET IDLE.PROFILE (QUOTE FORGET))
(QUOTE FIRST))
(SETQ \IDLE.PASSWORD.SET (QUOTE CLEAR))
(SETPASSWORD NIL (USERNAME NIL NIL T)
"")))
(RESETSAVE (MODIFY.KEYACTIONS (QUOTE ((LEFT (18 18)
18 18)
(MIDDLE (18 18)
18 18)
(RIGHT (18 18)
18 18)))
T))
(RESETSAVE (TTY.PROCESS (THIS.PROCESS)))
(RESETSAVE (RESET.INTERRUPTS NIL T))
(RESETSAVE (CHANGENAME (QUOTE \LOGIN.READ)
(QUOTE PROVIDE.PROMPTING.WINDOW)
(QUOTE \IDLE.PROMPTING.WINDOW))
(QUOTE (CHANGENAME \LOGIN.READ \IDLE.PROMPTING.WINDOW
PROVIDE.PROMPTING.WINDOW)))
(CLEARW PROMPTWINDOW)
(SETQ W (CREATEW WHOLESCREEN NIL 0 T))
(RESETSAVE NIL (LIST (FUNCTION CLOSEW)
W))
[RESETSAVE (CURSOR (CURSORCREATE (BITMAPCREATE 0 0]
(RESETSAVE (VIDEOCOLOR T))
(RESETSAVE (CHANGEBACKGROUNDBORDER WHITESHADE))
(OPENW W)
[COND
((AND (SMALLP (LISTGET IDLE.PROFILE (QUOTE SAVEVM)))
(\FLUSHVMOK? (QUOTE SAVEVM)
T)) (* Set up timer to go off when a SAVEVM should be
done. Don't do it if it's not safe)
(SETQ SAVEVM.TIMER (SETUPTIMER (TIMES (LISTGET IDLE.PROFILE
(QUOTE SAVEVM))
60000]
(SETQ IDLE.PROCESS (ADD.PROCESS [CONS (LISTGET IDLE.PROFILE
(QUOTE DISPLAYFN))
(CONS W (LISTGET
IDLE.PROFILE
(QUOTE DISPLAY.DATA]
(QUOTE NAME)
(QUOTE IDLE.DISPLAY)))
(RESETSAVE NIL (LIST (FUNCTION DEL.PROCESS)
IDLE.PROCESS))
(BLOCK) (* Let the demo get started first)
WAIT.FOR.CHAR
(COND
((NOT (READP))
(BLOCK 250)
(\DIRTYBACKGROUND)
(COND
((\SAVEVMBACKGROUND) (* Coming back from booting the SAVEVM image, restore
screen color)
(VIDEOCOLOR T)
(SETQ SAVEVM.TIMER)))
[COND
((OR (KEYDOWNP (QUOTE LSHIFT))
(KEYDOWNP (QUOTE RSHIFT)))
(AND (PROCESSP IDLE.PROCESS)
(SUSPEND.PROCESS IDLE.PROCESS))
(CLEARW PROMPTWINDOW)
(PRINTOUT PROMPTWINDOW (USERNAME NIL NIL T)
" Idle "
(\IDLE.TIME START.TIME)
T)
(until [NOT (OR (KEYDOWNP (QUOTE LSHIFT))
(KEYDOWNP (QUOTE RSHIFT]
do (BLOCK 250))
(AND IDLE.PROCESS (WAKE.PROCESS IDLE.PROCESS]
(COND
((AND SAVEVM.TIMER (NOT \VMEM.INHIBIT.WRITE)
(TIMEREXPIRED? SAVEVM.TIMER))
(COND
((NOT (\FLUSHVMOK? (QUOTE SAVEVM)
T))
(* SAVEVM not allowed, so forget it forever)
)
([CAR (RESETFORM (CURSOR SAVINGCURSOR)
(NLSETQ (SAVEVM]
(* Coming back from booting the SAVEVM image, restore
screen color)
(VIDEOCOLOR T)))
(SETQ SAVEVM.TIMER)))
(TTY.PROCESS (THIS.PROCESS))
(* Keep us the tty process, even if someone else tries
for it)
(GO WAIT.FOR.CHAR)))
(COND
((PROCESSP IDLE.PROCESS)
(SUSPEND.PROCESS IDLE.PROCESS)))
[SETQ NO.ERROR (NLSETQ (SETQ EXIT? (\IDLE.EXIT?]
(COND
((NOT NO.ERROR)
(SETQ INTERRUPTED.STRING "ERROR while checking Allowed Logins")
(SETPASSWORD NIL (USERNAME NIL NIL T)
"")
(SETQ \IDLE.PASSWORD.SET (QUOTE CLEAR)))
((NOT EXIT?)
[SETQ INTERRUPTED.STRING (CONCAT
"Someone tried to use the machine at "
(DATE (DATEFORMAT NO.DATE]
(DISMISS 5000)
(AND IDLE.PROCESS (WAKE.PROCESS IDLE.PROCESS))
(CLEARBUF T)
(GO WAIT.FOR.CHAR)))
EXIT(CLOSEW W)
(FRESHLINE PROMPTWINDOW)
(AND INTERRUPTED.STRING (PRINTOUT PROMPTWINDOW INTERRUPTED.STRING T))
(PRINTOUT PROMPTWINDOW "Idle time " (\IDLE.TIME START.TIME]
(COND
(\IDLE.PASSWORD.SET (* Notify anyone who cares about login change, since
we suppressed it earlier)
(MAPC \AFTERLOGINFNS (FUNCTION APPLY*])
(\IDLE.TIME
[LAMBDA (START.TIME) (* bvm: "15-Oct-85 23:35")
(LET [(GONE (IDIFFERENCE (IDATE)
START.TIME))
(ONEDAY (CONSTANT (IDIFFERENCE (IDATE "2-Jan-80 00:00:00")
(IDATE "1-Jan-80 00:00:00"]
(COND
((ILESSP GONE ONEDAY) (* Express in hours:min:sec)
(GDATE (IPLUS (IDATE "1-Jan-80 00:00:00")
GONE)
(DATEFORMAT NO.DATE)))
(T (CONCAT (SETQ GONE (QUOTIENT GONE ONEDAY))
" day"
(COND
((GREATERP GONE 1)
"s.")
(T "."])
(\IDLE.OUT
[LAMBDA NIL (* bvm: "16-Sep-85 18:34")
(AND (NOT \IDLING)
(LET [(TIMEOUT (LISTGET IDLE.PROFILE (QUOTE TIMEOUT]
(AND (SMALLP TIMEOUT)
(GREATERP TIMEOUT 0)
(\SECONDSCLOCKGREATERP \LASTUSERACTION (TIMES TIMEOUT 60))
(IDLE T])
(\IDLE.EXIT?
[LAMBDA NIL (* bvm: " 5-Nov-85 23:41")
(RESETLST (RESETSAVE (TTYDISPLAYSTREAM PROMPTWINDOW))
(CLEARBUF T)
(PROG ((GROUP (LISTGET IDLE.PROFILE (QUOTE ALLOWED.LOGINS)))
(AUTHTYPE (LISTGET IDLE.PROFILE (QUOTE AUTHENTICATE)))
(NAME (USERNAME NIL NIL T))
PWD)
(COND
((NLISTP GROUP) (* no login check at all)
(COND
((LISTGET IDLE.PROFILE (QUOTE FORGET))
(SETPASSWORD NIL NAME "")))
(RETURN T)))
(COND
((EQ 0 (NCHARS NAME)) (* Not logged in, so don't complain about anything)
(RETURN T)))
(OBTAIN.MONITORLOCK \GETPASSWORD.LOCK NIL T)
(* Lock out anyone else trying to prompt for a
password)
(CLEARW PROMPTWINDOW) (* prompt for password, maybe new username)
[SETQ PWD
(COND
((AND (EQUAL GROUP (QUOTE (T)))
NAME) (* Only previous user allowed to login)
(PROMPTFORWORD (CONCAT NAME " password:")
NIL NIL NIL (QUOTE *)
(QUOTE TTY)))
(T (PROG1 [CDR (SETQ NAME (CAR (NLSETQ (\LOGIN.READ
NIL NAME NIL NIL
(QUOTE NS]
(SETQ NAME (MKSTRING (CAR NAME]
(* decide whether NAME and PWD are in GROUP)
(RETURN (COND
((NULL PWD)
NIL)
([AND (OR (MEMB T GROUP)
(MEMB (QUOTE *)
GROUP))
(\IDLE.IS.PREVIOUS NAME PWD (EQUAL GROUP
(QUOTE (T]
(* Previous user is allowed to login.
Also, if only allowed login is old user, but old
password is unknown, allow it)
T)
((\IDLE.ISMEMBER GROUP NAME PWD)
(COND
((COND
[AUTHTYPE (\IDLE.AUTHENTICATE NAME PWD AUTHTYPE
(NOT (MEMB T GROUP]
(T T))
(SETPASSWORD NIL NAME PWD)
(SETQ \IDLE.PASSWORD.SET T)
T)))
(T (PRINTOUT PROMPTWINDOW "login incorrect" T)
NIL])
(\IDLE.PROMPTING.WINDOW
[LAMBDA (TITLE) (* bvm: " 5-Nov-85 23:10")
(* * Replaces PROVIDE.PROMPTING.WINDOW in \LOGIN.READ while idle is on)
(RESETSAVE (INTERRUPTCHAR 5 (QUOTE ERROR))) (* Allow ↑E to abort prompt)
(COND
((NEQ (PROCESSPROP (THIS.PROCESS)
(QUOTE NAME))
(QUOTE IDLE))
(OR \IDLE.PASSWORD.SET (SETQ \IDLE.PASSWORD.SET T))
(RESETSAVE (TTYDISPLAYSTREAM PROMPTWINDOW))
(RESETSAVE (TTY.PROCESS (THIS.PROCESS)))
(RESETSAVE (SUSPEND.PROCESS (QUOTE IDLE))
(QUOTE (WAKE.PROCESS IDLE)))
(RESETSAVE (SUSPEND.PROCESS (QUOTE IDLE.DISPLAY))
(QUOTE (WAKE.PROCESS IDLE.DISPLAY])
(\IDLE.IS.PREVIOUS
[LAMBDA (NAME PWD NULLOK) (* bvm: " 5-Nov-85 23:24")
(* * if the new name is the same as the old name, and the old global password wasn't forgotten, then allow the old
password)
(AND (NEQ \IDLE.PASSWORD.SET (QUOTE CLEAR))
(STRING-EQUAL (USERNAME NIL NIL T)
NAME)
(LET ((PASSWORDADDR (EMPASSWORDLOC))
OLDPWD)
(COND
((AND (NEQ PASSWORDADDR 0)
(NEQ [NCHARS (SETQ OLDPWD (GetBcplString (EMPOINTER PASSWORDADDR]
0))
(STRING-EQUAL OLDPWD PWD))
(T (* there was no password)
NULLOK])
(\IDLE.ISMEMBER
[LAMBDA (GROUP NAME PWD) (* bvm: " 5-Nov-85 22:50")
(OR [for X in GROUP thereis (COND
((EQ X T)
(STRING-EQUAL NAME (USERNAME)))
((STRPOS "*" X)
T)
((STRPOS ":" X)
(EQUAL.CH.NAMES (PARSE.NSNAME NAME)
(PARSE.NSNAME X)))
(T (STRING-EQUAL X (COND
((OR (NULL DEFAULTREGISTRY)
(STRPOS "." NAME)
(NOT (STRPOS "." X)))
NAME)
(T (CONCAT NAME "." DEFAULTREGISTRY]
(for X in GROUP thereis (COND
((EQ X T)
NIL)
((AND DEFAULTREGISTRY (STRPOS "↑." X))
(PRINTOUT T "..." X "?...")
(SELECTQ (GV.ISMEMBERCLOSURE X (\CHECKNAME NAME))
(T (PRINTOUT T "ok.")
T)
(NIL (PRINTOUT T "no.")
NIL)
(BadRName (PRINTOUT T "not a GV group")
NIL)
T))
((AND CH.DEFAULT.DOMAIN (STRPOS ":" X))
(PRINTOUT T "..." X "?...")
(SELECTQ (CH.ISMEMBER (PARSE.NSNAME X)
(QUOTE MEMBERS)
NIL
(CH.LOOKUP.OBJECT NAME))
(T (PRINTOUT T "ok.")
T)
(NIL (PRINTOUT T "no.")
NIL)
(ERROR (PRINTOUT T "not an NS group")
NIL)
T])
(\IDLE.AUTHENTICATE
[LAMBDA (NAME PWD TYPE IFALLDOWN) (* bvm: "15-Oct-85 23:43")
(printout PROMPTWINDOW T "Authenticating " NAME " ...")
(LET ((NS (AND (NEQ TYPE (QUOTE GV))
CH.DEFAULT.DOMAIN))
(GV (AND (NEQ TYPE (QUOTE NS))
DEFAULTREGISTRY))
CODE)
[AND (EQ TYPE T)
(COND
((STRPOS ":" NAME)
(SETQ GV)
(SETQ NS T))
((AND (STRPOS "." NAME)
DEFAULTREGISTRY)
(SETQ NS)
(SETQ GV T]
[OR [AND NS (EQ T (SETQ CODE (NS.AUTHENTICATE (NS.MAKE.SIMPLE.CREDENTIALS
(CONS NAME (\ENCRYPT.PWD
(CONCAT PWD]
(AND GV (SETQ CODE (GV.AUTHENTICATE NAME (\ENCRYPT.PWD (CONCAT PWD]
(SELECTQ CODE
(AllDown (printout PROMPTWINDOW "All authentication servers down" T)
IFALLDOWN)
((T NIL)
(printout PROMPTWINDOW "ok.")
T)
((SimpleKeyDoesNotExist CredentialsInvalid BadRName BadPassword)
NIL)
(PROGN (printout PROMPTWINDOW T "Odd response from authenticator: " CODE)
T])
)
(RPAQ? IDLE.PROFILE (QUOTE (ALLOWED.LOGINS (T *)
FORGET T TIMEOUT 20 DISPLAYFN IDLE.BOUNCING.BOX SAVEVM
10 AUTHENTICATE T)))
(RPAQ? \IDLING )
(RPAQ? CH.DEFAULT.DOMAIN )
(RPAQ? DEFAULTREGISTRY )
(ADDTOVAR IDLE.SUSPEND.PROCESS.NAMES MOUSE LAFITEMAILWATCH CROCK.PROCESS SPACEWINDOW
REMINDERS.WATCHDOG)
(ADDTOVAR IDLE.RESETVARS (PUPTRACEFLG NIL)
(XIPTRACEFLG NIL))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS IDLE.PROFILE \IDLING \LASTUSERACTION IDLE.RESETVARS IDLE.SUSPEND.PROCESS.NAMES
CH.DEFAULT.DOMAIN DEFAULTREGISTRY \AFTERLOGINFNS SAVINGCURSOR \VMEM.INHIBIT.WRITE
\IDLE.PASSWORD.SET)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(FONTCREATE (QUOTE TIMESROMAND)
36)
(ADDTOVAR BACKGROUNDFNS \IDLE.OUT)
(ADDTOVAR BackgroundMenuCommands [Idle
(QUOTE (IDLE))
"Enter Idle mode"
(SUBITEMS ("Show Profile" (QUOTE (IDLE.SHOW.OPTIONS))
"Print current idle options in prompt window")
("Set Timeout" (QUOTE (IDLE.SET.OPTION (QUOTE TIMEOUT)))
"Set how long before idling started")
("Choose Display" (QUOTE (IDLE.SET.OPTION (QUOTE DISPLAYFN)))
"Choose idle display")
("Forget" (QUOTE (IDLE.SHOW.OPTION (QUOTE FORGET)))
"Erase password when leaving idle mode?"
(SUBITEMS ("Do" (QUOTE (IDLE.SET.OPTION (QUOTE FORGET)
T))
"Erase password upon exiting idle mode")
("Don't" (QUOTE (IDLE.SET.OPTION (QUOTE FORGET)
NIL))
"Retain password through idle mode (unless someone logs in)")))
["Allowed Logins" (QUOTE (IDLE.SHOW.OPTION (QUOTE ALLOWED.LOGINS)))
"Who can exit idle mode"
(SUBITEMS ("Unlocked" (QUOTE (IDLE.SET.OPTION (QUOTE
ALLOWED.LOGINS)
(QUOTE UNLOCKED)
))
"No login required to exit idle mode")
("Locked" [QUOTE (IDLE.SET.OPTION (QUOTE
ALLOWED.LOGINS)
(QUOTE (T]
"Only the current user may exit idle mode")
("Any Login" [QUOTE (IDLE.SET.OPTION (QUOTE
ALLOWED.LOGINS)
(QUOTE (*]
"Any user may exit, but require login")
("Group" (QUOTE (IDLE.SET.OPTION (QUOTE
ALLOWED.LOGINS)
(QUOTE ADD)))
"Only allow specific users and/or groups to exit"
(SUBITEMS
("Include Previous User"
(QUOTE (IDLE.SET.OPTION (QUOTE
ALLOWED.LOGINS)
T))
"If current user exits, check old password")
("Add Member"
(QUOTE (IDLE.SET.OPTION (QUOTE
ALLOWED.LOGINS)
(QUOTE ADD)))
"Add a group or username")
("Remove Member"
(QUOTE (IDLE.SET.OPTION (QUOTE
ALLOWED.LOGINS)
(QUOTE REMOVE))
)
"Remove a group or username"]
("Authenticate" (QUOTE (IDLE.SHOW.OPTION (QUOTE AUTHENTICATE)))
"Authenticate user upon exiting idle mode?"
(SUBITEMS ("Do" (QUOTE (IDLE.SET.OPTION (QUOTE AUTHENTICATE)
T))
"User will be authenticated upon exiting idle mode")
("Don't" (QUOTE (IDLE.SET.OPTION (QUOTE AUTHENTICATE)
NIL))
"Accept any password--no authentication check"])
(RPAQQ BackgroundMenu NIL)
(\DAYTIME0 \LASTUSERACTION)
)
(* * Default idle display)
(DEFINEQ
(IDLE.BOUNCING.BOX
[LAMBDA (WINDOW BOX WAIT) (* bvm: "16-Oct-85 00:47")
(OR WAIT (SETQ WAIT 1000))
(OR BOX (SETQ BOX IDLE.BOUNCING.BOX))
(RESETLST (LET ((MAXX (WINDOWPROP WINDOW (QUOTE WIDTH)))
(MAXY (WINDOWPROP WINDOW (QUOTE HEIGHT)))
ORIGBOX X Y BITMAP)
[for TAIL on [SETQ BOX (COND
((LISTP BOX) (* don't want to trash user's box)
(COPY BOX))
(T (LIST BOX]
unless (WINDOWP (CAR TAIL))
do (* Precompute everything but windows)
(RPLACA TAIL (IDLE.BITMAP NIL (CAR TAIL]
(SETQ ORIGBOX BOX)
(while T
do (SETQ BITMAP (IDLE.BITMAP BITMAP (CAR BOX)))
(SETQ BOX (OR (CDR BOX)
ORIGBOX)) (* rotate it)
[SETQ X (RAND (IDIFFERENCE MAXX (BITMAPWIDTH BITMAP]
[SETQ Y (RAND (IDIFFERENCE MAXY (BITMAPHEIGHT BITMAP]
(BITBLT BITMAP 0 0 WINDOW X Y NIL NIL NIL (QUOTE INVERT))
(BLOCK WAIT)
(BITBLT BITMAP 0 0 WINDOW X Y NIL NIL NIL (QUOTE INVERT])
(IDLE.BITMAP
[LAMBDA (BITMAP BOX) (* bvm: " 7-Nov-85 23:11")
(COND
((BITMAPP BOX)
BOX)
((WINDOWP BOX)
(LET* ((REGION (WINDOWPROP BOX (QUOTE REGION)))
(WIDTH (fetch (REGION WIDTH) of REGION))
(HEIGHT (fetch (REGION HEIGHT) of REGION)))
(OR (AND (BITMAPP BITMAP)
(EQ (BITMAPWIDTH BITMAP)
WIDTH)
(EQ (BITMAPHEIGHT BITMAP)
HEIGHT))
(SETQ BITMAP (BITMAPCREATE WIDTH HEIGHT)))
(TOTOPW BOX)
(BITBLT (SCREENBITMAP)
(fetch (REGION LEFT) of REGION)
(fetch (REGION BOTTOM) of REGION)
BITMAP)
BITMAP))
[(LISTP BOX)
(OR (BITMAPP (CAR BOX))
(CAR (RPLACA BOX (IDLE.BITMAP NIL (CAR BOX]
(T (LET ((FONT (OR (FONTCREATE (QUOTE TIMESROMAND)
36 NIL NIL NIL T)
(PROGN (* Shouldn't happen unless somebody flushed
TIMESROMAND 36 -- don't want to break)
(FONTCREATE (QUOTE HELVETICA)
12 NIL NIL NIL T))
DEFAULTFONT))
DSP)
(COND
((NOT (AND (OR (STRINGP BOX)
(LITATOM BOX))
(NEQ (NCHARS BOX)
0)))
(SETQ BOX "Interlisp-D")))
(SETQ BITMAP (BITMAPCREATE (STRINGWIDTH BOX FONT)
(FONTHEIGHT FONT)))
(SETQ DSP (DSPCREATE BITMAP))
(DSPFONT FONT DSP)
(MOVETO 0 (DIFFERENCE (FONTHEIGHT FONT)
(FONTASCENT FONT))
DSP)
(PRIN3 BOX DSP)
BITMAP])
)
(RPAQ? IDLE.BOUNCING.BOX "Interlisp-D")
(RPAQ? IDLE.FUNCTIONS [QUOTE (("Bouncing Box" (QUOTE IDLE.BOUNCING.BOX))
("Bouncing Username" (QUOTE (LAMBDA (W)
(IDLE.BOUNCING.BOX W
(USERNAME
NIL NIL T])
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS IDLE.FUNCTIONS IDLE.BOUNCING.BOX)
)
(PUTPROPS IDLER COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (4330 22908 (IDLE 4340 . 4813) (IDLE.SET.OPTION 4815 . 7117) (IDLE.SHOW.OPTIONS 7119 .
7479) (IDLE.SHOW.OPTION 7481 . 8531) (\IDLER 8533 . 15181) (\IDLE.TIME 15183 . 15833) (\IDLE.OUT 15835
. 16193) (\IDLE.EXIT? 16195 . 18683) (\IDLE.PROMPTING.WINDOW 18685 . 19491) (\IDLE.IS.PREVIOUS 19493
. 20212) (\IDLE.ISMEMBER 20214 . 21710) (\IDLE.AUTHENTICATE 21712 . 22906)) (26476 29436 (
IDLE.BOUNCING.BOX 26486 . 27738) (IDLE.BITMAP 27740 . 29434)))))
STOP