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


include "stdio.s7i";
include "time.s7i";
include "filesys.s7i";
include "filebits.s7i";
include "unicode.s7i";
include "bytedata.s7i";
include "bin32.s7i";
include "subfile.s7i";
include "iobuffer.s7i";


const string: CPIO_BINARY_MAGIC          is "\16#71;\16#c7;";  # = 8#70707
const string: CPIO_SWAPPED_BINARY_MAGIC  is "\16#c7;\16#71;";
const string: CPIO_OLD_ASCII_MAGIC       is "070707";
const string: CPIO_NEW_ASCII_MAGIC       is "070701";
const string: CPIO_NEW_ASCII_CRC_MAGIC   is "070702";

const string: CPIO_TRAILER_NAME is "TRAILER!!!";


const type: cpioHeader is new struct
    var string: magic is "";
    var integer: ino is 0;
    var integer: mode is 0;
    var integer: uid is 0;
    var integer: gid is 0;
    var integer: nlink is 0;
    var integer: mtime is 0;
    var integer: fileSize is 0;
    var integer: devmajor is 0;
    var integer: devminor is 0;
    var integer: rdevmajor is 0;
    var integer: rdevminor is 0;
    var integer: nameSize is 0;
    var integer: check is 0;
    var integer: headerSize is 0;
    var string: filePath is "";
    var integer: padding is 0;
    var integer: dataStartPos is 0;
  end struct;


const func integer: computeCheck (in string: data) is func
  result
    var integer: check is 0;
  local
    var char: ch is ' ';
  begin
    for ch range data do
      check := (check + ord(ch)) mod 16#100000000;
    end for;
  end func;


const proc: showHeader (inout file: outFile, in cpioHeader: header) is func
  begin
    writeln(outFile, "magic: " <& literal(header.magic));
    writeln(outFile, "ino: " <& header.ino);
    writeln(outFile, "mode: " <& header.mode);
    writeln(outFile, "uid: " <& header.uid);
    writeln(outFile, "gid: " <& header.gid);
    writeln(outFile, "nlink: " <& header.nlink);
    writeln(outFile, "mtime: " <& header.mtime);
    writeln(outFile, "fileSize: " <& header.fileSize);
    writeln(outFile, "devmajor: " <& header.devmajor);
    writeln(outFile, "devminor: " <& header.devminor);
    writeln(outFile, "rdevmajor: " <& header.rdevmajor);
    writeln(outFile, "rdevminor: " <& header.rdevminor);
    writeln(outFile, "nameSize: " <& header.nameSize);
    writeln(outFile, "check: " <& header.check);
    writeln(outFile, "headerSize: " <& header.headerSize);
    writeln(outFile, "filePath: " <& header.filePath);
    writeln(outFile, "padding: " <& header.padding);
    writeln(outFile, "dataStartPos: " <& header.dataStartPos);
  end func;


