(********************************************************************)
(*                                                                  *)
(*  tar_cmds.s7   Commands of the tar program.                      *)
(*  Copyright (C) 1994, 2004, 2005, 2010, 2014, 2017  Thomas Mertes *)
(*  Copyright (C) 2019, 2023 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 "tar.s7i";
include "osfiles.s7i";
include "fileutil.s7i";
include "gzip.s7i";
include "lzma.s7i";
include "xz.s7i";
include "zstd.s7i";


const proc: setUpHead (in string: basePath, in string: filePath,
    in string: filePathSuffix, inout tarHeader: header) is func
  begin
    header.name     := (filePath & filePathSuffix)[.. 100];
    header.mode     := integer(getFileMode(basePath & filePath));
    header.uid      := 100;
    header.gid      := 100;
    header.fileSize := 0;
    header.mtime    := timestamp1970(getMTime(basePath & filePath));
    header.chksum   := 0;  # Filled later
    header.typeflag := REGTYPE;
    header.linkname := "";
    header.magic    := TAR_MAGIC;
    header.version  := "  ";
    header.uname    := "";
    header.gname    := "";
    header.devmajor := 0;
    header.devminor := 0;
    header.prefix   := "";
    header.filePath := filePath;
    header.filePathSuffix := filePathSuffix;
  end func;


const func file: openTarFileWithMagic (in string: inFileName,
    in boolean: complainIfUncompressed) is func
  result
    var file: inFile is STD_NULL;
  local
    var string: magicBytes is "";
  begin
    inFile := open(inFileName, "r");
    if inFile <> STD_NULL then
      magicBytes := gets(inFile, length(GZIP_MAGIC));
      if magicBytes = GZIP_MAGIC then
        seek(inFile, 1);
        inFile := openGzipFile(inFile, READ);
      else
        magicBytes &:= gets(inFile, length(ZSTD_MAGIC) - length(GZIP_MAGIC));
        if magicBytes = ZSTD_MAGIC then
          seek(inFile, 1);
          inFile := openZstdFile(inFile);
        else
          magicBytes &:= gets(inFile, length(XZ_MAGIC) - length(ZSTD_MAGIC));
          seek(inFile, 1);
          if magicBytes = XZ_MAGIC then
            inFile := openXzFile(inFile);
          elsif endsWith(inFileName, ".lzma") then
            inFile := openLzmaFile(inFile);
          elsif complainIfUncompressed then
            write("tar7: File \"");
            write(inFileName);
            writeln("\" not in gzip, xz, zstd or lzma format.");
          end if;
        end if;
      end if;
    end if;
  end func;


const func boolean: filePathIsInTarMemberList (in string: filePath,
    in array string: memberList) is func
  result
    var boolean: isInMemberList is TRUE;
  local
    var string: member is "";
  begin
    if length(memberList) <> 0 then
      isInMemberList := FALSE;
      for member range memberList until isInMemberList do
        if filePath = member or
            (startsWith(filePath, member) and filePath[succ(length(member))] = '/') then
          isInMemberList := TRUE;
        end if;
      end for;
    end if;
  end func;


(**
 *  List the files in the TAR achive ''inFile''.
 *  This function is used by the ''tar7'' program. In other application areas the
 *  [[tar]] file system might be more convenient.
 *   aFile := open("test.tar", "r");
 *   if aFile <> STD_NULL then
 *     tarTell(aFile, 0 times "", TRUE);
 *     ...
 *  @param inFile File in TAR format.
 *  @param memberList List of archive members that should be listed.
 *                    If ''memberList'' is empty all files in the archive are listed.
 *  @param doView TRUE show details of the files in the archive,
 *                FALSE only write the names of the files in the archive.
 *)
const proc: tarTell (inout file: inFile, in array string: memberList,
    in boolean: doView) is func
  local
    var tarHeader: header is tarHeader.value;
    var time: modTime is time.value;
  begin
    readHead(inFile, header);
    while not header.endOfFileMarker and
        header.chksumOkay and header.filePath <> "" and
        (header.magic = TAR_MAGIC or header.magic = TAR_NOMAGIC) do
      if filePathIsInTarMemberList(header.filePath, memberList) then
        if doView then
          case header.typeflag of
            when {REGTYPE, AREGTYPE}: write("-");
            when {SYMTYPE}:           write("l");
            when {CHRTYPE}:           write("c");
            when {BLKTYPE}:           write("b");
            when {DIRTYPE}:           write("d");
            when {FIFOTYPE}:          write("f");
            otherwise:                write("?");
          end case;
          write(fileMode(header.mode mod 8#1000));
          write(" ");
          if header.uname <> "" then
            write(header.uname);
          else
            write(header.uid);
          end if;
          write("/");
          if header.gname <> "" then
            write(header.gname);
          else
            write(header.gid);
          end if;
          write(header.fileSize lpad 14);
          write(" ");
          modTime := timestamp1970ToTime(header.mtime);
          write(strDate(modTime));
          write(" ");
          write(str_hh_mm(modTime, ":"));
          write(" ");
          # write(strTimeZone(modTime) rpad 12);
        end if;
        writeln(header.filePath <& header.filePathSuffix);
      end if;
      if header.fileSize <> 0 then
        seek(inFile, tell(inFile) + succ(pred(header.fileSize) mdiv TAR_BLOCK_SIZE) * TAR_BLOCK_SIZE);
      end if;
      readHead(inFile, header);
    end while;
    if not header.endOfFileMarker then
      if header.magic <> TAR_MAGIC and header.magic <> TAR_NOMAGIC then
        writeln("*** The magic number of a tar header is not okay");
      elsif not header.chksumOkay then
        writeln("*** The check-sum of a tar header is not okay");
      end if;
    end if;
  end func;


(**
 *  List files in the possibly compressed TAR achive named ''inFileName''.
 *  If the archive is compressed with GZIP, XZ, ZSTD or LZMA it is uncompressed.
 *  This function is used by the ''tar7'' program. In other application areas the
 *  [[tar]] file system might be more convenient.
 *   tarTell("test.tar", 0 times "", FALSE, FALSE);
 *   tarTell("test.tgz", 0 times "", FALSE, TRUE);
 *  @param inFileName Name of the TAR archive.
 *  @param memberList List of archive members that should be listed.
 *                    If ''memberList'' is empty all files in the archive are listed.
 *  @param doView TRUE show details of the files in the archive,
 *                FALSE only write the names of the files in the archive.
 *  @param complainIfUncompressed TRUE complain if the archive is not compressed,
 *                                FALSE silently accept an uncompressed archive.
 *)
const proc: tarTell (in string: inFileName, in array string: memberList,
    in boolean: doView, in boolean: complainIfUncompressed) is func
  local
    var file: inFile is STD_NULL;
  begin
    inFile := openTarFileWithMagic(inFileName, complainIfUncompressed);
    if inFile <> STD_NULL then
      tarTell(inFile, memberList, doView);
    else
      write("tar7: Cannot open \"");
      write(inFileName);
      writeln("\".");
    end if;
  end func;


(**
 *  Extract files from the TAR achive ''inFile''.
 *  This function is used by the ''tar7'' program. The function extracts files
 *  directly to the hard-disk respectively solid-state drive of the operating
 *  system. In other application areas the [[tar]] file system might be more
 *  convenient.
 *   aFile := open("test.tar", "r");
 *   if aFile <> STD_NULL then
 *     tarXtract(aFile, 0 times "", FALSE);
 *     ...
 *  @param inFile File in TAR format.
 *  @param memberList List of archive members that should be extracted.
 *                    If ''memberList'' is empty all files in the archive are extracted.
 *  @param doView TRUE write the names of the extracted files,
 *                FALSE extract quietly.
 *)
const proc: tarXtract (inout file: inFile, in array string: memberList,
    in boolean: doView) is func
  local
    var tarHeader: header is tarHeader.value;
    var file: aFile is STD_NULL;
    var integer: bytesCopied is 0;
    var time: modTime is time.value;
    var array tarHeader: dirHeaderList is 0 times tarHeader.value;
    var integer: index is 0;
    var boolean: okay is TRUE;
  begin
    readHead(inFile, header);
    while not header.endOfFileMarker and
        header.chksumOkay and header.filePath <> "" and
        (header.magic = TAR_MAGIC or header.magic = TAR_NOMAGIC) and okay do
      if filePathIsInTarMemberList(header.filePath, memberList) then
        if doView then
          write("x ");
          writeln(header.filePath <& header.filePathSuffix);
        end if;
        if header.typeflag = DIRTYPE then
          if fileTypeSL(header.filePath) = FILE_DIR then
            dirHeaderList &:= [] (header);
          elsif fileTypeSL(header.filePath) = FILE_ABSENT then
            makeParentDirs(header.filePath);
            makeDir(header.filePath);
            dirHeaderList &:= [] (header);
          else
            writeln("*** The file " <& literal(header.filePath) <& " exists, but is not a directory");
            okay := FALSE;
          end if;
        elsif header.typeflag = REGTYPE or header.typeflag = AREGTYPE then
          if fileTypeSL(header.filePath) = FILE_REGULAR then
            removeFile(header.filePath);
          end if;
          if fileTypeSL(header.filePath) = FILE_ABSENT then
            makeParentDirs(header.filePath);
            aFile  := open(header.filePath, "w");
            if aFile <> STD_NULL then
              bytesCopied := copyFile(inFile, aFile, header.fileSize);
              close(aFile);
              # Just take the permission bits of the file mode.
              setFileMode(header.filePath, fileMode(header.mode mod 8#1000));
              modTime := timestamp1970ToTime(header.mtime);
              setMTime(header.filePath, modTime);
              # Skip bytes up to header.fileSize and then up to a multiple of TAR_BLOCK_SIZE.
              skip(inFile, header.fileSize - bytesCopied +
                   pred(TAR_BLOCK_SIZE) - pred(header.fileSize) mod TAR_BLOCK_SIZE);
            else
              skip(inFile, succ(pred(header.fileSize) mdiv TAR_BLOCK_SIZE) * TAR_BLOCK_SIZE);
              writeln("*** Cannot create file " <& literal(header.filePath));
              okay := FALSE;
            end if;
          else
            skip(inFile, succ(pred(header.fileSize) mdiv TAR_BLOCK_SIZE) * TAR_BLOCK_SIZE);
            writeln("*** The file " <& literal(header.filePath) <& " exists, but is not a regular file");
            okay := FALSE;
          end if;
        elsif header.typeflag = SYMTYPE then
          if fileTypeSL(header.filePath) = FILE_SYMLINK then
            removeFile(header.filePath);
          end if;
          if fileTypeSL(header.filePath) = FILE_ABSENT then
            makeParentDirs(header.filePath);
            if succeeds(makeLink(header.filePath, header.linkPath)) then
              modTime := timestamp1970ToTime(header.mtime);
              setMTime(header.filePath, modTime, SYMLINK);
            else
              writeln("*** Cannot create symbolic link " <& literal(header.filePath));
              okay := FALSE;
            end if;
          else
            writeln("*** The file " <& literal(header.filePath) <& " exists, but is not a symbolic link");
            okay := FALSE;
          end if;
        else
          writeln("*** Cannot create " <& literal(header.filePath));
        end if;
      end if;
      readHead(inFile, header);
    end while;
    if not header.endOfFileMarker then
      if header.magic <> TAR_MAGIC and header.magic <> TAR_NOMAGIC then
        writeln("*** The magic number of a tar header is not okay");
      elsif not header.chksumOkay then
        writeln("*** The check-sum of a tar header is not okay");
      end if;
    end if;
    for index range length(dirHeaderList) downto 1 do
      # Just take the permission bits of the file mode.
      setFileMode(dirHeaderList[index].filePath, fileMode(dirHeaderList[index].mode mod 8#1000));
      modTime := timestamp1970ToTime(dirHeaderList[index].mtime);
      setMTime(dirHeaderList[index].filePath, modTime);
    end for;
  end func;


(**
 *  Extract files from the possibly compressed TAR achive named ''inFileName''.
 *  If the archive is compressed with GZIP, XZ, ZSTD or LZMA it is uncompressed.
 *  This function is used by the ''tar7'' program. The function extracts files
 *  directly to the hard-disk respectively solid-state drive of the operating
 *  system. In other application areas the [[tar]] file system might be more
 *  convenient.
 *   tarXtract("test.tar", 0 times "", FALSE, FALSE);
 *   tarXtract("test.tgz", 0 times "", FALSE, TRUE);
 *  @param inFileName Name of the TAR archive.
 *  @param memberList List of archive members that should be extracted.
 *                    If ''memberList'' is empty all files in the archive are extracted.
 *  @param doView TRUE write the names of the extracted files,
 *                FALSE extract quietly.
 *  @param complainIfUncompressed TRUE complain if the archive is not compressed,
 *                                FALSE silently accept an uncompressed archive.
 *)
const proc: tarXtract (in string: inFileName, in array string: memberList,
    in boolean: doView, in boolean: complainIfUncompressed) is func
  local
    var file: inFile is STD_NULL;
  begin
    inFile := openTarFileWithMagic(inFileName, complainIfUncompressed);
    if inFile <> STD_NULL then
      tarXtract(inFile, memberList, doView);
    else
      write("tar7: Cannot open \"");
      write(inFileName);
      writeln("\".");
    end if;
  end func;


(**
 *  Extract files from the possibly compressed TAR achive named ''inFileName''.
 *  If the archive is compressed with GZIP, XZ, ZSTD or LZMA it is uncompressed.
 *  This function extracts files directly to the hard-disk respectively
 *  solid-state drive of the operating system. In other application
 *  areas the [[tar]] file system might be more convenient.
 *   tarXtract("test.tar", TRUE);
 *   tarXtract("test.tgz", FALSE);
 *  @param inFileName Name of the TAR archive.
 *  @param doView TRUE write the names of the extracted files,
 *                FALSE extract quietly.
 *)
const proc: tarXtract (in string: inFileName, in boolean: doView) is func
  begin
    tarXtract(inFileName, 0 times "", doView, FALSE);
  end func;


(**
 *  Extract files from the possibly compressed TAR achive named ''inFileName''.
 *  If the archive is compressed with GZIP, XZ, ZSTD or LZMA it is uncompressed.
 *  This function extracts files directly to the hard-disk respectively
 *  solid-state drive of the operating system. In other application areas
 *  the [[tar]] file system might be more convenient.
 *   tarXtract("test.tar");
 *   tarXtract("test.tgz");
 *  @param inFileName Name of the TAR archive.
 *)
const proc: tarXtract (in string: inFileName) is func
  begin
    tarXtract(inFileName, 0 times "", FALSE, FALSE);
  end func;


(**
 *  Write a TAR archive to ''outFile'' with the files listed in ''fileList''.
 *  This function is used by the ''tar7'' program. The function copies files
 *  from the hard-disk respectively solid-state drive of the operating system.
 *  In other application areas the [[tar]] file system might be more convenient.
 *   aFile := open("test.tar", "w");
 *   if aFile <> STD_NULL then
 *     tarCreate(aFile, "", "", [] ("test_dir"), FALSE);
 *     ...
 *     write(aFile, END_OF_FILE_MARKER mult 2);
 *     close(aFile);
 *  @param outFile Destination for the crated TAR file.
 *  @param basePath Base path for all files to be processed.
 *  @param pathFromBase Path from ''basePath'' for the files in ''fileList''.
 *  @param fileList List of file paths to be put into the created tar archive.
 *  @param doView TRUE write the names of the processed files,
 *                FALSE work quietly.
 *)
const proc: tarCreate (inout file: outFile, in string: basePath, in string: pathFromBase,
    in array string: fileList, in boolean: doView) is func
  local
    var string: name is "";
    var array string: dirContent is 0 times "";
    var file: aFile is STD_NULL;
    var integer: bytesCopied is 0;
    var tarHeader: header is tarHeader.value;
  begin
    for name range fileList do
      name := pathFromBase & name;
      if fileType(basePath & name) = FILE_ABSENT then
        writeln("*** The file " <& literal(basePath & name) <& " does not exist.");
      else
        if doView then
          write("c ");
          writeln(name);
        end if;
        if fileType(basePath & name) = FILE_DIR then
          dirContent := readDir(basePath & name);
          setUpHead(basePath, name, "/", header);
          header.typeflag := DIRTYPE;
          writeHead(outFile, header);
          tarCreate(outFile, basePath, name & "/", dirContent, doView);
        else
          setUpHead(basePath, name, "", header);
          aFile := open(basePath & name, "r");
          if aFile <> STD_NULL then
            header.fileSize := length(aFile);
            writeHead(outFile, header);
            bytesCopied := copyFile(aFile, outFile, header.fileSize);
            # Fill with '\0;' up to header.fileSize and then up to a multiple of TAR_BLOCK_SIZE.
            write(outFile, "\0;" mult header.fileSize - bytesCopied +
                  pred(TAR_BLOCK_SIZE) - pred(header.fileSize) mod TAR_BLOCK_SIZE);
            close(aFile);
          else
            writeHead(outFile, header);
          end if;
        end if;
      end if;
    end for;
  end func;


(**
 *  Create the TAR file ''outFileName'' with the files listed in ''fileList''.
 *  This function is used by the ''tar7'' program. The function copies files
 *  from the hard-disk respectively solid-state drive of the operating system.
 *  In other application areas the [[tar]] file system might be more convenient.
 *   tarCreate("test.tar", [] ("test_file1", "test_file2"), FALSE, FALSE);
 *   tarCreate("test.tgz", [] ("test_file1", "test_file2"), FALSE, TRUE);
 *  @param outFileName Name of the TAR archive to be created.
 *  @param fileList List of file paths to be put into the created tar archive.
 *  @param doView TRUE to log a line for every processed file,
 *                FALSE if nothing should be logged.
 *  @param doZip  TRUE if the TAR archive should be compressed with ZIP,
 *                FALSE if the TAR achive should be uncompressed.
 *)
const proc: tarCreate (in string: outFileName, in array string: fileList,
    in boolean: doView, in boolean: doZip) is func
  local
    var file: outFile is STD_NULL;
    var file: compressedFile is STD_NULL;
    var string: name is "";
    var string: uncompressed is "";
  begin
    outFile := open(outFileName, "w");
    if outFile <> STD_NULL and doZip then
      compressedFile := outFile;
      outFile := openGzipFile(compressedFile, WRITE);
    end if;
    if outFile <> STD_NULL then
      for name range fileList do
        tarCreate(outFile, "", "", [] name, doView);
      end for;
      write(outFile, END_OF_FILE_MARKER mult 2);
      close(outFile);
    end if;
    if compressedFile <> STD_NULL then
      close(compressedFile);
    end if;
  end func;


(**
 *  Create the TAR file ''outFileName'' with the files listed in ''fileList''.
 *  This function copies files from the hard-disk respectively solid-state drive
 *  of the operating system. In other application areas the [[tar]] file system
 *  might be more convenient.
 *   tarCreate("test.tar", [] ("test_file1", "test_file2"), TRUE);
 *  @param outFileName Name of the TAR archive to be created.
 *  @param fileList List of file paths to be put into the created tar archive.
 *  @param doView TRUE to log a line for every processed file,
 *                FALSE if nothing should be logged.
 *)
const proc: tarCreate (in string: outFileName, in array string: fileList,
    in boolean: doView) is func
  begin
    tarCreate(outFileName, fileList, doView, FALSE);
  end func;


(**
 *  Create the TAR file ''outFileName'' with the files listed in ''fileList''.
 *  This function copies files from the hard-disk respectively solid-state drive
 *  of the operating system. In other application areas the [[tar]] file system
 *  might be more convenient.
 *   tarCreate("test.tar", [] ("test_file1", "test_file2"));
 *  @param outFileName Name of the TAR archive to be created.
 *  @param fileList List of file paths to be put into the created tar archive.
 *)
const proc: tarCreate (in string: outFileName, in array string: fileList) is func
  begin
    tarCreate(outFileName, fileList, FALSE, FALSE);
  end func;