(********************************************************************)
(*                                                                  *)
(*  cpio.s7i      Cpio archive library                              *)
(*  Copyright (C) 2020 - 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 "filebits.s7i";
include "unicode.s7i";
include "fileutil.s7i";
include "bytedata.s7i";
include "bin32.s7i";
include "subfile.s7i";
include "iobuffer.s7i";
include "archive_base.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: inode 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, "inode: " <& header.inode);
    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, length(CPIO_BINARY_MAGIC));
    if header.magic = CPIO_BINARY_MAGIC then
      # writeln("CPIO_BINARY_MAGIC");
      headerStri := gets(inFile, 24);
      if length(headerStri) = 24 then
        header.devmajor   := bytes2Int(headerStri[ 1 fixLen 1], UNSIGNED, BE);
        header.devminor   := bytes2Int(headerStri[ 2 fixLen 1], UNSIGNED, BE);
        header.inode      := bytes2Int(headerStri[ 3 fixLen 2], UNSIGNED, BE);
        header.mode       := bytes2Int(headerStri[ 5 fixLen 2], UNSIGNED, BE);
        header.uid        := bytes2Int(headerStri[ 7 fixLen 2], UNSIGNED, BE);
        header.gid        := bytes2Int(headerStri[ 9 fixLen 2], UNSIGNED, BE);
        header.nlink      := bytes2Int(headerStri[11 fixLen 2], UNSIGNED, BE);
        header.rdevmajor  := bytes2Int(headerStri[13 fixLen 1], UNSIGNED, BE);
        header.rdevminor  := bytes2Int(headerStri[14 fixLen 1], UNSIGNED, BE);
        header.mtime      := bytes2Int(headerStri[15 fixLen 4], UNSIGNED, BE);
        header.nameSize   := bytes2Int(headerStri[19 fixLen 2], UNSIGNED, BE);
        header.fileSize   := bytes2Int(headerStri[21 fixLen 4], UNSIGNED, BE);
        header.headerSize := 26;
        filePath8         := gets(inFile, pred(header.nameSize));
        header.padding    := 2;
      end if;
    elsif header.magic = CPIO_SWAPPED_BINARY_MAGIC then
      # writeln("CPIO_SWAPPED_BINARY_MAGIC");
      headerStri := gets(inFile, 24);
      if length(headerStri) = 24 then
        header.devminor   := bytes2Int(headerStri[ 1 fixLen 1], UNSIGNED, LE);
        header.devmajor   := bytes2Int(headerStri[ 2 fixLen 1], UNSIGNED, LE);
        header.inode      := bytes2Int(headerStri[ 3 fixLen 2], UNSIGNED, LE);
        header.mode       := bytes2Int(headerStri[ 5 fixLen 2], UNSIGNED, LE);
        header.uid        := bytes2Int(headerStri[ 7 fixLen 2], UNSIGNED, LE);
        header.gid        := bytes2Int(headerStri[ 9 fixLen 2], UNSIGNED, LE);
        header.nlink      := bytes2Int(headerStri[11 fixLen 2], UNSIGNED, LE);
        header.rdevminor  := bytes2Int(headerStri[13 fixLen 1], UNSIGNED, LE);
        header.rdevmajor  := bytes2Int(headerStri[14 fixLen 1], UNSIGNED, LE);
        header.mtime      := bytes2Int(headerStri[15 fixLen 2], UNSIGNED, LE) * 65536 +
                             bytes2Int(headerStri[17 fixLen 2], UNSIGNED, LE);
        header.nameSize   := bytes2Int(headerStri[19 fixLen 2], UNSIGNED, LE);
        header.fileSize   := bytes2Int(headerStri[21 fixLen 2], UNSIGNED, LE) * 65536 +
                             bytes2Int(headerStri[23 fixLen 2], UNSIGNED, LE);
        header.headerSize := 26;
        filePath8         := gets(inFile, pred(header.nameSize));
        header.padding    := 2;
      end if;
    else
      header.magic &:= gets(inFile,
          length(CPIO_OLD_ASCII_MAGIC) - length(CPIO_BINARY_MAGIC));
      if header.magic = CPIO_OLD_ASCII_MAGIC then
        # writeln("CPIO_OLD_ASCII_MAGIC");
        headerStri := gets(inFile, 70);
        if length(headerStri) = 70 then
          device            := integer(headerStri[ 1 fixLen  6], 8);
          header.devmajor   := device >> 8;
          header.devminor   := device mod 256;
          header.inode      := integer(headerStri[ 7 fixLen  6], 8);
          header.mode       := integer(headerStri[13 fixLen  6], 8);
          header.uid        := integer(headerStri[19 fixLen  6], 8);
          header.gid        := integer(headerStri[25 fixLen  6], 8);
          header.nlink      := integer(headerStri[31 fixLen  6], 8);
          device            := integer(headerStri[37 fixLen  6], 8);
          header.rdevmajor  := device >> 8;
          header.rdevminor  := device mod 256;
          header.mtime      := integer(headerStri[43 fixLen 11], 8);
          header.nameSize   := integer(headerStri[54 fixLen  6], 8);
          header.fileSize   := integer(headerStri[60 fixLen 11], 8);
          header.headerSize := 76;
          filePath8         := gets(inFile, pred(header.nameSize));
          header.padding    := 1;
        end if;
      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);
        if length(headerStri) = 104 then
          header.inode      := integer(headerStri[ 1 fixLen  8], 16);
          header.mode       := integer(headerStri[ 9 fixLen  8], 16);
          header.uid        := integer(headerStri[17 fixLen  8], 16);
          header.gid        := integer(headerStri[25 fixLen  8], 16);
          header.nlink      := integer(headerStri[33 fixLen  8], 16);
          header.mtime      := integer(headerStri[41 fixLen  8], 16);
          header.fileSize   := integer(headerStri[49 fixLen  8], 16);
          header.devmajor   := integer(headerStri[57 fixLen  8], 16);
          header.devminor   := integer(headerStri[65 fixLen  8], 16);
          header.rdevmajor  := integer(headerStri[73 fixLen  8], 16);
          header.rdevminor  := integer(headerStri[81 fixLen  8], 16);
          header.nameSize   := integer(headerStri[89 fixLen  8], 16);
          header.check      := integer(headerStri[97 fixLen  8], 16);
          header.headerSize := 110;
          filePath8         := gets(inFile, pred(header.nameSize));
          header.padding    := 4;
        end if;
      else
        header.magic := "";
      end if;
    end if;
    if header.magic <> "" then
      if header.headerSize = 0 then
        header.magic := "";
      else
        block
          header.filePath := fromUtf8(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;
    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, length(CPIO_BINARY_MAGIC));
    if header.magic = CPIO_BINARY_MAGIC then
      # writeln("CPIO_BINARY_MAGIC");
      headerStri := gets(inFile, 24);
      if length(headerStri) = 24 then
        header.inode      := bytes2Int(headerStri[ 3 fixLen 2], UNSIGNED, BE);
        header.nameSize   := bytes2Int(headerStri[19 fixLen 2], UNSIGNED, BE);
        header.fileSize   := bytes2Int(headerStri[21 fixLen 4], UNSIGNED, BE);
        header.headerSize := 26;
        filePath8         := gets(inFile, pred(header.nameSize));
        header.padding    := 2;
      end if;
    elsif header.magic = CPIO_SWAPPED_BINARY_MAGIC then
      # writeln("CPIO_SWAPPED_BINARY_MAGIC");
      headerStri := gets(inFile, 24);
      if length(headerStri) = 24 then
        header.inode      := bytes2Int(headerStri[ 3 fixLen 2], UNSIGNED, LE);
        header.nameSize   := bytes2Int(headerStri[19 fixLen 2], UNSIGNED, LE);
        header.fileSize   := bytes2Int(headerStri[21 fixLen 2], UNSIGNED, LE) * 65536 +
                             bytes2Int(headerStri[23 fixLen 2], UNSIGNED, LE);
        header.headerSize := 26;
        filePath8         := gets(inFile, pred(header.nameSize));
        header.padding    := 2;
      end if;
    else
      header.magic &:= gets(inFile,
          length(CPIO_OLD_ASCII_MAGIC) - length(CPIO_BINARY_MAGIC));
      if header.magic = CPIO_OLD_ASCII_MAGIC then
        # writeln("CPIO_OLD_ASCII_MAGIC");
        headerStri := gets(inFile, 70);
        if length(headerStri) = 70 then
          header.inode      := integer(headerStri[ 7 fixLen  6], 8);
          header.nameSize   := integer(headerStri[54 fixLen  6], 8);
          header.fileSize   := integer(headerStri[60 fixLen 11], 8);
          header.headerSize := 76;
          filePath8         := gets(inFile, pred(header.nameSize));
          header.padding    := 1;
        end if;
      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);
        if length(headerStri) = 104 then
          header.inode      := integer(headerStri[ 1 fixLen  8], 16);
          header.fileSize   := integer(headerStri[49 fixLen  8], 16);
          header.nameSize   := integer(headerStri[89 fixLen  8], 16);
          header.headerSize := 110;
          filePath8         := gets(inFile, pred(header.nameSize));
          header.padding    := 4;
        end if;
      else
        header.magic := "";
      end if;
    end if;
    if header.magic <> "" then
      if header.headerSize = 0 then
        header.magic := "";
      else
        block
          header.filePath := fromUtf8(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;
    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 &
              bytes(header.devmajor,  UNSIGNED, BE, 1) &
              bytes(header.devminor,  UNSIGNED, BE, 1) &
              bytes(header.inode,     UNSIGNED, BE, 2) &
              bytes(header.mode,      UNSIGNED, BE, 2) &
              bytes(header.uid,       UNSIGNED, BE, 2) &
              bytes(header.gid,       UNSIGNED, BE, 2) &
              bytes(header.nlink,     UNSIGNED, BE, 2) &
              bytes(header.rdevmajor, UNSIGNED, BE, 1) &
              bytes(header.rdevminor, UNSIGNED, BE, 1) &
              bytes(header.mtime,     UNSIGNED, BE, 4) &
              bytes(header.nameSize,  UNSIGNED, BE, 2) &
              bytes(header.fileSize,  UNSIGNED, BE, 4);
    elsif header.magic = CPIO_SWAPPED_BINARY_MAGIC then
      # writeln("CPIO_SWAPPED_BINARY_MAGIC");
      stri := header.magic &
              bytes(header.devminor,           UNSIGNED, LE, 1) &
              bytes(header.devmajor,           UNSIGNED, LE, 1) &
              bytes(header.inode,              UNSIGNED, LE, 2) &
              bytes(header.mode,               UNSIGNED, LE, 2) &
              bytes(header.uid,                UNSIGNED, LE, 2) &
              bytes(header.gid,                UNSIGNED, LE, 2) &
              bytes(header.nlink,              UNSIGNED, LE, 2) &
              bytes(header.rdevminor,          UNSIGNED, LE, 1) &
              bytes(header.rdevmajor,          UNSIGNED, LE, 1) &
              bytes(header.mtime >> 16,        UNSIGNED, LE, 2) &
              bytes(header.mtime mod 65536,    UNSIGNED, LE, 2) &
              bytes(header.nameSize,           UNSIGNED, LE, 2) &
              bytes(header.fileSize >> 16,     UNSIGNED, LE, 2) &
              bytes(header.fileSize mod 65536, UNSIGNED, LE, 2);
    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.inode     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.inode     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: 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(aCpioArchive, "src/drivers")   # Relative path in the archive.
 *    fileType(aCpioArchive, "/usr/include")  # Absolute path in the archive.
 *    fileSize(aCpioArchive, "/image")        # Absolute path in the archive.
 *    readDir(aCpioArchive, "")               # Return e.g.: "src" and "/"
 *    readDir(aCpioArchive, "/")              # Return e.g.: "usr" and "image"
 *)
