(********************************************************************)
(*                                                                  *)
(*  tar.s7i       Tar archive library                               *)
(*  Copyright (C) 1994, 2004, 2005, 2010, 2014  Thomas Mertes       *)
(*                2016 - 2024  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 "unicode.s7i";
include "fileutil.s7i";
include "subfile.s7i";
include "iobuffer.s7i";
include "archive_base.s7i";


const string: TAR_MAGIC is "ustar";
const string: TAR_NOMAGIC is "";

const integer: TAR_BLOCK_SIZE is 512;
const string: END_OF_FILE_MARKER is "\0;" mult TAR_BLOCK_SIZE;

const char: REGTYPE         is '0';   # Regular file (preferred code)
const char: AREGTYPE        is '\0;'; # Regular file (alternate code)
const char: LNKTYPE         is '1';   # Hard link.
const char: SYMTYPE         is '2';   # Symbolic link
const char: CHRTYPE         is '3';   # Character special
const char: BLKTYPE         is '4';   # Block special
const char: DIRTYPE         is '5';   # Directory
const char: FIFOTYPE        is '6';   # Named pipe
const char: CONTTYPE        is '7';   # Contiguous file
const char: LONGNAMETYPE    is 'L';   # Long (untruncated) filename of the next file.
const char: LONGLINKTYPE    is 'K';   # Long link destination of a previous header.
const char: GLOBAL_HEADER   is 'g';   # Global extended header with meta data
const char: EXTENDED_HEADER is 'x';   # Meta data for the next file in the archive.


const type: tarHeader is new struct
    var string: name is "";
    var integer: mode is 0;
    var integer: uid is 0;
    var integer: gid is 0;
    var integer: fileSize is 0;
    var integer: mtime is 0;
    var integer: chksum is 0;
    var char: typeflag is REGTYPE;
    var string: linkname is "";
    var string: magic is "";
    var string: version is "";
    var string: uname is "";
    var string: gname is "";
    var integer: devmajor is 0;
    var integer: devminor is 0;
    var string: prefix is "";
    var boolean: endOfFileMarker is FALSE;
    var boolean: chksumOkay is FALSE;
    var string: filePath is "";
    var string: filePathSuffix is "";
    var string: linkPath is "";
    var integer: dataStartPos is 0;
  end struct;


const proc: showHeader (inout file: outFile, in tarHeader: header) is func
  begin
    writeln(outFile, "name: " <& header.name);
    writeln(outFile, "mode: " <& header.mode radix 8);
    writeln(outFile, "uid: " <& header.uid);
    writeln(outFile, "gid: " <& header.gid);
    writeln(outFile, "fileSize: " <& header.fileSize);
    writeln(outFile, "mtime: " <& header.mtime);
    writeln(outFile, "chksum: " <& header.chksum);
    writeln(outFile, "typeflag: " <& literal(header.typeflag));
    writeln(outFile, "linkname: " <& header.linkname);
    writeln(outFile, "magic: " <& literal(header.magic));
    writeln(outFile, "version: " <& literal(header.version));
    writeln(outFile, "uname: " <& header.uname);
    writeln(outFile, "gname: " <& header.gname);
    writeln(outFile, "devmajor: " <& header.devmajor);
    writeln(outFile, "devminor: " <& header.devminor);
    writeln(outFile, "prefix: " <& header.prefix);
    writeln(outFile, "endOfFileMarker: " <& header.endOfFileMarker);
    writeln(outFile, "chksumOkay: " <& header.chksumOkay);
    writeln(outFile, "filePath: " <& header.filePath);
    writeln(outFile, "filePathSuffix: " <& header.filePathSuffix);
    writeln(outFile, "linkPath: " <& header.linkPath);
    writeln(outFile, "dataStartPos: " <& header.dataStartPos);
  end func;


const func string: gets0 (in string: stri) is func
  result
    var string: data is "";
  local
    var integer: zeroBytePos is 0;
  begin
    zeroBytePos := pos(stri, "\0;");
    if zeroBytePos <> 0 then
      data := stri[ .. pred(zeroBytePos)];
    else
      data := stri;
    end if;
  end func;


const func string: gets0Spc (in string: stri) is func
  result
    var string: data is "";
  local
    var integer: zeroBytePos is 0;
    var integer: spacePos is 0;
  begin
    zeroBytePos := pos(stri, "\0;");
    if zeroBytePos <> 0 then
      data := stri[ .. pred(zeroBytePos)];
    else
      data := stri;
    end if;
    spacePos := pos(data, " ");
    if spacePos <> 0 then
      data := data[ .. pred(spacePos)];
    end if;
  end func;


const func integer: getOct (in string: stri) is func
  result
    var integer: number is 0;
  local
    var integer: start is 1;
    var integer: pos is 0;
  begin
    while start <= length(stri) and stri[start] = ' ' do
      incr(start);
    end while;
    pos := start;
    while pos <= length(stri) and stri[pos] >= '0' and stri[pos] <= '7' do
      incr(pos);
    end while;
    if pos > start then
      number := integer(stri[start .. pred(pos)], 8);
    end if;
  end func;


const func string: getMetaData (in string: stri, inout integer: pos) is func
  result
    var string: metaData is "";
  local
    var integer: subPos is 0;
    var integer: length is 0;
  begin
    subPos := pos;
    while subPos <= length(stri) and stri[subPos] >= '0' and stri[subPos] <= '9' do
      incr(subPos);
    end while;
    if subPos > 1 and stri[subPos] = ' ' then
      length := integer(stri[pos .. pred(subPos)]);
      metaData := stri[succ(subPos) .. pos + length - 2];
      pos +:= length;
    end if;
  end func;


const proc: puts0 (inout string: out_stri, in string: stri, in integer: length) is func
  begin
    out_stri &:= stri[ .. length];
    if length(stri) < length then
      out_stri &:= "\0;" mult length - length(stri);
    end if;
  end func;


const proc: putSpc (inout string: out_stri, in string: stri, in integer: length) is func
  begin
    out_stri &:= stri[ .. length] rpad length;
  end func;


const proc: putOct (inout string: out_stri, in integer: number, in integer: length) is func
  begin
    out_stri &:= number radix 8 lpad0 pred(length) <& "\0;";
  end func;


const func integer: tarChksum (in string: stri) is func
  result
    var integer: checkSum is 0;
  local
    var char: ch is ' ';
  begin
    for ch range stri do
      checkSum +:= ord(ch);
    end for;
    checkSum := checkSum mod 2 ** 16;
  end func;


const func tarHeader: tarHeader (in string: stri) is func
  result
    var tarHeader: header is tarHeader.value;
  begin
    header.name :=        gets0(stri[  1 fixLen 100]);
    header.mode :=       getOct(stri[101 fixLen   8]);
    header.uid :=        getOct(stri[109 fixLen   8]);
    header.gid :=        getOct(stri[117 fixLen   8]);
    header.fileSize :=   getOct(stri[125 fixLen  12]);
    header.mtime :=      getOct(stri[137 fixLen  12]);
    header.chksum :=     getOct(stri[149 fixLen   8]);
    header.typeflag :=          stri[157];     (* 1*)
    header.linkname :=    gets0(stri[158 fixLen 100]);
    header.magic :=    gets0Spc(stri[258 fixLen   6]);
    header.version :=           stri[264 fixLen   2];
    header.uname :=       gets0(stri[266 fixLen  32]);
    header.gname :=       gets0(stri[298 fixLen  32]);
    header.devmajor :=   getOct(stri[330 fixLen   8]);
    header.devminor :=   getOct(stri[338 fixLen   8]);
    header.prefix :=      gets0(stri[346 fixLen 155]);
    # Unused                                     12
  end func;


const func tarHeader: readHeadBlock (inout file: inFile) is func
  result
    var tarHeader: header is tarHeader.value;
  local
    var string: stri is "";
  begin
    stri := gets(inFile, TAR_BLOCK_SIZE);
    if length(stri) = TAR_BLOCK_SIZE then
      if stri = END_OF_FILE_MARKER then
        header.endOfFileMarker := TRUE;
      else
        header := tarHeader(stri);
        # The checksum is computed with an empty chksum field:
        header.chksumOkay :=
            tarChksum(stri[ .. 148] & ("" lpad 8) & stri[157 .. ]) = header.chksum;
      end if;
      # showHeader(STD_OUT, header);
    elsif stri = "" then
      header.endOfFileMarker := TRUE;
    end if;
  end func;


const proc: readHead (inout file: inFile, inout tarHeader: header) is func
  local
    var string: filePath8 is "";
    var string: linkPath8 is "";
    var string: extendedHeaderData is "";
    var integer: pos is 1;
    var string: metaData is "";
  begin
    header := readHeadBlock(inFile);
    # showHeader(STD_OUT, header);
    while header.magic = TAR_MAGIC and
        (((header.typeflag = LONGNAMETYPE or header.typeflag = LONGLINKTYPE) and
           header.name = "././@LongLink") or
         header.typeflag = EXTENDED_HEADER or header.typeflag = GLOBAL_HEADER) do
      if header.typeflag = LONGNAMETYPE then
        filePath8 := gets(inFile, header.fileSize);
      elsif header.typeflag = LONGLINKTYPE then
        linkPath8 := gets(inFile, header.fileSize);
      elsif header.typeflag = EXTENDED_HEADER then
        extendedHeaderData := gets(inFile, header.fileSize);
        pos := 1;
        while pos <= length(extendedHeaderData) do
          metaData := getMetaData(extendedHeaderData, pos);
          # writeln("metaData: " <& metaData);
          if startsWith(metaData, "path=") then
            filePath8 := metaData[6 ..];
          elsif startsWith(metaData, "linkpath=") then
            linkPath8 := metaData[10 ..];
          end if;
        end while;
      else # header.typeflag = GLOBAL_HEADER
        ignore(gets(inFile, header.fileSize));
      end if;
      seek(inFile, tell(inFile) + pred(TAR_BLOCK_SIZE) -
           pred(header.fileSize) mod TAR_BLOCK_SIZE);
      header := readHeadBlock(inFile);
      # showHeader(STD_OUT, header);
    end while;
    if filePath8 = "" then
      if header.prefix <> "" then
        filePath8 := header.prefix & "/" & header.name;
      else
        filePath8 := header.name;
      end if;
    end if;
    block
      header.filePath := fromUtf8(filePath8);
    exception
      catch RANGE_ERROR:
        header.filePath := filePath8;
    end block;
    if linkPath8 = "" then
      linkPath8 := header.linkname;
    end if;
    block
      header.linkPath := fromUtf8(linkPath8);
    exception
      catch RANGE_ERROR:
        header.linkPath := linkPath8;
    end block;
    if endsWith(header.filePath, "/") and header.filePath <> "/" then
      header.filePath := header.filePath[.. pred(length(header.filePath))];
      header.filePathSuffix := "/";
    end if;
    if endsWith(header.linkPath, "/") then
      header.linkPath := header.linkPath[.. pred(length(header.linkPath))];
    end if;
    header.dataStartPos := tell(inFile);
  end func;


const func tarHeader: readMinimumOfHeadBlock (inout file: inFile) is func
  result
    var tarHeader: header is tarHeader.value;
  local
    var string: stri is "";
  begin
    stri := gets(inFile, TAR_BLOCK_SIZE);
    if length(stri) = TAR_BLOCK_SIZE then
      if stri = END_OF_FILE_MARKER then
        header.endOfFileMarker := TRUE;
      else
        header.name :=         gets0(stri[  1 fixLen 100]);
        header.fileSize :=    getOct(stri[125 fixLen  12]);
        header.typeflag :=           stri[157];     (* 1*)
        header.magic :=     gets0Spc(stri[258 fixLen   6]);
        header.prefix :=       gets0(stri[346 fixLen 155]);
      end if;
      # showHeader(STD_OUT, header);
    elsif stri = "" then
      header.endOfFileMarker := TRUE;
    end if;
  end func;


const proc: readMinimumOfHead (inout file: inFile, inout tarHeader: header) is func
  local
    var string: filePath8 is "";
    var string: extendedHeaderData is "";
    var integer: pos is 1;
    var string: metaData is "";
  begin
    header := readMinimumOfHeadBlock(inFile);
    # showHeader(STD_OUT, header);
    while header.magic = TAR_MAGIC and
        (((header.typeflag = LONGNAMETYPE or header.typeflag = LONGLINKTYPE) and
           header.name = "././@LongLink") or
         header.typeflag = EXTENDED_HEADER or header.typeflag = GLOBAL_HEADER) do
      if header.typeflag = LONGNAMETYPE then
        filePath8 := gets(inFile, header.fileSize);
        seek(inFile, tell(inFile) + pred(TAR_BLOCK_SIZE) - pred(header.fileSize) mod TAR_BLOCK_SIZE);
      elsif header.typeflag = EXTENDED_HEADER then
        extendedHeaderData := gets(inFile, header.fileSize);
        pos := 1;
        while pos <= length(extendedHeaderData) do
          metaData := getMetaData(extendedHeaderData, pos);
          # writeln("metaData: " <& metaData);
          if startsWith(metaData, "path=") then
            filePath8 := metaData[6 ..];
          end if;
        end while;
        seek(inFile, tell(inFile) + pred(TAR_BLOCK_SIZE) - pred(header.fileSize) mod TAR_BLOCK_SIZE);
      else  # header.typeflag = LONGLINKTYPE or
            # header.typeflag = GLOBAL_HEADER
        seek(inFile, succ(succ((tell(inFile) + header.fileSize - 2) mdiv
                     TAR_BLOCK_SIZE) * TAR_BLOCK_SIZE));
      end if;
      header := readMinimumOfHeadBlock(inFile);
      # showHeader(STD_OUT, header);
    end while;
    if filePath8 = "" then
      if header.prefix <> "" then
        filePath8 := header.prefix & "/" & header.name;
      else
        filePath8 := header.name;
      end if;
    end if;
    block
      header.filePath := fromUtf8(filePath8);
    exception
      catch RANGE_ERROR:
        header.filePath := filePath8;
    end block;
    if endsWith(header.filePath, "/") and header.filePath <> "/" then
      header.filePath := header.filePath[.. pred(length(header.filePath))];
    end if;
  end func;


const func string: str (in tarHeader: header) is func
  result
    var string: stri is "";
  local
    var string: chksum is "";
  begin
    puts0  (stri, header.name,               100);
    putOct (stri, header.mode,                 8);
    putOct (stri, header.uid,                  8);
    putOct (stri, header.gid,                  8);
    putOct (stri, header.fileSize,            12);
    putOct (stri, header.mtime,               12);
    putSpc (stri, "",                          8);
    stri &:=      header.typeflag;          (* 1*)
    puts0  (stri, header.linkname,           100);
    puts0  (stri, header.magic,                6);
    putSpc (stri, header.version,              2);
    puts0  (stri, header.uname,               32);
    puts0  (stri, header.gname,               32);
    putOct (stri, header.devmajor,             8);
    putOct (stri, header.devminor,             8);
    puts0  (stri, header.prefix,             155);
    puts0  (stri, "",                         12);
    # The checksum is computed with an empty chksum field:
    putOct (chksum, tarChksum(stri), 8);
    # The computed checksum is inserted:
    stri := stri[ .. 148] & chksum & stri[157 .. ];
  end func;


const proc: writeHead (inout file: outFile, in var tarHeader: header) is func
  local
    var string: filePath8 is "";
    var string: linkPath8 is "";
    var tarHeader: longNameHead is tarHeader.value;
    var integer: startPos is 0;
    var integer: slashPos is 0;
  begin
    filePath8 := toUtf8(header.filePath);
    if filePath8 & header.filePathSuffix <> header.prefix & "/" & header.name then
      if length(filePath8) + length(header.filePathSuffix) > 100 then
        if length(filePath8) + length(header.filePathSuffix) <= 256 then
          startPos := max(2, length(filePath8) + length(header.filePathSuffix) - 100);
          slashPos := pos(filePath8, "/", startPos);
          if slashPos <> 0 then
            if slashPos <= 156 then  # Maximum prefix length is 155.
              header.name := filePath8[succ(slashPos) ..] & header.filePathSuffix;
              header.prefix := filePath8[.. pred(slashPos)];
            else
              slashPos := 0;
            end if;
          end if;
        end if;
        if slashPos = 0 then
          longNameHead.name     := "././@LongLink";
          longNameHead.mode     := 0;
          longNameHead.uid      := 0;
          longNameHead.gid      := 0;
          longNameHead.fileSize := length(filePath8) + length(header.filePathSuffix);
          longNameHead.mtime    := 0;
          longNameHead.typeflag := LONGNAMETYPE;
          longNameHead.linkname := "";
          longNameHead.magic    := TAR_MAGIC;
          longNameHead.version  := "  ";
          longNameHead.uname    := "root";
          longNameHead.gname    := "root";
          longNameHead.devmajor := 0;
          longNameHead.devminor := 0;
          longNameHead.prefix   := "";
          write(outFile, str(longNameHead));
          write(outFile, filePath8);
          write(outFile, header.filePathSuffix);
          write(outFile, "\0;" mult pred(TAR_BLOCK_SIZE) - pred(longNameHead.fileSize) mod TAR_BLOCK_SIZE);
          header.name := (filePath8 & header.filePathSuffix)[.. 100];
        end if;
      else
        header.name := filePath8 & header.filePathSuffix;
      end if;
    end if;
    linkPath8 := toUtf8(header.linkPath);
    if length(filePath8) > 100 then
      longNameHead.name     := "././@LongLink";
      longNameHead.mode     := 0;
      longNameHead.uid      := 0;
      longNameHead.gid      := 0;
      longNameHead.fileSize := length(linkPath8);
      longNameHead.mtime    := 0;
      longNameHead.typeflag := LONGLINKTYPE;
      longNameHead.linkname := "";
      longNameHead.magic    := TAR_MAGIC;
      longNameHead.version  := "  ";
      longNameHead.uname    := "root";
      longNameHead.gname    := "root";
      longNameHead.devmajor := 0;
      longNameHead.devminor := 0;
      longNameHead.prefix   := "";
      write(outFile, str(longNameHead));
      write(outFile, linkPath8);
      write(outFile, "\0;" mult pred(TAR_BLOCK_SIZE) - pred(longNameHead.fileSize) mod TAR_BLOCK_SIZE);
    else
      header.linkname := linkPath8;
    end if;
    write(outFile, str(header));
  end func;


const type: tarCatalogType is hash [string] tarHeader;


(**
 *  [[filesys#fileSys|FileSys]] implementation type to access a TAR archive.
 *  File paths in a TAR archive can be absolute (they start with a slash)
 *  or relative (they do not start with a slash). The tar file system does
 *  not support the concept of a current working directory. The functions
 *  chdir and getcwd are not supported by the tar file system. Absolute
 *  and relative paths in a TAR archive can be accessed directly.
 *  Since "/" is just a normal path in a TAR archive the root path of a
 *  tar file system is "". Possible usages of tar file system functions are:
 *    getMTime(aTarArchive, "src/drivers")   # Relative path in the archive.
 *    fileType(aTarArchive, "/usr/include")  # Absolute path in the archive.
 *    fileSize(aTarArchive, "/image")        # Absolute path in the archive.
 *    readDir(aTarArchive, "")               # Return e.g.: "src" and "/"
 *    readDir(aTarArchive, "/")              # Return e.g.: "usr" and "image"
 *)
const type: tarArchive is sub emptyFileSys struct
    var file: tarFile is STD_NULL;
    var archiveRegisterType: register is archiveRegisterType.value;
    var tarCatalogType: catalog is tarCatalogType.value;
    var integer: endOfFileMarkerPos is 0;
  end struct;


(**
 *  Open a TAR archive with the given tarFile.
 *  @param tarFile File that contains a TAR archive.
 *  @return a file system that accesses the TAR archive, or
 *          fileSys.value if it could not be opened.
 *)
const func fileSys: openTar (inout file: tarFile) is func
  result
    var fileSys: newFileSys is fileSys.value;
  local
    var tarHeader: header is tarHeader.value;
    var integer: headPos is 1;
    var tarArchive: tar is tarArchive.value;
  begin
    if length(tarFile) = 0 then
      tar.tarFile := tarFile;
      newFileSys := toInterface(tar);
    else
      seek(tarFile, headPos);
      readHead(tarFile, header);
      if not header.endOfFileMarker and
          header.chksumOkay and header.filePath <> "" and
          (header.magic = TAR_MAGIC or header.magic = TAR_NOMAGIC) then
        tar.tarFile := tarFile;
        repeat
          # writeln(header.filePath <& " " <& headPos);
          tar.register @:= [header.filePath] headPos;
          if header.fileSize = 0 then
            headPos := tell(tarFile);
          else
            headPos := tell(tarFile) +
                succ(pred(header.fileSize) mdiv TAR_BLOCK_SIZE) * TAR_BLOCK_SIZE;
            seek(tarFile, headPos);
          end if;
          readMinimumOfHead(tarFile, header);
        until header.endOfFileMarker or header.filePath = "" or
              (header.magic <> TAR_MAGIC and header.magic <> TAR_NOMAGIC);
        if header.endOfFileMarker then
          tar.endOfFileMarkerPos := headPos;
        end if;
        newFileSys := toInterface(tar);
      end if;
    end if;
  end func;


(**
 *  Open a TAR archive with the given tarFileName.
 *  @param tarFileName Name of the TAR archive to be opened.
 *  @return a file system that accesses the TAR archive, or
 *          fileSys.value if it could not be opened.
 *)
const func fileSys: openTar (in string: tarFileName) is func
  result
    var fileSys: tar is fileSys.value;
  local
    var file: tarFile is STD_NULL;
  begin
    tarFile := open(tarFileName, "r");
    tar := openTar(tarFile);
  end func;


(**
 *  Close a TAR archive. The TAR file below stays open.
 *)
const proc: close (inout tarArchive: tar) is func
  begin
    tar := tarArchive.value;
  end func;


const func tarHeader: addToCatalog (inout tarArchive: tar, in string: filePath) is func
  result
    var tarHeader: header is tarHeader.value;
  begin
    seek(tar.tarFile, tar.register[filePath]);
    readHead(tar.tarFile, header);
    if not header.chksumOkay then
      raise FILE_ERROR;
    else
      tar.catalog @:= [filePath] header;
    end if;
  end func;


const func tarHeader: addImplicitDir (inout tarArchive: tar,
    in string: dirPath) is func
  result
    var tarHeader: header is tarHeader.value;
  begin
    header.filePath := dirPath;
    if dirPath <> "/" then
      header.filePathSuffix := "/";
    end if;
    header.typeflag := DIRTYPE;
    header.dataStartPos := -1;
    tar.catalog @:= [dirPath] header;
  end func;


const func string: followSymlink (inout tarArchive: tar, in var string: filePath,
    inout tarHeader: header) is func
  result
    var string: missingPath is "";
  local
    var integer: symlinkCount is MAX_SYMLINK_CHAIN_LENGTH;
    var boolean: isSymlink is TRUE;
  begin
    # writeln("followSymlink: " <& filePath);
    repeat
      if filePath in tar.catalog then
        header := tar.catalog[filePath];
      elsif filePath in tar.register then
        header := addToCatalog(tar, filePath);
      elsif implicitDir(tar.register, filePath) then
        header := addImplicitDir(tar, filePath);
      else
        # The file does not exist.
        missingPath := filePath;
        isSymlink := FALSE;
        # writeln("missing: " <& missingPath);
      end if;
      if missingPath = "" then
        if header.typeflag = SYMTYPE then
          decr(symlinkCount);
          filePath := symlinkDestination(filePath, header.linkPath);
          if startsWith(filePath, "/") and
              filePath not in tar.catalog and filePath not in tar.register then
            filePath := filePath[2 ..];
          end if;
        else
          isSymlink := FALSE;
          # 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 tarHeader: followSymlink (inout tarArchive: tar, in string: filePath) is func
  result
    var tarHeader: header is tarHeader.value;
  local
    var string: missingPath is "";
  begin
    missingPath := followSymlink(tar, filePath, header);
    if missingPath <> "" then
      # The file does not exist.
      raise FILE_ERROR;
    end if;
  end func;


const proc: fixRegisterAndCatalog (inout tarArchive: tar, in integer: insertPos,
    in integer: numChars) is func
  local
    var integer: headerPos is 1;
    var string: filePath is "";
  begin
    for key filePath range tar.register do
      if tar.register[filePath] >= insertPos then
        tar.register[filePath] +:= numChars;
      end if;
    end for;
    for key filePath range tar.catalog do
      if tar.catalog[filePath].dataStartPos >= insertPos then
        tar.catalog[filePath].dataStartPos +:= numChars;
      end if;
    end for;
  end func;


(**
 *  Determine the file names in a directory inside a TAR archive.
 *  Note that the function returns only the file names.
 *  Additional information must be obtained with other calls.
 *  @param tar Open TAR archive.
 *  @param dirPath Path of a directory in the TAR 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 TAR archive.
 *)
const func array string: readDir (inout tarArchive: tar, in string: dirPath) is
  return readDir(tar.register, dirPath);


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


(**
 *  Determine the type of a file in a TAR archive.
 *  The function follows 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 tarArchive: tar, in var string: filePath) is func
  result
    var fileType: aFileType is FILE_UNKNOWN;
  local
    var tarHeader: header is tarHeader.value;
    var integer: symlinkCount is MAX_SYMLINK_CHAIN_LENGTH;
    var boolean: isSymlink is FALSE;
  begin
    # 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 tar.catalog then
          header := tar.catalog[filePath];
        elsif filePath in tar.register then
          header := addToCatalog(tar, filePath);
        elsif implicitDir(tar.register, filePath) then
          header := addImplicitDir(tar, filePath);
        else
          aFileType := FILE_ABSENT;
        end if;
        if aFileType = FILE_UNKNOWN then
          case header.typeflag of
            when {REGTYPE}:  aFileType := FILE_REGULAR;
            when {AREGTYPE}: aFileType := FILE_REGULAR;
            when {CHRTYPE}:  aFileType := FILE_CHAR;
            when {BLKTYPE}:  aFileType := FILE_BLOCK;
            when {DIRTYPE}:  aFileType := FILE_DIR;
            when {FIFOTYPE}: aFileType := FILE_FIFO;
            when {CONTTYPE}: aFileType := FILE_UNKNOWN;
            when {SYMTYPE}:
              isSymlink := TRUE;
              decr(symlinkCount);
              filePath := symlinkDestination(filePath, header.linkPath);
              if startsWith(filePath, "/") and
                  filePath not in tar.catalog and filePath not in tar.register then
                filePath := filePath[2 ..];
              end if;
            otherwise:       aFileType := FILE_UNKNOWN;
          end case;
        end if;
      until not isSymlink or symlinkCount < 0;
      if isSymlink then
        aFileType := FILE_SYMLINK;
      end if;
    end if;
  end func;


(**
 *  Determine the type of a file in a TAR 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 tarArchive: tar, in string: filePath) is func
  result
    var fileType: aFileType is FILE_UNKNOWN;
  local
    var char: typeflag is ' ';
  begin
    # writeln("fileTypeSL: " <& filePath);
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    elsif filePath = "" then
      aFileType := FILE_DIR;
    else
      if filePath in tar.catalog then
        typeflag := tar.catalog[filePath].typeflag;
      elsif filePath in tar.register then
        typeflag := addToCatalog(tar, filePath).typeflag;
      elsif implicitDir(tar.register, filePath) then
        typeflag := addImplicitDir(tar, filePath).typeflag;
      else
        aFileType := FILE_ABSENT;
      end if;
      if aFileType = FILE_UNKNOWN then
        case typeflag of
          when {REGTYPE}:  aFileType := FILE_REGULAR;
          when {AREGTYPE}: aFileType := FILE_REGULAR;
          when {SYMTYPE}:  aFileType := FILE_SYMLINK;
          when {CHRTYPE}:  aFileType := FILE_CHAR;
          when {BLKTYPE}:  aFileType := FILE_BLOCK;
          when {DIRTYPE}:  aFileType := FILE_DIR;
          when {FIFOTYPE}: aFileType := FILE_FIFO;
          when {CONTTYPE}: aFileType := FILE_UNKNOWN;
          otherwise:       aFileType := FILE_UNKNOWN;
        end case;
      end if;
    end if;
  end func;


(**
 *  Determine the file mode (permissions) of a file in a TAR 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 TAR archive, or
 *             the chain of symbolic links is too long.
 *)
const func fileMode: getFileMode (inout tarArchive: tar, in string: filePath) is func
  result
    var fileMode: mode is fileMode.value;
  begin
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    else
      mode := fileMode(followSymlink(tar, filePath).mode mod 8#1000);
    end if;
  end func;


(**
 *  Change the file mode (permissions) of a file in a TAR 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 TAR archive, or
 *             the chain of symbolic links is too long.
 *)
const proc: setFileMode (inout tarArchive: tar, in string: filePath,
    in fileMode: mode) is func
  local
    var tarHeader: header is tarHeader.value;
  begin
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    else
      header := followSymlink(tar, filePath);
      if header.filePath in tar.register then
        header.mode := (header.mode >> 9 << 9) + integer(mode);
        tar.catalog @:= [header.filePath] header;
        seek(tar.tarFile, tar.register[header.filePath]);
        writeHead(tar.tarFile, tar.catalog[header.filePath]);
      else
        raise FILE_ERROR;
      end if;
    end if;
  end func;


(**
 *  Determine the size of a file in a TAR 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 TAR archive, or
 *             the chain of symbolic links is too long.
 *)
const func integer: fileSize (inout tarArchive: tar, in string: filePath) is func
  result
    var integer: size is 0;
  local
    var tarHeader: header is tarHeader.value;
  begin
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    else
      size := followSymlink(tar, filePath).fileSize;
    end if;
  end func;


(**
 *  Determine the modification time of a file in a TAR 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 TAR archive, or
 *             the chain of symbolic links is too long.
 *)
const func time: getMTime (inout tarArchive: tar, in string: filePath) is func
  result
    var time: modificationTime is time.value;
  begin
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    else
      modificationTime := timestamp1970ToTime(
          followSymlink(tar, filePath).mtime);
    end if;
  end func;


(**
 *  Set the modification time of a file in a TAR archive.
 *  The function follows symbolic links.
 *  @exception RANGE_ERROR ''filePath'' does not use the standard path
 *             representation.
 *  @exception RANGE_ERROR ''modificationTime'' is invalid or cannot be
 *             converted to the system file time.
 *  @exception FILE_ERROR ''filePath'' is not present in the TAR archive, or
 *             the chain of symbolic links is too long.
 *)
const proc: setMTime (inout tarArchive: tar, in string: filePath,
    in time: modificationTime) is func
  local
    var integer: mtime is 0;
    var tarHeader: header is tarHeader.value;
  begin
    mtime := timestamp1970(modificationTime);
    if mtime < 0 or mtime >= 2 ** 31 or
        (filePath <> "/" and endsWith(filePath, "/")) then
      raise RANGE_ERROR;
    else
      header := followSymlink(tar, filePath);
      if header.filePath in tar.register then
        header.mtime := mtime;
        tar.catalog @:= [header.filePath] header;
        seek(tar.tarFile, tar.register[header.filePath]);
        writeHead(tar.tarFile, tar.catalog[header.filePath]);
      else
        raise FILE_ERROR;
      end if;
    end if;
  end func;


(**
 *  Determine the name of the owner (UID) of a file in a TAR 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 TAR archive, or
 *             the chain of symbolic links is too long.
 *)
const func string: getOwner (inout tarArchive: tar, in string: filePath) is func
  result
    var string: owner is "";
  local
    var tarHeader: header is tarHeader.value;
  begin
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    else
      header := followSymlink(tar, filePath);
      if header.uname <> "" then
        owner := header.uname;
      else
        owner := str(header.uid);
      end if;
    end if;
  end func;


(**
 *  Set the owner of a file in a TAR 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 TAR archive, or
 *             the chain of symbolic links is too long.
 *)
const proc: setOwner (inout tarArchive: tar, in string: filePath,
    in string: owner) is func
  local
    var tarHeader: header is tarHeader.value;
  begin
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    else
      header := followSymlink(tar, filePath);
      if header.filePath in tar.register then
        if isDigitString(owner) then
          header.uid := integer(owner);
          header.uname := "";
        else
          header.uid := 0;
          header.uname := owner;
        end if;
        tar.catalog @:= [header.filePath] header;
        seek(tar.tarFile, tar.register[header.filePath]);
        writeHead(tar.tarFile, tar.catalog[header.filePath]);
      else
        raise FILE_ERROR;
      end if;
    end if;
  end func;


(**
 *  Determine the name of the group (GID) of a file in a TAR 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 TAR archive, or
 *             the chain of symbolic links is too long.
 *)
const func string: getGroup (inout tarArchive: tar, in string: filePath) is func
  result
    var string: group is "";
  local
    var tarHeader: header is tarHeader.value;
  begin
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    else
      header := followSymlink(tar, filePath);
      if header.gname <> "" then
        group := header.gname;
      else
        group := str(header.gid);
      end if;
    end if;
  end func;


(**
 *  Set the group of a file in a TAR 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 TAR archive, or
 *             the chain of symbolic links is too long.
 *)
const proc: setGroup (inout tarArchive: tar, in string: filePath,
    in string: group) is func
  local
    var tarHeader: header is tarHeader.value;
  begin
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    else
      header := followSymlink(tar, filePath);
      if header.filePath in tar.register then
        if isDigitString(group) then
          header.gid := integer(group);
          header.gname := "";
        else
          header.gid := 0;
          header.gname := group;
        end if;
        tar.catalog @:= [header.filePath] header;
        seek(tar.tarFile, tar.register[header.filePath]);
        writeHead(tar.tarFile, tar.catalog[header.filePath]);
      else
        raise FILE_ERROR;
      end if;
    end if;
  end func;


(**
 *  Determine the file mode (permissions) of a symbolic link in a TAR 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 TAR archive, or it is not a symbolic link.
 *)
const func fileMode: getFileMode (inout tarArchive: tar, in string: filePath, SYMLINK) is func
  result
    var fileMode: mode is fileMode.value;
  local
    var tarHeader: header is tarHeader.value;
  begin
    # writeln("getFileMode: " <& filePath);
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    elsif filePath = "" then
      raise FILE_ERROR;
    else
      if filePath in tar.catalog then
        header := tar.catalog[filePath];
      elsif filePath in tar.register then
        header := addToCatalog(tar, filePath);
      else
        raise FILE_ERROR;
      end if;
      if header.typeflag = SYMTYPE then
        mode := fileMode(header.mode mod 8#1000);
      else
        raise FILE_ERROR;
      end if;
    end if;
  end func;


(**
 *  Determine the modification time of a symbolic link in a TAR 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 TAR archive, or it is not a symbolic link.
 *)
const func time: getMTime (inout tarArchive: tar, in string: filePath, SYMLINK) is func
  result
    var time: modificationTime is time.value;
  local
    var tarHeader: header is tarHeader.value;
  begin
    # writeln("getMTime: " <& filePath);
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    elsif filePath = "" then
      raise FILE_ERROR;
    else
      if filePath in tar.catalog then
        header := tar.catalog[filePath];
      elsif filePath in tar.register then
        header := addToCatalog(tar, filePath);
      else
        raise FILE_ERROR;
      end if;
      if header.typeflag = SYMTYPE then
        modificationTime := timestamp1970ToTime(header.mtime);
      else
        raise FILE_ERROR;
      end if;
    end if;
  end func;


(**
 *  Set the modification time of a symbolic link in a TAR 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 TAR archive, or it is not a symbolic link.
 *)
const proc: setMTime (inout tarArchive: tar, in string: filePath,
    in time: modificationTime, SYMLINK) is func
  local
    var integer: mtime is 0;
    var tarHeader: header is tarHeader.value;
  begin
    mtime := timestamp1970(modificationTime);
    if mtime < 0 or mtime >= 2 ** 31 or
        (filePath <> "/" and endsWith(filePath, "/")) then
      raise RANGE_ERROR;
    elsif filePath = "" then
      raise FILE_ERROR;
    else
      if filePath in tar.catalog then
        header := tar.catalog[filePath];
      elsif filePath in tar.register then
        header := addToCatalog(tar, filePath);
      else
        raise FILE_ERROR;
      end if;
      if header.typeflag = SYMTYPE then
        header.mtime := mtime;
        tar.catalog @:= [header.filePath] header;
        seek(tar.tarFile, tar.register[header.filePath]);
        writeHead(tar.tarFile, tar.catalog[header.filePath]);
      else
        raise FILE_ERROR;
      end if;
    end if;
  end func;


(**
 *  Determine the name of the owner (UID) of a symbolic link in a TAR 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 TAR archive, or it is not a symbolic link.
 *)
const func string: getOwner (inout tarArchive: tar, in string: filePath, SYMLINK) is func
  result
    var string: owner is "";
  local
    var tarHeader: header is tarHeader.value;
  begin
    # writeln("getOwner: " <& filePath);
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    elsif filePath = "" then
      raise FILE_ERROR;
    else
      if filePath in tar.catalog then
        header := tar.catalog[filePath];
      elsif filePath in tar.register then
        header := addToCatalog(tar, filePath);
      else
        raise FILE_ERROR;
      end if;
      if header.typeflag = SYMTYPE then
        if header.uname <> "" then
          owner := header.uname;
        else
          owner := str(header.uid);
        end if;
      else
        raise FILE_ERROR;
      end if;
    end if;
  end func;


(**
 *  Set the owner of a symbolic link in a TAR 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 FILE_ERROR The file described with ''filePath'' is not
 *             present in the TAR archive, or it is not a symbolic link.
 *)
const proc: setOwner (inout tarArchive: tar, in string: filePath,
    in string: owner, SYMLINK) is func
  local
    var tarHeader: header is tarHeader.value;
  begin
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    elsif filePath = "" then
      raise FILE_ERROR;
    else
      if filePath in tar.catalog then
        header := tar.catalog[filePath];
      elsif filePath in tar.register then
        header := addToCatalog(tar, filePath);
      else
        raise FILE_ERROR;
      end if;
      if header.typeflag = SYMTYPE then
        if isDigitString(owner) then
          header.uid := integer(owner);
          header.uname := "";
        else
          header.uid := 0;
          header.uname := owner;
        end if;
        tar.catalog @:= [header.filePath] header;
        seek(tar.tarFile, tar.register[header.filePath]);
        writeHead(tar.tarFile, tar.catalog[header.filePath]);
      else
        raise FILE_ERROR;
      end if;
    end if;
  end func;


(**
 *  Determine the name of the group (GID) of a symbolic link in a TAR 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 TAR archive, or it is not a symbolic link.
 *)
const func string: getGroup (inout tarArchive: tar, in string: filePath, SYMLINK) is func
  result
    var string: group is "";
  local
    var tarHeader: header is tarHeader.value;
  begin
    # writeln("getGroup: " <& filePath);
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    elsif filePath = "" then
      raise FILE_ERROR;
    else
      if filePath in tar.catalog then
        header := tar.catalog[filePath];
      elsif filePath in tar.register then
        header := addToCatalog(tar, filePath);
      else
        raise FILE_ERROR;
      end if;
      if header.typeflag = SYMTYPE then
        if header.gname <> "" then
          group := header.gname;
        else
          group := str(header.gid);
        end if;
      else
        raise FILE_ERROR;
      end if;
    end if;
  end func;


(**
 *  Set the group of a symbolic link in a TAR 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 FILE_ERROR The file described with ''filePath'' is not
 *             present in the TAR archive, or it is not a symbolic link.
 *)
const proc: setGroup (inout tarArchive: tar, in string: filePath,
    in string: group, SYMLINK) is func
  local
    var tarHeader: header is tarHeader.value;
  begin
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    elsif filePath = "" then
      raise FILE_ERROR;
    else
      if filePath in tar.catalog then
        header := tar.catalog[filePath];
      elsif filePath in tar.register then
        header := addToCatalog(tar, filePath);
      else
        raise FILE_ERROR;
      end if;
      if header.typeflag = SYMTYPE then
        if isDigitString(group) then
          header.gid := integer(group);
          header.gname := "";
        else
          header.gid := 0;
          header.gname := group;
        end if;
        tar.catalog @:= [header.filePath] header;
        seek(tar.tarFile, tar.register[header.filePath]);
        writeHead(tar.tarFile, tar.catalog[header.filePath]);
      else
        raise FILE_ERROR;
      end if;
    end if;
  end func;


(**
 *  Reads the destination of a symbolic link in a TAR 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 TAR archive,
 *             or is not a symbolic link.
 *)
const func string: readLink (inout tarArchive: tar, in string: filePath) is func
  result
    var string: linkPath is "";
  local
    var tarHeader: header is tarHeader.value;
  begin
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    elsif filePath in tar.catalog then
      header := tar.catalog[filePath];
    elsif filePath in tar.register then
      header := addToCatalog(tar, filePath);
    else
      raise FILE_ERROR;
    end if;
    if header.typeflag = SYMTYPE then
      linkPath := header.linkPath;
    else
      raise FILE_ERROR;
    end if;
  end func;


(**
 *  Create a symbolic link in a TAR archive.
 *  The symbolic link ''symlinkPath'' will refer to ''targetPath'' afterwards.
 *  The function does not follow symbolic links.
 *  @param tar Open TAR 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 tarArchive: tar, in string: symlinkPath,
    in string: targetPath) is func
  local
    var tarHeader: header is tarHeader.value;
    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 tar.catalog or
        symlinkPath in tar.register or implicitDir(tar.register, symlinkPath) then
      raise FILE_ERROR;
    else
      header.name     := symlinkPath[.. 100];
      header.mode     := 8#777;
      header.uid      := 0;
      header.gid      := 0;
      header.fileSize := 0;
      header.mtime    := timestamp1970(time(NOW));
      header.typeflag := SYMTYPE;
      header.magic    := TAR_MAGIC;
      header.version  := "  ";
      header.filePath := symlinkPath;
      header.linkPath := targetPath;
      if seekable(tar.tarFile) and tar.endOfFileMarkerPos <> 0 then
        seek(tar.tarFile, tar.endOfFileMarkerPos);
      else
        length := length(tar.tarFile);
        if seekable(tar.tarFile) then
          seek(tar.tarFile, succ(length));
        end if;
        # Add zero bytes such that the next header starts at a multiple of the block size:
        write(tar.tarFile, "\0;" mult pred(TAR_BLOCK_SIZE) -
              pred(length) mod TAR_BLOCK_SIZE);
      end if;
      tar.register @:= [symlinkPath] tell(tar.tarFile);
      writeHead(tar.tarFile, header);
      header.dataStartPos := tell(tar.tarFile);
      tar.endOfFileMarkerPos := header.dataStartPos;
      write(tar.tarFile, END_OF_FILE_MARKER mult 2);
      tar.catalog @:= [symlinkPath] header;
      flush(tar.tarFile);
    end if;
  end func;


(*
const proc: moveSingleFile (inout tarArchive: tar, in string: sourcePath,
    in string: destPath) is func
  local
    var tarHeader: header is tarHeader.value;
    var integer: headerPos is 0;
  begin
    if sourcePath <> "/" and endsWith(sourcePath, "/") or
        destPath <> "/" and endsWith(destPath, "/") then
      raise RANGE_ERROR;
    elsif sourcePath <> destPath then
      if destPath in tar.register then
        raise FILE_ERROR;
      elsif sourcePath in tar.catalog then
        header := tar.catalog[sourcePath];
        header.filePath := destPath;
        excl(tar.catalog, sourcePath);
        tar.catalog @:= [destPath] header;
        headerPos := tar.register[sourcePath];
        excl(tar.register, sourcePath;
        tar.register @:= [destPath] headerPos;
        seek(tar.tarFile, headerPos);
        writeHead(tar.tarFile, header);
      elsif sourcePath in tar.register then
        header := addToCatalog(tar, sourcePath);
        header.mtime := mtime;
        tar.catalog @:= [sourcePath] header;
      else
        raise FILE_ERROR;
      end if;
      seek(tar.tarFile, tar.register[sourcePath]);
      writeHead(tar.tarFile, tar.catalog[sourcePath]);
    end if;
  end func;


(* *
 *  Move and rename a file or directory tree in a TAR archive.
 *  @exception RANGE_ERROR ''sourcePath'' or ''destPath'' does not use
 *             the standard path representation.
 *  @exception FILE_ERROR Source file does not exist or destination file
 *             already exists.
 *)
const proc: moveFile (inout tarArchive: tar, in string: sourcePath,
    in string: destPath) is func
  local
    var tarHeader: header is tarHeader.value;
    var integer: headerPos is 0;
  begin
    if sourcePath <> "/" and endsWith(sourcePath, "/") or
        destPath <> "/" and endsWith(destPath, "/") then
      raise RANGE_ERROR;
    elsif sourcePath <> destPath then
      if destPath in tar.register then
        raise FILE_ERROR;
      elsif sourcePath in tar.catalog then
        header := tar.catalog[sourcePath];
        header.filePath := destPath;
        excl(tar.catalog, sourcePath);
        tar.catalog @:= [destPath] header;
        headerPos := tar.register[sourcePath];
        excl(tar.register, sourcePath;
        tar.register @:= [destPath] headerPos;
        seek(tar.tarFile, headerPos);
        writeHead(tar.tarFile, header);
      elsif sourcePath in tar.register then
        header := addToCatalog(tar, sourcePath);
        header.mtime := mtime;
        tar.catalog @:= [sourcePath] header;
      else
        raise FILE_ERROR;
      end if;
      seek(tar.tarFile, tar.register[sourcePath]);
      writeHead(tar.tarFile, tar.catalog[sourcePath]);
    end if;
  end func;
*)


(**
 *  Get the contents of a file in a TAR 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 TAR archive,
 *             or is not a regular file, or
 *             the chain of symbolic links is too long.
 *)
const func string: getFile (inout tarArchive: tar, in string: filePath) is func
  result
    var string: content is "";
  local
    var tarHeader: header is tarHeader.value;
  begin
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    else
      header := followSymlink(tar, filePath);
      if header.typeflag = REGTYPE or header.typeflag = AREGTYPE then
        seek(tar.tarFile, header.dataStartPos);
        content := gets(tar.tarFile, header.fileSize);
      else
        raise FILE_ERROR;
      end if;
    end if;
  end func;


(**
 *  Write ''data'' to a TAR 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.
 *  @exception FILE_ERROR The file exists, but it is not a regular file.
 *)
const proc: putFile (inout tarArchive: tar, in var string: filePath,
    in string: data) is func
  local
    var tarHeader: header is tarHeader.value;
    var string: missingPath is "";
    var boolean: appendFile is TRUE;
    var integer: length is 0;
  begin
    if filePath = "" or filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    else
      missingPath := followSymlink(tar, filePath, header);
      if missingPath = "" then
        # The file does exist.
        filePath := header.filePath;
        if header.typeflag <> REGTYPE and header.typeflag <> AREGTYPE then
          raise FILE_ERROR;
        else
          if succ(pred(header.fileSize) mdiv TAR_BLOCK_SIZE) * TAR_BLOCK_SIZE =
              succ(pred(length(data)) mdiv TAR_BLOCK_SIZE) * TAR_BLOCK_SIZE then
            # The number of blocks used of the old file and the new file are identical.
            # The file data is rewritten in place.
            header.fileSize := length(data);
            tar.catalog @:= [filePath] header;
            seek(tar.tarFile, header.dataStartPos - TAR_BLOCK_SIZE);
            # Write just the main header. Extended headers are left unchanged.
            write(tar.tarFile, str(header));
            write(tar.tarFile, data);
            write(tar.tarFile, "\0;" mult pred(TAR_BLOCK_SIZE) -
                  pred(header.fileSize) mod TAR_BLOCK_SIZE);
            appendFile := FALSE;
          end if;
        end if;
      else
        filePath := missingPath;
      end if;
      if appendFile then
        if seekable(tar.tarFile) and tar.endOfFileMarkerPos <> 0 then
          seek(tar.tarFile, tar.endOfFileMarkerPos);
        else
          length := length(tar.tarFile);
          if seekable(tar.tarFile) then
            seek(tar.tarFile, succ(length));
          end if;
          # Add zero bytes such that the next header starts at a multiple of the block size:
          write(tar.tarFile, "\0;" mult pred(TAR_BLOCK_SIZE) -
                pred(length) mod TAR_BLOCK_SIZE);
        end if;
        tar.register @:= [filePath] tell(tar.tarFile);
        if missingPath <> "" then
          header.name     := filePath[.. 100];
          header.mode     := 8#664;
          header.uid      := 0;
          header.gid      := 0;
          header.mtime    := timestamp1970(time(NOW));
          header.typeflag := REGTYPE;
          header.magic    := TAR_MAGIC;
          header.version  := "  ";
          header.filePath := filePath;
        end if;
        header.fileSize := length(data);
        writeHead(tar.tarFile, header);
        header.dataStartPos := tell(tar.tarFile);
        tar.catalog @:= [filePath] header;
        write(tar.tarFile, data);
        write(tar.tarFile, "\0;" mult pred(TAR_BLOCK_SIZE) -
              pred(header.fileSize) mod TAR_BLOCK_SIZE);
        tar.endOfFileMarkerPos := tell(tar.tarFile);
        write(tar.tarFile, END_OF_FILE_MARKER mult 2);
        flush(tar.tarFile);
      end if;
    end if;
  end func;


(**
 *  Create a new directory in a TAR archive.
 *  The function does not follow symbolic links.
 *  @param tar Open TAR 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 tarArchive: tar, in string: dirPath) is func
  local
    var tarHeader: header is tarHeader.value;
    var boolean: fileExists is TRUE;
    var integer: dataStartPos is 0;
    var integer: length is 0;
  begin
    if dirPath = "" or dirPath <> "/" and endsWith(dirPath, "/") then
      raise RANGE_ERROR;
    elsif dirPath in tar.catalog then
      dataStartPos := tar.catalog[dirPath].dataStartPos;
    elsif dirPath in tar.register then
      dataStartPos := addToCatalog(tar, dirPath).dataStartPos;
    elsif implicitDir(tar.register, dirPath) then
      dataStartPos := addImplicitDir(tar, dirPath).dataStartPos;
    else
      fileExists := FALSE;
    end if;
    if fileExists and dataStartPos <> -1 then
      # The file exists and it is not an implicit directory.
      raise FILE_ERROR;
    else
      if seekable(tar.tarFile) and tar.endOfFileMarkerPos <> 0 then
        seek(tar.tarFile, tar.endOfFileMarkerPos);
      else
        length := length(tar.tarFile);
        if seekable(tar.tarFile) then
          seek(tar.tarFile, succ(length));
        end if;
        # Add zero bytes such that the next header starts at a multiple of the block size:
        write(tar.tarFile, "\0;" mult pred(TAR_BLOCK_SIZE) -
              pred(length) mod TAR_BLOCK_SIZE);
      end if;
      tar.register @:= [dirPath] tell(tar.tarFile);
      header.name     := (dirPath & "/") [.. 100];
      header.mode     := 8#775;
      header.uid      := 0;
      header.gid      := 0;
      header.fileSize := 0;
      header.mtime    := timestamp1970(time(NOW));
      header.typeflag := DIRTYPE;
      header.magic    := TAR_MAGIC;
      header.version  := "  ";
      header.filePath := dirPath;
      header.filePathSuffix := "/";
      writeHead(tar.tarFile, header);
      header.dataStartPos := tell(tar.tarFile);
      tar.endOfFileMarkerPos := header.dataStartPos;
      write(tar.tarFile, END_OF_FILE_MARKER mult 2);
      tar.catalog @:= [dirPath] header;
      flush(tar.tarFile);
    end if;
  end func;


(**
 *  Remove any file except non-empty directories from a TAR archive.
 *  The function does not follow symbolic links. An attempt to remove a
 *  directory that is not empty triggers FILE_ERROR.
 *  @param tar Open TAR 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 tarArchive: tar, in string: filePath) is func
  local
    var tarHeader: header is tarHeader.value;
    var boolean: fileExists is TRUE;
    var integer: posOfHeaderToBeRemoved is 0;
    var integer: numCharsToBeRemoved is 0;
  begin
    # writeln("removeFile(" <& literal(filePath) <& ")");
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    elsif filePath in tar.catalog then
      header := tar.catalog[filePath];
    elsif filePath in tar.register then
      header := addToCatalog(tar, filePath);
    elsif implicitDir(tar.register, filePath) then
      header := addImplicitDir(tar, filePath);
    else
      fileExists := FALSE;
    end if;
    if fileExists and
        (header.typeflag in {REGTYPE, AREGTYPE, SYMTYPE, CHRTYPE, BLKTYPE,
                            FIFOTYPE, CONTTYPE} or
         (header.typeflag = DIRTYPE and isEmptyDir(tar.register, filePath))) then
      posOfHeaderToBeRemoved := tar.register[filePath];
      numCharsToBeRemoved := header.dataStartPos - posOfHeaderToBeRemoved +
          succ(pred(header.fileSize) mdiv TAR_BLOCK_SIZE) * TAR_BLOCK_SIZE;
      # writeln("numCharsToBeRemoved: " <& numCharsToBeRemoved);
      deleteArea(tar.tarFile, posOfHeaderToBeRemoved, numCharsToBeRemoved);
      excl(tar.register, filePath);
      excl(tar.catalog, filePath);
      fixRegisterAndCatalog(tar, posOfHeaderToBeRemoved + numCharsToBeRemoved,
                            -numCharsToBeRemoved);
      flush(tar.tarFile);
    else
      raise FILE_ERROR;
    end if;
  end func;


(**
 *  For-loop which loops recursively over the paths in a TAR archive.
 *)
const proc: for (inout string: filePath) range (inout tarArchive: tar) do
              (in proc: statements)
            end for is func
  begin
    for key filePath range tar.register do
      statements;
    end for;
  end func;


const func file: openFileInTar (inout tarArchive: tar, in string: filePath,
    in string: mode) is func
  result
    var file: newFile is STD_NULL;
  local
    var tarHeader: header is tarHeader.value;
    var string: missingPath is "";
  begin
    if mode = "r" then
      if filePath <> "/" and endsWith(filePath, "/") then
        raise RANGE_ERROR;
      else
        missingPath := followSymlink(tar, filePath, header);
        if missingPath = "" and (header.typeflag = REGTYPE or
                                 header.typeflag = AREGTYPE) then
          newFile := openSubFile(tar.tarFile, header.dataStartPos,
                                 header.fileSize);
        end if;
      end if;
    end if;
  end func;


(**
 *  Open a file with ''filePath'' and ''mode'' in in a TAR archive.
 *)
const func file: open (inout tarArchive: tar, in string: filePath,
    in string: mode) is
  return openBufferFile(openFileInTar(tar, filePath, mode));