(FILECREATED " 3-NOV-83 22:53:20" {PHYLUM}<LISPCORE>LIBRARY>GRAPEVINE.;1 38359
changes to: (FNS GV.MAKEKEY)
previous date: "17-SEP-83 16:09:43" {PHYLUM}<LISP>LIBRARY>GRAPEVINE.;1)
(* Copyright (c) 1983 by Xerox Corporation)
(PRETTYCOMPRINT GRAPEVINECOMS)
(RPAQQ GRAPEVINECOMS [(COMS (* High Level Grapevine User Operations as per section 4.1 of the
Grapevine Interface document)
(* Functions for interrogating the database)
(FNS GV.AUTHENTICATE GV.CHECKSTAMP GV.EXPAND GV.IDENTIFYCALLER
GV.IDENTIFYME GV.ISINLIST GV.ISMEMBERCLOSURE GV.ISMEMBERDIRECT
GV.READCONNECT GV.READENTRY GV.READFRIENDS GV.READMEMBERS
GV.READOWNERS GV.READREMARK)
(* Functions which update the database)
(FNS GV.ADDFORWARD GV.ADDFRIEND GV.ADDLISTOFMEMBERS GV.ADDMAILBOX
GV.ADDMEMBER GV.ADDOWNER GV.CHANGECONNECT GV.CHANGEPASSWORD
GV.CHANGEREMARK GV.CREATEGROUP GV.CREATEINDIVIDUAL GV.DELETEGROUP
GV.DELETEINDIVIDUAL GV.NEWNAME GV.REMOVEFORWARD GV.REMOVEFRIEND
GV.REMOVEMAILBOX GV.REMOVEMEMBER GV.REMOVEOWNER)
(FNS GV.MAKEKEY)
(DECLARE: DOEVAL@COMPILE DONTCOPY (MACROS KEYP CREATEKEY GETKEYBYTE
SETKEYBYTE)
(* Constants for calling GV.ISINLIST)
(CONSTANTS * \GVU.MEMBEROPS)))
[COMS (* Contacting Reg Servers)
(FNS \GVOP \ENQUIRE \PERFORMGVOP FINDREGSERVER LOCATESOCKETS)
(ADDVARS (\GVCONNECTIONS))
(VARS (REGROOT (QUOTE (GV . GV)))
(REGROOTNLSNAME "GrapevineRServer")
(\REG.IOTIMEOUT 30000))
(DECLARE: DOEVAL@COMPILE DONTCOPY (* Grapevine User Protocol Op Codes)
(CONSTANTS * \GV.OPS)
(* Grapevine response codes)
(CONSTANTS * \GV.RESPONSES)
(* Response codes the user sees)
(CONSTANTS * \GVU.RESPONSES)
(GLOBALVARS REGROOT REGROOTNLSNAME \REG.IOTIMEOUT \GVCONNECTIONS)
(CONSTANTS (\REG.SERVERENQUIRYSOC 40)
(\REG.SERVERPOLLINGSOC 42]
[COMS (* Functions for trying to make connection to closest by hopcount and responsiveness)
(FNS OPENCLOSESTSOCKET \OPENGVCONNECTION \GV.WHENCLOSED)
(DECLARE: DOEVAL@COMPILE DONTCOPY (RECORDS GVCONNECTION)
(CONSTANTS (\DEFAULTPOLLINGSOC 5))
(GLOBALVARS \BETWEENPROBEDELAY \CONNECTTIMEOUT \EchosFrom \TIMEOUTKEY))
(VARS (\BETWEENPROBEDELAY 100)
(\CONNECTTIMEOUT 5000))
(DECLARE: DONTEVAL@LOAD DOCOPY (P (COND ((NOT (GETD (QUOTE SORT.PUPHOSTS.BY.DISTANCE)))
(FILESLOAD ROUTER)
(/MOVD (QUOTE HOPORDER)
(QUOTE SORT.PUPHOSTS.BY.DISTANCE]
(COMS (* These functions check and/or coerce arguments to server operations)
(FNS \CHECKKEY \CHECKNAME \CHECKSTAMP \CHECKSTRING \NONAMEERR \UNPACKREG)
(INITVARS (DEFAULTREGISTRY))
(DECLARE: DOEVAL@COMPILE DONTCOPY (GLOBALVARS DEFAULTREGISTRY)
(RECORDS TIMESTAMP))
(INITRECORDS TIMESTAMP))
(COMS (* Lower-level Grapevine User primitives)
(FNS \SENDITEM \SENDSTRING \SENDWORD)
(FNS \RECEIVEBOOL \RECEIVECLIST \RECEIVECOMPONENT \RECEIVERLIST \RECEIVERNAME
\RECEIVESTAMP \RECEIVESTRING \RECEIVEWORD)
(VARS (\3BYTEKLUDGEKEY (QUOTE $$3byte$$)))
(DECLARE: DOEVAL@COMPILE DONTCOPY (MACROS \RECEIVEWORD \SENDWORD)
(CONSTANTS (\GV.SSLENGTH 64)
(\MAXGVSTRING 64))
(GLOBALVARS \3BYTEKLUDGEKEY)))
(DECLARE: DONTEVAL@LOAD EVAL@COMPILE DONTCOPY (P (SELECTQ (COMPILEMODE)
(D (FILESLOAD (LOADCOMP)
PUP BSP))
(PDP-10 (FILESLOAD (LOADCOMP)
PUP10 BSPAUX))
NIL])
(* High Level Grapevine User Operations as per section 4.1 of the Grapevine Interface document)
(* Functions for interrogating the database)
(DEFINEQ
(GV.AUTHENTICATE
[LAMBDA (NAME KEY) (* ht: "14-JAN-82 10:24")
(\GVOP \OP.AUTHENTICATE (\CHECKNAME NAME)
(LIST (\CHECKKEY KEY])
(GV.CHECKSTAMP
[LAMBDA (NAME OLDSTAMP) (* ht: "22-JAN-82 10:07")
(\GVOP \OP.CHECKSTAMP (\CHECKNAME NAME)
(LIST (\CHECKSTAMP OLDSTAMP))
(FUNCTION \RECEIVESTAMP])
(GV.EXPAND
[LAMBDA (NAME OLDSTAMP) (* M.Yonke "10-AUG-83 11:10")
(* Does the database Expand operation -
named to avoid conflict with the mail server version
(MSExpand))
(\GVOP \OP.GVEXPAND (\CHECKNAME NAME)
(LIST (\CHECKSTAMP OLDSTAMP))
(FUNCTION \RECEIVERLIST])
(GV.IDENTIFYCALLER
[LAMBDA (NAME KEY) (* ht: "14-JAN-82 10:27")
(\GVOP \OP.IDENTIFYCALLER (\CHECKNAME NAME)
(LIST (\CHECKKEY KEY])
(GV.IDENTIFYME
[LAMBDA NIL (* bvm: "17-SEP-83 14:14")
(* Calls GV.IDENTIFYCALLER with info provided by LOGIN)
(PROG ((npw (\INTERNAL/GETPASSWORD NIL)))
(RETURN (GV.IDENTIFYCALLER (CAR npw)
(CDR npw])
(GV.ISINLIST
[LAMBDA (NAME STRING WHAT WHICH WHERE) (* ht: "22-JAN-82 09:48")
(\GVOP \OP.ISINLIST (\CHECKNAME NAME)
(LIST (\CHECKSTRING STRING)
(LIST \3BYTEKLUDGEKEY (OR WHAT OP.ITSELF)
(OR WHICH OP.MEMBERS)
(OR WHERE OP.DIRECT)))
(FUNCTION \RECEIVEBOOL])
(GV.ISMEMBERCLOSURE
[LAMBDA (NAME STRING) (* bvm: "17-SEP-83 15:42")
(\GVOP \OP.ISMEMBERCLOSURE (\CHECKNAME NAME)
(LIST (\CHECKSTRING STRING))
(FUNCTION \RECEIVEBOOL])
(GV.ISMEMBERDIRECT
[LAMBDA (NAME STRING) (* bvm: "17-SEP-83 15:43")
(\GVOP \OP.ISMEMBERDIRECT (\CHECKNAME NAME)
(LIST (\CHECKSTRING STRING))
(FUNCTION \RECEIVEBOOL])
(GV.READCONNECT
[LAMBDA (NAME) (* ht: "14-JAN-82 10:20")
(\GVOP \OP.READCONNECT (\CHECKNAME NAME)
NIL
(FUNCTION \RECEIVERNAME])
(GV.READENTRY
[LAMBDA (NAME OLDSTAMP) (* ht: "22-JAN-82 10:07")
(\GVOP \OP.READENTRY (\CHECKNAME NAME)
(LIST (\CHECKSTAMP OLDSTAMP))
(FUNCTION \RECEIVECLIST])
(GV.READFRIENDS
[LAMBDA (NAME OLDSTAMP) (* lmm "20-JAN-83 00:07")
(\GVOP \OP.READFRIENDS (\CHECKNAME NAME)
(LIST (\CHECKSTAMP OLDSTAMP))
(FUNCTION \RECEIVERLIST])
(GV.READMEMBERS
[LAMBDA (NAME OLDSTAMP) (* ht: "22-JAN-82 10:07")
(\GVOP \OP.READMEMBERS (\CHECKNAME NAME)
(LIST (\CHECKSTAMP OLDSTAMP))
(FUNCTION \RECEIVERLIST])
(GV.READOWNERS
[LAMBDA (NAME OLDSTAMP) (* ht: "22-JAN-82 10:07")
(\GVOP \OP.READOWNERS (\CHECKNAME NAME)
(LIST (\CHECKSTAMP OLDSTAMP))
(FUNCTION \RECEIVERLIST])
(GV.READREMARK
[LAMBDA (NAME) (* ht: "14-JAN-82 10:21")
(\GVOP \OP.READREMARK (\CHECKNAME NAME)
NIL
(FUNCTION \RECEIVERNAME])
)
(* Functions which update the database)
(DEFINEQ
(GV.ADDFORWARD
[LAMBDA (NAME STRING IDENTIFYUSER PASSWORD) (* bvm: "16-SEP-83 18:28")
(\GVOP \OP.ADDFORWARD (\CHECKNAME NAME)
(LIST (\CHECKSTRING STRING))
NIL
(OR IDENTIFYUSER T)
PASSWORD])
(GV.ADDFRIEND
[LAMBDA (NAME STRING IDENTIFYUSER PASSWORD) (* bvm: "16-SEP-83 18:19")
(\GVOP \OP.ADDFRIEND (\CHECKNAME NAME)
(LIST (\CHECKSTRING STRING))
NIL
(OR IDENTIFYUSER T)
PASSWORD])
(GV.ADDLISTOFMEMBERS
[LAMBDA (NAME STRINGLIST IDENTIFYUSER PASSWORD) (* bvm: "16-SEP-83 18:28")
(\GVOP \OP.ADDLISTOFMEMBERS (\CHECKNAME NAME)
[LIST (COND
([AND (LISTP STRINGLIST)
(OR (STRINGP (CAR STRINGLIST))
(LITATOM (CAR STRINGLIST)))
(for p on STRINGLIST when (CDR p) always (AND (OR (STRINGP (CADR p))
(LITATOM (CADR p)))
(ALPHORDER (CAR p)
(CADR p]
STRINGLIST)
(T (ERROR "must have ordered list of strings" STRINGLIST]
NIL
(OR IDENTIFYUSER T)
PASSWORD])
(GV.ADDMAILBOX
[LAMBDA (NAME STRING IDENTIFYUSER PASSWORD) (* bvm: "16-SEP-83 18:20")
(\GVOP \OP.ADDMAILBOX (\CHECKNAME NAME)
(LIST (\CHECKSTRING STRING))
NIL
(OR IDENTIFYUSER T)
PASSWORD])
(GV.ADDMEMBER
[LAMBDA (NAME STRING IDENTIFYUSER PASSWORD) (* bvm: "16-SEP-83 18:20")
(\GVOP \OP.ADDMEMBER (\CHECKNAME NAME)
(LIST (\CHECKSTRING STRING))
NIL
(OR IDENTIFYUSER T)
PASSWORD])
(GV.ADDOWNER
[LAMBDA (NAME STRING IDENTIFYUSER PASSWORD) (* bvm: "16-SEP-83 18:21")
(\GVOP \OP.ADDOWNER (\CHECKNAME NAME)
(LIST (\CHECKSTRING STRING))
NIL
(OR IDENTIFYUSER T)
PASSWORD])
(GV.CHANGECONNECT
[LAMBDA (NAME SITE IDENTIFYUSER PASSWORD) (* bvm: "16-SEP-83 18:27")
(\GVOP \OP.CHANGECONNECT (\CHECKNAME NAME)
[LIST (OR (STRINGP SITE)
(AND (LITATOM SITE)
SITE)
(COND
((AND [OR (LISTP SITE)
(NUMBERP SITE)
(AND (NOT SITE)
(SETQ SITE (\LOCALPUPADDRESS]
(PORTSTRING SITE)))
(T (ERROR "Invalid Site" SITE]
NIL IDENTIFYUSER PASSWORD])
(GV.CHANGEPASSWORD
[LAMBDA (NAME KEY IDENTIFYUSER PASSWORD) (* bvm: "16-SEP-83 18:21")
(\GVOP \OP.CHANGEPASSWORD (\CHECKNAME NAME)
(LIST (\CHECKKEY KEY))
NIL
(OR IDENTIFYUSER T)
PASSWORD])
(GV.CHANGEREMARK
[LAMBDA (NAME STRING IDENTIFYUSER PASSWORD) (* bvm: "16-SEP-83 18:22")
(\GVOP \OP.CHANGEREMARK (\CHECKNAME NAME)
(LIST (\CHECKSTRING STRING))
NIL
(OR IDENTIFYUSER T)
PASSWORD])
(GV.CREATEGROUP
[LAMBDA (NAME IDENTIFYUSER PASSWORD) (* bvm: "16-SEP-83 18:22")
(\GVOP \OP.CREATEGROUP (\CHECKNAME NAME)
NIL NIL (OR IDENTIFYUSER T)
PASSWORD])
(GV.CREATEINDIVIDUAL
[LAMBDA (NAME KEY IDENTIFYUSER PASSWORD) (* bvm: "16-SEP-83 18:23")
(\GVOP \OP.CREATEINDIVIDUAL (\CHECKNAME NAME)
(LIST (\CHECKKEY KEY))
NIL
(OR IDENTIFYUSER T)
PASSWORD])
(GV.DELETEGROUP
[LAMBDA (NAME IDENTIFYUSER PASSWORD) (* bvm: "16-SEP-83 18:23")
(\GVOP \OP.DELETEGROUP (\CHECKNAME NAME)
NIL NIL (OR IDENTIFYUSER T)
PASSWORD])
(GV.DELETEINDIVIDUAL
[LAMBDA (NAME IDENTIFYUSER PASSWORD) (* bvm: "16-SEP-83 18:23")
(\GVOP \OP.DELETEINDIVIDUAL (\CHECKNAME NAME)
NIL NIL (OR IDENTIFYUSER T)
PASSWORD])
(GV.NEWNAME
[LAMBDA (NAME GV.NEWNAME IDENTIFYUSER PASSWORD) (* bvm: "16-SEP-83 18:24")
(\GVOP \OP.NEWNAME (\CHECKNAME NAME)
(LIST (\CHECKNAME GV.NEWNAME))
NIL
(OR IDENTIFYUSER T)
PASSWORD])
(GV.REMOVEFORWARD
[LAMBDA (NAME STRING IDENTIFYUSER PASSWORD) (* bvm: "16-SEP-83 18:24")
(\GVOP \OP.REMOVEFORWARD (\CHECKNAME NAME)
(LIST (\CHECKSTRING STRING))
NIL
(OR IDENTIFYUSER T)
PASSWORD])
(GV.REMOVEFRIEND
[LAMBDA (NAME STRING IDENTIFYUSER PASSWORD) (* bvm: "16-SEP-83 18:25")
(\GVOP \OP.REMOVEFRIEND (\CHECKNAME NAME)
(LIST (\CHECKSTRING STRING))
NIL
(OR IDENTIFYUSER T)
PASSWORD])
(GV.REMOVEMAILBOX
[LAMBDA (NAME STRING IDENTIFYUSER PASSWORD) (* bvm: "16-SEP-83 18:25")
(\GVOP \OP.REMOVEMAILBOX (\CHECKNAME NAME)
(LIST (\CHECKSTRING STRING))
NIL
(OR IDENTIFYUSER T)
PASSWORD])
(GV.REMOVEMEMBER
[LAMBDA (NAME STRING IDENTIFYUSER PASSWORD) (* bvm: "16-SEP-83 18:25")
(\GVOP \OP.REMOVEMEMBER (\CHECKNAME NAME)
(LIST (\CHECKSTRING STRING))
NIL
(OR IDENTIFYUSER T)
PASSWORD])
(GV.REMOVEOWNER
[LAMBDA (NAME STRING IDENTIFYUSER PASSWORD) (* bvm: "16-SEP-83 18:26")
(\GVOP \OP.REMOVEOWNER (\CHECKNAME NAME)
(LIST (\CHECKSTRING STRING))
NIL
(OR IDENTIFYUSER T)
PASSWORD])
)
(DEFINEQ
(GV.MAKEKEY
[LAMBDA (STRING ISCLEAR) (* bvm: " 3-NOV-83 22:17")
(* As per section 2 of the Grapevine Interface document)
(bind J C (R ←(CREATEKEY)) for I from 0 while (SETQ C (NTHCHARCODE STRING (ADD1 I)))
do (SETKEYBYTE R (SETQ J (IMOD I 8))
(LOGXOR (GETKEYBYTE R J)
(LOGAND (LLSH (PROGN (OR ISCLEAR (SETQ C (\DECRYPT.PWD.CHAR C)))
(COND
((AND (IGEQ C (CHARCODE A))
(ILEQ C (CHARCODE Z)))
(IPLUS (IDIFFERENCE C (CHARCODE A))
(CHARCODE a)))
(T C)))
1)
255)))
finally (RETURN R])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS KEYP MACRO ((X)
(ARRAYP X)))
(PUTPROPS CREATEKEY MACRO (NIL (ARRAY 8 (QUOTE (BITS 8))
0 1)))
(PUTPROPS CREATEKEY DMACRO (NIL (ARRAY 8 (QUOTE (BITS 8))
0 0)))
(PUTPROPS GETKEYBYTE MACRO ((KEY N)
(ELT KEY (ADD1 N))))
(PUTPROPS GETKEYBYTE DMACRO ((KEY N)
(ELT KEY N)))
(PUTPROPS SETKEYBYTE MACRO ((KEY N BYTE)
(SETA KEY (ADD1 N)
BYTE)))
(PUTPROPS SETKEYBYTE DMACRO ((KEY N BYTE)
(SETA KEY N BYTE)))
)
(* Constants for calling GV.ISINLIST)
(RPAQQ \GVU.MEMBEROPS ((OP.ITSELF 0)
(OP.ITSREGISTRY 1)
(OP.MEMBERS 0)
(OP.OWNERS 1)
(OP.FRIENDS 2)
(OP.DIRECT 0)
(OP.CLOSURE 1)
(OP.UPARROW 2)))
(DECLARE: EVAL@COMPILE
(RPAQQ OP.ITSELF 0)
(RPAQQ OP.ITSREGISTRY 1)
(RPAQQ OP.MEMBERS 0)
(RPAQQ OP.OWNERS 1)
(RPAQQ OP.FRIENDS 2)
(RPAQQ OP.DIRECT 0)
(RPAQQ OP.CLOSURE 1)
(RPAQQ OP.UPARROW 2)
(CONSTANTS (OP.ITSELF 0)
(OP.ITSREGISTRY 1)
(OP.MEMBERS 0)
(OP.OWNERS 1)
(OP.FRIENDS 2)
(OP.DIRECT 0)
(OP.CLOSURE 1)
(OP.UPARROW 2))
)
)
(* Contacting Reg Servers)
(DEFINEQ
(\GVOP
[LAMBDA (OP name itemList READFN IDENTIFYUSER PASSWORD) (* bvm: "16-SEP-83 18:30")
(* Supervises a registration database operation. Does the initial interaction, applies READFN to the input side of
the connection to collect results, and interprets same if necessary)
(PROG (RC)
(RETURN (SELECTC (SETQ RC (\ENQUIRE name (CONS OP (CONS name itemList))
READFN IDENTIFYUSER PASSWORD))
(COND
((NUMBERP RC)
(SELECTC RC
(\RC.BADRNAME EC.BADRNAME)
(\RC.NOCHANGE EC.NOCHANGE)
(\RC.NOTALLOWED EC.NOTALLOWED)
(\RC.BADPASSWORD EC.BADPASSWORD)
(\RC.ALLDOWN EC.ALLDOWN)
(SHOULDNT)))
(T RC])
(\ENQUIRE
[LAMBDA (NAME ARGS READFN IDENTIFYUSER PASSWORD) (* bvm: "16-SEP-83 22:17")
(* Attempt to accomplish some interaction with a reg. server. Implements the Taft/Birrell approach of first trying
anybody we're connected to, failing that trying the closest reg. server we can find, and only if that fails as
well do we get down to basics and actually go thru the lookup procedure to find someone who knows what we need)
(PROG ((REGISTRY REGROOT)
RESULT CONN INFO)
LP (COND
((NOT (SETQ CONN (FINDREGSERVER REGISTRY)))
(RETURN EC.ALLDOWN)))
[COND
(IDENTIFYUSER [COND
((EQ IDENTIFYUSER T)
(SETQ INFO (\INTERNAL/GETPASSWORD))
(SETQ IDENTIFYUSER (CAR INFO]
(COND
((AND (NEQ (fetch GVIDENTIFIED of CONN)
IDENTIFYUSER)
(NOT (EQUAL (fetch GVIDENTIFIED of CONN)
IDENTIFYUSER)))
(COND
([NOT (SETQ RESULT (\PERFORMGVOP CONN
(LIST \OP.IDENTIFYCALLER
(\CHECKNAME IDENTIFYUSER)
(\CHECKKEY
(OR PASSWORD (CDR INFO]
(replace GVBUSY of CONN with NIL)
(GO LP))
((SETQ RESULT (SELECTC (fetch HIBYTE of RESULT)
(\RC.BADRNAME EC.BADRNAME)
(\RC.BADPASSWORD EC.BADPASSWORD)
(\RC.ALLDOWN EC.ALLDOWN)
(\RC.DONE NIL)
(SHOULDNT)))
(RETURN RESULT))
(T (replace GVIDENTIFIED of CONN with IDENTIFYUSER]
(SELECTC (COND
((SETQ RESULT (\PERFORMGVOP CONN ARGS))
(* we ignore the name type and return the code part of
the return code)
(SETQ GVNAMETYPE (fetch LOBYTE of RESULT))
(SETQ RESULT (fetch HIBYTE of RESULT)))
(T
(* The usual causes for this are the stream is not in fact open despite our efforts to insure that it is, or that
the other end has gone to sleep and the BSPIOTIMEOUT occurs. If this happens too often, \REG.IOTIMEOUT should be
lengthened)
(replace GVBUSY of CONN with NIL)
(GO LP)))
(\RC.NOCHANGE (* For use with timestamps, says entry has not changed,
so no values to return))
[\RC.DONE (SETQ RESULT (COND
(READFN (APPLY* READFN (fetch GVINSTREAM of CONN)))
(T T]
[\RC.WRONGSERVER (* so we have to do it right after all)
(COND
((NEQ REGISTRY REGROOT)
(SETQ RESULT \RC.BADRNAME))
(T (replace GVBUSY of CONN with NIL)
(SETQ REGISTRY (CONS (CDR NAME)
(QUOTE GV)))
(GO LP]
NIL)
(replace GVBUSY of CONN with NIL)
(RETURN RESULT])
(\PERFORMGVOP
[LAMBDA (CONN ARGS) (* bvm: "16-SEP-83 17:37")
(CAR (ERSETQ (PROG ((STREAM (fetch GVOUTSTREAM of CONN)))
(for e in ARGS do (\SENDITEM STREAM e))
(BSPFORCEOUTPUT STREAM)
(RETURN (\RECEIVEWORD (fetch GVINSTREAM of CONN])
(FINDREGSERVER
[LAMBDA (REGISTRY ERRORFLG) (* bvm: "16-SEP-83 15:49")
(* Find a registration server for REGISTRY -
the closest one available)
(PROG (NEWSOC)
[COND
((NLISTP REGISTRY)
(SETQ REGISTRY (\UNPACKREG REGISTRY]
(RETURN (COND
[(UNINTERRUPTABLY
(for CONN in \GVCONNECTIONS
when [AND (NULL (fetch GVBUSY of CONN))
(OR (EQ REGISTRY REGROOT)
(EQUAL REGISTRY (fetch GVREGISTRY of CONN]
do (replace GVBUSY of CONN with T)
(RETURN CONN)))]
((SETQ NEWSOC (OPENCLOSESTSOCKET (LOCATESOCKETS REGISTRY ERRORFLG)
\REG.SERVERPOLLINGSOC \REG.SERVERENQUIRYSOC
\REG.IOTIMEOUT))
(replace GVREGISTRY of NEWSOC with REGISTRY)
(replace GVBUSY of NEWSOC with T)
(push \GVCONNECTIONS NEWSOC)
NEWSOC)
(ERRORFLG (ERROR "Couldn't open connection for" REGISTRY])
(LOCATESOCKETS
[LAMBDA (SITE ERRORFLG) (* bvm: "17-SEP-83 14:15")
(* get a list of sockets for a SITE -
a three step process (except for GV.GV) -
find the members of the site, find the connect sites for each, turn those into sockets)
(COND
((EQUAL SITE REGROOT) (* treat the root -
"GV.GV" -
specially)
(ETHERPORT REGROOTNLSNAME ERRORFLG T))
(T (bind cn for rName in [CDR (OR (LISTP (GV.READMEMBERS SITE))
(COND
(ERRORFLG (ERROR "Not a valid site" SITE]
join (OR (AND (SETQ cn (STRINGP (GV.READCONNECT rName)))
(ETHERPORT cn NIL T))
(ETHERPORT rName NIL T)
(COND
(ERRORFLG (HELP "Can't look up connect name" (CONS rName cn])
)
(ADDTOVAR \GVCONNECTIONS )
(RPAQQ REGROOT (GV . GV))
(RPAQ REGROOTNLSNAME "GrapevineRServer")
(RPAQQ \REG.IOTIMEOUT 30000)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(* Grapevine User Protocol Op Codes)
(RPAQQ \GV.OPS ((\OP.GVEXPAND 1)
(\OP.READMEMBERS 2)
(\OP.READOWNERS 3)
(\OP.READFRIENDS 4)
(\OP.READENTRY 5)
(\OP.CHECKSTAMP 6)
(\OP.READCONNECT 7)
(\OP.READREMARK 8)
(\OP.AUTHENTICATE 9)
(\OP.IDENTIFYCALLER 33)
(\OP.ISMEMBERDIRECT 40)
(\OP.ISOWNERDIRECT 41)
(\OP.ISFRIENDDIRECT 42)
(\OP.ISMEMBERCLOSURE 43)
(\OP.ISOWNERCLOSURE 44)
(\OP.ISFRIENDCLOSURE 45)
(\OP.ISINLIST 46)
(\OP.CREATEINDIVIDUAL 12)
(\OP.DELETEINDIVIDUAL 13)
(\OP.CREATEGROUP 14)
(\OP.DELETEGROUP 15)
(\OP.CHANGEPASSWORD 16)
(\OP.CHANGECONNECT 17)
(\OP.CHANGEREMARK 18)
(\OP.ADDMEMBER 19)
(\OP.ADDMAILBOX 20)
(\OP.ADDFORWARD 21)
(\OP.ADDOWNER 22)
(\OP.ADDFRIEND 23)
(\OP.REMOVEMEMBER 24)
(\OP.REMOVEMAILBOX 25)
(\OP.REMOVEFORWARD 26)
(\OP.REMOVEOWNER 27)
(\OP.REMOVEFRIEND 28)
(\OP.ADDSELF 29)
(\OP.REMOVESELF 30)
(\OP.ADDLISTOFMEMBERS 31)
(\OP.NEWNAME 32)))
(DECLARE: EVAL@COMPILE
(RPAQQ \OP.GVEXPAND 1)
(RPAQQ \OP.READMEMBERS 2)
(RPAQQ \OP.READOWNERS 3)
(RPAQQ \OP.READFRIENDS 4)
(RPAQQ \OP.READENTRY 5)
(RPAQQ \OP.CHECKSTAMP 6)
(RPAQQ \OP.READCONNECT 7)
(RPAQQ \OP.READREMARK 8)
(RPAQQ \OP.AUTHENTICATE 9)
(RPAQQ \OP.IDENTIFYCALLER 33)
(RPAQQ \OP.ISMEMBERDIRECT 40)
(RPAQQ \OP.ISOWNERDIRECT 41)
(RPAQQ \OP.ISFRIENDDIRECT 42)
(RPAQQ \OP.ISMEMBERCLOSURE 43)
(RPAQQ \OP.ISOWNERCLOSURE 44)
(RPAQQ \OP.ISFRIENDCLOSURE 45)
(RPAQQ \OP.ISINLIST 46)
(RPAQQ \OP.CREATEINDIVIDUAL 12)
(RPAQQ \OP.DELETEINDIVIDUAL 13)
(RPAQQ \OP.CREATEGROUP 14)
(RPAQQ \OP.DELETEGROUP 15)
(RPAQQ \OP.CHANGEPASSWORD 16)
(RPAQQ \OP.CHANGECONNECT 17)
(RPAQQ \OP.CHANGEREMARK 18)
(RPAQQ \OP.ADDMEMBER 19)
(RPAQQ \OP.ADDMAILBOX 20)
(RPAQQ \OP.ADDFORWARD 21)
(RPAQQ \OP.ADDOWNER 22)
(RPAQQ \OP.ADDFRIEND 23)
(RPAQQ \OP.REMOVEMEMBER 24)
(RPAQQ \OP.REMOVEMAILBOX 25)
(RPAQQ \OP.REMOVEFORWARD 26)
(RPAQQ \OP.REMOVEOWNER 27)
(RPAQQ \OP.REMOVEFRIEND 28)
(RPAQQ \OP.ADDSELF 29)
(RPAQQ \OP.REMOVESELF 30)
(RPAQQ \OP.ADDLISTOFMEMBERS 31)
(RPAQQ \OP.NEWNAME 32)
(CONSTANTS (\OP.GVEXPAND 1)
(\OP.READMEMBERS 2)
(\OP.READOWNERS 3)
(\OP.READFRIENDS 4)
(\OP.READENTRY 5)
(\OP.CHECKSTAMP 6)
(\OP.READCONNECT 7)
(\OP.READREMARK 8)
(\OP.AUTHENTICATE 9)
(\OP.IDENTIFYCALLER 33)
(\OP.ISMEMBERDIRECT 40)
(\OP.ISOWNERDIRECT 41)
(\OP.ISFRIENDDIRECT 42)
(\OP.ISMEMBERCLOSURE 43)
(\OP.ISOWNERCLOSURE 44)
(\OP.ISFRIENDCLOSURE 45)
(\OP.ISINLIST 46)
(\OP.CREATEINDIVIDUAL 12)
(\OP.DELETEINDIVIDUAL 13)
(\OP.CREATEGROUP 14)
(\OP.DELETEGROUP 15)
(\OP.CHANGEPASSWORD 16)
(\OP.CHANGECONNECT 17)
(\OP.CHANGEREMARK 18)
(\OP.ADDMEMBER 19)
(\OP.ADDMAILBOX 20)
(\OP.ADDFORWARD 21)
(\OP.ADDOWNER 22)
(\OP.ADDFRIEND 23)
(\OP.REMOVEMEMBER 24)
(\OP.REMOVEMAILBOX 25)
(\OP.REMOVEFORWARD 26)
(\OP.REMOVEOWNER 27)
(\OP.REMOVEFRIEND 28)
(\OP.ADDSELF 29)
(\OP.REMOVESELF 30)
(\OP.ADDLISTOFMEMBERS 31)
(\OP.NEWNAME 32))
)
(* Grapevine response codes)
(RPAQQ \GV.RESPONSES ((\RC.DONE 0)
(\RC.NOCHANGE 1)
(\RC.OUTOFDATE 2)
(\RC.NOTALLOWED 3)
(\RC.BADOPERATION 4)
(\RC.BADPROTOCOL 5)
(\RC.BADRNAME 6)
(\RC.BADPASSWORD 7)
(\RC.WRONGSERVER 8)
(\RC.ALLDOWN 9)))
(DECLARE: EVAL@COMPILE
(RPAQQ \RC.DONE 0)
(RPAQQ \RC.NOCHANGE 1)
(RPAQQ \RC.OUTOFDATE 2)
(RPAQQ \RC.NOTALLOWED 3)
(RPAQQ \RC.BADOPERATION 4)
(RPAQQ \RC.BADPROTOCOL 5)
(RPAQQ \RC.BADRNAME 6)
(RPAQQ \RC.BADPASSWORD 7)
(RPAQQ \RC.WRONGSERVER 8)
(RPAQQ \RC.ALLDOWN 9)
(CONSTANTS (\RC.DONE 0)
(\RC.NOCHANGE 1)
(\RC.OUTOFDATE 2)
(\RC.NOTALLOWED 3)
(\RC.BADOPERATION 4)
(\RC.BADPROTOCOL 5)
(\RC.BADRNAME 6)
(\RC.BADPASSWORD 7)
(\RC.WRONGSERVER 8)
(\RC.ALLDOWN 9))
)
(* Response codes the user sees)
(RPAQQ \GVU.RESPONSES ((EC.STREAMLOST (QUOTE StreamLost))
(EC.ALLDOWN (QUOTE AllDown))
(EC.NOCHANGE (QUOTE NoChange))
(EC.BADRNAME (QUOTE BadRName))
(EC.BADPASSWORD (QUOTE BadPassword))
(EC.NOTALLOWED (QUOTE NotAllowed))))
(DECLARE: EVAL@COMPILE
(RPAQQ EC.STREAMLOST StreamLost)
(RPAQQ EC.ALLDOWN AllDown)
(RPAQQ EC.NOCHANGE NoChange)
(RPAQQ EC.BADRNAME BadRName)
(RPAQQ EC.BADPASSWORD BadPassword)
(RPAQQ EC.NOTALLOWED NotAllowed)
(CONSTANTS (EC.STREAMLOST (QUOTE StreamLost))
(EC.ALLDOWN (QUOTE AllDown))
(EC.NOCHANGE (QUOTE NoChange))
(EC.BADRNAME (QUOTE BadRName))
(EC.BADPASSWORD (QUOTE BadPassword))
(EC.NOTALLOWED (QUOTE NotAllowed)))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS REGROOT REGROOTNLSNAME \REG.IOTIMEOUT \GVCONNECTIONS)
)
(DECLARE: EVAL@COMPILE
(RPAQQ \REG.SERVERENQUIRYSOC 40)
(RPAQQ \REG.SERVERPOLLINGSOC 42)
(CONSTANTS (\REG.SERVERENQUIRYSOC 40)
(\REG.SERVERPOLLINGSOC 42))
)
)
(* Functions for trying to make connection to closest by hopcount and responsiveness)
(DEFINEQ
(OPENCLOSESTSOCKET
[LAMBDA (PORTLIST POLLSOC CONNSOC TIMEOUT) (* bvm: "11-MAY-83 15:24")
(* Open a BSP connection with the "closest" respondant on portList. EchoMe polling to determine responsiveness is
to pollSoc, connection will go to connSoc. We poll in order from nearest to farest by hop order, use broadcast on
local net if appropriate, and hope not to engage too many folks before the real thing comes along.
The basic structure of this is owed to Taft)
(PROG (PUP SOC CNTIME BETWEENPROBE NEXTPORT PORT VAL LOCALFLG (MYNET (\LOCALPUPNETNUMBER)))
[COND
([SETQ PORTLIST (for PORT in PORTLIST collect PORT
unless (COND
((AND POLLSOC (EQ (fetch PUPNET# of (CAR PORT))
MYNET))
(SETQ LOCALFLG T]
(SETQ PORTLIST (SORT.PUPHOSTS.BY.DISTANCE PORTLIST]
(COND
[LOCALFLG (* if there were some local hosts on the list, remove
them and add a broadcast port)
(push PORTLIST (LIST (create PUPADDRESS
PUPNET# ← MYNET
PUPHOST# ← 0]
((NULL PORTLIST)
(RETURN)))
(SETQ SOC (\GETMISCSOCKET))
(SETQ CNTIME (SETUPTIMER \CONNECTTIMEOUT))
(SETQ NEXTPORT PORTLIST)
(DISCARDPUPS SOC) (* clear out anything left over from other activities)
(RETURN (do [COND
((OR (NULL BETWEENPROBE)
(TIMEREXPIRED? BETWEENPROBE))
[SETQ PORT (PROG1 (CAR NEXTPORT)
(SETQ NEXTPORT (OR (CDR NEXTPORT)
PORTLIST]
(SETQ PUP (ALLOCATE.PUP))
(SETUPPUP PUP (CAR PORT)
(OR POLLSOC (CDR PORT)
\DEFAULTPOLLINGSOC)
\PT.ECHOME NIL SOC (QUOTE FREE))
(SENDPUP SOC PUP)
(SETQ BETWEENPROBE (SETUPTIMER \BETWEENPROBEDELAY BETWEENPROBE]
(BLOCK)
(COND
((AND (SETQ PUP (GETPUP SOC))
(EQ (fetch PUPTYPE of PUP)
\PT.IAMECHO)
(SETQ VAL (\OPENGVCONNECTION (CONS (fetch PUPSOURCE of PUP)
(OR CONNSOC (fetch PUPSOURCESOCKET
of PUP)))
TIMEOUT)))
(RETURN VAL)))
repeatuntil (TIMEREXPIRED? CNTIME])
(\OPENGVCONNECTION
[LAMBDA (FRNSOCKET TIMEOUT) (* bvm: "16-SEP-83 16:03")
(PROG [(INSTREAM (CREATEBSPSTREAM FRNSOCKET NIL NIL TIMEOUT NIL (FUNCTION \GV.WHENCLOSED]
(RETURN (AND INSTREAM (create GVCONNECTION
GVINSTREAM ← INSTREAM
GVOUTSTREAM ←(BSPOUTPUTSTREAM INSTREAM])
(\GV.WHENCLOSED
[LAMBDA (BSPSTREAM) (* bvm: "16-SEP-83 15:17")
(* Called when BSPSTREAM is killed)
(for CONN in \GVCONNECTIONS when (EQ (fetch GVINSTREAM of CONN)
BSPSTREAM)
do (replace GVIDENTIFIED of CONN with NIL)
(SETQ \GVCONNECTIONS (DREMOVE CONN \GVCONNECTIONS])
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
[DECLARE: EVAL@COMPILE
(RECORD GVCONNECTION (GVINSTREAM GVOUTSTREAM GVBUSY GVREGISTRY GVHOPS GVIDENTIFIED))
]
(DECLARE: EVAL@COMPILE
(RPAQQ \DEFAULTPOLLINGSOC 5)
(CONSTANTS (\DEFAULTPOLLINGSOC 5))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \BETWEENPROBEDELAY \CONNECTTIMEOUT \EchosFrom \TIMEOUTKEY)
)
)
(RPAQQ \BETWEENPROBEDELAY 100)
(RPAQQ \CONNECTTIMEOUT 5000)
(DECLARE: DONTEVAL@LOAD DOCOPY
[COND ((NOT (GETD (QUOTE SORT.PUPHOSTS.BY.DISTANCE)))
(FILESLOAD ROUTER)
(/MOVD (QUOTE HOPORDER)
(QUOTE SORT.PUPHOSTS.BY.DISTANCE]
)
(* These functions check and/or coerce arguments to server operations)
(DEFINEQ
(\CHECKKEY
[LAMBDA (KEY) (* bvm: "17-SEP-83 14:18")
(COND
((KEYP KEY)
KEY)
(T (GV.MAKEKEY KEY])
(\CHECKNAME
[LAMBDA (NAME) (* bvm: "17-SEP-83 14:37")
[COND
((NLISTP NAME)
(SETQ NAME (\UNPACKREG (OR NAME (\NONAMEERR]
(COND
((ILESSP (IPLUS (NCHARS (CAR NAME))
(NCHARS (CDR NAME)))
\MAXGVSTRING) (* less than because the dot takes 1 more)
NAME)
(T (ERROR "name too long - must be < 65 chars" NAME])
(\CHECKSTAMP
[LAMBDA (STAMP) (* lmm "23-JAN-83 18:23")
(COND
[STAMP (COND
((type? TIMESTAMP STAMP)
STAMP)
(T (ERROR "not a time stamp" STAMP]
(T (create TIMESTAMP])
(\CHECKSTRING
[LAMBDA (STRING) (* Beau " 7-SEP-82 13:43")
(SELECTQ (TYPENAME STRING)
(STRINGP)
[LISTP (COND
[(AND (CAR STRING)
(LITATOM (CAR STRING))
(CDR STRING)
(LITATOM (CDR STRING)))
(SETQ STRING (CONCAT (CAR STRING)
(QUOTE %.)
(CDR STRING]
(T (ERROR "bad string arg" STRING]
(LITATOM (SETQ STRING (MKSTRING STRING)))
(ERROR "bad string arg" STRING))
(COND
((IGREATERP (NCHARS STRING)
\MAXGVSTRING)
(ERROR "string too long" STRING))
(T STRING])
(\NONAMEERR
[LAMBDA NIL (* ht: "13-JAN-82 12:05")
(ERROR "must have name for GV user op"])
(\UNPACKREG
[LAMBDA (REG) (* lmm "15-JAN-83 23:19")
(PROG ((PPOS (STRPOS "." REG)))
(RETURN (COND
[PPOS (CONS (SUBATOM REG 1 (SUB1 PPOS))
(SUBATOM REG (ADD1 PPOS]
((STRPOS "@" REG)
(CONS (MKATOM REG)
(QUOTE ArpaGateway)))
(T (CONS (MKATOM REG)
DEFAULTREGISTRY])
)
(RPAQ? DEFAULTREGISTRY )
(DECLARE: DOEVAL@COMPILE DONTCOPY
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS DEFAULTREGISTRY)
)
[DECLARE: EVAL@COMPILE
(DATATYPE TIMESTAMP ((TIMEHOST BITS 16)
(TIMETIME FIXP)))
]
(/DECLAREDATATYPE (QUOTE TIMESTAMP)
(QUOTE ((BITS 16)
FIXP)))
)
(/DECLAREDATATYPE (QUOTE TIMESTAMP)
(QUOTE ((BITS 16)
FIXP)))
(* Lower-level Grapevine User primitives)
(DEFINEQ
(\SENDITEM
[LAMBDA (OUTSTREAM ITEM) (* bvm: "11-MAY-83 16:29")
(* send out ITEM as determined by its type as per the
specs in section 4.0 of the Grapevine Interface
document)
(COND
((FIXP ITEM)
(\SENDWORD OUTSTREAM ITEM))
[(OR (LITATOM ITEM)
(STRINGP ITEM))
(COND
(ITEM (\SENDSTRING OUTSTREAM ITEM))
(T (* not a string at all but an empty string list)
(\SENDWORD OUTSTREAM 0]
[(KEYP ITEM)
(for I from 0 to 7 do (BOUT OUTSTREAM (GETKEYBYTE ITEM I]
((type? TIMESTAMP ITEM)
(\SENDWORD OUTSTREAM (fetch TIMEHOST of ITEM))
(\SENDWORD OUTSTREAM (LOGAND (fetch TIMETIME of ITEM)
65535))
(\SENDWORD OUTSTREAM (LRSH (fetch TIMETIME of ITEM)
16)))
[(LISTP ITEM) (* may be a name pair, a string list, or a byte kludge)
(COND
[(EQ (CAR ITEM)
\3BYTEKLUDGEKEY) (* somewhat miss-named now, this gives a way of sending
small numbers as bytes instead of words)
(for b in (CDR ITEM) do (BOUT OUTSTREAM (LOGAND b 255]
[(LITATOM (CDR ITEM)) (* an RName -
cons pair of two atoms)
(PROG (length)
[\SENDWORD OUTSTREAM (SETQ length (IPLUS 1 (NCHARS (CAR ITEM))
(NCHARS (CDR ITEM]
(\SENDWORD OUTSTREAM 0)
(PRIN3 (CAR ITEM)
OUTSTREAM)
(BOUT OUTSTREAM (CHARCODE %.))
(PRIN3 (CDR ITEM)
OUTSTREAM)
(COND
((ODDP length) (* padding needed)
(BOUT OUTSTREAM 0]
(T (* string list)
[\SENDWORD OUTSTREAM (for e in ITEM sum (IPLUS 2 (FOLDHI (NCHARS e)
BYTESPERWORD]
(for e in ITEM do (\SENDSTRING OUTSTREAM e]
(T (SHOULDNT])
(\SENDSTRING
[LAMBDA (STREAM STRING) (* bvm: "11-MAY-83 16:26")
(PROG ((L (NCHARS STRING)))
(COND
((IGREATERP L \MAXGVSTRING)
(ERROR "string too long" STRING)
(RETURN)))
(\SENDWORD STREAM L)
(\SENDWORD STREAM 64)
(PRIN3 STRING STREAM)
(COND
((ODDP L) (* pad)
(BOUT STREAM 0])
(\SENDWORD
[LAMBDA (OUTSTREAM WORD) (* bvm: "11-MAY-83 15:10")
(\WOUT OUTSTREAM WORD])
)
(DEFINEQ
(\RECEIVEBOOL
[LAMBDA (STREAM) (* bvm: "11-MAY-83 14:51")
(SELECTQ (BIN STREAM)
(1 T)
(0 NIL)
(SHOULDNT])
(\RECEIVECLIST
[LAMBDA (STREAM) (* bvm: "11-MAY-83 14:57")
(* receive a list of components)
(\RECEIVESTAMP STREAM T)
(to (\RECEIVEWORD STREAM) collect (\RECEIVECOMPONENT STREAM])
(\RECEIVECOMPONENT
[LAMBDA (STREAM) (* bvm: "11-MAY-83 14:57")
(* receive a component -
just a list of words)
(to (\RECEIVEWORD STREAM) collect (\RECEIVEWORD STREAM])
(\RECEIVERLIST
[LAMBDA (INSTREAM) (* bvm: "11-MAY-83 15:58")
(* receive a list of RNames -
prefix the result with the time STAMP)
(bind STRLEN (STAMP ←(\RECEIVESTAMP INSTREAM))
(NWORDS ←(\RECEIVEWORD INSTREAM)) while (IGREATERP NWORDS 0)
collect [PROG1 (\RECEIVESTRING INSTREAM (SETQ STRLEN (\RECEIVEWORD INSTREAM)))
(* mind the possible odd length, and add 2 NWORDS for
STRLEN and max)
(SETQ NWORDS (IDIFFERENCE NWORDS (IPLUS (FOLDHI STRLEN BYTESPERWORD)
2]
finally (RETURN (CONS STAMP $$VAL])
(\RECEIVERNAME
[LAMBDA (INSTREAM) (* bvm: "11-MAY-83 15:59")
(\RECEIVESTRING INSTREAM (\RECEIVEWORD INSTREAM])
(\RECEIVESTAMP
[LAMBDA (STREAM OLDSTAMP) (* bvm: "11-MAY-83 14:54")
[COND
((EQ OLDSTAMP T)
(\WIN STREAM)
(\WIN STREAM)
(\WIN STREAM)
T)
(T [COND
((NOT (type? TIMESTAMP OLDSTAMP))
(SETQ OLDSTAMP (create TIMESTAMP]
(replace TIMEHOST of OLDSTAMP with (\WIN STREAM))
(replace TIMETIME of OLDSTAMP with (LOGOR (\WIN STREAM)
(LLSH (\WIN STREAM)
16]
OLDSTAMP])
(\RECEIVESTRING
[LAMBDA (STREAM LENGTH) (* bvm: "11-MAY-83 14:52")
(COND
((IGREATERP LENGTH \MAXGVSTRING)
(ERROR "stream must be confused - string too long" LENGTH))
(T (\RECEIVEWORD STREAM) (* ignore maxLength)
(CONCATLIST (for i from 1 to LENGTH collect (FCHARACTER (BIN STREAM))
finally (COND
((ODDP LENGTH) (* read padding)
(BIN STREAM])
(\RECEIVEWORD
[LAMBDA (SOCKET) (* ht: "11-JAN-82 17:46")
(LOGOR (LSH (BSPBIN SOCKET)
8)
(BSPBIN SOCKET])
)
(RPAQQ \3BYTEKLUDGEKEY $$3byte$$)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS \RECEIVEWORD MACRO (= . \WIN))
(PUTPROPS \SENDWORD MACRO (= . \WOUT))
)
(DECLARE: EVAL@COMPILE
(RPAQQ \GV.SSLENGTH 64)
(RPAQQ \MAXGVSTRING 64)
(CONSTANTS (\GV.SSLENGTH 64)
(\MAXGVSTRING 64))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(ADDTOVAR GLOBALVARS \3BYTEKLUDGEKEY)
)
)
(DECLARE: DONTEVAL@LOAD EVAL@COMPILE DONTCOPY
(SELECTQ (COMPILEMODE)
(D (FILESLOAD (LOADCOMP)
PUP BSP))
(PDP-10 (FILESLOAD (LOADCOMP)
PUP10 BSPAUX))
NIL)
)
(PUTPROPS GRAPEVINE COPYRIGHT ("Xerox Corporation" 1983))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3683 7246 (GV.AUTHENTICATE 3693 . 3889) (GV.CHECKSTAMP 3891 . 4120) (GV.EXPAND 4122 .
4552) (GV.IDENTIFYCALLER 4554 . 4754) (GV.IDENTIFYME 4756 . 5104) (GV.ISINLIST 5106 . 5436) (
GV.ISMEMBERCLOSURE 5438 . 5676) (GV.ISMEMBERDIRECT 5678 . 5914) (GV.READCONNECT 5916 . 6117) (
GV.READENTRY 6119 . 6346) (GV.READFRIENDS 6348 . 6579) (GV.READMEMBERS 6581 . 6812) (GV.READOWNERS
6814 . 7043) (GV.READREMARK 7045 . 7244)) (7295 12509 (GV.ADDFORWARD 7305 . 7551) (GV.ADDFRIEND 7553
. 7797) (GV.ADDLISTOFMEMBERS 7799 . 8395) (GV.ADDMAILBOX 8397 . 8643) (GV.ADDMEMBER 8645 . 8889) (
GV.ADDOWNER 8891 . 9133) (GV.CHANGECONNECT 9135 . 9596) (GV.CHANGEPASSWORD 9598 . 9846) (
GV.CHANGEREMARK 9848 . 10098) (GV.CREATEGROUP 10100 . 10311) (GV.CREATEINDIVIDUAL 10313 . 10565) (
GV.DELETEGROUP 10567 . 10778) (GV.DELETEINDIVIDUAL 10780 . 11001) (GV.NEWNAME 11003 . 11245) (
GV.REMOVEFORWARD 11247 . 11499) (GV.REMOVEFRIEND 11501 . 11751) (GV.REMOVEMAILBOX 11753 . 12005) (
GV.REMOVEMEMBER 12007 . 12257) (GV.REMOVEOWNER 12259 . 12507)) (12510 13254 (GV.MAKEKEY 12520 . 13252)
) (14518 20479 (\GVOP 14528 . 15239) (\ENQUIRE 15241 . 18145) (\PERFORMGVOP 18147 . 18495) (
FINDREGSERVER 18497 . 19620) (LOCATESOCKETS 19622 . 20477)) (25876 28949 (OPENCLOSESTSOCKET 25886 .
28167) (\OPENGVCONNECTION 28169 . 28507) (\GV.WHENCLOSED 28509 . 28947)) (29653 31578 (\CHECKKEY 29663
. 29834) (\CHECKNAME 29836 . 30277) (\CHECKSTAMP 30279 . 30513) (\CHECKSTRING 30515 . 31098) (
\NONAMEERR 31100 . 31225) (\UNPACKREG 31227 . 31576)) (32010 34774 (\SENDITEM 32020 . 34178) (
\SENDSTRING 34180 . 34636) (\SENDWORD 34638 . 34772)) (34775 37694 (\RECEIVEBOOL 34785 . 34964) (
\RECEIVECLIST 34966 . 35289) (\RECEIVECOMPONENT 35291 . 35610) (\RECEIVERLIST 35612 . 36393) (
\RECEIVERNAME 36395 . 36567) (\RECEIVESTAMP 36569 . 37052) (\RECEIVESTRING 37054 . 37550) (
\RECEIVEWORD 37552 . 37692)))))
STOP