<> <> DIRECTORY Arpa USING [Address, nullAddress], ArpaExtras USING [IsBroadcast, IsMyAddress], ArpaIP USING [Buffer, GetUserBytes, SetUserBytes], ArpaUDP USING [AllocBuffers, Buffer, Buffers, Create, Destroy, Error, FreeBuffers, Get, GetLocalPort, GetSource, Kick, nullPort, Port, ReceivedError, Send, SendToSelf, SetGetTimeout, waitForever], ArpaUDPBuf USING [hdrBytes, maxBytes], Basics USING [FWORD, HWORD, HFromCard16, UnsafeBlock], PrincOpsUtils USING [ByteBlt], Process USING [Detach, PauseMsec, priorityForeground, SetPriority], RefText USING [New, ObtainScratch, ReleaseScratch, TrustTextRopeAsText], Rope USING [FromRefText, InlineFlatten, ROPE], SafeStorage USING [EnableFinalization, EstablishFinalization, FinalizationQueue, FQNext, NewFQ], SunRPC USING [GetCard32, PutCard32, ServerProc], SunRPCAuth USING [Authenticate, AuthenticateResult, CheckReplyVerifier, Conversation, Flavor, GetCredentialsAndNextVerifier, maxValueBytes, nullFlavor], SunRPCPrivate USING [Object, ObjectClass, ServerObject], SunRPCType USING [AcceptStat, AuthStat, MsgType, RejectStat, ReplyStat, rpcVersion] ; SunRPCImpl: CEDAR MONITOR LOCKS s USING s: Server IMPORTS ArpaExtras, ArpaIP, ArpaUDP, Basics, PrincOpsUtils, Process, RefText, Rope, SafeStorage, SunRPC, SunRPCAuth EXPORTS SunRPC ~ { OPEN RPCT: SunRPCType; <> ROPE: TYPE ~ Rope.ROPE; Address: TYPE ~ Arpa.Address; nullAddress: Address ~ Arpa.nullAddress; Port: TYPE ~ ArpaUDP.Port; nullPort: Port ~ ArpaUDP.nullPort; UnsafeBlock: TYPE ~ Basics.UnsafeBlock; ObjectClass: TYPE ~ SunRPCPrivate.ObjectClass; Handle: TYPE ~ REF Object; Object: PUBLIC TYPE ~ SunRPCPrivate.Object; Server: TYPE ~ REF ServerObject; ServerObject: PUBLIC TYPE ~ SunRPCPrivate.ServerObject; Conversation: TYPE ~ SunRPCAuth.Conversation; AuthFlavor: TYPE ~ SunRPCAuth.Flavor; nullFlavor: AuthFlavor ~ SunRPCAuth.nullFlavor; AuthValue: TYPE ~ REF TEXT; Error: PUBLIC ERROR [code: ATOM] ~ CODE; <> maxPull: CARDINAL ~ 50; dataBufBytes: CARDINAL ~ 2*maxPull; maxAuthBytes: CARDINAL ~ SunRPCAuth.maxValueBytes; maxRefTextLength: CARDINAL _ 8*1024; maxBLimit: CARDINAL ~ ArpaUDPBuf.maxBytes - (ArpaUDPBuf.maxBytes MOD 8); <> <> <> maxBuffersPerDatagram: CARDINAL _ 6; maxProcessesPerServer: CARDINAL ~ 6; maxRetries: CARDINAL _ 10; minTimeout: CARD _ 50; maxTimeout: CARD _ 30*1000; rwCacheSize: CARDINAL ~ 8; useSendToSelf: BOOL _ TRUE; -- DEBUG defaultReplyTTL: CARDINAL _ 5; -- seconds <> IPBuffer: PROC [b: ArpaUDP.Buffer] RETURNS [ArpaIP.Buffer] ~ TRUSTED INLINE { RETURN[LOOPHOLE[b]] }; Next: PROC [b: ArpaUDP.Buffer] RETURNS [ArpaUDP.Buffer] ~ TRUSTED INLINE { RETURN[LOOPHOLE[b.ovh.next]] }; TextPtrFromRefText: UNSAFE PROC [block: REF READONLY TEXT] RETURNS [LONG POINTER] ~ TRUSTED INLINE { RETURN[ LOOPHOLE[block, LONG POINTER] + SIZE[TEXT[0]] ] }; FPtrFromRefTextAndIndex: UNSAFE PROC [block: REF READONLY TEXT, index: CARDINAL] RETURNS [LONG POINTER TO Basics.FWORD] ~ TRUSTED -- INLINE -- { IF (index MOD 4) # 0 THEN ERROR; -- DEBUG RETURN [ LOOPHOLE[ LOOPHOLE[block, LONG POINTER] + SIZE[TEXT[0]] + index/BYTES[WORD]] ] }; HPtrFromRefTextAndIndex: UNSAFE PROC [block: REF READONLY TEXT, index: CARDINAL] RETURNS [LONG POINTER TO Basics.HWORD] ~ TRUSTED -- INLINE -- { IF (index MOD 2) # 0 THEN ERROR; -- DEBUG RETURN [ LOOPHOLE[ LOOPHOLE[block, LONG POINTER] + SIZE[TEXT[0]] + index/BYTES[WORD]] ] }; <> Create: PUBLIC PROC [remoteAddress: Address, remotePort: Port] RETURNS [h: Handle] ~ { h _ NEW[Object]; h.class _ network; h.dataBuf _ RefText.ObtainScratch[dataBufBytes]; h.udpHandle _ ArpaUDP.Create[sendBuffers~maxBuffersPerDatagram, recvBuffers~maxBuffersPerDatagram, acceptErrors~TRUE, acceptLongDatagrams~TRUE]; h _ SetRemote[h, remoteAddress, remotePort]; SafeStorage.EnableFinalization[h]; }; GetRemote: PUBLIC PROC [h: Handle] RETURNS [remoteAddress: Address, remotePort: Port] ~ { remoteAddress _ h.address; remotePort _ h.port; }; SetRemote: PUBLIC PROC [h: Handle, remoteAddress: Address, remotePort: Port] RETURNS [newH: Handle] ~ { h.address _ remoteAddress; h.port _ remotePort; h.addressIsMe _ ArpaExtras.IsMyAddress[remoteAddress]; newH _ h; }; Destroy: PUBLIC PROC [h: Handle] ~ { IF h.class # network THEN ERROR Error[$notNetworkHandle]; FreeTheBuffers[h]; IF h.dataBuf # NIL THEN { RefText.ReleaseScratch[h.dataBuf]; h.dataBuf _ NIL }; IF h.udpHandle # NIL THEN { ArpaUDP.Destroy[h.udpHandle]; h.udpHandle _ NIL }; }; FreeTheBuffers: PROC [h: Handle] ~ INLINE { IF h.bHead # NIL THEN { ArpaUDP.FreeBuffers[h.bHead]; h.bHead _ h.bTail _ NIL }; }; <> ofq: SafeStorage.FinalizationQueue; InitObjectFinalizer: PROC ~ { ofq _ SafeStorage.NewFQ[]; SafeStorage.EstablishFinalization[type: CODE[Object], npr: 0, fq: ofq]; TRUSTED { Process.Detach[FORK ObjectFinalizer[]] }; }; ObjectFinalizer: PROC = { Process.SetPriority[Process.priorityForeground]; DO Destroy[NARROW[SafeStorage.FQNext[ofq]]]; ENDLOOP; }; <> StartCall: PUBLIC PROC [h: Handle, c: Conversation, pgm, version, proc: CARD] ~ { cFlavor, vFlavor: AuthFlavor; credentials, verifier: AuthValue; FreeTheBuffers[h]; h.index _ h.limit _ 0; h.dataBuf.length _ h.dataBuf.maxLength; h.xid _ h.xid + 1; h.authData _ c; IF h.class # network THEN ERROR Error[$notNetworkHandle]; <> SunRPC.PutCard32[h, h.xid]; -- xid SunRPC.PutCard32[h, ORD[RPCT.MsgType.call]]; -- msgType SunRPC.PutCard32[h, RPCT.rpcVersion]; -- rpcvers SunRPC.PutCard32[h, pgm]; -- prog SunRPC.PutCard32[h, version]; -- vers SunRPC.PutCard32[h, proc]; -- proc [cFlavor, credentials, vFlavor, verifier] _ SunRPCAuth.GetCredentialsAndNextVerifier[c]; SunRPC.PutCard32[h, cFlavor]; SunRPC.PutCard32[h, credentials.length]; IF credentials.length > 0 THEN PutBlock[h, credentials, 0, credentials.length]; SunRPC.PutCard32[h, vFlavor]; SunRPC.PutCard32[h, verifier.length]; IF verifier.length > 0 THEN PutBlock[h, verifier, 0, credentials.length]; }; SendCallAndReceiveReply: PUBLIC PROC [h: Handle, timeoutMsec: CARD, retries: CARD] RETURNS [remoteAddress: Address, remotePort: Port] ~ { sB: ArpaUDP.Buffer; IF h.class # network THEN ERROR Error[$notNetworkHandle]; OutOfLinePush[h]; -- make sure all the data is in the send buffer IF (sB _ h.bHead) = NIL THEN ERROR Error[$outOfData]; ArpaIP.SetUserBytes[IPBuffer[h.bTail], h.bLimit]; h.bytesInSendBuffers _ h.bytesInSendBuffers + h.bLimit; h.bHead _ h.bTail _ NIL; sB.hdr2.length _ Basics.HFromCard16[h.bytesInSendBuffers]; [remoteAddress, remotePort] _ SendAndReceive[h, timeoutMsec, retries, sB]; }; ReceiveAnotherReply: PUBLIC PROC [h: Handle, timeoutMsec: CARD] RETURNS [remoteAddress: Address, remotePort: Port] ~ { IF h.class # network THEN ERROR Error[$notNetworkHandle]; [remoteAddress, remotePort] _ SendAndReceive[h, timeoutMsec, 0, NIL]; }; SendAndReceive: PROC [h: Handle, timeoutMsec: CARD, retries: CARD, sB: ArpaUDP.Buffer] RETURNS [remoteAddress: Address, remotePort: Port] ~ { errorCode: ATOM _ NIL; replyVerifier: AuthValue; timeoutMsec _ MAX[timeoutMsec, minTimeout]; retries _ MIN[retries, maxRetries]; IF retries > 0 THEN timeoutMsec _ MIN[timeoutMsec, maxTimeout]; IF sB # NIL THEN { IF h.addressIsMe AND useSendToSelf THEN { ArpaUDP.SendToSelf[sB, h.address, h.port]; sB _ NIL } ELSE ArpaUDP.Send[sB, h.address, h.port ! ArpaUDP.Error => { errorCode _ code; CONTINUE }]; }; IF errorCode = NIL THEN DO errorCode _ NIL; FreeTheBuffers[h]; ArpaUDP.SetGetTimeout[h.udpHandle, timeoutMsec]; h.bHead _ ArpaUDP.Get[h.udpHandle ! ArpaUDP.ReceivedError => { errorCode _ code; CONTINUE }]; SELECT errorCode FROM NIL => { IF h.bHead # NIL THEN { <> h.bIndex _ ArpaUDPBuf.hdrBytes; h.bLimit _ ArpaIP.GetUserBytes[IPBuffer[h.bHead]].bodyBytes; h.index _ h.limit _ 0; <> [remoteAddress, remotePort] _ ArpaUDP.GetSource[h.bHead]; IF remoteAddress # h.address THEN IF NOT ArpaExtras.IsBroadcast[h.address] THEN LOOP; <> { ENABLE Error => LOOP; returnedXid, returnedMsgType: CARD32; returnedXid _ SunRPC.GetCard32[h]; returnedMsgType _ SunRPC.GetCard32[h]; IF (returnedXid # h.xid) OR (returnedMsgType # ORD[RPCT.MsgType.reply]) THEN LOOP; }; <> { ENABLE Error => { errorCode _ $protocolError; EXIT }; replyStat, acceptStat, rejectStat, authStat: CARD32; replyFlavor: AuthFlavor; SELECT (replyStat _ SunRPC.GetCard32[h]) FROM ORD[RPCT.ReplyStat.msgAccepted] => { [replyFlavor, replyVerifier] _ GetAuth[h]; SELECT SunRPCAuth.CheckReplyVerifier[NARROW[h.authData], replyFlavor, replyVerifier] FROM ok => NULL; badVerifier => { errorCode _ $badReplyVerifier; EXIT }; wrongVerifier => { errorCode _ $wrongReplyVerifier; EXIT }; ENDCASE => ERROR; acceptStat _ SunRPC.GetCard32[h]; errorCode _ SELECT acceptStat FROM ORD[RPCT.AcceptStat.success] => NIL, -- winner! ORD[RPCT.AcceptStat.progUnavail] => $wrongProgram, ORD[RPCT.AcceptStat.progMismatch] => $wrongProgramVersion, ORD[RPCT.AcceptStat.procUnavail] => $wrongProc, ENDCASE => $protocolError; EXIT; }; ORD[RPCT.ReplyStat.msgDenied] => { SELECT (rejectStat _ SunRPC.GetCard32[h]) FROM ORD[RPCT.RejectStat.rpcMismatch] => { errorCode _ $wrongRPCVersion; EXIT; }; ORD[RPCT.RejectStat.authError] => { authStat _ SunRPC.GetCard32[h]; errorCode _ SELECT authStat FROM ORD[RPCT.AuthStat.authBadcred] => $badCredentials, ORD[RPCT.AuthStat.authRejectedcred] => $wrongCredentials, ORD[RPCT.AuthStat.authBadverf] => $badVerifier, ORD[RPCT.AuthStat.authRejectedverf] => $wrongVerifier, ORD[RPCT.AuthStat.authTooweak] => $weakCredentials, ENDCASE => $protocolError; EXIT; }; ENDCASE => { errorCode _ $protocolError; EXIT }; }; ENDCASE => { errorCode _ $protocolError; EXIT }; }; }; <> IF (retries > 0) AND (sB # NIL) THEN { retries _ retries - 1; IF h.addressIsMe AND useSendToSelf THEN { ArpaUDP.SendToSelf[sB, h.address, h.port]; sB _ NIL } ELSE ArpaUDP.Send[sB, h.address, h.port ! ArpaUDP.Error => { errorCode _ code; EXIT }]; LOOP; }; errorCode _ $timeout; EXIT; }; $timeoutTimeToLive, $timeoutReassembly, $sourceQuench => { LOOP; }; $netUnreachable, $hostUnreachable, $portUnreachable => { errorCode _ $unreachable; EXIT; }; ENDCASE => { errorCode _ $protocolError; EXIT; }; ENDLOOP; IF replyVerifier # NIL THEN { RefText.ReleaseScratch[replyVerifier]; replyVerifier _ NIL }; IF sB # NIL THEN { ArpaUDP.FreeBuffers[sB] }; IF errorCode # NIL THEN { FreeTheBuffers[h]; ERROR Error[errorCode] }; }; ReleaseReply: PUBLIC PROC [h: Handle] ~ { IF h.class # network THEN ERROR Error[$notNetworkHandle]; h.authData _ NIL; -- help finalization FreeTheBuffers[h]; }; <> CreateServer: PUBLIC PROC [pgm, version: CARD, serverProc: SunRPC.ServerProc, port: Port, concurrency: CARDINAL, clientData: REF] RETURNS [s: Server] ~ { buffers: CARDINAL; concurrency _ MAX[concurrency, 1]; concurrency _ MIN[concurrency, maxProcessesPerServer]; buffers _ maxBuffersPerDatagram * concurrency; s _ NEW[ServerObject[concurrency+1]]; s.pgm _ pgm; s.version _ version; s.udpHandle _ ArpaUDP.Create[localPort ~ port, sendBuffers~buffers, recvBuffers~buffers, getTimeout~ArpaUDP.waitForever]; s.clientData _ clientData; s.serverProc _ serverProc; FOR i: CARDINAL IN [0..concurrency+1) DO h: Handle _ NEW[Object]; h.class _ network; h.dataBuf _ RefText.ObtainScratch[dataBufBytes]; h.udpHandle _ s.udpHandle; s.handles[i] _ h; ENDLOOP; SafeStorage.EnableFinalization[s]; TRUSTED { Process.Detach[ FORK Serve[s] ] }; TRUSTED { Process.Detach[ FORK AgeResults[s] ] }; }; GetServerPort: PUBLIC PROC [s: Server] RETURNS [port: ArpaUDP.Port] ~ { RETURN[ ArpaUDP.GetLocalPort[s.udpHandle] ]; }; DestroyServer: PUBLIC ENTRY PROC [s: Server] ~ { s.dead _ TRUE; ArpaUDP.Kick[s.udpHandle]; <> }; <> <> droppedServers: CARD _ 0; finishedServers: CARD _ 0; sfq: SafeStorage.FinalizationQueue; InitServerFinalizer: PROC ~ { sfq _ SafeStorage.NewFQ[]; SafeStorage.EstablishFinalization[type: CODE[SunRPCPrivate.ServerObject], npr: 0, fq: sfq]; TRUSTED { Process.Detach[FORK ServerFinalizer[]] }; }; ServerFinalizer: PROC = { Process.SetPriority[Process.priorityForeground]; DO s: Server _ NARROW[SafeStorage.FQNext[sfq]]; IF NOT s.dead THEN { -- Can't happen unless the daemons have failed for some reason ... droppedServers _ droppedServers.SUCC; SafeStorage.EnableFinalization[s]; DestroyServer[s]; } ELSE { -- Normal end of life finishedServers _ finishedServers.SUCC; FOR i: CARDINAL IN [0 .. s.concurrencyPlusOne) DO h: Handle ~ s.handles[i]; IF h # NIL THEN { FreeTheBuffers[h]; IF h.dataBuf # NIL THEN { RefText.ReleaseScratch[h.dataBuf]; h.dataBuf _ NIL }; h.udpHandle _ NIL; }; ENDLOOP; IF s.udpHandle # NIL THEN { ArpaUDP.Destroy[s.udpHandle]; s.udpHandle _ NIL }; }; ENDLOOP; }; <> GetFreeHandle: ENTRY PROC [s: Server] RETURNS [handle: Handle] ~ { DO i: CARDINAL _ s.freeHandleIndex; bestTTL: CARDINAL _ CARDINAL.LAST; bestIndex: CARDINAL _ s.concurrencyPlusOne; THROUGH [0 .. s.concurrencyPlusOne) DO h: Handle; IF (i _ i + 1) >= s.concurrencyPlusOne THEN i _ 0; h _ s.handles[i]; IF (NOT h.busy) AND (h.ttl < bestTTL) THEN { bestTTL _ h.ttl; bestIndex _ i }; ENDLOOP; IF bestIndex < s.concurrencyPlusOne THEN { handle _ s.handles[bestIndex]; handle.busy _ TRUE; RETURN; }; IF s.dead THEN RETURN; WAIT s.freeHandle; ENDLOOP; }; GetThisFreeHandle: ENTRY PROC [s: Server, h: Handle] RETURNS [gotIt: BOOL] ~ { IF h.busy THEN RETURN [FALSE]; RETURN [h.busy _ TRUE]; }; NotifyFreeHandle: ENTRY PROC [s: Server, h: Handle] ~ { h.busy _ FALSE; BROADCAST s.freeHandle; }; AgeResults: PROC [s: Server] ~ { DO buffersToFree: ArpaUDP.Buffers; IF (buffersToFree _ AgeResultsInner[s]) # NIL -- NIL only if s.dead -- THEN ArpaUDP.FreeBuffers[buffersToFree]; IF s.dead THEN EXIT; Process.PauseMsec[1000]; ENDLOOP; }; AgeResultsInner: ENTRY PROC [s: Server] RETURNS [buffersToFree: ArpaUDP.Buffers] ~ { DO tail: ArpaUDP.Buffer _ NIL; FOR i: CARDINAL IN [0 .. s.concurrencyPlusOne) DO h: Handle ~ s.handles[i]; IF h.busy THEN LOOP; IF h.ttl > 0 THEN h.ttl _ h.ttl - 1; IF (h.ttl = 0) AND (h.bHead # NIL) THEN { IF buffersToFree = NIL THEN buffersToFree _ h.bHead ELSE tail.ovh.next _ h.bHead; tail _ h.bTail; h.bHead _ h.bTail _ NIL; }; ENDLOOP; IF (buffersToFree # NIL) OR s.dead THEN EXIT; WAIT s.freeHandle; ENDLOOP; }; Serve: PROC [s: Server] ~ { h: Handle _ GetFreeHandle[s]; WHILE NOT s.dead DO <> h.bHead _ ArpaUDP.Get[s.udpHandle -- ! ArpaUDP.ReceivedError => CONTINUE can't happen -- ]; IF h.bHead = NIL THEN LOOP; [h.address, h.port] _ ArpaUDP.GetSource[h.bHead]; h.addressIsMe _ ArpaExtras.IsMyAddress[h.address]; h.bIndex _ ArpaUDPBuf.hdrBytes; h.bLimit _ ArpaIP.GetUserBytes[IPBuffer[h.bHead]].bodyBytes; h.index _ h.limit _ 0; { ENABLE Error => CONTINUE; msgType: CARD32; h.xid _ SunRPC.GetCard32[h]; msgType _ SunRPC.GetCard32[h]; SELECT TRUE FROM (msgType # ORD[RPCT.MsgType.call]) => { NULL; }; ENDCASE => { isDuplicate: BOOL _ FALSE; finger: Handle; FOR i: CARDINAL IN [0 .. s.concurrencyPlusOne) DO finger _ s.handles[i]; IF (finger # h) AND (finger.xid = h.xid) AND (finger.port = h.port) AND (finger.address = h.address) AND (finger.ttl > 0) THEN { isDuplicate _ TRUE; EXIT }; ENDLOOP; IF isDuplicate THEN { IF GetThisFreeHandle[s, finger] THEN { SELECT TRUE FROM (finger.bHead # NIL) => { TRUSTED { Process.Detach[FORK SendDuplicateReply[s, finger]] }; }; ENDCASE => { TRUSTED { Process.Detach[FORK CallServerProcAndSendReply[s, h]] }; h _ finger; }; }; } ELSE -- not a duplicate -- { finger _ GetFreeHandle[s]; -- may block TRUSTED { Process.Detach[FORK CallServerProcAndSendReply[s, h]] }; h _ finger; }; }; }; IF h # NIL -- h=NIL only if s.dead -- THEN FreeTheBuffers[h]; ENDLOOP; }; SendDuplicateReply: PROC [s: Server, h: Handle] ~ { ArpaUDP.Send[h.bHead, h.address, h.port]; h.ttl _ MAX[h.ttl, defaultReplyTTL]; NotifyFreeHandle[s, h]; }; StartAcceptReply: PUBLIC PROC [h: Handle, acceptStat: CARD32] ~ { <> FreeTheBuffers[h]; h.index _ h.limit _ 0; SunRPC.PutCard32[h, h.xid]; -- xid SunRPC.PutCard32[h, ORD[RPCT.MsgType.reply]]; -- msgType SunRPC.PutCard32[h, ORD[RPCT.ReplyStat.msgAccepted]]; -- replyStat PutAuth[h, h.authFlavor, NARROW[h.authData]]; -- replyVerifier SunRPC.PutCard32[h, acceptStat]; -- acceptStat }; StartRejectReply: PUBLIC PROC [h: Handle, rejectStat: CARD32] ~ { <> FreeTheBuffers[h]; h.index _ h.limit _ 0; SunRPC.PutCard32[h, h.xid]; -- xid SunRPC.PutCard32[h, ORD[RPCT.MsgType.reply]]; -- msgType SunRPC.PutCard32[h, ORD[RPCT.ReplyStat.msgDenied]]; -- replyStat SunRPC.PutCard32[h, rejectStat]; -- rejectStat }; StartReply: PUBLIC PROC [h: Handle] ~ { IF h.class # network THEN ERROR Error[$notNetworkHandle]; StartAcceptReply[h, ORD[RPCT.AcceptStat.success]]; }; CallServerProcAndSendReply: PROC [s: Server, h: Handle] ~ { errorCode: ATOM; credentials, verifier: AuthValue; sendReply: BOOL _ TRUE; h.ttl _ defaultReplyTTL; BEGIN { ENABLE Error => { sendReply _ FALSE; GOTO Out }; rpcvers, prog, vers, proc: CARD32; cFlavor, vFlavor: AuthFlavor; authResult: SunRPCAuth.AuthenticateResult; conversation: Conversation; <> rpcvers _ SunRPC.GetCard32[h]; IF (rpcvers # RPCT.rpcVersion) THEN { errorCode _ $wrongRPCVersion; GOTO Reply }; <. There's nothing we can do with them yet, until we've examined the credentials and verifier, but that's the way they defined the protocol.>> prog _ SunRPC.GetCard32[h]; vers _ SunRPC.GetCard32[h]; proc _ SunRPC.GetCard32[h]; <> [cFlavor, credentials] _ GetAuth[h ! Error => { errorCode _ $badCredentials; GOTO Reply }]; <> [vFlavor, verifier] _ GetAuth[h ! Error => { errorCode _ $badVerifier; GOTO Reply }]; <> [authResult, h.authFlavor, h.authData, conversation] _ SunRPCAuth.Authenticate[cFlavor, credentials, vFlavor, verifier]; IF authResult # ok THEN { errorCode _ SELECT authResult FROM badCredentials => $badCredentials, wrongCredentials => $wrongCredentials, badVerifier => $badVerifier, wrongVerifier => $wrongVerifier, ENDCASE => ERROR; GOTO Reply; }; <> IF prog # s.pgm THEN { errorCode _ $wrongProgram; GOTO Reply }; IF vers # s.version THEN { errorCode _ $wrongProgramVersion; GOTO Reply }; <> [sendReply, h.ttl] _ s.serverProc[h, conversation, proc, s.clientData ! Error => { errorCode _ code; CONTINUE }]; EXITS Reply => NULL; }; { ENABLE Error => ERROR; SELECT errorCode FROM NIL => NULL; $wrongRPCVersion => { StartRejectReply[h, ORD[RPCT.RejectStat.rpcMismatch]]; SunRPC.PutCard32[h, RPCT.rpcVersion]; SunRPC.PutCard32[h, RPCT.rpcVersion]; }; $badCredentials => { StartRejectReply[h, ORD[RPCT.RejectStat.authError]]; SunRPC.PutCard32[h, ORD[RPCT.AuthStat.authBadcred]]; }; $wrongCredentials => { StartRejectReply[h, ORD[RPCT.RejectStat.authError]]; SunRPC.PutCard32[h, ORD[RPCT.AuthStat.authRejectedcred]]; }; $badVerifier => { StartRejectReply[h, ORD[RPCT.RejectStat.authError]]; SunRPC.PutCard32[h, ORD[RPCT.AuthStat.authBadverf]]; }; $wrongVerifier => { StartRejectReply[h, ORD[RPCT.RejectStat.authError]]; SunRPC.PutCard32[h, ORD[RPCT.AuthStat.authRejectedverf]]; }; $weakCredentials => { StartRejectReply[h, ORD[RPCT.RejectStat.authError]]; SunRPC.PutCard32[h, ORD[RPCT.AuthStat.authTooweak]]; }; $wrongProgram => { StartAcceptReply[h, ORD[RPCT.AcceptStat.progUnavail]]; }; $wrongProgramVersion => { StartAcceptReply[h, ORD[RPCT.AcceptStat.progMismatch]]; SunRPC.PutCard32[h, s.version]; SunRPC.PutCard32[h, s.version]; }; $wrongProc => { StartAcceptReply[h, ORD[RPCT.AcceptStat.procUnavail]]; }; $abortWithoutReturn => { sendReply _ FALSE; }; ENDCASE => { StartAcceptReply[h, ORD[RPCT.AcceptStat.garbageArgs]]; }; }; EXITS Out => NULL; END; IF sendReply THEN -- send the reply -- { OutOfLinePush[h]; IF h.bHead # NIL THEN { ArpaIP.SetUserBytes[IPBuffer[h.bTail], h.bLimit]; h.bytesInSendBuffers _ h.bytesInSendBuffers + h.bLimit; h.bHead.hdr2.length _ Basics.HFromCard16[h.bytesInSendBuffers]; IF h.addressIsMe AND useSendToSelf THEN { ArpaUDP.SendToSelf[h.bHead, h.address, h.port]; h.bHead _ h.bTail _ NIL; } ELSE { ArpaUDP.Send[h.bHead, h.address, h.port ! ArpaUDP.Error => CONTINUE]; }; }; } ELSE { FreeTheBuffers[h]; }; h.authData _ NIL; -- help finalization NotifyFreeHandle[s, h]; IF credentials # NIL THEN { RefText.ReleaseScratch[credentials]; credentials _ NIL }; IF verifier # NIL THEN { RefText.ReleaseScratch[verifier]; verifier _ NIL }; }; <> rwCache: Server _ NEW[ServerObject[rwCacheSize]]; AllocLocalHandle: ENTRY PROC [s: Server _ rwCache] RETURNS [h: Handle] ~ { IF rwCache.freeHandleIndex > 0 THEN { rwCache.freeHandleIndex _ rwCache.freeHandleIndex - 1; h _ rwCache.handles[rwCache.freeHandleIndex]; rwCache.handles[rwCache.freeHandleIndex] _ NIL; } ELSE { h _ NEW[Object]; }; h.class _ local; }; FreeLocalHandle: PROC [s: Server _ rwCache, h: Handle] ~ { IF h.class # local THEN ERROR Error[$notLocalHandle]; IF rwCache.freeHandleIndex < rwCacheSize THEN { rwCache.handles[rwCache.freeHandleIndex] _ h; rwCache.freeHandleIndex _ rwCache.freeHandleIndex + 1; }; h.dataBuf _ NIL; }; OpenReader: PUBLIC PROC [block: REF TEXT] RETURNS [h: Handle] ~ { h _ AllocLocalHandle[]; h.dataBuf _ block; h.index _ 0; h.limit _ block.length; }; CloseReader: PUBLIC PROC [h: Handle] ~ { IF h.class # local THEN ERROR Error[$notLocalHandle]; FreeLocalHandle[h~h]; }; OpenWriter: PUBLIC PROC [maxBytes: CARDINAL] RETURNS [h: Handle] ~ { dB: REF TEXT ~ RefText.New[maxBytes]; h _ AllocLocalHandle[]; h.dataBuf _ dB; h.index _ h.limit _ 0; dB.length _ dB.maxLength; }; CloseWriter: PUBLIC PROC [h: Handle] RETURNS [output: REF TEXT] ~ { IF h.class # local THEN ERROR Error[$notLocalHandle]; output _ h.dataBuf; h.dataBuf _ NIL; output.length _ h.limit; FreeLocalHandle[h~h]; }; <> Pull: PROC [h: Handle, bytes: CARDINAL] ~ INLINE { IF h.index + bytes > h.limit THEN OutOfLinePull[h, bytes]; }; IncGet: PROC [h: Handle, bytes: CARDINAL] ~ INLINE { h.index _ h.index + bytes; }; OutOfLinePull: PROC [h: Handle, bytesWanted: CARDINAL] ~ { <> <> <> dB: REF TEXT; bytesInDataBuf, newIndex: CARDINAL; IF h.class = local THEN ERROR Error[$outOfData]; dB _ h.dataBuf; newIndex _ (h.index MOD 4); bytesInDataBuf _ h.limit - h.index; IF (bytesInDataBuf + newIndex) <= h.index THEN { TRUSTED { bytesInDataBuf _ UnsafeGetBlockInner[h, [base~TextPtrFromRefText[dB], startIndex~newIndex, count~dB.maxLength-newIndex]] }; h.index _ newIndex; dB.length _ h.limit _ (newIndex + bytesInDataBuf); }; IF bytesInDataBuf < bytesWanted THEN ERROR Error[$outOfData]; }; BytesRemaining: PUBLIC PROC [h: Handle] RETURNS [bytes: CARDINAL] ~ { b: ArpaUDP.Buffer; bytes _ h.limit _ h.index; IF h.class = network THEN { IF (b _ h.bHead) # NIL THEN { bytes _ bytes + (h.bLimit - h.bIndex); b _ Next[b]; }; WHILE b # NIL DO bytes _ bytes + ArpaIP.GetUserBytes[IPBuffer[b]].bodyBytes; b _ Next[b]; ENDLOOP; }; }; GetByte: PUBLIC PROC [h: Handle] RETURNS [byte: BYTE] ~ { dB: REF TEXT ~ h.dataBuf; Pull[h, BYTES[BYTE]]; byte _ ORD[dB[h.index]]; IncGet[h, BYTES[BYTE]]; }; GetH: PUBLIC PROC [h: Handle] RETURNS [hword: Basics.HWORD] ~ { Pull[h, BYTES[Basics.HWORD]]; TRUSTED { hword _ (HPtrFromRefTextAndIndex[h.dataBuf, h.index])^ }; IncGet[h, BYTES[Basics.HWORD]]; }; GetF: PUBLIC PROC [h: Handle] RETURNS [fword: Basics.FWORD] ~ { Pull[h, BYTES[Basics.FWORD]]; TRUSTED { fword _ (FPtrFromRefTextAndIndex[h.dataBuf, h.index])^ }; IncGet[h, BYTES[Basics.FWORD]]; }; UnsafeGetBlock: PUBLIC UNSAFE PROC [h: Handle, block: UnsafeBlock] ~ UNCHECKED { IF UnsafeGetBlockInner[h, block] # block.count THEN ERROR Error[$outOfData]; }; UnsafeGetBlockInner: UNSAFE PROC [h: Handle, block: UnsafeBlock] RETURNS[bytesMoved: CARDINAL] ~ { <> bytesLeft: CARDINAL _ block.count; toOffset: CARDINAL _ block.startIndex; count: CARDINAL; IF bytesLeft = 0 THEN RETURN[0]; IF (count _ MIN[bytesLeft, h.limit - h.index]) > 0 THEN { TRUSTED { [] _ PrincOpsUtils.ByteBlt[to~[block.base, toOffset, toOffset+count], from~[TextPtrFromRefText[h.dataBuf], h.index, h.index+count]] }; toOffset _ toOffset + count; h.index _ h.index + count; bytesLeft _ bytesLeft - count; }; WHILE bytesLeft > 0 DO b: ArpaUDP.Buffer _ h.bHead; IF b = NIL THEN EXIT; IF (count _ MIN[bytesLeft, h.bLimit - h.bIndex]) > 0 THEN { TRUSTED { [] _ PrincOpsUtils.ByteBlt[to~[block.base, toOffset, toOffset+count], from~[@b.hdr2, h.bIndex, h.bIndex+count]] }; toOffset _ toOffset + count; h.bIndex _ h.bIndex + count; bytesLeft _ bytesLeft - count; IF h.index # h.limit THEN ERROR; -- DEBUG h.index _ h.limit _ ((h.index + count) MOD 4); }; IF h.bIndex >= h.bLimit THEN { h.bHead _ Next[b]; b.ovh.next _ NIL; ArpaUDP.FreeBuffers[b]; h.bIndex _ 0; IF h.bHead # NIL THEN h.bLimit _ ArpaIP.GetUserBytes[IPBuffer[h.bHead]].bodyBytes; }; ENDLOOP; RETURN[block.count - bytesLeft]; }; GetBlock: PUBLIC PROC [h: Handle, block: REF TEXT, startIndex, count: CARDINAL] ~ { actualCount: CARDINAL; IF startIndex > block.length THEN ERROR; count _ MIN[count, block.maxLength-startIndex]; TRUSTED { actualCount _ UnsafeGetBlockInner[h, [base~TextPtrFromRefText[block], startIndex~startIndex, count~count]] }; block.length _ startIndex + actualCount; IF actualCount # count THEN ERROR Error[$outOfData]; }; GetAlign: PUBLIC PROC [h: Handle] ~ { n: CARDINAL; IF (n _ (h.index MOD 4)) = 0 THEN RETURN; n _ 4 - n; Pull[h, n]; IncGet[h, n]; }; GetRefText: PUBLIC PROC [h: Handle] RETURNS [refText: REF TEXT] ~ { length: CARD _ SunRPC.GetCard32[h]; IF length > maxRefTextLength THEN ERROR Error[$outOfBufferSpace]; refText _ RefText.New[length]; GetBlock[h, refText, 0, length]; GetAlign[h]; }; GetEphemeralRefText: PUBLIC PROC [h: Handle, oldBuffer: REF TEXT] RETURNS [newBuffer: REF TEXT] ~ { length: CARD _ SunRPC.GetCard32[h]; IF length > maxRefTextLength THEN ERROR Error[$outOfBufferSpace]; SELECT TRUE FROM (oldBuffer = NIL) => { newBuffer _ RefText.ObtainScratch[length]; }; (oldBuffer.maxLength < length) => { RefText.ReleaseScratch[oldBuffer]; newBuffer _ RefText.ObtainScratch[length]; }; ENDCASE => { newBuffer _ oldBuffer; }; IF (newBuffer.length _ length) > 0 THEN { GetBlock[h, newBuffer, 0, length]; GetAlign[h]; }; }; GetRope: PUBLIC PROC [h: Handle] RETURNS [ROPE] ~ { temp: REF TEXT _ GetEphemeralRefText[h, NIL]; result: ROPE _ Rope.FromRefText[temp]; RefText.ReleaseScratch[temp]; RETURN [result]; }; GetAuth: PROC [h: Handle] RETURNS [flavor: AuthFlavor, value: AuthValue] ~ { <> flavor _ [SunRPC.GetCard32[h]]; value _ GetEphemeralRefText[h, NIL]; }; AllocFirstSendBuffer: PROC [h: Handle] RETURNS [b: ArpaUDP.Buffer] ~ { h.bIndex _ h.bLimit _ ArpaUDPBuf.hdrBytes; b _ h.bHead _ h.bTail _ ArpaUDP.AllocBuffers[h.udpHandle, 1]; h.sendBuffersInUse _ 1; h.bytesInSendBuffers _ 0; }; AllocNextSendBuffer: PROC [h: Handle] RETURNS [b: ArpaUDP.Buffer] ~ { IF (h.bLimit # maxBLimit) THEN ERROR; -- DEBUG ArpaIP.SetUserBytes[IPBuffer[h.bTail], h.bLimit]; IF h.sendBuffersInUse >= maxBuffersPerDatagram THEN ERROR Error[$outOfBufferSpace]; h.bytesInSendBuffers _ h.bytesInSendBuffers + h.bLimit; h.bIndex _ h.bLimit _ 0; b _ ArpaUDP.AllocBuffers[h.udpHandle, 1]; h.bTail.ovh.next _ b; h.bTail _ b; h.sendBuffersInUse _ h.sendBuffersInUse + 1; }; Push: PROC [h: Handle, bytes: CARDINAL] ~ INLINE { IF h.limit + bytes > h.dataBuf.maxLength THEN OutOfLinePush[h]; }; IncPut: PROC [h: Handle, bytes: CARDINAL] ~ INLINE { h.limit _ h.limit + bytes; }; OutOfLinePush: PROC [h: Handle] ~ { <> <> bytesLeft: CARDINAL; IF h.class = local THEN ERROR Error[$outOfBufferSpace]; IF (bytesLeft _ h.limit - h.index) > 0 THEN { b: ArpaUDP.Buffer; IF (b _ h.bTail) = NIL THEN b _ AllocFirstSendBuffer[h]; DO count: CARDINAL; IF (count _ MIN[bytesLeft, maxBLimit - h.bLimit]) > 0 THEN { TRUSTED { [] _ PrincOpsUtils.ByteBlt[to~[@b.hdr2, h.bLimit, h.bLimit+count], from~[TextPtrFromRefText[h.dataBuf], h.index, h.index + count]] }; h.bLimit _ h.bLimit + count; h.index _ h.index + count; bytesLeft _ bytesLeft - count; }; IF bytesLeft = 0 THEN EXIT; IF h.bLimit # maxBLimit THEN ERROR; -- DEBUG b _ AllocNextSendBuffer[h]; ENDLOOP; }; h.index _ h.limit _ (h.limit MOD 4); }; PutByte: PUBLIC PROC [h: Handle, byte: BYTE] ~ { dB: REF TEXT ~ h.dataBuf; Push[h, BYTES[BYTE]]; dB[h.limit] _ VAL[byte]; IncPut[h, BYTES[BYTE]]; }; PutH: PUBLIC PROC [h: Handle, hword: Basics.HWORD] ~ { Push[h, BYTES[Basics.HWORD]]; TRUSTED { HPtrFromRefTextAndIndex[h.dataBuf, h.limit]^ _ hword }; IncPut[h, BYTES[Basics.HWORD]]; }; PutF: PUBLIC PROC [h: Handle, fword: Basics.FWORD] ~ { Push[h, BYTES[Basics.FWORD]]; TRUSTED { FPtrFromRefTextAndIndex[h.dataBuf, h.limit]^ _ fword }; IncPut[h, BYTES[Basics.FWORD]]; }; UnsafePutBlock: PUBLIC UNSAFE PROC [h: Handle, block: UnsafeBlock] ~ { bytesLeft: CARDINAL _ block.count; fromOffset: CARDINAL _ block.startIndex; b: ArpaUDP.Buffer; IF bytesLeft = 0 THEN RETURN; IF h.class = local THEN { IF (h.limit + bytesLeft) <= h.dataBuf.maxLength THEN { TRUSTED { [] _ PrincOpsUtils.ByteBlt[to~[TextPtrFromRefText[h.dataBuf], h.limit, h.limit+bytesLeft], from~[block.base, fromOffset, fromOffset+bytesLeft]] }; h.limit _ h.limit + bytesLeft; RETURN; } ELSE { ERROR Error[$outOfBufferSpace]; }; }; OutOfLinePush[h]; IF (b _ h.bTail) = NIL THEN b _ AllocFirstSendBuffer[h]; DO count: CARDINAL; IF (count _ MIN[bytesLeft, maxBLimit - h.bLimit]) > 0 THEN { TRUSTED { [] _ PrincOpsUtils.ByteBlt[to~[@b.hdr2, h.bLimit, h.bLimit+count], from~[block.base, fromOffset, fromOffset+count]] }; fromOffset _ fromOffset + count; h.bLimit _ h.bLimit + count; bytesLeft _ bytesLeft - count; }; IF bytesLeft = 0 THEN EXIT; IF h.bLimit # maxBLimit THEN ERROR; -- DEBUG b _ AllocNextSendBuffer[h]; ENDLOOP; h.index _ h.limit _ (h.bLimit MOD 4); }; PutBlock: PUBLIC PROC [h: Handle, block: REF READONLY TEXT, startIndex: CARDINAL _ 0, count: CARDINAL] ~ TRUSTED { IF startIndex > block.length THEN ERROR; count _ MIN[count, block.length-startIndex]; UnsafePutBlock[h, [base~TextPtrFromRefText[block], startIndex~startIndex, count~count]]; }; PutAlign: PUBLIC PROC [h: Handle, padValue: BYTE] ~ { WHILE (h.limit MOD 4) # 0 DO PutByte[h, padValue]; ENDLOOP; }; PutRefText: PUBLIC PROC [h: Handle, refText: REF READONLY TEXT] ~ { SunRPC.PutCard32[h, refText.length]; PutBlock[h, refText, 0, refText.length]; PutAlign[h, 0]; }; PutRope: PUBLIC PROC [h: Handle, rope: ROPE] ~ { IF rope = NIL THEN { SunRPC.PutCard32[h, 0]; } ELSE TRUSTED { PutRefText[h, RefText.TrustTextRopeAsText[Rope.InlineFlatten[rope]]]; }; }; PutAuth: PROC [h: Handle, flavor: AuthFlavor, value: AuthValue] ~ { SunRPC.PutCard32[h, flavor]; IF value.length > maxAuthBytes THEN ERROR; SunRPC.PutCard32[h, value.length]; IF value.length > 0 THEN PutBlock[h, value, 0, value.length]; PutAlign[h, 0]; }; InitObjectFinalizer[]; InitServerFinalizer[]; }...