diff options
Diffstat (limited to 'Master/tlpkg')
| -rw-r--r-- | Master/tlpkg/TeXLive/TLUtils.pm | 126 | ||||
| -rwxr-xr-x | Master/tlpkg/installer/install-menu-text.pl | 12 |
2 files changed, 79 insertions, 59 deletions
diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm index 7668697c4c8..3fb58a9f68c 100644 --- a/Master/tlpkg/TeXLive/TLUtils.pm +++ b/Master/tlpkg/TeXLive/TLUtils.pm @@ -734,28 +734,30 @@ a fileserver. # real Program Files. Ugh. sub dir_writable { - my $path=shift; + my ($path) = @_; return 0 unless -d $path; $path =~ s!\\!/!g if win32; $path =~ s!/$!!; my $i = 0; my $too_large = 100000; - while ((-e $path . "/" . $i) and $i<$too_large) { $i++; } - return 0 if $i>=$too_large; - my $f = $path."/".$i; - return 0 unless open TEST, ">".$f; + while ((-e "$path/$i") && $i < $too_large) { + $i++; + } + return 0 if $ i >= $too_large; + my $f = "$path/$i"; + return 0 if ! open (TEST, ">$f"); my $written = 0; $written = (print TEST "\n"); - close TEST; - unlink $f; + close (TEST); + unlink ($f); return $written; } =item C<mkdirhier($path, [$mode])> -The function C<mkdirhier> does the same as the UNIX command C<mkdir -p>. -The optional parameter sets the permission flags. +The function C<mkdirhier> does the same as the UNIX command C<mkdir -p>, +and dies on failure. The optional parameter sets the permission bits. =cut @@ -2008,27 +2010,38 @@ On Windows it returns undefined. =cut sub add_link_dir_dir { - my ($from, $to) = @_; - mkdirhier $to; - if (-w $to) { - debug("linking files from $from to $to\n"); + my ($from,$to) = @_; + mkdirhier ($to); + if (-w $to) { + debug ("linking files from $from to $to\n"); chomp (@files = `ls "$from"`); my $ret = 1; for my $f (@files) { - # skip certain dangerous entries that should never be linked somewhere + # don't make a system-dir link to our special "man" link. if ($f eq "man") { - debug("not linking man into $to.\n"); + debug ("not linking `man' into $to.\n"); next; } - unlink("$to/$f"); - if (system("ln -s \"$from/$f\" \"$to\"")) { - tlwarn("Linking $f from $from to $to failed: $!\n"); + # + # attempt to remove an existing symlink, but nothing else. + unlink ("$to/$f") if -l "$to/$f"; + # + # if the destination still exists, skip it. + if (-e "$to/$f") { + tlwarn ("add_link_dir_dir: $to/$f exists; not making symlink.\n"); + next; + } + # + # try to make the link. + if (system ("ln -s '$from/$f' '$to'") != 0) { + tlwarn ("add_link_dir_dir: linking $f from $from to $to failed: $!\n"); $ret = 0; } } return $ret; } else { - tlwarn("destination $to not writable, no linking files in $from done.\n"); + tlwarn ("add_link_dir_dir: destination $to not writable, " + . "no links from $from.\n"); return 0; } } @@ -2067,58 +2080,65 @@ sub add_remove_symlinks { my ($mode, $Master, $arch, $sys_bin, $sys_man, $sys_info) = @_; my $errors = 0; my $plat_bindir = "$Master/bin/$arch"; + + # nothing to do with symlinks on Windows, of course. return if win32(); + + my $info_dir = "$Master/texmf-dist/doc/info"; if ($mode eq "add") { - $errors++ unless add_link_dir_dir($plat_bindir, $sys_bin); - if (-d "$Master/texmf-dist/doc/info") { - $errors++ - unless add_link_dir_dir("$Master/texmf-dist/doc/info", $sys_info); + $errors++ unless add_link_dir_dir($plat_bindir, $sys_bin); # bin + if (-d $info_dir) { + $errors++ unless add_link_dir_dir($info_dir, $sys_info); } } elsif ($mode eq "remove") { - $errors++ unless remove_link_dir_dir($plat_bindir, $sys_bin); - if (-d "$Master/texmf-dist/doc/info") { - $errors++ - unless remove_link_dir_dir("$Master/texmf-dist/doc/info", $sys_info); + $errors++ unless remove_link_dir_dir($plat_bindir, $sys_bin); # bin + if (-d $info_dir) { + $errors++ unless remove_link_dir_dir($info_dir, $sys_info); } } else { die ("should not happen, unknown mode $mode in add_remove_symlinks!"); } - mkdirhier $sys_man if ($mode eq "add"); - if (-w $sys_man && -d "$Master/texmf-dist/doc/man") { - debug("$mode symlinks for man pages in $sys_man\n"); - my $foo = `(cd "$Master/texmf-dist/doc/man" && echo *)`; - my @mans = split (' ', $foo); - chomp (@mans); - foreach my $m (@mans) { - my $mandir = "$Master/texmf-dist/doc/man/$m"; - next unless -d $mandir; - if ($mode eq "add") { - $errors++ unless add_link_dir_dir($mandir, "$sys_man/$m"); - } else { - $errors++ unless remove_link_dir_dir($mandir, "$sys_man/$m"); + + # man + my $top_man_dir = "$Master/texmf-dist/doc/man"; + debug("$mode symlinks for man pages to $sys_man from $top_man_dir\n"); + if (! -d $top_man_dir && $mode eq "add") { + ; # better to be silent? + #info("skipping add of man symlinks, no source directory $top_man_dir\n"); + } else { + mkdirhier $sys_man if ($mode eq "add"); + if (-w $sys_man) { + my $foo = `(cd "$top_man_dir" && echo *)`; + my @mans = split (' ', $foo); + chomp (@mans); + foreach my $m (@mans) { + my $mandir = "$top_man_dir/$m"; + next unless -d $mandir; + if ($mode eq "add") { + $errors++ unless add_link_dir_dir($mandir, "$sys_man/$m"); + } else { + $errors++ unless remove_link_dir_dir($mandir, "$sys_man/$m"); + } } + #`rmdir "$sys_man" 2>/dev/null` if ($mode eq "remove"); + } else { + tlwarn("man symlink destination ($sys_man) not writable," + . "cannot $mode symlinks.\n"); + $errors++; } - # `rmdir "$sys_man" 2>/dev/null` if ($mode eq "remove"); - } else { - tlwarn("destination of man symlink $sys_man not writable, " - . "cannot $mode symlinks.\n"); - $errors++; } - # we collected errors in $ret, so return the negation of it + + # we collected errors in $errors, so return the negation of it if ($errors) { - info("$mode of symlinks failed $errors times, please see above messages.\n"); + info("$mode of symlinks had $errors error(s), see messages above.\n"); return 0; } else { return 1; } } -sub add_symlinks { - return (add_remove_symlinks("add", @_)); -} -sub remove_symlinks { - return (add_remove_symlinks("remove", @_)); -} +sub add_symlinks { return (add_remove_symlinks("add", @_)); } +sub remove_symlinks { return (add_remove_symlinks("remove", @_)); } =pod diff --git a/Master/tlpkg/installer/install-menu-text.pl b/Master/tlpkg/installer/install-menu-text.pl index bd0fdaa098c..f66124ba4eb 100755 --- a/Master/tlpkg/installer/install-menu-text.pl +++ b/Master/tlpkg/installer/install-menu-text.pl @@ -1069,14 +1069,14 @@ EOF } } print " $b_addoneditor install TeXworks front end\n"; - print " $b_path create symlinks to standard directories\n" unless - ($vars{'portable'} || win32()); } - if ($media ne 'NET') { - print " $b_adjustrepo after install, use tlnet on CTAN " - . "for package updates\n"; - } + print " $b_path create symlinks to standard directories\n" + unless ($vars{'portable'} || win32()); + + print " $b_adjustrepo after install, use tlnet on CTAN " + . "for package updates\n" + unless ($media eq 'NET'); if ($vars{'portable'}) { print "\n <V> set up for regular installation to hard disk\n"; |