// GrapevineProtocol.bcpl // Copyright Xerox Corporation 1981, 1983 // Last modified September 19, 1983 9:34 AM by Taft get "Pup0.decl" get "Pup1.decl" get "Grapevine.decl" get "GrapevineProtocol.decl" get "GrapevineInternal.decl" get "Streams.d" external [ // outgoing procedures InitGrapevine; MakeKey GVCreateStream; GVDestroyStream; GVClaimStream; GVReleaseStream ReceiveWord; SendWord; ReceiveRName; SendRName ReceiveRList; DestroyRList // for OEP declaration only: GVStreamError // incoming procedures OpenLevel1Socket; CloseLevel1Socket OpenRTPSocket; CreateBSPStream; CloseBSPSocket BSPReadBlock; BSPWriteBlock Enqueue; Dequeue; Block Gets; Puts; Errors Allocate; Free; Zero; MoveBlock; MyFrame; GotoFrame // outgoing statics @gus // incoming statics offsetBSPStr; lBSPSoc; CtxRunning ] static @gus = 0 // Grapevine User State //---------------------------------------------------------------------------- let InitGrapevine(zone, testing; numargs na) be //---------------------------------------------------------------------------- // If testing then use the R-Server testing sockets (1 in the high word) // rather than the normal sockets. // May be called multiple times to change the testing mode. [ if gus eq 0 then [ gus = Allocate(zone, lenGUS); Zero(gus, lenGUS) gus>>GUS.zone = zone ] gus>>GUS.socketHigh = na gr 1 & testing? 1, 0 GVDestroyStream() // in case changed testing mode ] //---------------------------------------------------------------------------- and MakeKey(string, key) be //---------------------------------------------------------------------------- // Converts password string to 64-bit encryption key. [ structure PString: [ length byte; char^0,0 byte ] // zero-origin string Zero(key, lenPassword) for i = 0 to string>>PString.length-1 do [ let j = i rem 8 let c = string>>PString.char^i if c ge $A & c le $Z then c = c+($a-$A) key>>Password^j = key>>Password^j xor (c lshift 1) ] ] //---------------------------------------------------------------------------- and GVCreateStream(port) = valof //---------------------------------------------------------------------------- // First closes currently-open stream if there is one. // Then attempts to open a stream to port. If successful, puts stream in // gus>>GUS.stream. Returns true iff successful. // The socket portion of port is ignored; the registration server enquiry // socket is always used (and is stored into the port that was passed in). [ GVDestroyStream() GVClaimStream() let soc = Allocate(gus>>GUS.zone, lBSPSoc) port>>Port.socket^1 = gus>>GUS.socketHigh // zero except when testing port>>Port.socket^2 = socRegServerEnquiry OpenLevel1Socket(soc, 0, port) let result = OpenRTPSocket(soc, 0, 0, 0, 0, initialTimeout) test result ifso [ gus>>GUS.stream = CreateBSPStream(soc) gus>>GUS.stream>>ST.error = GVStreamError ] ifnot [ CloseLevel1Socket(soc); Free(gus>>GUS.zone, soc) ] GVReleaseStream() resultis result ] //---------------------------------------------------------------------------- and GVDestroyStream() be //---------------------------------------------------------------------------- // Closes and destroys the currently-open stream if there is one. [ GVClaimStream() if gus>>GUS.stream ne 0 then [ let soc = gus>>GUS.stream-offsetBSPStr CloseBSPSocket(soc, closeTimeout) Free(gus>>GUS.zone, soc) ] gus>>GUS.stream = 0 GVReleaseStream() ] //---------------------------------------------------------------------------- and GVClaimStream() be //---------------------------------------------------------------------------- // Obtains a lock on the stream -- must be done prior to any stream operation. [ while gus>>GUS.inUse do Block() gus>>GUS.inUse = CtxRunning ] //---------------------------------------------------------------------------- and GVReleaseStream() be gus>>GUS.inUse = 0 //---------------------------------------------------------------------------- // Releases the lock on the stream. //---------------------------------------------------------------------------- and GVStreamError(stream, ec) be //---------------------------------------------------------------------------- // The stream error routine called on the BSP stream to the Grapevine server. // Destroys the stream and returns to the frame specified in ST.par1, // which had better be on the call stack! The value -1 is returned; this // must be distinguishable as an exceptional result by the code for the // frame that is returned to. [ let frame = stream>>ST.par1 let soc = gus>>GUS.stream-offsetBSPStr CloseBSPSocket(soc, 0) // abort it Free(gus>>GUS.zone, soc) gus>>GUS.stream = 0 GotoFrame(frame, -1) // code = rcStreamFailed, type = rnStreamFailed ] //---------------------------------------------------------------------------- and ReceiveWord(stream) = valof //---------------------------------------------------------------------------- [ let l = Gets(stream, dataTimeout) resultis l lshift 8 + Gets(stream, dataTimeout) ] //---------------------------------------------------------------------------- and SendWord(stream, w) be //---------------------------------------------------------------------------- [ Puts(stream, w rshift 8, dataTimeout) Puts(stream, w, dataTimeout) ] //---------------------------------------------------------------------------- and ReceiveRName(stream, overheadWords) = valof //---------------------------------------------------------------------------- // Reads a Mesa string from stream, and returns the result as // either an RName (overheadWords = 0) or an RItem (overheadWords = 1). // Calls Errors(stream, ecBadProtocol) if anything bad happens. [ let length = ReceiveWord(stream) // length if length ugr maxRNameLength then Errors(stream, ecBadProtocol) ReceiveWord(stream) // maxLength (ignored) let savedErrorPoint = stream>>ST.par1 stream>>ST.par1 = MyFrame() // Grapevine always sends an even number of bytes, even if the string // length is odd. Make the RName one word too long to accomodate it. let rItem = Allocate(gus>>GUS.zone, overheadWords + (length+3) rshift 1) let rName = rItem+overheadWords rName>>RName.length = length if BSPReadBlock(stream, rName, 1, (length+1)&-2, dataTimeout) eq -1 then [ Free(gus>>GUS.zone, rItem); GotoFrame(savedErrorPoint, -1) ] stream>>ST.par1 = savedErrorPoint resultis rItem ] //---------------------------------------------------------------------------- and SendRName(stream, rName) be //---------------------------------------------------------------------------- // Writes rName (a BCPL string) as a Mesa string on stream. [ SendWord(stream, rName>>RName.length) // length SendWord(stream, 0) // maxLength (ignored) BSPWriteBlock(stream, rName, 1, (rName>>RName.length+1)&-2, // text & padding dataTimeout) ] //---------------------------------------------------------------------------- and ReceiveRList(stream) = valof //---------------------------------------------------------------------------- [ let stamp = vec lenTimeStamp BSPReadBlock(stream, stamp, 0, 2*lenTimeStamp, dataTimeout) let words = ReceiveWord(stream) let savedErrorPoint = stream>>ST.par1 stream>>ST.par1 = MyFrame() let rList = Allocate(gus>>GUS.zone, lenRList) Zero(rList, lenRList) MoveBlock(lv rList>>RList.stamp, stamp, lenTimeStamp) while words ugr 0 do [ let rItem = ReceiveRName(stream, 1) if rItem eq -1 then [ DestroyRList(rList); GotoFrame(savedErrorPoint, -1) ] Enqueue(lv rList>>RList.queue, rItem) words = words - (rItem>>RItem.rName.length+5) rshift 1 ] stream>>ST.par1 = savedErrorPoint resultis rList ] //---------------------------------------------------------------------------- and DestroyRList(rList) be //---------------------------------------------------------------------------- [ while rList>>RList.queue.head ne 0 do Free(gus>>GUS.zone, Dequeue(lv rList>>RList.queue)) Free(gus>>GUS.zone, rList) ]