
<<RPC: Authentication and security facilities>>
<<RPCSecurity.mesa>>
<<Andrew Birrell  September 7, 1983 4:33 pm>>

DIRECTORY
BasicTime USING[ earliestGMT, GetClockPulses, Now, Period ],
BufferDefs USING[ PupBuffer ],
ConvertUnsafe USING[ ToRope ],
DESFace,
GVNames USING[ AuthenticateKey, CheckStamp ],
PrincOpsUtils USING[ IsBound, LongCOPY ],
PrincOps USING[ PsbNull ],
PupDefs USING[ AnyLocalPupAddress, PupRouterSendThis, ReturnFreePupBuffer],
PupTypes USING[ PupAddress ],
Rope USING[ Flatten, Length, Text ],
RPC USING[ AuthenticateFailed, Conversation, ConversationLevel, EncryptionKey, maxPrincipalLength, Principal, SecurityLevel, 
unencrypted ],
RPCInternal USING[ Authenticator, AuthenticatorObject, ConversationObject ],
RPCLupine USING[ DataLength, Dispatcher, GetStubPkt, Header, pktOverhead, RPCPkt, StubPkt ],
RPCPkt USING[ CallCount, ConnectionID, ConversationID, DispatcherDetails, Header, Machine, PktConversationID, PktExchange, PktID, 
pktLengthOverhead, SetupResponse ],
RPCPrivate USING[ rpcSocket, ReturnBuffer ];

RPCSecurity: MONITOR
IMPORTS BasicTime, ConvertUnsafe, DESFace, GVNames, PrincOpsUtils, PupDefs, Rope, RPC, RPCLupine, RPCPkt, RPCPrivate
EXPORTS RPC--encryption stuff--, RPCInternal--GetAuthenticator--, RPCLupine
SHARES RPCLupine =

BEGIN

Header: PUBLIC TYPE = RPCPkt.Header;

ConcreteHeader: PROC[abstract: LONG POINTER TO RPCLupine.Header]
RETURNS[LONG POINTER TO Header] = INLINE
{ RETURN[ abstract ] };

GiveBackBuffer: PROC[b: BufferDefs.PupBuffer] =
<<NOTE: calls of this must be made outside our monitor, because>>
<<RPCPrivate.ReturnBuffer acquires the EthernetDriver monitor,>>
<<and the EthernetDriver may call EnqueueRecvd which acquires>>
<<our monitor!>>
IF PrincOpsUtils.IsBound[RPCPrivate.ReturnBuffer]
THEN RPCPrivate.ReturnBuffer
ELSE PupDefs.ReturnFreePupBuffer;

CopyPrincipal: PROC[from: RPC.Principal, to: LONG POINTER] =
BEGIN
flat: Rope.Text = Rope.Flatten[from];
text: LONG POINTER TO TEXT = LOOPHOLE[flat];
PrincOpsUtils.LongCOPY[from: LOOPHOLE[text], to: to, nwords: SIZE[StringBody[text.length]]];
END;


-- ******** Conversation management ******** --

ConversationID:     PUBLIC TYPE = RPCPkt.ConversationID;

ConversationObject: PUBLIC TYPE = RPCInternal.ConversationObject;

Conversation:       TYPE = REF ConversationObject;

lastConversation:   ConversationID;

firstConversation:  PUBLIC RPCPkt.PktConversationID;

GenerateConversation: PUBLIC SAFE PROC RETURNS[conversation: Conversation] = TRUSTED
{ RETURN[EntryGenerate[none, , NIL, NIL, DESFace.nullKey, NIL]] };

EntryGenerate: ENTRY PROC[ level: RPC.SecurityLevel,
iv: DESFace.IV,
originator, responder: RPC.Principal,
convKey: DESFace.Key,
auth: RPCInternal.Authenticator]
RETURNS[ conversation: Conversation ] =
BEGIN
lastConversation.count.ls _ lastConversation.count.ls+1;
IF lastConversation.count.ls = 0
THEN lastConversation.count.ms _ lastConversation.count.ms+1;
conversation _ AddConversation[lastConversation,
level, iv, originator, responder,
convKey, auth];
END;

