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𡤂𡤀x%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𡤂𡤀x".
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.