const type: cpioArchive is sub emptyFileSys struct
    var file: cpioFile is STD_NULL;
    var archiveRegisterType: register is archiveRegisterType.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;
    var integer: maximumInode 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, or
 *          fileSys.value if it could not be opened.
 *)
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);
      cpio.maximumInode := max(cpio.maximumInode, header.inode);
      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);
          cpio.maximumInode := max(cpio.maximumInode, header.inode);
        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, or
 *          fileSys.value if it could not be opened.
 *)
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. The CPIO file below stays open.
 *)
const proc: close (inout cpioArchive: cpio) is func
  begin
    cpio := cpioArchive.value;
  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);
    if header.magic <> "" then
      cpio.catalog @:= [filePath] header;
    else
      raise RANGE_ERROR;
    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_SYMLINK_CHAIN_LENGTH;
    var boolean: isSymlink is TRUE;
    var string: targetPath is "";
  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.register, 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
          decr(symlinkCount);
          seek(cpio.cpioFile, header.dataStartPos);
          targetPath := gets(cpio.cpioFile, header.fileSize);
          filePath := symlinkDestination(filePath, targetPath);
          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;
    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;


const proc: fixRegisterAndCatalog (inout cpioArchive: cpio, in integer: insertPos,
    in integer: numChars) is func
  local
    var integer: headerPos is 1;
    var string: filePath is "";
  begin
    for key filePath range cpio.register do
      if cpio.register[filePath] >= insertPos then
        cpio.register[filePath] +:= numChars;
      end if;
    end for;
    for key filePath range cpio.catalog do
      if cpio.catalog[filePath].dataStartPos >= insertPos then
        cpio.catalog[filePath].dataStartPos +:= numChars;
      end if;
    end for;
  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
  return readDir(cpio.register, dirPath);