AuthenticatorLayout: TYPE = MACHINE DEPENDENT RECORD[
<<Contents of an authenticator when it's not encrypted>>
ky(0): DESFace.Key,
kySpare(4): DESFace.Key, -- space for larger keys! --
ck(8): DESFace.Key,
ckSpare(12): DESFace.Key, -- space for larger keys! --
time(16): LONG CARDINAL,
a(18): StringBody
];

BadConversationLevel: ERROR = CODE;

StartConversation: PUBLIC SAFE PROC[caller: RPC.Principal,
key: RPC.EncryptionKey,
callee: RPC.Principal,
level: RPC.ConversationLevel]
RETURNS[conversation: Conversation] = TRUSTED
BEGIN
authenticator: RPCInternal.Authenticator;
convKey: DESFace.Key;
iv: DESFace.IV;
IF level NOT IN RPC.ConversationLevel THEN ERROR BadConversationLevel[];
[authenticator, convKey, iv] _ Authenticate[caller, key, callee];
RETURN[ EntryGenerate[level, iv, caller, callee, convKey, authenticator] ]
END;

Authenticate: PROC[caller: RPC.Principal, key: RPC.EncryptionKey,
callee: RPC.Principal]
RETURNS[ authenticator: RPCInternal.Authenticator,
convKey: DESFace.Key,
iv: DESFace.IV] =
BEGIN
-- TEMP: This entire procedure should use a secure R-Server protocol! --
nBlks: CARDINAL = ( SIZE[AuthenticatorLayout] -
SIZE[StringBody[0]] +
SIZE[StringBody[caller.Length[]]] +
SIZE[DESFace.Block]-1 --rounding-- ) / SIZE[DESFace.Block];
IF caller.Length[] > RPC.maxPrincipalLength THEN ERROR RPC.AuthenticateFailed[badCaller];
IF callee.Length[] > RPC.maxPrincipalLength THEN ERROR RPC.AuthenticateFailed[badCallee];
SELECT GVNames.AuthenticateKey[caller, key] FROM
group, notFound => ERROR RPC.AuthenticateFailed[badCaller];
allDown => ERROR RPC.AuthenticateFailed[communications];
badPwd => ERROR RPC.AuthenticateFailed[badKey];
ENDCASE => NULL;
SELECT GVNames.CheckStamp[callee] FROM
group, notFound => ERROR RPC.AuthenticateFailed[badCallee];
allDown => ERROR RPC.AuthenticateFailed[communications];
ENDCASE => NULL;
iv _ DESFace.GetRandomIV[];
authenticator _ NEW[RPCInternal.AuthenticatorObject[nBlks]];
BEGIN
-- TEMP: construct authenticator in clear ourselves! --
kb: DESFace.Key _ DESFace.nullKey -- !!! --;
authRec: LONG POINTER TO AuthenticatorLayout = LOOPHOLE[@authenticator[0]];
authRec.ky _ DESFace.GetRandomKey[];
authRec.ck _ convKey _ DESFace.GetRandomKey[];
authRec.time _ 0;
CopyPrincipal[from: caller, to: @(authRec.a)];
DESFace.CorrectParity[@kb];
DESFace.EncryptBlock[key:  kb,
from: LOOPHOLE[@authRec.ck],
to:   LOOPHOLE[@authRec.ck] ];
DESFace.CBCCheckEncrypt[key:   authRec.ky,
nBlks: nBlks-2,
from:  LOOPHOLE[@authRec.ck],
to:    LOOPHOLE[@authRec.ck],
seed:  [0,0,0,0] ];
DESFace.EncryptBlock[key:  kb,
from: LOOPHOLE[@authRec.ky],
to:   LOOPHOLE[@authRec.ky] ];
END;
END;

ConvHashKey: TYPE = [0..127];

conversations: REF ARRAY ConvHashKey OF Conversation =
NEW[ARRAY ConvHashKey OF Conversation _ ALL[NIL]];

InconsistentHashTable: ERROR = CODE;

