summaryrefslogtreecommitdiff
path: root/Master/tlpkg/TeXLive/TLWinGoo.pm
diff options
context:
space:
mode:
authorSiep Kroonenberg <siepo@cybercomm.nl>2012-12-07 15:41:08 +0000
committerSiep Kroonenberg <siepo@cybercomm.nl>2012-12-07 15:41:08 +0000
commitaf0965769f2f5c3e24477d00739691e498670cf5 (patch)
treebafb2e328a360875c053f81d848f218ac8d6e5f9 /Master/tlpkg/TeXLive/TLWinGoo.pm
parent4b8d5103b7e6a70001e1aaf5b4f0ff0d0ac18d13 (diff)
Bypass HKCR; flush after registry deletes
git-svn-id: svn://tug.org/texlive/trunk@28457 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/TeXLive/TLWinGoo.pm')
-rw-r--r--Master/tlpkg/TeXLive/TLWinGoo.pm122
1 files changed, 65 insertions, 57 deletions
diff --git a/Master/tlpkg/TeXLive/TLWinGoo.pm b/Master/tlpkg/TeXLive/TLWinGoo.pm
index 63dc07c102a..36e71de0fab 100644
--- a/Master/tlpkg/TeXLive/TLWinGoo.pm
+++ b/Master/tlpkg/TeXLive/TLWinGoo.pm
@@ -146,6 +146,15 @@ use TeXLive::TLConfig;
use TeXLive::TLUtils;
TeXLive::TLUtils->import( qw( mkdirhier ) );
+sub reg_debug {
+ return if ($::opt_verbosity < 1);
+ my $mess = shift;
+ my $regerr = Win32API::Registry::regLastError();
+ if ($regerr) {
+ debug("$regerr\n$mess");
+ }
+}
+
my $is_win = $^O=~/^MSWin(32|64)$/i;
=pod
@@ -569,6 +578,9 @@ sub hash_merge {
hash_merge($target->{$k}, $mods->{$k});
} else {
$target->{$k} = $mods->{$k};
+ reg_debug ("at hash merge\n");
+ $target->Flush();
+ reg_debug ("at hash merge\n");
}
}
}
@@ -595,10 +607,14 @@ sub reg_delete_recurse {
my $child;
if ($childname !~ '^/') { # subkey
$child = $parent->Open ($childname, {Access => KEY_ALL_ACCESS()});
+ reg_debug ("at open $childname for all access\n");
return 1 unless defined($child);
foreach my $v (keys %$child) {
if ($v =~ '^/') { # value
delete $child->{$v};
+ reg_debug ("at delete $childname/$v\n");
+ $child->Flush();
+ reg_debug ("at delete $childname/$v\n");
Time::HiRes::usleep(20000);
} else { # subkey
return 0 unless reg_delete_recurse ($child, $v);
@@ -607,6 +623,9 @@ sub reg_delete_recurse {
#delete $child->{'/'};
}
delete $parent->{$childname};
+ reg_debug ("at delete $parentpath$childname\n");
+ $parent->Flush();
+ reg_debug ("at delete $parentpath$childname\n");
Time::HiRes::usleep(20000);
return 1;
}
@@ -615,6 +634,7 @@ sub cu_root {
my $k = $Registry -> Open("CUser", {
Access => KEY_ALL_ACCESS(), Delimiter => '/'
});
+ reg_debug ("at open HKCU for all access\n");
die "Cannot open HKCU for writing" unless $k;
return $k;
}
@@ -624,23 +644,12 @@ sub lm_root {
Access => ($is_admin ? KEY_ALL_ACCESS() : KEY_READ()),
Delimiter => '/'
});
+ reg_debug ("at open HKLM\n");
die "Cannot open HKLM for ".($is_admin ? "writing" : "reading")
unless $k;
return $k;
}
-sub cl_root {
- my $k = $Registry -> Open("Classes", {
- Access => KEY_READ(), Delimiter => '/'
- });
- die "Cannot open HKCR for reading" unless $k;
- return $k;
-}
-
-# write a registry key under HKCU or HKLM, depending on privilege level
-# If admin, $remove_cu means to delete the corresponding HKCU entry.
-# This parameter is ignored in the non-admin case
-
sub do_write_regkey {
my $keypath = shift; # modulo cu/lm
my $keyhash = shift; # ref to a possibly nested hash; empty hash allowed
@@ -669,14 +678,18 @@ sub do_write_regkey {
# make sure parent exists
if ($is_admin) {
$parentkey = $lm_key->Open($parentpath);
+ reg_debug ("at open $parentpath; creating...\n");
if (!$parentkey) {
# in most cases, this probably shouldn't happen for lm
$parentkey = $lm_key->CreateKey($parentpath);
+ reg_debug ("at creating $parentpath\n");
}
} else {
$parentkey = $cu_key->Open($parentpath);
+ reg_debug ("at open $parentpath; creating...\n");
if (!$parentkey) {
$parentkey = $cu_key->CreateKey($parentpath);
+ reg_debug ("at creating $parentpath\n");
}
}
if (!$parentkey) {
@@ -689,6 +702,7 @@ sub do_write_regkey {
hash_merge($parentkey->{$keyname}, $keyhash);
} else {
$parentkey->{$keyname} = $keyhash;
+ reg_debug ("at creating $keyname\n");
}
if (!$parentkey->{$keyname}) {
tlwarn "Failure to create $hivename/$keypath\n";
@@ -732,6 +746,7 @@ sub do_remove_regkey {
} else {
$parentkey = $cu_key->Open($parentpath);
}
+ reg_debug ("at opening $parentpath\n");
if (!$parentkey) {
debug ("$hivename/$parentpath not present or not writable".
" so $keypath not removed\n");
@@ -753,12 +768,14 @@ sub do_remove_regkey {
}
} else {
delete $parentkey->{$valname};
+ reg_debug ("at deleting $valname\n");
if ($parentkey->{$valname}) {
tlwarn "Failure to delete $hivename/$keypath\n";
return 0;
}
if ($is_admin and $cu_key->{$parentpath}) {
delete $cu_key->{$parentpath}->{$valname};
+ reg_debug ("at deleting $valname\n");
if ($cu_key->{$parentpath}->{$valname}) {
tlwarn "Failure to delete HKCU/$keypath\n";
return 0;
@@ -768,18 +785,24 @@ sub do_remove_regkey {
return 1;
}
-sub current_valdata {
- my $value_path = shift;
- die "Illegal value path $value_path"
- unless $value_path =~ /\/\//;
- my $valdata = "";
+# Effective default value of any key under Classes.
+# admin: HKLM; user: HKCU or otherwise HKLM
+# Reject if there is no corresponding key under classes
+sub current_filetype {
+ my $extension = shift;
+ my $filetype;
if ($is_admin) {
- $valdata = lm_root()->{"Software/Classes/$value_path"};
+ $filetype = lm_root()->{"Software/Classes/$extension//"}; # REG_SZ
} else {
- $valdata = $Registry->{"Classes/$value_path"};
+ # Mysterious failures on w7_64 => merge HKLM/HKCU info explicitly
+ # rather than checking HKCR
+ $filetype = cu_root()->{"Software/Classes/$extension//"};
+ if (!defined($filetype) or ($filetype eq "")) {
+ $filetype = lm_root()->{"Software/Classes/$extension//"}
+ };
}
- $valdata = "" unless defined($valdata);
- return $valdata;
+ $filetype = "" unless defined($filetype);
+ return $filetype;
}
### now the exported file type functions ###
@@ -796,10 +819,12 @@ The associated program shows up in the `open with' right-click menu.
sub add_to_progids {
my $ext = shift;
my $filetype = shift;
- $Registry->ArrayValues(1);
+ #$Registry->ArrayValues(1);
+ #do_write_regkey("Software/Classes/$ext/OpenWithProgIds/",
+ # {"/$filetype" => [0, REG_NONE()]});
+ #$Registry->ArrayValues(0);
do_write_regkey("Software/Classes/$ext/OpenWithProgIds/",
- {"/$filetype" => [0, REG_NONE()]});
- $Registry->ArrayValues(0);
+ {"/$filetype" => ""});
}
=pod
@@ -816,32 +841,6 @@ sub remove_from_progids {
do_remove_regkey("Software/Classes/$ext/OpenWithProgIds//$filetype");
}
-sub active_file_type {
- # current filetype, except
- # return empty string if no action associated with it
- my $extension = shift; # assume leading dot
- my $file_type = current_valdata("$extension//");
- my $is_active = 0;
- debug("active_file_type called for $extension and $file_type\n");
- if ($is_admin) {
- $is_active = 1 if ($file_type and
- lm_root()->{"Software/Classes/$file_type/shell/"});
- } else {
- if ($::opt_verbosity) {
- my $cmd = cl_root()->{"$file_type/shell/open/command//"};
- if ($cmd) {
- debug("Action: $cmd\n");
- } else {
- debug("No open command for $extension and $file_type\n");
- }
- }
- $is_active = 1 if ($file_type and
- cl_root()->{"$file_type/shell/"});
- }
- $file_type = "" unless $is_active;
- return $file_type;
-}
-
=pod
=item C<register_extension($mode, $extension, $file_type)>
@@ -852,11 +851,8 @@ are flipped where necessary.
If $mode is 0, nothing is actually done.
For $mode 1, the filetype for the extension is preserved, but only
-if shell actions are defined for it. This is slightly changed from
-previous versions. Because Windows often creates filetypes for
-extensions automatically, it seems better to ignore filetypes
-without actions. If the old filetype is not overwritten, the new
-filetype is added to the openwithprogids list.
+if there is a registry key under Classes for it. For $mode>0,
+the new filetype is always added to the openwithprogids list.
For $mode 2, the filetype is always overwritten. The old filetype
moves to the openwithprogids list if necessary.
@@ -873,7 +869,19 @@ sub register_extension {
my $file_type = shift;
my $regkey;
- my $old_file_type = active_file_type($extension);
+ my $old_file_type = current_filetype($extension);
+ if ($old_file_type) {
+ if ($is_admin) {
+ if (not lm_root()->{"Software/Classes/$old_file_type/"}) {
+ $old_file_type = "";
+ }
+ } else {
+ if ((not cu_root()->{"Software/Classes/$old_file_type/"}) and
+ (not lm_root()->{"Software/Classes/$old_file_type/"})) {
+ $old_file_type = "";
+ }
+ }
+ }
# admin: whether to remove HKCU entry. admin never _writes_ to HKCU
my $remove_cu = ($mode == 2) && admin();
# can do the following safely:
@@ -913,7 +921,7 @@ sub unregister_extension {
my $file_type = shift;
$extension = '.'.$extension unless $extension =~ /^\./;
remove_from_progids($extension, $file_type);
- my $old_file_type = current_valdata("$extension//");
+ my $old_file_type = current_filetype("$extension");
if ($old_file_type ne $file_type) {
debug("Filetype $extension now $old_file_type; not ours, so not removed\n");
return 1;