
    <<SunNFSUnixRemoteFileImpl.mesa>>
        <<Copyright Ó 1987 by Xerox Corporation.  All rights reserved.>>
        <<Demers, November 8, 1987 1:55:06 pm PST>>

    DIRECTORY
        Atom USING [MakeAtom],
        BasicTime USING [GMT, nullGMT],
        Convert USING [RopeFromCard],
        IO USING [STREAM],
        RemoteFile USING [ServerHandle],
        Rope USING [Cat, Concat, FindBackward, FromRefText, ROPE, Substr, ToRefText],
        SunMount USING [FHStatus],
        SunMountClient USING [Mnt, Umnt],
        SunNFS USING[AttrStat, Cookie, DirOpArgs, DirOpRes, EachDirEntryProc, FAttr, FHandle, FType, SAttr, Stat],
        SunNFSClient USING[Create, Getattr, Link, Mkdir, Read, Readdir, Remove, Rename, Rmdir, Setattr, Symlink, Write],
        SunNFSRemoteFile USING [FixModeForDirectory, FixModeForRegularFile, GetModeAccessBits, GMTFromSunTime, 
        ObtainRPCHandleAndConversation, ReleaseRPCHandleAndConversation, ServerData, SunTimeFromGMT, UpdateModeAccessBits],
        SunRPC USING [Error, Handle, SetRemote],
        SunRPCAuth USING [Conversation],
        UnixRemoteFile USING [CloseProc, CreateProc, DeleteProc, EnumerateProc, Error, GetInfoProc, LinkProc, MkDirProc, OpenProc, 
        ReadProc, RenameProc, RmDirProc, SetInfoProc, SymLinkProc, WriteProc]
        ;

    SunNFSUnixRemoteFileImpl: CEDAR PROGRAM
        IMPORTS Atom, Convert, Rope, SunMountClient, SunNFSClient, SunNFSRemoteFile, SunRPC, UnixRemoteFile
        EXPORTS SunNFSRemoteFile
        ~ {
    <<Types>>
        FileDescriptor: TYPE ~ REF;
        FType: TYPE ~ SunNFS.FType -- { non(0), reg(1), dir(2), blk(3), chr(4), lnk(5) } -- ;
        GMT: TYPE ~ BasicTime.GMT;
        Mode: TYPE ~ CARD32 -- rwxrwxrwx, only the low order 9 bits are significant -- ;
        ROPE: TYPE ~ Rope.ROPE;
        ServerHandle: TYPE ~ RemoteFile.ServerHandle;
        STREAM: TYPE ~ IO.STREAM;
        FileDescriptorInner: TYPE ~ SunNFS.FHandle;
    <<Parameters>>
        dirSearchBlocksize: CARDINAL _ 2048;
        defaultSymLinkCreateMode: CARD _ 0777B; -- this is what NFS does anyway ...
        defaultCreateMode: CARD _ 0600B;
        defaultCreateAttributes: SunNFS.SAttr _ [
            mode ~ CARD.LAST,
            uid~CARD.LAST,
            gid~CARD.LAST,
            size~CARD.LAST,
            atime~[CARD.LAST, CARD.LAST],
            mtime~[CARD.LAST, CARD.LAST]
            ];
    <<Operations>>
        InnerProc: TYPE ~ PROC [data: SunNFSRemoteFile.ServerData, rpcH: SunRPC.Handle, c: SunRPCAuth.Conversation];

        SunNFSUnixOpen: PUBLIC UnixRemoteFile.OpenProc -- [sH: ServerHandle, path: ROPE] RETURNS [fD: FileDescriptor] -- ~ {
            OpenInner: InnerProc ~ {
                fHStatus: SunMount.FHStatus;
                pathRefText: REF TEXT _ Rope.ToRefText[path];
                rpcH _ SetMountPort[data, rpcH];
                fHStatus _ SunMountClient.Mnt[rpcH, c, pathRefText];
                IF fHStatus.status # 0 THEN UnixError[$noent, sH, path, "NFS mount lookup failed"];
                fD _ fHStatus.directory;
                SunMountClient.Umnt[rpcH, c, pathRefText
                    ! SunRPC.Error => CONTINUE];
                rpcH _ SetNFSPort[data, rpcH];
                };
            CallServer[sH, OpenInner];
            };

        SunNFSUnixClose: PUBLIC UnixRemoteFile.CloseProc -- [sH: ServerHandle, fD: FileDescriptor] -- ~ {
            NULL;
            };

        SunNFSUnixCreate: PUBLIC UnixRemoteFile.CreateProc -- [sH: ServerHandle, path: ROPE, mode: Mode] RETURNS [fD: FileDescriptor] -- ~ {
            dirOpArgs: SunNFS.DirOpArgs;
            CreateInner: InnerProc ~ {
                attributes: SunNFS.SAttr _ defaultCreateAttributes;
                dirOpRes: SunNFS.DirOpRes;
                attributes.mode _ SunNFSRemoteFile.FixModeForRegularFile[mode];
                dirOpRes _ SunNFSClient.Create[rpcH, c, dirOpArgs, attributes];
                IF dirOpRes.status # ok THEN NFSToUnixError[dirOpRes.status, sH, path, "NFS create error"];
                fD _ dirOpRes.file;
                };
            dirOpArgs _ ResolvePath[sH, path];
            CallServer[sH, CreateInner];
            };

        SunNFSUnixDelete: PUBLIC UnixRemoteFile.DeleteProc -- [sH: ServerHandle, path: ROPE] -- ~ {
            dirOpArgs: SunNFS.DirOpArgs;
            DeleteInner: InnerProc ~ {
            status: SunNFS.Stat _ SunNFSClient.Remove[rpcH, c, dirOpArgs];
                IF status # ok THEN NFSToUnixError[status, sH, path, "NFS delete error"];
                };
            dirOpArgs _ ResolvePath[sH, path];
            CallServer[sH, DeleteInner];
            };

        SunNFSUnixMkDir: PUBLIC UnixRemoteFile.MkDirProc -- [sH: ServerHandle, path: ROPE, mode: Mode] -- ~ {
            dirOpArgs: SunNFS.DirOpArgs;
            MkDirInner: InnerProc ~ {
                attributes: SunNFS.SAttr _ defaultCreateAttributes;
                dirOpRes: SunNFS.DirOpRes;
                attributes.mode _ SunNFSRemoteFile.FixModeForDirectory[mode];
            dirOpRes _ SunNFSClient.Mkdir[rpcH, c, dirOpArgs, attributes];
                IF dirOpRes.status # ok THEN NFSToUnixError[dirOpRes.status, sH, path, "NFS mkdir error"];
                };
            dirOpArgs _ ResolvePath[sH, path];
            CallServer[sH, MkDirInner];
            };

        SunNFSUnixRmDir: PUBLIC UnixRemoteFile.RmDirProc -- [sH: ServerHandle, path: ROPE] -- ~ {
            dirOpArgs: SunNFS.DirOpArgs;
            RmDirInner: InnerProc ~ {
            status: SunNFS.Stat _ SunNFSClient.Rmdir[rpcH, c, dirOpArgs];
                IF status # ok THEN NFSToUnixError[status, sH, path, "NFS rmdir error"];
                };
            dirOpArgs _ ResolvePath[sH, path];
            CallServer[sH, RmDirInner];
            };

        SunNFSUnixLink: PUBLIC UnixRemoteFile.LinkProc -- [sH: ServerHandle, toPath, asPath: ROPE] -- ~ {
            asDirOpArgs: SunNFS.DirOpArgs;
            toFD: FileDescriptor;
            LinkInner: InnerProc ~ {
                status: SunNFS.Stat _ SunNFSClient.Link[rpcH, c, NARROW[toFD], asDirOpArgs];
                IF status # ok THEN NFSToUnixError[status, sH, asPath, "NFS link error"];
                };
            asDirOpArgs _ ResolvePath[sH, asPath];
            toFD _ SunNFSUnixOpen[sH, toPath];
            CallServer[sH, LinkInner];
            };

        SunNFSUnixSymLink: PUBLIC UnixRemoteFile.SymLinkProc -- [sH: ServerHandle, toPath, asPath: ROPE] -- ~ {
            asDirOpArgs: SunNFS.DirOpArgs;
            SymLinkInner: InnerProc ~ {
                attributes: SunNFS.SAttr _ defaultCreateAttributes;
                status: SunNFS.Stat;
                attributes.mode _ SunNFSRemoteFile.FixModeForRegularFile[defaultSymLinkCreateMode];
                status _ SunNFSClient.Symlink[rpcH, c, asDirOpArgs, Rope.ToRefText[asPath], attributes];
                IF status # ok THEN NFSToUnixError[status, sH, asPath, "NFS symlink error"];
                };
            asDirOpArgs _ ResolvePath[sH, asPath];
            CallServer[sH, SymLinkInner];
            };

        SunNFSUnixRename: PUBLIC UnixRemoteFile.RenameProc -- [sH: ServerHandle, fromPath, toPath: ROPE] -- ~ {
            fromDirOpArgs, toDirOpArgs: SunNFS.DirOpArgs;
            RenameInner: InnerProc ~ {
                status: SunNFS.Stat _ SunNFSClient.Rename[rpcH, c, fromDirOpArgs, toDirOpArgs];
                IF status # ok THEN NFSToUnixError[status, sH, fromPath, "NFS rename error"];
                };
            fromDirOpArgs _ ResolvePath[sH, fromPath];
            toDirOpArgs _ ResolvePath[sH, toPath];
            CallServer[sH, RenameInner];
            };

        SunNFSUnixEnumerate: PUBLIC UnixRemoteFile.EnumerateProc -- [sH: ServerHandle, dirPath: ROPE, pattern: ROPE, eachName: 
        EachNameProc] -- ~ {
            dD: FileDescriptor;
            EachEntry: SunNFS.EachDirEntryProc -- [fileid: CARD, filename: FileName] RETURNS [continue: BOOL _ TRUE] -- ~ {
                continue _ eachName[Rope.FromRefText[filename]];
                };
            EnumerateInner: InnerProc ~ {
                status: SunNFS.Stat;
                eof: BOOL _ FALSE;
                cookie: SunNFS.Cookie _ NIL;
                WHILE NOT eof DO
                    [status, eof, cookie] _ SunNFSClient.Readdir[rpcH, c, NARROW[dD], cookie, dirSearchBlocksize, EachEntry];
                IF status # ok THEN NFSToUnixError[status, sH, dirPath, "NFS enumerate error"];
                ENDLOOP;
                };
            dD _ SunNFSUnixOpen[sH, dirPath];
            CallServer[sH, EnumerateInner];
            };

        SunNFSUnixGetInfo: PUBLIC UnixRemoteFile.GetInfoProc -- [sH: ServerHandle, fD: FileDescriptor] RETURNS [type: FType, size: CARD, 
        mode: Mode, mTime: GMT] -- ~ {
            GetInfoInner: InnerProc ~ {
                attrStat: SunNFS.AttrStat _ SunNFSClient.Getattr[rpcH, c, NARROW[fD]];
                IF attrStat.status # ok THEN NFSToUnixError[attrStat.status, sH, NIL, "NFS stat error"];
                type _ attrStat.attributes.type;
                size _ attrStat.attributes.size;
                mode _ SunNFSRemoteFile.GetModeAccessBits[attrStat.attributes.mode];
                mTime _ SunNFSRemoteFile.GMTFromSunTime[attrStat.attributes.mtime];
                };
            CallServer[sH, GetInfoInner];
            };

        SunNFSUnixSetInfo: PUBLIC UnixRemoteFile.SetInfoProc -- [sH: ServerHandle, fD: FileDescriptor, mode: Mode, mTime: GMT] -- ~ {
            SetInfoInner: InnerProc ~ {
                attrStat: SunNFS.AttrStat;
                attributes: SunNFS.SAttr _ defaultCreateAttributes;
                IF mode # CARD.LAST THEN
                    attributes.mode _ SunNFSRemoteFile.UpdateModeAccessBits[attributes.mode, mode];
                IF mTime # BasicTime.nullGMT THEN
                    attributes.mtime _ SunNFSRemoteFile.SunTimeFromGMT[mTime];
                attrStat _ SunNFSClient.Setattr[rpcH, c, NARROW[fD], attributes];
                IF attrStat.status # ok THEN NFSToUnixError[attrStat.status, sH, NIL, "NFS setattr error"];
                };
            CallServer[sH, SetInfoInner];
            };

        SunNFSUnixRead: PUBLIC UnixRemoteFile.ReadProc -- [sH: ServerHandle, fD: FileDescriptor, offset, count: CARD, bOffset: CARD, block: 
        REF TEXT] RETURNS [bytesRead: CARD] -- ~ {
            ReadInner: InnerProc ~ {
                attrStat: SunNFS.AttrStat _ SunNFSClient.Read[rpcH, c, NARROW[fD], offset, count, bOffset, block];
                IF attrStat.status # ok THEN NFSToUnixError[attrStat.status, sH, NIL, "NFS write error"];
                bytesRead _ block.length - bOffset;
                };
            CallServer[sH, ReadInner];
            };

        SunNFSUnixWrite: PUBLIC UnixRemoteFile.WriteProc -- [sH: ServerHandle, fD: FileDescriptor, offset, count: CARD, bOffset: CARD, 
        block: REF TEXT] RETURNS [bytesWritten: CARD] -- ~ {
            WriteInner: InnerProc ~ {
                attrStat: SunNFS.AttrStat;
                IF bOffset >= block.length THEN { bytesWritten _ 0; RETURN };
                count _ MIN[count, block.length-bOffset];
                attrStat _ SunNFSClient.Write[rpcH, c, NARROW[fD], offset, count, bOffset, block];
                IF attrStat.status # ok THEN NFSToUnixError[attrStat.status, sH, NIL, "NFS write error"];
                bytesWritten _ count;
                };
            CallServer[sH, WriteInner];
            };
    <<Private Procedures>>
        CallServer: PROC [sH: ServerHandle, proc: InnerProc] ~ {
            data: SunNFSRemoteFile.ServerData _ NARROW[sH.data];
            rpcH: SunRPC.Handle;
            c: SunRPCAuth.Conversation;
            {
                ENABLE UNWIND => IF rpcH # NIL THEN {
                    rpcH _ SetNFSPort[data, rpcH];
                    SunNFSRemoteFile.ReleaseRPCHandleAndConversation[sH, rpcH, c]; rpcH _ NIL;
                    };
                [rpcH, c] _ SunNFSRemoteFile.ObtainRPCHandleAndConversation[sH];
                proc[data, rpcH, c ! SunRPC.Error => UnixError[code, sH, NIL, "rpc error"]];
                };
            SunNFSRemoteFile.ReleaseRPCHandleAndConversation[sH, rpcH, c];
            };

        SetNFSPort: PROC [data: SunNFSRemoteFile.ServerData, rpcH: SunRPC.Handle] RETURNS [SunRPC.Handle] ~ --INLINE-- {
            RETURN[SunRPC.SetRemote[rpcH, data.address, data.port]];
            };

        SetMountPort: PROC [data: SunNFSRemoteFile.ServerData, rpcH: SunRPC.Handle] RETURNS [SunRPC.Handle] ~ --INLINE-- {
            RETURN[SunRPC.SetRemote[rpcH, data.address, data.mountPort]];
            };

        ResolvePath: PROC [sH: ServerHandle, path: ROPE] RETURNS [dirOpArgs: SunNFS.DirOpArgs] ~ {
            lastSlashPos: INT;
            pathPrefix: ROPE;
            lastSlashPos _ Rope.FindBackward[path, "/"];
            IF lastSlashPos < 0 THEN UnixError[$pathNameSyntax, sH, path, "relative pathnames not supported"];
            IF lastSlashPos > 0
                THEN pathPrefix _ Rope.Substr[path, 0, lastSlashPos]
                ELSE pathPrefix _ "/";
            dirOpArgs.dir _ NARROW[SunNFSUnixOpen[sH, pathPrefix]];
            dirOpArgs.name _ Rope.ToRefText[Rope.Substr[path, lastSlashPos+1]];
            };
    <<Errors>>
        UnixError: PUBLIC PROC [code: ATOM, sH: ServerHandle _ NIL, name, msg: ROPE _ NIL] ~ {
        r: ROPE;
        IF (sH # NIL) OR (name # NIL) THEN {
        r _ Rope.Cat["server: ", (IF sH # NIL THEN sH.name ELSE "?"), ", "];
        r _ Rope.Cat[r, "file: ", (IF name # NIL THEN name ELSE "?"), ", "];
        };
        r _ Rope.Concat[r, msg];
        ERROR UnixRemoteFile.Error[code, r];
            };

        NFSToUnixError: PUBLIC PROC [status: SunNFS.Stat, sH: ServerHandle _ NIL, name, msg: ROPE _ NIL] ~ {
            code: ATOM;
        r: ROPE;

        IF (sH # NIL) OR (name # NIL) THEN {
        r _ Rope.Cat["server: ", (IF sH # NIL THEN sH.name ELSE "?"), ", "];
        r _ Rope.Cat[r, "file: ", (IF name # NIL THEN name ELSE "?"), ", "];
        };
        r _ Rope.Concat[r, msg];

            code _ SELECT status FROM
                perm => $perm,
                noent => $noent,
                io => $io,
                nxio => $nxio,
                acces => $acces,
                exist => $exist,
                nodev => $nodev,
                notdir => $notdir,
                isdir => $isdir,
                fbig => $fbig,
                nospc => $nospc,
                rofs => $rofs,
                nametoolong => $nametoolong,
                dquot => $dquot,
                stale => $stale,
                ENDCASE => Atom.MakeAtom[Convert.RopeFromCard[ORD[status]]];

            ERROR UnixRemoteFile.Error[code, r];
            };

        }...