// GrapevineTest.bcpl
// Last modified October 21, 1983  3:57 PM by Taft

get "Grapevine.decl"
get "GrapevineProtocol.decl"
get "Pup0.decl"
get "Streams.d"

external
[
InitPupLevel1; InitGrapevine; GVDestroyStream
IsInACL; Authenticate; ReadRList; DestroyRList; MakeKey; FindServer
InitializeContext; CallContextList
InitCmd; GetString; CreateKeywordTable; InsertKeyword; GetKeyword; GetNumber; Confirm
DestroyKeywordTable; EnableCatch; EndCatch; DisableCatch; DefaultPhrase
CreateDisplayStream; ShowDisplayStream
InitializeZone; Allocate; Free
Puts; Closes; Ws; Wss; PutTemplate; Enqueue; QueueLength; ExtractSubstring
SysErr; FalsePredicate; Block; Idle
dsp; sysZone; lvSysZone; lvIdle
]

static
[
ctxQ; underlyingZone; defaultGroup; defaultMember; defaultServer
testing = false
]

structure MyZone:
[
@ZN
underlyingZone word
blocksAllocated word
]
manifest lenMyZone = size MyZone/16

//---------------------------------------------------------------------------
let Test() be
//---------------------------------------------------------------------------
[
Ws("*nGrapevineTest of October 21, 1983")
let v = vec 10000
let myZone = vec lenMyZone
myZone>>MyZone.Allocate = MyAllocate; myZone>>MyZone.Free = MyFree
myZone>>MyZone.underlyingZone = InitializeZone(v, 10000, SysErr, 0)
myZone>>MyZone.blocksAllocated = 0
sysZone = myZone; @lvSysZone = myZone
let v = vec 1; ctxQ = v; ctxQ!0 = 0

let v = vec 20000
dsp = CreateDisplayStream(40, v, 20000)
ShowDisplayStream(dsp)

InitPupLevel1(sysZone, ctxQ, 10)

Enqueue(ctxQ, InitializeContext(Allocate(sysZone, 1000), 1000, Main))

@lvIdle = Block

CallContextList(ctxQ!0) repeat
]

//---------------------------------------------------------------------------
and Main(ctx) be
//---------------------------------------------------------------------------
[
InitGrapevine(sysZone)
let kt = CreateKeywordTable(10)
InsertKeyword(kt, "Is")!0 = IsCmd
InsertKeyword(kt, "Registry")!0 = RegistryCmd
InsertKeyword(kt, "Authenticate")!0 = AuthenticateCmd
InsertKeyword(kt, "Read")!0 = ReadCmd
InsertKeyword(kt, "Find")!0 = FindCmd
InsertKeyword(kt, "Quit")!0 = Quit
InsertKeyword(kt, "ZoneCount")!0 = ZoneCountCmd
InsertKeyword(kt, "Testing")!0 = TestingCmd
InsertKeyword(kt, "Close")!0 = GVDestroyStream

defaultGroup = ExtractSubstring("")
defaultMember = ExtractSubstring("")
defaultServer = ExtractSubstring("")

   [ // repeat
   let cs = InitCmd(100, 10)
   if cs ne 0 then
      [
      Wss(cs, "*n> ")
      let proc = GetKeyword(cs, kt)!0
      proc(cs)
      Closes(cs)
      ]
   ] repeat
]

//---------------------------------------------------------------------------
and Quit(cs) be
//---------------------------------------------------------------------------
[
Closes(dsp)
GVDestroyStream()
@lvIdle = Idle
finish
]

//---------------------------------------------------------------------------
and TestingCmd(cs) be
//---------------------------------------------------------------------------
[
Wss(cs, (testing? " disable", " enable"))
if Confirm(cs) then testing = not testing
InitGrapevine(nil, testing)
]

//---------------------------------------------------------------------------
and ZoneCountCmd(cs) be
//---------------------------------------------------------------------------
   PutTemplate(dsp, " = $UD blocks allocated", sysZone>>MyZone.blocksAllocated)

//---------------------------------------------------------------------------
and IsCmd(cs, nil; numargs na) be
//---------------------------------------------------------------------------
[
let desc = na eq 1? dItself, dItsRegistry
desc = desc % (table [ dMember; dOwner; dFriend ]) !
    (SelectKeyword(cs, "Member", "Owner", "Friend")-1)
desc = desc % (table [ dDirect; dClosure; dUpArrow ]) !
    (SelectKeyword(cs, "Direct", "Closure", "UpArrow")-1)
Wss(cs, " (group) ")
let group = GetDefaultedString(cs, lv defaultGroup)
Wss(cs, " (member) ")
let member = GetDefaultedString(cs, lv defaultMember)
let ec = IsInACL(group, member, desc)
DisplayGrapevineEC(ec)
Free(sysZone, group)
Free(sysZone, member)
]