const proc: readHead (inout file: inFile, inout cpioHeader: header) is func
  local
    var string: headerStri is "";
    var integer: device is 0;
    var string: filePath8 is "";
    var integer: remPadding is 0;
  begin
    header.magic := gets(inFile, 2);
    if header.magic = CPIO_BINARY_MAGIC then
      # writeln("CPIO_BINARY_MAGIC");
      headerStri := gets(inFile, 24);
      header.devmajor   := ord(headerStri[1]);
      header.devminor   := ord(headerStri[2]);
      header.ino        := bytes2Int(headerStri[ 3 len 2], UNSIGNED, BE);
      header.mode       := bytes2Int(headerStri[ 5 len 2], UNSIGNED, BE);
      header.uid        := bytes2Int(headerStri[ 7 len 2], UNSIGNED, BE);
      header.gid        := bytes2Int(headerStri[ 9 len 2], UNSIGNED, BE);
      header.nlink      := bytes2Int(headerStri[11 len 2], UNSIGNED, BE);
      header.rdevmajor  := ord(headerStri[13]);
      header.rdevminor  := ord(headerStri[14]);
      header.mtime      := bytes2Int(headerStri[15 len 4], UNSIGNED, BE);
      header.nameSize   := bytes2Int(headerStri[19 len 2], UNSIGNED, BE);
      header.fileSize   := bytes2Int(headerStri[21 len 4], UNSIGNED, BE);
      header.headerSize := 26;
      filePath8         := gets(inFile, pred(header.nameSize));
      header.padding    := 2;
    elsif header.magic = CPIO_SWAPPED_BINARY_MAGIC then
      # writeln("CPIO_SWAPPED_BINARY_MAGIC");
      headerStri := gets(inFile, 24);
      header.devminor   := ord(headerStri[1]);
      header.devmajor   := ord(headerStri[2]);
      header.ino        := bytes2Int(headerStri[ 3 len 2], UNSIGNED, LE);
      header.mode       := bytes2Int(headerStri[ 5 len 2], UNSIGNED, LE);
      header.uid        := bytes2Int(headerStri[ 7 len 2], UNSIGNED, LE);
      header.gid        := bytes2Int(headerStri[ 9 len 2], UNSIGNED, LE);
      header.nlink      := bytes2Int(headerStri[11 len 2], UNSIGNED, LE);
      header.rdevminor  := ord(headerStri[13]);
      header.rdevmajor  := ord(headerStri[14]);
      header.mtime      := bytes2Int(headerStri[15 len 2], UNSIGNED, LE) * 65536 +
                           bytes2Int(headerStri[17 len 2], UNSIGNED, LE);
      header.nameSize   := bytes2Int(headerStri[19 len 2], UNSIGNED, LE);
      header.fileSize   := bytes2Int(headerStri[21 len 2], UNSIGNED, LE) * 65536 +
                           bytes2Int(headerStri[23 len 2], UNSIGNED, LE);
      header.headerSize := 26;
      filePath8         := gets(inFile, pred(header.nameSize));
      header.padding    := 2;
    else
      header.magic &:= gets(inFile, 4);
      if header.magic = CPIO_OLD_ASCII_MAGIC then
        # writeln("CPIO_OLD_ASCII_MAGIC");
        headerStri := gets(inFile, 70);
        device            := integer(headerStri[ 1 len  6], 8);
        header.devmajor   := device >> 8;
        header.devminor   := device mod 256;
        header.ino        := integer(headerStri[ 7 len  6], 8);
        header.mode       := integer(headerStri[13 len  6], 8);
        header.uid        := integer(headerStri[19 len  6], 8);
        header.gid        := integer(headerStri[25 len  6], 8);
        header.nlink      := integer(headerStri[31 len  6], 8);
        device            := integer(headerStri[37 len  6], 8);
        header.rdevmajor  := device >> 8;
        header.rdevminor  := device mod 256;
        header.mtime      := integer(headerStri[43 len 11], 8);
        header.nameSize   := integer(headerStri[54 len  6], 8);
        header.fileSize   := integer(headerStri[60 len 11], 8);
        header.headerSize := 76;
        filePath8         := gets(inFile, pred(header.nameSize));
        header.padding    := 1;
      elsif header.magic = CPIO_NEW_ASCII_MAGIC or
            header.magic = CPIO_NEW_ASCII_CRC_MAGIC then
        # writeln("CPIO_NEW_ASCII_MAGIC");
        headerStri := gets(inFile, 104);
        header.ino        := integer(headerStri[ 1 len  8], 16);
        header.mode       := integer(headerStri[ 9 len  8], 16);
        header.uid        := integer(headerStri[17 len  8], 16);
        header.gid        := integer(headerStri[25 len  8], 16);
        header.nlink      := integer(headerStri[33 len  8], 16);
        header.mtime      := integer(headerStri[41 len  8], 16);
        header.fileSize   := integer(headerStri[49 len  8], 16);
        header.devmajor   := integer(headerStri[57 len  8], 16);
        header.devminor   := integer(headerStri[65 len  8], 16);
        header.rdevmajor  := integer(headerStri[73 len  8], 16);
        header.rdevminor  := integer(headerStri[81 len  8], 16);
        header.nameSize   := integer(headerStri[89 len  8], 16);
        header.check      := integer(headerStri[97 len  8], 16);
        header.headerSize := 110;
        filePath8         := gets(inFile, pred(header.nameSize));
        header.padding    := 4;
      else
        header.magic := "";
      end if;
    end if;
    if header.magic <> "" then
      block
        header.filePath := utf8ToStri(filePath8);
      exception
        catch RANGE_ERROR:
          header.filePath := filePath8;
      end block;
      remPadding := (header.headerSize + header.nameSize) rem header.padding;
      if remPadding <> 0 then
        ignore(gets(inFile, 1 + header.padding - remPadding));
      else
        ignore(getc(inFile));
      end if;
    end if;
    if endsWith(header.filePath, "/") and header.filePath <> "/" then
      header.filePath := header.filePath[.. pred(length(header.filePath))];
    end if;
    header.dataStartPos := tell(inFile);
    # showHeader(OUT, header);
  end func;