(**
 *  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''.
 *  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 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_SYMLINK_CHAIN_LENGTH;
    var boolean: isSymlink is FALSE;
    var string: targetPath is "";
  begin
    # writeln("fileType: " <& filePath);
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    elsif filePath = "" then
      aFileType := FILE_DIR;
    else
      repeat
        isSymlink := FALSE;
        if filePath in cpio.catalog then
          header := cpio.catalog[filePath];
        elsif filePath in cpio.register then
          header := addToCatalog(cpio, filePath);
        elsif implicitDir(cpio.register, 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}:
              isSymlink := TRUE;
              decr(symlinkCount);
              seek(cpio.cpioFile, header.dataStartPos);
              targetPath := gets(cpio.cpioFile, header.fileSize);
              filePath := symlinkDestination(filePath, targetPath);
            otherwise:                aFileType := FILE_UNKNOWN;
          end case;
        end if;
      until not isSymlink or symlinkCount < 0;
      if isSymlink then
        aFileType := FILE_SYMLINK;
      end if;
    end if;
  end func;


(**
 *  Determine the type of a file in 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 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 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.register, 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:                aFileType := FILE_UNKNOWN;
        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: getFileMode (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 mod 8#1000);
    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 ''modificationTime'' 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;


(**
 *  Set the owner of a file in a CPIO archive.
 *  The function follows symbolic links. The CPIO archive format allows
 *  only a numeric UID. The ''owner'' "root" is mapped to the UID 0. Other
 *  ''owner'' names raise a RANGE_ERROR.
 *  @exception RANGE_ERROR ''filePath'' does not use the standard path
 *             representation, or the ''owner'' cannot be mapped to a UID.
 *  @exception FILE_ERROR ''filePath'' is not present in the CPIO archive, or
 *             the chain of symbolic links is too long.
 *)
const proc: setOwner (inout cpioArchive: cpio, in string: filePath,
    in string: owner) is func
  local
    var integer: uid is 0;
    var cpioHeader: header is cpioHeader.value;
  begin
    if isDigitString(owner) then
      uid := integer(owner);
    elsif owner <> "root" then
      raise RANGE_ERROR;
    end if;
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    else
      header := followSymlink(cpio, filePath);
      if header.filePath in cpio.register then
        header.uid := uid;
        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;


(**
 *  Set the group of a file in a CPIO archive.
 *  The function follows symbolic links. The CPIO archive format allows
 *  only a numeric GID. The ''group'' "root" is mapped to the GID 0. Other
 *  ''group'' names raise a RANGE_ERROR.
 *  @exception RANGE_ERROR ''filePath'' does not use the standard path
 *             representation, or the ''group'' cannot be mapped to a GID.
 *  @exception FILE_ERROR ''filePath'' is not present in the CPIO archive, or
 *             the chain of symbolic links is too long.
 *)
const proc: setGroup (inout cpioArchive: cpio, in string: filePath,
    in string: group) is func
  local
    var integer: gid is 0;
    var cpioHeader: header is cpioHeader.value;
  begin
    if isDigitString(group) then
      gid := integer(group);
    elsif group <> "root" then
      raise RANGE_ERROR;
    end if;
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    else
      header := followSymlink(cpio, filePath);
      if header.filePath in cpio.register then
        header.gid := gid;
        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 file mode (permissions) of a symbolic link in a CPIO 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 CPIO archive, or it is not a symbolic link.
 *)
const func fileMode: getFileMode (inout cpioArchive: cpio, in string: filePath, SYMLINK) is func
  result
    var fileMode: mode is fileMode.value;
  local
    var cpioHeader: header is cpioHeader.value;
  begin
    # writeln("getFileMode: " <& filePath);
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    elsif filePath = "" then
      raise FILE_ERROR;
    else
      if 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
        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 CPIO 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 CPIO archive, or it is not a symbolic link.
 *)
const func time: getMTime (inout cpioArchive: cpio, in string: filePath, SYMLINK) is func
  result
    var time: modificationTime is time.value;
  local
    var cpioHeader: header is cpioHeader.value;
  begin
    # writeln("getMTime: " <& filePath);
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    elsif filePath = "" then
      raise FILE_ERROR;
    else
      if 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
        modificationTime := timestamp1970ToTime(header.mtime);
      else
        raise FILE_ERROR;
      end if;
    end if;
  end func;


(**
 *  Set the modification time of a symbolic link in a CPIO 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 CPIO archive, or it is not a symbolic link.
 *)
const proc: setMTime (inout cpioArchive: cpio, in string: filePath,
    in time: modificationTime, SYMLINK) 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;
    elsif filePath = "" then
      raise FILE_ERROR;
    else
      if 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
        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 symbolic link in a CPIO 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 CPIO archive, or it is not a symbolic link.
 *)
