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