const proc: readMinimumOfHead (inout file: inFile, inout cpioHeader: header) is func
  local
    var string: headerStri is "";
    var string: filePath8 is "";
    var integer: remPadding is 0;
  begin
    header.magic := gets(inFile, 2);
    if header.magic = CPIO_BINARY_MAGIC then
      # writeln("CPIO_BINARY_MAGIC");
      headerStri := gets(inFile, 24);
      header.nameSize   := bytes2Int(headerStri[19 len 2], UNSIGNED, BE);
      header.fileSize   := bytes2Int(headerStri[21 len 4], UNSIGNED, BE);
      header.headerSize := 26;
      filePath8         := gets(inFile, pred(header.nameSize));
      header.padding    := 2;
    elsif header.magic = CPIO_SWAPPED_BINARY_MAGIC then
      # writeln("CPIO_SWAPPED_BINARY_MAGIC");
      headerStri := gets(inFile, 24);
      header.nameSize   := bytes2Int(headerStri[19 len 2], UNSIGNED, LE);
      header.fileSize   := bytes2Int(headerStri[21 len 2], UNSIGNED, LE) * 65536 +
                           bytes2Int(headerStri[23 len 2], UNSIGNED, LE);
      header.headerSize := 26;
      filePath8         := gets(inFile, pred(header.nameSize));
      header.padding    := 2;
    else
      header.magic &:= gets(inFile, 4);
      if header.magic = CPIO_OLD_ASCII_MAGIC then
        # writeln("CPIO_OLD_ASCII_MAGIC");
        headerStri := gets(inFile, 70);
        header.nameSize   := integer(headerStri[54 len  6], 8);
        header.fileSize   := integer(headerStri[60 len 11], 8);
        header.headerSize := 76;
        filePath8         := gets(inFile, pred(header.nameSize));
        header.padding    := 1;
      elsif header.magic = CPIO_NEW_ASCII_MAGIC or
            header.magic = CPIO_NEW_ASCII_CRC_MAGIC then
        # writeln("CPIO_NEW_ASCII_MAGIC");
        headerStri := gets(inFile, 104);
        header.fileSize   := integer(headerStri[49 len  8], 16);
        header.nameSize   := integer(headerStri[89 len  8], 16);
        header.headerSize := 110;
        filePath8         := gets(inFile, pred(header.nameSize));
        header.padding    := 4;
      else
        header.magic := "";
      end if;
    end if;
    if header.magic <> "" then
      block
        header.filePath := utf8ToStri(filePath8);
      exception
        catch RANGE_ERROR:
          header.filePath := filePath8;
      end block;
      remPadding := (header.headerSize + header.nameSize) rem header.padding;
      if remPadding <> 0 then
        ignore(gets(inFile, 1 + header.padding - remPadding));
      else
        ignore(getc(inFile));
      end if;
    end if;
    if endsWith(header.filePath, "/") and header.filePath <> "/" then
      header.filePath := header.filePath[.. pred(length(header.filePath))];
    end if;
    header.dataStartPos := tell(inFile);
    # showHeader(OUT, header);
  end func;


const func string: str (in cpioHeader: header) is func
  result
    var string: stri is "";
  begin
    if header.magic = CPIO_BINARY_MAGIC then
      # writeln("CPIO_BINARY_MAGIC");
      stri := header.magic &
              str(char(header.devmajor)) &
              str(char(header.devminor)) &
              int16AsTwoBytesBe(header.ino) &
              int16AsTwoBytesBe(header.mode) &
              int16AsTwoBytesBe(header.uid) &
              int16AsTwoBytesBe(header.gid) &
              int16AsTwoBytesBe(header.nlink) &
              str(char(header.rdevmajor)) &
              str(char(header.rdevminor)) &
              int32AsFourBytesBe(header.mtime) &
              int16AsTwoBytesBe(header.nameSize) &
              int32AsFourBytesBe(header.fileSize);
    elsif header.magic = CPIO_SWAPPED_BINARY_MAGIC then
      # writeln("CPIO_SWAPPED_BINARY_MAGIC");
      stri := header.magic &
              str(char(header.devminor)) &
              str(char(header.devmajor)) &
              int16AsTwoBytesLe(header.ino) &
              int16AsTwoBytesLe(header.mode) &
              int16AsTwoBytesLe(header.uid) &
              int16AsTwoBytesLe(header.gid) &
              int16AsTwoBytesLe(header.nlink) &
              str(char(header.rdevminor)) &
              str(char(header.rdevmajor)) &
              int16AsTwoBytesLe(header.mtime >> 16) &
              int16AsTwoBytesLe(header.mtime mod 65536) &
              int16AsTwoBytesLe(header.nameSize) &
              int16AsTwoBytesLe(header.fileSize >> 16) &
              int16AsTwoBytesLe(header.fileSize mod 65536);
    elsif header.magic = CPIO_OLD_ASCII_MAGIC then
      # writeln("CPIO_OLD_ASCII_MAGIC");
      stri := header.magic <&
              header.devmajor * 256 +
              header.devminor  radix 8 lpad0  6 <&
              header.ino       radix 8 lpad0  6 <&
              header.mode      radix 8 lpad0  6 <&
              header.uid       radix 8 lpad0  6 <&
              header.gid       radix 8 lpad0  6 <&
              header.nlink     radix 8 lpad0  6 <&
              header.rdevmajor * 256 +
              header.rdevminor radix 8 lpad0  6 <&
              header.mtime     radix 8 lpad0 11 <&
              header.nameSize  radix 8 lpad0  6 <&
              header.fileSize  radix 8 lpad0 11;
    elsif header.magic = CPIO_NEW_ASCII_MAGIC or
          header.magic = CPIO_NEW_ASCII_CRC_MAGIC then
      # writeln("CPIO_NEW_ASCII_MAGIC");
      stri := header.magic <&
              header.ino       radix 16 lpad0 8 <&
              header.mode      radix 16 lpad0 8 <&
              header.uid       radix 16 lpad0 8 <&
              header.gid       radix 16 lpad0 8 <&
              header.nlink     radix 16 lpad0 8 <&
              header.mtime     radix 16 lpad0 8 <&
              header.fileSize  radix 16 lpad0 8 <&
              header.devmajor  radix 16 lpad0 8 <&
              header.devminor  radix 16 lpad0 8 <&
              header.rdevmajor radix 16 lpad0 8 <&
              header.rdevminor radix 16 lpad0 8 <&
              header.nameSize  radix 16 lpad0 8 <&
              header.check     radix 16 lpad0 8;
    end if;
  end func;