const func string: getOwner (inout cpioArchive: cpio, in string: filePath, SYMLINK) is func
  result
    var string: owner is "";
  local
    var cpioHeader: header is cpioHeader.value;
  begin
    # writeln("getOwner: " <& filePath);
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    elsif filePath = "" then
      raise FILE_ERROR;
    else
      if 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
        owner := str(header.uid);
      else
        raise FILE_ERROR;
      end if;
    end if;
  end func;


(**
 *  Set the owner of a symbolic link in a CPIO archive.
 *  The function only works for symbolic links and does not follow the
 *  symbolic link. The CPIO archive format allows only a numeric UID.
 *  The ''owner'' "root" is mapped to the UID 0. Other ''owner'' names
 *  raise a RANGE_ERROR.
 *  @exception RANGE_ERROR ''filePath'' does not use the standard path
 *             representation, or the ''owner'' cannot be mapped to a UID.
 *  @exception FILE_ERROR The file described with ''filePath'' is not
 *             present in the CPIO archive, or it is not a symbolic link.
 *)
const proc: setOwner (inout cpioArchive: cpio, in string: filePath,
    in string: owner, SYMLINK) is func
  local
    var integer: uid is 0;
    var cpioHeader: header is cpioHeader.value;
  begin
    if isDigitString(owner) then
      uid := integer(owner);
    elsif owner <> "root" then
      raise RANGE_ERROR;
    end if;
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    elsif filePath = "" then
      raise FILE_ERROR;
    else
      if filePath in 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
        header.uid := uid;
        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 symbolic link in a CPIO 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 CPIO archive, or it is not a symbolic link.
 *)