EntryAddConversation: ENTRY PROC[ id: ConversationID,
level: RPC.SecurityLevel,
iv: DESFace.IV,
originator, responder: RPC.Principal,
convKey: DESFace.Key,
auth: RPCInternal.Authenticator]
RETURNS[ conversation: Conversation ] = INLINE
{ RETURN[AddConversation[id, level, iv, originator, responder, convKey, auth]] };

AddConversation: INTERNAL PROC[ id: ConversationID,
level: RPC.SecurityLevel,
iv: DESFace.IV,
originator, responder: RPC.Principal,
convKey: DESFace.Key,
auth: RPCInternal.Authenticator]
RETURNS[ conversation: Conversation ] =
BEGIN
hash: ConvHashKey = id.count.ls MOD SUCC[LAST[ConvHashKey]];
prev: Conversation _ NIL;
conversation _ conversations[hash];
DO SELECT TRUE FROM
conversation = NIL =>
BEGIN
conversation _ NEW[ConversationObject _
[ NIL,
id,
level,
convKey,
iv,
originator,
responder,
auth] ];
IF prev = NIL
THEN conversations[hash] _ conversation
ELSE prev.next _ conversation;
EXIT;
END;
conversation.id = id =>
{ EXIT -- already there --};
ENDCASE => { prev _ conversation; conversation _ conversation.next };
ENDLOOP;
END;

UnknownConversation: ERROR = CODE;

EndConversation: PUBLIC ENTRY SAFE PROC[conversation: Conversation] = TRUSTED
BEGIN
hash: ConvHashKey = conversation.id.count.ls MOD SUCC[LAST[ConvHashKey]];
prev: Conversation _ NIL;
old: Conversation _ conversations[hash];
IF conversation.id.originator # myHost THEN RETURN WITH ERROR UnknownConversation[];
DO SELECT TRUE FROM
old = NIL => RETURN WITH ERROR UnknownConversation[];
old = conversation =>
BEGIN
IF prev = NIL
THEN conversations[hash] _ conversation.next
ELSE prev.next _ conversation.next;
EXIT;
END;
ENDCASE => { prev _ old; old _ old.next };
ENDLOOP;
END;

InvalidateConversations: INTERNAL PROC =
BEGIN
<<Invalidate conversations for which we are the originator, such that client will get an error if he uses them.>>
FOR hash: ConvHashKey IN ConvHashKey
DO FOR conversation: Conversation _ conversations[hash], conversation.next
UNTIL conversation = NIL
DO IF conversation.id.originator = myHost THEN conversation.id.originator _ [[0],[0]];
ENDLOOP;
ENDLOOP;
END;

GetConversationID: PUBLIC ENTRY SAFE PROC[conversation: Conversation]
RETURNS[id: ConversationID] = TRUSTED
{ RETURN[ IF conversation = NIL
THEN [[[0],[0]],[0,0]]
ELSE conversation.id ] };

GetCaller: PUBLIC ENTRY SAFE PROC[conversation: Conversation]
RETURNS[ RPC.Principal ] = TRUSTED
{ RETURN[ IF conversation = NIL THEN NIL ELSE conversation.originator ] };

GetLevel: PUBLIC ENTRY SAFE PROC[conversation: Conversation]
RETURNS[ level: RPC.SecurityLevel ] = TRUSTED
{ RETURN[ IF conversation = NIL THEN none ELSE conversation.level ] };


-- ******** Packet encryption and decryption ******** --

encryptedHeaderLength: CARDINAL =
SIZE[RPCPkt.PktID] + SIZE[RPCPkt.DispatcherDetails];

Check: TYPE = LONG CARDINAL; -- cipher checksum at end of packet --
-- bottom 2 bits indicate block rounding; remaining 30 bits should be 0 --

