DIRECTORY
Basics USING [LongNumber],
CrRPC USING [Call, CreateClientHandle, DestroyClientHandle, Error, GetBYTE, GetCARDINAL, GetCHAR, GetFWORD, GetHAlign, GetHWORD, GetINTEGER, GetErrorProc, GetResultsProc, Handle, PutArgsProc, PutCARD, PutCARDINAL, PutCHAR, PutFWORD, PutHAlign, SetHops, SetTimeout],
DESFace USING [Block, CorrectParity, EncryptBlock, Key, nullKey],
Endian USING [BYTE, FWORD, HWORD],
IO USING [UnsafeBlock],
RefText USING [AppendChar, ObtainScratch, ReleaseScratch],
Rope USING [Concat, FromRefText, InlineFetch, Length, ROPE, SkipTo, Substr],
XNS USING [Address, broadcastNet, broadcastHost, Socket, unknownAddress],
XNSAddressParsing USING [AddressFromRope, RopeFromSocket],
XNSWKS USING [authenticationInfo, clearinghouse];
CrRPCTest:
CEDAR
PROGRAM
IMPORTS CrRPC, DESFace, RefText, Rope, XNSAddressParsing
~ {
CARD: TYPE ~ LONG CARDINAL;
BYTE: TYPE ~ Endian.BYTE;
FWORD: TYPE ~ Endian.FWORD;
HWORD: TYPE ~ Endian.HWORD;
ROPE: TYPE ~ Rope.ROPE;
Handle: TYPE ~ CrRPC.Handle;
GetXNSAddress:
PROC [h: Handle]
RETURNS [
XNS.Address] ~ {
xNet: FWORD;
xHost: MACHINE DEPENDENT RECORD [a, b, c: HWORD];
xSocket: HWORD;
xNet ← CrRPC.GetFWORD[h];
xHost.a ← CrRPC.GetHWORD[h];
xHost.b ← CrRPC.GetHWORD[h];
xHost.c ← CrRPC.GetHWORD[h];
xSocket ← CrRPC.GetHWORD[h];
TRUSTED {
RETURN [
[net~LOOPHOLE[xNet], host~LOOPHOLE[xHost], socket~LOOPHOLE[xSocket]] ] };
};
PutRope:
PROC [h: Handle, rope:
ROPE] ~ {
len: CARDINAL ~ Rope.Length[rope];
CrRPC.PutCARDINAL[h, len];
FOR i:
CARDINAL
IN [0..len)
DO
CrRPC.PutCHAR[h, Rope.InlineFetch[rope, i]];
ENDLOOP;
CrRPC.PutHAlign[h];
};
MarshalledRopeHWords:
PROC [rope:
ROPE]
RETURNS [hWords:
CARDINAL] ~ {
RETURN [ (Rope.Length[rope] + 3) / 2 ] };
GetRope:
PROC [h: Handle]
RETURNS [rope:
ROPE] ~ {
text: REF TEXT;
len: CARDINAL;
len ← CrRPC.GetCARDINAL[h];
text ← RefText.ObtainScratch[len];
FOR i:
INT
IN [0 .. len)
DO
text ← RefText.AppendChar[to~text, from~CrRPC.GetCHAR[h]]
ENDLOOP;
CrRPC.GetHAlign[h];
rope ← Rope.FromRefText[text];
RefText.ReleaseScratch[text];
};
SkipRope:
PROC [h: Handle] ~ {
len: CARDINAL ~ CrRPC.GetCARDINAL[h];
THROUGH [0 .. len)
DO
[] ← CrRPC.GetCHAR[h];
ENDLOOP;
CrRPC.GetHAlign[h];
};
CHName:
TYPE ~
RECORD [
org: ROPE,
dom: ROPE,
name: ROPE
];
defaultDom: ROPE ← "PARC";
defaultOrg: ROPE ← "Xerox";
SetDefaultDomain:
PROC [default:
ROPE] ~ {
defaultDom ← default };
SetDefaultOrg:
PROC [default:
ROPE] ~ {
defaultOrg ← default };
CHNameFromRope:
PROC [rope:
ROPE]
RETURNS [result: CHName] ~ {
pos: INT ← 0;
len: INT ~ Rope.Length[rope];
GetField:
PROC
RETURNS [field:
ROPE ←
NIL] ~ {
startPos: INT ← pos;
IF startPos >= len THEN RETURN;
pos ← Rope.SkipTo[s~rope, pos~startPos, skip~":"];
IF pos = startPos THEN RETURN;
field ← Rope.Substr[base~rope, start~startPos, len~pos-startPos];
pos ← pos + 1;
};
result.name ← GetField[];
result.dom ← GetField[];
result.org ← GetField[];
IF result.name = NIL THEN ERROR; -- FIX THIS LATER
IF result.dom = NIL THEN result.dom ← defaultDom;
IF result.org = NIL THEN result.org ← defaultOrg;
};
PutCHName:
PROC [h: Handle, chName: CHName] ~ {
PutRope[h, chName.org]; PutRope[h, chName.dom]; PutRope[h, chName.name];
};
GetCHName:
PROC [h: Handle]
RETURNS [chName: CHName] ~ {
chName.org ← GetRope[h];
chName.dom ← GetRope[h];
chName.name ← GetRope[h];
};
SkipCHName:
PROC [h: Handle] ~ {
[] ← SkipRope[h]; [] ← SkipRope[h]; [] ← SkipRope[h] };
GetCHError: CrRPC.GetErrorProc
[h: Handle, errNum: CARDINAL]
~ {
errArg: CARDINAL ← CrRPC.GetCARDINAL[h];
ERROR;
};
SimpleCredentials: TYPE ~ CHName;
simpleCredentialsType: CARDINAL ~ 0;
PutSimpleCredentials:
PROC [h: Handle, credentials: SimpleCredentials] ~ {
CrRPC.PutCARDINAL[h, simpleCredentialsType];
CrRPC.PutCARDINAL[h, MarshalledRopeHWords[credentials.org] + MarshalledRopeHWords[credentials.dom] + MarshalledRopeHWords[credentials.name]];
PutRope[h, credentials.org]; PutRope[h, credentials.dom]; PutRope[h, credentials.name];
};
SimpleVerifier: TYPE ~ CARDINAL;
PutSimpleVerifier:
PROC [h: Handle, verifier: SimpleVerifier] ~ {
CrRPC.PutCARDINAL[h, 1];
CrRPC.PutCARDINAL[h, verifier];
};
HashPassword:
PROC [password:
ROPE]
RETURNS [hashVal:
CARDINAL ← 0] ~ {
c: CHAR;
acc: Basics.LongNumber;
FOR i:
INT
IN [0 .. Rope.Length[password])
DO
c ← Rope.InlineFetch[password, i];
SELECT c
FROM
IN ['A .. 'Z] => c ← 'a + (c - 'A);
ENDCASE;
acc.hi ← hashVal; acc.lo ← ORD[c];
hashVal ← acc.lc MOD 65357;
ENDLOOP;
};
BlockFromPassword:
PROC [password:
ROPE, index, len:
INT,
to:
LONG
POINTER
TO DESFace.Block] ~ {
c: CHAR;
blockIndex: INT ← 0;
WHILE blockIndex < len
DO
c ← Rope.InlineFetch[password, index];
SELECT c
FROM
IN ['A .. 'Z] => c ← 'a + (c - 'A);
ENDCASE;
TRUSTED { to[blockIndex] ← ORD[c] };
index ← index + 1;
blockIndex ← blockIndex + 1;
ENDLOOP;
WHILE blockIndex < 4
DO
TRUSTED { to[blockIndex] ← 0 };
blockIndex ← blockIndex + 1;
ENDLOOP;
};
DBBlockFromPassword:
PROC [password:
ROPE, index, len:
INT]
RETURNS [block:
PACKED
ARRAY[0..8)
OF
BYTE] ~ {
TRUSTED { BlockFromPassword[password, index, len, LOOPHOLE[LONG[@block]]] };
RETURN;
};
StrongKeyFromPassword:
PROC [password:
ROPE]
RETURNS [strongKey:
PACKED ARRAY[0..8)
OF
BYTE] ~ {
index: INT;
passwordLen: INT ~ Rope.Length[password];
ki: DESFace.Key ← DESFace.nullKey;
bi: DESFace.Block;
biPlus1: DESFace.Block;
newbi: DESFace.Block;
FOR index ← 0, index + 4
WHILE index < passwordLen
DO
len: INT ~ MIN[4, passwordLen-index];
TRUSTED {
BlockFromPassword[password, index, len, @bi];
DESFace.CorrectParity[@ki];
DESFace.EncryptBlock[key~ki, from~@bi, to~LOOPHOLE[LONG[@ki]]] };
DESFace.EncryptBlock[key~ki, from~@bi, to~@biPlus1];
DESFace.EncryptBlock[key~ki, from~@biPlus1, to~@newbi];
ki ← LOOPHOLE[biPlus1] };
ENDLOOP;
TRUSTED { DESFace.CorrectParity[@ki] };
RETURN [ LOOPHOLE[ki] ];
};
TestDES:
PROC [k0, k1, k2, k3:
CARDINAL, d0, d1, d2, d3:
CARDINAL]
RETURNS [c0, c1, c2, c3:
CARDINAL] ~ {
k: DESFace.Block;
d: DESFace.Block;
c: DESFace.Block;
k[0] ← k0; k[1] ← k1; k[2] ← k2; k[3] ← k3;
d[0] ← d0; d[1] ← d1; d[2] ← d2; d[3] ← d3;
TRUSTED { DESFace.EncryptBlock[key~LOOPHOLE[k], from~@d, to~@c] };
RETURN [ c[0], c[1], c[2], c[3] ] };
AddressList: TYPE ~ LIST OF XNS.Address;
AddToAddressList:
PROC [new:
XNS.Address, list: AddressList]
RETURNS [AddressList] ~ {
FOR temp: AddressList ← list, temp.rest
WHILE temp #
NIL
DO
IF temp.first = new THEN RETURN [list];
ENDLOOP;
RETURN [ CONS[new, list] ];
};
FindAuthServer:
PROC [h: Handle]
RETURNS [answer:
XNS.Address ←
XNS.unknownAddress]
~ {
PutArgs: CrRPC.PutArgsProc ~ { NULL };
GetResults: CrRPC.GetResultsProc ~ {
n: CARDINAL ← CrRPC.GetCARDINAL[h];
IF (n > 0)
AND (answer =
XNS.unknownAddress)
THEN answer ← GetXNSAddress[h];
};
CrRPC.Call[
h~h, remotePgm~14, remotePgmVersion~2, remoteProc~0,
putArgs~PutArgs, getResults~GetResults
! CrRPC.Error => CONTINUE];
};
FindAuthServers:
PROC [h: Handle, oldList: AddressList]
RETURNS [newList: AddressList]
~ {
PutArgs: CrRPC.PutArgsProc ~ { NULL };
GetResults: CrRPC.GetResultsProc ~ {
n: CARDINAL ← CrRPC.GetCARDINAL[h];
IF n > 0 THEN newList ← AddToAddressList[GetXNSAddress[h], newList];
};
newList ← oldList;
CrRPC.Call[
h~h, remotePgm~14, remotePgmVersion~2, remoteProc~0,
putArgs~PutArgs, getResults~GetResults
! CrRPC.Error => CONTINUE];
};
FindCHServer:
PROC [h: Handle]
RETURNS [answer:
XNS.Address ←
XNS.unknownAddress]
~ {
PutArgs: CrRPC.PutArgsProc ~ { NULL };
GetResults: CrRPC.GetResultsProc ~ {
n: CARDINAL ← CrRPC.GetCARDINAL[h];
IF (n > 0)
AND (answer =
XNS.unknownAddress)
THEN answer ← GetXNSAddress[h];
};
CrRPC.Call[
h~h, remotePgm~2, remotePgmVersion~2, remoteProc~0,
putArgs~PutArgs, getResults~GetResults
! CrRPC.Error => CONTINUE];
};
FindCHServers:
PROC [h: Handle, oldList: AddressList]
RETURNS [newList: AddressList]
~ {
PutArgs: CrRPC.PutArgsProc ~ { NULL };
GetResults: CrRPC.GetResultsProc ~ {
n: CARDINAL ← CrRPC.GetCARDINAL[h];
IF n > 0 THEN newList ← AddToAddressList[GetXNSAddress[h], newList];
};
newList ← oldList;
CrRPC.Call[
h~h, remotePgm~2, remotePgmVersion~2, remoteProc~0,
putArgs~PutArgs, getResults~GetResults
! CrRPC.Error => CONTINUE];
};
CheckSimpleCredentials:
PROC [
h: Handle, credentials: SimpleCredentials, verifier: SimpleVerifier]
RETURNS [ok:
BOOL]
~ {
PutArgs: CrRPC.PutArgsProc ~ {
PutSimpleCredentials[h, credentials];
PutSimpleVerifier[h, verifier] };
GetResults: CrRPC.GetResultsProc ~ {
ok ← (CrRPC.GetCARDINAL[h] # 0) };
CrRPC.Call[
h~h, remotePgm~14, remotePgmVersion~2, remoteProc~2,
putArgs~PutArgs, getResults~GetResults
];
};
GetStrongCredentials:
PROC [
h: Handle, iCHName, rCHName: CHName, nonce:
CARD]
RETURNS [answer:
INTEGER ← -1]
~ {
PutArgs: CrRPC.PutArgsProc ~ {
PutCHName[h, iCHName];
PutCHName[h, rCHName];
CrRPC.PutCARD[h, nonce] };
GetResults: CrRPC.GetResultsProc ~ {
answer ← CrRPC.GetINTEGER[h] };
CrRPC.Call[
h~h, remotePgm~14, remotePgmVersion~2, remoteProc~1,
putArgs~PutArgs, getResults~GetResults
];
};
CHPropID: TYPE ~ LONG CARDINAL;
The following are STRANGE because of a BUG in the way CH V 2 marshalls/unmarshalls its PropIDs:
GetCHPropID:
PROC [h: Handle]
RETURNS [CHPropID] ~ {
RETURN [ LOOPHOLE[CrRPC.GetFWORD[h]] ] };
PutCHPropID:
PROC [h: Handle, propID: CHPropID] ~ {
CrRPC.PutCARD[h, LOOPHOLE[propID]] };
ListProperties:
PROC [
h: Handle, pattern: CHName, credentials: SimpleCredentials, verifier: SimpleVerifier]
RETURNS [properties:
LIST
OF CHPropID]
~ {
PutArgs: CrRPC.PutArgsProc ~ {
PutCHName[h, pattern];
PutSimpleCredentials[h, credentials];
PutSimpleVerifier[h, verifier] };
GetResults: CrRPC.GetResultsProc ~ {
nProps: CARDINAL;
SkipCHName[h];
nProps ← CrRPC.GetCARDINAL[h];
properties ← NIL;
THROUGH [0 .. nProps)
DO
properties ← CONS[GetCHPropID[h], properties];
ENDLOOP;
};
CrRPC.Call[
h~h, remotePgm~2, remotePgmVersion~2, remoteProc~15,
putArgs~PutArgs, getResults~GetResults, getError~GetCHError
];
};
GetCHItemProc: TYPE ~ PROC [h: Handle, nBytesReceived: INT] RETURNS [nBytesRead: INT];
RetrieveItemInner:
PROC [
h: Handle, pattern: CHName, propID: CHPropID, credentials: SimpleCredentials, verifier: SimpleVerifier, getCHItem: GetCHItemProc]
RETURNS [nBytesReceived, nBytesRead:
INT] ~ {
PutArgs: CrRPC.PutArgsProc ~ {
PutCHName[h, pattern];
PutCHPropID[h, propID];
PutSimpleCredentials[h, credentials];
PutSimpleVerifier[h, verifier] };
GetResults: CrRPC.GetResultsProc ~ {
SkipCHName[h];
nBytesReceived ← CrRPC.GetCARDINAL[h] * 2;
nBytesRead ← getCHItem[h, nBytesReceived];
THROUGH [nBytesRead .. nBytesReceived)
DO
[] ← CrRPC.GetBYTE[h];
ENDLOOP;
};
CrRPC.Call[
h~h, remotePgm~2, remotePgmVersion~2, remoteProc~16,
putArgs~PutArgs, getResults~GetResults, getError~GetCHError
];
};
RetrieveAddress:
PROC [
h: Handle, pattern: CHName, credentials: SimpleCredentials, verifier: SimpleVerifier]
RETURNS [address:
XNS.Address ←
XNS.unknownAddress] ~ {
GetAddress: GetCHItemProc ~ {
numAddresses: INT;
IF nBytesReceived < 2 THEN RETURN[0];
numAddresses ← CrRPC.GetCARDINAL[h];
IF (numAddresses < 1)
OR (nBytesReceived # (2 + (numAddresses *
SIZE[
XNS.Address] * 2)))
THEN -- RETURN[2] -- ERROR;
address ← GetXNSAddress[h];
THROUGH [1..numAddresses) DO [] ← GetXNSAddress[h] ENDLOOP;
RETURN[nBytesReceived];
};
[] ← RetrieveItemInner[h~h, pattern~pattern, propID~4 -- nsAddress -- , credentials~credentials, verifier~verifier, getCHItem~GetAddress];
};
FindServer:
PROC [socket:
XNS.Socket, proc:
PROC [Handle]
RETURNS [
XNS.Address]]
RETURNS [answer:
XNS.Address ←
XNS.unknownAddress] ~ {
h: Handle;
h ← CrRPC.CreateClientHandle[
class~$EXCHANGE,
remote~[net~XNS.broadcastNet, host~XNS.broadcastHost, socket~socket],
timeoutMsec~200];
BEGIN
FOR hops:
CARDINAL
IN [0..3]
DO
h ← CrRPC.SetHops[h~h, low~hops, high~hops];
h ← CrRPC.SetTimeout[h, 200 + 300 * hops];
THROUGH [0..4)
DO
IF (answer ← proc[h]) #
XNS.unknownAddress
THEN GOTO Found;
ENDLOOP;
ENDLOOP;
END;
CrRPC.DestroyClientHandle[h];
};
FindServers:
PROC [
socket:
XNS.Socket,
proc:
PROC [Handle, AddressList]
RETURNS [AddressList]
] RETURNS [answer: AddressList ← NIL] ~ {
h: Handle;
h ← CrRPC.CreateClientHandle[
class~$EXCHANGE,
remote~[net~XNS.broadcastNet, host~XNS.broadcastHost, socket~socket],
timeoutMsec~200];
FOR hops:
CARDINAL
IN [0..2]
DO
h ← CrRPC.SetHops[h~h, low~hops, high~hops];
h ← CrRPC.SetTimeout[h, 200 + 300 * hops];
THROUGH [0..4)
DO
answer ← proc[h, answer];
ENDLOOP;
ENDLOOP;
CrRPC.DestroyClientHandle[h];
};
DBAuthFind:
PROC
RETURNS [
XNS.Address] ~ {
RETURN [FindServer[socket~XNSWKS.authenticationInfo, proc~FindAuthServer]] };
DBAuthFindAll:
PROC
RETURNS [AddressList] ~ {
RETURN [FindServers[socket~XNSWKS.authenticationInfo, proc~FindAuthServers]] };
DBCHFind:
PROC
RETURNS [
XNS.Address] ~ {
RETURN [FindServer[socket~XNSWKS.clearinghouse, proc~FindCHServer]] };
DBCHFindAll:
PROC
RETURNS [AddressList] ~ {
RETURN [FindServers[socket~XNSWKS.clearinghouse, proc~FindCHServers]] };
DBCheckSimpleCredentials:
PROC [destRope:
ROPE, name:
ROPE, password:
ROPE]
RETURNS [ok:
BOOL]
~ {
h: Handle;
h ← CrRPC.CreateClientHandle[
class~$SPP,
remote~XNSAddressParsing.AddressFromRope[destRope],
timeoutMsec~20000];
ok ← CheckSimpleCredentials[
h, CHNameFromRope[name], HashPassword[password]];
CrRPC.DestroyClientHandle[h];
};
DBListProperties:
PROC [destRope:
ROPE, pattern:
ROPE, name:
ROPE, password:
ROPE]
RETURNS [properties:
LIST
OF CHPropID]
~ {
h: Handle;
h ← CrRPC.CreateClientHandle[
class~$SPP,
remote~XNSAddressParsing.AddressFromRope[destRope],
timeoutMsec~20000];
properties ← ListProperties[
h, CHNameFromRope[pattern], CHNameFromRope[name], HashPassword[password]];
CrRPC.DestroyClientHandle[h];
};
DBRetrieveAddress:
PROC [destRope:
ROPE, pattern:
ROPE, name:
ROPE, password:
ROPE]
RETURNS [address:
XNS.Address]
~ {
h: Handle;
h ← CrRPC.CreateClientHandle[
class~$SPP,
remote~XNSAddressParsing.AddressFromRope[destRope],
timeoutMsec~20000];
address ← RetrieveAddress[
h, CHNameFromRope[pattern], CHNameFromRope[name], HashPassword[password]];
CrRPC.DestroyClientHandle[h];
};
DBERetrieveAddress:
PROC [destRope:
ROPE, pattern:
ROPE, name:
ROPE, password:
ROPE]
RETURNS [address:
XNS.Address]
~ {
h: Handle;
h ← CrRPC.CreateClientHandle[
class~$EXCHANGE,
remote~XNSAddressParsing.AddressFromRope[destRope],
timeoutMsec~1500];
address ← RetrieveAddress[
h, CHNameFromRope[pattern], CHNameFromRope[name], HashPassword[password]];
CrRPC.DestroyClientHandle[h];
};
DoIt:
PROC [destRope, initiator, recipient:
ROPE]
RETURNS [answer:
INTEGER] ~ {
h: Handle;
h ← CrRPC.CreateClientHandle[
class~$SPP,
remote~XNSAddressParsing.AddressFromRope[destRope],
timeoutMsec~20000];
answer ← GetStrongCredentials[
h, CHNameFromRope[initiator], CHNameFromRope[recipient], 17];
CrRPC.DestroyClientHandle[h];
};
}.