const func string: getGroup (inout cpioArchive: cpio, in string: filePath, SYMLINK) is func
  result
    var string: group is "";
  local
    var cpioHeader: header is cpioHeader.value;
  begin
    # writeln("getGroup: " <& filePath);
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    elsif filePath = "" then
      raise FILE_ERROR;
    else
      if 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
        group := str(header.gid);
      else
        raise FILE_ERROR;
      end if;
    end if;
  end func;


(**
 *  Set the group of a symbolic link in a CPIO archive.
 *  The function only works for symbolic links and does not follow the
 *  symbolic link. The CPIO archive format allows only a numeric GID.
 *  The ''group'' "root" is mapped to the GID 0. Other ''group'' names
 *  raise a RANGE_ERROR.
 *  @exception RANGE_ERROR ''filePath'' does not use the standard path
 *             representation, or the ''group'' cannot be mapped to a GID.
 *  @exception FILE_ERROR The file described with ''filePath'' is not
 *             present in the CPIO archive, or it is not a symbolic link.
 *)
const proc: setGroup (inout cpioArchive: cpio, in string: filePath,
    in string: group, SYMLINK) is func
  local
    var integer: gid is 0;
    var cpioHeader: header is cpioHeader.value;
  begin
    if isDigitString(group) then
      gid := integer(group);
    elsif group <> "root" then
      raise RANGE_ERROR;
    end if;
    if filePath <> "/" and endsWith(filePath, "/") then
      raise RANGE_ERROR;
    elsif filePath = "" then
      raise FILE_ERROR;
    else
      if filePath in 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
        header.gid := gid;
        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;
    var string: linkPath8 is "";
  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);
      linkPath8 := gets(cpio.cpioFile, header.fileSize);
      block
        linkPath := fromUtf8(linkPath8);
      exception
        catch RANGE_ERROR:
          linkPath := linkPath8;
      end block;
    else
      raise FILE_ERROR;
    end if;
  end func;


