texlive[53204] Master/tlpkg: TLUtils.pm (texdir_check): return

commits+karl at tug.org commits+karl at tug.org
Sun Dec 22 00:18:20 CET 2019


Revision: 53204
          http://tug.org/svn/texlive?view=revision&revision=53204
Author:   karl
Date:     2019-12-22 00:18:19 +0100 (Sun, 22 Dec 2019)
Log Message:
-----------
TLUtils.pm (texdir_check): return failure if given $texdir contains
  various characters special to kpathsea expansion, such as ,$:{};{}\
  If passed new optional second argument, print a message saying so.
install-menu-text.pl (directories_menu, main_menu): pass the second
  argument to texdir_check.
TLPOBJ.pm, TeXCatalogue.pm: doc updates.
tl-try-install: accept -p and -r for profile and repo;
  also check $profiledir/$profile.pro for convenience.
TLcomma.pro: new test profile (fails, as expected).

This is in response to a query from Victor Kong on the tex-live list:
https://tug.org/pipermail/tex-live/2019-December/044586.html

Modified Paths:
--------------
    trunk/Master/tlpkg/TeXLive/TLPOBJ.pm
    trunk/Master/tlpkg/TeXLive/TLUtils.pm
    trunk/Master/tlpkg/TeXLive/TeXCatalogue.pm
    trunk/Master/tlpkg/bin/tl-try-install
    trunk/Master/tlpkg/installer/install-menu-text.pl

Added Paths:
-----------
    trunk/Master/tlpkg/dev/profiles/TLcomma.pro

Modified: trunk/Master/tlpkg/TeXLive/TLPOBJ.pm
===================================================================
--- trunk/Master/tlpkg/TeXLive/TLPOBJ.pm	2019-12-21 22:40:04 UTC (rev 53203)
+++ trunk/Master/tlpkg/TeXLive/TLPOBJ.pm	2019-12-21 23:18:19 UTC (rev 53204)
@@ -796,7 +796,7 @@
   rmdir($InfraLocation) if $removetlpkgdir;
   xchdir($cwd);
 
-  debug(" done $containername, size $size, $checksum\n");
+  debug(" done $containername, size $size, csum $checksum\n");
   return ($size, $checksum, "$destdir/$containername");
 }
 
@@ -1517,8 +1517,7 @@
 
 =item C<srcfiles>, C<runfiles>, C<binfiles>, C<docfiles>
 each of these items contains addition the sum of sizes of the single
-files (in number of C<TeXLive::TLConfig::BlockSize> blocks,currently
-4k).
+files (in units of C<TeXLive::TLConfig::BlockSize> blocks, currently 4k).
 
   srcfiles size=NNNNNN
   runfiles size=NNNNNN
@@ -1531,7 +1530,7 @@
   docfiles size=NNNNNN
 
 But the lines listing the files are allowed to have additional tags,
-which come from the TeX Catalogue.
+(which in practice come from the TeX Catalogue)
 
   /------- excerpt from achemso.tlpobj
   |...
@@ -1846,7 +1845,7 @@
 =head1 SEE ALSO
 
 The other modules in C<Master/tlpkg/TeXLive/> (L<TeXLive::TLConfig> and
-the rest), and the scripts in C<Master/tlpg/bin/> (especially
+the rest), and the scripts in C<Master/tlpkg/bin/> (especially
 C<tl-update-tlpdb>), the documentation in C<Master/tlpkg/doc/>, etc.
 
 =head1 AUTHORS AND COPYRIGHT

Modified: trunk/Master/tlpkg/TeXLive/TLUtils.pm
===================================================================
--- trunk/Master/tlpkg/TeXLive/TLUtils.pm	2019-12-21 22:40:04 UTC (rev 53203)
+++ trunk/Master/tlpkg/TeXLive/TLUtils.pm	2019-12-21 23:18:19 UTC (rev 53204)
@@ -831,7 +831,7 @@
 
 Tests whether its argument is writable by trying to write to
 it. This function is necessary because the built-in C<-w> test just
-looks at mode and uid/guid, which on Windows always returns true and
+looks at mode and uid/gid, which on Windows always returns true and
 even on Unix is not always good enough for directories mounted from
 a fileserver.
 