//---------------------------------------------------------------------------
and RegistryCmd(cs) be IsCmd(cs, nil)
//---------------------------------------------------------------------------

//---------------------------------------------------------------------------
and AuthenticateCmd(cs) be
//---------------------------------------------------------------------------
[
Wss(cs, " (name) ")
let name = GetDefaultedString(cs, lv defaultMember)
Wss(cs, " (password) ")
let password = GetString(cs, 0, 0, 0, FalsePredicate)
let key = vec lenPassword
MakeKey(password, key)
let ec = Authenticate(name, key)
DisplayGrapevineEC(ec)
Free(sysZone, name)
Free(sysZone, password)
]

//---------------------------------------------------------------------------
and ReadCmd(cs) be
//---------------------------------------------------------------------------
[
let op = (table [ opReadMembers; opReadOwners; opReadFriends ]) !
    (SelectKeyword(cs, "Members", "Owners", "Friends")-1)
Wss(cs, " (of group) ")
let group = GetDefaultedString(cs, lv defaultGroup)
let ec = nil
let rList = ReadRList(group, op, lv ec)
test rList ne 0
   ifso
      [
      PutTemplate(dsp, " = ($D) ", QueueLength(lv rList>>RList.queue))
      let rItem = rList>>RList.queue.head
      while rItem ne 0 do
         [ PutTemplate(dsp, " $S", lv rItem>>RItem.rName); rItem = rItem>>RItem.next ]
      DestroyRList(rList)
      ]
   ifnot DisplayGrapevineEC(ec)
Free(sysZone, group)
]

//---------------------------------------------------------------------------
and FindCmd(cs) be
//---------------------------------------------------------------------------
[
Wss(cs, " (server name) ")
let name = GetDefaultedString(cs, lv defaultServer)
Wss(cs, " (polling socket number) ")
let pollingSocket = GetNumber(cs, 8)
let ec = FindServer(name, pollingSocket, PrintPort)
if ec ne 0 then DisplayGrapevineEC(ec)
]

//---------------------------------------------------------------------------
and PrintPort(port) = valof
//---------------------------------------------------------------------------
[
PutTemplate(dsp, " [$O#$O#$UEO]", port>>Port.net, port>>Port.host, lv port>>Port.socket)
resultis true  // stop at first server enumerated
]

//---------------------------------------------------------------------------
and DisplayGrapevineEC(ec) be
//---------------------------------------------------------------------------
[
PutTemplate(dsp, " -- $S", selecton ec into
   [
   case ecNoChange: "NoChange"
   case ecGroup: "Group"
   case ecIndividual: "Individual"
   case ecBadRName: "BadRName"
   case ecAllDown: "AllDown"
   case ecBadPassword: "BadPassword"
   case ecIsMember: "IsMember"
   case ecIsNotMember: "IsNotMember"
   default: "unknown error code"
   ])
]

//---------------------------------------------------------------------------
and MyAllocate(zone, words) = valof
//---------------------------------------------------------------------------
[
zone>>MyZone.blocksAllocated = zone>>MyZone.blocksAllocated+1
resultis Allocate(zone>>MyZone.underlyingZone, words)
]

//---------------------------------------------------------------------------
and MyFree(zone, block) = valof
//---------------------------------------------------------------------------
[
zone>>MyZone.blocksAllocated = zone>>MyZone.blocksAllocated-1
resultis Free(zone>>MyZone.underlyingZone, block)
]

//---------------------------------------------------------------------------
and SelectKeyword(cs, key1, nil, nil, nil, nil, nil, nil, nil, nil, nil;
    numargs na) = valof
//---------------------------------------------------------------------------
// Takes a list of up to 10 keywords, calls GetKeyword with that list,
//  and returns the index (1-10) of the one matching the word typed in.
// Keyword arguments may be omitted by supplying zero in some argument
//  positions; this permits keywords to be included conditionally.
[
Puts(cs, $*s)
let kt = nil
if EnableCatch(cs) then [ DestroyKeywordTable(kt); EndCatch(cs) ]
kt = CreateKeywordTable(10)
for i = 1 to na-1 do if (lv cs)!i ne 0 then InsertKeyword(kt, (lv cs)!i)!0 = i
let which = GetKeyword(cs, kt)!0
DestroyKeywordTable(kt)
DisableCatch(cs)
resultis which
]

//---------------------------------------------------------------------------
and GetDefaultedString(cs, lvDefaultString) = valof
//---------------------------------------------------------------------------
[
DefaultPhrase(cs, @lvDefaultString)
let result = GetString(cs)
Free(sysZone, @lvDefaultString)
@lvDefaultString = ExtractSubstring(result)
resultis result
]