
(********************************************************************)
(*                                                                  *)
(*  tar.s7i       Tar archive library                               *)
(*  Copyright (C) 1994, 2004, 2005, 2010, 2014  Thomas Mertes       *)
(*  Copyright (C) 2016 - 2019  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";


const string: TMAGIC is "ustar";
const string: NOMAGIC is "";

const integer: TAR_BLOCK_SIZE is 512;

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 type: tarHeader is new struct
    var string: name is "";
    var fileMode: mode is fileMode.value;
    var integer: uid is 0;
    var integer: gid is 0;
    var integer: size 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: 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);
    writeln(outFile, "uid: " <& header.uid);
    writeln(outFile, "gid: " <& header.gid);
    writeln(outFile, "size: " <& header.size);
    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, "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 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 len 100]);
    header.mode := fileMode conv getoct(stri[101 len   8]);
    header.uid :=                getoct(stri[109 len   8]);
    header.gid :=                getoct(stri[117 len   8]);
    header.size :=               getoct(stri[125 len  12]);
    header.mtime :=              getoct(stri[137 len  12]);
    header.chksum :=             getoct(stri[149 len   8]);
    header.typeflag :=                  stri[157];  (* 1*)
    header.linkname :=            gets0(stri[158 len 100]);
    header.magic :=            gets0spc(stri[258 len   6]);
    header.version :=                   stri[264 len   2];
    header.uname :=               gets0(stri[266 len  32]);
    header.gname :=               gets0(stri[298 len  32]);
    header.devmajor :=           getoct(stri[330 len   8]);
    header.devminor :=           getoct(stri[338 len   8]);
    header.prefix :=              gets0(stri[346 len 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
      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);
  end func;


const proc: readHead (inout file: inFile, inout tarHeader: header) is func
  local
    var string: filePath8 is "";
    var string: linkPath8 is "";
  begin
    header := readHeadBlock(inFile);
    # showHeader(STD_OUT, header);
    while header.name = "././@LongLink" and header.magic = TMAGIC and
        (header.typeflag = LONGNAMETYPE or header.typeflag = LONGLINKTYPE) do
      if header.typeflag = LONGNAMETYPE then
        filePath8 := gets(inFile, header.size);
      else  # header.typeflag = LONGLINKTYPE
        linkPath8 := gets(inFile, header.size);
      end if;
      seek(inFile, tell(inFile) + pred(TAR_BLOCK_SIZE) - pred(header.size) mod TAR_BLOCK_SIZE);
      # seek(inFile, succ(succ((tell(inFile) - 2) mdiv TAR_BLOCK_SIZE) * 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 := utf8ToStri(filePath8);
    exception
      catch RANGE_ERROR:
        header.filePath := filePath8;
    end block;
    if linkPath8 = "" then
      linkPath8 := header.linkname;
    end if;
    block
      header.linkPath := utf8ToStri(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
      header.name :=         gets0(stri[  1 len 100]);
      header.size :=        getoct(stri[125 len  12]);
      header.typeflag :=           stri[157];  (* 1*)
      header.magic :=     gets0spc(stri[258 len   6]);
      header.prefix :=       gets0(stri[346 len 155]);
      # writeln("header.name: " <& header.name);
      # showHeader(STD_OUT, header);
    end if;
  end func;


const proc: readMinimumOfHead (inout file: inFile, inout tarHeader: header) is func
  local
    var string: filePath8 is "";
  begin
    header := readMinimumOfHeadBlock(inFile);
    # showHeader(STD_OUT, header);
    while header.name = "././@LongLink" and header.magic = TMAGIC and
        (header.typeflag = LONGNAMETYPE or header.typeflag = LONGLINKTYPE) do
      if header.typeflag = LONGNAMETYPE then
        filePath8 := gets(inFile, header.size);
        seek(inFile, tell(inFile) + pred(TAR_BLOCK_SIZE) - pred(header.size) mod TAR_BLOCK_SIZE);
        # seek(inFile, succ(succ((tell(inFile) - 2) mdiv TAR_BLOCK_SIZE) * TAR_BLOCK_SIZE));
      else  # header.typeflag = LONGLINKTYPE
        seek(inFile, succ(succ((tell(inFile) + header.size - 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 := utf8ToStri(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, integer conv (header.mode),  8);
    putoct (stri, header.uid,                  8);
    putoct (stri, header.gid,                  8);
    putoct (stri, header.size,                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 tarHeader: longNameHead is tarHeader.value;
    var integer: startPos is 0;
    var integer: slashPos is 0;
  begin
    filePath8 := striToUtf8(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     := fileMode.value;
          longNameHead.uid      := 0;
          longNameHead.gid      := 0;
          longNameHead.size     := length(filePath8) + length(header.filePathSuffix);
          longNameHead.mtime    := 0;
          longNameHead.typeflag := LONGNAMETYPE;
          longNameHead.linkname := "";
          longNameHead.magic    := TMAGIC;
          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.size) mod TAR_BLOCK_SIZE);
          header.name := (filePath8 & header.filePathSuffix)[.. 100];
        end if;
      else
        header.name := filePath8 & header.filePathSuffix;
      end if;
    end if;
    write(outFile, str(header));
  end func;


const type: tarRegisterType is hash [string] integer;
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(aTarFile, "src/drivers")   # Relative path in the archive.
 *    fileType(aTarFile, "/usr/include")  # Absolute path in the archive.
 *    fileSize(aTarFile, "/image")        # Absolute path in the archive.
 *    readDir(aTarFile, "")               # Return e.g.: "src" and "/"
 *    readDir(aTarFile, "/")              # Return e.g.: "usr" and "image"
 *)
const type: tarArchive is sub emptyFileSys struct
    var file: tarFile is STD_NULL;
    var tarRegisterType: register is tarRegisterType.value;
    var tarCatalogType: catalog is tarCatalogType.value;
  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.
 *)
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 header.chksumOkay and header.filePath <> "" and
          (header.magic = TMAGIC or header.magic = NOMAGIC) then
        tar.tarFile := tarFile;
        repeat
          # writeln(header.filePath <& " " <& headPos);
          tar.register @:= [header.filePath] headPos;
          if header.size = 0 then
            headPos := tell(tarFile);
          else
            headPos := tell(tarFile) +
                succ(pred(header.size) mdiv TAR_BLOCK_SIZE) * TAR_BLOCK_SIZE;
            seek(tarFile, headPos);
          end if;
          readMinimumOfHead(tarFile, header);
        until header.filePath = "" or
              (header.magic <> TMAGIC and header.magic <> NOMAGIC);
        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.
 *)
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.
 *)
const proc: close (inout tarArchive: tar) is func
  begin
    close(tar.tarFile);
    tar.tarFile := STD_NULL;
  end func;


const func tarHeader: addToCatalog (inout tarArchive: tar, in string: filePath) is func
  result
    var tarHeader: header is tarHeader.value;
  local
    var string: linkPath is "";
  begin
    linkPath := filePath;
    repeat
      seek(tar.tarFile, tar.register[linkPath]);
      readHead(tar.tarFile, header);
      if header.typeflag = LNKTYPE then
        linkPath := header.linkPath;
        if linkPath not in tar.register then
          raise FILE_ERROR;
        end if;
      end if;
    until header.typeflag <> LNKTYPE;
    tar.catalog @:= [filePath] header;
  end func;


const func boolean: implizitDir (inout tarArchive: tar, in string: dirPath) is func
  result
    var boolean: implizitDir is FALSE;
  local
    var string: filePath is "";
  begin
    if dirPath <> "" then
      for key filePath range tar.register do
        if startsWith(filePath, dirPath) and
            length(filePath) > length(dirPath) and
            (filePath[succ(length(dirPath))] = '/' or dirPath = "/") then
          implizitDir := TRUE;
        end if;
      end for;
    end if;
  end func;


const func tarHeader: addImplizitDir (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;


(**
 *  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 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 tar.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 tar.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 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 does follow symbolic links. When the chain of
 *  symbolic links is too long the function returns ''FILE_SYMLINK''.
 *  When 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 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 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 tar.catalog then
          header := tar.catalog[filePath];
        elsif filePath in tar.register then
          header := addToCatalog(tar, filePath);
        elsif implizitDir(tar, filePath) then
          header := addImplizitDir(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}:  filePath := header.linkPath;
            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 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 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 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 implizitDir(tar, filePath) then
        typeflag := addImplizitDir(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:
            raise RANGE_ERROR;
        end case;
      end if;
    end if;
  end func;


(**
 *  Determine the file mode (permissions) of a file in a TAR 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 TAR archive.
 *)
const func fileMode: fileMode (inout tarArchive: tar, in string: filePath) is func
  result
    var fileMode: mode is fileMode.value;
  local
    var tarHeader: header is tarHeader.value;
  begin
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    elsif filePath in tar.catalog then
      mode := tar.catalog[filePath].mode;
    elsif filePath in tar.register then
      mode := addToCatalog(tar, filePath).mode;
    elsif implizitDir(tar, filePath) then
      mode := addImplizitDir(tar, filePath).mode;
    else
      raise FILE_ERROR;
    end if;
  end func;


(**
 *  Change the file mode (permissions) of a file in a TAR archive.
 *  @exception RANGE_ERROR ''filePath'' does not use the standard path
 *             representation.
 *  @exception FILE_ERROR ''filePath'' is not present in the TAR archive.
 *)
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;
    elsif filePath in tar.catalog then
      tar.catalog[filePath].mode := mode;
    elsif filePath in tar.register then
      header := addToCatalog(tar, filePath);
      header.mode := mode;
      tar.catalog @:= [filePath] header;
    else
      raise FILE_ERROR;
    end if;
    seek(tar.tarFile, tar.register[filePath]);
    writeHead(tar.tarFile, tar.catalog[filePath]);
  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.
 *  @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.
 *)
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;
    elsif filePath in tar.catalog then
      size := tar.catalog[filePath].size;
    elsif filePath in tar.register then
      size := addToCatalog(tar, filePath).size;
    elsif implizitDir(tar, filePath) then
      size := addImplizitDir(tar, filePath).size;
    else
      raise FILE_ERROR;
    end if;
  end func;


(**
 *  Determine the modification time of a file in a TAR 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 TAR archive.
 *)
const func time: getMTime (inout tarArchive: tar, in string: filePath) is func
  result
    var time: modificationTime is time.value;
  local
    var tarHeader: header is tarHeader.value;
    var integer: mtime is 0;
  begin
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    elsif filePath in tar.catalog then
      mtime := tar.catalog[filePath].mtime;
    elsif filePath in tar.register then
      mtime := addToCatalog(tar, filePath).mtime;
    elsif implizitDir(tar, filePath) then
      mtime := addImplizitDir(tar, filePath).mtime;
    else
      raise FILE_ERROR;
    end if;
    modificationTime := timestamp1970ToTime(mtime);
  end func;


(**
 *  Set the modification time of a file in a TAR 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 TAR archive.
 *)
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 then
      raise RANGE_ERROR;
    end if;
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    elsif filePath in tar.catalog then
      tar.catalog[filePath].mtime := mtime;
    elsif filePath in tar.register then
      header := addToCatalog(tar, filePath);
      header.mtime := mtime;
      tar.catalog @:= [filePath] header;
    else
      raise FILE_ERROR;
    end if;
    seek(tar.tarFile, tar.register[filePath]);
    writeHead(tar.tarFile, tar.catalog[filePath]);
  end func;


(**
 *  Reads the destination of a symbolic link in a TAR archive.
 *  @return The destination refered 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);
    elsif implizitDir(tar, filePath) then
      header := addImplizitDir(tar, filePath);
    else
      raise FILE_ERROR;
    end if;
    # showHeader(STD_OUT, header);
    linkPath := header.linkPath;
  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.
 *  @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.
 *)
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;
    elsif filePath in tar.catalog then
      header := tar.catalog[filePath];
      if header.typeflag = REGTYPE or header.typeflag = AREGTYPE then
        seek(tar.tarFile, header.dataStartPos);
      end if;
    elsif filePath in tar.register then
      header := addToCatalog(tar, filePath);
    elsif implizitDir(tar, filePath) then
      header := addImplizitDir(tar, filePath);
    else
      raise FILE_ERROR;
    end if;
    if header.typeflag = REGTYPE or header.typeflag = AREGTYPE then
      content := gets(tar.tarFile, header.size);
    else
      raise FILE_ERROR;
    end if;
  end func;


(**
 *  Write ''data'' to a TAR 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 tarArchive: tar, in string: filePath,
    in string: data) is func
  local
    var tarHeader: header is tarHeader.value;
    var boolean: fileExists is TRUE;
    var boolean: appendFile is TRUE;
    var integer: length is 0;
  begin
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    elsif filePath in tar.catalog then
      header := tar.catalog[filePath];
    elsif filePath in tar.register then
      header := addToCatalog(tar, filePath);
    elsif implizitDir(tar, filePath) then
      header := addImplizitDir(tar, filePath);
    else
      fileExists := FALSE;
    end if;
    if fileExists then
      if header.typeflag <> REGTYPE and header.typeflag <> AREGTYPE then
        raise FILE_ERROR;
      end if;
      if succ(pred(header.size) 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.size := length(data);
        tar.catalog @:= [filePath] header;
        seek(tar.tarFile, tar.register[filePath]);
        writeHead(tar.tarFile, header);
        write(tar.tarFile, data);
        write(tar.tarFile, "\0;" mult pred(TAR_BLOCK_SIZE) - pred(header.size) mod TAR_BLOCK_SIZE);
        appendFile := FALSE;
      end if;
    end if;
    if appendFile then
      length := length(tar.tarFile);
      seek(tar.tarFile, succ(length));
      # 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);
      tar.register @:= [filePath] tell(tar.tarFile);
      if not fileExists then
        header.name     := filePath[.. 100];
        header.mode     := fileMode conv 8#664;
        header.uid      := 100;
        header.gid      := 100;
        header.typeflag := REGTYPE;
        header.magic    := TMAGIC;
        header.version  := "  ";
        header.filePath := filePath;
      end if;
      header.size := 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.size) mod TAR_BLOCK_SIZE);
      flush(tar.tarFile);
    end if;
  end func;


(**
 *  Creates a new directory in a TAR archive.
 *  @exception RANGE_ERROR ''dirPath'' does not use the standard path
 *             representation.
 *  @exception FILE_ERROR A system function returns an error.
 *)
const proc: mkdir (inout tarArchive: tar, in string: filePath) 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 filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    elsif filePath in tar.catalog then
      dataStartPos := tar.catalog[filePath].dataStartPos;
    elsif filePath in tar.register then
      dataStartPos := addToCatalog(tar, filePath).dataStartPos;
    elsif implizitDir(tar, filePath) then
      dataStartPos := addImplizitDir(tar, filePath).dataStartPos;
    else
      fileExists := FALSE;
    end if;
    if fileExists and dataStartPos <> -1 then
      raise FILE_ERROR;
    else
      length := length(tar.tarFile);
      seek(tar.tarFile, succ(length));
      # 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);
      tar.register @:= [filePath] tell(tar.tarFile);
      if not fileExists then
        header.name     := (filePath & "/") [.. 100];
        header.mode     := fileMode conv 8#775;
        header.uid      := 100;
        header.gid      := 100;
        header.typeflag := DIRTYPE;
        header.magic    := TMAGIC;
        header.version  := "  ";
        header.filePath := filePath;
        header.filePathSuffix := "/";
      end if;
      header.size := 0;
      writeHead(tar.tarFile, header);
      header.dataStartPos := tell(tar.tarFile);
      tar.catalog @:= [filePath] header;
    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;