@@ -1318,6 +1318,7 @@
 
       my $item = "$d/$dirent";  # prepend directory for comparison
       if (! exists $seen{$item}) {
+        ddebug("   no collapse of $d because of: $dirent\n");
         $ok_to_collapse = 0;
         last;  # no need to keep looking after the first.
       }
@@ -3662,38 +3663,67 @@
 
 =item C<texdir_check($texdir)>
 
-Test whether installation with TEXDIR set to $texdir would succeed due to
-writing permissions.
+Test whether installation with TEXDIR set to $texdir should be ok, e.g.,
+would be a creatable directory. Return 1 if ok, 0 if not.
 
 Writable or not, we will not allow installation to the root
 directory (Unix) or the root of a drive (Windows).
 
+We also do not allow paths containing various special characters, and
+print a message about this if second argument WARN is true. (We only
+want to do this for the regular text installer, since spewing output in
+a GUI program wouldn't be good; the generic message will have to do for
+them.)
+
 =cut
 
 sub texdir_check {
-  my $texdir = shift;
-  return 0 unless defined $texdir;
+  my ($orig_texdir,$warn) = @_;
+  return 0 unless defined $orig_texdir;
+
   # convert to absolute, for safer parsing.
+  # also replaces backslashes with slashes on w32.
   # The return value may still contain symlinks,
   # but no unnecessary terminating '/'.
-  $texdir = tl_abs_path($texdir);
+  my $texdir = tl_abs_path($orig_texdir);
   return 0 unless defined $texdir;
-  # also reject the root of a drive,
+
+  # reject the root of a drive,
   # assuming that only the canonical form of the root ends with /
   return 0 if $texdir =~ m!/$!;
-  # win32: for now, reject the root of a samba share
+
+  # Unfortunately we have lots of special characters.
+  # On Windows, backslashes are normal but will already have been changed
+  # to slashes by tl_abs_path. And we should only check for : on Unix.
+  my $colon = win32() ? "" : ":";
+  if ($texdir =~ /[,$colon;\\{}\$]/) {
+    if ($warn) {
+      print "     !! TEXDIR value has problematic characters: $orig_texdir\n";
+      print "     !! (such as comma, colon, semicolon, backslash, braces\n";
+      print "     !!  and dollar sign; sorry)\n";
+    }
+    # although we could check each character individually and give a
+    # specific error, it seems plausibly useful to report all the chars
+    # that cause problems, regardless of which was there. Simpler too.
+    return 0;
+  }
+  # w32: for now, reject the root of a samba share
   return 0 if win32() && $texdir =~ m!^//[^/]+/[^/]+$!;
-  my $texdirparent;
-  my $texdirpparent;
 
+  # if texdir already exists, make sure we can write into it.
   return dir_writable($texdir) if (-d $texdir);
-  ($texdirparent = $texdir) =~ s!/[^/]*$!!;
+
+  # if texdir doesn't exist, make sure we can write the parent.
+  (my $texdirparent = $texdir) =~ s!/[^/]*$!!;
   #print STDERR "Checking $texdirparent".'[/]'."\n";
-  return  dir_creatable($texdirparent) if -d dir_slash($texdirparent);
-  # try another level up the tree
-  ($texdirpparent = $texdirparent) =~ s!/[^/]*$!!;
+  return dir_creatable($texdirparent) if -d dir_slash($texdirparent);
+  
+  # ditto for the next level up the tree
+  (my $texdirpparent = $texdirparent) =~ s!/[^/]*$!!;
   #print STDERR "Checking $texdirpparent".'[/]'."\n";
   return dir_creatable($texdirpparent) if -d dir_slash($texdirpparent);
+  
+  # doesn't look plausible.
   return 0;
 }
 
@@ -4663,12 +4693,8 @@
   my $ret = "[" . join(",", map { encode_json(\$_) } @$hr) . "]";
   return($ret);
 }
-
-
-
 =back
 =cut
-
 1;
 __END__
 

Modified: trunk/Master/tlpkg/TeXLive/TeXCatalogue.pm
===================================================================
--- trunk/Master/tlpkg/TeXLive/TeXCatalogue.pm	2019-12-21 22:40:04 UTC (rev 53203)
+++ trunk/Master/tlpkg/TeXLive/TeXCatalogue.pm	2019-12-21 23:18:19 UTC (rev 53204)
@@ -324,7 +324,7 @@
 =head1 SEE ALSO
 
 The other modules in C<Master/tlpkg/TeXLive/> (L<TeXLive::TLConfig> and
-the rest), and the scripts in C<Master/tlpg/bin/> (especially
+the rest), and the scripts in C<Master/tlpkg/bin/> (especially
 C<tl-update-tlpdb>), the documentation in C<Master/tlpkg/doc/>, etc.
 
 =head1 AUTHORS AND COPYRIGHT

