AgentImpl.mesa
Copyright Ó 1987 by Xerox Corporation. All rights reserved.
Dan Swinehart April 2, 1987 6:23:27 pm PST
DIRECTORY
Agent USING [ Authentication, AuthenticationRecord,
Authenticator, AuthenticatorLayout, Frob, FrobRecord, Machine, Principal ],
AgentRpcControl USING [ ExportInterface, UnexportInterface ],
Commander USING [ CommandProc, Register ],
DESFace USING [ Block, Blocks, CBCCheckEncrypt, CorrectParity,
EncryptBlock, GetRandomKey, Key, nullKey ],
IO,
LupineRuntime USING [ BindingError ],
NameDB USING [ GetAttribute ],
Pup USING [ Host, nullHost, nullNet ],
PupHop USING [ GetRouting, RoutingTableEntry, unreachable ],
Rope USING [ Concat, Equal, Length, Flatten, ROPE ],
RPC USING [ EncryptionKey, ExportFailed, matchAllVersions, ShortROPE, VersionRange ],
RPCInternal USING [ CopyPrincipal ],
UserProfile USING [ Token ],
VoiceUtils USING [ CmdOrToken, CurrentPasskey, InstanceFromNetAddress, MakeRName, NetAddress, NetAddressFromRope, nullNetAddress, Report, Problem ]
;
AgentImpl: CEDAR PROGRAM
IMPORTS AgentRpcControl, Commander, DESFace, IO, LupineRuntime, NameDB, PupHop, Rope, RPC, RPCInternal, UserProfile, VoiceUtils
EXPORTS Agent = {
OPEN IO;
Authentication
blockSize: NAT = SIZE[DESFace.Block];
defaultServerInstance: Rope.ROPE
UserProfile.Token[key: "ThrushServerInstance", default: "Morley.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 {
VoiceUtils.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;
RPCInternal.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 ]];
RPCInternal.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] ];
VoiceUtils.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: Agent.Machine,
range: RPC.VersionRange←RPC.matchAllVersions,
interfaceType: RPC.ShortROPE ]
RETURNS [
serverMachine: Agent.Machine←[[0],[0]],
clientRname: Agent.Principal,
clientInstance: RPC.ShortROPE←NIL,
serverInstance: RPC.ShortROPE←NIL
] = TRUSTED {
Implements everything but range check
serverMachineRope: RPC.ShortROPE;
clientLarkHost: RPC.ShortROPE;
pa: VoiceUtils.NetAddress;
comment: Rope.ROPENIL;
dbInterfaceName: ROPE;
pa ← VoiceUtils.nullNetAddress;
pa.net ← clientMachine.net;
pa.host ← clientMachine.host;
clientInstance ← VoiceUtils.InstanceFromNetAddress[pa, "0"];
clientLarkHost ← VoiceUtils.InstanceFromNetAddress[pa, NIL];
clientRname ← NameDB.GetAttribute[clientLarkHost, $rname, NIL, $larkhost];
IF clientRname#NIL THEN {
dbInterfaceName ← NameDB.GetAttribute[clientRname, $interface];
IF ~interfaceType.Equal[dbInterfaceName, FALSE] THEN
comment ← comment.Concat[IO.PutFR["GV interface type is %s. ", rope[dbInterfaceName]]];
serverInstance ← NameDB.GetAttribute[clientRname, $instance]
};
IF serverInstance=NIL THEN serverInstance ← defaultServerInstance;
serverMachineRope ← NameDB.GetAttribute[serverInstance, $connect ];
IF serverMachineRope#NIL THEN {
pa ← VoiceUtils.NetAddressFromRope[serverMachineRope];
serverMachine ← [net: pa.net, host: pa.host];
}
ELSE comment ← comment.Concat["Instance has not been exported. "];
VoiceUtils.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];
IF comment#NIL THEN VoiceUtils.Report[IO.PutFR[" (%s)", rope[comment]], $System];
};
Routing Information
RoutingHostForHost: PUBLIC PROC[
clientMachine: Agent.Machine, -- Address of the requester.
targetMachine: Agent.Machine -- Address of the destination
]
RETURNS [routingMachine: Agent.Machine ← [Pup.nullNet, Pup.nullHost]] = {
From the client, what's the right host value to use in order to reach targetMachine. At present, this code assumes that clientMachine.net = localNet, which makes it possible to use the standard routing code in the Pup package.
routingTableEntry: PupHop.RoutingTableEntry;
IF clientMachine.net = targetMachine.net THEN RETURN[targetMachine]; -- why did you ask?
routingTableEntry ← PupHop.GetRouting[targetMachine.net];
IF routingTableEntry.hop >= PupHop.unreachable THEN RETURN;
routingMachine ← [routingTableEntry.immediate.net, routingTableEntry.immediate.host];
VoiceUtils.Report[
IO.PutFR["RoutingHostForHost[targetnet: %b] -> [ net: %b, host: %b]",
card[clientMachine.net], card[routingMachine.net], card[routingMachine.host]], $System];
};
Initialization
AgentInit: Commander.CommandProc = {
ENABLE
RPC.ExportFailed => { VoiceUtils.Problem["Agent export failed", $System]; GOTO Failed; };
instance: Rope.ROPE = VoiceUtils.MakeRName[
VoiceUtils.CmdOrToken[cmd: cmd, key: "AgentInstance", default: "Michaelson.Lark"], rName];
serverPassword: RPC.EncryptionKey = VoiceUtils.CurrentPasskey[
VoiceUtils.CmdOrToken[cmd: cmd, key: "AgentPassword", default: "MFLFLX"]];
AgentRpcControl.UnexportInterface[!LupineRuntime.BindingError=>CONTINUE];
AgentRpcControl.ExportInterface[
interfaceName: [ "Agent.Lark", instance],
user: instance,
password: serverPassword];
VoiceUtils.Report[IO.PutFR["Agent exported as %s", rope[instance]], $System];
EXITS Failed => NULL;
};
Commander.Register["Agent", AgentInit, "Agent <instance[Michaelson]> <password[...]>\nExport Registration/Authentication Agent"];
}.
Swinehart, May 23, 1986 3:26:05 pm PDT
Add RoutingHostForHost
changes to: DIRECTORY, AgentImpl, Vitae, RoutingHostForHost
Swinehart, April 2, 1987 6:12:37 pm PST
Adapt to new NameDB interface
changes to: DIRECTORY, AgentImpl, Vitae, blockSize