EncryptPkt: PUBLIC PROC[pkt: RPCLupine.RPCPkt, l: RPCLupine.DataLength]
RETURNS[CARDINAL] =
BEGIN
header: LONG POINTER TO RPCPkt.Header = @pkt.header;
conv: Conversation = pkt.convHandle;
IF conv # NIL AND conv.level # none AND conv.level # authOnly
THEN BEGIN
words: CARDINAL = l -- stub data words -- +
encryptedHeaderLength +
SIZE[Check];
nBlks: CARDINAL = (words + SIZE[DESFace.Block]-1 -- round up --)
/ SIZE[DESFace.Block];
blocks: DESFace.Blocks = LOOPHOLE[@header.pktID];
checkPtr: LONG POINTER TO Check = 
LOOPHOLE[@blocks[nBlks] - SIZE[Check]];
checkPtr^ _ nBlks * SIZE[DESFace.Block] - words;
SELECT conv.level FROM
ECB => DESFace.ECBEncrypt[conv.key, nBlks,
blocks,
blocks];
CBC => DESFace.CBCEncrypt[conv.key, nBlks,
blocks,
blocks,
conv.iv];
CBCCheck => DESFace.CBCCheckEncrypt[conv.key, nBlks,
blocks,
blocks,
conv.iv];
ENDCASE => ERROR;
RETURN[nBlks * SIZE[DESFace.Block] -
encryptedHeaderLength +
RPCPkt.pktLengthOverhead]
END
ELSE RETURN[l + RPCPkt.pktLengthOverhead]
END;

DecryptPkt: PUBLIC PROC[header: LONG POINTER TO RPCPkt.Header,
convHandle: Conversation]
RETURNS[ok: BOOLEAN, l: RPCLupine.DataLength] =
BEGIN
ok _ TRUE;
IF convHandle # NIL AND convHandle.level # none AND convHandle.level # authOnly
THEN BEGIN
nBlks: CARDINAL = (header.length - RPCPkt.pktLengthOverhead +
encryptedHeaderLength)
/ SIZE[DESFace.Block];
blocks: DESFace.Blocks = LOOPHOLE[@header.pktID];
checkPtr: LONG POINTER TO Check =  
LOOPHOLE[@blocks[nBlks] - SIZE[Check]];
SELECT convHandle.level FROM
ECB => DESFace.ECBDecrypt[convHandle.key, nBlks,
blocks,
blocks];
CBC => DESFace.CBCDecrypt[convHandle.key, nBlks,
blocks,
blocks,
convHandle.iv];
CBCCheck => DESFace.CBCCheckDecrypt[convHandle.key, nBlks,
blocks,
blocks,
convHandle.iv];
ENDCASE => ERROR;
IF checkPtr^ IN [0..SIZE[DESFace.Block])
THEN l _ nBlks * SIZE[DESFace.Block] -
checkPtr^ -
SIZE[Check] -
encryptedHeaderLength
ELSE ok _ FALSE;
END
ELSE l _ header.length - RPCPkt.pktLengthOverhead;
END;


-- ******** Requests-For-Authenticator's (RFA's) ******** --

RFARequest: TYPE = MACHINE DEPENDENT RECORD[
<<conversationID, {pktID}CK, nonceID>>
callerConv(0):    RPCPkt.PktConversationID,
callerPktID(2):   RPCPkt.PktID -- still encrypted --,
nonceID(6):       LONG CARDINAL -- nominated by requester --];

RFAResponse: TYPE = MACHINE DEPENDENT RECORD[
<<{iv, connectionID, callCount, nonceID+1}CK,>>
<<null, authScheme, authLength, authenticator, callee.>>
<<The initial part is encrypted with CBC using a zero IV.>>
iv(0):             DESFace.IV,
connection(4):     RPCPkt.ConnectionID,
call(8):           RPCPkt.CallCount,
nonceID(10):       LONG CARDINAL,
-- ends here if callee originated the conversation --
level(12):         RPC.SecurityLevel,
-- ends here if level = none --
authLength(13):    CARDINAL, -- length of authenticator (words) --
authenticator(14): AuthenticatorLayout
-- followed by Callee principal name --
];

responseCKBlocks: CARDINAL = 12 / SIZE[DESFace.Block];
<<Size of {iv, connectionID, callCount, nonceID+1}>>

rfaDataLength: RPCLupine.DataLength = SIZE[RFAResponse] - SIZE[StringBody[0]] +
2 * SIZE[StringBody[RPC.maxPrincipalLength]];

myHost: RPCPkt.Machine;  