Modified: trunk/Master/tlpkg/bin/tl-try-install
===================================================================
--- trunk/Master/tlpkg/bin/tl-try-install	2019-12-21 22:40:04 UTC (rev 53203)
+++ trunk/Master/tlpkg/bin/tl-try-install	2019-12-21 23:18:19 UTC (rev 53204)
@@ -22,10 +22,10 @@
 
 while test $# -gt 0; do
   case $1 in
-  --profile) shift; profile=$1;;
-  --repo)    shift; repo=$1;;
-  --help)    echo "ustl. sorry."; exit 0;;
-  --version) echo "$vc_id"; exit 0;;
+  -p|--profile) shift; profile=$1;;
+  -r|--repo)    shift; repo=$1;;
+  --help)       echo "ustl. sorry."; exit 0;;
+  --version)    echo "$vc_id"; exit 0;;
   *) echo "$0: unrecognized option \`$1'." >&2
      exit 1;;
   esac
@@ -36,6 +36,8 @@
   # convenience silliness
   if test -f "$profiledir/$profile"; then
     profile=$profiledir/$profile
+  elif test -f "$profiledir/$profile.pro"; then
+    profile=$profiledir/$profile.pro
   elif test -f "$profiledir/TL$profile"; then
     profile=$profiledir/TL$profile
   elif test -f "$profiledir/TL$profile.pro"; then

Added: trunk/Master/tlpkg/dev/profiles/TLcomma.pro
===================================================================
--- trunk/Master/tlpkg/dev/profiles/TLcomma.pro	                        (rev 0)
+++ trunk/Master/tlpkg/dev/profiles/TLcomma.pro	2019-12-21 23:18:19 UTC (rev 53204)
@@ -0,0 +1,15 @@
+# $Id$
+# This profile does not create a working installation, because of the
+# comma in TEXDIR. See TLUtils::texdir_check for other special characters.
+selected_scheme scheme-infraonly
+TEXDIR /tmp/ki,c
+TEXMFHOME /tmp/ki,c/user/home
+TEXMFLOCAL /tmp/ki,c/texmf-local
+TEXMFSYSCONFIG /tmp/ki,c/texmf-config
+TEXMFSYSVAR /tmp/ki,c/texmf-var
+TEXMFCONFIG /tmp/ki,c/user/config
+TEXMFVAR /tmp/ki,c/user/var
+option_doc 0
+option_fmt 0
+option_src 0
+option_adjustrepo 0


Property changes on: trunk/Master/tlpkg/dev/profiles/TLcomma.pro
___________________________________________________________________
Added: svn:eol-style
## -0,0 +1 ##
+native
\ No newline at end of property
Added: svn:keywords
## -0,0 +1 ##
+Date Author Id Revision
\ No newline at end of property
Modified: trunk/Master/tlpkg/installer/install-menu-text.pl
===================================================================
--- trunk/Master/tlpkg/installer/install-menu-text.pl	2019-12-21 22:40:04 UTC (rev 53203)
+++ trunk/Master/tlpkg/installer/install-menu-text.pl	2019-12-21 23:18:19 UTC (rev 53204)
@@ -503,7 +503,7 @@
       );
 
   menu_head "Directories customization:";
-  if (!TeXLive::TLUtils::texdir_check($vars{'TEXDIR'})) {
+  if (!TeXLive::TLUtils::texdir_check($vars{'TEXDIR'}, 1)) {
     print "!! The default location as given below is forbidden or
 !! can't be written to.
 !! Either change the destination directory using <1> or create it
@@ -1068,7 +1068,7 @@
    TEXDIR (the main TeX directory):
 EOF
 
-  if (TeXLive::TLUtils::texdir_check($vars{'TEXDIR'})) {
+  if (TeXLive::TLUtils::texdir_check($vars{'TEXDIR'}, 1)) {
     print "     $vars{'TEXDIR'}\n";
   } else {
     print "     !! default location: $vars{'TEXDIR'}\n";



More information about the tex-live-commits mailing list