(FILECREATED "13-Feb-86 16:00:49" {ERIS}<LISPCORE>SOURCES>IDLER.;83 38912
changes to: (FNS IDLE)
previous date: "22-Jan-86 20:40:34" {ERIS}<LISPCORE>SOURCES>IDLER.;82)
(* Copyright (c) 1985, 1986 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 \OK.TO.IDLE? \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"
(SUBITEMS ("Never" (IDLE.SET.OPTION (QUOTE TIMEOUT)
0)
"Never spontaneously enter idle mode")))
("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 "Xerox Lisp")
(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) (* lmm
"13-Feb-86 13:59")
(if (NOT \IDLING)
then (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) (* drc: " 3-Jan-86 11:47")
(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 (OR X (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) (* drc: " 3-Jan-86 11:40")
[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)
(COND
((NOT (\OK.TO.IDLE?)) (* Somebody in password prompt, better not idle)
(RETURN)))
(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)))
(COND
((OR [AND FROMTIMEOUT (NOT (LET [(TIMEOUT (LISTGET IDLE.PROFILE
(QUOTE TIMEOUT]
(AND (SMALLP TIMEOUT)
(\SECONDSCLOCKGREATERP
\LASTUSERACTION
(TIMES TIMEOUT 60]
(NOT (\OK.TO.IDLE?)))
(* Check again if it's ok, since somebody could have fallen into a password prompter between then and now.
Anybody who does after this is ok, because the CHANGENAME above is now in effect. Also check timeout again, in case
there was a user interaction during the BEFORESAVEVM stuff)
(RETURN)))
(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 T T))
(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]
(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*])
(\OK.TO.IDLE?
[LAMBDA NIL (* bvm: " 4-Dec-85 15:05")
(RESETLST (OBTAIN.MONITORLOCK \GETPASSWORD.LOCK T T])
(\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 (* lmm
"22-Jan-86 13:06")
(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))
PROMPTWINDOW))
(T T))
(SETPASSWORD NIL NAME PWD)
(SETQ \IDLE.PASSWORD.SET T)
T)
(T (DISMISS 5000) (* Let the error
message be visible)
NIL)))
(T (PRINTOUT PROMPTWINDOW "login incorrect" T)
(DISMISS 5000) (* Let the error
message be visible)
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 OUTPUT) (* lmm
"22-Jan-86 13:06")
(printout OUTPUT 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 OUTPUT "All authentication servers down" T)
IFALLDOWN)
((T NIL)
(printout OUTPUT "ok.")
T)
((SimpleKeyDoesNotExist CredentialsInvalid BadRName BadPassword)
(printout OUTPUT CODE)
NIL)
(PROGN (printout OUTPUT 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"
(SUBITEMS ("Never" (IDLE.SET.OPTION (QUOTE TIMEOUT)
0)
"Never spontaneously enter idle mode")))
("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) (* lmm "18-Jan-86 03:01")
(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 "Xerox Lisp")))
(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 "Xerox Lisp")
(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 1986))
(DECLARE: DONTCOPY
(FILEMAP (NIL (7543 29648 (IDLE 7553 . 8253) (IDLE.SET.OPTION 8255 . 10585) (IDLE.SHOW.OPTIONS 10587
. 10947) (IDLE.SHOW.OPTION 10949 . 11999) (\IDLER 12001 . 19423) (\OK.TO.IDLE? 19425 . 19600) (
\IDLE.TIME 19602 . 20252) (\IDLE.OUT 20254 . 20612) (\IDLE.EXIT? 20614 . 25189) (
\IDLE.PROMPTING.WINDOW 25191 . 25997) (\IDLE.IS.PREVIOUS 25999 . 26718) (\IDLE.ISMEMBER 26720 . 28216)
(\IDLE.AUTHENTICATE 28218 . 29646)) (35353 38324 (IDLE.BOUNCING.BOX 35363 . 36615) (IDLE.BITMAP 36617
. 38322)))))
STOP