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