include "tar.s7i";
include "osfiles.s7i";
include "fileutil.s7i";
include "gzip.s7i";
include "lzma.s7i";
include "xz.s7i";
include "zstd.s7i";
const proc: setUpHead (in string: basePath, in string: filePath,
in string: filePathSuffix, inout tarHeader: header) is func
begin
header.name := (filePath & filePathSuffix)[.. 100];
header.mode := integer(getFileMode(basePath & filePath));
header.uid := 100;
header.gid := 100;
header.fileSize := 0;
header.mtime := timestamp1970(getMTime(basePath & filePath));
header.chksum := 0;
header.typeflag := REGTYPE;
header.linkname := "";
header.magic := TAR_MAGIC;
header.version := " ";
header.uname := "";
header.gname := "";
header.devmajor := 0;
header.devminor := 0;
header.prefix := "";
header.filePath := filePath;
header.filePathSuffix := filePathSuffix;
end func;
const func file: openTarFileWithMagic (in string: inFileName,
in boolean: complainIfUncompressed) is func
result
var file: inFile is STD_NULL;
local
var string: magicBytes is "";
begin
inFile := open(inFileName, "r");
if inFile <> STD_NULL then
magicBytes := gets(inFile, length(GZIP_MAGIC));
if magicBytes = GZIP_MAGIC then
seek(inFile, 1);
inFile := openGzipFile(inFile, READ);
else
magicBytes &:= gets(inFile, length(ZSTD_MAGIC) - length(GZIP_MAGIC));
if magicBytes = ZSTD_MAGIC then
seek(inFile, 1);
inFile := openZstdFile(inFile);
else
magicBytes &:= gets(inFile, length(XZ_MAGIC) - length(ZSTD_MAGIC));
seek(inFile, 1);
if magicBytes = XZ_MAGIC then
inFile := openXzFile(inFile);
elsif endsWith(inFileName, ".lzma") then
inFile := openLzmaFile(inFile);
elsif complainIfUncompressed then
write("tar7: File \"");
write(inFileName);
writeln("\" not in gzip, xz, zstd or lzma format.");
end if;
end if;
end if;
end if;
end func;
const func boolean: filePathIsInTarMemberList (in string: filePath,
in array string: memberList) is func
result
var boolean: isInMemberList is TRUE;
local
var string: member is "";
begin
if length(memberList) <> 0 then
isInMemberList := FALSE;
for member range memberList until isInMemberList do
if filePath = member or
(startsWith(filePath, member) and filePath[succ(length(member))] = '/') then
isInMemberList := TRUE;
end if;
end for;
end if;
end func;
const proc: tarTell (inout file: inFile, in array string: memberList,
in boolean: doView) is func
local
var tarHeader: header is tarHeader.value;
var time: modTime is time.value;
begin
readHead(inFile, header);
while not header.endOfFileMarker and
header.chksumOkay and header.filePath <> "" and
(header.magic = TAR_MAGIC or header.magic = TAR_NOMAGIC) do
if filePathIsInTarMemberList(header.filePath, memberList) then
if doView then
case header.typeflag of
when {REGTYPE, AREGTYPE}: write("-");
when {SYMTYPE}: write("l");
when {CHRTYPE}: write("c");
when {BLKTYPE}: write("b");
when {DIRTYPE}: write("d");
when {FIFOTYPE}: write("f");
otherwise: write("?");
end case;
write(fileMode(header.mode mod 8#1000));
write(" ");
if header.uname <> "" then
write(header.uname);
else
write(header.uid);
end if;
write("/");
if header.gname <> "" then
write(header.gname);
else
write(header.gid);
end if;
write(header.fileSize lpad 14);
write(" ");
modTime := timestamp1970ToTime(header.mtime);
write(strDate(modTime));
write(" ");
write(str_hh_mm(modTime, ":"));
write(" ");
end if;
writeln(header.filePath <& header.filePathSuffix);
end if;
if header.fileSize <> 0 then
seek(inFile, tell(inFile) + succ(pred(header.fileSize) mdiv TAR_BLOCK_SIZE) * TAR_BLOCK_SIZE);
end if;
readHead(inFile, header);
end while;
if not header.endOfFileMarker then
if header.magic <> TAR_MAGIC and header.magic <> TAR_NOMAGIC then
writeln("*** The magic number of a tar header is not okay");
elsif not header.chksumOkay then
writeln("*** The check-sum of a tar header is not okay");
end if;
end if;
end func;
const proc: tarTell (in string: inFileName, in array string: memberList,
in boolean: doView, in boolean: complainIfUncompressed) is func
local
var file: inFile is STD_NULL;
begin
inFile := openTarFileWithMagic(inFileName, complainIfUncompressed);
if inFile <> STD_NULL then
tarTell(inFile, memberList, doView);
else
write("tar7: Cannot open \"");
write(inFileName);
writeln("\".");
end if;
end func;
const proc: tarXtract (inout file: inFile, in array string: memberList,
in boolean: doView) is func
local
var tarHeader: header is tarHeader.value;
var file: aFile is STD_NULL;
var integer: bytesCopied is 0;
var time: modTime is time.value;
var array tarHeader: dirHeaderList is 0 times tarHeader.value;
var integer: index is 0;
var boolean: okay is TRUE;
begin
readHead(inFile, header);
while not header.endOfFileMarker and
header.chksumOkay and header.filePath <> "" and
(header.magic = TAR_MAGIC or header.magic = TAR_NOMAGIC) and okay do
if filePathIsInTarMemberList(header.filePath, memberList) then
if doView then
write("x ");
writeln(header.filePath <& header.filePathSuffix);
end if;
if header.typeflag = DIRTYPE then
if fileTypeSL(header.filePath) = FILE_DIR then
dirHeaderList &:= [] (header);
elsif fileTypeSL(header.filePath) = FILE_ABSENT then
makeParentDirs(header.filePath);
makeDir(header.filePath);
dirHeaderList &:= [] (header);
else
writeln("*** The file " <& literal(header.filePath) <& " exists, but is not a directory");
okay := FALSE;
end if;
elsif header.typeflag = REGTYPE or header.typeflag = AREGTYPE then
if fileTypeSL(header.filePath) = FILE_REGULAR then
removeFile(header.filePath);
end if;
if fileTypeSL(header.filePath) = FILE_ABSENT then
makeParentDirs(header.filePath);
aFile := open(header.filePath, "w");
if aFile <> STD_NULL then
bytesCopied := copyFile(inFile, aFile, header.fileSize);
close(aFile);
setFileMode(header.filePath, fileMode(header.mode mod 8#1000));
modTime := timestamp1970ToTime(header.mtime);
setMTime(header.filePath, modTime);
skip(inFile, header.fileSize - bytesCopied +
pred(TAR_BLOCK_SIZE) - pred(header.fileSize) mod TAR_BLOCK_SIZE);
else
skip(inFile, succ(pred(header.fileSize) mdiv TAR_BLOCK_SIZE) * TAR_BLOCK_SIZE);
writeln("*** Cannot create file " <& literal(header.filePath));
okay := FALSE;
end if;
else
skip(inFile, succ(pred(header.fileSize) mdiv TAR_BLOCK_SIZE) * TAR_BLOCK_SIZE);
writeln("*** The file " <& literal(header.filePath) <& " exists, but is not a regular file");
okay := FALSE;
end if;
elsif header.typeflag = SYMTYPE then
if fileTypeSL(header.filePath) = FILE_SYMLINK then
removeFile(header.filePath);
end if;
if fileTypeSL(header.filePath) = FILE_ABSENT then
makeParentDirs(header.filePath);
if succeeds(makeLink(header.filePath, header.linkPath)) then
modTime := timestamp1970ToTime(header.mtime);
setMTime(header.filePath, modTime, SYMLINK);
else
writeln("*** Cannot create symbolic link " <& literal(header.filePath));
okay := FALSE;
end if;
else
writeln("*** The file " <& literal(header.filePath) <& " exists, but is not a symbolic link");
okay := FALSE;
end if;
else
writeln("*** Cannot create " <& literal(header.filePath));
end if;
end if;
readHead(inFile, header);
end while;
if not header.endOfFileMarker then
if header.magic <> TAR_MAGIC and header.magic <> TAR_NOMAGIC then
writeln("*** The magic number of a tar header is not okay");
elsif not header.chksumOkay then
writeln("*** The check-sum of a tar header is not okay");
end if;
end if;
for index range length(dirHeaderList) downto 1 do
setFileMode(dirHeaderList[index].filePath, fileMode(dirHeaderList[index].mode mod 8#1000));
modTime := timestamp1970ToTime(dirHeaderList[index].mtime);
setMTime(dirHeaderList[index].filePath, modTime);
end for;
end func;
const proc: tarXtract (in string: inFileName, in array string: memberList,
in boolean: doView, in boolean: complainIfUncompressed) is func
local
var file: inFile is STD_NULL;
begin
inFile := openTarFileWithMagic(inFileName, complainIfUncompressed);
if inFile <> STD_NULL then
tarXtract(inFile, memberList, doView);
else
write("tar7: Cannot open \"");
write(inFileName);
writeln("\".");
end if;
end func;
const proc: tarXtract (in string: inFileName, in boolean: doView) is func
begin
tarXtract(inFileName, 0 times "", doView, FALSE);
end func;
const proc: tarXtract (in string: inFileName) is func
begin
tarXtract(inFileName, 0 times "", FALSE, FALSE);
end func;
const proc: tarCreate (inout file: outFile, in string: basePath, in string: pathFromBase,
in array string: fileList, in boolean: doView) is func
local
var string: name is "";
var array string: dirContent is 0 times "";
var file: aFile is STD_NULL;
var integer: bytesCopied is 0;
var tarHeader: header is tarHeader.value;
begin
for name range fileList do
name := pathFromBase & name;
if fileType(basePath & name) = FILE_ABSENT then
writeln("*** The file " <& literal(basePath & name) <& " does not exist.");
else
if doView then
write("c ");
writeln(name);
end if;
if fileType(basePath & name) = FILE_DIR then
dirContent := readDir(basePath & name);
setUpHead(basePath, name, "/", header);
header.typeflag := DIRTYPE;
writeHead(outFile, header);
tarCreate(outFile, basePath, name & "/", dirContent, doView);
else
setUpHead(basePath, name, "", header);
aFile := open(basePath & name, "r");
if aFile <> STD_NULL then
header.fileSize := length(aFile);
writeHead(outFile, header);
bytesCopied := copyFile(aFile, outFile, header.fileSize);
write(outFile, "\0;" mult header.fileSize - bytesCopied +
pred(TAR_BLOCK_SIZE) - pred(header.fileSize) mod TAR_BLOCK_SIZE);
close(aFile);
else
writeHead(outFile, header);
end if;
end if;
end if;
end for;
end func;
const proc: tarCreate (in string: outFileName, in array string: fileList,
in boolean: doView, in boolean: doZip) is func
local
var file: outFile is STD_NULL;
var file: compressedFile is STD_NULL;
var string: name is "";
var string: uncompressed is "";
begin
outFile := open(outFileName, "w");
if outFile <> STD_NULL and doZip then
compressedFile := outFile;
outFile := openGzipFile(compressedFile, WRITE);
end if;
if outFile <> STD_NULL then
for name range fileList do
tarCreate(outFile, "", "", [] name, doView);
end for;
write(outFile, END_OF_FILE_MARKER mult 2);
close(outFile);
end if;
if compressedFile <> STD_NULL then
close(compressedFile);
end if;
end func;
const proc: tarCreate (in string: outFileName, in array string: fileList,
in boolean: doView) is func
begin
tarCreate(outFileName, fileList, doView, FALSE);
end func;
const proc: tarCreate (in string: outFileName, in array string: fileList) is func
begin
tarCreate(outFileName, fileList, FALSE, FALSE);
end func;