summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xMaster/install-tl1
-rw-r--r--Master/texmf/scripts/texlive/uninstall-win32.pl1
-rw-r--r--Master/tlpkg/TeXLive/TLUtils.pm91
-rw-r--r--Master/tlpkg/TeXLive/TLWinGoo.pm6
-rw-r--r--Master/tlpkg/installer/install-menu-perltk.pl52
5 files changed, 95 insertions, 56 deletions
diff --git a/Master/install-tl b/Master/install-tl
index 9aca143fdfa..5aa5cc98fc3 100755
--- a/Master/install-tl
+++ b/Master/install-tl
@@ -64,7 +64,6 @@ if (win32) {
&admin
&non_admin
&reg_country
- &dir_writable
&expand_string
&global_tmpdir
&get_system_path
diff --git a/Master/texmf/scripts/texlive/uninstall-win32.pl b/Master/texmf/scripts/texlive/uninstall-win32.pl
index 4f69e7667aa..002e4983aab 100644
--- a/Master/texmf/scripts/texlive/uninstall-win32.pl
+++ b/Master/texmf/scripts/texlive/uninstall-win32.pl
@@ -41,7 +41,6 @@ $cancel->pack(-side => 'left' , -padx => "3m");
sub doit {
remove_texbindirs_from_path();
unsetenv_reg("TEXBINDIR");
- # unregister_script_type(".texlua");
unregister_uninstaller();
exit if is_vista();
broadcast_env();
diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm
index dfed24ad3e0..8e65670ea37 100644
--- a/Master/tlpkg/TeXLive/TLUtils.pm
+++ b/Master/tlpkg/TeXLive/TLUtils.pm
@@ -1,6 +1,6 @@
# $Id$
# The inevitable utilities for TeX Live.
-#
+#
# Copyright 2007, 2008 Norbert Preining, Reinhard Kotucha
# This file is licensed under the GNU General Public License version 2
# or any later version.
@@ -32,11 +32,12 @@ C<TeXLive::TLUtils> -- utilities used in the TeX Live infrastructure
TeXLive::TLUtils::program_exists($program);
TeXLive::TLUtils::get_system_tmpdir;
-=head2 File Utulities
+=head2 File Utilities
TeXLive::TLUtils::dirname($path);
TeXLive::TLUtils::basename($path);
TeXLive::TLUtils::dirname_and_basename($path);
+ TeXLive::TLUtils::dir_writable($path);
TeXLive::TLUtils::mkdirhier($path);
TeXLive::TLUtils::copy($file, $target_dir);
TeXLive::TLUtils::download_file( $path, $destination [, $progs ] );
@@ -85,6 +86,7 @@ BEGIN {
&dirname
&basename
&dirname_and_basename
+ &dir_writable
&mkdirhier
&copy
&install_package
@@ -423,6 +425,53 @@ sub dirname_and_basename {
=pod
+=item C<dir_writable($path)>
+
+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
+even on Unix is not always good enough for directories mounted from
+a fileserver.
+
+=cut
+
+# Theoretically, the test below, which uses numbers as names, might
+# lead to a race condition. OTOH, it should work even on a very
+# broken Perl.
+
+# The Unix test gives the wrong answer when used under Windows Vista
+# with one of the `virtualized' directories such as Program Files:
+# lacking administrative permissions, it would write successfully to
+# the virtualized Program Files rather than fail to write to the
+# real Program Files. Ugh.
+
+sub dir_writable {
+ $path=shift;
+ return 0 unless -d $path;
+ $path =~ s!\\!/!g if win32;
+ $path =~ s!/$!!g;
+ my $i = 0;
+ while (-e $path . "/" . $i) { $i++; }
+ my $f = $path."/".$i;
+ if (win32) {
+ my $fb = $f;
+ $fb =~ s!/!\\!g;
+ return 0 if
+ system('copy /b ' . $ENV{'COMSPEC'} . ' "' . $fb . '" >nul 2>&1');
+ unlink $f if -e $f;
+ return 1;
+ } else {
+ return 0 unless open TEST, ">".$f;
+ my $written = 0;
+ $written = (print TEST "\n");
+ close TEST;
+ unlink $f;
+ return $written;
+ }
+}
+
+=pod
+
=item C<mkdirhier($path, [$mode])>
The function C<mkdirhier> does the same as the UNIX command C<mkdir -p>.
@@ -540,8 +589,8 @@ sub install_packages {
die "STRANGE: $package not to be found in ", $fromtlpdb->root;
}
my $real_opt_doc = $opt_doc;
- # if we install a package from the Documentation class we
- # reactivate the do_doc in any case. It should apply ONLY for fonts
+ # if we install a package from the Documentation class we
+ # reactivate the do_doc in any case. It should apply ONLY for fonts
# and macros!
if ($tlpobj->category =~ m/documentation/i) {
$real_opt_doc = 1;
@@ -660,7 +709,7 @@ sub install_package {
#
# in all other cases we create temp files .tar.lzma (or use the present
# one), lzmadec them, and then call tar
-
+
my $fn = basename($what);
mkdirhier("$target/temp");
my $lzmafile = "$target/temp/$fn";
@@ -704,7 +753,7 @@ sub install_package {
=item C<setup_programs( $bindir, $platform )>
-Sets up the global $::progs hash containing the pathes to the
+Sets up the global $::progs hash containing the pathes to the
programs C<wget>, C<tar>, C<lzmadec>. The C<$bindir> argument specifies
the path to the location of the C<lzmadec> binaries, the C<$platform>
gives the extension for the C<lzmadec> binary.
@@ -715,9 +764,9 @@ sub setup_programs {
my ($bindir, $platform) = @_;
$::progs{'wget'} = "wget";
if (!defined($platform) || ($platform eq "")) {
- # we assume that we run from the DVD, so we can call platform() and
+ # we assume that we run from the DVD, so we can call platform() and
# thus also the config.guess script
- # but we have to setup $::installerdir because that stupid
+ # but we have to setup $::installerdir because that stupid
# platform script relies on it
$::installerdir = "$bindir/../..";
$platform = platform();
@@ -738,10 +787,10 @@ sub setup_programs {
=item C<download_file( $path, $destination [, $progs ] )>
Try to download the file given in C<$relpath> from either C<$TeXLiveURL>
-or C<TeXLiveAlternativeURL> into C<$destination>, which can be either
+or C<TeXLiveAlternativeURL> into C<$destination>, which can be either
a filename of simply C<|>. In the latter case a file handle is returned.
-The optional argument C<$progs> is a reference to a hash giving full pathes
+The optional argument C<$progs> is a reference to a hash giving full pathes
to the respective programs, at least C<wget>. In case that C<$progs> is not
given the C<%::progs> is consulted, and if this also does not exist we
try "wget".
@@ -749,7 +798,7 @@ try "wget".
Downloading honors two environment variables C<TL_DOWNLOAD_PROGRAM> and
C<TL_DOWNLOAD_ARGS>. The former overrides C<wget> (or what is given in the
C<$progs> argument, the latter overrides the default wget arguments
-given in C<$TeXLive::TLConfig::DefaultWgetArgs>.
+given in C<$TeXLive::TLConfig::DefaultWgetArgs>.
C<TL_DOWNLOAD_ARGS> must be set up in a way that the place the output should
go to is the first argument after the C<TL_DOWNLOAD_ARGS>. Use with care.
@@ -804,7 +853,7 @@ sub _download_file {
debug("Trying to download $url\n");
my $ret;
if ($dest eq "|") {
- open(RETFH, "$wget $wgetargs - $url|") or
+ open(RETFH, "$wget $wgetargs - $url|") or
die("Cannot open $url via wget for reading");
# opening to a pipe always succeeds, so we return immediately
return \*RETFH;
@@ -931,7 +980,7 @@ again.
sub initialize_installer {
&media;
&platform;
- $ENV{'WGETRC'}="$::installerdir/tlpkg/installer/wgetrc"
+ $ENV{'WGETRC'}="$::installerdir/tlpkg/installer/wgetrc"
}
=pod
@@ -1176,18 +1225,10 @@ sub texdir_check {
my ($texdir) = shift; # PATH/texlive/2008
my $texdirparent = dirname($texdir); # PATH/texlive
my $texdirpparent = dirname($texdirparent); # PATH
- if (win32()) {
- if ( (TeXLive::TLWinGoo::dir_writable($texdirpparent)) ||
- ( (-d $texdirparent) && (TeXLive::TLWinGoo::dir_writable($texdirparent)) ) ||
- ( (-d $texdir) && (TeXLive::TLWinGoo::dir_writable($texdir)) ) ) {
- return 1;
- }
- } else {
- if ( (-w $texdirpparent) ||
- ( (-d $texdirparent) && (-w $texdirparent) ) ||
- ( (-d $texdir) && (-w $texdir) ) ) {
- return 1;
- }
+ if ( (dir_writable($texdirpparent)) ||
+ ( (-d $texdirparent) && (dir_writable($texdirparent)) ) ||
+ ( (-d $texdir) && (dir_writable($texdir)) ) ) {
+ return 1;
}
return 0;
}
diff --git a/Master/tlpkg/TeXLive/TLWinGoo.pm b/Master/tlpkg/TeXLive/TLWinGoo.pm
index a44ca6a7c0d..7cf27f446b5 100644
--- a/Master/tlpkg/TeXLive/TLWinGoo.pm
+++ b/Master/tlpkg/TeXLive/TLWinGoo.pm
@@ -937,7 +937,7 @@ sub add_menu_shortcut {
next; # fail silently and don't worry about it
} elsif (not (-d $shpath)) {
mkdirhier($shpath);
- #return unless mkdirhier ($shpath);
+ return unless -d $shpath;
}
$shfile = $shpath.'/'.$name.'.lnk';
$shc->Save($shfile);
@@ -1068,12 +1068,12 @@ sub unregister_uninstaller {
$regkey_uninst = $Registry->Open(
"CUser/software/microsoft/windows/currentversion/uninstall/",
{Access => KEY_ALL_ACCESS()});
- reg_delete_recurse($regkey_uninst, 'texlive') if $regkey_uninst;
+ reg_delete_recurse($regkey_uninst, 'texlive/') if $regkey_uninst;
return unless admin();
$regkey_uninst = $Registry->Open(
"LMachine/software/microsoft/windows/currentversion/uninstall/",
{Access => KEY_ALL_ACCESS()});
- reg_delete_recurse($regkey_uninst, 'texlive') if $regkey_uninst;
+ reg_delete_recurse($regkey_uninst, 'texlive/') if $regkey_uninst;
}
=pod
diff --git a/Master/tlpkg/installer/install-menu-perltk.pl b/Master/tlpkg/installer/install-menu-perltk.pl
index f3afba912c1..d5cc655e320 100644
--- a/Master/tlpkg/installer/install-menu-perltk.pl
+++ b/Master/tlpkg/installer/install-menu-perltk.pl
@@ -265,7 +265,7 @@ sub run_menu {
# further customization
$fr->Label(-text => "------- $text{'dirsetup'} -------")->pack;
-
+
# texdir line
my $ftexdir = $fr->Frame; $ftexdir->pack;
$ftexdir->Label(-text => $labels{'texdir'}, -width => $a, -anchor => 'w')->pack(-side => 'left');
@@ -289,7 +289,7 @@ sub run_menu {
$fhome->Label(-text => $labels{'texmfhome'}, -width => $a, -anchor => 'w')->pack(-side => 'left');
$texmfhometext = $fhome->Label(-width => $b, -anchor => 'w')->pack(-side => 'left');
$fhome->Button(-width => $c, -text => $text{'change'}, -command => sub { menu_edit_vars_value("TEXMFHOME"); })->pack(-side => 'left');
-
+
# Options
$fr->Label(-text => "------- $text{'options'} -------")->pack;
@@ -299,30 +299,30 @@ sub run_menu {
$fletter->Label(-text => $labels{'optletter'}, -width => $a, -anchor => 'w')->pack(-side => 'left');
$fletter->Label(-width => $b, -anchor => 'w', -textvariable => \$letteryesno)->pack(-side => 'left');
$fletter->Button(-width => $c, -text => $text{'toggle'}, -command => sub { toggle_and_set_opt_variable(\$vars{'option_letter'}, \$letteryesno); })->pack(-side => 'left');
-
+
my $ffmt = $fr->Frame; $ffmt->pack;
$ffmt->Label(-text => $labels{'optfmt'}, -width => $a, -anchor => 'w')->pack(-side => 'left');
$ffmt->Label(-width => $b, -anchor => 'w', -textvariable => \$fmtyesno)->pack(-side => 'left');
$ffmt->Button(-width => $c, -text => $text{'toggle'}, -command => sub { toggle_and_set_opt_variable(\$vars{'option_fmt'}, \$fmtyesno); })->pack(-side => 'left');
-
+
if ($vars{'doc_splitting_supported'}) {
my $fdoc = $fr->Frame; $fdoc->pack;
$fdoc->Label(-text => $labels{'optdoc'}, -width => $a, -anchor => 'w')->pack(-side => 'left');
$fdoc->Label(-width => $b, -anchor => 'w', -textvariable => \$docyesno)->pack(-side => 'left');
$fdoc->Button(-width => $c, -text => $text{'toggle'}, -command => sub { toggle_and_set_opt_variable(\$vars{'option_doc'}, \$docyesno); })->pack(-side => 'left');
}
-
+
if ($vars{'src_splitting_supported'}) {
my $fsrc = $fr->Frame; $fsrc->pack;
$fsrc->Label(-text => $labels{'optsrc'}, -width => $a, -anchor => 'w')->pack(-side => 'left');
$fsrc->Label(-width => $b, -anchor => 'w', -textvariable => \$srcyesno)->pack(-side => 'left');
$fsrc->Button(-width => $c, -text => $text{'toggle'}, -command => sub { toggle_and_set_opt_variable(\$vars{'option_src'}, \$srcyesno); })->pack(-side => 'left');
}
-
+
if (unix()) {
# Symlinks
$fr->Label(-text => "------- $text{'sysint'} -------")->pack;
-
+
my $fsym = $fr->Frame; $fsym->pack;
$fsym->Label(-text => $labels{'symlink'}, -width => $a, -anchor => 'w')->pack(-side => 'left');
$symlinktext = $fsym->Label(-width => $b, -anchor => 'w')->pack(-side => 'left');
@@ -333,7 +333,7 @@ sub run_menu {
my $f3 = $fr->Frame;
$f3->Button(
-text => $text{'install'},
- -command => sub { do_installation();
+ -command => sub { do_installation();
$return = $MENU_ALREADYDONE;
$fr->Dialog(-text => $text{'finished'}, -buttons => [ $text{'finbut'} ])->Show;
$mw->destroy },
@@ -358,13 +358,13 @@ sub menu_edit_vars_value {
my $entry = $sw->Entry(-textvariable => $val, -width => 60);
$entry->pack;
my $f = $sw->Frame;
- $f->Button(-text => $text{'ok'},
+ $f->Button(-text => $text{'ok'},
-command => sub { $val = $entry->get; callback_edit_directories($key,$val) ; $sw->destroy })->pack(-side => 'left');
- $f->Button(-text => $text{'cancel'},
+ $f->Button(-text => $text{'cancel'},
-command => sub { $sw->destroy })->pack(-side => 'right');
$f->pack(-expand => 'x');
}
-
+
sub menu_select_scheme {
my $sw = $mw->Toplevel(-title => $labels{'scheme'});
my @schemes;
@@ -398,9 +398,9 @@ sub menu_select_scheme {
$f2r->pack(-side => 'right');
$f2->pack;
my $f3 = $sw->Frame;
- $f3->Button(-text => $text{'ok'},
+ $f3->Button(-text => $text{'ok'},
-command => sub { callback_select_scheme($selected) ; $sw->destroy })->pack(-side => 'left');
- $f3->Button(-text => $text{'cancel'},
+ $f3->Button(-text => $text{'cancel'},
-command => sub { $sw->destroy })->pack(-side => 'right');
$f3->pack(-expand => 'x');
}
@@ -434,9 +434,9 @@ sub menu_select_standard_collections {
$fd->Button(-text => $text{'selectnone'},
-command => sub { deselect_collections(\%lvars, @collections_std) })->pack(-side => 'right');
$fc->pack(-expand => 'x');
- $fc->Button(-text => $text{'ok'},
+ $fc->Button(-text => $text{'ok'},
-command => sub { %vars = %lvars; callback_select_collection() ; $sw->destroy })->pack(-side => 'left');
- $fc->Button(-text => $text{'cancel'},
+ $fc->Button(-text => $text{'cancel'},
-command => sub { $sw->destroy })->pack(-side => 'right');
}
@@ -471,7 +471,7 @@ sub menu_select_lang_collections {
-command => sub { select_collections(\%lvars, @collections_lang) })->pack(-side => 'left');
$f1langB->Button(-text => $text{'selectnone'},
-command => sub { deselect_collections(\%lvars, @collections_lang) })->pack(-side => 'right');
-
+
my $f1docT = $f1doc->Frame; $f1docT->pack;
my $f1docL = $f1doc->Frame; $f1docL->pack;
$f1docT->Label(-text => $text{'selectdoc'})->pack;
@@ -495,9 +495,9 @@ sub menu_select_lang_collections {
$f1docB->Button(-text => $text{'selectnone'},
-command => sub { deselect_collections(\%lvars, @collections_lang_doc) })->pack(-side => 'right');
my $f2 = $sw->Frame; $f2->pack(-expand => 'x');
- $f2->Button(-text => $text{'ok'},
+ $f2->Button(-text => $text{'ok'},
-command => sub { %vars = %lvars; callback_select_collection() ; $sw->destroy })->pack(-side => 'left');
- $f2->Button(-text => $text{'cancel'},
+ $f2->Button(-text => $text{'cancel'},
-command => sub { $sw->destroy })->pack(-side => 'right');
}
@@ -520,13 +520,13 @@ sub menu_select_symlink {
$vars{'sys_bin'} = $lbin;
$vars{'sys_info'} = $linfo;
$vars{'sys_man'} = $lman;
- }
+ }
$vars{'option_symlinks'} = $osym;
menu_update_texts();
}
set_unset_buttons();
my $sw = $mw->Toplevel(-title => $labels{'symlink'});
- $sw->Checkbutton(-variable => \$osym,
+ $sw->Checkbutton(-variable => \$osym,
-text => $text{'createsym'},
-command => sub { set_unset_buttons(); } )->pack;
my $fbin = $sw->Frame;
@@ -545,9 +545,9 @@ sub menu_select_symlink {
$infob->pack(-side => 'right');
$finfo->pack(-expand => 'x');
my $f2 = $sw->Frame; $f2->pack(-expand => 'x');
- $f2->Button(-text => $text{'ok'},
+ $f2->Button(-text => $text{'ok'},
-command => sub { return_callback(); $sw->destroy })->pack(-side => 'left');
- $f2->Button(-text => $text{'cancel'},
+ $f2->Button(-text => $text{'cancel'},
-command => sub { $sw->destroy })->pack(-side => 'right');
}
@@ -570,9 +570,9 @@ sub menu_select_binsystems {
$f2l->pack(-side => 'left');
$f2->pack;
my $f3 = $sw->Frame;
- $f3->Button(-text => $text{'ok'},
+ $f3->Button(-text => $text{'ok'},
-command => sub { callback_select_systems() ; $sw->destroy })->pack(-side => 'left');
- $f3->Button(-text => $text{'cancel'},
+ $f3->Button(-text => $text{'cancel'},
-command => sub { $sw->destroy })->pack(-side => 'right');
$f3->pack(-expand => 'x');
}
@@ -604,7 +604,7 @@ sub menu_set_collections_text {
sub menu_set_pathes_text {
if (TeXLive::TLUtils::texdir_check($vars{'TEXDIR'})) {
- menu_set_text($texdirtext, "$vars{'TEXDIR'}");
+ menu_set_text($texdirtext, "$vars{'TEXDIR'}", -foreground => "black");
} else {
menu_set_text($texdirtext, $text{'notwritable'}, -foreground => "red");
}
@@ -613,7 +613,7 @@ sub menu_set_pathes_text {
menu_set_text($texmfsysvartext, "$vars{'TEXMFSYSVAR'}");
} elsif ("$vars{'TEXMFSYSVAR'}" =~ m;^$vars{'TEXDIR'};) {
if (TeXLive::TLUtils::texdir_check($vars{'TEXDIR'})) {
- menu_set_text($texmfsysvartext, "$vars{'TEXMFSYSVAR'}");
+ menu_set_text($texmfsysvartext, "$vars{'TEXMFSYSVAR'}", -foreground => "black");
} else {
menu_set_text($texmfsysvartext, $text{'changetexdir'}, -foreground => "red");
}