(FILECREATED "11-Jul-84 16:40:09" {ERIS}<LISPCORE>LIBRARY>GRAPEVINE.;3
 37887  

      changes to:  (FNS \OPENGVCONNECTION)

      previous date: " 1-Jun-84 11:48:33" {ERIS}<LISPCORE>LIBRARY>GRAPEVINE.;2)


(* Copyright (c) 1983, 1984 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT GRAPEVINECOMS)

(RPAQQ GRAPEVINECOMS
 [(COMS (* 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)))
	(COMS (* Talking to Reg Servers)
	      (FNS \GVOP \ENQUIRE \PERFORMGVOP FINDREGSERVER LOCATESOCKETS)
	      (ADDVARS (\GVCONNECTIONS))
	      (VARS (REGROOT (QUOTE (GV . GV)))
		    (REGROOTNLSNAME "GrapevineRServer")
		    (\REG.IOTIMEOUT 30000))
	      (DECLARE: DOEVAL@COMPILE DONTCOPY (COMS * GVPROTOCOLDEFS)))
	(COMS (* Making server connections)
	      (FNS OPENCLOSESTSOCKET \OPENGVCONNECTION GV.KILLSOCKET \GV.WHENCLOSED)
	      (DECLARE: DOEVAL@COMPILE DONTCOPY (RECORDS GVCONNECTION)
			(CONSTANTS (\DEFAULTPOLLINGSOC 5))
			(GLOBALVARS \BETWEENPROBEDELAY \CONNECTTIMEOUT))
	      (VARS (\BETWEENPROBEDELAY 100)
		    (\CONNECTTIMEOUT 5000)))
	(COMS (* Checking arguments)
	      (FNS \CHECKKEY \CHECKNAME \CHECKSTAMP \CHECKSTRING \NONAMEERR \UNPACKREG)
	      (INITVARS (DEFAULTREGISTRY))
	      (DECLARE: DOEVAL@COMPILE DONTCOPY (GLOBALVARS DEFAULTREGISTRY)
			(RECORDS TIMESTAMP))
	      (INITRECORDS TIMESTAMP))
	(COMS (* I/O primitives)
	      (FNS \SENDITEM \SENDSTRING \SENDWORD)
	      (FNS \RECEIVEBOOL \RECEIVECLIST \RECEIVECOMPONENT \RECEIVERLIST \RECEIVERNAME 
		   \RECEIVESTAMP \RECEIVESTRING \RECEIVEWORD \SKIPWORD)
	      (VARS (\3BYTEKLUDGEKEY (QUOTE $$3byte$$)))
	      (DECLARE: DOEVAL@COMPILE DONTCOPY (MACROS \RECEIVEWORD \SKIPWORD \SENDWORD)
			(CONSTANTS (\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])



(* 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 READFN)                             (* bvm: "22-Mar-84 14:05")

    (\GVOP
 \OP.READENTRY (\CHECKNAME
 NAME)
	   (LIST (\CHECKSTAMP
 OLDSTAMP))
	   (OR READFN (FUNCTION \RECEIVECLIST])

(GV.READFRIENDS

  [LAMBDA (NAME OLDSTAMP READFN)                             (* bvm: "22-Mar-84 14:03")

    (\GVOP
 \OP.READFRIENDS (\CHECKNAME
 NAME)
	   (LIST (\CHECKSTAMP
 OLDSTAMP))
	   (OR READFN (FUNCTION \RECEIVERLIST])

(GV.READMEMBERS

  [LAMBDA (NAME OLDSTAMP READFN)                             (* bvm: "22-Mar-84 14:03")

    (\GVOP
 \OP.READMEMBERS (\CHECKNAME
 NAME)
	   (LIST (\CHECKSTAMP
 OLDSTAMP))
	   (OR READFN (FUNCTION \RECEIVERLIST])

(GV.READOWNERS

  [LAMBDA (NAME OLDSTAMP READFN)                             (* bvm: "22-Mar-84 14:04")

    (\GVOP
 \OP.READOWNERS (\CHECKNAME
 NAME)
	   (LIST (\CHECKSTAMP
 OLDSTAMP))
	   (OR READFN (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)))
)
)



(* Talking to Reg Servers)


(DEFINEQ

(\GVOP

  [LAMBDA (OP name itemList READFN IDENTIFYUSER PASSWORD)    (* bvm: "22-Mar-84 14:55")


          (* 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)



    (\ENQUIRE
 name (CONS OP (CONS name itemList))
	      READFN IDENTIFYUSER PASSWORD])

(\ENQUIRE

  [LAMBDA (NAME ARGS READFN IDENTIFYUSER PASSWORD)           (* bvm: " 1-Jun-84 11:43")


          (* 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]
				  (BLOCK)
				  (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]
          (SETQ RESULT (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)



				     (BLOCK)                 (* Let RTP run and clean this guy out)

				     (replace
 GVBUSY of
 CONN with
 NIL)
				     (GO LP)))
				(\RC.NOCHANGE                (* For use with timestamps, says entry has not changed, 

							     so no values to return)

					      EC.NOCHANGE)
				(\RC.DONE (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)
						     EC.BADRNAME)
						   (T (replace
 GVBUSY of
 CONN with
 NIL)
						      (SETQ REGISTRY (CONS (CDR NAME)
									   (QUOTE GV)))
						      (GO LP]
				(\RC.BADRNAME EC.BADRNAME)
				(\RC.NOTALLOWED EC.NOTALLOWED)
				(\RC.BADPASSWORD EC.BADPASSWORD)
				(\RC.ALLDOWN EC.ALLDOWN)
				RESULT))
          (replace
 GVBUSY of
 CONN with
 NIL)
          (RETURN RESULT])

(\PERFORMGVOP

  [LAMBDA (CONN ARGS)                                        (* bvm: "21-Mar-84 18:53")

    (CAR (NLSETQ (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 

(RPAQQ GVPROTOCOLDEFS
 ((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))
		       (* Constants for calling GV.ISINLIST)
		       (CONSTANTS * \GVU.MEMBEROPS)))

(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))
)



(* 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))
)
)



(* Making server connections)


(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: "11-Jul-84 16:35")

    (PROG [(INSTREAM (OPENBSPSTREAM FRNSOCKET NIL NIL TIMEOUT NIL (FUNCTION \GV.WHENCLOSED]
          (RETURN (AND INSTREAM (create
 GVCONNECTION
					GVINSTREAM _ INSTREAM
					GVOUTSTREAM _(BSPOUTPUTSTREAM INSTREAM])

(GV.KILLSOCKET

  [LAMBDA (SOCKET TIMEOUT)                                   (* bvm: " 1-Jun-84 11:45")

    (CLOSEBSPSTREAM (fetch
 GVINSTREAM of
 SOCKET)
		    TIMEOUT)
    (BLOCK])

(\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)
)
)

(RPAQQ \BETWEENPROBEDELAY
 100)

(RPAQQ \CONNECTTIMEOUT
 5000)



(* Checking arguments)


(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)))



(* I/O 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: "22-Mar-84 15:34")

    [COND
      ((EQ OLDSTAMP T)
	(\SKIPWORD
 STREAM)
	(\SKIPWORD
 STREAM)
	(\SKIPWORD
 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: "22-Mar-84 18:22")

    (COND
      ((IGREATERP LENGTH \MAXGVSTRING)
	(ERROR "stream must be confused - string too long" LENGTH))
      (T (\SKIPWORD
 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])

(\SKIPWORD

  [LAMBDA (STREAM)                                           (* bvm: "22-Mar-84 15:34")

    (BIN STREAM)
    (BIN STREAM])
)

(RPAQQ \3BYTEKLUDGEKEY
 $$3byte$$)
(DECLARE: DOEVAL@COMPILE DONTCOPY 
(DECLARE: EVAL@COMPILE 

(PUTPROPS \RECEIVEWORD MACRO
 (= . \WIN))

(PUTPROPS \SKIPWORD MACRO
 (OPENLAMBDA (STREAM)
				      (PROGN (BIN STREAM)
					     (BIN STREAM))))

(PUTPROPS \SENDWORD MACRO
 (= . \WOUT))
)

(DECLARE: EVAL@COMPILE 

(RPAQQ \MAXGVSTRING
 64)

(CONSTANTS (\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 1984))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (2751 6362 (GV.AUTHENTICATE 2761 . 2957) (GV.CHECKSTAMP 2959 . 3188) (GV.EXPAND 3190 . 
3620) (GV.IDENTIFYCALLER 3622 . 3822) (GV.IDENTIFYME 3824 . 4172) (GV.ISINLIST 4174 . 4504) (
GV.ISMEMBERCLOSURE 4506 . 4744) (GV.ISMEMBERDIRECT 4746 . 4982) (GV.READCONNECT 4984 . 5185) (
GV.READENTRY 5187 . 5426) (GV.READFRIENDS 5428 . 5671) (GV.READMEMBERS 5673 . 5916) (GV.READOWNERS 
5918 . 6159) (GV.READREMARK 6161 . 6360)) (6411 11625 (GV.ADDFORWARD 6421 . 6667) (GV.ADDFRIEND 6669
 . 6913) (GV.ADDLISTOFMEMBERS 6915 . 7511) (GV.ADDMAILBOX 7513 . 7759) (GV.ADDMEMBER 7761 . 8005) (
GV.ADDOWNER 8007 . 8249) (GV.CHANGECONNECT 8251 . 8712) (GV.CHANGEPASSWORD 8714 . 8962) (
GV.CHANGEREMARK 8964 . 9214) (GV.CREATEGROUP 9216 . 9427) (GV.CREATEINDIVIDUAL 9429 . 9681) (
GV.DELETEGROUP 9683 . 9894) (GV.DELETEINDIVIDUAL 9896 . 10117) (GV.NEWNAME 10119 . 10361) (
GV.REMOVEFORWARD 10363 . 10615) (GV.REMOVEFRIEND 10617 . 10867) (GV.REMOVEMAILBOX 10869 . 11121) (
GV.REMOVEMEMBER 11123 . 11373) (GV.REMOVEOWNER 11375 . 11623)) (11626 12370 (GV.MAKEKEY 11636 . 12368)
) (12975 18863 (\GVOP 12985 . 13387) (\ENQUIRE 13389 . 16529) (\PERFORMGVOP 16531 . 16879) (
FINDREGSERVER 16881 . 18004) (LOCATESOCKETS 18006 . 18861)) (25257 28525 (OPENCLOSESTSOCKET 25267 . 
27548) (\OPENGVCONNECTION 27550 . 27886) (GV.KILLSOCKET 27888 . 28083) (\GV.WHENCLOSED 28085 . 28523))
 (28972 30897 (\CHECKKEY 28982 . 29153) (\CHECKNAME 29155 . 29596) (\CHECKSTAMP 29598 . 29832) (
\CHECKSTRING 29834 . 30417) (\NONAMEERR 30419 . 30544) (\UNPACKREG 30546 . 30895)) (31306 34070 (
\SENDITEM 31316 . 33474) (\SENDSTRING 33476 . 33932) (\SENDWORD 33934 . 34068)) (34071 37160 (
\RECEIVEBOOL 34081 . 34260) (\RECEIVECLIST 34262 . 34585) (\RECEIVECOMPONENT 34587 . 34906) (
\RECEIVERLIST 34908 . 35689) (\RECEIVERNAME 35691 . 35863) (\RECEIVESTAMP 35865 . 36375) (
\RECEIVESTRING 36377 . 36873) (\RECEIVEWORD 36875 . 37015) (\SKIPWORD 37017 . 37158)))))
STOP