
<<Protocol agent services for Larks and other lightweights>>
<<AgentImpl.mesa>>
<<Dan Swinehart February 2, 1984 9:27 am>>

DIRECTORY
Agent USING [ Authentication, AuthenticationRecord,
Authenticator, AuthenticatorLayout, Frob, FrobRecord, Principal ],
AgentRpcControl USING [ ExportInterface, InterfaceName ],
DESFace USING [ Block, Blocks, CBCCheckEncrypt, CorrectParity,
EncryptBlock, GetRandomKey, Key, nullKey ],
IO,
Log    USING [ Report, Problem ],
Names    USING [ CurrentPasskey, GetDefaultInstance, GetDefaultDetails, GetGVDetails, GVDetails, Results ],
PupDefs USING [ GetPupAddress, PupAddress ],
PupTypes USING [ PupHostID, PupNetID ],
Rope USING [ Length, Flatten, ROPE ],
RPC USING [ EncryptionKey, matchAllVersions, ShortROPE, VersionRange ],
RPCPkt USING [ Machine ],
RPCSecurity USING [ CopyPrincipal ],
UserProfile USING [ Token ]
;

AgentImpl: CEDAR PROGRAM
IMPORTS AgentRpcControl, DESFace, IO, Log, Names, PupDefs, Rope, RPCSecurity, UserProfile
EXPORTS Agent SHARES RPCSecurity = {
OPEN IO;

<<Authentication>>

blockSize: NAT = SIZE[DESFace.Block];
larkRegistry: Rope.ROPE = ".Lark";

Authenticate: PUBLIC PROC [ nonceId: LONG INTEGER, a, b: Agent.Principal  ]
RETURNS [ an: Agent.Frob,
ar: Agent.Frob ] = TRUSTED {
ka, kb: DESFace.Key _ DESFace.nullKey -- !!! --;
kx, ky, ck: DESFace.Key;
aLen: NAT=a.Length[];
bLen: NAT=b.Length[];
authenticator: Agent.Authenticator;
authentication: Agent.Authentication;
nBlks: NAT _ DESBlocks[SIZE[Agent.AuthenticatorLayout[aLen]]];
IF a=NIL OR b=NIL OR aLen=0 OR bLen=0 THEN {
Log.Problem["Authenticate: Null arguments", $System]; RETURN[NIL, NIL]; };
ar _ NEW[Agent.FrobRecord[nBlks*blockSize]];
authenticator _ LOOPHOLE[@ar[0]];
a _ a.Flatten[];
b _ b.Flatten[];
DESFace.CorrectParity[@ka];
DESFace.CorrectParity[@kb];
kx _ DESFace.GetRandomKey[];
ky _ DESFace.GetRandomKey[];
ck _ DESFace.GetRandomKey[];
-- Build and encrypt Authenticator --
DESFace.EncryptBlock[key: kb, from: Blk[LONG[@ky]], to: Blk[@authenticator.ky ]];
DESFace.EncryptBlock[key: kb, from: Blk[LONG[@ck]], to: Blk[@authenticator.ck ]];
authenticator.time _ 0;
RPCSecurity.CopyPrincipal[from: a, to: @(authenticator.a)];
DESFace.CBCCheckEncrypt[key: ky, nBlks: nBlks-2, from:  Blks[@authenticator.ck],
to: Blks[@authenticator.ck], seed:  [0,0,0,0] ];
<<Encrypt the whole thing for a's benefit>>
DESFace.CBCCheckEncrypt[key: kx, nBlks: nBlks, from:  Blks[@authenticator.ky],
to: Blks[@authenticator.ky], seed:  [0,0,0,0] ];
<<Build and encrypt Authentication>>
nBlks _ DESBlocks[SIZE[Agent.AuthenticationRecord[bLen]]];
an _ NEW[Agent.FrobRecord[nBlks*blockSize]];
authentication _ LOOPHOLE[@an[0]];
authentication.nonceId _ nonceId;
DESFace.EncryptBlock[key: ka, from: Blk[LONG[@kx]],to: Blk[@authentication.kx] ];
DESFace.EncryptBlock[key: ka, from: Blk[LONG[@ck]], to: Blk[@authentication.ck ]];
RPCSecurity.CopyPrincipal[from: b, to: @authentication.b];
DESFace.CBCCheckEncrypt[key: kx, nBlks: nBlks-2, from:  Blks[@authentication.ck],
to: Blks[@authentication.ck],  seed:  [0,0,0,0] ];
Log.Report[IO.PutFR["Authenticate[%s, to; %s]", rope[a], rope[b]], $System];
};

DESBlocks: PROC[len: NAT] RETURNS [nBlks: NAT] = { RETURN [
(len + blockSize - 1) / blockSize ];  };
Blk: PROC[p: LONG POINTER] RETURNS [LONG POINTER TO DESFace.Block] = 
TRUSTED INLINE { RETURN [LOOPHOLE[p]]; };
Blks: PROC[p: LONG POINTER] RETURNS [DESFace.Blocks] = 
TRUSTED INLINE { RETURN [LOOPHOLE[p]]; };

<<Binding>>

Vitae: PUBLIC PROC[
clientMachine: RPCPkt.Machine,
range: RPC.VersionRange_RPC.matchAllVersions,
interfaceType: RPC.ShortROPE ]
RETURNS [
serverMachine: RPCPkt.Machine_[[0],[0]],
clientRname: Agent.Principal,
clientInstance: RPC.ShortROPE_NIL,
serverInstance: RPC.ShortROPE_NIL
] = TRUSTED {
<<Implements everything but range check>>
machineInstance: RPC.ShortROPE;
serverMachineRope: RPC.ShortROPE;
pa: PupDefs.PupAddress;
clientDetails: Names.GVDetails;
results: Names.Results;
machineInstance _ Names.GetDefaultInstance[clientMachine, FALSE];
<<clientInstance _ Names.GetDefaultInstance[netAddress: clientMachine!ANY=>CONTINUE];>>
IF clientInstance=NIL THEN clientInstance _ machineInstance;
[results, clientDetails] _ Names.GetDefaultDetails[netAddress: clientMachine];
IF results#ok OR ~clientDetails.valid OR ~clientDetails.larkSpec THEN RETURN; 
clientRname _ clientDetails.connect;
serverInstance _ clientDetails.instance;
IF serverInstance = NIL THEN RETURN;
[results, clientDetails] _ Names.GetGVDetails[ serverInstance ];
IF results#ok OR ~clientDetails.valid THEN RETURN;
serverMachineRope _ clientDetails.connect;
pa _ PupDefs.GetPupAddress[[0,0], serverMachineRope];
serverMachine _ [net: pa.net, host: pa.host];
Log.Report[
IO.PutFR["Vitae[lark: %b, type: %s] -> [ rName: %s, client: %s, server: %s]",
card[clientMachine.host], rope[interfaceType], rope[clientRname], rope[clientInstance],
rope[serverInstance]], $System];
};


<<Initialization>>

myName: AgentRpcControl.InterfaceName = [
type: "Agent.Lark",
instance: UserProfile.Token[key: "AgentInstance", default: "Michaelson.Lark"]];
serverPassword: RPC.EncryptionKey = Names.CurrentPasskey[UserProfile.Token[
key: "AgentPassword", default: "MFLFLX"]];

AgentRpcControl.ExportInterface[
interfaceName: myName,
user: myName.instance,
password: serverPassword];

Log.Report[IO.PutFR["Agent exported as %s", rope[myName.instance]], $System];
}.