GetConnectionState: PUBLIC PROC[ decrypted: BOOLEAN,
callPkt: RPCLupine.RPCPkt]
RETURNS[ ok: BOOLEAN,
id: RPCPkt.ConnectionID,
call: RPCPkt.CallCount,
conv: Conversation,
l: RPCLupine.DataLength] =
BEGIN
<<The RFA packet looks a lot like the first packet of a new call.>>
<<The response, a data packet, will look a lot like the result of>>
<<this call.>>
callHeader: LONG POINTER TO Header = @callPkt.header;
rfaPktSpace: ARRAY [1..rfaDataLength + RPCLupine.pktOverhead] OF WORD;
rfaPkt: RPCLupine.StubPkt = RPCLupine.GetStubPkt[@rfaPktSpace];
myNonceID: LONG CARDINAL = BasicTime.GetClockPulses[];
request:  LONG POINTER TO RFARequest =  LOOPHOLE[LONG[@(rfaPkt[0])]];
response: LONG POINTER TO RFAResponse = LOOPHOLE[LONG[@(rfaPkt[0])]];
rfaHeader: LONG POINTER TO Header = @rfaPkt.header;
request.callerConv _ callHeader.conv;
request.callerPktID _ callHeader.pktID; --still encrypted--
request.nonceID _ myNonceID;
rfaPkt.convHandle _ RPC.unencrypted;
rfaHeader^ _ ConcreteHeader[@callPkt.header]^;
RPCPkt.SetupResponse[rfaHeader];
rfaHeader.conv _ firstConversation;
rfaHeader.pktID.activity _ 0;
-- rfaHeader.pktID.callSeq will be set by PktExchange --
rfaHeader.pktID.pktSeq _ 0;
BEGIN
responseLength: RPCLupine.DataLength _
RPCPkt.PktExchange[rfaPkt, SIZE[RFARequest], rfaDataLength, authReq].newLength;
IF responseLength < SIZE[RFAResponse] - SIZE[AuthenticatorLayout]
THEN { ok _ FALSE; RETURN };
END;
IF response.level = none
THEN { l _ callHeader.length - RPCPkt.pktLengthOverhead; conv _ NIL }
ELSE BEGIN
<<response = {IV,cond,call,nonce}CK,,{KY}KB,{{CK}KB,time,A}KY>>
--TEMP-- kb: DESFace.Key _ DESFace.nullKey -- !!! --;
DESFace.CorrectParity[@kb];
DESFace.DecryptBlock[key: kb,
from: LOOPHOLE[@response.authenticator.ky],
to: LOOPHOLE[@response.authenticator.ky] ];
DESFace.CBCCheckDecrypt[key:   response.authenticator.ky,
nBlks: response.authLength/SIZE[DESFace.Block] - 2,
from:  LOOPHOLE[@response.authenticator.ck],
to:    LOOPHOLE[@response.authenticator.ck],
seed:  [0,0,0,0] ];
DESFace.DecryptBlock[key:  kb,
from: LOOPHOLE[@response.authenticator.ck],
to:   LOOPHOLE[@response.authenticator.ck] ];
DESFace.CBCCheckDecrypt[key:   response.authenticator.ck,
nBlks: responseCKBlocks,
from:  LOOPHOLE[response],
to:    LOOPHOLE[response],
seed:  [0,0,0,0] ];
conv _ EntryAddConversation[
-- Construct a ConversationID from a PktConversationID --
[IF response.connection.conv.originator = caller
THEN response.connection.caller
ELSE myHost,
[response.connection.conv.ls, response.connection.conv.ms]],
response.level,
response.iv,
ConvertUnsafe.ToRope[@response.authenticator.a],
NIL,
response.authenticator.ck,
NIL ];
callPkt.convHandle _ conv;
IF NOT decrypted
THEN BEGIN
ok: BOOLEAN;
[ok, l] _ DecryptPkt[callHeader, conv];
IF NOT ok THEN { ok _ FALSE; RETURN };
END;
END;
<<correctness of nonceID means he knows CK.>>
IF response.nonceID # myNonceID+1 THEN { ok _ FALSE; RETURN };
IF response.connection # [
callHeader.conv, callHeader.srceHost, callHeader.pktID.activity]
THEN { ok _ FALSE; RETURN };
IF response.call # callHeader.pktID.callSeq THEN { ok _ FALSE; RETURN };
RETURN[TRUE, response.connection, response.call, conv, l];
END;