const proc: writeHead (inout file: outFile, in cpioHeader: header) is func
  begin
    write(outFile, str(header));
  end func;


const proc: writeTrailer (inout file: outFile, in cpioHeader: header) is func
  local
    var cpioHeader: trailer is cpioHeader.value;
  begin
    trailer.magic := header.magic;
    trailer.nameSize := succ(length(CPIO_TRAILER_NAME));
    writeHead(outFile, trailer);
    # showHeader(OUT, trailer);
    write(outFile, CPIO_TRAILER_NAME <& "\0;");
    write(outFile, "\0;" mult pred(header.padding) -
          pred(header.headerSize + trailer.nameSize) mod header.padding);
  end func;


const type: cpioRegisterType is hash [string] integer;
const type: cpioCatalogType is hash [string] cpioHeader;


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


(**
 *  Open a CPIO archive with the given cpioFile.
 *  @param cpioFile File that contains a CPIO archive.
 *  @return a file system that accesses the CPIO archive.
 *)
const func fileSys: openCpio (inout file: cpioFile) is func
  result
    var fileSys: newFileSys is fileSys.value;
  local
    var cpioHeader: header is cpioHeader.value;
    var integer: headPos is 1;
    var cpioArchive: cpio is cpioArchive.value;
  begin
    if length(cpioFile) = 0 then
      cpio.magic := CPIO_NEW_ASCII_CRC_MAGIC;
      cpio.headerSize := 110;
      cpio.padding := 4;
      cpio.cpioFile := cpioFile;
      cpio.trailerPos := 0;
      newFileSys := toInterface(cpio);
    else
      seek(cpioFile, headPos);
      readMinimumOfHead(cpioFile, header);
      if header.magic <> "" then
        cpio.magic := header.magic;
        cpio.headerSize := header.headerSize;
        cpio.padding := header.padding;
        cpio.cpioFile := cpioFile;
        repeat
          # writeln(header.filePath <& " " <& headPos);
          cpio.register @:= [header.filePath] headPos;
          # writeln(tell(cpioFile));
          headPos := tell(cpioFile) +
              succ(pred(header.fileSize) mdiv header.padding) * header.padding;
          # writeln(headPos);
          seek(cpioFile, headPos);
          readMinimumOfHead(cpioFile, header);
        until header.magic = "" or
              (header.filePath = CPIO_TRAILER_NAME and header.fileSize = 0);
        cpio.trailerPos := headPos;
        newFileSys := toInterface(cpio);
      end if;
    end if;
  end func;


(**
 *  Open a CPIO archive with the given cpioFileName.
 *  @param cpioFileName Name of the CPIO archive to be opened.
 *  @return a file system that accesses the CPIO archive.
 *)
const func fileSys: openCpio (in string: cpioFileName) is func
  result
    var fileSys: cpio is fileSys.value;
  local
    var file: cpioFile is STD_NULL;
  begin
    cpioFile := open(cpioFileName, "r");
    cpio := openCpio(cpioFile);
  end func;


(**
 *  Close a CPIO archive.
 *)
const proc: close (inout cpioArchive: cpio) is func
  begin
    # close(cpio.cpioFile);
    cpio.cpioFile := STD_NULL;
  end func;


const func cpioHeader: addToCatalog (inout cpioArchive: cpio, in string: filePath) is func
  result
    var cpioHeader: header is cpioHeader.value;
  begin
    seek(cpio.cpioFile, cpio.register[filePath]);
    readHead(cpio.cpioFile, header);
    cpio.catalog @:= [filePath] header;
  end func;


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


