NativeCall to Windows API function RegEnumKeyExW resulting in inconsistent and incomplete output

Viewed 83

I have some Raku code using the NativeCall module to make calls to the Windows API:

#! /usr/bin/env raku
use v6;

use NativeCall;

constant BYTE    = uint8;
constant WCHAR   = uint16;   
constant DWORD   = int32;    
constant REGSAM  = int32;
constant WCHARS  = CArray[WCHAR];
constant BYTES   = CArray[BYTE];

constant HKEY_LOCAL_MACHINE = 0x80000002;
constant KEY_QUERY_VALUE   = 0x1 +| 0x0008;
constant ERROR_SUCCESS     = 0; # Yeah, I know. The Win-Api uses 0 for success and other values to indicate errors

sub RegOpenKeyExW( DWORD, WCHARS, DWORD, REGSAM, DWORD is rw) is native("Kernel32.dll") returns DWORD { * };


sub RegQueryValueExW( DWORD, WCHARS, DWORD is rw, DWORD is rw, BYTE is rw, DWORD is rw) is native("Kernel32.dll") returns DWORD { * };

my $key = 'SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths';

my DWORD $hkey;
my $length = 1024;

sub wstr( Str $str ) returns WCHARS {
    my $return = CArray[WCHAR].new( $str.encode.list );
    $return[$return.elems] = 0;
    return $return;
}

my $h-key = RegOpenKeyExW(HKEY_LOCAL_MACHINE, wstr($key), 0, KEY_QUERY_VALUE, $hkey);
say "hkey: $hkey";


sub RegQueryInfoKeyW( int32, int32, int32, int32, int32 is rw, int32 is rw, int32, int32, int32, int32, int32, int32    ) returns int32 is native('kernel32') { * };
my $blah = RegQueryInfoKeyW( $hkey, 0, 0, 0, my int32 $num-subkeys, my int32 $max-sk-len, 0, 0, 0, 0, 0, 0);
say 'max subkey length: ' ~ $max-sk-len;

#arg   name
#1     hkey:        handle to an open reg. key
#2     dwIndex:     the index of the subkey to retrieve
#3     lpName:      pointer to a buffer
#4     lpccName:    pointer to a variable that specifies the size of the buffer specified by lpName param
#5     lpReserved:  unused
#6     lpClass:     pointer to a buffer, can be null
#7     lpcchClass:  pointer to a variable, can be null
#8     lpftLastWriteTime: pointer to a file structure, can be null
sub RegEnumKeyExW(
    int32,                # 1
    int32,                # 2
    CArray[uint16],       # 3
    int32 is rw,          # 4
    int32,                # 5
    CArray[int16],        # 6
    int32,                # 7
    int32                 # 8
) returns int32 is native('kernel32') { * };

my $count;
for 0..$num-subkeys - 1 {
    my $subkeyname = CArray[uint16].new;
    $subkeyname[$_] = 0 for 0..$max-sk-len;
    say 'bing';
    my $result = RegEnumKeyExW($hkey, $_, $subkeyname, $max-sk-len + 1, 0, CArray[int16], 0, 0);
    say 'bang';
    my $name = '';
    for 0..$max-sk-len - 1 {
        $name ~= chr($subkeyname[$_]);
    }

    say $name;
    say '';
    $count++;

}
say $count;

Weirdly, the code only partially works. The last for loop in the code, which repeatedly calls RegEnumKeyExW does not iterate over the entire number of subkeys and crashes, resulting in output that looks like this:

PS Z:\devel> raku RegOpenKeyExW.raku
hkey: 588
max subkey length: 26
bing
bang
cmmgr32.exe

bing
bang
dfshim.dll

bing
bang
fsquirt.exe

<snip>

bing
bang
wab.exe

bing
bang
wabmig.exe

bing
bang
wmplayer.exe

bing

The call to RegEnumKeyExW just suddenly craps out with no warning. Sometimes the call makes it through 10 iterations, sometimes fewer and sometimes less, but it never makes it through the whole loop.

Anyone have any ideas what the problem might be?

UPDATE: Very weirdly, if I tighten up the last loop and remove all extraneous print statements and the inner loop that builds the $subkyename, all the subkeys are iterated over successfully (the looping finishes).

If I modify the last loop to include an inner loop to print characters to the screen, the number of iterations that succeed is dependent upon the number of characters printed as set by the $printx variable. So with a large number of characters printed, say 1000, the loop only completes once before failing. If I print out a only 5 characters, the loop will make it through about 15 iterations. If I remove the inner loop that prints characters, the loop finishes every time. See:

my $count;
my $printx = 5; # changing this value higher or lower will change how many iterations complete before an iteration fails.  
for 0..$num-subkeys - 1 {
    my $subkeyname = CArray[uint16].new;
    $subkeyname[$_] = 0 for 0..$max-sk-len;
    say 'bing';
    my $result = RegEnumKeyExW($hkey, $_, $subkeyname, $max-sk-len + 1, 0, CArray[int16], 0, 0);
    for 0..$printx {
        print 'x';
    }
    $count++;

}
say $count;

UPDATE #2: If I get rid of the loop and replace it with 19 (the number of subkeys) manually typed out calls to RegEnumKeyExW, everything works perfectly.

1 Answers

A knowledgeable person on raku-irc had me set MVM_SPESH_DISABLE=1 in the powershell environment. Once set, the problem was resolved. So there is some kind of bug with the Moar VM.

I found a workaround, which is to move the RegEnumKeyExW function into the loop:

for 0..$num-subkeys - 1 {

    #arg   name
    #1     hkey:        handle to an open reg. key
    #2     dwIndex:     the index of the subkey to retrieve
    #3     lpName:      pointer to a buffer
    #4     lpccName:    pointer to a variable that specifies the size of the buffer specified by lpName param
    #5     lpReserved:  unused
    #6     lpClass:     pointer to a buffer, can be null
    #7     lpcchClass:  pointer to a variable, can be null
    #8     lpftLastWriteTime: pointer to a file structure, can be null
    sub RegEnumKeyExW(
        int32,                # 1
        int32,                # 2
        CArray[uint16],       # 3
        int32 is rw,          # 4
        int32,                # 5
        CArray[int16],        # 6
        int32,                # 7
        int32                 # 8
    ) returns int32 is native('kernel32') { * };

    my $subkeyname = CArray[uint16].new;
    $subkeyname[$_] = 0 for 0..$max-sk-len;
    my $result = RegEnumKeyExW($hkey, $_, $subkeyname, $max-sk-len + 1, 0, CArray[int16], 0, 0);
    for 1..200 {
        print 'x';
    }
    my $name = '';
    for 0..$max-sk-len - 1 {
        $name ~= chr($subkeyname[$_]);
    }

    say $name;

}

Related