SunRPCBindingImpl.mesa
Copyright Ó 1992 by Xerox Corporation. All rights reserved.
Michael Plass, January 8, 1992 2:08 pm PST
Chauser, January 7, 1992 3:56 pm PST
DIRECTORY Arpa, Atom, Basics, Convert, NetworkName, Prop, Rope, SunPMap, SunPMapClient, SunPMapLocal, SunRPC, SunRPCAuth, SunRPCBinding, SunRPCOnNetworkStream, SunRPCOnUDP;
~
BEGIN
ROPE: TYPE ~ Rope.ROPE;
ErrorCode: TYPE ~ SunRPCBinding.ErrorCode;
Error:
PUBLIC
ERROR [errorCode: ErrorCode, explanation:
ROPE, propList: Prop.PropList ¬
NIL] ~
CODE;
AtomFromErrorCode:
PUBLIC
PROC [e: ErrorCode]
RETURNS [
ATOM] ~ {
RETURN [ SELECT e FROM $ok => $ok, $someError => $someError, $nameLookupFailed => $nameLookupFailed, $registryNotAvailable => $registryNotAvailable, $registrationFailed => $registrationFailed, $serviceNotAvailable => $serviceNotAvailable, $authenticationProblem => $authenticationProblem, $protocolError => $protocolError, $timeout => $timeout, $brokenConnection => $brokenConnection, $notSupported => $notSupported, ENDCASE => NIL ]
};
TranslateSunRPCError:
PROC [code:
ATOM, fn:
ROPE, default: ErrorCode] ~ {
e: ErrorCode ¬ default;
p: Prop.PropList ¬ LIST[[$SunRPCError, code]];
SELECT code
FROM
$protocol, $protocolError, $wrongRPCVersion, $wrongProgram, $wrongProgramVersion, $wrongProc => {e ¬ $protocolError};
$unreachable => {e ¬ $registryNotAvailable};
$timeout => {e ¬ $timeout};
ENDCASE;
ERROR Error[e, Rope.Cat[fn, " ", Atom.GetPName[AtomFromErrorCode[e]], ", ", Atom.GetPName[code]], p];
};
Import:
PUBLIC
PROC [hostName:
ROPE, pgm:
INT, version:
INT, instance:
ROPE, transport: SunRPCBinding.Transport ¬ $UDP, nameServiceFlavor:
ATOM ¬
NIL, registry: SunRPCBinding.Registry ¬ $PortMapper]
RETURNS [handle: SunRPC.Handle] ~ {
ENABLE {
SunRPC.Error => TranslateSunRPCError[code, "SunRPC Error in SunRPCBinding.Import", $someError];
SunRPCAuth.Error => TranslateSunRPCError[code, "SunRPCAuth Error in SunRPCBinding.Import", $authenticationProblem];
NetworkName.Error => ERROR Error[$nameLookupFailed, msg, LIST[[$NetworkNameError, codes]]];
};
IF registry # $PortMapper THEN ERROR Error[$notSupported, "requested registry not supported"];
SELECT transport
FROM
$UDP => {
addrRope: ROPE ~ NetworkName.AddressFromName[family: $ARPA, name: hostName, components: host, serviceFlavor: nameServiceFlavor].addr;
address: Arpa.Address ~ Convert.ArpaAddressFromRope[addrRope];
rh: SunRPC.Handle ~ SunRPCOnUDP.Create[address, Basics.HFromCard16[SunPMap.udpPort]];
c: SunRPCAuth.Conversation ~ SunRPCAuth.Initiate[];
port: CARDINAL ~ SunPMapClient.GetPort[rh, c, pgm, version, SunPMap.ipProtocolUDP];
IF port = 0 THEN ERROR Error[$serviceNotAvailable, "requested service not available"];
handle ¬ SunRPCOnUDP.SetRemote[rh, address, Basics.HFromCard16[Basics.LowHalf[port]]];
SunRPCAuth.Terminate[c];
};
$TCP => {
addrRope: ROPE ~ NetworkName.AddressFromName[family: $ARPA, name: hostName, components: host, serviceFlavor: nameServiceFlavor].addr;
address: Arpa.Address ~ Convert.ArpaAddressFromRope[addrRope];
rh: SunRPC.Handle ~ SunRPCOnUDP.Create[address, Basics.HFromCard16[SunPMap.udpPort]];
c: SunRPCAuth.Conversation ~ SunRPCAuth.Initiate[];
port: CARDINAL ~ SunPMapClient.GetPort[rh, c, pgm, version, SunPMap.ipProtocolTCP];
addrAndPortRope: ROPE ~ NetworkName.AddressFromName[family: $ARPA, name: addrRope, components: hostAndPort, portHint: Convert.RopeFromInt[port], serviceFlavor: nameServiceFlavor].addr;
IF port = 0 THEN ERROR Error[$serviceNotAvailable, "requested service not available"];
handle ¬ SunRPCOnNetworkStream.Create[protocolFamily: $ARPA, remote: addrAndPortRope];
SunRPC.Destroy[rh];
SunRPCAuth.Terminate[c];
};
ENDCASE => ERROR;
};
PortFromNetworkStreamServer:
PROC [s: SunRPC.Server]
RETURNS [
CARD] ~ {
rope: ROPE ~ NetworkName.AddressFromName[family: $ARPA, name: SunRPCOnNetworkStream.GetServerAddress[s].local, components: port].addr;
IF Rope.Match[":*", rope] THEN RETURN [Convert.CardFromRope[Rope.Substr[rope, 1]]] ELSE ERROR;
};
Export:
PUBLIC
PROC [unboundServer: SunRPC.Server, instance:
ROPE, transport: SunRPCBinding.Transport ¬ $UDP, concurrency:
CARDINAL ¬ 1, reExport:
BOOL ¬
TRUE, registry: SunRPCBinding.Registry ¬ $PortMapper]
RETURNS [s: SunRPC.Server] ~ {
OPEN unboundServer;
ENABLE {
SunRPC.Error => TranslateSunRPCError[code, "SunRPCBinding.Export", $someError];
SunRPCAuth.Error => TranslateSunRPCError[code, "SunRPCBinding.Export", $authenticationProblem];
NetworkName.Error => ERROR Error[$nameLookupFailed, msg, LIST[[$NetworkNameError, codes]]];
};
SELECT registry
FROM
$PortMapper => {
protocol: CARD32 ¬ 0;
port: CARD32 ¬ 0;
IF reExport THEN [] ¬ SunPMapLocal.UnsetLocal[pgm, version];
SELECT transport
FROM
$UDP => {
s ¬ SunRPCOnUDP.CreateServer[pgm: pgm, version: version, serverProc: serverProc, concurrency: concurrency, clientData: clientData];
protocol ¬ SunPMap.ipProtocolUDP;
port ¬ Basics.Card16FromH[SunRPCOnUDP.GetServerPort[s]];
};
$TCP => {
s ¬ SunRPCOnNetworkStream.CreateServer[pgm: pgm, version: version, serverProc: serverProc, local: NIL, clientData: clientData];
protocol ¬ SunPMap.ipProtocolTCP;
port ¬ PortFromNetworkStreamServer[s];
};
ENDCASE => Error[$notSupported, "requested transport not supported by portmapper"];
IF NOT SunPMapLocal.SetLocal[pgm, version, protocol, port] THEN ERROR Error[$registrationFailed, "portmapper did not allow server registration"];
};
ENDCASE => ERROR Error[$notSupported, "requested registry not supported"];
};