Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
(FILECREATED " 6-FEB-82 20:19:17" <LISPUSERS>PASSWORDS.;12 7468
changes to: LOGIN
previous date: "30-JAN-82 23:28:41" <LISPUSERS>PASSWORDS.;11)
(* Copyright (c) 1982 by Xerox Corporation)
(PRETTYCOMPRINT PASSWORDSCOMS)
(RPAQQ PASSWORDSCOMS ((FNS GETPASSWORD LOGIN \LOGIN.READ)
[DECLARE: DONTEVAL@LOAD (ADDVARS (BEFORESYSOUTFORMS (CLRHASH LOGINPASSWORDS))
(BEFOREMAKESYSFORMS (CLRHASH LOGINPASSWORDS))
(BEFORELOGOUTFORMS (CLRHASH LOGINPASSWORDS]
(VARS (LOGINPASSWORDS (LIST (HARRAY 8)))
(LOGINTTBL))
(P (MOVD? (QUOTE NILL)
(QUOTE CLBUFS)))
(GLOBALVARS LOGINTTBL LOGINPASSWORDS USERNAME)
(LOCALVARS . T)))
(DEFINEQ
(GETPASSWORD
[LAMBDA (USER ALWAYSASK HOST) (* lmm "30-JAN-82 23:06")
(CDR (LOGIN HOST (COND
(ALWAYSASK T)
(T (QUOTE QUIET)))
(OR USER (USERNAME))
NIL
(QUOTE ALWAYS])
(LOGIN
[LAMBDA (HOST FLG DIRECTORY MSG CNFLG)
(* lmm " 6-FEB-82 20:12")
(* returns (name . password) with which to login (or connect if DIRECTORY given) at HOST, performing an alto-style
login if necessary, or if FLG is ASK. If FLG is NIL, forces login and returns only the name.
MSG is optional message string to print before asking)
(PROG ((INFO (GETHASH HOST LOGINPASSWORDS))
NAME PWD PASSWORDADDR NAME/PASS LOGINNAME)
(COND
([AND (EQ FLG (QUOTE QUIET))
(SETQ NAME/PASS (COND
(DIRECTORY (ASSOC DIRECTORY (CDR INFO)))
(T (CAR INFO]
(* We already have login info)
(RETURN NAME/PASS)))
(COND
[DIRECTORY (SETQ NAME/PASS (\LOGIN.READ HOST DIRECTORY MSG (OR CNFLG T)))
(COND
(NAME/PASS (RPLACD (OR INFO (SETQ INFO (PUTHASH HOST (CONS)
LOGINPASSWORDS)))
(CONS NAME/PASS (CDR INFO]
(T (SETQ LOGINNAME (USERNAME NIL T T))
(SETQ NAME (OR (CAAR INFO)
LOGINNAME))
(SELECTQ (SYSTEMTYPE)
[D (SETQ PASSWORDADDR (EMADDRESS (fetch (IFPAGE UserPswdAddr) of
\InterfacePage)))
(COND
((AND (EQ FLG (QUOTE QUIET))
(IGREATERP (NCHARS (SETQ PWD (GetBcplString PASSWORDADDR)))
0))
(SETQ NAME/PASS (CONS NAME PWD)))
(T (SETQ NAME/PASS (\LOGIN.READ HOST NAME MSG))
(COND
((EQ (CAR NAME/PASS)
LOGINNAME)
(SetBcplString PASSWORDADDR (CDR NAME/PASS)))
([OR (NULL HOST)
(AND (ZEROP (GETBASE PASSWORDADDR 0))
(NEQ (U-CASE (CAR NAME/PASS))
(QUOTE GUEST]
(* There was no password before, or user forced login)
(SETUSERNAME (CAR NAME/PASS))
(SetBcplString PASSWORDADDR (CDR NAME/PASS]
(SETQ NAME/PASS (\LOGIN.READ HOST NAME MSG)))
(FRPLACA (OR INFO (PUTHASH HOST (CONS)
LOGINPASSWORDS))
NAME/PASS)))
(RETURN (COND
(FLG NAME/PASS)
(T (CAR NAME/PASS])
(\LOGIN.READ
[LAMBDA (HOST DEFAULTNAME MSG CONNECTFLG)
(* lmm "30-JAN-82 23:10")
(COND
(MSG (printout T MSG T)))
(RESETBUFS (RESETFORM [SETTERMTABLE (OR (TERMTABLEP LOGINTTBL)
(SETQ LOGINTTBL (PROG [(TT (COPYTERMTABLE (QUOTE ORIG]
(ECHOMODE NIL TT)
(CONTROL T TT)
(SELECTQ
(SYSTEMTYPE)
(D (ECHOCONTROL ERASECHARCODE
(QUOTE REAL)
TT))
NIL)
(RETURN TT]
(PROG ((ERASESTR (SELECTQ (SYSTEMTYPE)
(D (CHARACTER ERASECHARCODE))
NIL))
(NAME DEFAULTNAME)
CHAR CNT)
TOP (COND
((IGREATERP (POSITION T)
0)
(TERPRI T)))
(COND
(HOST (printout T (QUOTE {)
HOST "} ")))
(COND
((EQ CONNECTFLG (QUOTE ALWAYS))
(PRIN1 NAME T)
(GO DONE)))
(printout T (COND
(CONNECTFLG "Connect to ")
(T "Login: "))
NAME)
(* start out displaying existing name as default)
LP
(* * Should the following SELECTC use syntax classes instead of absolute chars? i.e. how much should I mimic the
alto exec?)
(SELECTC (SETQ CHAR (READC T))
((LIST (CHARACTER (CHARCODE SPACE))
(CHARACTER (CHARCODE EOL)))
(* These terminate)
(GO DONE))
[(CHARACTER (CHARCODE ^A))
(* ^A or BS)
[COND
((NOT CNT)
(SETQ CNT (NCHARS (SETQ NAME (CONCAT NAME]
(COND
((ZEROP CNT)
(PRIN1 (CHARACTER 7)
T))
(ERASESTR (PRIN1 ERASESTR T)
(* Back up)
(GLC NAME)
(SETQ CNT (SUB1 CNT)))
(T (PRIN1 "\" T)
(PRIN1 (GLC NAME))
(SETQ CNT (SUB1 CNT]
((LIST (CHARACTER (CHARCODE ^Q))
(CHARACTER (CHARCODE ^W)))
(IF ERASESTR
THEN (FRPTQ (OR CNT (NCHARS NAME))
(PRIN1 ERASESTR T))
ELSE (PRIN1 "_" T))
(* erase name)
(SETQ CNT 0)
(SETQ NAME ""))
((QUOTE ?)
(* Give help)
(PRIN1 (COND
(CONNECTFLG
"
Type <space> followed by the password for the directory
")
(T
"
You are being asked for a user name and password for login.
Type <space> to accept the given user name,
<BS> to back up over it,
or type a new name, followed by <space>.
"))
T)
(GO TOP))
((CHARACTER (CHARCODE ^R))
(GO TOP))
(PROGN (COND
((NOT CNT)
(* First char typed is not space, etc, so assume user is typing new name)
(IF ERASESTR
THEN (FRPTQ (NCHARS NAME)
(PRIN1 ERASESTR T))
ELSE (PRIN1 "_ " T))
(SETQ NAME (CONCAT CHAR))
(SETQ CNT 1))
(T (SETQ NAME (CONCAT NAME CHAR))
(add CNT 1)))
(PRIN1 CHAR T)))
(GO LP)
DONE[COND
(CNT
(* A new/modified name was typed)
(COND
((ZEROP CNT)
(PRIN1 " ??" T)
(GO TOP))
(T (SETQ NAME (MKATOM NAME]
(PRIN1 " (password) " T)
(RETURN (CONS NAME (PROG1 (RSTRING T)
(* Get password as string, echoing off)
(TERPRI T)
(CLEARBUF T])
)
(DECLARE: DONTEVAL@LOAD
(ADDTOVAR BEFORESYSOUTFORMS (CLRHASH LOGINPASSWORDS))
(ADDTOVAR BEFOREMAKESYSFORMS (CLRHASH LOGINPASSWORDS))
(ADDTOVAR BEFORELOGOUTFORMS (CLRHASH LOGINPASSWORDS))
)
(RPAQ LOGINPASSWORDS (LIST (HARRAY 8)))
(RPAQQ LOGINTTBL NIL)
(MOVD? (QUOTE NILL)
(QUOTE CLBUFS))
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS LOGINTTBL LOGINPASSWORDS USERNAME)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS . T)
)
(DECLARE: DONTCOPY (PUTPROPS PASSWORDS COPYRIGHT ("Xerox Corporation" 1982)))
(DECLARE: DONTCOPY
(FILEMAP (NIL (730 6877 (GETPASSWORD 742 . 949) (LOGIN 953 . 3113) (\LOGIN.READ 3117 . 6874)))))
STOP