Seed7 Program listing


(********************************************************************)
(*                                                                  *)
(*  ar.s7i        Ar archive library                                *)
(*  Copyright (C) 2019, 2020, 2022, 2023  Thomas Mertes             *)
(*                                                                  *)
(*  This file is part of the Seed7 Runtime Library.                 *)
(*                                                                  *)
(*  The Seed7 Runtime Library is free software; you can             *)
(*  redistribute it and/or modify it under the terms of the GNU     *)
(*  Lesser General Public License as published by the Free Software *)
(*  Foundation; either version 2.1 of the License, or (at your      *)
(*  option) any later version.                                      *)
(*                                                                  *)
(*  The Seed7 Runtime Library is distributed in the hope that it    *)
(*  will be useful, but WITHOUT ANY WARRANTY; without even the      *)
(*  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR *)
(*  PURPOSE.  See the GNU Lesser General Public License for more    *)
(*  details.                                                        *)
(*                                                                  *)
(*  You should have received a copy of the GNU Lesser General       *)
(*  Public License along with this program; if not, write to the    *)
(*  Free Software Foundation, Inc., 51 Franklin Street,             *)
(*  Fifth Floor, Boston, MA  02110-1301, USA.                       *)
(*                                                                  *)
(********************************************************************)


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;
    # A longNameStart of zero means: The filePath is in header.name.
    # Values greater than zero indicate an index into ar.longNames.
    # Note that longNameStart is one more than the value used in the file.
    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);
    # writeln("slashPos: " <& slashPos);
    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
      # writeln(literal(stri));
      header := arHeader(stri);
      header.dataStartPos := tell(inFile);
    else
      header := arHeader.value;
    end if;
    # showHeader(OUT, header);
  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;
    # showHeader(OUT, header);
  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);
    # writeln("filePath8: " <& literal(filePath8));
    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";
    # writeln("header string: " <& literal(stri));
  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
      # longName is not stored correctly in longNames.
      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
        # Add padding
        longNames &:= "\n";
      end if;
    end if;
  end func;


const type: arCatalogType is hash [string] arHeader;


(**
 *  [[filesys#fileSys|FileSys]] implementation type to access an AR archive.
 *  File paths in an AR archive can be absolute (they start with a slash)
 *  or relative (they do not start with a slash). The ar file system does
 *  not support the concept of a current working directory. The functions
 *  chdir and getcwd are not supported by the ar file system. Absolute
 *  and relative paths in an AR archive can be accessed directly.
 *  Since "/" is just a normal path in an AR archive the root path of a
 *  ar file system is "". Possible usages of ar file system functions are:
 *    getMTime(anArArchive, "src/drivers")   # Relative path in the archive.
 *    fileType(anArArchive, "/usr/include")  # Absolute path in the archive.
 *    fileSize(anArArchive, "/image")        # Absolute path in the archive.
 *    readDir(anArArchive, "")               # Return e.g.: "src" and "/"
 *    readDir(anArArchive, "/")              # Return e.g.: "usr" and "image"
 *)
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;


(**
 *  Open an AR archive with the given arFile.
 *  @param arFile File that contains an AR archive.
 *  @return a file system that accesses the AR archive.
 *)
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
          # writeln(header.filePath <& " " <& headerPos);
          if header.filePath = "//" then
            # showHeader(OUT, header);
            ar.longNamesHeaderPos := headerPos;
            ar.longNames := gets(arFile, header.fileSize);
            # writeln("long Names: " <& literal(ar.longNames));
            headerPos := tell(arFile);
          elsif header.filePath = "/" then
            # showHeader(OUT, header);
            # lookup table
            ignore(gets(arFile, header.fileSize));
            headerPos := tell(arFile);
          else
            if header.longNameStart <> 0 then
              header.filePath := getLongName(ar.longNames, header.longNameStart);
            end if;
            # showHeader(OUT, header);
            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;


(**
 *  Open an AR archive with the given arFileName.
 *  @param arFileName Name of the AR archive to be opened.
 *  @return a file system that accesses the AR archive.
 *)
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;


(**
 *  Close an AR archive. The AR file below stays open.
 *)
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
    # writeln("followSymlink: " <& filePath);
    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
        # The file does not exist.
        missingPath := filePath;
        isSymlink := FALSE;
        # writeln("missing: " <& missingPath);
      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;
          # writeln("found: " <& header.filePath);
        end if;
      end if;
    until not isSymlink or symlinkCount < 0;
    if isSymlink then
      # Too many symbolic links.
      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
      # The file does not exist.
      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
    # writeln("setHeaderFileName: " <& header.filePath);
    filePath8 := toUtf8(header.filePath);
    if filePath8 <> header.filePath or length(filePath8) >= 16 or
        pos(filePath8, '/') <> 0 then
      # Not an ASCII file name with less than 16 chars.
      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;
          # writeln("update existing // header");
          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));
          # writeln("create new // header");
          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;


(**
 *  Determine the file names in a directory inside an AR archive.
 *  Note that the function returns only the file names.
 *  Additional information must be obtained with other calls.
 *  @param ar Open AR archive.
 *  @param dirPath Path of a directory in the AR archive.
 *  @return an array with the file names.
 *  @exception RANGE_ERROR ''dirPath'' does not use the standard path
 *             representation.
 *  @exception FILE_ERROR ''dirPath'' is not present in the AR archive.
 *)
const func array string: readDir (inout arArchive: ar, in string: dirPath) is
  return readDir(ar.register, dirPath);


(**
 *  Determine the file paths in an AR archive.
 *  Note that the function returns only the file paths.
 *  Additional information must be obtained with other calls.
 *  @param ar Open AR archive.
 *  @return an array with the file paths.
 *)
const func array string: readDir (inout arArchive: ar, RECURSIVE) is
  return sort(keys(ar.register));


(**
 *  Determine the type of a file in an AR archive.
 *  The function does follow symbolic links. If the chain of
 *  symbolic links is too long the function returns ''FILE_SYMLINK''.
 *  A return value of ''FILE_ABSENT'' does not imply that a file
 *  with this name can be created, since missing directories and
 *  invalid file names cause also ''FILE_ABSENT''.
 *  @return the type of the file.
 *  @exception RANGE_ERROR ''filePath'' does not use the standard path
 *             representation.
 *)
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
    # writeln("fileType: " <& filePath);
    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;


(**
 *  Determine the type of a file in an AR archive.
 *  The function does not follow symbolic links. Therefore it may
 *  return ''FILE_SYMLINK''. A return value of ''FILE_ABSENT'' does
 *  not imply that a file with this name can be created, since missing
 *  directories and invalid file names cause also ''FILE_ABSENT''.
 *  @return the type of the file.
 *  @exception RANGE_ERROR ''filePath'' does not use the standard path
 *             representation.
 *)
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
    # writeln("fileTypeSL: " <& filePath);
    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
        # writeln("modeValue: " <& modeValue radix 8);
        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;


(**
 *  Determine the file mode (permissions) of a file in an AR archive.
 *  The function follows symbolic links.
 *  @return the file mode.
 *  @exception RANGE_ERROR ''filePath'' does not use the standard path
 *             representation.
 *  @exception FILE_ERROR ''filePath'' is not present in the AR archive.
 *)
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;


(**
 *  Change the file mode (permissions) of a file in an AR archive.
 *  The function follows symbolic links.
 *  @exception RANGE_ERROR ''filePath'' does not use the standard path
 *             representation.
 *  @exception FILE_ERROR ''filePath'' is not present in the AR archive.
 *)
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;


(**
 *  Determine the size of a file in an AR archive.
 *  The file size is measured in bytes.
 *  For directories a size of 0 is returned.
 *  The function follows symbolic links.
 *  @return the size of the file.
 *  @exception RANGE_ERROR ''filePath'' does not use the standard path
 *             representation.
 *  @exception FILE_ERROR ''filePath'' is not present in the AR archive.
 *)
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;


(**
 *  Determine the modification time of a file in an AR archive.
 *  The function follows symbolic links.
 *  @return the modification time of the file.
 *  @exception RANGE_ERROR ''filePath'' does not use the standard path
 *             representation.
 *  @exception FILE_ERROR ''filePath'' is not present in the AR archive.
 *)
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;


(**
 *  Set the modification time of a file in an AR archive.
 *  The function follows symbolic links.
 *  @exception RANGE_ERROR ''filePath'' does not use the standard path
 *             representation.
 *  @exception RANGE_ERROR ''aTime'' is invalid or cannot be
 *             converted to the system file time.
 *  @exception FILE_ERROR ''filePath'' is not present in the AR archive.
 *)
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;


(**
 *  Determine the name of the owner (UID) of a file in an AR archive.
 *  The function follows symbolic links.
 *  @return the name of the file owner.
 *  @exception RANGE_ERROR ''filePath'' does not use the standard path
 *             representation.
 *  @exception FILE_ERROR ''filePath'' is not present in the AR archive, or
 *             the chain of symbolic links is too long.
 *)
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;


(**
 *  Set the owner of a file in an AR archive.
 *  The function follows symbolic links. The AR archive format allows
 *  only a numeric UID. The ''owner'' "root" is mapped to the UID 0. Other
 *  ''owner'' names raise a RANGE_ERROR.
 *  @exception RANGE_ERROR ''filePath'' does not use the standard path
 *             representation, or the ''owner'' cannot be mapped to a UID.
 *  @exception FILE_ERROR ''filePath'' is not present in the AR archive, or
 *             the chain of symbolic links is too long.
 *)
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;


(**
 *  Determine the name of the group (GID) of a file in an AR archive.
 *  The function follows symbolic links.
 *  @return the name of the file group.
 *  @exception RANGE_ERROR ''filePath'' does not use the standard path
 *             representation.
 *  @exception FILE_ERROR ''filePath'' is not present in the AR archive, or
 *             the chain of symbolic links is too long.
 *)
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;


(**
 *  Set the group of a file in an AR archive.
 *  The function follows symbolic links. The AR archive format allows
 *  only a numeric GID. The ''group'' "root" is mapped to the GID 0. Other
 *  ''group'' names raise a RANGE_ERROR.
 *  @exception RANGE_ERROR ''filePath'' does not use the standard path
 *             representation, or the ''group'' cannot be mapped to a GID.
 *  @exception FILE_ERROR ''filePath'' is not present in the AR archive, or
 *             the chain of symbolic links is too long.
 *)
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;


(**
 *  Determine the file mode (permissions) of a symbolic link in an AR archive.
 *  The function only works for symbolic links and does not follow the
 *  symbolic link.
 *  @return the file mode.
 *  @exception RANGE_ERROR ''filePath'' does not use the standard path
 *             representation.
 *  @exception FILE_ERROR The file described with ''filePath'' is not
 *             present in the AR archive, or it is not a symbolic link.
 *)
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
    # writeln("getFileMode: " <& filePath);
    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;


(**
 *  Determine the modification time of a symbolic link in an AR archive.
 *  The function only works for symbolic links and does not follow the
 *  symbolic link.
 *  @return the modification time of the symbolic link.
 *  @exception RANGE_ERROR ''filePath'' does not use the standard path
 *             representation.
 *  @exception FILE_ERROR The file described with ''filePath'' is not
 *             present in the AR archive, or it is not a symbolic link.
 *)
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
    # writeln("getMTime: " <& filePath);
    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;


(**
 *  Set the modification time of a symbolic link in an AR archive.
 *  The function only works for symbolic links and does not follow the
 *  symbolic link.
 *  @exception RANGE_ERROR ''filePath'' does not use the standard path
 *             representation.
 *  @exception RANGE_ERROR ''modificationTime'' is invalid or it cannot be
 *             converted to the system file time.
 *  @exception FILE_ERROR The file described with ''filePath'' is not
 *             present in the AR archive, or it is not a symbolic link.
 *)
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;


(**
 *  Determine the name of the owner (UID) of a symbolic link in an AR archive.
 *  The function only works for symbolic links and does not follow the
 *  symbolic link.
 *  @return the name of the file owner.
 *  @exception RANGE_ERROR ''filePath'' does not use the standard path
 *             representation.
 *  @exception FILE_ERROR The file described with ''filePath'' is not
 *             present in the AR archive, or it is not a symbolic link.
 *)
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
    # writeln("getOwner: " <& filePath);
    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;


(**
 *  Set the owner of a symbolic link in an AR archive.
 *  The function only works for symbolic links and does not follow the
 *  symbolic link. The AR archive format allows only a numeric UID.
 *  The ''owner'' "root" is mapped to the UID 0. Other ''owner'' names
 *  raise a RANGE_ERROR.
 *  @exception RANGE_ERROR ''filePath'' does not use the standard path
 *             representation, or the ''owner'' cannot be mapped to a UID.
 *  @exception FILE_ERROR The file described with ''filePath'' is not
 *             present in the AR archive, or it is not a symbolic link.
 *)
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;


(**
 *  Determine the name of the group (GID) of a symbolic link in an AR archive.
 *  The function only works for symbolic links and does not follow the
 *  symbolic link.
 *  @return the name of the file group.
 *  @exception RANGE_ERROR ''filePath'' does not use the standard path
 *             representation.
 *  @exception FILE_ERROR The file described with ''filePath'' is not
 *             present in the AR archive, or it is not a symbolic link.
 *)
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
    # writeln("getGroup: " <& filePath);
    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;


(**
 *  Set the group of a symbolic link in an AR archive.
 *  The function only works for symbolic links and does not follow the
 *  symbolic link. The AR archive format allows only a numeric GID.
 *  The ''group'' "root" is mapped to the GID 0. Other ''group'' names
 *  raise a RANGE_ERROR.
 *  @exception RANGE_ERROR ''filePath'' does not use the standard path
 *             representation, or the ''group'' cannot be mapped to a GID.
 *  @exception FILE_ERROR The file described with ''filePath'' is not
 *             present in the AR archive, or it is not a symbolic link.
 *)
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;


(**
 *  Reads the destination of a symbolic link in an AR archive.
 *  @return The destination referred by the symbolic link.
 *  @exception RANGE_ERROR ''filePath'' does not use the standard path
 *             representation.
 *  @exception FILE_ERROR ''filePath'' is not present in the AR archive,
 *             or is not a symbolic link.
 *)
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;


(**
 *  Create a symbolic link in an AR archive.
 *  The symbolic link ''symlinkPath'' will refer to ''targetPath'' afterwards.
 *  The function does not follow symbolic links.
 *  @param ar Open AR archive.
 *  @param symlinkPath Name of the symbolic link to be created.
 *  @param targetPath String to be contained in the symbolic link.
 *  @exception RANGE_ERROR ''targetPath'' or ''symlinkPath'' does not use the
 *             standard path representation.
 *  @exception FILE_ERROR A system function returns an error.
 *)
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
    # writeln("makeLink: " <& literal(symlinkPath) <& " " <& literal(targetPath));
    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);
      # writeln("ar.register[" <& literal(symlinkPath) <& "]: " <& ar.register[symlinkPath]);
      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;


(**
 *  Get the contents of a file in an AR archive.
 *  The function follows symbolic links.
 *  @return the specified file as string.
 *  @exception RANGE_ERROR ''filePath'' does not use the standard path
 *             representation.
 *  @exception FILE_ERROR ''filePath'' is not present in the AR archive,
 *             or is not a regular file.
 *)
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;


(**
 *  Write ''data'' to an AR archive with the given ''filePath''.
 *  If the file exists already, it is overwritten.
 *  The function follows symbolic links.
 *  @exception RANGE_ERROR ''filePath'' does not use the standard path
 *             representation.
 *)
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
        # The file does exist.
        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;
          # writeln("oldPaddedSize: " <& oldPaddedSize);
          # writeln("newPaddedSize: " <& newPaddedSize);
          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;
          # The file data is rewritten in place.
          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);
        # writeln("ar.register[" <& literal(filePath) <& "]: " <& ar.register[filePath]);
        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;


(**
 *  Create a new directory in an AR archive.
 *  The function does not follow symbolic links.
 *  @param ar Open AR archive.
 *  @param dirPath Name of the directory to be created.
 *  @exception RANGE_ERROR ''dirPath'' does not use the standard path
 *             representation.
 *  @exception FILE_ERROR The file ''dirPath'' already exists.
 *)
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
      # The file exists and it is not an implicit directory.
      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);
      # writeln("ar.register[" <& literal(dirPath) <& "]: " <& ar.register[dirPath]);
      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;


(**
 *  Remove any file except non-empty directories from an AR archive.
 *  The function does not follow symbolic links. An attempt to remove a
 *  directory that is not empty triggers FILE_ERROR.
 *  @param ar Open AR archive.
 *  @param filePath Name of the file to be removed.
 *  @exception RANGE_ERROR ''filePath'' does not use the standard path
 *             representation.
 *  @exception FILE_ERROR The file does not exist or it is a directory
 *             that is not empty.
 *)
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
    # writeln("removeFile(" <& literal(filePath) <& ")");
    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;
      # writeln("numCharsToBeRemoved: " <& numCharsToBeRemoved);
      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;


(**
 *  For-loop which loops recursively over the paths in an AR archive.
 *)
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;


(**
 *  Open a file with ''filePath'' and ''mode'' in in an AR archive.
 *)
const func file: open (inout arArchive: ar, in string: filePath,
    in string: mode) is
  return openBufferFile(openFileInAr(ar, filePath, mode));