(**
 *  Create a symbolic link in a CPIO archive.
 *  The symbolic link ''symlinkPath'' will refer to ''targetPath'' afterwards.
 *  The function does not follow symbolic links.
 *  @param cpio Open CPIO 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 cpioArchive: cpio, in string: symlinkPath,
    in string: targetPath) is func
  local
    var cpioHeader: header is cpioHeader.value;
    var string: symlinkPath8 is "";
    var string: targetPath8 is "";
    var integer: length is 0;
  begin
    # writeln("makeLink: " <& literal(symlinkPath) <& " " <& literal(targetPath));
    if symlinkPath <> "/" and endsWith(symlinkPath, "/") then
      raise RANGE_ERROR;
    elsif symlinkPath = "" or symlinkPath in cpio.catalog or
        symlinkPath in cpio.register or implicitDir(cpio.register, symlinkPath) then
      raise FILE_ERROR;
    else
      symlinkPath8 := toUtf8(symlinkPath);
      targetPath8 := toUtf8(targetPath);
      header.magic      := cpio.magic;
      incr(cpio.maximumInode);
      header.inode      := cpio.maximumInode;
      header.mode       := ord(MODE_FILE_SYMLINK) + 8#777;
      header.uid        := 0;
      header.gid        := 0;
      header.nlink      := 1;
      header.mtime      := timestamp1970(time(NOW));
      header.devmajor   := 0;
      header.devminor   := 0;
      header.rdevmajor  := 0;
      header.rdevminor  := 0;
      header.nameSize   := succ(length(symlinkPath8));
      header.check      := 0;
      header.headerSize := cpio.headerSize;
      header.filePath   := symlinkPath;
      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 @:= [symlinkPath] tell(cpio.cpioFile);
      header.fileSize := length(targetPath8);
      if header.magic = CPIO_NEW_ASCII_CRC_MAGIC then
        header.check := computeCheck(targetPath8);
      end if;
      writeHead(cpio.cpioFile, header);
      write(cpio.cpioFile, symlinkPath8 <& "\0;");
      write(cpio.cpioFile, "\0;" mult pred(header.padding) -
            pred(header.headerSize + header.nameSize) mod header.padding);
      header.dataStartPos := tell(cpio.cpioFile);
      cpio.catalog @:= [symlinkPath] header;
      write(cpio.cpioFile, targetPath8);
      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 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 := toUtf8(filePath);
        if missingPath <> "" then
          header.magic      := cpio.magic;
          incr(cpio.maximumInode);
          header.inode      := cpio.maximumInode;
          header.mode       := ord(MODE_FILE_REGULAR) + 8#664;
          header.uid        := 0;
          header.gid        := 0;
          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;