ReplyToRFA: PUBLIC PROC[b: BufferDefs.PupBuffer,
callHeader: LONG POINTER TO RPCPkt.Header, -- encrypted --
callPktID: RPCPkt.PktID -- clear --,
convHandle: Conversation]
RETURNS[BOOLEAN] =
BEGIN
-- Remember BufferDefs.PupBuffer's don't look like RPCLupine.RPCPkt's! --
recvdHeader: LONG POINTER TO RPCPkt.Header = LOOPHOLE[@b.pupLength];
-- copy request out of buffer to avoid overwriting our args! --
request:  RFARequest = LOOPHOLE[recvdHeader+SIZE[RPCPkt.Header],
LONG POINTER TO RFARequest]^;
response: LONG POINTER TO RFAResponse = LOOPHOLE[recvdHeader+SIZE[RPCPkt.Header]];
used: CARDINAL _ SIZE[RFAResponse] - SIZE[AuthenticatorLayout];
IF request.callerConv # callHeader.conv OR request.callerPktID # callHeader.pktID
THEN { GiveBackBuffer[b]; RETURN[FALSE] };
response.connection _ [callHeader.conv, callHeader.srceHost, callPktID.activity];
response.call _ callPktID.callSeq;
response.nonceID _ request.nonceID+1;
IF callHeader.conv = firstConversation
THEN response.level _ none
ELSE BEGIN
IF callHeader.conv.originator = callee THEN --TEMP--ERROR;
response.level _ convHandle.level;
response.iv _ convHandle.iv;
DESFace.CBCCheckEncrypt[key:   convHandle.key,
nBlks: responseCKBlocks,
from:  LOOPHOLE[response],
to:    LOOPHOLE[response],
seed:  [0,0,0,0] ];
response.authLength _ convHandle.authenticator.nBlks * SIZE[DESFace.Block];
PrincOpsUtils.LongCOPY[from: @convHandle.authenticator[0],
to: @response.authenticator,
nwords: response.authLength];
used _ used +  response.authLength;
CopyPrincipal[from: convHandle.originator,
to: @response.authenticator+response.authLength];
used _ used + SIZE[StringBody[convHandle.originator.Length[]]];
END;
BEGIN
header: Header _ recvdHeader^;
RPCPkt.SetupResponse[@header];
header.length _ RPCPkt.pktLengthOverhead + used;
header.oddByte _ no;
header.type _ [0,rpc,end,dontAck,data];
header.pktID.pktSeq _ header.pktID.pktSeq+1;
header.srceHost _ myHost;
header.srceSoc _ RPCPrivate.rpcSocket;
header.srcePSB _ PrincOps.PsbNull;
recvdHeader^ _ header;
END;
PupDefs.PupRouterSendThis[b];
RETURN[TRUE]
END;


-- Initialization --

Initialize: ENTRY PROC =
BEGIN
myAddr: PupTypes.PupAddress _
PupDefs.AnyLocalPupAddress[RPCPrivate.rpcSocket];
now: MACHINE DEPENDENT RECORD[ls: CARDINAL, spare: [0..1], ms: [0..77777B]] =
LOOPHOLE[BasicTime.Period[from: BasicTime.earliestGMT, to: BasicTime.Now[]]];
firstHandle: Conversation;
myHost _ [myAddr.net, myAddr.host];
lastConversation _ [originator: myHost, count:[ls: now.ls, ms: now.ms] ];
<<Use first available conversationID for unencrypted conversations.>>
firstHandle _ AddConversation[lastConversation, none, , NIL, NIL,
DESFace.nullKey, NIL];
firstConversation _ [ls: firstHandle.id.count.ls, originator: caller,
ms: firstHandle.id.count.ms];
END; 

Restart: ENTRY PROC =
BEGIN
InvalidateConversations[];
END;

DO Initialize[]; STOP; Restart[]; ENDLOOP;

END.