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];
}.