// 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)
]