LoganBerrySunStubImpl.mesa
Copyright Ó 1985, 1989, 1992 by Xerox Corporation. All rights reserved.
Doug Terry, February 10, 1991 6:59 pm PST
Brian Oki, March 30, 1990 4:38 pm PST
Willie-s, April 23, 1992 5:14 pm PDT
Allows one to invoke operations on LoganBerry servers using SUN RPC.
DIRECTORY
Arpa USING [Address, nullAddress],
Atom USING [GetPName, MakeAtom],
Basics USING [HFromCard16, LowHalf],
Convert USING [ArpaAddressFromRope],
IO USING [rope, PutFR1],
LoganBerry,
LoganBerryClass USING [Class, ClassObject, Register],
LoganBerrySunRPC,
LoganBerrySunRPCClient,
RefID USING [Seal, Unseal],
Rope USING [Concat, Find, FromRefText, Length, Replace, ROPE, Substr],
SunPMap USING [ipProtocolUDP, udpPort],
SunPMapClient USING [GetPort],
SunRPC USING [Error, Handle],
SunRPCOnUDP USING [Create, SetRemote],
SunRPCAuth USING [Initiate],
SunYPAgent USING [Error, Handle, Match, ObtainHandle, ReleaseHandle, Tokenize];
LoganBerrySunStubImpl: CEDAR MONITOR LOCKS dbinfo USING dbinfo: OpenDBInfo
-- Operations are monitored to avoid concurrent callers using the same RPC handle.
IMPORTS Atom, Basics, Convert, IO, LoganBerry, LoganBerryClass, LoganBerrySunRPCClient, RefID, Rope, SunPMapClient, SunRPC, SunRPCAuth, SunRPCOnUDP, SunYPAgent
EXPORTS LoganBerry indirectly by registering with LoganBerryClass
~ BEGIN
ROPE: TYPE = Rope.ROPE;
Conv: TYPE ~ LoganBerry.Conv;
OpenDB: TYPE ~ LoganBerry.OpenDB;
AttributeType: TYPE ~ LoganBerry.AttributeType;
AttributeValue: TYPE ~ LoganBerry.AttributeValue;
Entry: TYPE ~ LoganBerry.Entry;
EntryProc: TYPE ~ LoganBerry.EntryProc;
Cursor: TYPE ~ LoganBerry.Cursor;
CursorDirection: TYPE ~ LoganBerry.CursorDirection;
LogID: TYPE ~ LoganBerry.LogID;
activityLog: LogID ~ LoganBerry.activityLog;
SchemaInfo: TYPE ~ LoganBerry.SchemaInfo;
nilconv: INT = 0;
OpenDBInfo: TYPE = REF OpenDBRecord;
OpenDBRecord: TYPE = MONITORED RECORD [
h: SunRPC.Handle ¬ NIL,
db: CARD32   
];
CursorInfo: TYPE = REF CursorRecord;
CursorRecord: TYPE = RECORD[
dbinfo: OpenDBInfo,
cursor: CARD32 
];
Naming
Database name should be of the form: /server-Sun/rest/...LB.df.
This becomes: server="server", nameOnServer="//rest/...LB.df".
CheckName: PROC [dbName: ROPE] RETURNS [accept: BOOLEAN, server: ROPE, nameOnServer: ROPE] ~ {
fullPathName: ROPE;
serverIndex: INT;
sunName: BOOL ¬ TRUE;
fullPathName ¬ dbName;
accept ¬ FALSE;
serverIndex ¬ Rope.Find[s1: fullPathName, s2: "-SUN", case: FALSE];
IF serverIndex = -1 THEN {
sunName ¬ FALSE;
serverIndex ¬ Rope.Find[s1: fullPathName, s2: "-ARPA", case: FALSE]};
IF serverIndex > -1 THEN { -- found either -sun or -arpa suffix
newlength: INT;
fullServerName: ROPE;
serverNameLength: INT ¬ serverIndex - 1;
accept ¬ TRUE;
server ¬ Rope.Substr[base: fullPathName, start: 1, len: serverNameLength];
IF sunName THEN
fullServerName ¬ Rope.Concat[base: server, rest: "-SUN"]
ELSE fullServerName ¬ Rope.Concat[base: server, rest: "-ARPA"];
Now the full server name is of the form name-sun or name-arpa. Now from this extract the full path name to get the actual name on server.
newlength ¬ Rope.Length[fullServerName] ;
nameOnServer ¬ NIL;
nameOnServer ¬ Rope.Replace[base: fullPathName, start: 1, len: newlength, with: NIL];
newlength ¬ Rope.Length[nameOnServer];
nameOnServer ¬ Rope.Substr[base: nameOnServer, start: 1, len: newlength];
};
};
ypMap: ROPE ¬ "hosts.byname";
SunYPNameToAddress: PROC [name: ROPE] RETURNS [addr: Arpa.Address ¬ Arpa.nullAddress] ~ {
ENABLE SunYPAgent.Error => CONTINUE;
mapEntry: REF TEXT ¬ NIL;
h: SunYPAgent.Handle ¬ SunYPAgent.ObtainHandle[]; -- use default domain
mapEntry ¬ SunYPAgent.Match[h, ypMap, name];
SunYPAgent.ReleaseHandle[h];
IF mapEntry # NIL THEN {
map entry is something like "13.0.208.72 baobab baobab.parc.xerox.com"
addrText: REF TEXT ¬ SunYPAgent.Tokenize[mapEntry][0]; -- address is at front of mapEntry
addr ¬ Convert.ArpaAddressFromRope[Rope.FromRefText[addrText]];
};
};
Class methods
Open: PROC [conv: Conv ¬ NIL, dbName: ROPE] RETURNS [db: OpenDB] ~ {
ENABLE {
SunRPC.Error => PostSunError[code];
LoganBerrySunRPCClient.Error => ERROR LoganBerry.Error[Atom.MakeAtom[ec], explanation];
};
accept: BOOLEAN;
server, nameOnServer: ROPE;
dbinfo: OpenDBInfo;
addr: Arpa.Address;
port: CARD;
[accept, server, nameOnServer] ¬ CheckName[dbName];
IF NOT accept THEN RETURN[LoganBerry.nullDB];
dbinfo ¬ NEW[OpenDBRecord];
addr ¬ SunYPNameToAddress[server];
IF ( addr = Arpa.nullAddress ) THEN
ERROR LoganBerry.Error[$CantOpenSchema, IO.PutFR1["Unknown server: %g.", IO.rope[server]]];
dbinfo.h ¬ SunRPCOnUDP.Create[addr, Basics.HFromCard16[SunPMap.udpPort]];
port ¬ SunPMapClient.GetPort[dbinfo.h, SunRPCAuth.Initiate[], 390905, 1, SunPMap.ipProtocolUDP ! SunRPC.Error => ERROR LoganBerry.Error[$CantOpenSchema, IO.PutFR1["Can't contact remote server: %g.", IO.rope[server]]]];
IF port = 0 THEN
ERROR LoganBerry.Error[$CantOpenSchema, IO.PutFR1["LoganBerry not exported on server: %g.", IO.rope[server]]];
dbinfo.h ¬ SunRPCOnUDP.SetRemote[dbinfo.h, addr, Basics.HFromCard16[Basics.LowHalf[port]]];
dbinfo.db ¬ LoganBerrySunRPCClient.Open[dbinfo.h, nilconv, nameOnServer];
RETURN[RefID.Seal[dbinfo]];
};
ReadEntry: PROC [conv: Conv ¬ NIL, db: OpenDB, key: AttributeType, value: AttributeValue] RETURNS [entry: Entry, others: BOOLEAN] ~ {
ENABLE {
SunRPC.Error => PostSunError[code];
LoganBerrySunRPCClient.Error => ERROR LoganBerry.Error[Atom.MakeAtom[ec], explanation];
};
dbinfo: OpenDBInfo ¬ GetInfo[db];
[entry, others] ¬ ReadEntryI[dbinfo, key, value];
RETURN[entry, others];
};
ReadEntryI: PUBLIC ENTRY PROC [dbinfo: OpenDBInfo, key: AttributeType, value: AttributeValue] RETURNS [entry: Entry, others: BOOLEAN] ~ {
ENABLE UNWIND => NULL;
srEntry: LoganBerrySunRPC.Entry;
[srEntry, others] ¬ LoganBerrySunRPCClient.ReadEntry[dbinfo.h, nilconv, dbinfo.db, Atom.GetPName[key], value];
entry ¬ SrToEntry[srEntry];
};
EnumerateEntries: PROC [db: OpenDB, key: AttributeType, start: AttributeValue ¬ NIL, end: AttributeValue ¬ NIL, proc: EntryProc] RETURNS [] ~ {
entry: Entry;
c: Cursor ¬ GenerateEntries[NIL, db, key, start, end];
entry ¬ NextEntry[NIL, c];
WHILE entry # NIL DO
IF NOT proc[entry] THEN EXIT;
entry ¬ NextEntry[NIL, c];
ENDLOOP;
EndGenerate[NIL, c];
};
GenerateEntries: PROC [conv: Conv ¬ NIL, db: OpenDB, key: AttributeType, start: AttributeValue ¬ NIL, end: AttributeValue ¬ NIL] RETURNS [cursor: Cursor] ~ {
ENABLE {
SunRPC.Error => PostSunError[code];
LoganBerrySunRPCClient.Error => ERROR LoganBerry.Error[Atom.MakeAtom[ec], explanation];
};
cinfo: CursorInfo;
dbinfo: OpenDBInfo ¬ GetInfo[db];
cinfo ¬ GenerateEntriesI[dbinfo, key, start, end];
RETURN[RefID.Seal[cinfo]];
};
GenerateEntriesI: PUBLIC ENTRY PROC [dbinfo: OpenDBInfo, key: AttributeType, start: AttributeValue ¬ NIL, end: AttributeValue ¬ NIL] RETURNS [cinfo: CursorInfo] ~ {
ENABLE UNWIND => NULL;
cinfo ¬ NEW[CursorRecord];
cinfo.dbinfo ¬ dbinfo;
cinfo.cursor ¬ LoganBerrySunRPCClient.GenerateEntries[dbinfo.h, nilconv, dbinfo.db, Atom.GetPName[key], start, end];
};
NextEntry: PROC [conv: Conv ¬ NIL, cursor: Cursor, dir: CursorDirection ¬ increasing] RETURNS [entry: Entry] ~ {
ENABLE {
SunRPC.Error => PostSunError[code];
LoganBerrySunRPCClient.Error => ERROR LoganBerry.Error[Atom.MakeAtom[ec], explanation];
};
cinfo: CursorInfo ¬ GetCursorInfo[cursor];
entry ¬ NextEntryI[cinfo.dbinfo, cinfo, dir];
RETURN[entry];
};
NextEntryI: PUBLIC ENTRY PROC [dbinfo: OpenDBInfo, cinfo: CursorInfo, dir: CursorDirection ¬ increasing] RETURNS [entry: Entry] ~ {
ENABLE UNWIND => NULL;
srEntry: LoganBerrySunRPC.Entry;
srEntry ¬ LoganBerrySunRPCClient.NextEntry[cinfo.dbinfo.h, nilconv, cinfo.cursor, IF dir=increasing THEN increasing ELSE decreasing];
entry ¬ SrToEntry[srEntry];
};
EndGenerate: PROC [conv: Conv ¬ NIL, cursor: Cursor] RETURNS [] ~ {
ENABLE {
SunRPC.Error => PostSunError[code];
LoganBerrySunRPCClient.Error => ERROR LoganBerry.Error[Atom.MakeAtom[ec], explanation];
};
cinfo: CursorInfo ¬ GetCursorInfo[cursor];
EndGenerateI[cinfo.dbinfo, cinfo];
};
EndGenerateI: PUBLIC ENTRY PROC [dbinfo: OpenDBInfo, cinfo: CursorInfo] RETURNS [] ~ {
ENABLE UNWIND => NULL;
LoganBerrySunRPCClient.EndGenerate[cinfo.dbinfo.h, nilconv, cinfo.cursor];
};
WriteEntry: PROC [conv: Conv ¬ NIL, db: OpenDB, entry: Entry, log: LogID ¬ activityLog, replace: BOOLEAN ¬ FALSE] RETURNS [] ~ {
ENABLE {
SunRPC.Error => PostSunError[code];
LoganBerrySunRPCClient.Error => ERROR LoganBerry.Error[Atom.MakeAtom[ec], explanation];
};
dbinfo: OpenDBInfo ¬ GetInfo[db];
WriteEntryI[dbinfo, entry, log, replace];
};
WriteEntryI: PUBLIC ENTRY PROC [dbinfo: OpenDBInfo, entry: Entry, log: LogID ¬ activityLog, replace: BOOLEAN ¬ FALSE] RETURNS [] ~ {
ENABLE UNWIND => NULL;
LoganBerrySunRPCClient.WriteEntry[dbinfo.h, nilconv, dbinfo.db, EntryToSr[entry], log, replace];
};
DeleteEntry: PROC [conv: Conv ¬ NIL, db: OpenDB, key: AttributeType, value: AttributeValue] RETURNS [deleted: Entry] ~ {
ENABLE {
SunRPC.Error => PostSunError[code];
LoganBerrySunRPCClient.Error => ERROR LoganBerry.Error[Atom.MakeAtom[ec], explanation];
};
dbinfo: OpenDBInfo ¬ GetInfo[db];
deleted ¬ DeleteEntryI[dbinfo, key, value];
RETURN[deleted];
};
DeleteEntryI: PUBLIC ENTRY PROC [dbinfo: OpenDBInfo, key: AttributeType, value: AttributeValue] RETURNS [deleted: Entry] ~ {
ENABLE UNWIND => NULL;
srEntry: LoganBerrySunRPC.Entry;
srEntry ¬ LoganBerrySunRPCClient.ReadEntry[dbinfo.h, nilconv, dbinfo.db, Atom.GetPName[key], value].entry;
LoganBerrySunRPCClient.DeleteEntry[dbinfo.h, nilconv, dbinfo.db, Atom.GetPName[key], value];
deleted ¬ SrToEntry[srEntry];
};
Close: PROC [conv: Conv ¬ NIL, db: OpenDB] RETURNS [] ~ {
ENABLE {
SunRPC.Error => PostSunError[code];
LoganBerrySunRPCClient.Error => ERROR LoganBerry.Error[Atom.MakeAtom[ec], explanation];
};
dbinfo: OpenDBInfo ¬ GetInfo[db];
CloseI[dbinfo];
};
CloseI: PUBLIC ENTRY PROC [dbinfo: OpenDBInfo] RETURNS [] ~ {
ENABLE UNWIND => NULL;
LoganBerrySunRPCClient.Close[dbinfo.h, nilconv, dbinfo.db];
};
BuildIndices: PROC [conv: Conv ¬ NIL, db: OpenDB] RETURNS [] ~ {
ENABLE {
SunRPC.Error => PostSunError[code];
LoganBerrySunRPCClient.Error => ERROR LoganBerry.Error[Atom.MakeAtom[ec], explanation];
};
dbinfo: OpenDBInfo ¬ GetInfo[db];
BuildIndicesI[dbinfo];
};
BuildIndicesI: PUBLIC ENTRY PROC [dbinfo: OpenDBInfo] RETURNS [] ~ {
ENABLE UNWIND => NULL;
LoganBerrySunRPCClient.BuildIndices[dbinfo.h, nilconv, dbinfo.db];
};
CompactLogs: PROC [conv: Conv ¬ NIL, db: OpenDB] RETURNS [] ~ {
ENABLE {
SunRPC.Error => PostSunError[code];
LoganBerrySunRPCClient.Error => ERROR LoganBerry.Error[Atom.MakeAtom[ec], explanation];
};
dbinfo: OpenDBInfo ¬ GetInfo[db];
CompactLogsI[dbinfo];
};
CompactLogsI: PUBLIC ENTRY PROC [dbinfo: OpenDBInfo] RETURNS [] ~ {
ENABLE UNWIND => NULL;
LoganBerrySunRPCClient.CompactLogs[dbinfo.h, nilconv, dbinfo.db];
};
Describe: PROC [conv: Conv ¬ NIL, db: OpenDB] RETURNS [info: SchemaInfo] ~ {
ENABLE {
SunRPC.Error => PostSunError[code];
LoganBerrySunRPCClient.Error => ERROR LoganBerry.Error[Atom.MakeAtom[ec], explanation];
};
dbinfo: OpenDBInfo ¬ GetInfo[db];
info ¬ DescribeI[dbinfo];
RETURN[info];
};
DescribeI: PUBLIC ENTRY PROC [dbinfo: OpenDBInfo] RETURNS [info: SchemaInfo] ~ {
ENABLE UNWIND => NULL;
srInfo: LoganBerrySunRPC.SchemaInfo;
srInfo ¬ LoganBerrySunRPCClient.Describe[dbinfo.h, nilconv, dbinfo.db];
info ¬ SrToSchemaInfo[srInfo];
};
IsLocal: PROC [db: LoganBerry.OpenDB] RETURNS [local: BOOL ¬ TRUE] = {
RETURN[FALSE];
};
PostSunError: PROC [code: ATOM] RETURNS [] ~ {
Simply turn SUN RPC errors into LoganBerry errors.
ERROR LoganBerry.Error[$CallFailed, IO.PutFR1["SUN RPC stub problem - %g.", IO.rope[SELECT code FROM
$timeout, $unreachable => "server unreachable",
$protocolError => "protocol error",
$wrongRPCVersion, $wrongProgram, $wrongProgramVersion, $wrongProc => "using wrong program, version, or procedure",
ENDCASE => "unknown error"
]]];
};
Handles
GetInfo: PROC [db: OpenDB] RETURNS [OpenDBInfo] ~ INLINE {
Unseals the database handle and ensures that it's valid.
ref: REF = RefID.Unseal[db];
IF ref = NIL THEN
ERROR LoganBerry.Error[$BadDBHandle, "NIL OpenDB handle."];
WITH ref SELECT FROM
dbinfo: OpenDBInfo => {
RETURN[dbinfo];
};
ENDCASE => ERROR LoganBerry.Error[$BadDBHandle, "Invalid OpenDB handle."];
};
GetCursorInfo: PROC [cursor: Cursor] RETURNS [CursorInfo] ~ INLINE {
Unseals the cursor and ensures that it's valid.
ref: REF = RefID.Unseal[cursor];
IF ref = NIL THEN
ERROR LoganBerry.Error[$BadCursor, "NIL cursor."];
WITH ref SELECT FROM
cinfo: CursorInfo => {
RETURN[cinfo];
};
ENDCASE => ERROR LoganBerry.Error[$BadCursor, "Invalid cursor."];
};
Data conversion
SrToEntry: PROC [srEntry: LoganBerrySunRPC.Entry] RETURNS [entry: LoganBerry.Entry] ~ {
entry ¬ NIL;
FOR i: CARDINAL DECREASING IN [0..srEntry.length) DO
attr: LoganBerry.Attribute ¬ [Atom.MakeAtom[srEntry[i].type], srEntry[i].value];
entry ¬ CONS[attr, entry];
ENDLOOP;
};
EntryToSr: PROC [entry: LoganBerry.Entry] RETURNS [srEntry: LoganBerrySunRPC.Entry] ~ {
count: CARDINAL ¬ 0;
FOR e: Entry ¬ entry, e.rest WHILE e # NIL DO
count ¬ count + 1;
ENDLOOP;
srEntry ¬ NEW[LoganBerrySunRPC.EntryObject[count]];
count ¬ 0;
FOR e: Entry ¬ entry, e.rest WHILE e # NIL DO
srEntry[count].type ¬ Atom.GetPName[e.first.type];
srEntry[count].value ¬ e.first.value;
count ¬ count + 1;
ENDLOOP;
};
SrToSchemaInfo: PROC [srInfo: LoganBerrySunRPC.SchemaInfo] RETURNS [info: LoganBerry.SchemaInfo] ~ {
SrToLogList: PROC [srLogs: LoganBerrySunRPC.LogList] RETURNS [logs: LIST OF LoganBerry.LogInfo] ~ {
logs ¬ NIL;
FOR i: CARDINAL DECREASING IN [0..srLogs.length) DO
loginfo: LoganBerry.LogInfo ¬ NEW[LoganBerry.LogInfoRec ¬ [srLogs[i].id, srLogs[i].file]];
logs ¬ CONS[loginfo, logs];
ENDLOOP;
};
SrToIndexList: PROC [srIndices: LoganBerrySunRPC.IndexList] RETURNS [indices: LIST OF LoganBerry.IndexInfo] ~ {
indices ¬ NIL;
FOR i: CARDINAL DECREASING IN [0..srIndices.length) DO
indexinfo: LoganBerry.IndexInfo ¬ NEW[LoganBerry.IndexInfoRec ¬ [Atom.MakeAtom[srIndices[i].key], srIndices[i].file, Atom.MakeAtom[srIndices[i].order]]];
indices ¬ CONS[indexinfo, indices];
ENDLOOP;
};
info ¬ NEW[LoganBerry.SchemaInfoRec ¬ [srInfo.dbName, SrToLogList[srInfo.logs], SrToIndexList[srInfo.indices]]];
};
Class registration
class: LoganBerryClass.Class;
Init: PROC ~ {
LoganBerryClass.Register[name: class.name, class: class];
};
class ¬ NEW[LoganBerryClass.ClassObject ¬ [
name: $SunRPCStub,
open: Open,
describe: Describe,
readEntry: ReadEntry,
enumerateEntries: EnumerateEntries,
generateEntries: GenerateEntries,
nextEntry: NextEntry,
endGenerate: EndGenerate,
writeEntry: WriteEntry,
deleteEntry: DeleteEntry,
close: Close,
buildIndices: BuildIndices,
compactLogs: CompactLogs,
isLocal: IsLocal,
classData: NIL
]];
Init[];
END.