const func cpioHeader: addImplicitDir (inout cpioArchive: cpio,
    in string: dirPath) is func
  result
    var cpioHeader: header is cpioHeader.value;
  begin
    header.filePath := dirPath;
    header.mode := ord(MODE_FILE_DIR) + 8#775;
    header.dataStartPos := -1;
    cpio.catalog @:= [dirPath] header;
  end func;


const func string: followSymlink (inout cpioArchive: cpio, in var string: filePath,
    inout cpioHeader: header) is func
  result
    var string: missingPath is "";
  local
    var integer: symlinkCount is MAX_SYMLINKS;
    var boolean: isSymlink is TRUE;
  begin
    # writeln("followSymlink: " <& filePath);
    repeat
      if filePath in cpio.catalog then
        header := cpio.catalog[filePath];
      elsif filePath in cpio.register then
        header := addToCatalog(cpio, filePath);
      elsif implicitDir(cpio, filePath) then
        header := addImplicitDir(cpio, filePath);
      else
        # The file does not exist.
        missingPath := filePath;
        isSymlink := FALSE;
        # writeln("missing: " <& missingPath);
      end if;
      if missingPath = "" then
        if bin32(header.mode) & MODE_FILE_TYPE_MASK = MODE_FILE_SYMLINK then
          seek(cpio.cpioFile, header.dataStartPos);
          filePath := gets(cpio.cpioFile, header.fileSize);
          if startsWith(filePath, "/") and
              filePath not in cpio.catalog and filePath not in cpio.register then
            filePath := "." & filePath;
          end if;
        else
          isSymlink := FALSE;
          # writeln("found: " <& header.filePath);
        end if;
      end if;
      decr(symlinkCount);
    until not isSymlink or symlinkCount = 0;
    if isSymlink then
      # Too many symbolic links.
      raise FILE_ERROR;
    end if;
  end func;


const func cpioHeader: followSymlink (inout cpioArchive: cpio, in var string: filePath) is func
  result
    var cpioHeader: header is cpioHeader.value;
  local
    var string: missingPath is "";
  begin
    missingPath := followSymlink(cpio, filePath, header);
    if missingPath <> "" then
      # The file does not exist.
      raise FILE_ERROR;
    end if;
  end func;


(**
 *  Determine the file names in a directory inside a CPIO archive.
 *  Note that the function returns only the file names.
 *  Additional information must be obtained with other calls.
 *  @param cpio Open CPIO archive.
 *  @param dirPath path of a directory in the CPIO 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 CPIO archive.
 *)
const func array string: readDir (inout cpioArchive: cpio, 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 cpio.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 cpio.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 CPIO archive.
 *  Note that the function returns only the file paths.
 *  Additional information must be obtained with other calls.
 *  @param cpio Open CPIO archive.
 *  @return an array with the file paths.
 *)
const func array string: readDir (inout cpioArchive: cpio, RECURSIVE) is
  return sort(keys(cpio.register));


(**
 *  Determine the type of a file in a CPIO archive.
 *  The function follows symbolic links. If the chain of
 *  symbolic links is too long the function returns ''FILE_SYMLINK''.
 *  If a symbolic link refers to a place where the permission
 *  is denied the function returns ''FILE_SYMLINK''.
 *  A return value of ''FILE_ABSENT'' does not imply that a file
 *  with this name can be created, since missing directories and
 *  illegal file names cause also ''FILE_ABSENT''.
 *  @return the type of the file.
 *  @exception RANGE_ERROR ''filePath'' does not use the standard path
 *             representation.
 *)
const func fileType: fileType (inout cpioArchive: cpio, in var string: filePath) is func
  result
    var fileType: aFileType is FILE_UNKNOWN;
  local
    var cpioHeader: header is cpioHeader.value;
    var integer: symlinkCount is MAX_SYMLINKS;
  begin
    # writeln("fileType: " <& filePath);
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    elsif filePath = "" then
      aFileType := FILE_DIR;
    else
      repeat
        if filePath in cpio.catalog then
          header := cpio.catalog[filePath];
        elsif filePath in cpio.register then
          header := addToCatalog(cpio, filePath);
        elsif implicitDir(cpio, filePath) then
          header := addImplicitDir(cpio, filePath);
        else
          aFileType := FILE_ABSENT;
        end if;
        if aFileType = FILE_UNKNOWN then
          case bin32(header.mode) & MODE_FILE_TYPE_MASK of
            when {MODE_FILE_REGULAR}: aFileType := FILE_REGULAR;
            when {MODE_FILE_DIR}:     aFileType := FILE_DIR;
            when {MODE_FILE_CHAR}:    aFileType := FILE_CHAR;
            when {MODE_FILE_BLOCK}:   aFileType := FILE_BLOCK;
            when {MODE_FILE_FIFO}:    aFileType := FILE_FIFO;
            when {MODE_FILE_SOCKET}:  aFileType := FILE_SOCKET;
            when {MODE_FILE_SYMLINK}:
              seek(cpio.cpioFile, header.dataStartPos);
              filePath := gets(cpio.cpioFile, header.fileSize);
            otherwise:
              raise RANGE_ERROR;
          end case;
        end if;
        decr(symlinkCount);
      until aFileType <> FILE_UNKNOWN or symlinkCount = 0;
    end if;
  end func;


