Wed Feb 12 13:57:45 2014: Request 92971 was acted upon.
Transaction: Ticket created by markus.ort...@utanet.at
       Queue: Win32-API
     Subject: Win32::API::Struct (v 0.65) and fixed length WCHAR array crashes 
Perl
   Broken in: (no value)
    Severity: (no value)
       Owner: Nobody
  Requestors: markus.ort...@utanet.at
      Status: new
 Ticket <URL: https://rt.cpan.org/Ticket/Display.html?id=92971 >


Dear Daniel and Cosimo,

I was using the impressive Win32::API module to make a call to the 
kernel function GetTimeZoneInformation, which is defined as

     DWORD GetTimeZoneInformation(LPTIME_ZONE_INFORMATION 
lpTimeZoneInformation)

and used Win32::API::Struct (v0.65) to define the TIME_ZONE_INFORMATION 
structure:

     Win32::API::Struct->typedef( TIME_ZONE_INFORMATION => qw{
         LONG       Bias;
         WCHAR      StandardName[32];
         SYSTEMTIME   StandardDate;
         LONG       StandardBias;
         WCHAR      DaylightName[32];
         SYSTEMTIME   DaylightDate;
         LONG       DaylightBias;
     });

However, Perl crashes when I use following code:

     my $tz = Win32::API::Struct->new('TIME_ZONE_INFORMATION');
     GetTimeZoneInformation($tz) or die "GetTimeZoneInformation failed: 
$^E\n";

I figured out that the root cause of the crash was the packing / 
unpacking of the item StandardName (and DaylightName), which is a fixed 
length, wide character string of type WCHAR that is 'UTF-16LE' encoded.

This is because Win32::API::Struct::getPack and 
Win32::API::Struct::getUnpack do not take the size of the type into 
account, but always assume a 8-bit type size (CHAR):

258:            if ($type =~ /\w\*(\d+)/) {
259:                $repeat = $1;
260:                $type = "a$repeat";
261:            }
...
350:            if ($type =~ /\w\*(\d+)/) {
351:                $repeat = $1;
352:                $type = "Z$repeat";
353:            }

However, for the "$packed_size" the correct value "$type_size * $repeat" 
is calculated:

358:            $packed_size += ( $type_size * $repeat ) + $type_align;

So, at a first glance I would suggest to use the corrected repeat count 
also in line 259 and 351, respectively. Furthermore, getUnpack should 
not assume a null-terminated (ASCIZ) string, but a string with arbitrary 
binary data as getPack does:

258:            if ($type =~ /\w\*(\d+)/) {
259:                $repeat = $1**Win32::API::Type::sizeof($orig)*;
260:                $type = "a$repeat";
261:            }
...
350:            if ($type =~ /\w\*(\d+)/) {
351:                $repeat = $1**Win32::API::Type::sizeof($orig)*;
352:                $type = "*a*$repeat";
353:            }

In order to remain compatible, getUnpack may assume a null-terminated 
string if and only if the original type is CHAR (or TCHAR). I have not 
checked if it is also possible to implement a decoding of a WCHAR that 
is encoded as 'UTF-16LE'.

I tested the module with above modifications and it is working fine.

Is it possible to make a correction in a future update of this module to 
handle non-CHAR fixed length arrays correctly?

With kind regards,
Markus




Reply via email to