#!/usr/bin/env perl # For testing, edit $ro_dir and $luaprog as needed; # $ro_dir should be a read-only directory and # $luaprog should be a working lua executable but not texlua. # Under Unix/Linux, just test whether loading of win32 modules is skipped. use strict; BEGIN { $^W = 1; my $me=$0; $me=~s!\\!/!g if $^O=~/^MSWin(32|64)$/i; if ($me=~m!/!) { # wingoo-demo now in a subsubdirectory: ($::installerdir=$me)=~s!(.*)/[^/]+/[^/]+/[^/]*$!$1!; } else { # This shouldn't occur if called from batchfile $::installerdir='./../..'; } @INC = ("$::installerdir/tlpkg/installer/perllib") if ($^O=~/^MSWin(32|64)$/i); unshift (@INC, "$::installerdir/tlpkg"); } use TeXLive::TLUtils qw( get_system_tmpdir ); use TeXLive::TLWinGoo qw( win_version is_vista admin non_admin admin_again dir_writable reg_country get_system_path get_user_path get_system_env get_user_env expand_string win_which_dir global_tmpdir add_texbindir_to_path remove_texbindirs_from_path setenv_reg unsetenv_reg register_script_type unregister_script_type broadcast_env update_assocs wg_error ); # safe under Unix/Linux! my $ro_dir = "z:/aps"; my $luadir = "x:/utils0"; my $luaprog; my $pathsave = $ENV{'PATH'}; my $pathextsave = $ENV{'PATHEXT'}; $::LOGLEVELTERMINAL=$::LOG_DDDEBUG; $::LOGLEVELFILE=$::LOG_ZERO; #sub pathnew { # my $p = expand_string(get_system_path()).';'. # expand_string(get_user_path()); # $p =~ s!/!\\!g; # return $p; #} #sub getenvnew { # # only use this for REG_SZ values! # my $env_var = shift; # return TeXLive::TLWinGoo::get_user_env()->{$env_var} or # TeXLive::TLWinGoo::get_system_env()->{$env_var} or ""; # #my $env_data = TeXLive::TLWinGoo::get_user_env()->{$env_var}; # #if (not $env_data) { # # $env_data = TeXLive::TLWinGoo::get_system_env()->{$env_var}; # #} # #if (not $env_data) { $env_data = ""; } # #return $env_data; #} sub pause { my $mess = shift; print( $mess."\nType any key..." ); read STDIN,my $dummy, 1; } sub run_and_pause { my $command = shift; #my $setenv = "set PATH=".pathnew(). # " & set TEXBINDIR=".getenvnew('TEXBINDIR'). # " & set PATHEXT=".getenvnew('PATHEXT'); #my $cmd_prompt = expand_string ($ENV{'COMSPEC'}); #system ($cmd_prompt . ' /C "'.$setenv.' & '.$command.' & pause"'); print "Type $command in a new command prompt\n"; read STDIN,my $dummy, 1; } sub maybenot { my $bool = shift; return $bool ? " is " : " is not "; } # two uses: # - is the parent directory writable? # - is the script interpreted by lua or by texlua? sub create_file { my $name = shift; return 1 if -e $name; return 0 unless open DUMMY, ">".$name; print DUMMY 's = tostring(0.0000001)'."\n"; # lua: 1e-7; texlua: 0 print DUMMY 'print("0.0000001 becomes " .. s)'."\n"; close DUMMY; return 1; } sub print_search_paths { print "System path: ".get_system_path()."\n"; print "User path: ".get_user_path()."\n"; } sub print_lua_out { my $luatest = expand_string( $ENV{'TEMP'} ) . "/testlua"; my $luatestlua = $luatest . ".texlua"; unlink $luatestlua if -e $luatestlua; create_file( $luatestlua ); #$ENV{'PATH'} = expand_string($pathsave) . ";" . $ENV{'TEMP'}; #my $usersave = get_user_path(); #$userpath = ($usersave ? "$usersave;" . #run_and_pause ('testlua'); $luatest =~ s!/!\\!g; #run_and_pause ("set PATHEXT=%PATHEXT%;.TEXLUA & set TEXBINDIR=".$luatest); run_and_pause ($luatest); #print "Lua[tex] result: ".`testlua`."\n"; #$ENV{'PATH'} = $pathsave; unlink $luatestlua; } sub print_assoc_cmd { my $ext = shift; my $cmdout = `assoc $ext`; chomp $cmdout if $cmdout; if (!$cmdout) { print "Extension unknown says assoc\n"; return; } my $ftype = $cmdout; $ftype =~ s/.*=//; if (!$ftype) { print "Extension unknown says assoc\n"; return; } $cmdout = `ftype $ftype`; if (!$cmdout) { print "Filetype unknown says ftype\n"; return; } $cmdout =~ s/.*=//; print( $ext.' command is: '.$cmdout." says ftype\n" ); } ### end of subs ### my $real_admin = admin(); print( "\nGENERAL; ALSO UNIX\n" ); print ( "\nINC\n" . (join "\n", @INC) . "\n\n"); # admin if (admin()) { print "Admin or not_on_Windows\n"; } else { print "Not admin\n"; } # global_tmpdir print "\nGlobal tempdir: " . global_tmpdir()."\n"; # Windows version print "Windows version: ".win_version()."\n"; print maybenot(is_vista()). " Vista\n"; if ($^O !~ /^MSWin(32|64)$/i) { print "Not Windows; bailing out...\n"; exit; } ### end of non-windows #my @winversion = Win32::GetOSVersion(); #print "Windows version: " . $winversion[1] . "\n"; # country print "\n***\nCountry: " . reg_country() . "\n"; # dir_writable my $wr_dir = $ENV{'USERPROFILE'}; $wr_dir =~ s/\\/\//g; mkdir $wr_dir unless -e $wr_dir; print "\n***\nTesting for writability\n"; print $wr_dir . maybenot(dir_writable($wr_dir)) . "writable\n"; print $ro_dir . maybenot(dir_writable($ro_dir)) . "writable\n"; # expand_string print( "\n***\nExpansion\n" ); print expand_string("pre\\%systemROOT%\\post")."\n"; # win_which_dir print( "\n***\nFinding an executable\n" ); print "cmd.exe found in " . win_which_dir("cmd.exe") . "\n"; my $system_tmpdir=get_system_tmpdir(); print( "\n***\nPath; admin and user\n\n" ); my ($wr_dir1, $wr_dir2); foreach ("admin", "user") { if ($_ eq "admin") { next unless $real_admin; admin_again(); } else { non_admin(); } print "\n***\n" . ((admin() ? "Is" : "Not") . " an admin\n"); # adding and removing texbindir print( "\ntexbindir on searchpath:\n" ); $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( "Take 1\n" ); print_search_paths(); print "tex.exe found in " . win_which_dir("tex.exe") . "\n"; $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( "Take 2\n" ); print_search_paths(); print "tex.exe found in " . win_which_dir("tex.exe") . "\n"; print( "Mopping up...\n" ); remove_texbindirs_from_path(); print_search_paths(); # broadcast environment changes broadcast_env(); pause( maybenot(admin())." admin; check environment in new dosbox\n\n" ); } remove_texbindirs_from_path(); rmdir $wr_dir1 if unlink $wr_dir1.'/tex.exe'; rmdir $wr_dir2 if unlink $wr_dir2.'/tex.exe'; print( "Dummy texs removed from path\n"); # the problem case: no admin, but TeX on system path print( "\nNon-admin path problem\n" ); my $fn = expand_string("%windir%")."/TEX.EXE"; $fn =~ s/\\/\//g; non_admin(); if (create_file($fn)) { # a tex.exe on the system path! add_texbindir_to_path(expand_string($wr_dir2)); my @wge = wg_error(); if (@wge) { print $wge[1]."\n"; } print( "Cannot remove tex from system searchpath\n" ); print_search_paths(); print "Wrong tex.exe found in " . win_which_dir("tex.exe") . "\n"; unlink $fn; remove_texbindirs_from_path(); broadcast_env(); pause( "Non-admin: check environment in new dosbox" ); } else { print "Cannot test; cannot create $fn\n"; } # texlua filetype: plain lua for user, texlua for admin. # differentiation: texlua rounds .0000001 to 0, lua doesn't # The texlua command is REG_EXPAND_SZ, parameterized with %TEXBINDIR%. print( "\n***\nRegistering and unregistering filetypes\n\n" ); unregister_script_type(".texlua"); unsetenv_reg('TEXBINDIR'); update_assocs(); broadcast_env(); print_assoc_cmd( '.texlua' ); foreach ("admin", "user") { if ($_ eq "admin") { next unless $real_admin; admin_again(); } else { non_admin(); } print "\n***\n" . ((admin() ? "Is" : "Not") . " an admin\n"); # adding a filetype my $luaprog = admin() ? "texlua.exe" : "lua.exe"; my $texbindir = admin() ? $::installerdir."/bin/win32" : $luadir; $texbindir =~ s!/!\\!g; setenv_reg("TEXBINDIR", $texbindir); register_script_type(".texlua", "%TEXBINDIR%\\".$luaprog ); broadcast_env(); update_assocs(); print "\n***\nAfter registering script type\n"; print_assoc_cmd( '.texlua' ); print_lua_out(); print( "\***\nNow unregister\n" ); unregister_script_type(".texlua"); update_assocs(); print_assoc_cmd( '.texlua' ); print_lua_out(); print( "Now re-register (not shown)\n" ); register_script_type(".texlua", "%TEXBINDIR%\\".$luaprog ); update_assocs(); # broadcast environment changes broadcast_env(); } unregister_script_type(".texlua"); unsetenv_reg('TEXBINDIR'); update_assocs(); broadcast_env(); print_assoc_cmd( '.texlua' );