(**
 *  Determine the type of a file in a CPIO 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 cpioArchive: cpio, in string: filePath) is func
  result
    var fileType: aFileType is FILE_UNKNOWN;
  local
    var integer: modeValue is 0;
  begin
    # writeln("fileTypeSL: " <& filePath);
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    elsif filePath = "" then
      aFileType := FILE_DIR;
    else
      if filePath in cpio.catalog then
        modeValue := cpio.catalog[filePath].mode;
      elsif filePath in cpio.register then
        modeValue := addToCatalog(cpio, filePath).mode;
      elsif implicitDir(cpio, filePath) then
        modeValue := addImplicitDir(cpio, filePath).mode;
      else
        aFileType := FILE_ABSENT;
      end if;
      if aFileType = FILE_UNKNOWN then
        case bin32(modeValue) & MODE_FILE_TYPE_MASK of
          when {MODE_FILE_REGULAR}: aFileType := FILE_REGULAR;
          when {MODE_FILE_DIR}:     aFileType := FILE_DIR;
          when {MODE_FILE_CHAR}:    aFileType := FILE_CHAR;
          when {MODE_FILE_BLOCK}:   aFileType := FILE_BLOCK;
          when {MODE_FILE_FIFO}:    aFileType := FILE_FIFO;
          when {MODE_FILE_SOCKET}:  aFileType := FILE_SOCKET;
          when {MODE_FILE_SYMLINK}: aFileType := FILE_SYMLINK;
          otherwise:
            raise RANGE_ERROR;
        end case;
      end if;
    end if;
  end func;


(**
 *  Determine the file mode (permissions) of a file in a CPIO 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 CPIO archive, or
 *             the chain of symbolic links is too long.
 *)
const func fileMode: fileMode (inout cpioArchive: cpio, 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(cpio, filePath).mode);
    end if;
  end func;


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


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


(**
 *  Determine the modification time of a file in a CPIO 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 CPIO archive, or
 *             the chain of symbolic links is too long.
 *)
const func time: getMTime (inout cpioArchive: cpio, 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(cpio, filePath).mtime);
    end if;
  end func;


(**
 *  Set the modification time of a file in a CPIO archive.
 *  The function follows symbolic links.
 *  @exception RANGE_ERROR ''filePath'' does not use the standard path
 *             representation.
 *  @exception RANGE_ERROR ''aTime'' is invalid or cannot be
 *             converted to the system file time.
 *  @exception FILE_ERROR ''filePath'' is not present in the CPIO archive, or
 *             the chain of symbolic links is too long.
 *)
const proc: setMTime (inout cpioArchive: cpio, in string: filePath,
    in time: modificationTime) is func
  local
    var integer: mtime is 0;
    var cpioHeader: header is cpioHeader.value;
  begin
    mtime := timestamp1970(modificationTime);
    if mtime < 0 or mtime >= 2 ** 31 or
        (filePath <> "/" and endsWith(filePath, "/")) then
      raise RANGE_ERROR;
    else
      header := followSymlink(cpio, filePath);
      if header.filePath in cpio.register then
        header.mtime := mtime;
        cpio.catalog @:= [header.filePath] header;
        seek(cpio.cpioFile, cpio.register[header.filePath]);
        writeHead(cpio.cpioFile, cpio.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 CPIO 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 CPIO archive, or
 *             the chain of symbolic links is too long.
 *)
const func string: getOwner (inout cpioArchive: cpio, in string: filePath) is func
  result
    var string: owner is "";
  begin
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    else
      owner := str(followSymlink(cpio, filePath).uid);
    end if;
  end func;


const proc: setOwner (inout cpioArchive: cpio, in string: filePath,
    in string: owner) is func
  local
    var cpioHeader: header is cpioHeader.value;
  begin
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    else
      header := followSymlink(cpio, filePath);
      if header.filePath in cpio.register then
        if isDigitString(owner) then
          header.uid := integer(owner);
        else
          header.uid := 0;
        end if;
        cpio.catalog @:= [header.filePath] header;
        seek(cpio.cpioFile, cpio.register[header.filePath]);
        writeHead(cpio.cpioFile, cpio.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 CPIO 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 CPIO archive, or
 *             the chain of symbolic links is too long.
 *)
