#!/usr/bin/perl -w
use Win32::API;
use Math::Int64 qw ( native_to_int64  int64_to_string);
use Data::Dumper;
use warnings;
use strict; 
BEGIN {
    use Config;
    eval ' sub PTR_LET () { "'
    .($Config{ptrsize} == 8 ? 'Q' : 'L').
    '" }';
}

#Win32::API doesnt do enums
Win32::API::Type->typedef( 'SYSTEM_INFORMATION_CLASS', 'ULONG' );
my $api = Win32::API::More->new('ntdll.dll',
'                      
NTSTATUS WINAPI NtQuerySystemInformation(
    SYSTEM_INFORMATION_CLASS SystemInformationClass,
    PVOID SystemInformation,
    ULONG SystemInformationLength,
    PULONG ReturnLength
);');
#uninfomative error, GetLastError should be fetched
die "Win32::API failure" if !$api;

#this should really be a loop, a fixed 65KB is wrong,
#NtQuerySystemInformation will fail with STATUS_INFO_LENGTH_MISMATCH if the buffer
#is not long enough

#changing \x00 to \xff and comparing the before and after will show what
#reserved fields are never filled and truly have no meaning
my $buf = "\x00" x 65000;
my $retlen = 0;
# 5 == SystemProcessInformation
my $ret = $api->Call(5, $buf, length($buf), $retlen );

#todo print NTSTATUS code
die "failed " if $ret;
#ImageName.Buffer is a pointer to inside $buf, if $buf is realloced
#there is a problem, so save the PV, then use that to convert Buffer to
#offset not a ptr later
my $bufptr = unpack(PTR_LET, pack('p', $buf));
#how far are we into the buffer, part of extracting ImageName.Buffer
my $bufoffset = 0;
print "retlen $retlen ret $ret\n";
#cut off uninit data at the end
$buf = substr($buf, 0, $retlen);
my %h;
do {
    ($h{NextEntryOffset},
     $h{NumberOfThreads},
    $h{Reserved1},
    $h{Reserved2},
    $h{Reserved3},
    $h{CreateTime},
    $h{UserTime},
    $h{KernelTime},
    $h{ImageName},
    $h{BasePriority},
    $h{ProcessId},
    $h{InheritedFromProcessId},
    $h{HandleCount},
    $h{Reserved4},
    $h{Reserved5},
    $h{PrivatePageCount}
    ) = unpack('LL(a[8])[6]a[SS'.(PTR_LET eq 'Q' ? 'x!['.PTR_LET.']' : '').PTR_LET.']lx!['.PTR_LET.']'
                        #pid         
                        .PTR_LET.''
                        #parent pid 
                        .PTR_LET.
                        #handle count, 2 reserveds, private page count
                        'LLLL'
                        #VM_COUNTERS VirtualMemoryCounters;
                        #IO_COUNTERS IoCounters;
                        #SYSTEM_THREAD Threads[0];
                        #not done/todo    
                        , $buf);
    #portable 64 bit int conversion, these are strings now
    $h{Reserved1} = int64_to_string(native_to_int64($h{Reserved1}));
    $h{Reserved2} = int64_to_string(native_to_int64($h{Reserved2}));
    $h{Reserved3} = int64_to_string(native_to_int64($h{Reserved3}));
    $h{CreateTime} = int64_to_string(native_to_int64($h{CreateTime}));
    $h{UserTime} = int64_to_string(native_to_int64($h{UserTime}));
    $h{KernelTime} = int64_to_string(native_to_int64($h{KernelTime}));

    {
        #this is still packed, make a copy
        my $in = $h{ImageName};
        $h{ImageName} = {};
        ($h{ImageName}->{Length},
         $h{ImageName}->{MaximumLength},
         $h{ImageName}->{Buffer}
        ) = unpack('SS'.(PTR_LET eq 'Q' ? 'x!['.PTR_LET.']' : '').PTR_LET, $in);
        #Buffer is still packed, but convert the pointer to the offset into the
        #$buf
        $h{ImageName}->{Buffer} = substr($buf, $h{ImageName}->{Buffer}-$bufptr-$bufoffset,
                                         $h{ImageName}->{Length});
        #$h{ImageName}->{Buffer} is in UTF16 wont print nicely to console
    }
    #slice off the processed SYSTEM_PROCESS_INFORMATION struct and trailing
    #VLA/unprocesed data
    $buf = substr($buf, $h{NextEntryOffset});
    $bufoffset += $h{NextEntryOffset};
    print Dumper(\%h);
} while ($h{NextEntryOffset});