texlive[62426] Master: install-tl: if df is available, check for free

[commits+preining at tug.org]

Revision: 62426
          http://tug.org/svn/texlive?view=revision&revision=62426
Author:   preining
Date:     2022-03-05 06:38:53 +0100 (Sat, 05 Mar 2022)
Log Message:
-----------
install-tl: if df is available, check for free disk space

Modified Paths:
--------------
    trunk/Master/install-tl
    trunk/Master/tlpkg/TeXLive/TLUtils.pm

Modified: trunk/Master/install-tl
===================================================================
--- trunk/Master/install-tl	2022-03-05 02:28:25 UTC (rev 62425)
+++ trunk/Master/install-tl	2022-03-05 05:38:53 UTC (rev 62426)
@@ -937,6 +937,37 @@
   if (win32()) {
     TeXLive::TLWinGoo::maybe_make_ro ($vars{'TEXDIR'});
   }
+  # If df is available, check for free disk space
+  if ($::progs{"df"}) {
+    # To ensure that GNU coreutil df returns POSIX style 512-blocks,
+    # it is necessary to set POSIXLY_CORRECT=1
+    # (GNU df defaults to 1024-block)
+    # https://en.wikipedia.org/wiki/POSIX#512-_vs_1024-byte_blocks
+    my $td = $vars{'TEXDIR'};
+    $td .= "/" if ($td !~ m!/$!);
+    debug("Checking for free diskspace in $td\n");
+    my ($output, $retval) =
+      TeXLive::TLUtils::run_cmd("df -P \"$vars{'TEXDIR'}\"",
+                                POSIXLY_CORRECT => 1);
+    if ($retval == 0) {
+      # Output format should be this:
+      # Filesystem      512-blocks       Used  Available Capacity Mounted on
+      # /dev/sdb3       6099908248 3590818104 2406881416      60% /home
+      my ($h,$l) = split(/\n/, $output);
+      my ($fs, $nrb, $used, $avail, @rest) = split(' ', $l);
+      debug("disk space: used=$used (512-block), avail=$avail (512-block),",
+            " required=$vars{'total_size'} (Mb)\n");
+      # $vars{'total_size'} is number required in Mb (1024**2)
+      # $vars{'total_size'} =
+      #   sprintf "%d", ($size * $TeXLive::TLConfig::BlockSize)/1024**2;
+      # $avail is in 512 blocks, so we need to device by 2 * 1024 to obtain Mb
+      # require that at least 100M remain free
+      my $reserve = 100;
+      if ( $avail / 2024 + $reserve < $vars{'total_size'}) {
+        die("DISK SPACE INSUFFICIENT!");
+      }
+    }
+  }
   # now remove final slash from TEXDIR even if it is the root of a drive
   $vars{'TEXDIR'} =~ s!/$!!;
   # do the actual installation

Modified: trunk/Master/tlpkg/TeXLive/TLUtils.pm
===================================================================
--- trunk/Master/tlpkg/TeXLive/TLUtils.pm	2022-03-05 02:28:25 UTC (rev 62425)
+++ trunk/Master/tlpkg/TeXLive/TLUtils.pm	2022-03-05 05:38:53 UTC (rev 62426)
@@ -40,7 +40,7 @@
   TeXLive::TLUtils::xchdir($dir);
   TeXLive::TLUtils::wsystem($msg, at args);
   TeXLive::TLUtils::xsystem(@args);
-  TeXLive::TLUtils::run_cmd($cmd);
+  TeXLive::TLUtils::run_cmd($cmd [, @envvars ]);
   TeXLive::TLUtils::system_pipe($prog, $infile, $outfile, $removeIn, @args);
 
 =head2 File utilities
@@ -731,16 +731,35 @@
   return $retval;
 }
 
-=item C<run_cmd($cmd)>
+=item C<run_cmd($cmd, @envvars)>
 
 Run shell command C<$cmd> and captures its output. Returns a list with CMD's
 output as the first element and the return value (exit code) as second.
 
+The C<@envvars> - if given - are variable name / value pairs set for the call
+and reset to their original value (or unset if not defined initially).
+
 =cut
 
 sub run_cmd {
   my $cmd = shift;
+  my %envvars = @_;
+  my %envvarsSetState;
+  my %envvarsValue;
+  for my $k (keys %envvars) {
+    $envvarsSetState{$k} = exists $ENV{$k};
+    $envvarsValue{$k} = $ENV{$k};
+    $ENV{$k} = $envvars{$k};
+  }
   my $output = `$cmd`;
+  for my $k (keys %envvars) {
+    if ($envvarsSetState{$k}) {
+      $ENV{$k} = $envvarsValue{$k};
+    } else {
+      delete $ENV{$k};
+    }
+  }
+
   $output = "" if ! defined ($output);  # don't return undef
 
   my $retval = $?;
@@ -2616,6 +2635,8 @@
     # tar needs to be provided by the system, we not even check!
     $::progs{'tar'} = "tar";
 
+    setup_one("unix", "df", undef, "-P", 0);
+
     if (!defined($platform) || ($platform eq "")) {
       # we assume that we run from uncompressed media, so we can call
       # platform() and thus also the config.guess script but we have to
@@ -2793,6 +2814,10 @@
 #   . if the copy is -x and executable, use it
 sub setup_unix_tl_one {
   my ($p, $def, $arg) = @_;
+  if (!$def) {
+    debug("(unix) no default program for $p, no setup done\n");
+    return(1);
+  }
   our $tmp;
   debug("(unix) trying to set up $p, default $def, arg $arg\n");
   if (-r $def) {