<<>>
    <<TarImpl.mesa>>
        <<Copyright Ó 1989 by Xerox Corporation.  All rights reserved.>>
        <<Bill Jackson (bj) July 7, 1989 10:12:14 pm PDT>>
        <<Willie-sue, August 10, 1989 1:02:39 pm PDT>>
        <<>>
    DIRECTORY
        Basics USING [ UnsafeBlock ],
        BasicTime USING [ GMT, Now, nullGMT ],
        Convert USING [ CardFromRope ],
        DFUtilities USING [ CommentItem, Date, DirectoryItem, FileItem, WhiteSpaceItem, WriteItemToStream ],
        IO USING [ card, GetIndex, PutF, PutFR, rope, SetIndex, STREAM, time, UnsafeGetBlock ],
        RefText USING [ ObtainScratch, ReleaseScratch ],
        Rope USING [ Fetch, FromRefText, Length, ROPE ],
        Tar USING [ EnumProc, FileInfo, InfoProc, SinkProc ],
        TarFileFormat USING [ Header, headerBytes, Link, LinkType, NAME, NAMSIZ, OCTAL8, OCTAL12, TBLOCK ],
        TarPrivate,
        UXTime USING [ ToGMT, UP, UXTIME ];

    TarImpl: CEDAR MONITOR
        IMPORTS BasicTime, Convert, DFUtilities, IO, RefText, Rope, UXTime
        EXPORTS Tar, TarPrivate ~ {
        OPEN Tar, TarFileFormat;

        ROPE: TYPE ~ Rope.ROPE;
        STREAM: TYPE ~ IO.STREAM;

        Malformed: PUBLIC ERROR [ how: ROPE ] ~ CODE;
        Warning: PUBLIC SIGNAL [ msg: ROPE ] ~ CODE;

        Finished: PUBLIC ERROR ~ CODE;

        FileInfoFromHeader: PUBLIC PROC [ h: Header ] RETURNS [ info: FileInfo ] ~ {
            chksum: CARD32 ~ Checksum[h];
            otherChksum: CARD32 ~ OtherChecksum[h];
            info.name _ RopeFromName[h.name];
            info.mode _ CardFromOctal8[h.mode];
            info.uid _ CardFromOctal8[h.uid];
            info.gid _ CardFromOctal8[h.gid];
            info.size _ CardFromOctal12[h.size];
            info.mtime _ CardFromOctal12[h.mtime];
            info.chksum _ CardFromOctal8[h.chksum];
            [info.linkflag, info.linkname] _ DecodeLinkName[h.link];
            IF ( chksum # info.chksum ) THEN Warning["bad Header/Checksum"];
            IF ( otherChksum # info.chksum ) THEN Warning["bad Header/OtherChecksum"];
            };

        HeaderFromFileInfo: PUBLIC PROC[ info: FileInfo ] RETURNS[ h: Header ] ~ {
            h.name _ NameFromRope[info.name];
            h.mode _ Octal8FromCard[info.mode];
            h.uid _ Octal8FromCard[info.uid];
            h.gid _ Octal8FromCard[info.gid];
            h.size _ Octal12FromCard[info.size];
            h.mtime _ Octal12FromCard[info.mtime];
            h.link _ LinkFromRope[info.linkname];
            h.chksum _ Octal8FromCard[Checksum[h]];
            };

        Checksum: PUBLIC PROC [ h: Header ] RETURNS [ chksum: CARD32 _ 0 ] ~ TRUSTED {
            p: LONG POINTER TO PACKED ARRAY [0..headerBytes) OF BYTE ~ LOOPHOLE[LONG[@h]];
            FOR i: NAT IN [0..headerBytes) DO chksum _ chksum + p[i]; ENDLOOP;
            FOR i: NAT IN [0..8) DO chksum _ chksum - h.chksum[i].ORD; ENDLOOP;
            FOR i: NAT IN [0..8) DO chksum _ chksum + 40B; ENDLOOP;
            };

        OtherChecksum: PUBLIC PROC [ h: Header ] RETURNS [ chksum: CARD32 _ 0 ] ~ TRUSTED {
            p: LONG POINTER TO PACKED ARRAY [0..headerBytes) OF BYTE ~ LOOPHOLE[LONG[@h]];
            FOR i: NAT IN [0..headerBytes) DO chksum _ chksum + p[i]; ENDLOOP;
            FOR i: NAT IN [0..8) DO chksum _ chksum + 40B; ENDLOOP;
            FOR i: NAT IN [0..8) DO chksum _ chksum - h.chksum[i].ORD; ENDLOOP;
            };

        EmptyHeader: PUBLIC PROC [ h: Header ] RETURNS [ yes: BOOL _ FALSE ] ~ TRUSTED {
            p: LONG POINTER TO PACKED ARRAY [0..headerBytes) OF BYTE ~ LOOPHOLE[LONG[@h]];
            FOR i: NAT IN [0..headerBytes) DO IF ( p[i] # 0 ) THEN RETURN; ENDLOOP;
            yes _ TRUE;
            };

        CardFromOctal8: PUBLIC PROC [ o: OCTAL8 ] RETURNS [ c: CARD32 ] ~ {
            text: REF TEXT ~ RefText.ObtainScratch[6];
            SELECT TRUE FROM
                ( o[7] # '\000 ) => { Warning["missing NUL in OCTAL8"] };
                ( o[6] # '  ) => { Warning["missing SPACE in OCTAL8"] };
                ENDCASE => { NULL };
            FOR i: NAT IN [0..6) DO text[i] _ o[i]; text.length _ i.SUCC; ENDLOOP;
            {
                rope: ROPE ~ Rope.FromRefText[text];
                c _ Convert.CardFromRope[rope, 8];
                RefText.ReleaseScratch[text];
                };
            };

        Octal8FromCard: PUBLIC PROC [ c: CARD32 ] RETURNS[ o8: OCTAL8 ] = {
            r: ROPE ~ IO.PutFR["%6b", [cardinal[c]] ];
            o8[7] _ '\000;
            o8[6] _ ' ;
            FOR i: NAT IN [0..6) DO
                <<o8[i] _ IF r.Fetch[i] = '   THEN '\000 ELSE r.Fetch[i];>>
                o8[i] _ r.Fetch[i];
                ENDLOOP;
            };

        CardFromOctal12: PUBLIC PROC [ o: OCTAL12 ] RETURNS [ c: CARD32 ] ~ {
            text: REF TEXT ~ RefText.ObtainScratch[11];
            SELECT TRUE FROM
                <<( o[12] # '\000 ) => { Warning["missing NUL in OCTAL12"] };>>
                ( o[11] # '  ) => { Warning["missing SPACE in OCTAL12"] };
                ENDCASE => { NULL };
            FOR i: NAT IN [0..11) DO text[i] _ o[i]; text.length _ i.SUCC; ENDLOOP;
            {
                rope: ROPE ~ Rope.FromRefText[text];
                c _ Convert.CardFromRope[rope, 8];
                RefText.ReleaseScratch[text];
                };
            };

        Octal12FromCard: PUBLIC PROC [ c: CARD32 ] RETURNS [ o12: OCTAL12 ] ~ {
            r: ROPE ~ IO.PutFR["%11b", [cardinal[c]] ];
            o12[11] _ ' ;
            FOR i: NAT IN [0..11) DO
                <<o12[i] _ IF r.Fetch[i] = '   THEN '\000 ELSE r.Fetch[i];>>
                o12[i] _ r.Fetch[i];
                ENDLOOP;
            };

        GMTFromOctal12: PUBLIC PROC [ o: OCTAL12 ] RETURNS [ time: BasicTime.GMT ] ~ {
            card32: CARD32 ~ CardFromOctal12[o];
            uxtime: UXTime.UXTIME ~ UXTime.UP[card32];
            time _ uxtime.ToGMT[];
            };

        RopeFromName: PUBLIC PROC [ name: NAME ] RETURNS [ r: ROPE ] ~ {
            text: REF TEXT ~ RefText.ObtainScratch[NAMSIZ];
            FOR i: NAT IN [0..NAMSIZ) WHILE ( name[i] # '\000 )
            DO text[i] _ name[i]; text.length _ i.SUCC; ENDLOOP; 
            r _ Rope.FromRefText[text];
            RefText.ReleaseScratch[text];
            };

        NameFromRope: PUBLIC PROC [ r: ROPE ] RETURNS[ n: NAME ] ~ {
            FOR i: INT IN [0..r.Length[]) DO n[i] _ r.Fetch[i]; ENDLOOP;
            FOR i: INT IN [r.Length[] .. NAMSIZ) DO n[i] _ '\000; ENDLOOP;
            };

        LinkFromRope: PUBLIC PROC [ r: ROPE ] RETURNS[ l: Link ] ~ {
            FOR i: INT IN [0..r.Length[]) DO l[i] _ r.Fetch[i]; ENDLOOP;
            FOR i: INT IN [r.Length[] .. NAMSIZ+2) DO l[i] _ '\000; ENDLOOP;
            };

        DecodeLinkName: PUBLIC PROC [ link: Link ] RETURNS [ flag: LinkType, name: ROPE ] ~ {
            text: REF TEXT ~ RefText.ObtainScratch[NAMSIZ];
            flag _ VAL[link.bytes[0].ORD];
            FOR i: NAT IN [0..NAMSIZ) WHILE ( link.bytes[i.SUCC] # '\000 )
            DO text[i] _ link.bytes[i.SUCC]; text.length _ i.SUCC; ENDLOOP; 
            name _ Rope.FromRefText[text];
            RefText.ReleaseScratch[text];
            };

        GetHeader: PUBLIC PROC [ s: IO.STREAM ] RETURNS [ h: Header ] ~ TRUSTED {
            finger: INT ~ s.GetIndex[];
            unsafe: Basics.UnsafeBlock ~ [LOOPHOLE[LONG[@h]], 0, headerBytes];
            IF ( s.UnsafeGetBlock[unsafe] # headerBytes )
            THEN ERROR Malformed["EOF encountered when reading header"];
            IF ( EmptyHeader[h] ) THEN ERROR Finished[];
            s.SetIndex[finger+TBLOCK];
            };

        Scan: PUBLIC PROC [ s: IO.STREAM, p: InfoProc ]
        RETURNS [ aborted: BOOL _ FALSE ] ~ TRUSTED {
            DO
                header: Header ~ GetHeader[s ! Finished => GOTO Bottom];
                info: FileInfo ~ FileInfoFromHeader[header];
                finger: INT ~ s.GetIndex[];
                records: INT ~ ( info.size + TBLOCK.PRED ) / TBLOCK;
                bytes: INT ~ records * TBLOCK;
                newIndex: INT ~ finger+bytes;
                IF ( aborted _ p[info, s] ) THEN RETURN;
                SELECT info.linkflag FROM
                    zero => { s.SetIndex[newIndex] };
                    normal => { s.SetIndex[newIndex] };
                    hard => { NULL };
                    symbolic => { NULL };
                    ENDCASE => { ERROR };
                ENDLOOP;
            EXITS
                Bottom => { NULL };
            };
    <<DF processing>>
        blankLine: REF DFUtilities.WhiteSpaceItem ~ NEW[DFUtilities.WhiteSpaceItem _ [lines: 1]];
        noDate: DFUtilities.Date ~ [format: $omitted, gmt: BasicTime.nullGMT];

        FromDF: PUBLIC PROC [s: STREAM, enum: EnumProc, sink: SinkProc, dfFile: STREAM] ~ {
            ERROR;
            };

        AddInfoHdr: PROC [s: STREAM, project: ROPE, user: ROPE]~ {
            projectLine: ROPE ~ IO.PutFR["-- %g.df", [rope[project]]];
            copyright: ROPE ~ "-- Copyright Ó 1989, by Xerox Corporation.  All rights reserved.";
            timeLine: ROPE ~ IO.PutFR["-- %g, %g", IO.rope[user], IO.time[BasicTime.Now[]]];
            comment: REF DFUtilities.CommentItem ~ NEW[DFUtilities.CommentItem];
            comment.text _ projectLine; DFUtilities.WriteItemToStream[s, comment];
            comment.text _ copyright; DFUtilities.WriteItemToStream[s, comment];
            comment.text _ timeLine; DFUtilities.WriteItemToStream[s, comment];
            DFUtilities.WriteItemToStream[s, blankLine];
            };

        AddBoilerplate: PROC [s: IO.STREAM, pseudo: ROPE, project: ROPE]~ {
            topName: ROPE ~ IO.PutFR["[%g]<Top>", IO.rope[pseudo] ];
            dirName: ROPE ~ IO.PutFR["[%g]<%g>", IO.rope[pseudo], IO.rope[project] ];
            dfName: ROPE ~ IO.PutFR["%g.df", IO.rope[project] ];
            export: REF DFUtilities.DirectoryItem ~ NEW[DFUtilities.DirectoryItem _ [path1: NIL, path2: NIL, path2IsCameFrom: FALSE, exported: 
            TRUE, readOnly: FALSE]];
            dir: REF DFUtilities.DirectoryItem ~ NEW[DFUtilities.DirectoryItem _ [path1: NIL, path2: NIL, path2IsCameFrom: FALSE, exported: 
            FALSE, readOnly: FALSE]];
            file: REF DFUtilities.FileItem ~ NEW[DFUtilities.FileItem _ [name: NIL, date: noDate, verifyRoot: FALSE]];
            export.path1 _ topName; DFUtilities.WriteItemToStream[s, export];
            DFUtilities.WriteItemToStream[s, blankLine];
            file.name _ dfName; DFUtilities.WriteItemToStream[s, file];
            DFUtilities.WriteItemToStream[s, blankLine];
            dir.path1 _ dirName; DFUtilities.WriteItemToStream[s, dir];
            DFUtilities.WriteItemToStream[s, blankLine];
            };

        EntryForInfo: PROC [ info: FileInfo ]
        RETURNS [ name: ROPE, date: DFUtilities.Date ] ~ {
            uxtime: UXTime.UXTIME ~ UXTime.UP[info.mtime];
            gmt: BasicTime.GMT ~ uxtime.ToGMT[];
            name _ info.name;
            date _ [format: $explicit, gmt: gmt];
            };

        AddTarFile: PROC [dfFile: IO.STREAM, tarfile: IO.STREAM] ~ {
            AddTarEntry: InfoProc ~ {
                file: REF DFUtilities.FileItem ~ NEW[DFUtilities.FileItem _
                [name: NIL, date: noDate, verifyRoot: FALSE]];
                [file.name, file.date] _ EntryForInfo[info];
                DFUtilities.WriteItemToStream[dfFile, file];
                };
            [] _ Scan[tarfile, AddTarEntry];
            };

        AddBottom: PROC [s: IO.STREAM] ~ {
            eof: ROPE ~ "-- eof";
            comment: REF DFUtilities.CommentItem ~ NEW[DFUtilities.CommentItem];
            DFUtilities.WriteItemToStream[s, blankLine];
            comment.text _ eof; DFUtilities.WriteItemToStream[s, comment];
            };

        ToDF: PUBLIC PROC [s: IO.STREAM, pseudo: ROPE, project: ROPE, dfFile: IO.STREAM] ~ {
            user: ROPE ~ "Created via Tar.ToDF";
            AddInfoHdr[dfFile, project, user];
            AddBoilerplate[dfFile, pseudo, project];
            AddTarFile[dfFile, s];
            AddBottom[dfFile];
            };
    <<for debugging>>
        stdout: IO.STREAM;
        PrintInfo: InfoProc ~ {
            stdout.PutF[" name: %g", IO.rope[info.name] ];
            stdout.PutF[" mode: %g", IO.card[info.mode] ];
            stdout.PutF[" uid: %g", IO.card[info.uid] ];
            stdout.PutF[" gid: %g", IO.card[info.gid] ];
            stdout.PutF[" size: %g", IO.card[info.size] ];
            stdout.PutF[" mtime: %g", IO.card[info.mtime] ];
            stdout.PutF[" chksum: %g", IO.card[info.chksum] ];
            stdout.PutF[" linkflag: %g", IO.card[info.linkflag.ORD] ];
            stdout.PutF[" linkname: %g\n", IO.rope[info.linkname] ];
            };

        }.
    <<>>