<<>>
    <<TarCommandsImpl.mesa>>
        <<Copyright Ó 1989 by Xerox Corporation.  All rights reserved.>>
        <<Bill Jackson (bj) July 7, 1989 10:08:40 pm PDT>>
        <<>>
    DIRECTORY
        BasicTime USING [ GMT ],
        Commander USING [ CommandProc, Register ],
        CommandTool USING [ NextArgument ],
        Convert USING [ IntFromRope ],
        FS USING [ StreamOpen ],
        IO USING [ card, Close, int, PutF, PutFR, rope, STREAM, time ],
        RefText USING [ ObtainScratch, ReleaseScratch ],
        Rope USING [ Fetch, FromRefText, Length, ROPE ],
        Tar USING [ FromDF, EnumProc, InfoProc, Scan, SinkProc, ToDF, Warning ],
        UXTime USING [ ToGMT, UP, UXTIME ];

    TarCommandsImpl: CEDAR MONITOR
        IMPORTS Commander, CommandTool, Convert, FS, IO, RefText, Rope, Tar, UXTime ~ {
        ROPE: TYPE ~ Rope.ROPE;

        tarfromdfdoc: ROPE ~ "tarfile dfFile";
        tartodfdoc: ROPE ~ "tarfile pseudo project dfFile";

        tardoc: ROPE ~ "[ - ] crtux [ bBefFhilmopvwX014578 ]
        \t[ tarfile ] [ blocksize ] [ exclude-file ] [ -I include-file ]
        \tfilename1 filename2 ...
        \t-C directory filenameN ...";

        ArgOpt: TYPE ~ { none, blockingFactor, exclude, filename };
        Filtering: TYPE ~ { none, some, lots };
        Function: TYPE ~ { none, append, create, extract, toc, update };

        Switches: TYPE ~ RECORD [
            exitOnError: BOOL _ FALSE,
            followLinks: BOOL _ FALSE,
            forceBuffered: BOOL _ FALSE,
            ignoreChecksumErrors: BOOL _ FALSE,
            linkMessages: BOOL _ FALSE,
            manual: BOOL _ FALSE,
            preserve: BOOL _ FALSE,
            suppressDirectoryModes: BOOL _ FALSE,
            touchFiles: BOOL _ FALSE,
            verbose: BOOL _ FALSE,
            filtering: Filtering _ none
            ];
    <<derived from UnixSys [UnixStat, etc]>>
        Fmt: TYPE ~ MACHINE DEPENDENT {
            null(0),
            fifo(01B),    -- fifo special
            chr(02B),    -- character special
            dir(04B),    -- directory
            blk(06B),    -- block special
            reg(10B),    -- regular file
            lnk(12B),    -- symbolic link
            sock(14B),    -- socket
            (17B)
            };
            <<>>
        Permission: TYPE ~ RECORD [ read, write, exec: BOOL _ FALSE ];

        Mode: TYPE ~ RECORD [
            fmt: Fmt _ null,    -- type of file
            suid: BOOL _ FALSE,    -- set user id on execution
            sgid: BOOL _ FALSE,    -- set group id on execution
            svtx: BOOL _ FALSE,    -- save swapped text even after use
            owner, group, others: Permission
            ];

        ModeToRope: PROC [ mode: Mode ] RETURNS [ rope: ROPE ] ~ {
            text: REF TEXT ~ RefText.ObtainScratch[9];
            text.length _ 9;

            text[0] _ IF ( mode.owner.read ) THEN 'r ELSE '-;
            text[1] _ IF ( mode.owner.write ) THEN 'w ELSE '-;
            text[2] _ IF ( mode.owner.exec ) THEN
                IF ( mode.suid ) THEN 's ELSE 'x ELSE '-;

            text[3] _ IF ( mode.group.read ) THEN 'r ELSE '-;
            text[4] _ IF ( mode.group.write ) THEN 'w ELSE '-;
            text[5] _ IF ( mode.group.exec ) THEN
                IF ( mode.sgid ) THEN 's ELSE 'x ELSE '-;

            text[6] _ IF ( mode.others.read ) THEN 'r ELSE '-;
            text[7] _ IF ( mode.others.write ) THEN 'w ELSE '-;
            text[8] _ IF ( mode.others.exec ) THEN
                IF ( mode.svtx ) THEN 't ELSE 'x ELSE '-;

            rope _ Rope.FromRefText[text];
            RefText.ReleaseScratch[text];
            };

        ModeFromCard32: PROC [ card32: CARD32 ] RETURNS [ mode: Mode ] ~ {
            ODD: PROC [ card32: CARD32 ] RETURNS [ odd: BOOL ] ~ INLINE
            { odd _ ( card32 MOD 2 ) # 0 };
            Triplet: PROC RETURNS [ p: Permission ] ~ {
                p.exec _ ODD[card32]; card32 _ card32 / 2;
                p.write _ ODD[card32]; card32 _ card32 / 2;
                p.read _ ODD[card32]; card32 _ card32 / 2;
                };
            mode.others _ Triplet[];
            mode.group _ Triplet[];
            mode.owner _ Triplet[];
            {
                special: Permission _ Triplet[];
                mode.suid _ special.read; mode.sgid _ special.write; mode.svtx _ special.exec;
                };
            {
                format: BYTE[0..20B) ~ card32 MOD ( ORD[Fmt.LAST]+1 );
                mode.fmt _ VAL[format];
                };
            };
    <<Actual Operations>>
        ListContents: PUBLIC PROC [ out: IO.STREAM, filename: ROPE,
        options: LIST OF ArgOpt, switches: Switches ] ~ {
            ENABLE Tar.Warning => { IF ( switches.exitOnError ) THEN REJECT ELSE RESUME };
            ListFile: Tar.InfoProc ~ {
                IF ( switches.verbose ) THEN {
                    mode: Mode ~ ModeFromCard32[info.mode];
                    modeRope: ROPE ~ ModeToRope[mode];
                    time: UXTime.UXTIME ~ UXTime.UP[info.mtime];
                    created: BasicTime.GMT ~ time.ToGMT[];
                    out.PutF["%g", IO.rope[modeRope] ];
                    out.PutF[" %g/%g", IO.card[info.uid], IO.card[info.gid] ];
                    out.PutF["\t%g %g", IO.card[info.size], IO.time[created] ];
                    };
                out.PutF[" %g", IO.rope[info.name] ];
                SELECT info.linkflag FROM
                    zero => { NULL };
                    normal => { NULL };
                    hard => { out.PutF[" linked to %g", IO.rope[info.linkname] ] };
                    symbolic => { out.PutF[" symbolic link to %g", IO.rope[info.linkname] ] };
                    ENDCASE => {
                        out.PutF["\n\t"];
                        out.PutF[" linkflag: %g", IO.card[info.linkflag.ORD] ];
                        out.PutF[" linkname: %g", IO.rope[info.linkname] ];
                        };
                out.PutF["\n"];
                IF ( FALSE ) THEN out.PutF["\t chksum: %g\n", IO.card[info.chksum] ];
                };
            tarfile: IO.STREAM ~ FS.StreamOpen[filename, $read];
            [] _ Tar.Scan[tarfile, ListFile];
            tarfile.Close[];
            };
    <<Commands>>
        TarFromDFCmd: Commander.CommandProc ~ {
            out: IO.STREAM ~ cmd.out;
            tarfile: ROPE ~ CommandTool.NextArgument[cmd];
            dfName: ROPE ~ CommandTool.NextArgument[cmd];
            s: IO.STREAM ~ FS.StreamOpen[tarfile, $create];
            dfFile: IO.STREAM ~ FS.StreamOpen[dfName, $read];
            Enum: Tar.EnumProc ~ {
                };
            Sink: Tar.SinkProc ~ {
                };
            Tar.FromDF[s, Enum, Sink, dfFile];
            s.Close[];
            dfFile.Close[];
            };

        TarToDFCmd: Commander.CommandProc ~ {
            out: IO.STREAM ~ cmd.out;
            tarfile: ROPE ~ CommandTool.NextArgument[cmd];
            pseudo: ROPE ~ CommandTool.NextArgument[cmd];
            project: ROPE ~ CommandTool.NextArgument[cmd];
            dfName: ROPE ~ CommandTool.NextArgument[cmd];
            s: IO.STREAM ~ FS.StreamOpen[tarfile, $read];
            dfFile: IO.STREAM ~ FS.StreamOpen[dfName, $create];
            Tar.ToDF[s, pseudo, project, dfFile];
            s.Close[];
            dfFile.Close[];
            };

        TarCmd: Commander.CommandProc ~ {
            out: IO.STREAM ~ cmd.out;
            keys: ROPE ~ CommandTool.NextArgument[cmd];
            fcn: Function _ none;
            options: LIST OF ArgOpt _ NIL;
            switches: Switches;
            drive: BYTE _ BYTE.LAST;
            filename: ROPE _ "/dev/rmt8";
            excludeList: LIST OF ROPE _ NIL;
            blockingFactor: INT _ 20;
            [fcn, options, switches, drive] _ ParseKeys[keys];
            IF ( drive # BYTE.LAST ) THEN filename _ IO.PutFR["/dev/rmt%g", IO.int[drive] ];
            FOR tail: LIST OF ArgOpt _ options, tail.rest WHILE ( tail # NIL ) DO
                SELECT tail.first FROM
                    none => { ERROR };
                    blockingFactor => {
                        factor: ROPE ~ CommandTool.NextArgument[cmd];
                        blockingFactor _ Convert.IntFromRope[factor];
                        };
                    exclude => {
                        excludeFile: ROPE ~ CommandTool.NextArgument[cmd];
                        excludeList _ CONS[excludeFile, excludeList];
                        };
                    filename => { filename _ CommandTool.NextArgument[cmd] };
                    ENDCASE => { ERROR };
                ENDLOOP;
            SELECT fcn FROM
                toc => { ListContents[out, filename, options, switches] };
                extract => { ERROR };
                append => { ERROR };
                create => { ERROR };
                update => { ERROR };
                none => { ERROR };
                ENDCASE => { ERROR };
            };

        ParseKeys: PROC [ keys: ROPE ] RETURNS [
        fcn: Function _ none,
        options: LIST OF ArgOpt _ NIL,
        switches: Switches,
        drive: BYTE _ BYTE.LAST ] ~ {
            FOR i: INT IN [0..keys.Length[]) DO
                char: CHAR ~ keys.Fetch[i];
                SELECT char FROM
                    '- => { NULL };
                <<Functions>>
                    'c => { IF ( fcn # none ) THEN ERROR; fcn _ create }; -- create new tarfile
                    'r => { IF ( fcn # none ) THEN ERROR; fcn _ append }; -- append files (run up?)
                    't => { IF ( fcn # none ) THEN ERROR; fcn _ toc }; -- table of contents
                    'u => { IF ( fcn # none ) THEN ERROR; fcn _ update }; -- update files
                    'x => { IF ( fcn # none ) THEN ERROR; fcn _ extract }; -- extract files
                <<Tape Drive numbers>>
                    '0 => { IF ( drive # BYTE.LAST ) THEN ERROR; drive _ 0 }; -- zero
                    '1 => { IF ( drive # BYTE.LAST ) THEN ERROR; drive _ 1 }; -- one
                    '4 => { IF ( drive # BYTE.LAST ) THEN ERROR; drive _ 4 }; -- four
                    '5 => { IF ( drive # BYTE.LAST ) THEN ERROR; drive _ 5 }; -- file
                    '7 => { IF ( drive # BYTE.LAST ) THEN ERROR; drive _ 7 }; -- seven
                    '8 => { IF ( drive # BYTE.LAST ) THEN ERROR; drive _ 8 }; -- eight
                <<Modifiers>>
                    'B => { switches.forceBuffered _ TRUE }; -- force multiple reads
                    'e => { switches.exitOnError _ TRUE }; -- exit immediately
                    'h => { switches.followLinks _ TRUE }; -- follow symbolic links
                    'i => { switches.ignoreChecksumErrors _ TRUE }; -- ignore checksum errors
                    'l => { switches.linkMessages _ TRUE }; -- unresolved link error msgs
                    'm => { switches.touchFiles _ TRUE }; -- mtime _ now
                    'o => { switches.suppressDirectoryModes _ TRUE }; -- suppress dir owner and modes
                    'p => { switches.preserve _ TRUE }; -- preserve
                    'v => { switches.verbose _ TRUE }; -- verbose
                    'w => { switches.manual _ TRUE }; -- wait for confirmation
                <<Modifiers (wierd guy)>>
                    'F => {
                        <<filter SCCS directories [[.o, errs, core, a.out]]>>
                        switches.filtering _ SELECT switches.filtering FROM 
                            none => some,
                            some => lots,
                            lots => ERROR
                            ENDCASE => ERROR;
                        };
                <<Modifiers (args-related)>>
                    'b => { options _ CONS[blockingFactor, options] }; -- blocking factor
                    'f => { options _ CONS[filename, options] }; -- file name
                    'X => { options _ CONS[exclude, options] }; -- exclude files (from list)
                <<anything else is garbage!>>
                    ENDCASE => { ERROR };
                ENDLOOP;
                {
                    reversed: LIST OF ArgOpt _ NIL;
                    FOR tail: LIST OF ArgOpt _ options, tail.rest WHILE ( tail # NIL ) DO
                        reversed _ CONS[tail.first, reversed];
                        ENDLOOP;
                    options _ reversed;
                    };
            };

        Commander.Register["tar", TarCmd, tardoc];
        Commander.Register["TarFromDF", TarFromDFCmd, tarfromdfdoc];
        Commander.Register["TarToDF", TarToDFCmd, tartodfdoc];

        }.