#!/usr/bin/env perl

# Copyright (c) 2025, R. W. Rodolico
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# 1. Redistributions of source code must retain the above copyright notice, this
#    list of conditions and the following disclaimer.
#
# 2. Redistributions in binary form must reproduce the above copyright notice,
#    this list of conditions and the following disclaimer in the documentation
#    and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
# DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

# installer_shared.pm
# Shared helper routines for stage-3 installer/update scripts.
#
# Revision History:
# 2026-10-13 Copilot v1.0.0 r? initial shared installer helper module
# 2026-10-13 Copilot v1.0.1 list-form fetch helper for setup/update URL handling
# 2026-10-14 Claude v1.0.2 runCommandList: a missing command returns 127 without a Perl "Can't exec" warning, and
#            an optional quiet flag discards the child's output; tryFetch no longer lets curl print its errors
# 2026-10-18 Claude v1.0.3 loadInstallerConfig returns %transportDependencies (bug 209)
# 2026-10-27 Claude v1.1.0 teeOutputToLog: copies STDOUT and STDERR to a log file in /tmp

package installer_shared;

use strict;
use warnings;

use version;
our $VERSION = version->declare('v1.1.0');

use Exporter 'import';
our @EXPORT_OK = qw(
   getRootPrefix
   rootPath
   ensureDir
   writeTextFile
   readTextFile
   appendLog
   runCommandList
   commandExists
   copyTree
   removeTreeIfExists
   movePath
   slurpCommand
   tryFetch
   loadInstallerConfig
   nowStamp
   teeOutputToLog
);

use File::Path qw(make_path remove_tree);
use File::Copy qw(copy move);
use File::Basename qw(dirname);
use File::Find;

#######################################################
#
# nowStamp()
#
# Returns local timestamp in YYYY-MM-DD HH:MM:SS format.
#
# Parameters:
#   none
#
# Returns:
#   scalar timestamp
#
# Side Effects:
#   none
#
#######################################################
sub nowStamp {
   my ($sec, $min, $hour, $mday, $mon, $year) = localtime(time);
   return sprintf('%04d-%02d-%02d %02d:%02d:%02d', $year + 1900, $mon + 1, $mday, $hour, $min, $sec);
}

#######################################################
#
# getRootPrefix( $override )
#
# Returns the root prefix used for testable filesystem
# path overrides.
#
# Parameters:
#   $override - optional explicit root path
#
# Returns:
#   scalar root prefix or empty string
#
# Side Effects:
#   none
#
#######################################################
sub getRootPrefix {
   my $override = shift;
   return $override if defined($override) && $override ne '';
   return $ENV{'SYSINFO_ROOT'} // '';
}

#######################################################
#
# rootPath( $root, $path )
#
# Applies a root prefix to an absolute path.
#
# Parameters:
#   $root - root prefix
#   $path - absolute target path
#
# Returns:
#   scalar rooted path
#
# Side Effects:
#   none
#
#######################################################
sub rootPath {
   my ($root, $path) = @_;
   return $path unless defined($path) && $path ne '';
   return $path unless defined($root) && $root ne '';
   return $path unless $path =~ m{^/};
   return $root . $path;
}

#######################################################
#
# ensureDir( $path, $dryRun )
#
# Ensures one directory exists.
#
# Parameters:
#   $path   - directory path
#   $dryRun - boolean dry-run flag
#
# Returns:
#   boolean success
#
# Side Effects:
#   creates directories
#
#######################################################
sub ensureDir {
   my ($path, $dryRun) = @_;
   return 1 if -d $path;
   return 1 if $dryRun;
   make_path($path);
   return -d $path ? 1 : 0;
}

#######################################################
#
# writeTextFile( $path, $text, $dryRun )
#
# Writes text to a file, creating parent dirs.
#
# Parameters:
#   $path   - file path
#   $text   - file content
#   $dryRun - boolean dry-run flag
#
# Returns:
#   boolean success
#
# Side Effects:
#   writes file content
#
#######################################################
sub writeTextFile {
   my ($path, $text, $dryRun) = @_;
   return 1 if $dryRun;
   my $parent = dirname($path);
   make_path($parent) unless -d $parent;
   open my $fh, '>', $path or return 0;
   print {$fh} $text;
   close($fh);
   return 1;
}

#######################################################
#
# readTextFile( $path )
#
# Reads one text file into a scalar.
#
# Parameters:
#   $path - file path
#
# Returns:
#   scalar content (empty on failure)
#
# Side Effects:
#   none
#
#######################################################
sub readTextFile {
   my $path = shift;
   return '' unless defined($path) && -f $path;
   open my $fh, '<', $path or return '';
   my $text = do { local $/; <$fh> };
   close($fh);
   return defined($text) ? $text : '';
}

