<<>>
<<NameServiceImpl.mesa>>
<<Copyright Ó 1992 by Xerox Corporation.  All rights reserved.>>
<<Theimer, April 29, 1993 11:58 am PDT>>

    DIRECTORY
        Convert,
        IO,
        List,
        NameService,
        NetworkName,
        NS,
        NMS,
        MS,
        Rope,
        RuntimeError,
        SunRPCOnNetworkStream,
        SunRPCAuth,
        SunRPC,
        SunRPCBinding,
        ThisMachine,
        UnixSysCalls;

    NameServiceImpl: CEDAR MONITOR
        IMPORTS Convert, IO, List, NetworkName, NMS, Rope, RuntimeError, SunRPCOnNetworkStream, SunRPCAuth, SunRPCBinding, ThisMachine, 
        UnixSysCalls
        EXPORTS NameService = 
    BEGIN

    OPEN NameService;

    ROPE: TYPE = Rope.ROPE;

    TypeRope: ROPE _ "Type";
    InstanceRope: ROPE _ "Instance";
    SBHRope: ROPE _ "SBH";
    HostRope: ROPE _ "Host";
    ApplRope: ROPE _ "Appl";

    RegKindValRope: ROPE _ "com.xerox.parc.rpc-service-registration-1";

    ThisHostName: ROPE;
    MyPid: INT _ 0;

    h: SunRPC.Handle;
    ns: NMS.NMS2;

    BadList: ERROR = CODE;


    ExportRPCSun:  PUBLIC PROC [name: ROPE, sp: SunRPC.Server, prog, vers: INT, proto: SunRPCBinding.Transport ¬ $TCP, instance: ROPE _ 
    NIL, appl: List.LORA _ NIL] RETURNS [sbh: ROPE, uid: ROPE] = {
        sbh _ GetSBH[sp, prog, vers, proto];
        uid _ NMSExport[name, instance, sbh, appl];
        };

    ReexportRPCSun:  PUBLIC PROC [uid: ROPE, name: ROPE, sp: SunRPC.Server, prog, vers: INT, proto: SunRPCBinding.Transport ¬ $TCP, 
    instance: ROPE _ NIL, appl: List.LORA _ NIL] RETURNS [sbh: ROPE] = {
        sbh _ GetSBH[sp, prog, vers, proto];
        NMSReexport[uid, name, instance, sbh, appl];
        };


    ImportRPCSun: PUBLIC PROC [name: ROPE _ NIL, instance: ROPE _ NIL, host: ROPE _ NIL, appl: List.LORA _ NIL] RETURNS [h: 
    SunRPC.Handle, r: Registration] = {
        regList: LIST OF Registration;
        prog, vers: INT;
        proto: SunRPCBinding.Transport;
        hostAddr: ROPE;
        port: CARD;

        regList _ ImportRegistrations[name, instance, host, appl];
        IF regList.rest # NIL THEN ERROR;

        r _ regList.first;
        IF r.sbh = NIL THEN ERROR;
        [prog, vers, proto, hostAddr, port] _ SBHFromRope[NARROW[r.sbh, ROPE]];
        h _ SunRPCBinding.Import[hostAddr, prog, vers,, proto];
            <<*** NOTE *** We would really like to be able to specify the port here instead of having Import look it up in the PortMapper.  The 
            current implementation precludes multiple servers from exporting the same RPC interface from the same host.>>
        };


    ImportRegistrations: PUBLIC PROC [name: ROPE _ NIL, instance: ROPE _ NIL, host: ROPE _ NIL, appl: List.LORA] RETURNS [regList: LIST 
    OF Registration] =
        BEGIN
        alist: List.LORA _ NIL;
        pList: NS.ProjectionList;
        ret: NS.Findreturn;
        reg: Registration;

        IF appl # NIL THEN alist _ CONS[List.DotCons[ApplRope, appl], alist];
        IF name # NIL THEN alist _ CONS[List.DotCons[TypeRope, name], alist];
        IF instance # NIL THEN alist _ CONS[List.DotCons[InstanceRope, instance], alist];
        IF host # NIL THEN alist _ CONS[List.DotCons[HostRope, host], alist];
        pList _ NEW [NS.SeqType2Object[0]];
        ret _ ns.nsfind[ns, ToObj[alist], pList, localArea];
        regList _ NIL;
        SELECT ret.returnCode FROM
            Success => {
                r: REF NS.FindreturnObject.Success _ NARROW[ret];
                SELECT r.objects.pType FROM
                    complete => {
                        ro: REF NS.FoundObjectsObject.complete _ NARROW[r.objects];
                        FOR i: CARD DECREASING IN [0..ro.objects.size) DO
                            reg _ ConstructRegRecord[FromObj[ro.objects[i]]];
                            regList _ CONS[reg, regList];
                            ENDLOOP;
                        };
                    ENDCASE => ERROR;
                };
            ENDCASE => ERROR;
        END;


    SBHToRope: PUBLIC PROC [prog, vers: INT, proto: SunRPCBinding.Transport, hostAddr: ROPE, port: CARD] RETURNS [sbh: ROPE] =
        BEGIN
        hProg: ROPE _ IO.PutFR1["%x", IO.int[prog]];
        hexProg: ROPE _ Rope.Substr[hProg, 0, Rope.Length[hProg]-1];
        sbh _ IO.PutFR["sunrpc_2_0x%g_%g|", IO.rope[hProg], IO.int[vers]];
        IF proto = $TCP THEN sbh _ Rope.Concat[sbh, "tcp_"]
        ELSE sbh _ Rope.Concat[sbh, "tcp_"];
        sbh _ Rope.Cat[sbh, hostAddr, "_", Convert.RopeFromInt[port]];
        END;

    SBHFromRope: PUBLIC PROC [sbh: ROPE] RETURNS [prog, vers: INT, proto: SunRPCBinding.Transport, hostAddr: ROPE, port: CARD] =
        BEGIN
        index: INT;

        sbh _ Rope.Substr[sbh, 11];
            <<Get rid of leading "sunrpc_2_0x".>>
        index _ Rope.SkipTo[sbh, 0, "_"];
        prog _ Convert.IntFromRope[Rope.Substr[sbh, 0, index], 16];
        sbh _ Rope.Substr[sbh, index+1];
        index _ Rope.SkipTo[sbh, 0, "|"];
        vers _ Convert.IntFromRope[Rope.Substr[sbh, 0, index]];
        sbh _ Rope.Substr[sbh, index+1];
        IF Rope.Fetch[sbh, 0] = 'u THEN proto _ $UDP
        ELSE IF Rope.Fetch[sbh, 0] = 't THEN proto _ $TCP
        ELSE ERROR;
        sbh _ Rope.Substr[sbh, 4];
            <<Skip over either "udp_" or "tcp_".>>
        index _ Rope.SkipTo[sbh, 0, "_"];
        hostAddr _ Rope.Substr[sbh, 0, index];
        sbh _ Rope.Substr[sbh, index+1];
        port _ Convert.IntFromRope[sbh];
        END;


    GetSBH: PROC [sp: SunRPC.Server, prog, vers: INT, proto: SunRPCBinding.Transport] RETURNS [sbh: ROPE] =
        BEGIN
        hostAddr: ROPE;
        port: CARD;
        s: SunRPC.Server;

        s _ SunRPCBinding.Export[sp, NIL, proto];
        hostAddr _ NetworkName.AddressFromName[family: $ARPA, name: ThisHostName, components: host].addr;
        port _ PortFromNetworkStreamServer[s];
        sbh _ SBHToRope[prog, vers, proto, hostAddr, port];
        END;

    NMSExport: PROC [name, instance, sbh: ROPE, appl: List.LORA] RETURNS [exportedUid: ROPE] =
        BEGIN
        alist: List.LORA;
        ret: NS.Insertreturn;

        alist _ MakeAlist[name, instance, sbh, appl];
        ret _ ns.nsinsert[ns, RegKindValRope, ToObj[alist], MyPid, NS.Domain.localArea];
        SELECT ret.returnCode FROM
            Success => {
                r: REF NS.InsertreturnObject.Success _ NARROW[ret];
                exportedUid _ r.uid;
                };
            ENDCASE => ERROR;
        END;

    NMSReexport: PROC [uid: ROPE, name, instance, sbh: ROPE, appl: List.LORA] =
        BEGIN
        alist: List.LORA;
        ret: NS.ReturnCodes;

        alist _ MakeAlist[name, instance, sbh, appl];
        ret _ ns.nsreplace[ns, RegKindValRope, ToObj[alist], uid, NS.Domain.localArea];
        IF ret # Success THEN ERROR;
        END;

    MakeAlist: PROC [name, instance, sbh: ROPE, appl: List.LORA] RETURNS [alist: List.LORA] =
        BEGIN
        IF appl # NIL THEN alist _ CONS[List.DotCons[ApplRope, appl], NIL]
        ELSE alist _ NIL;
        alist _ CONS[List.DotCons[SBHRope, sbh], alist];
        alist _ CONS[List.DotCons[TypeRope, name], alist];
        alist _ CONS[List.DotCons[InstanceRope, instance], alist];
        alist _ CONS[List.DotCons[HostRope, ThisHostName], alist];
        END;

    ToObj: PROC [alist: List.LORA] RETURNS [o: NS.Object] =
        BEGIN
        l: CARD;
        av: List.DottedPair;
        key: ROPE;

        IF alist = NIL THEN RETURN [NIL];
        l _ List.Length[alist];
        o _ NEW[NS.SeqType1Object[l]];
        FOR i: CARD IN [0..l) DO
            av _ NARROW[alist.first, List.DottedPair];
            alist _ alist.rest;
            IF NOT ISTYPE[av.key, ROPE] THEN 
                ERROR BadList;
            o[i].name _ NARROW[av.key, ROPE];
            IF av.val = NIL THEN {
                o[i].value _ NEW [NS.ValueObject.text _ [text[""]]];
                }
            ELSE  {
                IF ISTYPE[av.val, ROPE] THEN {
                    o[i].value _ NEW [NS.ValueObject.text _ [text[NARROW[av.val, ROPE]]]];
                    }
                ELSE IF ISTYPE[av.val, List.LORA] THEN {
                    o[i].value _ NEW [NS.ValueObject.attributes _ [attributes[ToObj1[NARROW[av.val, List.LORA]]]]];
                    }
                ELSE ERROR BadList;
                };
            ENDLOOP;
        END;

    ToObj1: PROC [alist: List.LORA] RETURNS [o: NS.SeqType0] =
        BEGIN
        l: CARD;
        av: List.DottedPair;
        key: ROPE;

        IF alist = NIL THEN RETURN [NIL];
        l _ List.Length[alist];
        o _ NEW[NS.SeqType0Object[l]];
        FOR i: CARD IN [0..l) DO
            av _ NARROW[alist.first, List.DottedPair];
            alist _ alist.rest;
            IF NOT ISTYPE[av.key, ROPE] THEN 
                ERROR BadList;
            o[i].name _ NARROW[av.key, ROPE];
            IF av.val = NIL THEN {
                o[i].value _ NEW [NS.ValueObject.text _ [text[""]]];
                }
            ELSE  {
                IF ISTYPE[av.val, ROPE] THEN {
                    o[i].value _ NEW [NS.ValueObject.text _ [text[NARROW[av.val, ROPE]]]];
                    }
                ELSE IF ISTYPE[av.val, List.LORA] THEN {
                    o[i].value _ NEW [NS.ValueObject.attributes _ [attributes[ToObj1[NARROW[av.val, List.LORA]]]]];
                    }
                ELSE ERROR BadList;
                };
            ENDLOOP;
        END;

    ListAssoc: PROC [key: ROPE, alist: List.LORA] RETURNS [val: REF ANY] =
        BEGIN
        av: List.DottedPair;

        FOR i: CARD IN [0..List.Length[alist]) DO
            av _ NARROW[alist.first, List.DottedPair];
            alist _ alist.rest;
            IF Rope.Equal[key, NARROW[av.key, ROPE]] THEN {
                val _ av.val;
                RETURN;
                };
            ENDLOOP;
        END;

    FromObj: PROC [o: NS.Object] RETURNS [alist: List.LORA] =
        BEGIN
        alist _ NIL;
        FOR i: CARD DECREASING IN [0..o.size) DO
            alist _ CONS[FromAttr[o[i]], alist];
            ENDLOOP;
        END;

    FromObj1: PROC [o: NS.SeqType0] RETURNS [alist: List.LORA] =
        BEGIN
        alist _ NIL;
        FOR i: CARD DECREASING IN [0..o.size) DO
            alist _ CONS[FromAttr[o[i]], alist];
            ENDLOOP;
        END;

    FromAttr: PROC [a: NS.Attribute] RETURNS [av: List.DottedPair] =
        BEGIN
        SELECT a.value.vType FROM
            text => {
                at: REF NS.ValueObject.text _ NARROW[a.value];
                av _ List.DotCons[a.name, at.valStr];
                };
            attributes => {
                aa: REF NS.ValueObject.attributes _ NARROW[a.value];
                av _ List.DotCons[a.name, FromObj1[aa.valPairs]];
                };
            ENDCASE => ERROR;
        END;

    ConstructRegRecord: PROC [alist: List.LORA] RETURNS [r: Registration] =
        BEGIN
        r _ NEW [RegistrationRecord];
        r.name _ NARROW[ListAssoc[TypeRope, alist]];
        r.instance _ NARROW[ListAssoc[InstanceRope, alist]];
        r.host _ NARROW[ListAssoc[HostRope, alist]];
        r.sbh _ NARROW[ListAssoc[SBHRope, alist]];
        r.appl _ CONS[ListAssoc[ApplRope, alist], NIL];
        END;

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


    <<Start Code>>

    Start: PROC [] =
        BEGIN
        ENABLE RuntimeError.UNCAUGHT => GO TO Oops;
        ThisHostName _ ThisMachine.Name[];
        MyPid _ UnixSysCalls.GetPID[];
        h _ SunRPCBinding.Import[ThisHostName, NMS.NMSPrognum, NMS.version2,, $TCP];
        ns _ NMS.MakeNMS2Client[h, SunRPCAuth.Initiate[]];
        EXITS Oops => {};
        END;

    Start[];

    END.