(FILECREATED "17-NOV-83 14:46:46" {PHYLUM}<LISPCORE>LIBRARY>MAINTAIN.;1 10487
changes to: (FNS \MT.CHANGE.PASSWORD)
previous date: "17-SEP-83 16:11:25" {PHYLUM}<LISP>LIBRARY>MAINTAIN.;2)
(* Copyright (c) 1983 by Xerox Corporation)
(PRETTYCOMPRINT MAINTAINCOMS)
(RPAQQ MAINTAINCOMS ((FNS MAINTAIN \GETMAINTAINCOMMAND)
(FNS \MT.ADD.FRIEND \MT.ADD.MEMBER \MT.CHANGE.PASSWORD \MT.CHANGE.REMARK
\MT.CHANGE.GROUP.COMPONENT \MT.LIST.GROUPS \MT.LOGIN \MT.REMOVE.FRIEND
\MT.REMOVE.MEMBER \MT.TYPE.ENTRY \MT.TYPE.MEMBERS)
(FNS \MT.READRNAME)
(VARS \MT.ELLIPSIS)
(DECLARE: EVAL@COMPILE DONTCOPY (CONSTANTS * GVNAMETYPES)
(MACROS .ELLIPSIS.)
(GLOBALVARS \MT.ELLIPSIS))
(FILES GRAPEVINE)))
(DEFINEQ
(MAINTAIN
[LAMBDA NIL (* bvm: "17-SEP-83 15:52")
(PROG (GVUSERNAME GVPASSWORD GVGROUPS LASTNAME LASTGROUP LASTSTRING CMD)
(DECLARE (SPECVARS GVUSERNAME GVPASSWORD GVGROUPS LASTNAME LASTGROUP LASTSTRING))
(\MT.LOGIN T)
(repeatwhile (NULL (ERSETQ (while (SETQ CMD (\GETMAINTAINCOMMAND)) do (APPLY* CMD])
(\GETMAINTAINCOMMAND
[LAMBDA NIL (* bvm: "17-SEP-83 16:08")
(TERPRI T) (* Unimplemented commands: ("List All Groups" "" RETURN
(FUNCTION \MT.LIST.GROUPS)))
(ASKUSER NIL NIL "GV: " [QUOTE (("Add Friend" "" RETURN (FUNCTION \MT.ADD.FRIEND))
("Add Member" "" RETURN (FUNCTION \MT.ADD.MEMBER))
("Change Password" "" RETURN (FUNCTION \MT.CHANGE.PASSWORD))
("Change Remark" "" RETURN (FUNCTION \MT.CHANGE.REMARK))
("Login" "" RETURN (FUNCTION \MT.LOGIN))
("Quit" " [confirm]" CONFIRMFLG T RETURN NIL)
("Remove Friend" "" RETURN (FUNCTION \MT.REMOVE.FRIEND))
("Remove Member" "" RETURN (FUNCTION \MT.REMOVE.MEMBER))
("Type Entry" "" RETURN (FUNCTION \MT.TYPE.ENTRY))
("Type Members" "" RETURN (FUNCTION \MT.TYPE.MEMBERS))
(% "↑Y - Enter Lisp" NOECHOFLG T RETURN
(FUNCTION (LAMBDA NIL
(TERPRI T)
(USEREXEC (QUOTE ←←]
T NIL (QUOTE (AUTOCOMPLETEFLG T])
)
(DEFINEQ
(\MT.ADD.FRIEND
[LAMBDA NIL (* bvm: "17-SEP-83 14:16")
(\MT.CHANGE.GROUP.COMPONENT (FUNCTION GV.ADDFRIEND)
(QUOTE ADD])
(\MT.ADD.MEMBER
[LAMBDA NIL (* bvm: "17-SEP-83 14:16")
(\MT.CHANGE.GROUP.COMPONENT (FUNCTION GV.ADDMEMBER)
(QUOTE ADD])
(\MT.CHANGE.PASSWORD
[LAMBDA NIL (* bvm: "17-NOV-83 14:45")
(PROG (NAME UPNAME PASS PASSKEY RESULT)
(DECLARE (USEDFREE GVUSERNAME GVPASSWORD LASTNAME LASTSTRING))
(COND
([SETQ NAME (\MT.READRNAME " for individual: " (CONCAT (CAR GVUSERNAME)
"."
(CDR GVUSERNAME]
(COND
([OR [NULL (SETQ PASS (PROMPTFORWORD " to be: " NIL NIL T (QUOTE *]
(NOT (STREQUAL PASS (PROMPTFORWORD " (retype password) " NIL NIL T (QUOTE *]
(printout T " xxx" T))
(T (.ELLIPSIS.)
(COND
((EQ (SETQ RESULT (GV.CHANGEPASSWORD (SETQ UPNAME (\CHECKNAME NAME))
(SETQ PASSKEY (GV.MAKEKEY PASS T))
GVUSERNAME GVPASSWORD))
T)
(printout T " done" T)
(SETQ GVUSERNAME UPNAME)
(SETQ GVPASSWORD PASSKEY)
(SETPASSWORD (QUOTE GV)
(MKATOM (SETQ LASTNAME (SETQ LASTSTRING NAME)))
PASS))
(T (printout T RESULT])
(\MT.CHANGE.REMARK
[LAMBDA NIL (* bvm: "17-SEP-83 15:23")
(PROG (GVNAMETYPE GROUP RESULT NEWREMARK)
(DECLARE (SPECVARS GVNAMETYPE)
(USEDFREE LASTGROUP LASTSTRING GVUSERNAME GVPASSWORD))
(COND
((SETQ GROUP (\MT.READRNAME " for group: " LASTGROUP))
(.ELLIPSIS.)
[COND
((STRINGP (SETQ RESULT (GV.READREMARK GROUP)))
(printout T " to be (type remark, terminate with <cr>)" T)
(COND
([SETQ NEWREMARK (PROMPTFORWORD "Remark: " RESULT NIL T NIL NIL (CHARCODE
(CR]
(.ELLIPSIS.)
(SETQ RESULT (GV.CHANGEREMARK GROUP NEWREMARK GVUSERNAME GVPASSWORD)))
(T (RETURN]
(printout T (COND
((EQ RESULT T)
"done")
(T RESULT))
T)
(SETQ LASTSTRING (SETQ LASTGROUP GROUP])
(\MT.CHANGE.GROUP.COMPONENT
[LAMBDA (GVACCESSFN OPERATION) (* bvm: "16-SEP-83 23:05")
(PROG (GVNAMETYPE GROUP INDIVIDUAL RESULT)
(DECLARE (SPECVARS GVNAMETYPE)
(USEDFREE LASTNAME LASTGROUP LASTSTRING GVUSERNAME GVPASSWORD))
(COND
((AND (SETQ INDIVIDUAL (\MT.READRNAME " name: " LASTNAME))
(SETQ GROUP (\MT.READRNAME (SELECTQ OPERATION
(ADD " to group: ")
(REMOVE " from group: ")
(SHOULDNT))
LASTGROUP)))
(.ELLIPSIS.)
(SETQ RESULT (APPLY* GVACCESSFN GROUP INDIVIDUAL GVUSERNAME GVPASSWORD))
(printout T (COND
((EQ RESULT T)
"done")
(T RESULT))
T)
(SETQ LASTNAME INDIVIDUAL)
(SETQ LASTSTRING (SETQ LASTGROUP GROUP])
(\MT.LIST.GROUPS
[LAMBDA NIL (* bvm: "17-SEP-83 15:52")
(PROG (GVNAMETYPE NAME GROUPS REG FOUNDONE)
(DECLARE (SPECVARS GVNAMETYPE)
(USEDFREE LASTNAME LASTGROUP LASTSTRING GVGROUPS))
(COND
((AND (SETQ REG (PROMPTFORWORD " in registry: " DEFAULTREGISTRY))
(SETQ NAME (\MT.READRNAME " that contain the name: " LASTNAME)))
(printout T " ... enumerating groups")
(COND
((EQ (SETQ GROUPS (GV.READMEMBERS (CONS (QUOTE GROUPS)
(MKATOM REG))
(CAR GVGROUPS)))
(QUOTE NoChange))
(SETQ GROUPS GVGROUPS))
(T (SETQ GVGROUPS GROUPS)))
(printout T " done." T)
(for GROUP in (CDR GROUPS) when (GV.ISMEMBERCLOSURE GROUP NAME)
do (COND
(FOUNDONE (printout T ", "))
(T (SETQ FOUNDONE T)))
(PRIN1 GROUP T))
(SETQ LASTSTRING (SETQ LASTNAME NAME])
(\MT.LOGIN
[LAMBDA (QUIET) (* bvm: "17-SEP-83 14:18")
(DECLARE (USEDFREE GVUSERNAME GVPASSWORD LASTNAME LASTSTRING))
(PROG ((ALWAYSASK (NULL QUIET))
LOGINFO UPNAME PASSKEY EC)
LP (COND
((NOT (SETQ LOGINFO (\INTERNAL/GETPASSWORD (QUOTE GV)
ALWAYSASK)))
(RETURN)))
(SETQ UPNAME (\CHECKNAME (CAR LOGINFO)))
(COND
((EQ [SETQ EC (GV.AUTHENTICATE UPNAME (SETQ PASSKEY (GV.MAKEKEY (CDR LOGINFO]
T)
(printout T T "User " [SETQ LASTSTRING (SETQ LASTNAME (CONCAT (CAR UPNAME)
"."
(CDR UPNAME]
" logged in." T)
(SETQ GVUSERNAME UPNAME)
(SETQ GVPASSWORD PASSKEY))
(T (printout T EC)
(SETQ ALWAYSASK T)
(GO LP)))
(RETURN LASTNAME])
(\MT.REMOVE.FRIEND
[LAMBDA NIL (* bvm: "17-SEP-83 14:18")
(\MT.CHANGE.GROUP.COMPONENT (FUNCTION GV.REMOVEFRIEND)
(QUOTE REMOVE])
(\MT.REMOVE.MEMBER
[LAMBDA NIL (* bvm: "17-SEP-83 14:18")
(\MT.CHANGE.GROUP.COMPONENT (FUNCTION GV.REMOVEMEMBER)
(QUOTE REMOVE])
(\MT.TYPE.ENTRY
[LAMBDA NIL (* bvm: "17-SEP-83 14:16")
(PROG (GVNAMETYPE NAME INFO)
(DECLARE (SPECVARS GVNAMETYPE)
(USEDFREE LASTNAME LASTGROUP LASTSTRING))
(COND
((SETQ NAME (\MT.READRNAME " for R-Name: " LASTSTRING))
(.ELLIPSIS.)
(SETQ INFO (GV.EXPAND NAME))
(SELECTC GVNAMETYPE
(\NAMETYPE.GROUP (printout T T "Group; number of members: " .P2
(LENGTH (CDR INFO))
T "Remark: " (GV.READREMARK NAME)
T "Owners: ")
(MAPRINT (CDR (GV.READOWNERS NAME))
T NIL NIL ", ")
(printout T T "Friends: ")
(MAPRINT (CDR (GV.READFRIENDS NAME))
T NIL NIL ", ")
(TERPRI T)
(SETQ LASTGROUP NAME))
(\NAMETYPE.INDIVIDUAL (printout T T "Individual; Mailbox sites: ")
(MAPRINT (CDR INFO)
T NIL NIL ", ")
(TERPRI T)
(SETQ LASTNAME NAME))
(printout T T "Name not found" T))
(SETQ LASTSTRING NAME])
(\MT.TYPE.MEMBERS
[LAMBDA NIL (* bvm: "17-SEP-83 14:15")
(PROG (GVNAMETYPE NAME INFO)
(DECLARE (SPECVARS GVNAMETYPE)
(USEDFREE LASTNAME LASTGROUP LASTSTRING))
(COND
((SETQ NAME (\MT.READRNAME " of group: " LASTGROUP))
(.ELLIPSIS.)
(SETQ INFO (GV.READMEMBERS NAME))
(SELECTC GVNAMETYPE
(\NAMETYPE.GROUP (TERPRI T)
(MAPRINT (CDR INFO)
T NIL NIL ", ")
(TERPRI T)
(SETQ LASTGROUP NAME))
(\NAMETYPE.INDIVIDUAL (printout T T "Can't: " NAME " is an individual" T)
(SETQ LASTNAME NAME))
(printout T T "Name not found" T))
(SETQ LASTSTRING NAME])
)
(DEFINEQ
(\MT.READRNAME
[LAMBDA (PROMPT DEFAULT) (* bvm: "16-SEP-83 22:36")
(PROG ((NAME (PROMPTFORWORD PROMPT DEFAULT NIL T)))
[COND
((NULL NAME)
(printout T " xxx" T)
(RETURN))
((NOT (STRPOS "." NAME))
(printout T "." DEFAULTREGISTRY)
(SETQ NAME (CONCAT NAME "." DEFAULTREGISTRY]
(RETURN NAME])
)
(RPAQQ \MT.ELLIPSIS " ... ")
(DECLARE: EVAL@COMPILE DONTCOPY
(RPAQQ GVNAMETYPES ((\NAMETYPE.GROUP 0)
(\NAMETYPE.INDIVIDUAL 1)
(\NAMETYPE.NOTFOUND 2)
(\NAMETYPE.DEAD 3)))
(DECLARE: EVAL@COMPILE
(RPAQQ \NAMETYPE.GROUP 0)
(RPAQQ \NAMETYPE.INDIVIDUAL 1)
(RPAQQ \NAMETYPE.NOTFOUND 2)
(RPAQQ \NAMETYPE.DEAD 3)
(CONSTANTS (\NAMETYPE.GROUP 0)
(\NAMETYPE.INDIVIDUAL 1)
(\NAMETYPE.NOTFOUND 2)
(\NAMETYPE.DEAD 3))
)
(DECLARE: EVAL@COMPILE
(PUTPROPS .ELLIPSIS. MACRO (NIL (printout T \MT.ELLIPSIS)))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \MT.ELLIPSIS)
)
)
(FILESLOAD GRAPEVINE)
(PUTPROPS MAINTAIN COPYRIGHT ("Xerox Corporation" 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (773 2300 (MAINTAIN 783 . 1199) (\GETMAINTAINCOMMAND 1201 . 2298)) (2301 9333 (
\MT.ADD.FRIEND 2311 . 2499) (\MT.ADD.MEMBER 2501 . 2689) (\MT.CHANGE.PASSWORD 2691 . 3700) (
\MT.CHANGE.REMARK 3702 . 4556) (\MT.CHANGE.GROUP.COMPONENT 4558 . 5365) (\MT.LIST.GROUPS 5367 . 6312)
(\MT.LOGIN 6314 . 7150) (\MT.REMOVE.FRIEND 7152 . 7349) (\MT.REMOVE.MEMBER 7351 . 7548) (
\MT.TYPE.ENTRY 7550 . 8598) (\MT.TYPE.MEMBERS 8600 . 9331)) (9334 9747 (\MT.READRNAME 9344 . 9745))))
)
STOP