(FILECREATED "13-Aug-85 18:14:10" {ERIS}<LISPCORE>SOURCES>IDLER.;36 16550
changes to: (FNS IDLE IDLE.SHOW.OPTIONS IDLE.SET.OPTIONS IDLE.AUTHENTICATE)
previous date: "12-Aug-85 23:24:35" {ERIS}<LISPCORE>SOURCES>IDLER.;35)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT IDLERCOMS)
(RPAQQ IDLERCOMS ((FNS IDLE IDLE.SHOW.OPTIONS IDLE.SET.OPTIONS IDLE.AUTHENTICATE \IDLER IDLE.OUT
IDLE.BOUNCING.BOX IDLE.BITMAP)
(INITVARS (IDLE.TIMEOUT 600)
(IDLE.DEFAULTFN (QUOTE IDLE.BOUNCING.BOX))
(IDLE.BITMAP "Interlisp-D")
(IDLE.DEFAULTMODE (QUOTE LOCK))
(\IDLING)
(ALLOWED.LOGINS))
(ADDVARS [BackgroundMenuCommands (Idle (QUOTE (IDLE))
"Enter Idle mode"
(SUBITEMS ("Set Idler Options"
(QUOTE (IDLE.SET.OPTIONS)))
(Lock (QUOTE (IDLE NIL
(QUOTE LOCK)))
"Require your password")
(Unlocked
(QUOTE (IDLE NIL (QUOTE UNLOCKED)
))
"Keep password, don't lock up")
(Forget
(QUOTE (IDLE NIL (QUOTE FORGET)))
"Clear password on entering idle mode, require login on exit")
(Authenticate
(QUOTE (IDLE NIL (QUOTE
AUTHENTICATE)))
"Require login, check with the net"]
[IDLE.FUNCTIONS ("Bouncing box" (QUOTE IDLE.BOUNCING.BOX))
("Bouncing star" (QUOTE (LAMBDA (W)
(IDLE.BOUNCING.BOX W "*"
10]
(IDLE.RESETVARS (PUPTRACEFLG NIL)
(XIPTRACEFLG NIL)
(SAVEVMMAX (REALMEMORYSIZE)))
(IDLE.SUSPEND.PROCESS.NAMES MOUSE LAFITEMAILWATCH CROCK.PROCESS
SPACEWINDOW REMINDERS.WATCHDOG))
(APPENDVARS (TTYBACKGROUNDFNS IDLE.OUT))
(GLOBALVARS IDLE.TIMEOUT IDLE.DEFAULTFN IDLE.BITMAP IDLE.DEFAULTMODE \IDLING
IDLE.FUNCTIONS ALLOWED.LOGINS IDLE.RESETVARS IDLE.SUSPEND.PROCESS.NAMES
\LASTUSERACTION)
(VARS (BackgroundMenu))))
(DEFINEQ
(IDLE
[LAMBDA (IDLEFN MODE) (* drc: "13-Aug-85 16:38")
(OR (FNTYP IDLEFN)
(FNTYP (SETQ IDLEFN IDLE.DEFAULTFN))
(SETQQ IDLEFN IDLE.BOUNCING.BOX))
(OR MODE (SETQ MODE IDLE.DEFAULTMODE))
(OR (FMEMB MODE (QUOTE (LOCK UNLOCKED FORGET AUTHENTICATE NS.AUTHENTICATE GV.AUTHENTICATE)))
(SETQ MODE (QUOTE UNLOCKED)))
(\CARET.DOWN)
(SETQ \IDLING T)
(ADD.PROCESS (BQUOTE (\IDLER (QUOTE , (OR IDLEFN IDLE.DEFAULTFN))
(QUOTE , MODE)))
(QUOTE RESTARTABLE)
T)
(BLOCK])
(IDLE.SHOW.OPTIONS
[LAMBDA NIL (* drc: "13-Aug-85 17:34")
(CLEARW PROMPTWINDOW)
(PRINTOUT PROMPTWINDOW "Idle program:" IDLE.DEFAULTFN " Default Mode:" IDLE.DEFAULTMODE
" Timeout:")
(if (AND IDLE.TIMEOUT (SMALLP IDLE.TIMEOUT)
(NEQ IDLE.TIMEOUT 0))
then (PRINTOUT PROMPTWINDOW .I3 (QUOTIENT IDLE.TIMEOUT 60)
" minutes.")
else (PRINTOUT PROMPTWINDOW "never."))
(AND ALLOWED.LOGINS [NOT (MEMB IDLE.DEFAULTMODE (QUOTE (UNLOCKED FORGET]
(PRINTOUT PROMPTWINDOW T ALLOWED.LOGINS " allowed to login."])
(IDLE.SET.OPTIONS
[LAMBDA NIL (* drc: "13-Aug-85 16:38")
(IDLE.SHOW.OPTIONS)
[PROG (OPTION)
(SELECTQ (SETQ OPTION (MENU (create MENU
ITEMS ←(APPEND (QUOTE (Lock Unlocked Forget
Authenticate Never Timeout
""))
IDLE.FUNCTIONS)
TITLE ← "Set Idle Option")))
((Forget Unlocked Lock Authenticate)
(SETQ IDLE.DEFAULTMODE (U-CASE OPTION)))
(Never (SETQ IDLE.TIMEOUT))
[Timeout (PROG [(X (COND
((GETD (QUOTE RNUMBER))
(RNUMBER "Idle timeout (mins)" NIL MENUFONT MENUFONT T))
(T (PROMPTFORWORD "Idle timeout (in minutes):"
(QUOTIENT IDLE.TIMEOUT 60]
(SETQ IDLE.TIMEOUT (AND (SMALLP X)
(GREATERP X 0)
(TIMES 60 X]
(OR (STRINGP OPTION)
(NULL OPTION)
(SETQ IDLE.DEFAULTFN OPTION]
(IDLE.SHOW.OPTIONS])
(IDLE.AUTHENTICATE
[LAMBDA (MODE) (* drc: "13-Aug-85 17:31")
(PROG [(NS (NEQ MODE (QUOTE GV.AUTHENTICATE)))
(GV (NEQ MODE (QUOTE NS.AUTHENTICATE)))
(GROUP ALLOWED.LOGINS)
(NAME (USERNAME))
(OLDPWD (CDR (\INTERNAL/GETPASSWORD]
(CLEARW PROMPTWINDOW)
(CLEARBUF T)
(AND (EQ MODE (QUOTE LOCK))
(NULL OLDPWD)
(RETURN T))
(LET [(PWD (if GROUP
then (PROG1 [CDR (SETQ NAME (RESETFORM (TTYDISPLAYSTREAM PROMPTWINDOW)
(\LOGIN.READ NIL NAME NIL NIL
(AND NS (QUOTE NS]
(SETQ NAME (CAR NAME)))
else (PROMPTFORWORD (CONCAT (USERNAME)
" password:")
NIL NIL PROMPTWINDOW (QUOTE *)
(QUOTE TTY]
(SELECTQ MODE
[LOCK (if (STRING-EQUAL (USERNAME)
NAME)
then (RETURN (OR (STRING-EQUAL (\DECRYPT.PWD (CONCAT OLDPWD))
PWD)
(PROGN (PRINTOUT PROMPTWINDOW "Incorrect password")
NIL]
[(AUTHENTICATE GV.AUTHENTICATE NS.AUTHENTICATE)
(LET (CODE)
(PRINTOUT PROMPTWINDOW "Authenticating " NAME " ...")
(if (STRPOS "." NAME)
then (SETQ NS)
(SETQ GV T)
elseif (STRPOS ":" NAME)
then (SETQ GV)
(SETQ NS 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]
(if (AND (SELECTQ CODE
(AllDown (PRINTOUT PROMPTWINDOW
"All authentication servers down"
T)
(NEQ MODE (QUOTE LOCK)))
((T NIL)
(PRINTOUT PROMPTWINDOW "ok.")
T)
((CredentialsInvalid BadRName BadPassword)
(PRINTOUT PROMPTWINDOW CODE T)
NIL)
(PROGN (PRINTOUT PROMPTWINDOW T
"Odd response from authenticator: "
CODE)
T)))
then (RESETSAVE NIL (LIST (QUOTE SETPASSWORD)
NIL NAME PWD))
(RETURN T]
NIL)
(AND GROUP [OR (for X inside GROUP
suchthat (COND
([if (AND NS (STRPOS ":" X))
then (EQUAL.CH.NAMES (PARSE.NSNAME NAME)
(PARSE.NSNAME X))
else (STRING-EQUAL X
(if (OR (STRPOS "." NAME)
(NULL DEFAULTREGISTRY)
(NOT (STRPOS "." X)))
then NAME
else (CONCAT NAME "."
DEFAULTREGISTRY]
(PRINTOUT PROMPTWINDOW , X " allowed to login." T)
T)))
(for X inside GROUP suchthat (COND
((if (AND GV DEFAULTREGISTRY
(STRPOS "↑." X))
then (PRINTOUT PROMPTWINDOW "..." X
"?...")
(if (GV.ISMEMBERCLOSURE
X
(\CHECKNAME NAME))
then (PRINTOUT
PROMPTWINDOW
"ok.")
T
else (PRINTOUT PROMPTWINDOW
"no.")
NIL)
elseif (AND NS (STRPOS ":" X))
then (CH.ISMEMBER (PARSE.NSNAME
X)
(QUOTE MEMBERS)
NIL
(CH.LOOKUP.OBJECT
NAME)))
(PRINTOUT PROMPTWINDOW , X
" allowed to login.")
T]
(PROGN (SETPASSWORD NIL NAME PWD)
(RETURN T])
(\IDLER
[LAMBDA (IDLEFN MODE) (* drc: "13-Aug-85 15:53")
(RESETLST (RESETSAVE NIL (QUOTE (SETTOPVAL \IDLING NIL)))
(PROG (W IDLE.PROCESS (START.TIME (ALTO.TO.LISP.DATE \LASTUSERACTION))
INTERRUPTED.STRING SUSPENDED)
(OR (OBTAIN.MONITORLOCK \GETPASSWORD.LOCK T T)
(PROGN (* someone else trying to login)
(RETURN)))
(PROGN (* do things like dump cache listings and flush files
to servers *before* passwords get smashed)
(\USEREVENT (QUOTE BEFORESAVEVM))
(\DEVICEEVENT (QUOTE BEFORESAVEVM)))
[for X in IDLE.RESETVARS
do (* turn off things like pup-trace, xiptrace and the
like -
also, most importantly, sets \AFETERLOGINFNS too)
[RESETSAVE NIL (LIST (QUOTE SETTOPVAL)
(CAR X)
(GETTOPVAL (CAR X]
(SETTOPVAL (CAR X)
(EVAL (CADR X]
(RESETSAVE (GCGAG NIL))
[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] (* so that mouse buttons will trigger READP)
(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))
(SELECTQ MODE
(NEVER (RETURN))
(FORGET (SETPASSWORD NIL (USERNAME)))
NIL)
(\CARET.DOWN)
(SETQ W (CREATEW WHOLESCREEN NIL 0 T))
(CLEARW PROMPTWINDOW)
[RESETSAVE (CURSOR (CURSORCREATE (BITMAPCREATE 0 0]
(RESETSAVE NIL (BQUOTE (CLOSEW , W)))
(RESETSAVE (VIDEOCOLOR T))
(RESETSAVE (CHANGEBACKGROUNDBORDER WHITESHADE))
(OPENW W)
(SETQ IDLE.PROCESS (ADD.PROCESS (LIST IDLEFN W)))
[RESETSAVE NIL (BQUOTE (AND (PROCESSP (QUOTE , IDLE.PROCESS))
(DEL.PROCESS (QUOTE , IDLE.PROCESS]
(BLOCK) (* Let the demo get started first)
WAIT.FOR.CHAR
(if (NOT (READP))
then (BLOCK 250)
(\SAVEVMBACKGROUND)
(GO WAIT.FOR.CHAR))
(COND
((PROCESSP IDLE.PROCESS)
(SUSPEND.PROCESS IDLE.PROCESS)))
(SELECTQ MODE
(UNLOCKED (* just return -
no questions asked)
(RETURN))
[FORGET (* just forget password, don't lock)
(RETURN (RESETFORM (TTYDISPLAYSTREAM PROMPTWINDOW)
(\INTERNAL/SETPASSWORD NIL (\LOGIN.READ
NIL
(USERNAME]
((AUTHENTICATE GV.AUTHENTICATE NS.AUTHENTICATE LOCK)
(COND
((NOT (IDLE.AUTHENTICATE MODE))
[SETQ INTERRUPTED.STRING (CONCAT
"Someone tried to use the machine at "
(GDATE NIL (DATEFORMAT NO.DATE]
(DISMISS 5000)
(AND IDLE.PROCESS (WAKE.PROCESS IDLE.PROCESS))
(CLEARBUF T)
(GO WAIT.FOR.CHAR)))
(RETURN))
NIL)
(CLOSEW W)
(FRESHLINE PROMPTWINDOW)
(AND INTERRUPTED.STRING (PRINTOUT PROMPTWINDOW INTERRUPTED.STRING T))
(PRINTOUT PROMPTWINDOW "Idle time " (LET [(GONE (IDIFFERENCE (IDATE)
START.TIME))
(ONEDAY (IDIFFERENCE (IDATE
"2-Jan-80 00:00:00")
(IDATE
"1-Jan-80 00:00:00"]
(if (ILESSP GONE ONEDAY)
then (GDATE (IPLUS (IDATE
"1-Jan-80 00:00:00")
GONE)
(DATEFORMAT NO.DATE))
else (CONCAT (SETQ GONE
(QUOTIENT GONE ONEDAY))
" day"
(if (GREATERP GONE 1)
then "s."
else "."])
(IDLE.OUT
[LAMBDA NIL (* lmm "12-Aug-85 23:01")
(AND (NOT \IDLING)
(SMALLP IDLE.TIMEOUT)
(GREATERP IDLE.TIMEOUT 0)
(\SECONDSCLOCKGREATERP \LASTUSERACTION IDLE.TIMEOUT)
(IDLE])
(IDLE.BOUNCING.BOX
[LAMBDA (WINDOW BITMAP WAIT) (* lmm " 5-Aug-85 04:57")
(OR WAIT (SETQ WAIT 1000))
(OR BITMAP (SETQ BITMAP IDLE.BITMAP))
(LET [(MAXX (WINDOWPROP WINDOW (QUOTE WIDTH)))
(MAXY (WINDOWPROP WINDOW (QUOTE HEIGHT]
(LET ((X (QUOTIENT MAXX 2))
(Y (QUOTIENT MAXY 2))
REALBITMAP)
(while T
do (SETQ REALBITMAP (IDLE.BITMAP REALBITMAP BITMAP))
[SETQ X (RAND (IDIFFERENCE MAXX (BITMAPWIDTH REALBITMAP]
[SETQ Y (RAND (IDIFFERENCE MAXY (BITMAPHEIGHT REALBITMAP]
(BITBLT REALBITMAP 0 0 WINDOW X Y NIL NIL NIL (QUOTE INVERT))
(BLOCK WAIT)
(BITBLT REALBITMAP 0 0 WINDOW X Y NIL NIL NIL (QUOTE INVERT])
(IDLE.BITMAP
[LAMBDA (BITMAP BOX) (* lmm " 4-Aug-85 05:48")
(if (STRINGP BOX)
then (if (BITMAPP BITMAP)
then BITMAP
else (LET ((FONT (FONTCREATE (QUOTE TIMESROMAND)
36))
DSP)
(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))
elseif (BITMAPP BOX)
then BOX
elseif (LISTP BOX)
then (MOVETOP (SETQ BITMAP (CAR (LAST BOX)))
BOX)
[OR (BITMAPP BITMAP)
(CAR (RPLACA BOX (IDLE.BITMAP NIL BITMAP]
else (IDLE.BITMAP BITMAP (if BOX
then (SELECTQ BOX
(FIRSTNAME (MKSTRING FIRSTNAME))
(USERNAME (USERNAME))
(MKSTRING BOX))
else "Interlisp-D"])
)
(RPAQ? IDLE.TIMEOUT 600)
(RPAQ? IDLE.DEFAULTFN (QUOTE IDLE.BOUNCING.BOX))
(RPAQ? IDLE.BITMAP "Interlisp-D")
(RPAQ? IDLE.DEFAULTMODE (QUOTE LOCK))
(RPAQ? \IDLING )
(RPAQ? ALLOWED.LOGINS )
(ADDTOVAR BackgroundMenuCommands (Idle (QUOTE (IDLE))
"Enter Idle mode"
(SUBITEMS ("Set Idler Options" (QUOTE (IDLE.SET.OPTIONS)))
(Lock (QUOTE (IDLE NIL (QUOTE LOCK)))
"Require your password")
(Unlocked (QUOTE (IDLE NIL (QUOTE UNLOCKED)))
"Keep password, don't lock up")
(Forget (QUOTE (IDLE NIL (QUOTE FORGET)))
"Clear password on entering idle mode, require login on exit")
(Authenticate (QUOTE (IDLE NIL (QUOTE AUTHENTICATE)))
"Require login, check with the net"))))
(ADDTOVAR IDLE.FUNCTIONS ("Bouncing box" (QUOTE IDLE.BOUNCING.BOX))
["Bouncing star" (QUOTE (LAMBDA (W)
(IDLE.BOUNCING.BOX W "*" 10])
(ADDTOVAR IDLE.RESETVARS (PUPTRACEFLG NIL)
(XIPTRACEFLG NIL)
(SAVEVMMAX (REALMEMORYSIZE)))
(ADDTOVAR IDLE.SUSPEND.PROCESS.NAMES MOUSE LAFITEMAILWATCH CROCK.PROCESS SPACEWINDOW
REMINDERS.WATCHDOG)
(APPENDTOVAR TTYBACKGROUNDFNS IDLE.OUT)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS IDLE.TIMEOUT IDLE.DEFAULTFN IDLE.BITMAP IDLE.DEFAULTMODE \IDLING IDLE.FUNCTIONS
ALLOWED.LOGINS IDLE.RESETVARS IDLE.SUSPEND.PROCESS.NAMES \LASTUSERACTION)
)
(RPAQQ BackgroundMenu NIL)
(PUTPROPS IDLER COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2037 15017 (IDLE 2047 . 2676) (IDLE.SHOW.OPTIONS 2678 . 3324) (IDLE.SET.OPTIONS 3326 .
4364) (IDLE.AUTHENTICATE 4366 . 8205) (\IDLER 8207 . 12804) (IDLE.OUT 12806 . 13074) (
IDLE.BOUNCING.BOX 13076 . 13905) (IDLE.BITMAP 13907 . 15015)))))
STOP