DIRECTORY
Basics USING [UnsafeBlock],
BasicTime USING [Now],
Commander USING [CommandProc, Handle, Register],
CommandTool USING [ArgumentVector, Failed, Parse],
IO USING [card, Close, Flush, GetBlock, GetIndex, GetLength, PutBlock, PutF, PutF1, PutFR1, rope, STREAM, time, UnsafePutBlock],
PFS USING [Error, PathFromRope, StreamOpen],
PFSNames USING [PATH],
Process USING [CheckForAbort],
RedBlackTree USING [EachNode, EnumerateIncreasing, Table],
RefText USING [ObtainScratch, ReleaseScratch],
Rope USING [Concat, Fetch, Length, ROPE],
Tar USING [FileInfo],
TarFileFormat USING [Header, headerBytes, LinkType, TBLOCK],
TarPrivate USING [HeaderFromFileInfo],
TarTrickle USING [BumpCounter, FileEntry, EnumerateDFs, EnumerateFiles, TCInfo, TCInfoRec, TCType, Translation],
UnixStat USING [Stat, StatPtr],
UnixSysCalls USING [RES, Stat],
UXStrings USING [Create];

PTrickleChargeToTarImpl: CEDAR MONITOR
IMPORTS BasicTime, Commander, CommandTool, IO, Process, RedBlackTree, Rope, RefText, TarPrivate, TarTrickle, PFS, UnixSysCalls, UXStrings ~ {
OPEN TarTrickle;
ROPE: TYPE ~ Rope.ROPE;
TBLOCK: NAT ~ TarFileFormat.TBLOCK;
dirDoc: ROPE ~ " tarFile srcDir
  moves files from srcDir/.. to tarFile
  removes prefix srcDir/ from resultant file names
  ";
allDfsDoc: ROPE ~ "{ { prefix translation supress } } tarFile subDir
  moves files from translation/subDir/*.df to tarFile
  removes prefix supress/ from resultant file names
  ";
oneDfDoc: ROPE ~ "{ { prefix translation supress } } tarFile dfName
  moves files from translation/subDir/dfName to tarFile
  removes prefix supress/ from resultant file names
  ";
nullBuffer: REF TEXT _ NEW[TEXT[TBLOCK]]; -- logically a readonly bunch of null's
StreamToStreamCopy: PROC [to, from: IO.STREAM] ~ {
copyBuffer: REF TEXT ~ RefText.ObtainScratch[TBLOCK];
DO
bytes: NAT ~ from.GetBlock[copyBuffer, 0, TBLOCK];
SELECT TRUE FROM
( bytes = 0 ) => { EXIT };
( bytes < TBLOCK ) => {
to.PutBlock[copyBuffer];
to.PutBlock[block: nullBuffer, startIndex: bytes];
EXIT;
};
( bytes = TBLOCK ) => { to.PutBlock[copyBuffer] };
ENDCASE => ERROR; -- bytes > TBLOCK
ENDLOOP;
RefText.ReleaseScratch[copyBuffer];
};

WriteHeaderToTarFile: PROC [tarFile: IO.STREAM, h: TarFileFormat.Header] ~ TRUSTED {
unsafe: Basics.UnsafeBlock ~ [LOOPHOLE[LONG[@h]], 0, TarFileFormat.headerBytes];
tarFile.UnsafePutBlock[unsafe];
tarFile.PutBlock[block: nullBuffer, startIndex: TarFileFormat.headerBytes];	-- pad to TBLOCK
};

FinishAndPadTarFileToBlocking: PROC [tarFile: IO.STREAM, blocking: NAT] ~ {
nBlocks, needed: INT;
len: INT ~ tarFile.GetIndex[];
IF ( len MOD TBLOCK ) # 0 THEN {
tarFile.Close[];		-- so we can examine the remains
ERROR;
};	-- someone messed up
tarFile.PutBlock[nullBuffer]; tarFile.PutBlock[nullBuffer]; -- 2 nullBuffer's for EOF
nBlocks _ tarFile.GetIndex[] / TBLOCK;
needed _ nBlocks MOD blocking;
FOR i: INT IN [0..needed) DO tarFile.PutBlock[nullBuffer]; ENDLOOP;
};
UnixNames: PROC [entry: FileEntry]
RETURNS [caseFileName, fullUnix, relative, relativeCaseName: ROPE _ NIL] ~ {
};

CopyFileToTar: PROC [entry: FileEntry, tarFile, out: IO.STREAM] ~ TRUSTED {
caseFileName, fullUnix, relative, relativeCaseName: ROPE;
fileInfo: Tar.FileInfo;
stats: UnixStat.Stat; statPtr: UnixStat.StatPtr _ @stats; res: UnixSysCalls.RES;
[caseFileName, fullUnix, relative, relativeCaseName] _ UnixNames[entry];
out.PutF1["\n**entry.relative (1): %g\n", [rope[relative]] ];

entry.state _ doingHeader;
TRUSTED { res _ UnixSysCalls.Stat[UXStrings.Create[fullUnix], statPtr] };
IF ( res # success ) THEN {
out.PutF1["\n\tCould not do Stat on %g, so skipping it\n", [rope[fullUnix]] ];
RETURN
};
{
srcStream: IO.STREAM _ NIL;
unixPath: PFSNames.PATH ~ PFS.PathFromRope[fullUnix];
out.PutF1["\n**entry.relative (2): %g\n", [rope[relative]] ];
TRUSTED {
fileInfo.mode _ LOOPHOLE[statPtr.mode];
fileInfo.uid _ statPtr.uid;
fileInfo.gid _ statPtr.gid;
fileInfo.size _ statPtr.size;
fileInfo.mtime _ statPtr.mtime;
fileInfo.name _ relative;
};
WriteHeaderToTarFile[tarFile, TarPrivate.HeaderFromFileInfo[fileInfo]];
entry.state _ copying;
srcStream _ PFS.StreamOpen[unixPath, $read];
StreamToStreamCopy[to: tarFile, from: srcStream]; 	-- pads to TBLOCK
srcStream.Close[];
};
TRUSTED { res _ UnixSysCalls.Stat[UXStrings.Create[caseFileName], statPtr] };
IF ( res = success ) THEN TRUSTED {
fileInfo.mode _ LOOPHOLE[statPtr.mode];
fileInfo.uid _ statPtr.uid;
fileInfo.gid _ statPtr.gid;
fileInfo.mtime _ statPtr.mtime;
};
fileInfo.size _ 0;
fileInfo.name _ relativeCaseName;
WriteHeaderToTarFile[tarFile, TarPrivate.HeaderFromFileInfo[fileInfo]];
tarFile.Flush[];
entry.state _ moved;
};

Phase1Enum: PUBLIC PROC [out: IO.STREAM, tcInfo: TCInfo, bestEfforts: BOOL, test: BOOL]
RETURNS [table: RedBlackTree.Table, filesSeen: INT _ 0, bytesSeen: INT _ 0] ~ {
target: ROPE ~ tcInfo.arg;
SELECT tcInfo.tcType FROM
oneDF =>  {
pattern: ROPE ~ target.Concat["!H"];
[table, filesSeen] _ TarTrickle.EnumerateDFs[pattern, tcInfo, out, test];
};
allDFs => {	
pattern: ROPE ~ target.Concat["*.df!H"];
[table, filesSeen] _ TarTrickle.EnumerateDFs[pattern, tcInfo, out, test];
};
fullDirectory => {		-- Trickling a whole directory.
pattern: ROPE ~ target.Concat["*!H"];
[table, filesSeen, bytesSeen] _ TarTrickle.EnumerateFiles[pattern, out];
};
ENDCASE => ERROR;
};

Phase2Copy: PROC [tarFile, out: IO.STREAM, table: RedBlackTree.Table, blocking: NAT] ~ {
filesMoved: INT _ 0;
NoteFileMoved: PROC ~ INLINE
{ filesMoved _ TarTrickle.BumpCounter[out, filesMoved] };
EachEntry: RedBlackTree.EachNode ~ {
WITH data SELECT FROM
entry: FileEntry => {
IF ( entry.state = moved ) THEN RETURN;
CopyFileToTar[entry, tarFile, out];
NoteFileMoved[];
};
ENDCASE => ERROR;
};
out.PutF1["\n***** Copying files at %g\n", [time[BasicTime.Now[]]] ];
table.EnumerateIncreasing[EachEntry];
FinishAndPadTarFileToBlocking[tarFile, blocking];
{
tarBytes: INT ~ tarFile.GetLength[];
out.PutF["\n Moved %g files, resulting tarFile is %g bytes\n",
[integer[filesMoved]], [integer[tarBytes]] ];
out.PutF1["\n{Done at %g}\n", [time[BasicTime.Now[]]] ];
};
};

Phase2CopyList: PROC [listing, out: IO.STREAM, table: RedBlackTree.Table] ~ {
filesMoved: INT _ 0;
NoteFileMoved: PROC ~ INLINE
{ filesMoved _ TarTrickle.BumpCounter[out, filesMoved] };
EachEntry: RedBlackTree.EachNode ~ {
WITH data SELECT FROM
entry: FileEntry => {
version: CARDINAL ~ IF ( entry.version.versionKind # numeric )
THEN 0 ELSE entry.version.version;
IF ( entry.state = moved ) THEN RETURN;
listing.PutF["type: [%g], %g (%g) %g\n", IO.card[entry.fileType], IO.rope[entry.name], IO.time[entry.date], IO.card[version]];
NoteFileMoved[];
};
ENDCASE => ERROR;
};
out.PutF1["\n*** {Listing files at %g} ***\n", [time[BasicTime.Now[]]] ];
table.EnumerateIncreasing[EachEntry];
out.PutF1["\n*** {Done at %g} ***\n", [time[BasicTime.Now[]]] ];
};

DoIt: ENTRY PROC [out: IO.STREAM, tcInfo: TCInfo, test: BOOL _ FALSE, blocking: NAT _ 20, bestEfforts: BOOL _ TRUE] ~ {
ENABLE UNWIND => NULL;
table: RedBlackTree.Table; filesSeen: INT _ 0; bytesSeen: INT _ 0;
out.PutF["\n\tTar'ing files from %g to %g\n",
[rope[tcInfo.arg]],  [rope[tcInfo.tarFileName]] ];
out.PutF1["\n***** Building file table at %g\n", [time[BasicTime.Now[]]] ];
[table, filesSeen, bytesSeen] _ Phase1Enum[out, tcInfo, bestEfforts, test];
out.PutF["\nEnumerated files: %g, bytes: %g\n",
[integer[filesSeen]], [integer[bytesSeen]] ];
IF ( filesSeen = 0 ) THEN RETURN;	-- nothing to do
IF ( test ) THEN RETURN;
{
tarPath: PFSNames.PATH ~ PFS.PathFromRope[tcInfo.tarFileName];
tarFile: IO.STREAM ~ PFS.StreamOpen[tarPath, $create];
Phase2CopyList[tarFile, out, table];
IF ( FALSE ) THEN Phase2Copy[tarFile, out, table, blocking];
tarFile.Close[]; -- get it out there
};
};
Testing: PROC [atom: ATOM] RETURNS [test: BOOL] ~ {
test _ SELECT atom FROM
$dir => FALSE,
$one => FALSE,
$onetest => TRUE,
$all => FALSE,
ENDCASE => ERROR;
};

OpType: PROC [atom: ATOM] RETURNS [tcType: TCType] ~ {
tcType _ SELECT atom FROM
$dir => fullDirectory,
$one => oneDF,
$onetest => oneDF,
$all => allDFs,
ENDCASE => ERROR;
};

CommonCmd: Commander.CommandProc ~ {
atom: ATOM ~ NARROW[cmd.procData.clientData];
out: IO.STREAM ~ cmd.out;
test: BOOL _ Testing[atom];
this: TCInfo _ NEW[TCInfoRec _ [tcType: OpType[atom]] ];
argv: CommandTool.ArgumentVector _ CommandTool.Parse[cmd
! CommandTool.Failed => {msg _ errorMsg; GOTO failed}];

i: NAT; FOR i _ 1, i.SUCC WHILE ( i < argv.argc ) DO
arg: ROPE ~ argv[i];
Process.CheckForAbort[];
IF ( arg.Length[] = 0 ) THEN LOOP;
SELECT arg.Fetch[0] FROM
'{ => {
prefix: ROPE _ argv[i _ i.SUCC];
translation: ROPE _ argv[i _ i.SUCC];
supress: ROPE _ argv[i _ i.SUCC];
this.fixes _ CONS[[prefix, translation, supress], this.fixes];
{
mark: ROPE ~ argv[i _ i.SUCC];
IF ( mark.Fetch[0] # '} ) THEN GOTO usage;
};
LOOP;
};
'$ => EXIT;	-- end of current set of instructions
ENDCASE => { NULL };
SELECT TRUE FROM
( this.tarFileName = NIL ) => this.tarFileName _ arg;
( this.fixes = NIL ) => {
this.arg _ arg;
};
( this.arg = NIL ) => { this.arg _ arg };
ENDCASE => {
msg _ IO.PutFR1["Extra argument (%g)", [rope[arg]] ];
GOTO usage;
};
ENDLOOP;
{
ENABLE {
PFS.Error => {
out.PutF["PFS.Error[%g], stopping (at %g)\n\n",
[rope[error.explanation]], [time[BasicTime.Now[]]] ];
GOTO failed;
};
};
out.PutF1["\n"];
IF ( test ) THEN {
FOR tail: LIST OF Translation _ this.fixes, tail.rest WHILE ( tail # NIL ) DO
out.PutF["{ prefix: %g, translation: %g, supress: %g }\n",
[rope[tail.first.prefix]], [rope[tail.first.translation]], [rope[tail.first.supress]] ];
ENDLOOP;
out.PutF["tcType: %g, tarFileName: %g, arg: %g\n",
[atom[atom]], [rope[this.tarFileName]], [rope[this.arg]] ];
};
IF ( this.tarFileName = NIL ) THEN GOTO usage;
IF ( this.arg = NIL ) THEN GOTO usage;
IF ( ( this.fixes = NIL ) AND ( this.arg = NIL ) ) THEN GOTO usage;
DoIt[out, this, test];
};
EXITS
failed => { result _ $Failure };
usage => { result _ $Failure; msg _ cmd.procData.doc };
};
{
FOR i: NAT IN [0..TBLOCK) DO nullBuffer[i] _ '\000; ENDLOOP;
nullBuffer.length _ TBLOCK;
};

Commander.Register["TarChargeOneDF", CommonCmd, oneDfDoc, $one];
Commander.Register["TarChargeAllDFs", CommonCmd, allDfsDoc, $all];
Commander.Register["TrAll", CommonCmd, allDfsDoc, $all];
Commander.Register["TarChargeDirectory", CommonCmd, dirDoc, $dir];
Commander.Register["TrDir", CommonCmd, dirDoc, $dir];
Commander.Register["TrOne", CommonCmd, oneDfDoc, $one];
Commander.Register["TestOne", CommonCmd, oneDfDoc, $onetest];
}.

FPTrickleChargeToTarImpl.mesa
Copyright Σ 1989, 1990 by Xerox Corporation.  All rights reserved.
Willie-Sue, August 21, 1989 10:33:10 am PDT
Bill Jackson (bj), May 21, 1990 5:31 pm PDT
TrickleChargeToTar (switches) srcDir dstFile
moves files from remote directory to a tar file.

Documentation
Various
Tar/Stream Routines
pads out to a TBLOCK boundary
Command Procedures
entry.{caseFileName, fullUnix, relative, relativeCaseName, state}
now get the .~case~ file info if it exists, else use the info for the file itself
Trickling a df file together with the files it controls
Trickling df files in a directory together with the files controlled by those df files.  
Phase2, copy files.  Don't change the entries (except for the 'moved' field).
called for each item in the table to do the moving. 
The mainline of DoIt
Commander Operation(s)
be prepared for failure; error reported to user
Each argument is an argument to be processed.  The first argument (argv[0]) is not examined, because by convention it is the name of the command as given by the user.
It is a good idea to periodically check for a process abort request.
Ignore null arguments (it is not easy to generate them, even).
next three args are: prefix, translation and supress
we're supposed to be doing a whole directory here!
prefix: ROPE _ arg;
translation: ROPE _ arg;
supress: ROPE _ arg;
this.fixes _ CONS[[prefix, translation, supress], this.fixes];
IF ( NOT Rope.Match["*]", arg] ) THEN {
msg _ IO.PutFR1["Source not a directory (%g)", [rope[arg]] ];
GOTO failed;
};
Initialization
fill the nullBuffer with null's, for later use
ΚP•NewlineDelimiter

–

"cedar" style˜
codeš
œ™Kš
œB™BK™+K™+K˜—š
Οk	˜	Kšœœ˜Kšœ
œ˜Kšœ
œ!˜0Kšœœ!˜2Kšœ
œZœ˜€
Kšœ
œ#˜,Kšœ	œœ˜Kšœœ˜Kšœ
œ(˜:Kšœœ!˜.Kšœœœ˜)Kšœœ˜Kšœœ!œ˜<Kšœœ˜&Kšœœ`˜pKšœ	œ˜Kšœ
œœ˜Kšœ
œ
˜K˜—š
œ,™,Kš
œ0™0K™—šΟnœœ
˜&Kšœ$œ@œ˜
Kšœ˜Kšœœœ
˜Kšœœœ
˜#
headš
Οz
™
Kšœœs˜Kšœœ€
˜³
Kšœ
œ¦
˜΄
—š
Ÿ™Kšœœ
œœ
œ
œΟc'˜Q—š
Ÿ™šžœœœ
œ˜2Kšœœ
œœ˜5Kš
œ™š
˜Kšœœ œ˜2šœ
œ
˜Kšœœ˜šœ
œ˜Kš
œ˜Kš
œ2˜2Kšœ
˜K˜—Kšœ
œ"˜2Kšœœ ˜#—Kšœ
˜—Kš
œ#˜#Kš
œ˜K˜—š
žœœœ
œœ˜TKšœœ
œ%˜PKš
œ˜KšœL ˜\K˜K˜—š
žœœœ
œœ˜KKšœœ
˜Kšœœ˜šœœ
œœ˜ Kšœ  ˜2Kšœ
˜Kšœ ˜—Kšœ< ˜UKšœœ
˜&Kšœœ
˜Kš
œœ
œ
œœ
˜CK˜——š
Ÿ™š
ž	œœœ6œœ˜oK˜K˜—š
ž
œœ"œ
œœ˜KKš
œA™AKšœ4œ
˜9Kš
œ˜KšœLœ
˜PKš
œH˜HKš
œ=˜=K˜Kš
œ˜KšœB˜Išœœ˜Kš
œN˜NKš
˜K˜—š
œ
˜
Kšœœ
œœ
˜Kšœœœ˜5Kš
œ=˜=šœ˜	Kšœœ˜'Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜K˜—Kš
œG˜GKš
œ˜Kšœœ˜,Kšœ3 ˜DKš
œ˜K˜—Kš
œQ™QKšœF˜Mšœœ
œ˜#Kšœœ˜'Kš
œ˜Kš
œ˜Kš
œ˜K˜—Kš
œ˜Kš
œ!˜!Kš
œG˜GKš
œ˜Kš
œ˜K˜K˜—šž
œœ
œœ
œœœœ(œœ	˜§
Kšœœ˜šœ˜š
œ˜K™7Kšœ	œ˜$Kš
œI˜IK˜—š
œ˜Kš
 Y™YKšœ	œ˜(Kš
œI˜IKš
œ˜—šœ ˜3Kšœ	œ˜%Kš
œH˜HK˜—Kšœœ
˜—K˜K˜—š
ž
œœœ
œ'œ˜XKš
œM™MKšœœ˜K•StartOfExpansion> -- [data: RedBlackTree.UserData] RETURNS [stop: BOOL _ FALSE]šž
œœœ:˜VšΠbn	œ˜$K™4šœœ
˜š
œ˜Kšœœ
œ
˜'Kš
œ#˜#Kš
œ˜Kš
œ˜—Kšœœ
˜—K˜—Kš
œE˜EKš
œ%˜%K˜1š
œ
˜
Kšœ
œ˜$Kš
œl˜lKš
œ8˜8K˜—K˜K˜—šžœœœ
œ ˜MKšœœ˜K–> -- [data: RedBlackTree.UserData] RETURNS [stop: BOOL _ FALSE]šž
œœœ:˜Vš‘	œ˜$šœœ
˜š
œ˜Kš	œ	œœ)œœ˜aKšœœ
œ
˜'Kš	œ(œœœœ˜~Kš
œ˜Kš
œ˜—Kšœœ
˜—K˜—Kš
œI˜IKš
œ%˜%Kš
œ@˜@K˜K˜—šžœœ
œœ
œœœœœœ˜wKšœ
œœ
˜K™Kšœ&œœ˜BKš
œ`˜`Kš
œK˜KKš
œK˜KKš
œ]˜]Kšœœ
œ ˜2Kšœ
œ
œ
˜˜
Kšœœœ"˜>Kšœ	œ
œœ˜6Kš
œ$˜$Kšœœœ+˜<Kšœ ˜$Kš
œ˜—K˜——–< -- [data: RedBlackTree.UserData] RETURNS [RedBlackTree.Key]š
Ÿ™š
žœœœœœ˜3šœœ˜Kšœœ
˜Kšœœ
˜Kšœœ
˜Kšœœ
˜Kšœœ
˜—Kš
œ˜K˜—šžœœœœ˜6šœ	œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kšœœ
˜—Kš
œ˜K˜—šž	œ˜$Kšœœœ˜-Kšœœ
œ˜Kšœœ˜Kšœœ&˜8–I[cmd: 
Commander.Handle, starExpand: 
BOOL _ FALSE, switchChar: 
CHAR]šœbœ
˜pKš
œ/™/K˜—š
œœ
œ
œ
œ˜4Kš
œ¦
™¦
Kšœœ˜˜Kš
œD™D—šœœ
œ
˜"Kš
œ>™>—šœ˜˜K™4Kšœœœ˜ Kšœ
œœ˜%Kšœ	œœ˜!Kšœ
œ-˜>š
œ
˜
Kšœœœ˜Kšœœ
œ˜*K˜—Kšœ
˜K˜—Kšœœ %˜1Kšœœ˜—šœ
œ
˜Kšœœ˜5šœœ˜K™2Kšœœ™Kšœ
œ™Kšœ	œ™Kšœ
œ-™>Kš
œ˜šœœœ™'Kšœœ5™=Kšœ™K™—K˜—Kšœ
œ˜)šœ˜Kšœœ-˜5Kšœ˜K˜——Kšœ
˜—˜
šœ˜šœq˜tKšœ˜K˜—K˜—Kš
œ˜šœ
œ˜šœœ
œ%œ
œ˜MKš
œ“
˜“
Kšœ
˜—Kš
œn˜nK˜—Kšœœœ
œ˜.Kšœœœ
œ˜&Kšœœœœœ
œ˜CKš
œ˜K˜—š
˜Kš
œ ˜ Kš
œ7˜7—K˜——–x[key: 
ROPE, proc: 
Commander.CommandProc, doc: 
ROPE _ NIL, clientData: 
REF ANY _ NIL, interpreted: 
BOOL _ TRUE]š
Ÿ™Kš
œ.™.š
œ
˜
Kšœœ
œœœœ
˜<Kšœœ
˜Kš
œ˜K˜—Kš
œ@˜@Kš
œB˜BKš
œ8˜8Kš
œB˜BKš
œ5˜5Kš
œ7˜7Kš
œ=˜=—Kš
œ˜K˜——…—(€=: