
(********************************************************************)
(*                                                                  *)
(*  ar.s7i        Ar archive library                                *)
(*  Copyright (C) 2019, 2020  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";


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);
    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 := utf8ToStri(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 len 12]));
      header.ownerId := integer(rtrim(stri[29 len  6]));
      header.groupId := integer(rtrim(stri[35 len  6]));
      header.mode :=    integer(rtrim(stri[41 len  8]));
    end if;
    header.fileSize :=           integer(rtrim(stri[49 len 10]));
    header.okay :=                             stri[59 len  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 len 10]));
      header.okay :=                         stri[59 len  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 := striToUtf8(header.filePath);
    # writeln("filePath8: " <& literal(filePath8));
    if header.longNameStart = 0 then
      if length(filePath8) < 16 then
        stri := (filePath8 & "/") rpad 16;
      elsif length(filePath8) = 16 then
        stri := filePath8[.. 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 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 := utf8ToStri(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: arRegisterType is hash [string] integer;
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(aArFile, "src/drivers")   # Relative path in the archive.
 *    fileType(aArFile, "/usr/include")  # Absolute path in the archive.
 *    fileSize(aArFile, "/image")        # Absolute path in the archive.
 *    readDir(aArFile, "")               # Return e.g.: "src" and "/"
 *    readDir(aArFile, "/")              # 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 arRegisterType: register is arRegisterType.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.
 *)
const proc: close (inout arArchive: ar) is func
  begin
    close(ar.arFile);
    ar.arFile := STD_NULL;
  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 boolean: implicitDir (inout arArchive: ar, in string: dirPath) is func
  result
    var boolean: implicitDir is FALSE;
  local
    var string: filePath is "";
  begin
    # writeln("implicitDir: " <& literal(dirPath));
    if dirPath <> "" then
      for key filePath range ar.register do
        if startsWith(filePath, dirPath) and
            length(filePath) > length(dirPath) and
            (filePath[succ(length(dirPath))] = '/' or dirPath = "/") then
          implicitDir := TRUE;
        end if;
      end for;
    end if;
  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 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 := striToUtf8(header.filePath);
    if length(filePath8) >= 16 then
      # Although 16 chars would fit a long name is used.
      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 func
  result
    var array string: fileNames is 0 times "";
  local
    var string: filePath is "";
    var boolean: dirExists is FALSE;
    var set of string: fileNameSet is (set of string).value;
    var string: fileName is "";
    var integer: slashPos is 0;
  begin
    if dirPath <> "/" and endsWith(dirPath, "/") then
      raise RANGE_ERROR;
    elsif dirPath = "" or dirPath = "." then
      for key fileName range ar.register do
        slashPos := pos(fileName, '/');
        if slashPos <> 0 then
          if slashPos = 1 then
            fileName := "/";
          else
            fileName := fileName[.. pred(slashPos)];
          end if;
        end if;
        if fileName not in fileNameSet then
          incl(fileNameSet, fileName);
        end if;
      end for;
    else
      for key filePath range ar.register do
        if startsWith(filePath, dirPath) then
          fileName := filePath[succ(length(dirPath)) ..];
          if fileName = "" then
            dirExists := TRUE;
          elsif startsWith(fileName, "/") then
            fileName := fileName[2 ..];
          elsif dirPath <> "/" then
            fileName := "";  # A file name <> dirPath starts with dirPath.
          end if;
          slashPos := pos(fileName, '/');
          if slashPos <> 0 then
            fileName := fileName[.. pred(slashPos)];
          end if;
          if fileName <> "" and fileName not in fileNameSet then
            incl(fileNameSet, fileName);
            dirExists := TRUE;
          end if;
        end if;
      end for;
      if not dirExists then
        raise FILE_ERROR;
      end if;
    end if;
    fileNames := sort(toArray(fileNameSet));
  end func;


(**
 *  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''.
 *  If a symbolic link refers to a place where the permission
 *  is denied 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
 *  illegal 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 5;
  begin
    # writeln("fileType: " <& filePath);
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    elsif filePath = "" then
      aFileType := FILE_DIR;
    else
      repeat
        if filePath in ar.catalog then
          header := ar.catalog[filePath];
        elsif filePath in ar.register then
          header := addToCatalog(ar, filePath);
        elsif implicitDir(ar, 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}:
              seek(ar.arFile, header.dataStartPos);
              filePath := gets(ar.arFile, header.fileSize);
            otherwise:
              raise RANGE_ERROR;
          end case;
        end if;
        decr(symlinkCount);
      until aFileType <> FILE_UNKNOWN or symlinkCount = 0;
    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 illegal 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, 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:
            raise RANGE_ERROR;
        end case;
      end if;
    end if;
  end func;


(**
 *  Determine the file mode (permissions) of a file in an AR archive.
 *  @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: fileMode (inout arArchive: ar, in string: filePath) is func
  result
    var fileMode: mode is fileMode.value;
  local
    var integer: modeValue is 0;
  begin
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    elsif filePath in ar.catalog then
      modeValue := ar.catalog[filePath].mode;
    elsif filePath in ar.register then
      modeValue := addToCatalog(ar, filePath).mode;
    elsif implicitDir(ar, filePath) then
      modeValue := addImplicitDir(ar, filePath).mode;
    else
      raise FILE_ERROR;
    end if;
    # writeln(filePath <& " mode: " <& modeValue radix 8);
    mode := fileMode conv modeValue;
  end func;


(**
 *  Change the file mode (permissions) of a file in an AR archive.
 *  @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;
    elsif filePath in ar.catalog then
      ar.catalog[filePath].mode := (ar.catalog[filePath].mode >> 9 << 9) +
          integer(mode);
    elsif filePath in ar.register then
      header := addToCatalog(ar, filePath);
      header.mode := (header.mode >> 9 << 9) + integer(mode);
      ar.catalog @:= [filePath] header;
    else
      raise FILE_ERROR;
    end if;
    seek(ar.arFile, ar.register[filePath]);
    writeHead(ar.arFile, ar.catalog[filePath]);
  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.
 *  @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;
    elsif filePath in ar.catalog then
      size := ar.catalog[filePath].fileSize;
    elsif filePath in ar.register then
      size := addToCatalog(ar, filePath).fileSize;
    elsif implicitDir(ar, filePath) then
      size := addImplicitDir(ar, filePath).fileSize;
    else
      raise FILE_ERROR;
    end if;
  end func;


(**
 *  Determine the modification time of a file in an AR archive.
 *  @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;
    var integer: mtime is 0;
  begin
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    elsif filePath in ar.catalog then
      mtime := ar.catalog[filePath].mtime;
    elsif filePath in ar.register then
      mtime := addToCatalog(ar, filePath).mtime;
    elsif implicitDir(ar, filePath) then
      mtime := addImplicitDir(ar, filePath).mtime;
    else
      raise FILE_ERROR;
    end if;
    modificationTime := timestamp1970ToTime(mtime);
  end func;


(**
 *  Set the modification time of a file in an AR archive.
 *  @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;
    elsif filePath in ar.catalog then
      ar.catalog[filePath].mtime := mtime;
    elsif filePath in ar.register then
      header := addToCatalog(ar, filePath);
      header.mtime := mtime;
      ar.catalog @:= [filePath] header;
    else
      raise FILE_ERROR;
    end if;
    seek(ar.arFile, ar.register[filePath]);
    writeHead(ar.arFile, ar.catalog[filePath]);
  end func;


(**
 *  Determine the name of the owner (UID) of a file in a AR archive.
 *  @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 "";
  local
    var integer: uid is 0;
  begin
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    elsif filePath in ar.catalog then
      uid := ar.catalog[filePath].ownerId;
    elsif filePath in ar.register then
      uid := addToCatalog(ar, filePath).ownerId;
    elsif implicitDir(ar, filePath) then
      uid := addImplicitDir(ar, filePath).ownerId;
    else
      raise FILE_ERROR;
    end if;
    # writeln(filePath <& " uid: " <& uid);
    owner := str(uid);
  end func;


(**
 *  Determine the name of the group (GID) of a file in a AR archive.
 *  @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 "";
  local
    var integer: gid is 0;
  begin
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    elsif filePath in ar.catalog then
      gid := ar.catalog[filePath].groupId;
    elsif filePath in ar.register then
      gid := addToCatalog(ar, filePath).groupId;
    elsif implicitDir(ar, filePath) then
      gid := addImplicitDir(ar, filePath).groupId;
    else
      raise FILE_ERROR;
    end if;
    # writeln(filePath <& " gid: " <& gid);
    group := str(gid);
  end func;


(**
 *  Get the contents of a file in an AR archive.
 *  @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;
    elsif filePath in ar.catalog then
      header := ar.catalog[filePath];
      if bin32(header.mode) & MODE_FILE_TYPE_MASK = MODE_FILE_REGULAR then
        seek(ar.arFile, header.dataStartPos);
      end if;
    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_REGULAR then
      content := gets(ar.arFile, header.fileSize);
    else
      raise FILE_ERROR;
    end if;
  end func;


(**
 *  Write ''data'' to an AR archive with the given ''filePath''.
 *  If the file exists already, it is overwritten.
 *  @exception RANGE_ERROR ''filePath'' does not use the standard path
 *             representation.
 *)
const proc: putFile (inout arArchive: ar, in string: filePath,
    in string: data) is func
  local
    var arHeader: header is arHeader.value;
    var boolean: fileExists is TRUE;
    var integer: oldPaddedSize is 0;
    var integer: newPaddedSize is 0;
    var integer: length is 0;
  begin
    # writeln("putFile(" <& literal(filePath) <& ")");
    if filePath = "" or 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, filePath) then
      raise FILE_ERROR;
    else
      fileExists := FALSE;
    end if;
    if fileExists then
      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
      length := length(ar.arFile);
      if length = 0 then
        write(ar.arFile, AR_MAGIC);
      end if;
      if not fileExists then
        header.filePath   := filePath;
        header.mtime      := timestamp1970(time(NOW));
        header.ownerId    := 100;
        header.groupId    := 100;
        header.mode       := ord(MODE_FILE_REGULAR) + 8#664;
      end if;
      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 func;


(**
 *  Remove a file (if it is not a directory), from an AR archive.
 *  @exception RANGE_ERROR ''filePath'' does not use the standard path
 *             representation.
 *  @exception FILE_ERROR The file does not exist or it is a directory.
 *)
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: numCharsToBeRemoved is 0;
    var integer: posOfHeaderToBeRemoved 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, filePath) then
      header := addImplicitDir(ar, filePath);
    else
      fileExists := FALSE;
    end if;
    if fileExists then
      if bin32(header.mode) & MODE_FILE_TYPE_MASK <> MODE_FILE_REGULAR then
        raise FILE_ERROR;
      else
        numCharsToBeRemoved := AR_HEADER_SIZE + succ(pred(header.fileSize) mdiv AR_PADDING) * AR_PADDING;
        # writeln("numCharsToBeRemoved: " <& numCharsToBeRemoved);
        posOfHeaderToBeRemoved := ar.register[filePath];
        deleteArea(ar.arFile, posOfHeaderToBeRemoved, numCharsToBeRemoved);
        excl(ar.register, filePath);
        excl(ar.catalog, filePath);
        fixRegisterAndCatalog(ar, posOfHeaderToBeRemoved + numCharsToBeRemoved,
                              -numCharsToBeRemoved);
        flush(ar.arFile);
      end if;
    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, 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));
