| Subject: | DateTime\TimeZone\Local\Win32.pm is requesting too much registry access |
I'm using:
DateTime-TimeZone-0.74
Win32-TieRegistry-0.26.
Perl 5.8.8
Windows Server 2003
I received the error: 'Cannot determine local time zone' when
attempting to determine the local time zone from a web application on a
Windows server. The same code worked when running from the command line
as an administrator.
The source of the bug is that by default, Win32::TieRegistry requests
read and write access. Here is a quote from its documentation:
The "Access" option specifies what level of access to the Registry key
you wish to have once it has been opened. If this option is not
specified, the new key [$subKey] is opened with the same access level
used when the old key [$key] was opened. The virtual root of the
Registry pretends it was opened with access KEY_READ()|KEY_WRITE() so
this is the default access when opening keys directory via $Registry.
If you don't plan on modifying a key, you should open it with KEY_READ
access as you may not have KEY_WRITE access to it or some of its
subkeys.
I'm not sure how to change the access with a Tied Hash, but I was able
to change the code using Win32::TieRegistry objects. I've attached a
patch of that change.
| Subject: | DateTime-TimeZone-Local-Win32.patch |
--- C:\Perl\site\lib\DateTime\TimeZone\Local\Win32.pm Mon Mar 24 16:37:06 2008
+++ D:\Perl\site\lib\DateTime\TimeZone\Local\Win32.pm Mon Apr 21 17:16:15 2008
@@ -6,7 +6,7 @@
use base 'DateTime::TimeZone::Local';
my %Registry;
-use Win32::TieRegistry ( TiedHash => \%Registry );
+use Win32::TieRegistry(Delimiter=>"/");
sub Methods { return qw( FromEnv FromRegistry ) }
@@ -180,13 +180,14 @@
);
my $Key =
- 'HKEY_LOCAL_MACHINE\\SYSTEM\\CurrentControlSet\\Control\\TimeZoneInformation\\StandardName';
+ 'LMachine/SYSTEM/CurrentControlSet/Control/TimeZoneInformation';
sub FromRegistry
{
my $class = shift;
- my $win_name = $Registry{$Key};
+ my $keyObject = $Registry->Open($Key, {Access=>Win32::TieRegistry::KEY_READ()});
+ my $win_name = $keyObject->{'/StandardName'};
return unless $win_name;