include "stdio.s7i";
include "time.s7i";
include "filesys.s7i";
include "filebits.s7i";
include "unicode.s7i";
include "fileutil.s7i";
include "subfile.s7i";
include "iobuffer.s7i";
include "archive_base.s7i";
const string: AR_MAGIC is "!<arch>\n";
const integer: AR_HEADER_SIZE is 60;
const integer: AR_PADDING is 2;
const type: arHeader is new struct
var string: name is "";
var integer: mtime is 0;
var integer: ownerId is 0;
var integer: groupId is 0;
var integer: mode is 0;
var integer: fileSize is 0;
var boolean: okay is FALSE;
var integer: longNameStart is 0;
var string: filePath is "";
var integer: dataStartPos is 0;
end struct;
const proc: showHeader (inout file: outFile, in arHeader: header) is func
begin
writeln(outFile, "name: " <& header.name);
writeln(outFile, "mtime: " <& header.mtime);
writeln(outFile, "ownerId: " <& header.ownerId);
writeln(outFile, "groupId: " <& header.groupId);
writeln(outFile, "mode: " <& header.mode radix 8);
writeln(outFile, "fileSize: " <& header.fileSize);
writeln(outFile, "okay: " <& header.okay);
writeln(outFile, "longNameStart: " <& header.longNameStart);
writeln(outFile, "filePath: " <& header.filePath);
writeln(outFile, "dataStartPos: " <& header.dataStartPos);
end func;
const proc: assignFilePath (inout arHeader: header, in string: stri) is func
local
var integer: slashPos is 0;
begin
header.longNameStart := 0;
slashPos := rpos(stri, '/', 16);
if slashPos = 0 then
header.name := rtrim(stri[ .. 16]);
elsif slashPos = 1 then
if stri[2] >= '0' and stri[2] <= '9' then
header.longNameStart := succ(integer(rtrim(stri[2 .. 16])));
header.name := "";
else
header.name := "/";
end if;
elsif slashPos = 2 and stri[1] = '/' then
header.name := "//";
else
header.name := stri[ .. pred(slashPos)];
end if;
if header.name <> "" then
block
header.filePath := fromUtf8(header.name);
exception
catch RANGE_ERROR:
header.filePath := header.name;
end block;
else
header.filePath := "";
end if;
end func;
const func arHeader: arHeader (in string: stri) is func
result
var arHeader: header is arHeader.value;
begin
assignFilePath(header, stri);
if stri[17 .. 48] <> " " mult 32 then
header.mtime := integer(rtrim(stri[17 fixLen 12]));
header.ownerId := integer(rtrim(stri[29 fixLen 6]));
header.groupId := integer(rtrim(stri[35 fixLen 6]));
header.mode := integer(rtrim(stri[41 fixLen 8]), 8);
end if;
header.fileSize := integer(rtrim(stri[49 fixLen 10]));
header.okay := stri[59 fixLen 2] = "`\n";
end func;
const proc: readHead (inout file: inFile, inout arHeader: header) is func
local
var string: stri is "";
begin
stri := gets(inFile, AR_HEADER_SIZE);
if length(stri) = AR_HEADER_SIZE then
header := arHeader(stri);
header.dataStartPos := tell(inFile);
else
header := arHeader.value;
end if;
end func;
const proc: readMinimumOfHead (inout file: inFile, inout arHeader: header) is func
local
var string: stri is "";
begin
stri := gets(inFile, AR_HEADER_SIZE);
if length(stri) = AR_HEADER_SIZE then
assignFilePath(header, stri);
header.fileSize := integer(rtrim(stri[49 fixLen 10]));
header.okay := stri[59 fixLen 2] = "`\n";
else
header := arHeader.value;
end if;
end func;
const func string: str (in arHeader: header) is func
result
var string: stri is "";
local
var string: filePath8 is "";
begin
filePath8 := toUtf8(header.filePath);
if header.longNameStart = 0 then
if length(filePath8) < 16 then
stri := (filePath8 & "/") rpad 16;
else
raise RANGE_ERROR;
end if;
else
stri := "/" <& pred(header.longNameStart) rpad 15;
end if;
stri &:= header.mtime rpad 12 <&
header.ownerId rpad 6 <&
header.groupId rpad 6 <&
header.mode radix 8 rpad 8 <&
header.fileSize rpad 10 <&
"`\n";
end func;
const proc: writeHead (inout file: outFile, in arHeader: header) is func
begin
write(outFile, str(header));
end func;
const func string: getLongName (in string: longNames, in integer: longNameStart) is func
result
var string: longName is "";
local
var string: longName8 is "";
var integer: nlPos is 0;
var integer: slashPos is 0;
begin
nlPos := pos(longNames, '\n', longNameStart);
if nlPos <> 0 then
longName8 := longNames[longNameStart .. pred(nlPos)];
else
longName8 := longNames[longNameStart ..];
end if;
slashPos := rpos(longName8, '/');
if slashPos <> 0 then
longName8 := longName8[ .. pred(slashPos)];
end if;
block
longName := fromUtf8(longName8);
exception
catch RANGE_ERROR:
longName := longName8;
end block;
end func;
const func integer: addLongName (inout string: longNames, in string: longName) is func
result
var integer: longNameStart is 0;
local
var integer: nameListEnd is 0;
begin
longNameStart := pos(longNames, longName & "/");
if longNameStart <> 0 and
longNameStart + length(longName) > length(longNames) and
longNames[longNameStart + length(longName) + 1] <> '\n' then
longNameStart := 0;
end if;
if longNameStart = 0 then
nameListEnd := length(longNames);
while nameListEnd >= 1 and longNames[nameListEnd] = '\n' do
decr(nameListEnd);
end while;
if nameListEnd = 0 then
longNames := longName & "/\n";
longNameStart := 1;
else
longNames := longNames[.. nameListEnd] & "\n" & longName & "/\n";
longNameStart := nameListEnd + 2;
end if;
if odd(length(longNames)) then
longNames &:= "\n";
end if;
end if;
end func;
const type: arCatalogType is hash [string] arHeader;
const type: arArchive is sub emptyFileSys struct
var file: arFile is STD_NULL;
var integer: longNamesHeaderPos is 0;
var string: longNames is "";
var archiveRegisterType: register is archiveRegisterType.value;
var arCatalogType: catalog is arCatalogType.value;
end struct;
const func fileSys: openAr (inout file: arFile) is func
result
var fileSys: newFileSys is fileSys.value;
local
var string: magic is "";
var arHeader: header is arHeader.value;
var integer: headerPos is 1;
var arArchive: ar is arArchive.value;
begin
if length(arFile) = 0 then
ar.arFile := arFile;
newFileSys := toInterface(ar);
else
seek(arFile, headerPos);
magic := gets(arFile, length(AR_MAGIC));
if magic = AR_MAGIC then
ar.arFile := arFile;
headerPos := tell(arFile);
readMinimumOfHead(arFile, header);
while header.okay do
if header.filePath = "//" then
ar.longNamesHeaderPos := headerPos;
ar.longNames := gets(arFile, header.fileSize);
headerPos := tell(arFile);
elsif header.filePath = "/" then
ignore(gets(arFile, header.fileSize));
headerPos := tell(arFile);
else
if header.longNameStart <> 0 then
header.filePath := getLongName(ar.longNames, header.longNameStart);
end if;
ar.register @:= [header.filePath] headerPos;
if header.fileSize = 0 then
headerPos := tell(arFile);
else
headerPos := tell(arFile) +
succ(pred(header.fileSize) mdiv AR_PADDING) * AR_PADDING;
seek(arFile, headerPos);
end if;
end if;
readMinimumOfHead(arFile, header);
end while;
newFileSys := toInterface(ar);
end if;
end if;
end func;
const func fileSys: openAr (in string: arFileName) is func
result
var fileSys: ar is fileSys.value;
local
var file: arFile is STD_NULL;
begin
arFile := open(arFileName, "r");
ar := openAr(arFile);
end func;
const proc: close (inout arArchive: ar) is func
begin
ar := arArchive.value;
end func;
const func arHeader: addToCatalog (inout arArchive: ar, in string: filePath) is func
result
var arHeader: header is arHeader.value;
local
var string: linkPath is "";
begin
seek(ar.arFile, ar.register[filePath]);
readHead(ar.arFile, header);
ar.catalog @:= [filePath] header;
end func;
const func arHeader: addImplicitDir (inout arArchive: ar,
in string: dirPath) is func
result
var arHeader: header is arHeader.value;
begin
header.filePath := dirPath;
header.mode := ord(MODE_FILE_DIR) + 8#775;
header.dataStartPos := -1;
ar.catalog @:= [dirPath] header;
end func;
const func string: followSymlink (inout arArchive: ar, in var string: filePath,
inout arHeader: header) is func
result
var string: missingPath is "";
local
var integer: symlinkCount is MAX_SYMLINK_CHAIN_LENGTH;
var boolean: isSymlink is TRUE;
var string: targetPath is "";
begin
repeat
if filePath in ar.catalog then
header := ar.catalog[filePath];
elsif filePath in ar.register then
header := addToCatalog(ar, filePath);
elsif implicitDir(ar.register, filePath) then
header := addImplicitDir(ar, filePath);
else
missingPath := filePath;
isSymlink := FALSE;
end if;
if missingPath = "" then
if bin32(header.mode) & MODE_FILE_TYPE_MASK = MODE_FILE_SYMLINK then
decr(symlinkCount);
seek(ar.arFile, header.dataStartPos);
targetPath := gets(ar.arFile, header.fileSize);
filePath := symlinkDestination(filePath, targetPath);
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 arHeader: followSymlink (inout arArchive: ar, in string: filePath) is func
result
var arHeader: header is arHeader.value;
local
var string: missingPath is "";
begin
missingPath := followSymlink(ar, filePath, header);
if missingPath <> "" then
raise FILE_ERROR;
end if;
end func;
const proc: fixRegisterAndCatalog (inout arArchive: ar, in integer: insertPos,
in integer: numChars) is func
local
var integer: headerPos is 1;
var string: filePath is "";
begin
for key filePath range ar.register do
if ar.register[filePath] >= insertPos then
ar.register[filePath] +:= numChars;
end if;
end for;
for key filePath range ar.catalog do
if ar.catalog[filePath].dataStartPos >= insertPos then
ar.catalog[filePath].dataStartPos +:= numChars;
end if;
end for;
end func;
const proc: setHeaderFileName (inout arArchive: ar, inout arHeader: header) is func
local
var string: filePath8 is "";
var string: longNames is "";
var arHeader: longNamesHeader is arHeader.value;
begin
filePath8 := toUtf8(header.filePath);
if filePath8 <> header.filePath or length(filePath8) >= 16 or
pos(filePath8, '/') <> 0 then
longNames := ar.longNames;
header.longNameStart := addLongName(longNames, filePath8);
if longNames <> ar.longNames then
if ar.longNamesHeaderPos <> 0 then
if length(longNames) > length(ar.longNames) then
longNamesHeader.filePath := "/";
longNamesHeader.fileSize := length(longNames);
seek(ar.arFile, ar.longNamesHeaderPos);
writeHead(ar.arFile, longNamesHeader);
insertArea(ar.arFile, ar.longNamesHeaderPos + AR_HEADER_SIZE,
length(longNames) - length(ar.longNames));
fixRegisterAndCatalog(ar, ar.longNamesHeaderPos + AR_HEADER_SIZE,
length(longNames) - length(ar.longNames));
end if;
seek(ar.arFile, ar.longNamesHeaderPos + AR_HEADER_SIZE);
write(ar.arFile, longNames);
else
ar.longNamesHeaderPos := 1 + length(AR_MAGIC);
insertArea(ar.arFile, ar.longNamesHeaderPos,
AR_HEADER_SIZE + length(longNames) - length(ar.longNames));
fixRegisterAndCatalog(ar, ar.longNamesHeaderPos,
AR_HEADER_SIZE + length(longNames) - length(ar.longNames));
longNamesHeader.filePath := "/";
longNamesHeader.fileSize := length(longNames);
seek(ar.arFile, ar.longNamesHeaderPos);
writeHead(ar.arFile, longNamesHeader);
write(ar.arFile, longNames);
end if;
ar.longNames := longNames;
end if;
end if;
end func;
const func array string: readDir (inout arArchive: ar, in string: dirPath) is
return readDir(ar.register, dirPath);
const func array string: readDir (inout arArchive: ar, RECURSIVE) is
return sort(keys(ar.register));
const func fileType: fileType (inout arArchive: ar, in var string: filePath) is func
result
var fileType: aFileType is FILE_UNKNOWN;
local
var arHeader: header is arHeader.value;
var integer: symlinkCount is MAX_SYMLINK_CHAIN_LENGTH;
var boolean: isSymlink is FALSE;
var string: targetPath is "";
begin
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
elsif filePath = "" then
aFileType := FILE_DIR;
else
repeat
isSymlink := FALSE;
if filePath in ar.catalog then
header := ar.catalog[filePath];
elsif filePath in ar.register then
header := addToCatalog(ar, filePath);
elsif implicitDir(ar.register, filePath) then
header := addImplicitDir(ar, filePath);
else
aFileType := FILE_ABSENT;
end if;
if aFileType = FILE_UNKNOWN then
case bin32(header.mode) & MODE_FILE_TYPE_MASK of
when {MODE_FILE_REGULAR}: aFileType := FILE_REGULAR;
when {MODE_FILE_DIR}: aFileType := FILE_DIR;
when {MODE_FILE_CHAR}: aFileType := FILE_CHAR;
when {MODE_FILE_BLOCK}: aFileType := FILE_BLOCK;
when {MODE_FILE_FIFO}: aFileType := FILE_FIFO;
when {MODE_FILE_SOCKET}: aFileType := FILE_SOCKET;
when {MODE_FILE_SYMLINK}:
isSymlink := TRUE;
decr(symlinkCount);
seek(ar.arFile, header.dataStartPos);
targetPath := gets(ar.arFile, header.fileSize);
filePath := symlinkDestination(filePath, targetPath);
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 arArchive: ar, in string: filePath) is func
result
var fileType: aFileType is FILE_UNKNOWN;
local
var integer: modeValue is 0;
begin
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
elsif filePath = "" then
aFileType := FILE_DIR;
else
if filePath in ar.catalog then
modeValue := ar.catalog[filePath].mode;
elsif filePath in ar.register then
modeValue := addToCatalog(ar, filePath).mode;
elsif implicitDir(ar.register, filePath) then
modeValue := addImplicitDir(ar, filePath).mode;
else
aFileType := FILE_ABSENT;
end if;
if aFileType = FILE_UNKNOWN then
case bin32(modeValue) & MODE_FILE_TYPE_MASK of
when {MODE_FILE_REGULAR}: aFileType := FILE_REGULAR;
when {MODE_FILE_DIR}: aFileType := FILE_DIR;
when {MODE_FILE_CHAR}: aFileType := FILE_CHAR;
when {MODE_FILE_BLOCK}: aFileType := FILE_BLOCK;
when {MODE_FILE_FIFO}: aFileType := FILE_FIFO;
when {MODE_FILE_SOCKET}: aFileType := FILE_SOCKET;
when {MODE_FILE_SYMLINK}: aFileType := FILE_SYMLINK;
otherwise: aFileType := FILE_UNKNOWN;
end case;
end if;
end if;
end func;
const func fileMode: getFileMode (inout arArchive: ar, 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(ar, filePath).mode mod 8#1000);
end if;
end func;
const proc: setFileMode (inout arArchive: ar, in string: filePath,
in fileMode: mode) is func
local
var arHeader: header is arHeader.value;
begin
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
else
header := followSymlink(ar, filePath);
if header.filePath in ar.register then
header.mode := (header.mode >> 9 << 9) + integer(mode);
ar.catalog @:= [header.filePath] header;
seek(ar.arFile, ar.register[header.filePath]);
writeHead(ar.arFile, ar.catalog[header.filePath]);
else
raise FILE_ERROR;
end if;
end if;
end func;
const func integer: fileSize (inout arArchive: ar, in string: filePath) is func
result
var integer: size is 0;
local
var arHeader: header is arHeader.value;
begin
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
else
size := followSymlink(ar, filePath).fileSize;
end if;
end func;
const func time: getMTime (inout arArchive: ar, in string: filePath) is func
result
var time: modificationTime is time.value;
local
var arHeader: header is arHeader.value;
begin
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
else
modificationTime := timestamp1970ToTime(
followSymlink(ar, filePath).mtime);
end if;
end func;
const proc: setMTime (inout arArchive: ar, in string: filePath,
in time: modificationTime) is func
local
var integer: mtime is 0;
var arHeader: header is arHeader.value;
begin
mtime := timestamp1970(modificationTime);
if mtime < 0 or mtime >= 2 ** 31 or
(filePath <> "/" and endsWith(filePath, "/")) then
raise RANGE_ERROR;
else
header := followSymlink(ar, filePath);
if header.filePath in ar.register then
header.mtime := mtime;
ar.catalog @:= [header.filePath] header;
seek(ar.arFile, ar.register[header.filePath]);
writeHead(ar.arFile, ar.catalog[header.filePath]);
else
raise FILE_ERROR;
end if;
end if;
end func;
const func string: getOwner (inout arArchive: ar, in string: filePath) is func
result
var string: owner is "";
begin
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
else
owner := str(followSymlink(ar, filePath).ownerId);
end if;
end func;
const proc: setOwner (inout arArchive: ar, in string: filePath,
in string: owner) is func
local
var integer: uid is 0;
var arHeader: header is arHeader.value;
begin
if isDigitString(owner) then
uid := integer(owner);
elsif owner <> "root" then
raise RANGE_ERROR;
end if;
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
else
header := followSymlink(ar, filePath);
if header.filePath in ar.register then
header.ownerId := uid;
ar.catalog @:= [header.filePath] header;
seek(ar.arFile, ar.register[header.filePath]);
writeHead(ar.arFile, ar.catalog[header.filePath]);
else
raise FILE_ERROR;
end if;
end if;
end func;
const func string: getGroup (inout arArchive: ar, in string: filePath) is func
result
var string: group is "";
begin
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
else
group := str(followSymlink(ar, filePath).groupId);
end if;
end func;
const proc: setGroup (inout arArchive: ar, in string: filePath,
in string: group) is func
local
var integer: gid is 0;
var arHeader: header is arHeader.value;
begin
if isDigitString(group) then
gid := integer(group);
elsif group <> "root" then
raise RANGE_ERROR;
end if;
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
else
header := followSymlink(ar, filePath);
if header.filePath in ar.register then
header.groupId := gid;
ar.catalog @:= [header.filePath] header;
seek(ar.arFile, ar.register[header.filePath]);
writeHead(ar.arFile, ar.catalog[header.filePath]);
else
raise FILE_ERROR;
end if;
end if;
end func;
const func fileMode: getFileMode (inout arArchive: ar, in string: filePath, SYMLINK) is func
result
var fileMode: mode is fileMode.value;
local
var arHeader: header is arHeader.value;
begin
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
elsif filePath = "" then
raise FILE_ERROR;
else
if filePath in ar.catalog then
header := ar.catalog[filePath];
elsif filePath in ar.register then
header := addToCatalog(ar, filePath);
else
raise FILE_ERROR;
end if;
if bin32(header.mode) & MODE_FILE_TYPE_MASK = MODE_FILE_SYMLINK then
mode := fileMode(header.mode mod 8#1000);
else
raise FILE_ERROR;
end if;
end if;
end func;
const func time: getMTime (inout arArchive: ar, in string: filePath, SYMLINK) is func
result
var time: modificationTime is time.value;
local
var arHeader: header is arHeader.value;
begin
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
elsif filePath = "" then
raise FILE_ERROR;
else
if filePath in ar.catalog then
header := ar.catalog[filePath];
elsif filePath in ar.register then
header := addToCatalog(ar, filePath);
else
raise FILE_ERROR;
end if;
if bin32(header.mode) & MODE_FILE_TYPE_MASK = MODE_FILE_SYMLINK then
modificationTime := timestamp1970ToTime(header.mtime);
else
raise FILE_ERROR;
end if;
end if;
end func;
const proc: setMTime (inout arArchive: ar, in string: filePath,
in time: modificationTime, SYMLINK) is func
local
var integer: mtime is 0;
var arHeader: header is arHeader.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 ar.catalog then
header := ar.catalog[filePath];
elsif filePath in ar.register then
header := addToCatalog(ar, filePath);
else
raise FILE_ERROR;
end if;
if bin32(header.mode) & MODE_FILE_TYPE_MASK = MODE_FILE_SYMLINK then
header.mtime := mtime;
ar.catalog @:= [header.filePath] header;
seek(ar.arFile, ar.register[header.filePath]);
writeHead(ar.arFile, ar.catalog[header.filePath]);
else
raise FILE_ERROR;
end if;
end if;
end func;
const func string: getOwner (inout arArchive: ar, in string: filePath, SYMLINK) is func
result
var string: owner is "";
local
var arHeader: header is arHeader.value;
begin
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
elsif filePath = "" then
raise FILE_ERROR;
else
if filePath in ar.catalog then
header := ar.catalog[filePath];
elsif filePath in ar.register then
header := addToCatalog(ar, filePath);
else
raise FILE_ERROR;
end if;
if bin32(header.mode) & MODE_FILE_TYPE_MASK = MODE_FILE_SYMLINK then
owner := str(header.ownerId);
else
raise FILE_ERROR;
end if;
end if;
end func;
const proc: setOwner (inout arArchive: ar, in string: filePath,
in string: owner, SYMLINK) is func
local
var integer: uid is 0;
var arHeader: header is arHeader.value;
begin
if isDigitString(owner) then
uid := integer(owner);
elsif owner <> "root" then
raise RANGE_ERROR;
end if;
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
elsif filePath = "" then
raise FILE_ERROR;
else
if filePath in ar.catalog then
header := ar.catalog[filePath];
elsif filePath in ar.register then
header := addToCatalog(ar, filePath);
else
raise FILE_ERROR;
end if;
if bin32(header.mode) & MODE_FILE_TYPE_MASK = MODE_FILE_SYMLINK then
header.ownerId := uid;
ar.catalog @:= [header.filePath] header;
seek(ar.arFile, ar.register[header.filePath]);
writeHead(ar.arFile, ar.catalog[header.filePath]);
else
raise FILE_ERROR;
end if;
end if;
end func;
const func string: getGroup (inout arArchive: ar, in string: filePath, SYMLINK) is func
result
var string: group is "";
local
var arHeader: header is arHeader.value;
begin
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
elsif filePath = "" then
raise FILE_ERROR;
else
if filePath in ar.catalog then
header := ar.catalog[filePath];
elsif filePath in ar.register then
header := addToCatalog(ar, filePath);
else
raise FILE_ERROR;
end if;
if bin32(header.mode) & MODE_FILE_TYPE_MASK = MODE_FILE_SYMLINK then
group := str(header.groupId);
else
raise FILE_ERROR;
end if;
end if;
end func;
const proc: setGroup (inout arArchive: ar, in string: filePath,
in string: group, SYMLINK) is func
local
var integer: gid is 0;
var arHeader: header is arHeader.value;
begin
if isDigitString(group) then
gid := integer(group);
elsif group <> "root" then
raise RANGE_ERROR;
end if;
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
elsif filePath = "" then
raise FILE_ERROR;
else
if filePath in ar.catalog then
header := ar.catalog[filePath];
elsif filePath in ar.register then
header := addToCatalog(ar, filePath);
else
raise FILE_ERROR;
end if;
if bin32(header.mode) & MODE_FILE_TYPE_MASK = MODE_FILE_SYMLINK then
header.groupId := gid;
ar.catalog @:= [header.filePath] header;
seek(ar.arFile, ar.register[header.filePath]);
writeHead(ar.arFile, ar.catalog[header.filePath]);
else
raise FILE_ERROR;
end if;
end if;
end func;
const func string: readLink (inout arArchive: ar, in string: filePath) is func
result
var string: linkPath is "";
local
var arHeader: header is arHeader.value;
var string: linkPath8 is "";
begin
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
elsif filePath in ar.catalog then
header := ar.catalog[filePath];
elsif filePath in ar.register then
header := addToCatalog(ar, filePath);
else
raise FILE_ERROR;
end if;
if bin32(header.mode) & MODE_FILE_TYPE_MASK = MODE_FILE_SYMLINK then
seek(ar.arFile, header.dataStartPos);
linkPath8 := gets(ar.arFile, header.fileSize);
block
linkPath := fromUtf8(linkPath8);
exception
catch RANGE_ERROR:
linkPath := linkPath8;
end block;
else
raise FILE_ERROR;
end if;
end func;
const proc: makeLink (inout arArchive: ar, in string: symlinkPath,
in string: targetPath) is func
local
var arHeader: header is arHeader.value;
var string: targetPath8 is "";
var integer: length is 0;
begin
if symlinkPath <> "/" and endsWith(symlinkPath, "/") then
raise RANGE_ERROR;
elsif symlinkPath = "" or symlinkPath in ar.catalog or
symlinkPath in ar.register or implicitDir(ar.register, symlinkPath) then
raise FILE_ERROR;
else
targetPath8 := toUtf8(targetPath);
length := length(ar.arFile);
if length = 0 then
write(ar.arFile, AR_MAGIC);
end if;
header.filePath := symlinkPath;
header.mtime := timestamp1970(time(NOW));
header.ownerId := 0;
header.groupId := 0;
header.mode := ord(MODE_FILE_SYMLINK) + 8#777;
header.fileSize := length(targetPath8);
setHeaderFileName(ar, header);
length := length(ar.arFile);
ar.register @:= [symlinkPath] succ(length);
seek(ar.arFile, succ(length));
writeHead(ar.arFile, header);
header.dataStartPos := tell(ar.arFile);
ar.catalog @:= [symlinkPath] header;
write(ar.arFile, targetPath8);
write(ar.arFile, "\0;" mult pred(AR_PADDING) -
pred(header.fileSize) mod AR_PADDING);
flush(ar.arFile);
end if;
end func;
const func string: getFile (inout arArchive: ar, in string: filePath) is func
result
var string: content is "";
local
var arHeader: header is arHeader.value;
begin
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
else
header := followSymlink(ar, filePath);
if bin32(header.mode) & MODE_FILE_TYPE_MASK = MODE_FILE_REGULAR then
seek(ar.arFile, header.dataStartPos);
content := gets(ar.arFile, header.fileSize);
else
raise FILE_ERROR;
end if;
end if;
end func;
const proc: putFile (inout arArchive: ar, in var string: filePath,
in string: data) is func
local
var arHeader: header is arHeader.value;
var string: missingPath is "";
var integer: oldPaddedSize is 0;
var integer: newPaddedSize is 0;
var integer: length is 0;
begin
if filePath = "" or filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
else
missingPath := followSymlink(ar, filePath, header);
if missingPath = "" then
filePath := header.filePath;
if bin32(header.mode) & MODE_FILE_TYPE_MASK <> MODE_FILE_REGULAR then
raise FILE_ERROR;
else
oldPaddedSize := succ(pred(header.fileSize) mdiv AR_PADDING) * AR_PADDING;
newPaddedSize := succ(pred(length(data)) mdiv AR_PADDING) * AR_PADDING;
if newPaddedSize > oldPaddedSize then
insertArea(ar.arFile, header.dataStartPos, newPaddedSize - oldPaddedSize);
fixRegisterAndCatalog(ar, header.dataStartPos, newPaddedSize - oldPaddedSize);
elsif newPaddedSize < oldPaddedSize then
deleteArea(ar.arFile, header.dataStartPos, oldPaddedSize - newPaddedSize);
fixRegisterAndCatalog(ar, header.dataStartPos + (oldPaddedSize - newPaddedSize),
newPaddedSize - oldPaddedSize);
end if;
header.fileSize := length(data);
ar.catalog @:= [filePath] header;
seek(ar.arFile, ar.register[filePath]);
writeHead(ar.arFile, header);
write(ar.arFile, data);
write(ar.arFile, "\0;" mult pred(AR_PADDING) -
pred(header.fileSize) mod AR_PADDING);
flush(ar.arFile);
end if;
else
filePath := missingPath;
length := length(ar.arFile);
if length = 0 then
write(ar.arFile, AR_MAGIC);
end if;
header.filePath := filePath;
header.mtime := timestamp1970(time(NOW));
header.ownerId := 0;
header.groupId := 0;
header.mode := ord(MODE_FILE_REGULAR) + 8#664;
header.fileSize := length(data);
setHeaderFileName(ar, header);
length := length(ar.arFile);
ar.register @:= [filePath] succ(length);
seek(ar.arFile, succ(length));
writeHead(ar.arFile, header);
header.dataStartPos := tell(ar.arFile);
ar.catalog @:= [filePath] header;
write(ar.arFile, data);
write(ar.arFile, "\0;" mult pred(AR_PADDING) -
pred(header.fileSize) mod AR_PADDING);
flush(ar.arFile);
end if;
end if;
end func;
const proc: makeDir (inout arArchive: ar, in string: dirPath) is func
local
var arHeader: header is arHeader.value;
var boolean: fileExists is TRUE;
var integer: dataStartPos is 0;
var integer: length is 0;
var string: dirPath8 is "";
begin
if dirPath = "" or dirPath <> "/" and endsWith(dirPath, "/") then
raise RANGE_ERROR;
elsif dirPath in ar.catalog then
dataStartPos := ar.catalog[dirPath].dataStartPos;
elsif dirPath in ar.register then
dataStartPos := addToCatalog(ar, dirPath).dataStartPos;
elsif implicitDir(ar.register, dirPath) then
dataStartPos := addImplicitDir(ar, dirPath).dataStartPos;
else
fileExists := FALSE;
end if;
if fileExists and dataStartPos <> -1 then
raise FILE_ERROR;
else
dirPath8 := toUtf8(dirPath);
length := length(ar.arFile);
if length = 0 then
write(ar.arFile, AR_MAGIC);
end if;
header.filePath := dirPath;
header.mtime := timestamp1970(time(NOW));
header.ownerId := 0;
header.groupId := 0;
header.mode := ord(MODE_FILE_DIR) + 8#775;
header.fileSize := 0;
setHeaderFileName(ar, header);
length := length(ar.arFile);
ar.register @:= [dirPath] succ(length);
seek(ar.arFile, succ(length));
writeHead(ar.arFile, header);
header.dataStartPos := tell(ar.arFile);
ar.catalog @:= [dirPath] header;
flush(ar.arFile);
end if;
end func;
const proc: removeFile (inout arArchive: ar, in string: filePath) is func
local
var arHeader: header is arHeader.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 ar.catalog then
header := ar.catalog[filePath];
elsif filePath in ar.register then
header := addToCatalog(ar, filePath);
elsif implicitDir(ar.register, filePath) then
header := addImplicitDir(ar, filePath);
else
fileExists := FALSE;
end if;
if fileExists and
(bin32(header.mode) & MODE_FILE_TYPE_MASK = MODE_FILE_REGULAR or
bin32(header.mode) & MODE_FILE_TYPE_MASK = MODE_FILE_CHAR or
bin32(header.mode) & MODE_FILE_TYPE_MASK = MODE_FILE_BLOCK or
bin32(header.mode) & MODE_FILE_TYPE_MASK = MODE_FILE_FIFO or
bin32(header.mode) & MODE_FILE_TYPE_MASK = MODE_FILE_SYMLINK or
bin32(header.mode) & MODE_FILE_TYPE_MASK = MODE_FILE_SOCKET or
(bin32(header.mode) & MODE_FILE_TYPE_MASK = MODE_FILE_DIR and
isEmptyDir(ar.register, filePath))) then
posOfHeaderToBeRemoved := ar.register[filePath];
numCharsToBeRemoved := AR_HEADER_SIZE + succ(pred(header.fileSize) mdiv AR_PADDING) * AR_PADDING;
deleteArea(ar.arFile, posOfHeaderToBeRemoved, numCharsToBeRemoved);
excl(ar.register, filePath);
excl(ar.catalog, filePath);
fixRegisterAndCatalog(ar, posOfHeaderToBeRemoved + numCharsToBeRemoved,
-numCharsToBeRemoved);
flush(ar.arFile);
else
raise FILE_ERROR;
end if;
end func;
const proc: for (inout string: filePath) range (inout arArchive: ar) do
(in proc: statements)
end for is func
begin
for key filePath range ar.register do
statements;
end for;
end func;
const func file: openFileInAr (inout arArchive: ar, in string: filePath,
in string: mode) is func
result
var file: newFile is STD_NULL;
local
var arHeader: header is arHeader.value;
var boolean: okay is TRUE;
begin
if mode = "r" then
if filePath <> "/" and endsWith(filePath, "/") then
raise RANGE_ERROR;
elsif filePath in ar.catalog then
header := ar.catalog[filePath];
elsif filePath in ar.register then
header := addToCatalog(ar, filePath);
elsif implicitDir(ar.register, filePath) then
header := addImplicitDir(ar, filePath);
else
okay := FALSE;
end if;
if okay and
bin32(header.mode) & MODE_FILE_TYPE_MASK = MODE_FILE_REGULAR then
newFile := openSubFile(ar.arFile, header.dataStartPos, header.fileSize);
end if;
end if;
end func;
const func file: open (inout arArchive: ar, in string: filePath,
in string: mode) is
return openBufferFile(openFileInAr(ar, filePath, mode));