const func string: getGroup (inout cpioArchive: cpio, in string: filePath) is func
  result
    var string: group is "";
  begin
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    else
      group := str(followSymlink(cpio, filePath).gid);
    end if;
  end func;


const proc: setGroup (inout cpioArchive: cpio, in string: filePath,
    in string: group) is func
  local
    var cpioHeader: header is cpioHeader.value;
  begin
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    else
      header := followSymlink(cpio, filePath);
      if header.filePath in cpio.register then
        if isDigitString(group) then
          header.gid := integer(group);
        else
          header.gid := 0;
        end if;
        cpio.catalog @:= [header.filePath] header;
        seek(cpio.cpioFile, cpio.register[header.filePath]);
        writeHead(cpio.cpioFile, cpio.catalog[header.filePath]);
      else
        raise FILE_ERROR;
      end if;
    end if;
  end func;


(**
 *  Reads the destination of a symbolic link in a CPIO 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 CPIO archive,
 *             or is not a symbolic link.
 *)
const func string: readlink (inout cpioArchive: cpio, in string: filePath) is func
  result
    var string: linkPath is "";
  local
    var cpioHeader: header is cpioHeader.value;
  begin
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    elsif filePath in cpio.catalog then
      header := cpio.catalog[filePath];
    elsif filePath in cpio.register then
      header := addToCatalog(cpio, filePath);
    else
      raise FILE_ERROR;
    end if;
    if bin32(header.mode) & MODE_FILE_TYPE_MASK = MODE_FILE_SYMLINK then
      seek(cpio.cpioFile, header.dataStartPos);
      linkPath := gets(cpio.cpioFile, header.fileSize);
    else
      raise FILE_ERROR;
    end if;
  end func;


(**
 *  Get the contents of a file in a CPIO 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 CPIO archive,
 *             or is not a regular file, or
 *             the chain of symbolic links is too long.
 *)
const func string: getFile (inout cpioArchive: cpio, in string: filePath) is func
  result
    var string: content is "";
  local
    var cpioHeader: header is cpioHeader.value;
  begin
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    else
      header := followSymlink(cpio, filePath);
      if bin32(header.mode) & MODE_FILE_TYPE_MASK = MODE_FILE_REGULAR then
        seek(cpio.cpioFile, header.dataStartPos);
        content := gets(cpio.cpioFile, header.fileSize);
      else
        raise FILE_ERROR;
      end if;
    end if;
  end func;


(**
 *  Write ''data'' to a CPIO 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 cpioArchive: cpio, in var string: filePath,
    in string: data) is func
  local
    var cpioHeader: header is cpioHeader.value;
    var string: missingPath is "";
    var boolean: appendFile is TRUE;
    var integer: length is 0;
    var string: filePath8 is "";
  begin
    if filePath = "" or filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    else
      missingPath := followSymlink(cpio, filePath, header);
      if missingPath = "" then
        # The file does exist.
        filePath := header.filePath;
        if bin32(header.mode) & MODE_FILE_TYPE_MASK <> MODE_FILE_REGULAR then
          raise FILE_ERROR;
        else
          if succ(pred(header.fileSize) mdiv header.padding) * header.padding =
              succ(pred(length(data)) mdiv header.padding) * header.padding 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);
            if header.magic = CPIO_NEW_ASCII_CRC_MAGIC then
              header.check := computeCheck(data);
            end if;
            cpio.catalog @:= [filePath] header;
            seek(cpio.cpioFile, cpio.register[filePath]);
            writeHead(cpio.cpioFile, header);
            seek(cpio.cpioFile, header.dataStartPos);
            write(cpio.cpioFile, data);
            write(cpio.cpioFile, "\0;" mult pred(header.padding) -
                  pred(header.fileSize) mod header.padding);
            appendFile := FALSE;
          end if;
        end if;
      else
        filePath := missingPath;
      end if;
      if appendFile then
        filePath8 := striToUtf8(filePath);
        if missingPath <> "" then
          header.magic      := cpio.magic;
          header.ino        := 0;
          header.mode       := ord(MODE_FILE_REGULAR) + 8#664;
          header.uid        := 100;
          header.gid        := 100;
          header.nlink      := 1;
          header.mtime      := timestamp1970(time(NOW));
          header.devmajor   := 0;
          header.devminor   := 0;
          header.rdevmajor  := 0;
          header.rdevminor  := 0;
          header.nameSize   := succ(length(filePath8));
          header.check      := 0;
          header.headerSize := cpio.headerSize;
          header.filePath   := filePath;
          header.padding    := cpio.padding;
        end if;
        length := length(cpio.cpioFile);
        if cpio.trailerPos = 0 then
          seek(cpio.cpioFile, succ(length));
          # Add zero bytes such that the next header starts
          # at a multiple of the block size:
          write(cpio.cpioFile, "\0;" mult pred(header.padding) -
                pred(length) mod header.padding);
        else
          seek(cpio.cpioFile, cpio.trailerPos);
        end if;
        cpio.register @:= [filePath] tell(cpio.cpioFile);
        header.fileSize := length(data);
        if header.magic = CPIO_NEW_ASCII_CRC_MAGIC then
          header.check := computeCheck(data);
        end if;
        writeHead(cpio.cpioFile, header);
        write(cpio.cpioFile, filePath8 <& "\0;");
        write(cpio.cpioFile, "\0;" mult pred(header.padding) -
              pred(header.headerSize + header.nameSize) mod header.padding);
        header.dataStartPos := tell(cpio.cpioFile);
        cpio.catalog @:= [filePath] header;
        write(cpio.cpioFile, data);
        write(cpio.cpioFile, "\0;" mult pred(header.padding) -
              pred(header.fileSize) mod header.padding);
        cpio.trailerPos := tell(cpio.cpioFile);
        writeTrailer(cpio.cpioFile, header);
        flush(cpio.cpioFile);
      end if;
    end if;
  end func;


