
    <<SunNFSRemoteDirImpl.mesa>>
        <<Copyright Ó 1987 by Xerox Corporation.  All rights reserved.>>
        <<Demers, November 9, 1987 12:01:10 pm PST>>

    DIRECTORY
        Basics USING [DoubleAnd, DoubleNot, DoubleOr],
        BasicTime USING [GMT],
        FS USING [Error],
        RemoteFile USING [ServerHandle],
        Rope USING [Cat, Equal, FromRefText, IsEmpty, ROPE, ToRefText],
        SunMountClient USING [Mnt, Umnt],
        SunNFS USING [AttrStat, Cookie, DirOpRes, EachDirEntryProc, FHandle, FileName, SAttr, Stat, TimeVal],
        SunNFSClient USING [Getattr, Lookup, Mkdir, Readdir],
        SunNFSRemoteFile USING [CompareSunTimes, CreateCaseFile, DirEntries, DirEntriesObject, EachDirEntryProc, NameReaderObject, 
        NameWriterObject, ObtainRPCHandleAndConversation, ReleaseRPCHandleAndConversation, ReadDirComponent, RemoteDirObject, 
        ReportNFSError, ReportRPCError, ResetNameReader, ServerData],
        SunRPC USING [Error, Handle, SetRemote],
        SunRPCAuth USING [Conversation]
        ;

    SunNFSRemoteDirImpl: CEDAR MONITOR
        IMPORTS Basics, Rope, FS, SunMountClient, SunNFSClient, SunNFSRemoteFile, SunRPC
        EXPORTS SunNFSRemoteFile
        ~ {
        OPEN SunNFSRemoteFile;
    <<Copied Types>>
        FHandle: TYPE ~ SunNFS.FHandle;
        GMT: TYPE ~ BasicTime.GMT;
        NameReader: TYPE ~ REF NameReaderObject;
        NameWriter: TYPE ~ REF NameWriterObject;
        RemoteDirHandle: TYPE ~ REF RemoteDirObject;
        ROPE: TYPE ~ Rope.ROPE;
        ServerHandle: TYPE ~ RemoteFile.ServerHandle;
    <<Parameters>>
        initialRemoteDirTTL: CARDINAL _ 600;
        initialCreateModeTTL: CARDINAL _ 600;
        defaultCreateMode: CARD _ 0640B; -- rw. r.. ...
        fsModeFileName: ROPE _ ".~mode~";
        dirSearchBlocksize: CARD _ 2048; -- should become 8K when gateways are fixed!
        initialDirContentTTL: CARDINAL _ 60;
        dirEntriesPerObject: CARDINAL _ 30;
    <<File mode stuff>>
        regularModeBits: CARD ~ 0100000B;
        directoryModeBits: CARD ~ 040700B;
        accessBits: CARD ~ 07777B; -- includes suid, sgid
        ownerRBit: CARD ~ 0400B;
        ownerWBit: CARD ~ 0200B;
        ownerXBit: CARD ~ 0100B;
        groupRWBits: CARD ~ 060B;
        groupRBit: CARD ~ 040B;
        groupWBit: CARD ~ 020B;
        groupXBit: CARD ~ 010B;
        otherRBit: CARD ~ 04B;
        otherWBit: CARD ~ 02B;
        otherXBit: CARD ~ 01B;

        FixModeForRegularFile: PUBLIC PROC [mode: CARD] RETURNS [CARD] ~ {
            mode _ LOOPHOLE[Basics.DoubleOr[LOOPHOLE[mode], LOOPHOLE[regularModeBits]]];
            RETURN [mode];
            };

        FixModeForDirectory: PUBLIC PROC [mode: CARD] RETURNS [CARD] ~ {
            mode _ LOOPHOLE[Basics.DoubleAnd[LOOPHOLE[mode], LOOPHOLE[accessBits]]];
            mode _ LOOPHOLE[Basics.DoubleOr[LOOPHOLE[mode], LOOPHOLE[directoryModeBits]]];
            IF LOOPHOLE[Basics.DoubleAnd[LOOPHOLE[mode], LOOPHOLE[groupWBit]], CARD] # 0
                THEN mode _ LOOPHOLE[Basics.DoubleOr[LOOPHOLE[mode], LOOPHOLE[groupRBit]]];
            IF LOOPHOLE[Basics.DoubleAnd[LOOPHOLE[mode], LOOPHOLE[groupRBit]], CARD] # 0
                THEN mode _ LOOPHOLE[Basics.DoubleOr[LOOPHOLE[mode], LOOPHOLE[groupXBit]]];
            IF LOOPHOLE[Basics.DoubleAnd[LOOPHOLE[mode], LOOPHOLE[otherWBit]], CARD] # 0
                THEN mode _ LOOPHOLE[Basics.DoubleOr[LOOPHOLE[mode], LOOPHOLE[otherRBit]]];
            IF LOOPHOLE[Basics.DoubleAnd[LOOPHOLE[mode], LOOPHOLE[otherRBit]], CARD] # 0
                THEN mode _ LOOPHOLE[Basics.DoubleOr[LOOPHOLE[mode], LOOPHOLE[otherXBit]]];
            RETURN [mode];
            };

        GetModeAccessBits: PUBLIC PROC [mode: CARD] RETURNS [CARD] ~ {
            RETURN [LOOPHOLE[Basics.DoubleAnd[LOOPHOLE[mode], LOOPHOLE[accessBits]]] ];
            };

        UpdateModeAccessBits: PUBLIC PROC [mode: CARD, newAccessBits: CARD] RETURNS [CARD] ~ {
            mode _ LOOPHOLE[Basics.DoubleAnd[LOOPHOLE[mode], LOOPHOLE[Basics.DoubleNot[LOOPHOLE[accessBits]]]]];
            newAccessBits _ LOOPHOLE[Basics.DoubleAnd[LOOPHOLE[newAccessBits], LOOPHOLE[accessBits]]];
            RETURN[ LOOPHOLE[Basics.DoubleOr[LOOPHOLE[mode], LOOPHOLE[newAccessBits]]] ];
            };
    <<Cache of remote directory handles>>
        FindRemoteDirChild: ENTRY PROC [dH: RemoteDirHandle, childName: ROPE]
        RETURNS [dHChild: RemoteDirHandle] ~ {
            ENABLE UNWIND => NULL;
            FOR dHChild _ dH.child, dHChild.sibling WHILE dHChild # NIL DO
                IF Rope.Equal[dHChild.nameComponent, childName, TRUE] THEN {
                    dHChild.useCount _ dHChild.useCount.SUCC;
                    RETURN;
                    };
                ENDLOOP;
            };

        InsertRemoteDirChild: PUBLIC ENTRY PROC [dH: RemoteDirHandle, childName: ROPE, fHandle: SunNFS.FHandle] RETURNS [dHChild: 
        RemoteDirHandle] ~ {
            ENABLE UNWIND => NULL;
            dHChild _ NEW[RemoteDirObject _ [parent~dH, sibling~dH.child, nameComponent~childName, fHandle~fHandle, createMode~0, 
            createModeTTL~0, contentMTime~[0, 0], contentTTL~0, useCount~1, ttl~initialRemoteDirTTL]];
            dH.child _ dHChild;
            };

        PinRemoteDirPath: PUBLIC ENTRY PROC [dH: RemoteDirHandle] ~ {
            ENABLE UNWIND => NULL;
            WHILE dH # NIL DO
                dH.useCount _ dH.useCount.SUCC;
                dH _ dH.parent;
                ENDLOOP;
            };

        UnPinRemoteDir: PUBLIC ENTRY PROC [dH: RemoteDirHandle]
        RETURNS [dHParent: RemoteDirHandle] ~ {
            ENABLE UNWIND => NULL;
            dH.useCount _ dH.useCount.PRED;
            dH.ttl _ initialRemoteDirTTL;
            RETURN[dH.parent];
            };

        UnPinRemoteDirPath: PUBLIC ENTRY PROC [dH: RemoteDirHandle] ~ {
            ENABLE UNWIND => NULL;
            WHILE dH # NIL DO
                dH.useCount _ dH.useCount.PRED;
                dH.ttl _ initialRemoteDirTTL;
                dH _ dH.parent;
                ENDLOOP;
            };

        GetRemoteDirRoot: PUBLIC ENTRY PROC [sH: ServerHandle]
        RETURNS [dH: RemoteDirHandle] ~ {
            ENABLE UNWIND => NULL;
            d: ServerData _ NARROW[sH.data];
            dH _ d.remoteDirs;
            IF dH = NIL THEN ERROR;
            dH.useCount _ dH.useCount.SUCC;
            };

        VerifySubdirectory: PROC [sH: ServerHandle, dH: RemoteDirHandle, name: ROPE] RETURNS [fH: SunNFS.FHandle] ~ {
            <<Return fHandle for subdirectory if it exists; return NIL if subdirectory doesn't exist, else raise appropriate FS.Error. >>
            reply: SunNFS.DirOpRes;
            reply _ LookupThruSymLinks[sH, dH, name];
            SELECT reply.status FROM
                ok => {
                    IF reply.attributes.type # dir THEN ReportNFSError[notdir, sH, name];
                    fH _ reply.file;
                    };
                noent => {
                    fH _ NIL;
                    };
                ENDCASE => {
                    ReportNFSError[reply.status, sH, name];
                    };
            };

        CreateSubdirectory: PUBLIC PROC [sH: ServerHandle, dH: RemoteDirHandle, name: ROPE, desiredMode: CARD] RETURNS [fH: SunNFS.FHandle] 
        ~ {
            <<Create subdirectory in the directory specified by <sH, dH>.>>
            rpcH: SunRPC.Handle;
            c: SunRPCAuth.Conversation;
            reply: SunNFS.DirOpRes;
            [rpcH, c] _ ObtainRPCHandleAndConversation[sH];
            { ENABLE UNWIND => ReleaseRPCHandleAndConversation[sH, rpcH, c];
                reply _ SunNFSClient.Mkdir[rpcH, c, [dH.fHandle, Rope.ToRefText[name]],
                    SunNFS.SAttr[
                        mode~FixModeForDirectory[desiredMode],
                        uid~CARD.LAST, -- => default
                        gid~CARD.LAST, -- => default
                        size~CARD.LAST, -- => default
                        atime~[CARD.LAST, CARD.LAST], -- => default
                        mtime~[CARD.LAST, CARD.LAST] -- => default
                        ]
                    ! SunRPC.Error => ReportRPCError[code, sH, name]];
                SELECT reply.status FROM
                    ok => {
                        fH _ reply.file;
                        };
                    ENDCASE => {
                        ReportNFSError[reply.status, sH, name];
                        };
                };
            ReleaseRPCHandleAndConversation[sH, rpcH, c];
            };

        RefreshRemoteDirContent: PROC [sH: ServerHandle, dH: RemoteDirHandle, staleOK: BOOL]  RETURNS [content: DirEntries] ~ {
            <<Read directory content from server if it has changed since oldMTime.>>
            h: SunRPC.Handle;
            c: SunRPCAuth.Conversation;
            tail: DirEntries _ NIL;
            oldMTime, mtime: SunNFS.TimeVal;
            EachEntry: SunNFS.EachDirEntryProc -- [fileid: CARD, filename: FileName] RETURNS [continue: BOOL _ TRUE] -- ~ {
                nameRope: ROPE ~ Rope.FromRefText[filename];
                IF (tail = NIL) OR (tail.count >= tail.maxCount) THEN {
                    temp: DirEntries ~ NEW[DirEntriesObject[dirEntriesPerObject]];
                    IF tail = NIL THEN content _ temp ELSE tail.next _ temp;
                    tail _ temp;
                    };
                tail.entries[tail.count] _ nameRope;
                tail.count _ tail.count + 1;
                };
            CheckOutContent: ENTRY PROC RETURNS [locked: BOOL] ~ {
            ENABLE UNWIND => NULL;
            WHILE dH.contentLocked DO WAIT dH.contentAvailable ENDLOOP;
            content _ dH.content;
            oldMTime _ dH.contentMTime;
            locked _ dH.contentLocked _ ((NOT staleOK) OR (dH.contentTTL = 0));
            };
        CheckInContent: ENTRY PROC ~ {
        ENABLE UNWIND => NULL;
        dH.content _ content;
        dH.contentMTime _ mtime;
        dH.contentTTL _ initialDirContentTTL;
        dH.contentLocked _ FALSE;
        BROADCAST dH.contentAvailable;
        };
        UnlockContent: ENTRY PROC ~ {
        ENABLE UNWIND => NULL;
        dH.contentLocked _ FALSE;
        BROADCAST dH.contentAvailable;
        };
            IF NOT CheckOutContent[].locked THEN RETURN;
            {
                ENABLE UNWIND => {
                    UnlockContent[];
                    IF h # NIL THEN ReleaseRPCHandleAndConversation[sH, h, c];
                    };
                {
                    attrStat: SunNFS.AttrStat;
                    [h, c] _ ObtainRPCHandleAndConversation[sH];
                    attrStat _ SunNFSClient.Getattr[h, c, dH.fHandle
                        ! SunRPC.Error => ReportRPCError[code, sH]];
                IF attrStat.status # ok THEN ReportNFSError[attrStat.status, sH];
                    mtime _ attrStat.attributes.mtime;
                    };
                IF CompareSunTimes[mtime, oldMTime] = greater THEN {
                    status: SunNFS.Stat;
                    eof: BOOL _ FALSE;
                    cookie: SunNFS.Cookie _ NIL;
                    WHILE NOT eof DO
                        [status, eof, cookie] _ SunNFSClient.Readdir[h, c, dH.fHandle, cookie, dirSearchBlocksize, EachEntry
                            ! SunRPC.Error => ReportRPCError[code, sH]];
                    IF status # ok THEN ReportNFSError[status, sH];
                    ENDLOOP;
                };
                };
            CheckInContent[];
            ReleaseRPCHandleAndConversation[sH, h, c];
            };

        GetCreateMode: PUBLIC PROC [sH: ServerHandle, dH: RemoteDirHandle, forDirectory: BOOL]
        RETURNS [createMode: CARD] ~ {
        rawMode: CARD _ RefreshCreateMode[sH, dH];
            RETURN [IF forDirectory THEN FixModeForDirectory[rawMode] ELSE FixModeForRegularFile[rawMode]];
            };

        RefreshCreateMode: PROC [sH: ServerHandle, dH: RemoteDirHandle]
        RETURNS [createMode: CARD] ~ {
            <<The returned create mode has no type bits set ...>>
            CheckOutCreateMode: ENTRY PROC RETURNS [ok: BOOL] ~ --INLINE-- {
            ENABLE UNWIND => NULL;
            createMode _ dH.createMode;
            ok _ (dH.createModeTTL > 0);
            };
        CheckInCreateMode: ENTRY PROC ~ --INLINE-- {
        ENABLE UNWIND => NULL;
        dH.createMode _ createMode;
        dH.createModeTTL _ initialCreateModeTTL;
        };
            IF dH = NIL THEN RETURN [defaultCreateMode];
            IF CheckOutCreateMode[].ok THEN RETURN;
            { reply: SunNFS.DirOpRes _ LookupThruSymLinks[sH, dH, fsModeFileName];
            SELECT reply.status FROM
            ok => createMode _ GetModeAccessBits[reply.attributes.mode];
            noent => createMode _ RefreshCreateMode[sH, dH.parent];
            ENDCASE => ReportNFSError[reply.status, sH];
                };
            CheckInCreateMode[];
            };

        EnumerateDirectory: PUBLIC PROC [sH: ServerHandle, dH: RemoteDirHandle, eachDirEntry: EachDirEntryProc, staleOK: BOOL] ~ {
            content: DirEntries;
            content _ RefreshRemoteDirContent[sH, dH, staleOK];
            FOR p: DirEntries _ content, p.next WHILE p # NIL DO
                FOR i: CARDINAL IN [0 .. p.count) DO
                    IF NOT eachDirEntry[p.entries[i]].continue THEN RETURN;
                    ENDLOOP;
                ENDLOOP;
            };

        FollowDirPath: PUBLIC PROC [sH: ServerHandle, nR: NameReader, case: BOOL, create: BOOL] RETURNS [dH: RemoteDirHandle _ NIL] ~ {
            ENABLE UNWIND => {
                IF dH # NIL THEN UnPinRemoteDirPath[dH];
                };
            dH _ GetRemoteDirRoot[sH];
            DO
                dHParent: RemoteDirHandle _ dH;
                created: BOOL;
                component: ROPE _ ReadDirComponent[nR, FALSE];
                IF Rope.IsEmpty[component] THEN EXIT;
                [dH, created] _ GetRemoteDirChild[sH~sH, dH~dH, childName~component, create~create];
                IF created THEN {
                    componentWithCase: ROPE;
                    ResetNameReader[nR, -1];
                    componentWithCase _ ReadDirComponent[nR, TRUE];
                    CreateCaseFile[sH, dHParent, componentWithCase ! FS.Error => CONTINUE ];
                    };
                ENDLOOP;
            };

        GetRemoteDirChild: PUBLIC PROC [sH: ServerHandle, dH: RemoteDirHandle, childName: ROPE, create: BOOL]
            RETURNS [dHChild: RemoteDirHandle, created: BOOL _ FALSE] ~ {
            <<Given a (pinned) RemoteDirHandle, return a (pinned) RemoteDirHandle for the named child, if that child exists and is a directory. 
             Otherwise raise FS.Error[...].>>
            fH: SunNFS.FHandle;
            IF (dHChild _ FindRemoteDirChild[dH, childName]) # NIL THEN RETURN;
            fH _ VerifySubdirectory[sH, dH, childName];
        IF fH = NIL THEN {
        desiredMode: CARD;
        IF NOT create THEN ReportNFSError[noent, sH, childName];
            desiredMode _ GetCreateMode[sH, dH, TRUE];
        fH _ CreateSubdirectory[sH, dH, childName, desiredMode];
        created _ TRUE;
        };
            dHChild _ InsertRemoteDirChild[dH, childName, fH];
            };

        SweepRemoteDirCache: PUBLIC ENTRY PROC [root: RemoteDirHandle, seconds: CARD] ~ {
            <<Note this can't delete the root!>>
            ENABLE UNWIND => NULL;
            SweepInner: PROC [dH: RemoteDirHandle] ~ {
                prev: RemoteDirHandle _ NIL;
                FOR p: RemoteDirHandle _ dH.child, p.sibling WHILE p # NIL DO
                    SweepInner[p];
                    IF (p.ttl = 0) AND (p.child = NIL) AND (p.useCount = 0)
                        THEN {
                            IF prev = NIL THEN dH.child _ p.sibling ELSE prev.sibling _ p.sibling;
                            }
                        ELSE {
                            prev _ p;
                            };
                    ENDLOOP;
                IF dH.ttl > seconds THEN dH.ttl _ dH.ttl - seconds ELSE dH.ttl _ 0;
                IF dH.contentTTL > seconds
                    THEN {
                        dH.contentTTL _ dH.contentTTL - seconds;
                        }
                    ELSE {
                        dH.contentTTL _ 0;
                        IF NOT dH.contentLocked THEN {
                            dH.content _ NIL;
                            dH.contentMTime _ [0, 0];
                            };
                        };
                IF dH.createModeTTL > seconds
                    THEN dH.createModeTTL _ dH.createModeTTL - seconds
                    ELSE dH.createModeTTL _ 0;
                };
            IF root # NIL THEN SweepInner[root];
            };
    <<Lookup through symbolic links>>
        LookupThruSymLinks: PUBLIC PROC [sH: ServerHandle, dH: RemoteDirHandle, name: ROPE] RETURNS [dirOpRes: SunNFS.DirOpRes] ~ {
            rpcH, rpcHForMount: SunRPC.Handle;
            c: SunRPCAuth.Conversation;
            data: ServerData _ NARROW[sH.data];
            {
                ENABLE {
                    UNWIND => {
                        IF rpcHForMount # NIL
                            THEN rpcH _ SunRPC.SetRemote[rpcHForMount, data.address, data.port];
                        IF rpcH # NIL THEN ReleaseRPCHandleAndConversation[sH, rpcH, c];
                        };
                    SunRPC.Error => {
                        ReportRPCError[code, sH];
                        };
                    };
                fullPathName: ROPE;
                fullPathNameRefText: REF TEXT;
                attrStat: SunNFS.AttrStat;
                fH: REF TEXT;
                [rpcH, c] _ ObtainRPCHandleAndConversation[sH];
                dirOpRes _ SunNFSClient.Lookup[rpcH, c, [dH.fHandle, Rope.ToRefText[name]] ];
                SELECT dirOpRes.status FROM
                    ok => NULL;
                    ENDCASE => GOTO Out;
                SELECT dirOpRes.attributes.type FROM
                    lnk => NULL;
                    ENDCASE => GOTO Out;
                <<At this point we've found a symbolic link.  We let the mount server follow it ...>>
                    fullPathName _ name;
                    FOR finger: RemoteDirHandle _ dH, finger.parent WHILE finger # NIL DO
                        fullPathName _ Rope.Cat[finger.nameComponent, "/", fullPathName];
                        ENDLOOP;
                    fullPathNameRefText _ Rope.ToRefText[fullPathName];
                    rpcHForMount _ SunRPC.SetRemote[rpcH, data.address, data.mountPort];
                    rpcH _ NIL;
                    fH _ SunMountClient.Mnt[rpcHForMount, c, fullPathNameRefText].directory;
                    IF fH = NIL THEN { dirOpRes.status _ noent; GOTO Out };
                    SunMountClient.Umnt[rpcHForMount, c, fullPathNameRefText
                        ! SunRPC.Error => CONTINUE ];
                    rpcH _ SunRPC.SetRemote[rpcHForMount, data.address, data.port];
                    rpcHForMount _ NIL;
                    attrStat _ SunNFSClient.Getattr[rpcH, c, fH];
                    dirOpRes _ [attrStat.status, fH, attrStat.attributes];
                EXITS
                    Out => NULL;
                };
            IF rpcHForMount # NIL
                THEN rpcH _ SunRPC.SetRemote[rpcHForMount, data.address, data.port];
            IF rpcH # NIL THEN ReleaseRPCHandleAndConversation[sH, rpcH, c];
            };
        }...