(**
 *  Create a new directory in a CPIO archive.
 *  The function does not follow symbolic links.
 *  @param cpio Open CPIO 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 cpioArchive: cpio, in string: dirPath) 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: dirPath8 is "";
  begin
    if dirPath = "" or dirPath <> "/" and endsWith(dirPath, "/") then
      raise RANGE_ERROR;
    elsif dirPath in cpio.catalog then
      dataStartPos := cpio.catalog[dirPath].dataStartPos;
    elsif dirPath in cpio.register then
      dataStartPos := addToCatalog(cpio, dirPath).dataStartPos;
    elsif implicitDir(cpio.register, dirPath) then
      dataStartPos := addImplicitDir(cpio, dirPath).dataStartPos;
    else
      fileExists := FALSE;
    end if;
    if fileExists and dataStartPos <> -1 then
      # The file exists and it is not an implicit directory.
      raise FILE_ERROR;
    else
      dirPath8 := toUtf8(dirPath);
      header.magic      := cpio.magic;
      incr(cpio.maximumInode);
      header.inode      := cpio.maximumInode;
      header.mode       := ord(MODE_FILE_DIR) + 8#775;
      header.uid        := 0;
      header.gid        := 0;
      header.nlink      := 1;
      header.mtime      := timestamp1970(time(NOW));
      header.devmajor   := 0;
      header.devminor   := 0;
      header.rdevmajor  := 0;
      header.rdevminor  := 0;
      header.nameSize   := succ(length(dirPath8));
      header.check      := 0;
      header.headerSize := cpio.headerSize;
      header.filePath   := dirPath;
      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 @:= [dirPath] tell(cpio.cpioFile);
      header.fileSize := 0;
      writeHead(cpio.cpioFile, header);
      write(cpio.cpioFile, dirPath8 <& "\0;");
      write(cpio.cpioFile, "\0;" mult pred(header.padding) -
            pred(header.headerSize + header.nameSize) mod header.padding);
      header.dataStartPos := tell(cpio.cpioFile);
      cpio.catalog @:= [dirPath] header;
      cpio.trailerPos := tell(cpio.cpioFile);
      writeTrailer(cpio.cpioFile, header);
      flush(cpio.cpioFile);
    end if;
  end func;


(**
 *  Remove any file except non-empty directories from a CPIO archive.
 *  The function does not follow symbolic links. An attempt to remove a
 *  directory that is not empty triggers FILE_ERROR.
 *  @param cpio Open CPIO 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 cpioArchive: cpio, in string: filePath) is func
  local
    var cpioHeader: header is cpioHeader.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 cpio.catalog then
      header := cpio.catalog[filePath];
    elsif filePath in cpio.register then
      header := addToCatalog(cpio, filePath);
    elsif implicitDir(cpio.register, filePath) then
      header := addImplicitDir(cpio, filePath);
    else
      fileExists := FALSE;
    end if;
    if fileExists and
        (bin32(header.mode) & MODE_FILE_TYPE_MASK = MODE_FILE_REGULAR or
         bin32(header.mode) & MODE_FILE_TYPE_MASK = MODE_FILE_CHAR or
         bin32(header.mode) & MODE_FILE_TYPE_MASK = MODE_FILE_BLOCK or
         bin32(header.mode) & MODE_FILE_TYPE_MASK = MODE_FILE_FIFO or
         bin32(header.mode) & MODE_FILE_TYPE_MASK = MODE_FILE_SYMLINK or
         bin32(header.mode) & MODE_FILE_TYPE_MASK = MODE_FILE_SOCKET or
         (bin32(header.mode) & MODE_FILE_TYPE_MASK = MODE_FILE_DIR and
          isEmptyDir(cpio.register, filePath))) then
      posOfHeaderToBeRemoved := cpio.register[filePath];
      numCharsToBeRemoved := header.dataStartPos - posOfHeaderToBeRemoved +
          succ(pred(header.fileSize) mdiv header.padding) * header.padding;
      # writeln("numCharsToBeRemoved: " <& numCharsToBeRemoved);
      deleteArea(cpio.cpioFile, posOfHeaderToBeRemoved, numCharsToBeRemoved);
      excl(cpio.register, filePath);
      excl(cpio.catalog, filePath);
      fixRegisterAndCatalog(cpio, posOfHeaderToBeRemoved + numCharsToBeRemoved,
                            -numCharsToBeRemoved);
      flush(cpio.cpioFile);
    else
      raise FILE_ERROR;
    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));