(**
 *  Creates a new directory in a CPIO archive.
 *  The function does not follow symbolic links.
 *  @exception RANGE_ERROR ''dirPath'' does not use the standard path
 *             representation.
 *  @exception FILE_ERROR A system function returns an error.
 *)
const proc: mkdir (inout cpioArchive: cpio, in string: filePath) is func
  local
    var cpioHeader: header is cpioHeader.value;
    var boolean: fileExists is TRUE;
    var integer: dataStartPos is 0;
    var integer: length is 0;
    var string: filePath8 is "";
  begin
    if filePath = "" or filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    elsif filePath in cpio.catalog then
      dataStartPos := cpio.catalog[filePath].dataStartPos;
    elsif filePath in cpio.register then
      dataStartPos := addToCatalog(cpio, filePath).dataStartPos;
    elsif implicitDir(cpio, filePath) then
      dataStartPos := addImplicitDir(cpio, filePath).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
      filePath8 := striToUtf8(filePath);
      header.magic      := cpio.magic;
      header.ino        := 0;
      header.mode       := ord(MODE_FILE_DIR) + 8#775;
      header.uid        := 100;
      header.gid        := 100;
      header.nlink      := 1;
      header.mtime      := timestamp1970(time(NOW));
      header.devmajor   := 0;
      header.devminor   := 0;
      header.rdevmajor  := 0;
      header.rdevminor  := 0;
      header.nameSize   := succ(length(filePath8));
      header.check      := 0;
      header.headerSize := cpio.headerSize;
      header.filePath   := filePath;
      header.padding    := cpio.padding;
      length := length(cpio.cpioFile);
      if cpio.trailerPos = 0 then
        seek(cpio.cpioFile, succ(length));
        # Add zero bytes such that the next header starts
        # at a multiple of the block size:
        write(cpio.cpioFile, "\0;" mult pred(header.padding) -
                                        pred(length) mod header.padding);
      else
        seek(cpio.cpioFile, cpio.trailerPos);
      end if;
      cpio.register @:= [filePath] tell(cpio.cpioFile);
      header.fileSize := 0;
      writeHead(cpio.cpioFile, header);
      write(cpio.cpioFile, filePath8 <& "\0;");
      write(cpio.cpioFile, "\0;" mult pred(header.padding) -
            pred(header.headerSize + header.nameSize) mod header.padding);
      header.dataStartPos := tell(cpio.cpioFile);
      cpio.catalog @:= [filePath] header;
      cpio.trailerPos := tell(cpio.cpioFile);
      writeTrailer(cpio.cpioFile, header);
      flush(cpio.cpioFile);
    end if;
  end func;


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


const func file: openFileInCpio (inout cpioArchive: cpio, in string: filePath,
    in string: mode) is func
  result
    var file: newFile is STD_NULL;
  local
    var cpioHeader: header is cpioHeader.value;
    var string: missingPath is "";
  begin
    if mode = "r" then
      if filePath <> "/" and endsWith(filePath, "/") then
        raise RANGE_ERROR;
      else
        missingPath := followSymlink(cpio, filePath, header);
        if missingPath = "" and
            bin32(header.mode) & MODE_FILE_TYPE_MASK = MODE_FILE_REGULAR then
          newFile := openSubFile(cpio.cpioFile, header.dataStartPos,
                                 header.fileSize);
        end if;
      end if;
    end if;
  end func;


(**
 *  Open a file with ''filePath'' and ''mode'' in in a CPIO archive.
 *)
const func file: open (inout cpioArchive: cpio, in string: filePath,
    in string: mode) is
  return openBufferFile(openFileInCpio(cpio, filePath, mode));
