diff options
-rw-r--r-- | Master/tlpkg/TeXLive/TLWinGoo.pm | 323 | ||||
-rwxr-xr-x | Master/wingoo-demo.bat | 27 | ||||
-rw-r--r-- | Master/wingoo-demo.pl | 106 |
3 files changed, 456 insertions, 0 deletions
diff --git a/Master/tlpkg/TeXLive/TLWinGoo.pm b/Master/tlpkg/TeXLive/TLWinGoo.pm new file mode 100644 index 00000000000..3629d49007c --- /dev/null +++ b/Master/tlpkg/TeXLive/TLWinGoo.pm @@ -0,0 +1,323 @@ +# TeXLive::TLWinGoo.pm +# Windows nastiness +# +# Copyright 2007 Siep Kroonenberg +# This file is licensed under the GNU General Public License version 2 +# or any later version. + +package TeXLive::TLWinGoo; + +=pod + +=head1 NAME + +C<TeXLive::TLWinGoo> -- Additional utilities for Windows + +=head2 SYNOPSIS + + use TeXLive::TLWinGoo; + + TeXLive::TLWinGoo::admin; + TeXLive::TLWinGoo::dir_writable($d); + TeXLive::TLWinGoo::expand_string($s); + TeXLive::TLWinGoo::global_tmpdir; + TeXLive::TLWinGoo::get_system_path; + TeXLive::TLWinGoo::get_user_path; + TeXLive::TLWinGoo::win_which_dir($prog); + TeXLive::TLWinGoo::add_texbindir_to_path($texpath); + +=head2 DESCRIPTION + +=over 6 + +=cut + +BEGIN { + use Exporter; + use vars qw( @ISA @EXPORT $Registry); + @ISA = qw( Exporter ); + @EXPORT = qw( + &admin + &dir_writable + &expand_string + &global_tmpdir + &get_system_path + &get_user_path + &win_which_dir + &add_texbindir_to_path + ); + + if ($^O=~/^MSWin(32|64)$/i) { + require Win32::TieRegistry; + Win32::TieRegistry->import( qw( $Registry + REG_SZ REG_EXPAND_SZ KEY_READ KEY_WRITE KEY_ALL_ACCESS + KEY_ENUMERATE_SUB_KEYS ) ); + $Registry->Delimiter('/'); + $Registry->ArrayValues(0); + $Registry->FixSzNulls(1); + } +} + +my $is_win = $^O=~/^MSWin(32|64)$/i; + +# Under Windows, the variables below are calculated while loading this module. +# The functions &admin and &global_tmpdir simply return these variables. + +my $is_admin = 1; +my $global_tmp = "/tmp"; + +# permissions with which we try to access the system environment + +sub sys_access_permissions { + $is_admin ? KEY_ALL_ACCESS() : KEY_READ() | KEY_ENUMERATE_SUB_KEYS(); +} + +sub get_system_env { + return $Registry -> Open( + "LMachine/system/currentcontrolset/control/session manager/Environment/", + {Access => sys_access_permissions()}); +} + +# $is_admin was set to true. With this value, sys-access_permissions returns +# full access permissions. If that doesn't work out then apparently +# we aren't administrator, so we set $is_admin to 0. + +if ($is_win) { + $is_admin = 0 if not get_system_env(); +} + +sub get_user_env { + return $Registry -> Open("CUser/Environment", {Access => KEY_ALL_ACCESS()}); +} + +=pod + +=item C<admin> + +Our test for being an administrator is the ability to change the +system environment. + +It would be nice to have an install/menu option to set admin to +false in case the user wants to install just for himself. + +=cut + +sub admin { return $is_admin; } + +=pod + +=item C<dir_writable> + +Tests whether its argument is writable by trying to write to +it. This function is necessary because the built-in C<-w> test +apparently doesn't work under Windows. + +=cut + +sub dir_writable { + $d=shift; + return 0 unless -d $d; + $d =~ s!\\!/!g; + $d =~ s!/$!!g; + my $i=0; + while (-e $d . "/" . $i) { $i++; } + my $f = $d."/".$i; + #print $f."\n"; + return 0 unless open TEST, ">".$f; + my $written = 0; + $written = (print TEST "\n"); + close TEST; + unlink $f; + return $written; +} + +=pod + +=item C<expand_string> + +This function replaces substrings C<%env_var%> with their current +values as environment variable and returns the result. + +=cut + +sub expand_string { + $s = shift @_; + while ($s =~ /^([^%]*)%([^%]+)%(.*)$/) { + foreach $k (keys %ENV) { + if (uc($k) eq uc($2)) { + $s = $1 . $ENV{$k} . $3; + last; + } + } + } + $s; +} + +=pod + +=item C<global_tmpdir> + +Returns the expanded value of C<%TEMP%> from the system environment, +usually C<%SystemRoot%/Temp>. This value is normally not available +from C<%ENV>. + +=cut + +if ($is_win) { + $global_tmp = expand_string(get_system_env()->{'TEMP'}) if $is_win; +} + +sub global_tmpdir { return $global_tmp; } + +sub is_a_texdir { + my $d = shift; + my $xd = expand_string($d); + $xd =~ s/\\/\//g; + $xd =~ s/\/$//; + my $xd1 = $xd . '/pdftex.exe'; + my $xd2 = $xd . '/tex.exe'; + return ((-e $xd1) or (-e $xd2)); +} + +=pod + +=item C<get_system_path> + +Returns unexpanded system path, as stored in the registry, but with +forward slashes. + +=cut + +sub get_system_path { + $Registry->ArrayValues(0); + my $value = get_system_env() -> {'/Path'}; + $value =~ s/\\/\//g; + $value =~ s/[\s\x00]+$//; + return $value; +} + +=pod + +=item C<get_user_path> + +Returns unexpanded user path, as stored in the registry, but with +forward slashes. The user path often does not exist, and is rarely +expandable. + +=cut + +sub get_user_path { + $Registry->ArrayValues(0); + my $value = get_user_env() -> {'/Path'}; + return "" if not $value; + $value =~ s/\\/\//g; + $value =~ s/[\s\x00]+$//; + return $value; +} + +=pod + +=item C<win_which_dir> + +More or less the same as which, except that 1. it returns a +directory, 2. it consults the path stored in the registry rather +than the path of the current process, and 3. it assumes that the +filename includes an extension. + +=cut + +sub win_which_dir { + my $prog = shift; + my $d; + # first check system path + my $path = expand_string(get_system_path()); + my $user_path = expand_string(get_user_path()); + $path = $path . ';' . $user_path if $user_path; + foreach $d (split (';',$path)) { + $d =~ s/\/$//; + return $d if -e $d.'/'.$prog; + } + return 0; +} + +=pod + +=item C<add_to_path> + +Returns its arguments joined with C<;> as separator, or returns the second +argument if the first is an empty string. + +=cut + +sub add_to_path { + my $old_path = shift @_; + my $addition = shift @_; + return ($old_path eq "") ? $addition : $old_path . ";" . $addition; +} + +=pod + +=item C<add_texbindir_to_path> + +Remove any TeX directories from system path (if possible) and user +path. A directory is a TeX directory if it contains tex.exe or +pdftex.exe. Then add desired TeX directory; to system path if +admin, otherwise to user path. + +=back + +=cut + +sub add_texbindir_to_path { + $texbindir = shift; + my $syspath_temp = ""; + foreach $d (split (';', get_system_path())) { + print "Warning: possibly conflicting [pdf]TeX program found at ". + expand_string($d)."\n" if is_a_texdir($d) and !$is_admin; + $syspath_temp = add_to_path($syspath_temp, $d) + if (not is_a_texdir($d)) and $is_admin; + } + + if ($is_admin) { + $syspath_temp = add_to_path($syspath_temp, $texbindir); + $syspath_temp =~ s/\//\\/g; + my $system_env = get_system_env(); + $system_env->ArrayValues(1); # use value_data, value_type pairs + $system_env -> {"/Path"} = [ $syspath_temp, REG_EXPAND_SZ ]; + } + + # fix user path + # admin: remove any texdir but don't add anything + # user: remove any texdir and append new texdir + + my $userpath_temp = ""; + foreach $d (split (';', get_user_path())) { + $userpath_temp = add_to_path($userpath_temp, $d) if (not is_a_texdir($d)); + } + + $userpath_temp = add_to_path($userpath_temp, $texbindir) if !$is_admin; + if ($userpath_temp) { + my $user_env = get_user_env(); + $user_env->ArrayValues(1); # use value_data, value_type pairs + $user_env -> {"/Path"} = [ $userpath_temp, + ($userpath_temp =~ /%/) ? REG_EXPAND_SZ : REG_SZ ]; + } else { + delete $user_env -> {'Path'}; + } +} + + + + + +# needs a terminal 1 for require to succeed! +1; + +__END__ + +### Local Variables: +### perl-indent-level: 2 +### tab-width: 2 +### indent-tabs-mode: nil +### End: +# vim:set tabstop=2 expandtab: # diff --git a/Master/wingoo-demo.bat b/Master/wingoo-demo.bat new file mode 100755 index 00000000000..629daae3495 --- /dev/null +++ b/Master/wingoo-demo.bat @@ -0,0 +1,27 @@ +@echo off
+
+rem TeX Live Root; ends with backslash
+rem This should also work with UNC names
+set tlroot=%~dp0
+set tldrive=%~d0
+
+%tldrive%
+cd %tlroot%
+
+rem we need wget in the path, so add tlpkg\bin to the path
+path %path%;%tlroot%tlpkg\bin
+
+rem use provided Perl
+
+set PERL5SAVE=%PERL5LIB%
+
+set PERL5LIB=%tlroot%tlpkg\lib\Perl5_lib-TL_inst
+"%tlroot%tlpkg\bin\perl" "%tlroot%wingoo-demo.pl"
+pause Done
+
+rem cleanup in case of start from command-line
+
+set PERL5LIB=%PERL5SAVE%
+set PERL5SAVE=
+set tldrive=
+set tlroot=
diff --git a/Master/wingoo-demo.pl b/Master/wingoo-demo.pl new file mode 100644 index 00000000000..373a8cc8c04 --- /dev/null +++ b/Master/wingoo-demo.pl @@ -0,0 +1,106 @@ +#!/usr/bin/env perl +# For testing, edit $ro_dir and $wr_dir as needed. + +# $ro_dir should be read-only. +# $wr_dir should be writable. + +#!/usr/bin/env perl + +use strict; + +BEGIN { + $^W = 1; + my $me=$0; + $me=~s!\\!/!g if $^O=~/^MSWin(32|64)$/i; + + if ($me=~m!/!) { + ($::installerdir=$me)=~s!(.*)/.*$!$1!; + } else { + # This shouldn't occur if called from batchfile + $::installerdir='.'; + } + unshift (@INC, "$::installerdir/tlpkg"); +} + +use TeXLive::TLWinGoo; # safe under Unix/Linux! + +my $ro_dir = "z:/aps"; + +sub maybenot { + my $bool = shift; + return $bool ? " is " : " is not "; +} + +sub create_file { + my $name = shift; + return if -e $name; + open DUMMY, ">".$name; + print DUMMY "Hello"; + close DUMMY; +} + +sub print_search_paths { + print "System path: ".get_system_path()."\n"; + print "User path: ".get_user_path()."\n"; +} + +# admin + +if (admin()) { + print "Admin or not on Windows\n"; +} else { + print "Not admin\n"; +} + +# global_tmpdir + +print "Global tempdir: " . global_tmpdir()."\n"; + +if ($^O !~ /^MSWin(32|64)$/i) { + print "Not Windows; bailing out...\n"; + exit; +} + +# dir_writable + +my $wr_dir = $ENV{'USERPROFILE'}; +$wr_dir =~ s/\\/\//g; +mkdir $wr_dir unless -e $wr_dir; +print $wr_dir . maybenot(dir_writable($wr_dir)) . "writable\n"; +print $ro_dir . maybenot(dir_writable($ro_dir)) . "writable\n"; + +# expand_string + +print expand_string("pre\\%systemROOT%\\post")."\n"; + +# win_which_dir + +print "cmd.exe found in " . win_which_dir("cmd.exe") . "\n"; + +# adding and removing texbindir + +my $wr_dir1 = $wr_dir . "/tex1"; +mkdir $wr_dir1 unless -e $wr_dir1; +create_file( $wr_dir1."/tex.exe" ); +add_texbindir_to_path($wr_dir1); +print_search_paths(); +print "tex.exe found in " . win_which_dir("tex.exe") . "\n"; + +my $wr_dir2 = $wr_dir . "/tex2"; +mkdir $wr_dir2 unless -e $wr_dir2; +create_file( $wr_dir2."/tex.exe" ); +add_texbindir_to_path($wr_dir2); +print_search_paths(); +print "tex.exe found in " . win_which_dir("tex.exe") . "\n"; + +# the problem case: no admin, but TeX on system path + +if (!admin()) { + my $fn = expand_string("%windir%")."/tex.exe"; + $fn =~ s/\\/\//g; + create_file($fn); + add_texbindir_to_path(expand_string($wr_dir2)); + print_search_paths(); + print "tex.exe found in " . win_which_dir("tex.exe") . "\n"; + unlink $fn; +} |