#######################################################
#
# appendLog( $path, $message, $dryRun )
#
# Appends one timestamped line to log file.
#
# Parameters:
#   $path    - log file path
#   $message - message text
#   $dryRun  - boolean dry-run flag
#
# Returns:
#   boolean success
#
# Side Effects:
#   appends log file content
#
#######################################################
sub appendLog {
   my ($path, $message, $dryRun) = @_;
   return 1 if $dryRun;
   my $parent = dirname($path);
   make_path($parent) unless -d $parent;
   open my $fh, '>>', $path or return 0;
   print {$fh} nowStamp() . "\t" . $message . "\n";
   close($fh);
   return 1;
}

#######################################################
#
# teeOutputToLog( $path )
#
# Copies everything this process and its children write to STDOUT or STDERR
# into a log file, while still showing it on the terminal. The file is
# appended to, created 0600, and not opened if the path is a symlink.
# Calling it a second time (or after exec of a restarted setup) does nothing
# because SYSINFO_INSTALL_LOG records that logging is already on.
#
# Parameters:
#   $path - log file path
#
# Returns:
#   1 when output is being logged, 0 when it could not be set up
#
# Side Effects:
#   forks a small copier process; reopens STDOUT and STDERR; sets
#   SYSINFO_INSTALL_LOG; writes the log file
#
#######################################################
my $teePipe;

sub teeOutputToLog {
   my $path = shift;
   return 1 if $ENV{'SYSINFO_INSTALL_LOG'};
   return 0 unless defined($path) && $path ne '';

   require Fcntl;
   my $log;
   sysopen($log, $path, Fcntl::O_WRONLY() | Fcntl::O_APPEND() | Fcntl::O_CREAT() | Fcntl::O_NOFOLLOW(), 0600) or return 0;

   open(my $realOut, '>&', \*STDOUT) or return 0;
   my $pid = open($teePipe, '|-');
   return 0 unless defined($pid);

   if ($pid == 0) {
      # copier: read the merged output, write it to the terminal and the log
      my $oldFh = select($realOut); $| = 1; select($log); $| = 1; select($oldFh);
      while (my $line = <STDIN>) {
         print {$realOut} $line;
         print {$log} $line;
      }
      require POSIX;
      POSIX::_exit(0);
   }

   close($log);
   close($realOut);
   open(STDOUT, '>&', $teePipe) or return 0;
   open(STDERR, '>&', $teePipe) or return 0;
   my $oldFh = select(STDOUT); $| = 1; select(STDERR); $| = 1; select($oldFh);
   $ENV{'SYSINFO_INSTALL_LOG'} = $path;
   return 1;
}

# the copier only ends when every write end of the pipe is closed, so close ours and wait for it
END {
   if ($teePipe) {
      my $status = $?;
      close(STDOUT);
      close(STDERR);
      close($teePipe);
      $? = $status;
   }
}

#######################################################
#
# runCommandList( $argv, $dryRun, $quiet )
#
# Executes one command in list form. A command that is not installed
# is not run and returns 127, so Perl does not print "Can't exec".
#
# Parameters:
#   $argv   - array reference command argv
#   $dryRun - boolean dry-run flag
#   $quiet  - optional; true discards the command's STDOUT and STDERR
#
# Returns:
#   integer exit status (0 on success, 127 when the command is not found)
#
# Side Effects:
#   runs subprocess
#
#######################################################
sub runCommandList {
   my ($argv, $dryRun, $quiet) = @_;
   return 0 if $dryRun;
   return 2 unless ref($argv) eq 'ARRAY' && @{$argv};

   # look the command up first: system() on a missing command warns on STDERR
   my $name = $argv->[0];
   my $found = 0;
   if ($name =~ m{/}) {
      $found = (-f $name && -x _) ? 1 : 0;
   } else {
      $found = commandExists($name);
   }
   return 127 unless $found;

   my $status;
   if ($quiet) {
      open(my $savedOut, '>&', \*STDOUT);
      open(my $savedErr, '>&', \*STDERR);
      open(STDOUT, '>', '/dev/null');
      open(STDERR, '>', '/dev/null');
      $status = system(@{$argv});
      open(STDOUT, '>&', $savedOut);
      open(STDERR, '>&', $savedErr);
      close($savedOut);
      close($savedErr);
   } else {
      $status = system(@{$argv});
   }
   return 2 if $status == -1;
   return ($status >> 8);
}

