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;
Documentation
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
";
Various
nullBuffer: REF TEXT ← NEW[TEXT[TBLOCK]]; -- logically a readonly bunch of null's
Tar/Stream Routines
StreamToStreamCopy:
PROC [to, from:
IO.
STREAM] ~ {
copyBuffer: REF TEXT ~ RefText.ObtainScratch[TBLOCK];
pads out to a TBLOCK boundary
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;
};
Command Procedures
UnixNames:
PROC [entry: FileEntry]
RETURNS [caseFileName, fullUnix, relative, relativeCaseName:
ROPE ←
NIL] ~ {
};
CopyFileToTar:
PROC [entry: FileEntry, tarFile, out:
IO.
STREAM] ~
TRUSTED {
entry.{caseFileName, fullUnix, relative, relativeCaseName, state}
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[];
};
now get the .~case~ file info if it exists, else use the info for the file itself
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 => {
Trickling a df file together with the files it controls
pattern: ROPE ~ target.Concat["!H"];
[table, filesSeen] ← TarTrickle.EnumerateDFs[pattern, tcInfo, out, test];
};
allDFs => {
Trickling df files in a directory together with the files controlled by those df files.
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] ~ {
Phase2, copy files. Don't change the entries (except for the 'moved' field).
filesMoved: INT ← 0;
NoteFileMoved: PROC ~ INLINE
{ filesMoved ← TarTrickle.BumpCounter[out, filesMoved] };
EachEntry: RedBlackTree.EachNode ~ {
called for each item in the table to do the moving.
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;
The mainline of DoIt
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
};
};
Commander Operation(s)
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}];
be prepared for failure; error reported to user
i:
NAT;
FOR i ← 1, i.
SUCC
WHILE ( i < argv.argc )
DO
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.
arg: ROPE ~ argv[i];
Process.CheckForAbort[];
It is a good idea to periodically check for a process abort request.
IF ( arg.Length[] = 0 )
THEN
LOOP;
Ignore null arguments (it is not easy to generate them, even).
SELECT arg.Fetch[0]
FROM
'{ => {
next three args are: prefix, translation and supress
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 ) => {
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];
this.arg ← arg;
IF ( NOT Rope.Match["*]", arg] ) THEN {
msg ← IO.PutFR1["Source not a directory (%g)", [rope[arg]] ];
GOTO failed;
};
};
( 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 };
};
Initialization
fill the nullBuffer with null's, for later use
{
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];
}.