<<>>
    <<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;

    SunRPCBindingImpl: CEDAR PROGRAM
    IMPORTS Atom, Basics, Convert, NetworkName, Rope, SunPMapClient, SunPMapLocal, SunRPC, SunRPCAuth, SunRPCOnNetworkStream, 
    SunRPCOnUDP
    EXPORTS SunRPCBinding
    ~ 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"];
            };

    END.