include "stdio.s7i";
include "time.s7i";
include "filesys.s7i";
include "unicode.s7i";
include "fileutil.s7i";
include "subfile.s7i";
include "iobuffer.s7i";
include "archive_base.s7i";
const string: TAR_MAGIC is "ustar";
const string: TAR_NOMAGIC is "";
const integer: TAR_BLOCK_SIZE is 512;
const string: END_OF_FILE_MARKER is "\0;" mult TAR_BLOCK_SIZE;
const char: REGTYPE is '0';
const char: AREGTYPE is '\0;';
const char: LNKTYPE is '1';
const char: SYMTYPE is '2';
const char: CHRTYPE is '3';
const char: BLKTYPE is '4';
const char: DIRTYPE is '5';
const char: FIFOTYPE is '6';
const char: CONTTYPE is '7';
const char: LONGNAMETYPE is 'L';
const char: LONGLINKTYPE is 'K';
const char: GLOBAL_HEADER is 'g';
const char: EXTENDED_HEADER is 'x';
const type: tarHeader is new struct
var string: name is "";
var integer: mode is 0;
var integer: uid is 0;
var integer: gid is 0;
var integer: fileSize is 0;
var integer: mtime is 0;
var integer: chksum is 0;
var char: typeflag is REGTYPE;
var string: linkname is "";
var string: magic is "";
var string: version is "";
var string: uname is "";
var string: gname is "";
var integer: devmajor is 0;
var integer: devminor is 0;
var string: prefix is "";
var boolean: endOfFileMarker is FALSE;
var boolean: chksumOkay is FALSE;
var string: filePath is "";
var string: filePathSuffix is "";
var string: linkPath is "";
var integer: dataStartPos is 0;
end struct;
const proc: showHeader (inout file: outFile, in tarHeader: header) is func
begin
writeln(outFile, "name: " <& header.name);
writeln(outFile, "mode: " <& header.mode radix 8);
writeln(outFile, "uid: " <& header.uid);
writeln(outFile, "gid: " <& header.gid);
writeln(outFile, "fileSize: " <& header.fileSize);
writeln(outFile, "mtime: " <& header.mtime);
writeln(outFile, "chksum: " <& header.chksum);
writeln(outFile, "typeflag: " <& literal(header.typeflag));
writeln(outFile, "linkname: " <& header.linkname);
writeln(outFile, "magic: " <& literal(header.magic));
writeln(outFile, "version: " <& literal(header.version));
writeln(outFile, "uname: " <& header.uname);
writeln(outFile, "gname: " <& header.gname);
writeln(outFile, "devmajor: " <& header.devmajor);
writeln(outFile, "devminor: " <& header.devminor);
writeln(outFile, "prefix: " <& header.prefix);
writeln(outFile, "endOfFileMarker: " <& header.endOfFileMarker);
writeln(outFile, "chksumOkay: " <& header.chksumOkay);
writeln(outFile, "filePath: " <& header.filePath);
writeln(outFile, "filePathSuffix: " <& header.filePathSuffix);
writeln(outFile, "linkPath: " <& header.linkPath);
writeln(outFile, "dataStartPos: " <& header.dataStartPos);
end func;
const func string: gets0 (in string: stri) is func
result
var string: data is "";
local
var integer: zeroBytePos is 0;
begin
zeroBytePos := pos(stri, "\0;");
if zeroBytePos <> 0 then
data := stri[ .. pred(zeroBytePos)];
else
data := stri;
end if;
end func;
const func string: gets0Spc (in string: stri) is func
result
var string: data is "";
local
var integer: zeroBytePos is 0;
var integer: spacePos is 0;
begin
zeroBytePos := pos(stri, "\0;");
if zeroBytePos <> 0 then
data := stri[ .. pred(zeroBytePos)];
else
data := stri;
end if;
spacePos := pos(data, " ");
if spacePos <> 0 then
data := data[ .. pred(spacePos)];
end if;
end func;
const func integer: getOct (in string: stri) is func
result
var integer: number is 0;
local
var integer: start is 1;
var integer: pos is 0;
begin
while start <= length(stri) and stri[start] = ' ' do
incr(start);
end while;
pos := start;
while pos <= length(stri) and stri[pos] >= '0' and stri[pos] <= '7' do
incr(pos);
end while;
if pos > start then
number := integer(stri[start .. pred(pos)], 8);
end if;
end func;
const func string: getMetaData (in string: stri, inout integer: pos) is func
result
var string: metaData is "";
local
var integer: subPos is 0;
var integer: length is 0;
begin
subPos := pos;
while subPos <= length(stri) and stri[subPos] >= '0' and stri[subPos] <= '9' do
incr(subPos);
end while;
if subPos > 1 and stri[subPos] = ' ' then
length := integer(stri[pos .. pred(subPos)]);
metaData := stri[succ(subPos) .. pos + length - 2];
pos +:= length;
end if;
end func;
const proc: puts0 (inout string: out_stri, in string: stri, in integer: length) is func
begin
out_stri &:= stri[ .. length];
if length(stri) < length then
out_stri &:= "\0;" mult length - length(stri);
end if;
end func;
const proc: putSpc (inout string: out_stri, in string: stri, in integer: length) is func
begin
out_stri &:= stri[ .. length] rpad length;
end func;
const proc: putOct (inout string: out_stri, in integer: number, in integer: length) is func
begin
out_stri &:= number radix 8 lpad0 pred(length) <& "\0;";
end func;
const func integer: tarChksum (in string: stri) is func
result
var integer: checkSum is 0;
local
var char: ch is ' ';
begin
for ch range stri do
checkSum +:= ord(ch);
end for;
checkSum := checkSum mod 2 ** 16;
end func;
const func tarHeader: tarHeader (in string: stri) is func
result
var tarHeader: header is tarHeader.value;
begin
header.name := gets0(stri[ 1 fixLen 100]);
header.mode := getOct(stri[101 fixLen 8]);
header.uid := getOct(stri[109 fixLen 8]);
header.gid := getOct(stri[117 fixLen 8]);
header.fileSize := getOct(stri[125 fixLen 12]);
header.mtime := getOct(stri[137 fixLen 12]);
header.chksum := getOct(stri[149 fixLen 8]);
header.typeflag := stri[157];
header.linkname := gets0(stri[158 fixLen 100]);
header.magic := gets0Spc(stri[258 fixLen 6]);
header.version := stri[264 fixLen 2];
header.uname := gets0(stri[266 fixLen 32]);
header.gname := gets0(stri[298 fixLen 32]);
header.devmajor := getOct(stri[330 fixLen 8]);
header.devminor := getOct(stri[338 fixLen 8]);
header.prefix := gets0(stri[346 fixLen 155]);
end func;
const func tarHeader: readHeadBlock (inout file: inFile) is func
result
var tarHeader: header is tarHeader.value;
local
var string: stri is "";
begin
stri := gets(inFile, TAR_BLOCK_SIZE);
if length(stri) = TAR_BLOCK_SIZE then
if stri = END_OF_FILE_MARKER then
header.endOfFileMarker := TRUE;
else
header := tarHeader(stri);
header.chksumOkay :=
tarChksum(stri[ .. 148] & ("" lpad 8) & stri[157 .. ]) = header.chksum;
end if;
elsif stri = "" then
header.endOfFileMarker := TRUE;
end if;
end func;
const proc: readHead (inout file: inFile, inout tarHeader: header) is func
local
var string: filePath8 is "";
var string: linkPath8 is "";
var string: extendedHeaderData is "";
var integer: pos is 1;
var string: metaData is "";
begin
header := readHeadBlock(inFile);
while header.magic = TAR_MAGIC and
(((header.typeflag = LONGNAMETYPE or header.typeflag = LONGLINKTYPE) and
header.name = "././@LongLink") or
header.typeflag = EXTENDED_HEADER or header.typeflag = GLOBAL_HEADER) do
if header.typeflag = LONGNAMETYPE then
filePath8 := gets(inFile, header.fileSize);
elsif header.typeflag = LONGLINKTYPE then
linkPath8 := gets(inFile, header.fileSize);
elsif header.typeflag = EXTENDED_HEADER then
extendedHeaderData := gets(inFile, header.fileSize);
pos := 1;
while pos <= length(extendedHeaderData) do
metaData := getMetaData(extendedHeaderData, pos);
if startsWith(metaData, "path=") then
filePath8 := metaData[6 ..];
elsif startsWith(metaData, "linkpath=") then
linkPath8 := metaData[10 ..];
end if;
end while;
else
ignore(gets(inFile, header.fileSize));
end if;
seek(inFile, tell(inFile) + pred(TAR_BLOCK_SIZE) -
pred(header.fileSize) mod TAR_BLOCK_SIZE);
header := readHeadBlock(inFile);
end while;
if filePath8 = "" then
if header.prefix <> "" then
filePath8 := header.prefix & "/" & header.name;
else
filePath8 := header.name;
end if;
end if;
block
header.filePath := fromUtf8(filePath8);
exception
catch RANGE_ERROR:
header.filePath := filePath8;
end block;
if linkPath8 = "" then
linkPath8 := header.linkname;
end if;
block
header.linkPath := fromUtf8(linkPath8);
exception
catch RANGE_ERROR:
header.linkPath := linkPath8;
end block;
if endsWith(header.filePath, "/") and header.filePath <> "/" then
header.filePath := header.filePath[.. pred(length(header.filePath))];
header.filePathSuffix := "/";
end if;
if endsWith(header.linkPath, "/") then
header.linkPath := header.linkPath[.. pred(length(header.linkPath))];
end if;
header.dataStartPos := tell(inFile);
end func;
const func tarHeader: readMinimumOfHeadBlock (inout file: inFile) is func
result
var tarHeader: header is tarHeader.value;
local
var string: stri is "";
begin
stri := gets(inFile, TAR_BLOCK_SIZE);
if length(stri) = TAR_BLOCK_SIZE then
if stri = END_OF_FILE_MARKER then
header.endOfFileMarker := TRUE;
else
header.name := gets0(stri[ 1 fixLen 100]);
header.fileSize := getOct(stri[125 fixLen 12]);
header.typeflag := stri[157];
header.magic := gets0Spc(stri[258 fixLen 6]);
header.prefix := gets0(stri[346 fixLen 155]);
end if;
elsif stri = "" then
header.endOfFileMarker := TRUE;
end if;
end func;
const proc: readMinimumOfHead (inout file: inFile, inout tarHeader: header) is func
local
var string: filePath8 is "";
var string: extendedHeaderData is "";
var integer: pos is 1;
var string: metaData is "";
begin
header := readMinimumOfHeadBlock(inFile);
while header.magic = TAR_MAGIC and
(((header.typeflag = LONGNAMETYPE or header.typeflag = LONGLINKTYPE) and
header.name = "././@LongLink") or
header.typeflag = EXTENDED_HEADER or header.typeflag = GLOBAL_HEADER) do
if header.typeflag = LONGNAMETYPE then
filePath8 := gets(inFile, header.fileSize);
seek(inFile, tell(inFile) + pred(TAR_BLOCK_SIZE) - pred(header.fileSize) mod TAR_BLOCK_SIZE);
elsif header.typeflag = EXTENDED_HEADER then
extendedHeaderData := gets(inFile, header.fileSize);
pos := 1;
while pos <= length(extendedHeaderData) do
metaData := getMetaData(extendedHeaderData, pos);
if startsWith(metaData, "path=") then
filePath8 := metaData[6 ..];
end if;
end while;
seek(inFile, tell(inFile) + pred(TAR_BLOCK_SIZE) - pred(header.fileSize) mod TAR_BLOCK_SIZE);
else
seek(inFile, succ(succ((tell(inFile) + header.fileSize - 2) mdiv
TAR_BLOCK_SIZE) * TAR_BLOCK_SIZE));
end if;
header := readMinimumOfHeadBlock(inFile);
end while;
if filePath8 = "" then
if header.prefix <> "" then
filePath8 := header.prefix & "/" & header.name;
else
filePath8 := header.name;
end if;
end if;
block
header.filePath := fromUtf8(filePath8);
exception
catch RANGE_ERROR:
header.filePath := filePath8;
end block;
if endsWith(header.filePath, "/") and header.filePath <> "/" then
header.filePath := header.filePath[.. pred(length(header.filePath))];
end if;
end func;
const func string: str (in tarHeader: header) is func
result
var string: stri is "";
local
var string: chksum is "";
begin
puts0 (stri, header.name, 100);
putOct (stri, header.mode, 8);
putOct (stri, header.uid, 8);
putOct (stri, header.gid, 8);
putOct (stri, header.fileSize, 12);
putOct (stri, header.mtime, 12);
putSpc (stri, "", 8);
stri &:= header.typeflag;
puts0 (stri, header.linkname, 100);
puts0 (stri, header.magic, 6);
putSpc (stri, header.version, 2);
puts0 (stri, header.uname, 32);
puts0 (stri, header.gname, 32);
putOct (stri, header.devmajor, 8);
putOct (stri, header.devminor, 8);
puts0 (stri, header.prefix, 155);
puts0 (stri, "", 12);
putOct (chksum, tarChksum(stri), 8);
stri := stri[ .. 148] & chksum & stri[157 .. ];
end func;
const proc: writeHead (inout file: outFile, in var tarHeader: header) is func
local
var string: filePath8 is "";
var string: linkPath8 is "";
var tarHeader: longNameHead is tarHeader.value;
var integer: startPos is 0;
var integer: slashPos is 0;
begin
filePath8 := toUtf8(header.filePath);
if filePath8 & header.filePathSuffix <> header.prefix & "/" & header.name then
if length(filePath8) + length(header.filePathSuffix) > 100 then
if length(filePath8) + length(header.filePathSuffix) <= 256 then
startPos := max(2, length(filePath8) + length(header.filePathSuffix) - 100);
slashPos := pos(filePath8, "/", startPos);
if slashPos <> 0 then
if slashPos <= 156 then
header.name := filePath8[succ(slashPos) ..] & header.filePathSuffix;
header.prefix := filePath8[.. pred(slashPos)];
else
slashPos := 0;
end if;
end if;
end if;
if slashPos = 0 then
longNameHead.name := "././@LongLink";
longNameHead.mode := 0;
longNameHead.uid := 0;
longNameHead.gid := 0;
longNameHead.fileSize := length(filePath8) + length(header.filePathSuffix);
longNameHead.mtime := 0;
longNameHead.typeflag := LONGNAMETYPE;
longNameHead.linkname := "";
longNameHead.magic := TAR_MAGIC;
longNameHead.version := " ";
longNameHead.uname := "root";
longNameHead.gname := "root";
longNameHead.devmajor := 0;
longNameHead.devminor := 0;
longNameHead.prefix := "";
write(outFile, str(longNameHead));
write(outFile, filePath8);
write(outFile, header.filePathSuffix);
write(outFile, "\0;" mult pred(TAR_BLOCK_SIZE) - pred(longNameHead.fileSize) mod TAR_BLOCK_SIZE);
header.name := (filePath8 & header.filePathSuffix)[.. 100];
end if;
else
header.name := filePath8 & header.filePathSuffix;
end if;
end if;
linkPath8 := toUtf8(header.linkPath);
if length(filePath8) > 100 then
longNameHead.name := "././@LongLink";
longNameHead.mode := 0;
longNameHead.uid := 0;
longNameHead.gid := 0;
longNameHead.fileSize := length(linkPath8);
longNameHead.mtime := 0;
longNameHead.typeflag := LONGLINKTYPE;
longNameHead.linkname := "";
longNameHead.magic := TAR_MAGIC;
longNameHead.version := " ";
longNameHead.uname := "root";
longNameHead.gname := "root";
longNameHead.devmajor := 0;
longNameHead.devminor := 0;
longNameHead.prefix := "";
write(outFile, str(longNameHead));
write(outFile, linkPath8);
write(outFile, "\0;" mult pred(TAR_BLOCK_SIZE) - pred(longNameHead.fileSize) mod TAR_BLOCK_SIZE);
else
header.linkname := linkPath8;
end if;
write(outFile, str(header));
end func;
const type: tarCatalogType is hash [string] tarHeader;
const type: tarArchive is sub emptyFileSys struct
var file: tarFile is STD_NULL;
var archiveRegisterType: register is archiveRegisterType.value;
var tarCatalogType: catalog is tarCatalogType.value;
var integer: endOfFileMarkerPos is 0;
end struct;
const func fileSys: openTar (inout file: tarFile) is func
result
var fileSys: newFileSys is fileSys.value;
local
var tarHeader: header is tarHeader.value;
var integer: headPos is 1;
var tarArchive: tar is tarArchive.value;
begin
if length(tarFile) = 0 then
tar.tarFile := tarFile;
newFileSys := toInterface(tar);
else
seek(tarFile, headPos);
readHead(tarFile, header);
if not header.endOfFileMarker and
header.chksumOkay and header.filePath <> "" and
(header.magic = TAR_MAGIC or header.magic = TAR_NOMAGIC) then
tar.tarFile := tarFile;
repeat
tar.register @:= [header.filePath] headPos;
if header.fileSize = 0 then
headPos := tell(tarFile);
else
headPos := tell(tarFile) +
succ(pred(header.fileSize) mdiv TAR_BLOCK_SIZE) * TAR_BLOCK_SIZE;
seek(tarFile, headPos);
end if;
readMinimumOfHead(tarFile, header);
until header.endOfFileMarker or header.filePath = "" or
(header.magic <> TAR_MAGIC and header.magic <> TAR_NOMAGIC);
if header.endOfFileMarker then
tar.endOfFileMarkerPos := headPos;
end if;
newFileSys := toInterface(tar);
end if;
end if;
end func;
const func fileSys: openTar (in string: tarFileName) is func
result
var fileSys: tar is fileSys.value;
local
var file: tarFile is STD_NULL;
begin
tarFile := open(tarFileName, "r");
tar := openTar(tarFile);
end func;
const proc: close (inout tarArchive: tar) is func
begin
tar := tarArchive.value;
end func;
const func tarHeader: addToCatalog (inout tarArchive: tar, in string: filePath) is func
result
var tarHeader: header is tarHeader.value;
begin
seek(tar.tarFile, tar.register[filePath]);
readHead(tar.tarFile, header);
if not header.chksumOkay then
raise FILE_ERROR;
else
tar.catalog @:= [filePath] header;
end if;
end func;
const func tarHeader: addImplicitDir (inout tarArchive: tar,
in string: dirPath) is func
result
var tarHeader: header is tarHeader.value;
begin
header.filePath := dirPath;
if dirPath <> "/" then
header.filePathSuffix := "/";
end if;
header.typeflag := DIRTYPE;
header.dataStartPos := -1;
tar.catalog @:= [dirPath] header;
end func;
const func string: followSymlink (inout tarArchive: tar, in var string: filePath,
inout tarHeader: header) is func
result
var string: missingPath is "";
local
var integer: symlinkCount is MAX_SYMLINK_CHAIN_LENGTH;
var boolean: isSymlink is TRUE;
begin
repeat
if filePath in tar.catalog then
header := tar.catalog[filePath];
elsif filePath in tar.register then
header := addToCatalog(tar, filePath);
elsif implicitDir(tar.register, filePath) then
header := addImplicitDir(tar, filePath);
else
missingPath := filePath;
isSymlink := FALSE;
end if;
if missingPath = "" then
if header.typeflag = SYMTYPE then
decr(symlinkCount);
filePath := symlinkDestination(filePath, header.linkPath);
if startsWith(filePath, "/") and
filePath not in tar.catalog and filePath not in tar.register then
filePath := filePath[2 ..];
end if;
else
isSymlink := FALSE;
end if;
end if;
until not isSymlink or symlinkCount < 0;
if isSymlink then
raise FILE_ERROR;
end if;
end func;
const func tarHeader: followSymlink (inout tarArchive: tar, in string: filePath) is func
result
var tarHeader: header is tarHeader.value;
local
var string: missingPath is "";
begin
missingPath := followSymlink(tar, filePath, header);
if missingPath <> "" then
raise FILE_ERROR;
end if;
end func;
const proc: fixRegisterAndCatalog (inout tarArchive: tar, in integer: insertPos,
in integer: numChars) is func
local
var integer: headerPos is 1;
var string: filePath is "";
begin
for key filePath range tar.register do
if tar.register[filePath] >= insertPos then
tar.register[filePath] +:= numChars;
end if;
end for;
for key filePath range tar.catalog do
if tar.catalog[filePath].dataStartPos >= insertPos then
tar.catalog[filePath].dataStartPos +:= numChars;
end if;
end for;
end func;
const func array string: readDir (inout tarArchive: tar, in string: dirPath) is
return readDir(tar.register, dirPath);
const func array string: readDir (inout tarArchive: tar, RECURSIVE) is
return sort(keys(tar.register));
const func fileType: fileType (inout tarArchive: tar, in var string: filePath) is func
result
var fileType: aFileType is FILE_UNKNOWN;
local
var tarHeader: header is tarHeader.value;
var integer: symlinkCount is MAX_SYMLINK_CHAIN_LENGTH;
var boolean: isSymlink is FALSE;
begin
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
elsif filePath = "" then
aFileType := FILE_DIR;
else
repeat
isSymlink := FALSE;
if filePath in tar.catalog then
header := tar.catalog[filePath];
elsif filePath in tar.register then
header := addToCatalog(tar, filePath);
elsif implicitDir(tar.register, filePath) then
header := addImplicitDir(tar, filePath);
else
aFileType := FILE_ABSENT;
end if;
if aFileType = FILE_UNKNOWN then
case header.typeflag of
when {REGTYPE}: aFileType := FILE_REGULAR;
when {AREGTYPE}: aFileType := FILE_REGULAR;
when {CHRTYPE}: aFileType := FILE_CHAR;
when {BLKTYPE}: aFileType := FILE_BLOCK;
when {DIRTYPE}: aFileType := FILE_DIR;
when {FIFOTYPE}: aFileType := FILE_FIFO;
when {CONTTYPE}: aFileType := FILE_UNKNOWN;
when {SYMTYPE}:
isSymlink := TRUE;
decr(symlinkCount);
filePath := symlinkDestination(filePath, header.linkPath);
if startsWith(filePath, "/") and
filePath not in tar.catalog and filePath not in tar.register then
filePath := filePath[2 ..];
end if;
otherwise: aFileType := FILE_UNKNOWN;
end case;
end if;
until not isSymlink or symlinkCount < 0;
if isSymlink then
aFileType := FILE_SYMLINK;
end if;
end if;
end func;
const func fileType: fileTypeSL (inout tarArchive: tar, in string: filePath) is func
result
var fileType: aFileType is FILE_UNKNOWN;
local
var char: typeflag is ' ';
begin
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
elsif filePath = "" then
aFileType := FILE_DIR;
else
if filePath in tar.catalog then
typeflag := tar.catalog[filePath].typeflag;
elsif filePath in tar.register then
typeflag := addToCatalog(tar, filePath).typeflag;
elsif implicitDir(tar.register, filePath) then
typeflag := addImplicitDir(tar, filePath).typeflag;
else
aFileType := FILE_ABSENT;
end if;
if aFileType = FILE_UNKNOWN then
case typeflag of
when {REGTYPE}: aFileType := FILE_REGULAR;
when {AREGTYPE}: aFileType := FILE_REGULAR;
when {SYMTYPE}: aFileType := FILE_SYMLINK;
when {CHRTYPE}: aFileType := FILE_CHAR;
when {BLKTYPE}: aFileType := FILE_BLOCK;
when {DIRTYPE}: aFileType := FILE_DIR;
when {FIFOTYPE}: aFileType := FILE_FIFO;
when {CONTTYPE}: aFileType := FILE_UNKNOWN;
otherwise: aFileType := FILE_UNKNOWN;
end case;
end if;
end if;
end func;
const func fileMode: getFileMode (inout tarArchive: tar, in string: filePath) is func
result
var fileMode: mode is fileMode.value;
begin
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
else
mode := fileMode(followSymlink(tar, filePath).mode mod 8#1000);
end if;
end func;
const proc: setFileMode (inout tarArchive: tar, in string: filePath,
in fileMode: mode) is func
local
var tarHeader: header is tarHeader.value;
begin
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
else
header := followSymlink(tar, filePath);
if header.filePath in tar.register then
header.mode := (header.mode >> 9 << 9) + integer(mode);
tar.catalog @:= [header.filePath] header;
seek(tar.tarFile, tar.register[header.filePath]);
writeHead(tar.tarFile, tar.catalog[header.filePath]);
else
raise FILE_ERROR;
end if;
end if;
end func;
const func integer: fileSize (inout tarArchive: tar, in string: filePath) is func
result
var integer: size is 0;
local
var tarHeader: header is tarHeader.value;
begin
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
else
size := followSymlink(tar, filePath).fileSize;
end if;
end func;
const func time: getMTime (inout tarArchive: tar, in string: filePath) is func
result
var time: modificationTime is time.value;
begin
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
else
modificationTime := timestamp1970ToTime(
followSymlink(tar, filePath).mtime);
end if;
end func;
const proc: setMTime (inout tarArchive: tar, in string: filePath,
in time: modificationTime) is func
local
var integer: mtime is 0;
var tarHeader: header is tarHeader.value;
begin
mtime := timestamp1970(modificationTime);
if mtime < 0 or mtime >= 2 ** 31 or
(filePath <> "/" and endsWith(filePath, "/")) then
raise RANGE_ERROR;
else
header := followSymlink(tar, filePath);
if header.filePath in tar.register then
header.mtime := mtime;
tar.catalog @:= [header.filePath] header;
seek(tar.tarFile, tar.register[header.filePath]);
writeHead(tar.tarFile, tar.catalog[header.filePath]);
else
raise FILE_ERROR;
end if;
end if;
end func;
const func string: getOwner (inout tarArchive: tar, in string: filePath) is func
result
var string: owner is "";
local
var tarHeader: header is tarHeader.value;
begin
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
else
header := followSymlink(tar, filePath);
if header.uname <> "" then
owner := header.uname;
else
owner := str(header.uid);
end if;
end if;
end func;
const proc: setOwner (inout tarArchive: tar, in string: filePath,
in string: owner) is func
local
var tarHeader: header is tarHeader.value;
begin
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
else
header := followSymlink(tar, filePath);
if header.filePath in tar.register then
if isDigitString(owner) then
header.uid := integer(owner);
header.uname := "";
else
header.uid := 0;
header.uname := owner;
end if;
tar.catalog @:= [header.filePath] header;
seek(tar.tarFile, tar.register[header.filePath]);
writeHead(tar.tarFile, tar.catalog[header.filePath]);
else
raise FILE_ERROR;
end if;
end if;
end func;
const func string: getGroup (inout tarArchive: tar, in string: filePath) is func
result
var string: group is "";
local
var tarHeader: header is tarHeader.value;
begin
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
else
header := followSymlink(tar, filePath);
if header.gname <> "" then
group := header.gname;
else
group := str(header.gid);
end if;
end if;
end func;
const proc: setGroup (inout tarArchive: tar, in string: filePath,
in string: group) is func
local
var tarHeader: header is tarHeader.value;
begin
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
else
header := followSymlink(tar, filePath);
if header.filePath in tar.register then
if isDigitString(group) then
header.gid := integer(group);
header.gname := "";
else
header.gid := 0;
header.gname := group;
end if;
tar.catalog @:= [header.filePath] header;
seek(tar.tarFile, tar.register[header.filePath]);
writeHead(tar.tarFile, tar.catalog[header.filePath]);
else
raise FILE_ERROR;
end if;
end if;
end func;
const func fileMode: getFileMode (inout tarArchive: tar, in string: filePath, SYMLINK) is func
result
var fileMode: mode is fileMode.value;
local
var tarHeader: header is tarHeader.value;
begin
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
elsif filePath = "" then
raise FILE_ERROR;
else
if filePath in tar.catalog then
header := tar.catalog[filePath];
elsif filePath in tar.register then
header := addToCatalog(tar, filePath);
else
raise FILE_ERROR;
end if;
if header.typeflag = SYMTYPE then
mode := fileMode(header.mode mod 8#1000);
else
raise FILE_ERROR;
end if;
end if;
end func;
const func time: getMTime (inout tarArchive: tar, in string: filePath, SYMLINK) is func
result
var time: modificationTime is time.value;
local
var tarHeader: header is tarHeader.value;
begin
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
elsif filePath = "" then
raise FILE_ERROR;
else
if filePath in tar.catalog then
header := tar.catalog[filePath];
elsif filePath in tar.register then
header := addToCatalog(tar, filePath);
else
raise FILE_ERROR;
end if;
if header.typeflag = SYMTYPE then
modificationTime := timestamp1970ToTime(header.mtime);
else
raise FILE_ERROR;
end if;
end if;
end func;
const proc: setMTime (inout tarArchive: tar, in string: filePath,
in time: modificationTime, SYMLINK) is func
local
var integer: mtime is 0;
var tarHeader: header is tarHeader.value;
begin
mtime := timestamp1970(modificationTime);
if mtime < 0 or mtime >= 2 ** 31 or
(filePath <> "/" and endsWith(filePath, "/")) then
raise RANGE_ERROR;
elsif filePath = "" then
raise FILE_ERROR;
else
if filePath in tar.catalog then
header := tar.catalog[filePath];
elsif filePath in tar.register then
header := addToCatalog(tar, filePath);
else
raise FILE_ERROR;
end if;
if header.typeflag = SYMTYPE then
header.mtime := mtime;
tar.catalog @:= [header.filePath] header;
seek(tar.tarFile, tar.register[header.filePath]);
writeHead(tar.tarFile, tar.catalog[header.filePath]);
else
raise FILE_ERROR;
end if;
end if;
end func;
const func string: getOwner (inout tarArchive: tar, in string: filePath, SYMLINK) is func
result
var string: owner is "";
local
var tarHeader: header is tarHeader.value;
begin
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
elsif filePath = "" then
raise FILE_ERROR;
else
if filePath in tar.catalog then
header := tar.catalog[filePath];
elsif filePath in tar.register then
header := addToCatalog(tar, filePath);
else
raise FILE_ERROR;
end if;
if header.typeflag = SYMTYPE then
if header.uname <> "" then
owner := header.uname;
else
owner := str(header.uid);
end if;
else
raise FILE_ERROR;
end if;
end if;
end func;
const proc: setOwner (inout tarArchive: tar, in string: filePath,
in string: owner, SYMLINK) is func
local
var tarHeader: header is tarHeader.value;
begin
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
elsif filePath = "" then
raise FILE_ERROR;
else
if filePath in tar.catalog then
header := tar.catalog[filePath];
elsif filePath in tar.register then
header := addToCatalog(tar, filePath);
else
raise FILE_ERROR;
end if;
if header.typeflag = SYMTYPE then
if isDigitString(owner) then
header.uid := integer(owner);
header.uname := "";
else
header.uid := 0;
header.uname := owner;
end if;
tar.catalog @:= [header.filePath] header;
seek(tar.tarFile, tar.register[header.filePath]);
writeHead(tar.tarFile, tar.catalog[header.filePath]);
else
raise FILE_ERROR;
end if;
end if;
end func;
const func string: getGroup (inout tarArchive: tar, in string: filePath, SYMLINK) is func
result
var string: group is "";
local
var tarHeader: header is tarHeader.value;
begin
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
elsif filePath = "" then
raise FILE_ERROR;
else
if filePath in tar.catalog then
header := tar.catalog[filePath];
elsif filePath in tar.register then
header := addToCatalog(tar, filePath);
else
raise FILE_ERROR;
end if;
if header.typeflag = SYMTYPE then
if header.gname <> "" then
group := header.gname;
else
group := str(header.gid);
end if;
else
raise FILE_ERROR;
end if;
end if;
end func;
const proc: setGroup (inout tarArchive: tar, in string: filePath,
in string: group, SYMLINK) is func
local
var tarHeader: header is tarHeader.value;
begin
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
elsif filePath = "" then
raise FILE_ERROR;
else
if filePath in tar.catalog then
header := tar.catalog[filePath];
elsif filePath in tar.register then
header := addToCatalog(tar, filePath);
else
raise FILE_ERROR;
end if;
if header.typeflag = SYMTYPE then
if isDigitString(group) then
header.gid := integer(group);
header.gname := "";
else
header.gid := 0;
header.gname := group;
end if;
tar.catalog @:= [header.filePath] header;
seek(tar.tarFile, tar.register[header.filePath]);
writeHead(tar.tarFile, tar.catalog[header.filePath]);
else
raise FILE_ERROR;
end if;
end if;
end func;
const func string: readLink (inout tarArchive: tar, in string: filePath) is func
result
var string: linkPath is "";
local
var tarHeader: header is tarHeader.value;
begin
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
elsif filePath in tar.catalog then
header := tar.catalog[filePath];
elsif filePath in tar.register then
header := addToCatalog(tar, filePath);
else
raise FILE_ERROR;
end if;
if header.typeflag = SYMTYPE then
linkPath := header.linkPath;
else
raise FILE_ERROR;
end if;
end func;
const proc: makeLink (inout tarArchive: tar, in string: symlinkPath,
in string: targetPath) is func
local
var tarHeader: header is tarHeader.value;
var integer: length is 0;
begin
if symlinkPath <> "/" and endsWith(symlinkPath, "/") then
raise RANGE_ERROR;
elsif symlinkPath = "" or symlinkPath in tar.catalog or
symlinkPath in tar.register or implicitDir(tar.register, symlinkPath) then
raise FILE_ERROR;
else
header.name := symlinkPath[.. 100];
header.mode := 8#777;
header.uid := 0;
header.gid := 0;
header.fileSize := 0;
header.mtime := timestamp1970(time(NOW));
header.typeflag := SYMTYPE;
header.magic := TAR_MAGIC;
header.version := " ";
header.filePath := symlinkPath;
header.linkPath := targetPath;
if seekable(tar.tarFile) and tar.endOfFileMarkerPos <> 0 then
seek(tar.tarFile, tar.endOfFileMarkerPos);
else
length := length(tar.tarFile);
if seekable(tar.tarFile) then
seek(tar.tarFile, succ(length));
end if;
write(tar.tarFile, "\0;" mult pred(TAR_BLOCK_SIZE) -
pred(length) mod TAR_BLOCK_SIZE);
end if;
tar.register @:= [symlinkPath] tell(tar.tarFile);
writeHead(tar.tarFile, header);
header.dataStartPos := tell(tar.tarFile);
tar.endOfFileMarkerPos := header.dataStartPos;
write(tar.tarFile, END_OF_FILE_MARKER mult 2);
tar.catalog @:= [symlinkPath] header;
flush(tar.tarFile);
end if;
end func;
const func string: getFile (inout tarArchive: tar, in string: filePath) is func
result
var string: content is "";
local
var tarHeader: header is tarHeader.value;
begin
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
else
header := followSymlink(tar, filePath);
if header.typeflag = REGTYPE or header.typeflag = AREGTYPE then
seek(tar.tarFile, header.dataStartPos);
content := gets(tar.tarFile, header.fileSize);
else
raise FILE_ERROR;
end if;
end if;
end func;
const proc: putFile (inout tarArchive: tar, in var string: filePath,
in string: data) is func
local
var tarHeader: header is tarHeader.value;
var string: missingPath is "";
var boolean: appendFile is TRUE;
var integer: length is 0;
begin
if filePath = "" or filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
else
missingPath := followSymlink(tar, filePath, header);
if missingPath = "" then
filePath := header.filePath;
if header.typeflag <> REGTYPE and header.typeflag <> AREGTYPE then
raise FILE_ERROR;
else
if succ(pred(header.fileSize) mdiv TAR_BLOCK_SIZE) * TAR_BLOCK_SIZE =
succ(pred(length(data)) mdiv TAR_BLOCK_SIZE) * TAR_BLOCK_SIZE then
header.fileSize := length(data);
tar.catalog @:= [filePath] header;
seek(tar.tarFile, header.dataStartPos - TAR_BLOCK_SIZE);
write(tar.tarFile, str(header));
write(tar.tarFile, data);
write(tar.tarFile, "\0;" mult pred(TAR_BLOCK_SIZE) -
pred(header.fileSize) mod TAR_BLOCK_SIZE);
appendFile := FALSE;
end if;
end if;
else
filePath := missingPath;
end if;
if appendFile then
if seekable(tar.tarFile) and tar.endOfFileMarkerPos <> 0 then
seek(tar.tarFile, tar.endOfFileMarkerPos);
else
length := length(tar.tarFile);
if seekable(tar.tarFile) then
seek(tar.tarFile, succ(length));
end if;
write(tar.tarFile, "\0;" mult pred(TAR_BLOCK_SIZE) -
pred(length) mod TAR_BLOCK_SIZE);
end if;
tar.register @:= [filePath] tell(tar.tarFile);
if missingPath <> "" then
header.name := filePath[.. 100];
header.mode := 8#664;
header.uid := 0;
header.gid := 0;
header.mtime := timestamp1970(time(NOW));
header.typeflag := REGTYPE;
header.magic := TAR_MAGIC;
header.version := " ";
header.filePath := filePath;
end if;
header.fileSize := length(data);
writeHead(tar.tarFile, header);
header.dataStartPos := tell(tar.tarFile);
tar.catalog @:= [filePath] header;
write(tar.tarFile, data);
write(tar.tarFile, "\0;" mult pred(TAR_BLOCK_SIZE) -
pred(header.fileSize) mod TAR_BLOCK_SIZE);
tar.endOfFileMarkerPos := tell(tar.tarFile);
write(tar.tarFile, END_OF_FILE_MARKER mult 2);
flush(tar.tarFile);
end if;
end if;
end func;
const proc: makeDir (inout tarArchive: tar, in string: dirPath) is func
local
var tarHeader: header is tarHeader.value;
var boolean: fileExists is TRUE;
var integer: dataStartPos is 0;
var integer: length is 0;
begin
if dirPath = "" or dirPath <> "/" and endsWith(dirPath, "/") then
raise RANGE_ERROR;
elsif dirPath in tar.catalog then
dataStartPos := tar.catalog[dirPath].dataStartPos;
elsif dirPath in tar.register then
dataStartPos := addToCatalog(tar, dirPath).dataStartPos;
elsif implicitDir(tar.register, dirPath) then
dataStartPos := addImplicitDir(tar, dirPath).dataStartPos;
else
fileExists := FALSE;
end if;
if fileExists and dataStartPos <> -1 then
raise FILE_ERROR;
else
if seekable(tar.tarFile) and tar.endOfFileMarkerPos <> 0 then
seek(tar.tarFile, tar.endOfFileMarkerPos);
else
length := length(tar.tarFile);
if seekable(tar.tarFile) then
seek(tar.tarFile, succ(length));
end if;
write(tar.tarFile, "\0;" mult pred(TAR_BLOCK_SIZE) -
pred(length) mod TAR_BLOCK_SIZE);
end if;
tar.register @:= [dirPath] tell(tar.tarFile);
header.name := (dirPath & "/") [.. 100];
header.mode := 8#775;
header.uid := 0;
header.gid := 0;
header.fileSize := 0;
header.mtime := timestamp1970(time(NOW));
header.typeflag := DIRTYPE;
header.magic := TAR_MAGIC;
header.version := " ";
header.filePath := dirPath;
header.filePathSuffix := "/";
writeHead(tar.tarFile, header);
header.dataStartPos := tell(tar.tarFile);
tar.endOfFileMarkerPos := header.dataStartPos;
write(tar.tarFile, END_OF_FILE_MARKER mult 2);
tar.catalog @:= [dirPath] header;
flush(tar.tarFile);
end if;
end func;
const proc: removeFile (inout tarArchive: tar, in string: filePath) is func
local
var tarHeader: header is tarHeader.value;
var boolean: fileExists is TRUE;
var integer: posOfHeaderToBeRemoved is 0;
var integer: numCharsToBeRemoved is 0;
begin
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
elsif filePath in tar.catalog then
header := tar.catalog[filePath];
elsif filePath in tar.register then
header := addToCatalog(tar, filePath);
elsif implicitDir(tar.register, filePath) then
header := addImplicitDir(tar, filePath);
else
fileExists := FALSE;
end if;
if fileExists and
(header.typeflag in {REGTYPE, AREGTYPE, SYMTYPE, CHRTYPE, BLKTYPE,
FIFOTYPE, CONTTYPE} or
(header.typeflag = DIRTYPE and isEmptyDir(tar.register, filePath))) then
posOfHeaderToBeRemoved := tar.register[filePath];
numCharsToBeRemoved := header.dataStartPos - posOfHeaderToBeRemoved +
succ(pred(header.fileSize) mdiv TAR_BLOCK_SIZE) * TAR_BLOCK_SIZE;
deleteArea(tar.tarFile, posOfHeaderToBeRemoved, numCharsToBeRemoved);
excl(tar.register, filePath);
excl(tar.catalog, filePath);
fixRegisterAndCatalog(tar, posOfHeaderToBeRemoved + numCharsToBeRemoved,
-numCharsToBeRemoved);
flush(tar.tarFile);
else
raise FILE_ERROR;
end if;
end func;
const proc: for (inout string: filePath) range (inout tarArchive: tar) do
(in proc: statements)
end for is func
begin
for key filePath range tar.register do
statements;
end for;
end func;
const func file: openFileInTar (inout tarArchive: tar, in string: filePath,
in string: mode) is func
result
var file: newFile is STD_NULL;
local
var tarHeader: header is tarHeader.value;
var string: missingPath is "";
begin
if mode = "r" then
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
else
missingPath := followSymlink(tar, filePath, header);
if missingPath = "" and (header.typeflag = REGTYPE or
header.typeflag = AREGTYPE) then
newFile := openSubFile(tar.tarFile, header.dataStartPos,
header.fileSize);
end if;
end if;
end if;
end func;
const func file: open (inout tarArchive: tar, in string: filePath,
in string: mode) is
return openBufferFile(openFileInTar(tar, filePath, mode));