DIRECTORY
Arpa USING [Address, nullAddress],
ArpaUDP USING [nullPort],
Atom USING [GetPName],
Basics USING [HFromCard16, LowHalf],
BasicTime USING [GMT],
Convert USING [RopeFromCard],
ConvertExtras USING [ArpaAddressFromRope],
FS USING [Error],
FSBackdoor USING [ErrorCode, ProduceError],
FSRemoteFileBackdoor USING [GetServerProc, Register, ServerObject, ServerProcs, ServerProcsObject, SweepProc, ValidateProc],
RefText USING [Append, New],
Rope USING [Cat, Concat, Equal, FromRefText, IsEmpty, ROPE, ToRefText],
SafeStorage USING [EnableFinalization, EstablishFinalization, FinalizationQueue, FQNext, NewFQ],
SunAuthUnix USING [FixNameForUnix],
SunMount USING [EachExportProc, EachGroupProc, FHStatus, program, programVersion],
SunMountClient USING [Export, Mnt, Umntall],
SunNFS USING [FHandle, program, programVersion, Stat],
SunNFSFSRemoteFile USING [DirEntries, GetRemoteDirChild, GetRemoteDirRoot, InsertRemoteDirChild, RemoteDirHandle, RemoteDirObject, ServerData, ServerDataObject, SunNFSDelete, SunNFSDoIO, SunNFSEnumerateForInfo, SunNFSEnumerateForNames, SunNFSGetInfo, SunNFSRename, SunNFSRetrieve, SunNFSStore, SweepRemoteDirCache],
SunPMap USING [ipProtocolUDP, udpPort],
SunPMapClient USING [GetPort],
SunRPC USING [Create, Destroy, Error, Handle, SetRemote],
SunRPCAuth USING [Conversation, Error, Initiate, Terminate, unixFlavor],
SunYPAgent USING [Error, First, Handle, Match, Next, ObtainHandle, ReleaseHandle, TextSeq, Tokenize, TokenizeUsingSeparator],
UserCredentials USING [Get]
;
SunNFSFSRemoteServerImpl:
CEDAR
MONITOR
IMPORTS Atom, Basics, Convert, ConvertExtras, FS, FSBackdoor, FSRemoteFileBackdoor, RefText, Rope, SafeStorage, SunAuthUnix, SunMountClient, SunNFSFSRemoteFile, SunPMapClient, SunRPC, SunRPCAuth, SunYPAgent, UserCredentials
EXPORTS SunNFSFSRemoteFile
~ {
OPEN SunNFSFSRemoteFile;
Copied Types
ROPE: TYPE ~ Rope.ROPE;
ServerHandle: TYPE ~ REF ServerObject;
ServerObject: TYPE ~ FSRemoteFileBackdoor.ServerObject;
Parameters
myFlavor: ATOM ← $NFS;
hostsMapName: ROPE ← "hosts.byname";
initialRemoteDirTTL: CARDINAL ← 120;
downServerTTL: CARDINAL ← 60;
upServerTTL: CARDINAL ← 0; -- irrelevant
Registered with FSRemoteFileBackdoor
myServerProcs: FSRemoteFileBackdoor.ServerProcs ←
NEW[FSRemoteFileBackdoor.ServerProcsObject ← [
sweep~SunNFSSweepServer,
validate~SunNFSValidate,
delete~SunNFSDelete,
enumerateForInfo~SunNFSEnumerateForInfo,
enumerateForNames~SunNFSEnumerateForNames,
getInfo~SunNFSGetInfo,
rename~SunNFSRename,
retrieve~SunNFSRetrieve,
store~SunNFSStore,
doIO~SunNFSDoIO
]
];
SunNFSGetServer:
PUBLIC FSRemoteFileBackdoor.GetServerProc
-- [server: ROPE] RETURNS [h: ServerHandle, downMsg: ROPE] -- ~ {
ypH: SunYPAgent.Handle ← NIL;
rpcH: SunRPC.Handle ← NIL;
c: SunRPCAuth.Conversation ← NIL;
data: ServerData;
val: REF TEXT;
downMsg ← "BUG in SunNFSGetServer"; -- hope not to see this.
{
ENABLE {
SunYPAgent.Error => { downMsg ← NIL; GOTO Out };
SunRPCAuth.Error => { downMsg ← "Sun Auth error"; GOTO Out };
SunRPC.Error => { downMsg ← "Sun RPC error"; GOTO Out };
};
tokens: SunYPAgent.TextSeq;
myName, myPassword: ROPE;
mountPort, nfsPort: CARD;
mntResult: SunMount.FHStatus;
Create server data object ...
data ←
NEW[ServerDataObject ←
[ ttl~upServerTTL,
downMsg~NIL,
hostName~server,
address~Arpa.nullAddress,
port~ArpaUDP.nullPort,
mountPort~ArpaUDP.nullPort
]
];
SafeStorage.EnableFinalization[data];
Look up host address
ypH ← SunYPAgent.ObtainHandle[];
val ← SunYPAgent.Match[ypH, hostsMapName, server
! SunYPAgent.Error => CONTINUE];
IF val = NIL THEN val ← YPMatchIgnoringCase[ypH, hostsMapName, server];
tokens ← SunYPAgent.Tokenize[val];
IF tokens.length < 1 THEN { downMsg ← "error in YP hosts map"; GOTO Out };
data.address ← ConvertExtras.ArpaAddressFromRope[Rope.FromRefText[tokens[0]]];
SunYPAgent.ReleaseHandle[ypH]; ypH ← NIL;
Contact the server PortMapper, bind to Mount and NFS service ports.
rpcH ← SunRPC.Create[data.address, Basics.HFromCard16[SunPMap.udpPort]];
[myName, myPassword] ← UserCredentials.Get[];
c ← SunRPCAuth.Initiate[SunRPCAuth.unixFlavor, SunAuthUnix.FixNameForUnix[myName], myPassword];
mountPort ← SunPMapClient.GetPort[rpcH, c, SunMount.program, SunMount.programVersion, SunPMap.ipProtocolUDP];
nfsPort ← SunPMapClient.GetPort[rpcH, c, SunNFS.program, SunNFS.programVersion, SunPMap.ipProtocolUDP];
data.port ← Basics.HFromCard16[Basics.LowHalf[nfsPort]];
data.mountPort ← Basics.HFromCard16[Basics.LowHalf[mountPort]];
IF (mountPort = 0) OR (nfsPort = 0)
THEN { downMsg ← "service not exported"; GOTO Out };
Get fHandle for desired file system ...
rpcH ← SunRPC.SetRemote[rpcH, data.address, data.mountPort];
mntResult ← SunMountClient.Mnt[rpcH, c, Rope.ToRefText["/"]];
SunMountClient.Umntall[rpcH, c
! SunRPC.Error => CONTINUE];
IF mntResult.status # 0 THEN { downMsg ← "mount failed (/)"; GOTO Out };
data.remoteDirs ←
NEW[RemoteDirObject ←
[ nameComponent~"",
fHandle~mntResult.directory,
createMode~0,
createModeTTL~0,
contentMTime~[0, 0],
contentTTL~0,
useCount~1,
ttl~initialRemoteDirTTL
]
];
Create server object (it's a little early to do this, but we need it to mount subdirectories, so we create it now and NIL it out if the subdirectory mounts fail) ...
h ←
NEW[FSRemoteFileBackdoor.ServerObject ←
[ flavor~myFlavor,
name~server,
procs~myServerProcs,
data~data
]
];
Get fHandles for mounted subdirectories, if any (note at this point h looks like a valid, up handle) ...
downMsg ← MountExportedDirectories[h, rpcH, c];
IF downMsg # NIL THEN { h ← NIL; GOTO Out };
Store RPC handle and credentials into server object ...
rpcH ← SunRPC.SetRemote[rpcH, data.address, data.port];
ReleaseRPCHandleAndConversation[h, rpcH, c];
rpcH ← NIL; c ← NIL;
};
IF (downMsg # NIL) AND (h # NIL) THEN ERROR; -- DEBUG
IF ypH # NIL THEN SunYPAgent.ReleaseHandle[ypH]; ypH ← NIL;
IF rpcH # NIL THEN SunRPC.Destroy[rpcH]; rpcH ← NIL;
IF c # NIL THEN SunRPCAuth.Terminate[c]; c ← NIL;
};
YPMatchIgnoringCase:
PROC [ypH: SunYPAgent.Handle, mapName:
ROPE, server:
ROPE]
RETURNS [val:
REF
TEXT] ~ {
On failure raises SunYPAgent.Error[$noMoreEntries].
key: ROPE;
[key, val] ← SunYPAgent.First[ypH, mapName];
DO
IF Rope.Equal[key, server, FALSE] THEN RETURN;
[key, val] ← SunYPAgent.Next[ypH, mapName, key];
ENDLOOP;
};
Export: TYPE ~ REF ExportObject;
ExportObject:
TYPE ~
RECORD [
next: Export,
path: REF TEXT
];
MountExportedDirectories:
PROC [sH: ServerHandle, mountH: SunRPC.Handle, mountC: SunRPCAuth.Conversation]
RETURNS [failMsg: ROPE ← NIL] ~ {
exports, exportsTail: Export ← NIL;
EachExport: SunMount.EachExportProc
-- [fileSys: Path] RETURNS [continue: BOOL] -- ~ {
IF exportsTail =
NIL
THEN exports ← exportsTail ← NEW[ExportObject]
ELSE { exportsTail.next ← NEW[ExportObject]; exportsTail ← exportsTail.next };
exportsTail.path ← RefText.Append[RefText.New[fileSys.length], fileSys];
};
EachGroup: SunMount.EachGroupProc
-- [group] RETURNS [continue: BOOL] -- ~ {
RETURN [TRUE];
};
Ask mount server for exported mount points ...
{
ENABLE SunRPC.Error, SunRPCAuth.Error,
FS.Error => {
failMsg ← "can't get exports from mount server";
GOTO Out;
};
SunMountClient.Export[mountH, mountC, EachExport, EachGroup];
IF exports = NIL THEN { failMsg ← "no exported file system on server"; GOTO Out };
};
Sort mount paths by length to ensure the mounts are done in the right order. Bubble sort is good enough, since they ought to be presented by the server in order anyway ...
DO
swapped: BOOL ← FALSE;
FOR p: Export ← exports, p.next
WHILE p.next #
NIL
DO
IF p.path.length > p.next.path.length
THEN {
temp: REF TEXT ~ p.path;
p.path ← p.next.path;
p.next.path ← temp;
swapped ← TRUE;
};
ENDLOOP;
IF NOT swapped THEN EXIT;
ENDLOOP;
Mount each specified directory, making a pinned directory cache entry for it ...
FOR p: Export ← exports, p.next
WHILE p #
NIL
DO
ENABLE SunRPC.Error, SunRPCAuth.Error,
FS.Error => {
failMsg ← Rope.Cat["mount failed (", Rope.FromRefText[p.path], ")"];
GOTO Out;
};
pathComponents: SunYPAgent.TextSeq;
mntResult: SunMount.FHStatus;
dH: RemoteDirHandle;
Syntax check ...
IF (p.path.length < 1)
OR (p.path[0] # '/)
THEN {
failMsg ← Rope.Cat["mount export syntax error: ", Rope.FromRefText[p.path]];
GOTO Out;
};
WHILE (p.path.length > 1)
AND (p.path[p.path.length-1] = '/)
DO
p.path.length ← p.path.length - 1;
ENDLOOP;
IF p.path.length = 1 THEN LOOP; -- root has already been mounted
Get fHandle for mount
mntResult ← SunMountClient.Mnt[mountH, mountC, p.path];
SunMountClient.Umntall[mountH, mountC ! SunRPC.Error => CONTINUE];
IF mntResult.status # 0
THEN {
failMsg ← Rope.Cat["mount failed (", Rope.FromRefText[p.path], ")"];
GOTO Out;
};
Insert entry in directory cache ...
pathComponents ← SunYPAgent.TokenizeUsingSeparator[p.path, '/];
IF pathComponents.length < 2 THEN ERROR; -- already checked for this above!
dH ← GetRemoteDirRoot[sH];
FOR j:
CARDINAL
IN [1 .. pathComponents.length-1)
DO
[dHChild~dH] ← GetRemoteDirChild[sH, dH, Rope.FromRefText[pathComponents.refText[j]],
FALSE
! FS.Error => { failMsg ← "mount failed (subdir search)"; GOTO Out }];
ENDLOOP;
dH ← InsertRemoteDirChild[dH, Rope.FromRefText[pathComponents.refText[pathComponents.length-1]], mntResult.directory];
(Drop dH without unpinning it, so fHandle is never flushed from cache)
ENDLOOP;
};
SunNFSValidate:
PUBLIC FSRemoteFileBackdoor.ValidateProc
-- [h: ServerHandle] RETURNS [obsolete: BOOL, downMsg: ROPE] -- ~ {
data: ServerData ← NARROW[h.data];
IF (data.ttl = 0) AND (data.downMsg # NIL) THEN RETURN [TRUE, data.downMsg];
RETURN [FALSE, data.downMsg];
};
SunNFSSweepServer: FSRemoteFileBackdoor.SweepProc
-- [h: ServerHandle, seconds: CARD] -- ~ {
data: ServerData ← NARROW[h.data];
rpcH: SunRPC.Handle;
c: SunRPCAuth.Conversation;
SweepServerInner:
ENTRY
PROC ~
INLINE {
ENABLE UNWIND => NULL;
IF data.ttl > seconds
THEN {
data.ttl ← data.ttl - seconds;
}
ELSE {
data.ttl ← 0;
rpcH ← data.h; data.h ← NIL;
c ← data.c; data.c ← NIL;
};
};
SweepRemoteDirCache[data.remoteDirs, seconds];
SweepServerInner[];
IF rpcH # NIL THEN SunRPC.Destroy[rpcH];
IF c # NIL THEN SunRPCAuth.Terminate[c];
};
ObtainRPCHandleAndConversation:
PUBLIC
PROC [sH: ServerHandle]
RETURNS [h: SunRPC.Handle, c: SunRPCAuth.Conversation] ~ {
ENABLE
UNWIND => {
IF h # NIL THEN SunRPC.Destroy[h];
IF c # NIL THEN SunRPCAuth.Terminate[c];
};
data: ServerData ← NARROW[sH.data];
myName, myPassword: ROPE;
[myName, myPassword] ← UserCredentials.Get[];
[h, c] ← ObtainRPCHandleAndConversationInner[sH];
IF h =
NIL
THEN
h ← SunRPC.Create[data.address, data.port];
IF c =
NIL
THEN
c ← SunRPCAuth.Initiate[SunRPCAuth.unixFlavor, SunAuthUnix.FixNameForUnix[myName], myPassword
! SunRPCAuth.Error => ReportAuthError[code, sH, NIL]];
};
ObtainRPCHandleAndConversationInner:
ENTRY
PROC [sH: ServerHandle]
RETURNS [h: SunRPC.Handle, c: SunRPCAuth.Conversation] ~ {
ENABLE UNWIND => NULL;
data: ServerData ← NARROW[sH.data];
h ← data.h; data.h ← NIL;
c ← data.c; data.c ← NIL;
};
ReleaseRPCHandleAndConversation:
PUBLIC
PROC [sH: ServerHandle, h: SunRPC.Handle, c: SunRPCAuth.Conversation] ~ {
[h, c] ← ReleaseRPCHandleAndConversationInner[sH, h, c];
IF h # NIL THEN SunRPC.Destroy[h];
IF c # NIL THEN SunRPCAuth.Terminate[c];
};
ReleaseRPCHandleAndConversationInner:
ENTRY
PROC [sH: ServerHandle, h: SunRPC.Handle, c: SunRPCAuth.Conversation]
RETURNS [hOut: SunRPC.Handle, cOut: SunRPCAuth.Conversation] ~ {
ENABLE UNWIND => NULL;
data: ServerData ← NARROW[sH.data];
IF data.h = NIL THEN data.h ← h ELSE hOut ← h;
IF data.c = NIL THEN data.c ← c ELSE cOut ← c;
};
SetServerDown:
ENTRY
PROC [sH: ServerHandle, downMsg:
ROPE] ~ {
data: ServerData ← NARROW[sH.data];
data.downMsg ← downMsg;
data.ttl ← downServerTTL;
};
Error Reporting
ReportRPCError:
PUBLIC
PROC [code:
ATOM, sH: ServerHandle, name, msg:
ROPE] ~ {
r: ROPE;
fsErrorCode: FSBackdoor.ErrorCode;
r ← Rope.Cat["SunRPC.Error[", Atom.GetPName[code], "]"];
IF sH #
NIL
THEN {
SetServerDown[sH, r];
r ← Rope.Cat[r, ", Server: ", sH.name];
};
IF NOT Rope.IsEmpty[name] THEN r ← Rope.Cat[r, ", File: ", name];
IF NOT Rope.IsEmpty[msg] THEN r ← Rope.Cat[r, ", ", msg];
fsErrorCode ← (
SELECT code
FROM
$unreachable => serverInaccessible,
$timeout => connectionTimedOut,
$badCredentials, $badVerifier => badCredentials,
$wrongCredentials, $wrongVerifier, $weakCredentials => accessDenied,
$wrongProgram, $wrongProgramVersion, $wrongProc => connectionRejected,
ENDCASE => software);
FSBackdoor.ProduceError[fsErrorCode, r];
};
ReportAuthError:
PUBLIC
PROC [code:
ATOM, sH: ServerHandle, msg:
ROPE] ~ {
r: ROPE;
fsErrorCode: FSBackdoor.ErrorCode;
r ← Rope.Cat["SunRPCAuth.Error[", Atom.GetPName[code], "]"];
IF sH #
NIL
THEN {
SetServerDown[sH, r];
r ← Rope.Cat[r, ", Server: ", sH.name];
};
IF NOT Rope.IsEmpty[msg] THEN r ← Rope.Cat[r, ", ", msg];
fsErrorCode ← (
SELECT code
FROM
$badCredentials, $badVerifier => badCredentials,
$wrongUserPassword, $wrongService, $wrongCredentials, $wrongVerifier => accessDenied,
$timeout => serverInaccessible,
ENDCASE => software);
FSBackdoor.ProduceError[fsErrorCode, r];
};
ReportNFSError:
PUBLIC
PROC [status: SunNFS.Stat, sH: ServerHandle, name, msg:
ROPE] ~ {
r, statusRope: ROPE;
fsErrorCode: FSBackdoor.ErrorCode;
SELECT status
FROM
perm => { statusRope ← "perm"; fsErrorCode ← accessDenied };
noent => { statusRope ← "noent"; fsErrorCode ← unknownFile };
io => { statusRope ← "io"; fsErrorCode ← hardware };
nxio => { statusRope ← "nxio"; fsErrorCode ← unknownVolume };
acces => { statusRope ← "acces"; fsErrorCode ← accessDenied };
exist => { statusRope ← "exist"; fsErrorCode ← accessDenied };
nodev => { statusRope ← "nodev"; fsErrorCode ← unknownVolume };
notdir => { statusRope ← "notdir"; fsErrorCode ← fileTypeMismatch };
isdir => { statusRope ← "isdir"; fsErrorCode ← fileTypeMismatch };
fbig => { statusRope ← "fbig"; fsErrorCode ← quotaExceeded };
nospc => { statusRope ← "nospc"; fsErrorCode ← volumeFull };
rofs => { statusRope ← "rofs"; fsErrorCode ← accessDenied };
nametoolong => { statusRope ← "nametoolong"; fsErrorCode ← illegalName };
dquot => { statusRope ← "dquot"; fsErrorCode ← quotaExceeded };
stale => { statusRope ← "stale"; fsErrorCode ← invalidOpenFile };
ENDCASE => {
statusRope ← Convert.RopeFromCard[ORD[status]];
fsErrorCode ← software;
};
r ← Rope.Cat["SunNFS Error[", statusRope, "]"];
IF sH # NIL THEN r ← Rope.Cat[r, ", Server: ", sH.name];
IF NOT Rope.IsEmpty[name] THEN r ← Rope.Cat[r, ", File: ", name];
IF NOT Rope.IsEmpty[msg] THEN r ← Rope.Cat[r, ", ", msg];
FSBackdoor.ProduceError[fsErrorCode, r];
};
ReportFSError:
PUBLIC
PROC [code: FSBackdoor.ErrorCode, sH: ServerHandle, name, msg:
ROPE] ~ {
r: ROPE ← NIL;
IF sH # NIL THEN r ← Rope.Concat["Server: ", sH.name];
IF
NOT Rope.IsEmpty[name]
THEN {
IF r # NIL THEN r ← Rope.Concat[r, ", "];
r ← Rope.Cat[r, "File: ", name];
};
IF
NOT Rope.IsEmpty[msg]
THEN {
IF r # NIL THEN r ← Rope.Concat[r, ", "];
r ← Rope.Concat[r, msg];
};
FSBackdoor.ProduceError[code, r];
};
Finalization
dfq: SafeStorage.FinalizationQueue ← SafeStorage.NewFQ[];
Finalizer:
PROC ~ {
DO
data: ServerData ← NARROW[SafeStorage.FQNext[dfq]];
p, next: RemoteDirHandle;
FOR p ← data.remoteDirs, next
WHILE p #
NIL
DO
SELECT
TRUE
FROM
(p.child # NIL) => { next ← p.child; p.child ← NIL };
(p.sibling # NIL) => { next ← p.sibling; p.sibling ← NIL };
ENDCASE => { next ← p.parent };
ENDLOOP;
ENDLOOP;
};
Initialization
SafeStorage.EstablishFinalization[type~CODE[ServerDataObject], npr~0, fq~dfq];
FSRemoteFileBackdoor.Register[myFlavor, SunNFSGetServer];
}...