#######################################################
#
# commandExists( $name )
#
# Checks if one command exists in PATH.
#
# Parameters:
#   $name - command name
#
# Returns:
#   boolean
#
# Side Effects:
#   none
#
#######################################################
sub commandExists {
   my $name = shift;
   return 0 unless defined($name) && $name ne '';
   foreach my $dir (split(':', $ENV{'PATH'} // '')) {
      next if $dir eq '';
      my $path = $dir . '/' . $name;
      return 1 if -x $path && !-d $path;
   }
   return 0;
}

#######################################################
#
# removeTreeIfExists( $path, $dryRun )
#
# Removes file/symlink/directory if present.
#
# Parameters:
#   $path   - path to remove
#   $dryRun - boolean dry-run flag
#
# Returns:
#   boolean success
#
# Side Effects:
#   removes filesystem paths
#
#######################################################
sub removeTreeIfExists {
   my ($path, $dryRun) = @_;
   return 1 unless -e $path || -l $path;
   return 1 if $dryRun;
   if (-l $path || -f $path) {
      unlink($path) or return 0;
      return 1;
   }
   remove_tree($path);
   return !(-e $path || -l $path) ? 1 : 0;
}

#######################################################
#
# movePath( $from, $to, $dryRun )
#
# Renames one path.
#
# Parameters:
#   $from   - source path
#   $to     - destination path
#   $dryRun - boolean dry-run flag
#
# Returns:
#   boolean success
#
# Side Effects:
#   moves filesystem path
#
#######################################################
sub movePath {
   my ($from, $to, $dryRun) = @_;
   return 1 if $dryRun;
   return move($from, $to) ? 1 : 0;
}

#######################################################
#
# copyTree( $src, $dst, $dryRun )
#
# Recursively copies one directory tree.
#
# Parameters:
#   $src    - source directory
#   $dst    - destination directory
#   $dryRun - boolean dry-run flag
#
# Returns:
#   boolean success
#
# Side Effects:
#   creates directories and copies files
#
#######################################################
sub copyTree {
   my ($src, $dst, $dryRun) = @_;
   return 0 unless -d $src;
   return 1 if $dryRun;

   my $ok = 1;

   find(
      {
         'wanted' => sub {
            return unless $ok;
            my $path = $File::Find::name;
            my $rel = $path;
            $rel =~ s/^\Q$src\E\/?//;
            my $target = $rel eq '' ? $dst : $dst . '/' . $rel;

            if (-d $path) {
               if (!-d $target) {
                  eval { make_path($target); 1 } or do { $ok = 0; return; };
               }
               return;
            }

            return if -p $path;
            if (-l $path) {
               my $linkTarget = readlink($path);
               unlink($target) if -l $target || -f $target;
               if (!symlink($linkTarget, $target)) {
                  $ok = 0;
               }
               return;
            }

            my $parent = dirname($target);
            if (!-d $parent) {
               eval { make_path($parent); 1 } or do { $ok = 0; return; };
            }
            if (!copy($path, $target)) {
               $ok = 0;
               return;
            }
            my $mode = (stat($path))[2];
            if (defined($mode)) {
               chmod($mode & 07777, $target) or $ok = 0;
            }
         },
         'no_chdir' => 1,
      },
      $src,
   );

   return ($ok && -d $dst) ? 1 : 0;
}

#######################################################
#
# slurpCommand( $argv )
#
# Runs command and captures STDOUT text.
#
# Parameters:
#   $argv - array reference command argv
#
# Returns:
#   scalar command output text
#
# Side Effects:
#   runs subprocess
#
#######################################################
sub slurpCommand {
   my $argv = shift;
   return '' unless ref($argv) eq 'ARRAY' && @{$argv};
   open my $fh, '-|', @{$argv} or return '';
   my $text = do { local $/; <$fh> };
   close($fh);
   return defined($text) ? $text : '';
}

#######################################################
#
# tryFetch( $url, $dst, $dryRun )
#
# Fetches one URL to a destination path using available
# system fetch tools.
#
# Parameters:
#   $url    - source URL
#   $dst    - destination file path
#   $dryRun - optional boolean dry-run flag
#
# Returns:
#   boolean success
#
# Side Effects:
#   runs network fetch tools and writes destination file
#
#######################################################
sub tryFetch {
   my ($url, $dst, $dryRun) = @_;
   return 0 if !defined($url) || $url eq '';
   return 0 if $dryRun;

   my @commands = (
      ['/usr/local/bin/fetch', '-q', '-o', $dst, $url],
      ['/usr/bin/fetch', '-q', '-o', $dst, $url],
      ['/usr/bin/curl', '-fsL', '-o', $dst, $url],
      ['/usr/local/bin/curl', '-fsL', '-o', $dst, $url],
      ['/usr/bin/wget', '-q', '-O', $dst, $url],
      ['/usr/local/bin/wget', '-q', '-O', $dst, $url],
   );

   foreach my $cmd (@commands) {
      my $bin = $cmd->[0];
      next unless -x $bin;
      my $rc = runCommandList($cmd, 0);
      return 1 if $rc == 0 && -f $dst;
   }

   return 0;
}

#######################################################
#
# loadInstallerConfig( $path )
#
# Loads installer_config.pl and returns hash references.
#
# Parameters:
#   $path - installer config path
#
# Returns:
#   hash reference with config hashes
#
# Side Effects:
#   executes installer config file
#
#######################################################
sub loadInstallerConfig {
   my $path = shift;
   our (%operatingSystems, %requiredDependencies, %transportDependencies, %optionalDependencies);
   do $path;
   return {
      'operatingSystems' => \%operatingSystems,
      'requiredDependencies' => \%requiredDependencies,
      'transportDependencies' => \%transportDependencies,
      'optionalDependencies' => \%optionalDependencies,
   };
}

1;