C:\sources>perl w32jobobj.pl 50 100
Opened process PID 14332Success, Perl assembled the 52428812 bytes long string.
It will now be printed to STDOUT.  2 kernel handles were leaked in this code.
This is a good time to hit Ctrl-C instead of hitting Spacebar or Enter.Press any
 key to continue . . .

##</code><code>##

C:\sources>perl w32jobobj.pl 110 100
Out of memory!
Opened process PID 7844
C:\sources>

##</code><code>##

# this script leaks 2 kernel handles, fix that before putting into production
use Win32::API;
use warnings;
use strict;

BEGIN {
    sub PROCESS_TERMINATE { return 0x0001; }
    sub PROCESS_DUP_HANDLE {return 0x0040; } 
    sub PROCESS_SET_QUOTA  {return 0x0100; }
    sub FALSE  {return 0; }
    sub INVALID_HANDLE_VALUE { return -1; }
    sub JobObjectExtendedLimitInformation { return 9;}
    sub JOB_OBJECT_QUERY { return 0x0004; }
    sub JOB_OBJECT_LIMIT_WORKINGSET { return 0x00000001; }
    sub JOB_OBJECT_LIMIT_PROCESS_TIME { return 0x00000002; }
    sub JOB_OBJECT_LIMIT_JOB_TIME { return 0x00000004; }
    sub JOB_OBJECT_LIMIT_ACTIVE_PROCESS { return 0x00000008; }
    sub JOB_OBJECT_LIMIT_AFFINITY { return 0x00000010; }
    sub JOB_OBJECT_LIMIT_PRIORITY_CLASS { return 0x00000020; }
    sub JOB_OBJECT_LIMIT_PRESERVE_JOB_TIME { return 0x00000040; }
    sub JOB_OBJECT_LIMIT_SCHEDULING_CLASS { return 0x00000080; }
    sub JOB_OBJECT_LIMIT_PROCESS_MEMORY { return 0x00000100; }
    sub JOB_OBJECT_LIMIT_JOB_MEMORY { return 0x00000200; }
    sub JOB_OBJECT_LIMIT_JOB_MEMORY_HIGH { return JOB_OBJECT_LIMIT_JOB_MEMORY; }
    sub JOB_OBJECT_LIMIT_DIE_ON_UNHANDLED_EXCEPTION { return 0x00000400; }
    sub JOB_OBJECT_LIMIT_BREAKAWAY_OK { return 0x00000800; }
    sub JOB_OBJECT_LIMIT_SILENT_BREAKAWAY_OK { return 0x00001000; }
    sub JOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE { return 0x00002000; }
    sub JOB_OBJECT_LIMIT_SUBSET_AFFINITY { return 0x00004000; }
    sub JOB_OBJECT_LIMIT_JOB_MEMORY_LOW { return 0x00008000; }
    sub JOB_OBJECT_LIMIT_JOB_READ_BYTES { return 0x00010000; }
    sub JOB_OBJECT_LIMIT_JOB_WRITE_BYTES { return 0x00020000; }
    sub JOB_OBJECT_LIMIT_RATE_CONTROL { return 0x00040000; }
    sub JOB_OBJECT_LIMIT_CPU_RATE_CONTROL{ return JOB_OBJECT_LIMIT_RATE_CONTROL; }
    sub JOB_OBJECT_LIMIT_IO_RATE_CONTROL { return 0x00080000; }
    sub JOB_OBJECT_LIMIT_NET_RATE_CONTROL { return 0x00100000; }
    sub JOB_OBJECT_LIMIT_VALID_FLAGS { return 0x0007ffff; }
    sub DUPLICATE_SAME_ACCESS { return 0x00000002; }
}
    die "Usage: perl win32_memleak_rsrc_limits.pl len_in_MBs_build_test_string RAM_quota_limit_in_MBs\n"
       if scalar(@ARGV) != 2 || !defined($ARGV[0]) || !defined($ARGV[1]);
    my ($howManyMBsString, $howManyMBsProcessRAMLimit) = ($ARGV[0]+0, $ARGV[1]+0);
    Win32::API::Type->typedef( 'LARGE_INTEGER', 'unsigned __int64');
    # I have no idea why the ::Type->typedef('ULONG_PTR', 64_bits is required by
    #   uname = Win32 strawberry-perl 5.32.1.1 #1 Sun Jan 24 12:17:47 2021 i386
    #   archname = MSWin32-x86-multi-thread-64int
    # which has 32 bit ptrs, and 'ULONG_PTR' is a size_t/ptr sized type
    # so its 4 bytes on i386, and 8 bytes on AMD64, but i386 strawberry or
    # the 32-bit edition of kernel32.dll want it as 64b inside a 32 bit process
    Win32::API::Type->typedef('ULONG_PTR', 'unsigned __int64');
    # This is the correct typedef for ULONG_PTR, which is defined by MS as an
    # unsigned pointer sized integer, aka "void *" aka "size_t".  The HANDLE
    # typedef works works in AMD64 Win64 Perl as expected:
    #       Win32::API::Type->typedef('ULONG_PTR', 'HANDLE');
    # but on Strawberry 5.32 i386 on Win7 AMD64, it fails with
    #       $SetInformationJobObject->Call() GLR=87 at w32jobobj.pl line 167.
    # so 'ULONG_PTR' == 'unsigned __int64' is needed on i386 for this demo
    # script on i386 Perls but it makes no sense, there is a bug somewhere.
    # ~~~ bulk88

    Win32::API::Type->typedef('JOBOBJECTINFOCLASS', 'int'); # C type enum aka I32
    my $OpenProcess = Win32::API::More->new( 'kernel32',
        'HANDLE OpenProcess( DWORD dwDesiredAccess,  BOOL  bInheritHandle, DWORD dwProcessId)');
    if (!$OpenProcess) { die 'OpenProcess GLR='.Win32::GetLastError(); }

    my $dwPID = $$;
    my $hProcess = $OpenProcess->Call(PROCESS_SET_QUOTA|PROCESS_TERMINATE|PROCESS_DUP_HANDLE, FALSE, $dwPID);
    if (! $hProcess || $hProcess == INVALID_HANDLE_VALUE) {
        printf("Could not open process PID %d, GLR=%d\n", $dwPID, Win32::GetLastError());
        exit 1;
    } else {
        printf("Opened process PID %d", $dwPID);
    }
    typedef Win32::API::Struct 'JOBOBJECT_BASIC_LIMIT_INFORMATION' => qw(
        LARGE_INTEGER PerProcessUserTimeLimit;
        LARGE_INTEGER PerJobUserTimeLimit;
        DWORD LimitFlags;
        SIZE_T MinimumWorkingSetSize;
        SIZE_T MaximumWorkingSetSize;
        DWORD ActiveProcessLimit;
        ULONG_PTR Affinity;
        DWORD PriorityClass;
        DWORD SchedulingClass;
    );
    typedef Win32::API::Struct 'IO_COUNTERS' => qw(
        ULONGLONG  ReadOperationCount;
        ULONGLONG  WriteOperationCount;
        ULONGLONG  OtherOperationCount;
        ULONGLONG ReadTransferCount;
        ULONGLONG WriteTransferCount;
        ULONGLONG OtherTransferCount;
    );
     Win32::API::Struct->typedef( 'JOBOBJECT_EXTENDED_LIMIT_INFORMATION' => qw(
        JOBOBJECT_BASIC_LIMIT_INFORMATION BasicLimitInformation;
        IO_COUNTERS IoInfo;
        SIZE_T ProcessMemoryLimit;
        SIZE_T JobMemoryLimit;
        SIZE_T PeakProcessMemoryUsed;
        SIZE_T PeakJobMemoryUsed;
    ));

    my $BasicLimitInformation = Win32::API::Struct->new('JOBOBJECT_BASIC_LIMIT_INFORMATION');
    $BasicLimitInformation->{PerProcessUserTimeLimit} = 0;
    $BasicLimitInformation->{PerJobUserTimeLimit} = 0;
    $BasicLimitInformation->{LimitFlags} = 0;
    $BasicLimitInformation->{MinimumWorkingSetSize} = 0;
    $BasicLimitInformation->{MaximumWorkingSetSize} = 0;
    $BasicLimitInformation->{ActiveProcessLimit} = 0;
    $BasicLimitInformation->{Affinity} = 0;
    $BasicLimitInformation->{PriorityClass} = 0;
    $BasicLimitInformation->{SchedulingClass} = 0;

    my $IoInfo = Win32::API::Struct->new('IO_COUNTERS');
    $IoInfo->{ReadOperationCount} = 0;
    $IoInfo->{WriteOperationCount} = 0;
    $IoInfo->{OtherOperationCount} = 0;
    $IoInfo->{ReadTransferCount} = 0;
    $IoInfo->{WriteTransferCount} = 0;
    $IoInfo->{OtherTransferCount} = 0;

    my $jelInfo = Win32::API::Struct->new('JOBOBJECT_EXTENDED_LIMIT_INFORMATION');
    $jelInfo->{BasicLimitInformation} = $BasicLimitInformation;
    $jelInfo->{IoInfo} = $IoInfo;

    $jelInfo->{ProcessMemoryLimit} = 0;
    $jelInfo->{JobMemoryLimit} = 0;
    $jelInfo->{PeakProcessMemoryUsed} = 0;
    $jelInfo->{PeakJobMemoryUsed} = 0;

    #my $CreateJobObject =  Win32::API::More->new( 'kernel32',
    #    'HANDLE CreateJobObjectA(LPSECURITY_ATTRIBUTES lpJobAttributes, LPCSTR lpName)');
    my $CreateJobObject =  Win32::API::More->new( 'kernel32',
        'HANDLE CreateJobObjectA(HANDLE lpJobAttributes, HANDLE lpName)');
    if(!$CreateJobObject) { die 'CreateJobObject GLR=' . Win32::GetLastError();}

    my $hJob = $CreateJobObject->Call(0,0); # XXX $hJob HANDLE is LEAKED XXX
    my( $dwProcessLimit,        $dwJobMemory,  $dwProcessMemory,
        $bKillProcOnJobClose,   $bBreakAwayOK, $bSilentBreakAwayOK);

    $dwJobMemory = $howManyMBsProcessRAMLimit * 1024 * 1024;
    if ($dwProcessLimit){
        $jelInfo->{BasicLimitInformation}->{LimitFlags} |= JOB_OBJECT_LIMIT_ACTIVE_PROCESS;
        $jelInfo->{BasicLimitInformation}->{ActiveProcessLimit} = $dwProcessLimit;
    }

    if ($dwJobMemory){
        $jelInfo->{BasicLimitInformation}->{LimitFlags} |= JOB_OBJECT_LIMIT_JOB_MEMORY;
        $jelInfo->{JobMemoryLimit} = $dwJobMemory;
    }
    if ($dwProcessMemory) {
        $jelInfo->{BasicLimitInformation}->{LimitFlags} |= JOB_OBJECT_LIMIT_PROCESS_MEMORY;
        $jelInfo->{ProcessMemoryLimit} = $dwProcessMemory;
    }
    if ($bKillProcOnJobClose) {
        $jelInfo->{BasicLimitInformation}->{LimitFlags} |= JOB_OBJECT_LIMIT_KILL_ON_JOB_CLOSE;
    }
    if ($bBreakAwayOK) {
        $jelInfo->{BasicLimitInformation}->{LimitFlags} |= JOB_OBJECT_LIMIT_BREAKAWAY_OK;
    }
    if ($bSilentBreakAwayOK) {
        $jelInfo->{BasicLimitInformation}->{LimitFlags} |= JOB_OBJECT_LIMIT_SILENT_BREAKAWAY_OK;
    }


    my $SetInformationJobObject =  Win32::API::More->new( 'kernel32',
        'BOOL SetInformationJobObject(HANDLE hJob,'
            .' JOBOBJECTINFOCLASS JobObjectInformationClass,'
            #.' LPVOID lpJobObjectInformation,'
            .' JOBOBJECT_EXTENDED_LIMIT_INFORMATION * lpJobObjectInformation,'
            .' DWORD cbJobObjectInformationLength)');
    if (!$SetInformationJobObject) {
        die 'SetInformationJobObject GLR=' . Win32::GetLastError();
    }
    my $b = $SetInformationJobObject->Call($hJob, JobObjectExtendedLimitInformation, $jelInfo, $jelInfo->sizeof());
    if (!$b) {
        die '$SetInformationJobObject->Call() GLR=' . Win32::GetLastError();
    }

    my $DuplicateHandle =  Win32::API::More->new( 'kernel32', 'BOOL DuplicateHandle(
        HANDLE   hSourceProcessHandle,
        HANDLE   hSourceHandle,
        HANDLE   hTargetProcessHandle,
        LPHANDLE lpTargetHandle,
        DWORD    dwDesiredAccess,
        BOOL     bInheritHandle,
        DWORD    dwOptions
    )');
    if (!$DuplicateHandle) { die '$DuplicateHandle GLR=' . Win32::GetLastError();}
    my $GetCurrentProcess =  Win32::API::More->new( 'kernel32', 'HANDLE GetCurrentProcess()');
    if (!$GetCurrentProcess) { die '$GetCurrentProcess GLR=' . Win32::GetLastError();}

    my $hCurrentProcess = 0; # XXX this is LEAKED XXX
    $b = $DuplicateHandle->Call($GetCurrentProcess->Call(),
                                $GetCurrentProcess->Call(),
                                $GetCurrentProcess->Call(),
                                $hCurrentProcess,
                                0, !!0, DUPLICATE_SAME_ACCESS);
    if (!$b) { die '$DuplicateHandle->Call() GLR=' . Win32::GetLastError(); }
    my $AssignProcessToJobObject =  Win32::API::More->new( 'kernel32',
        'BOOL AssignProcessToJobObject( HANDLE hJob, HANDLE hProcess)');
    if (!$AssignProcessToJobObject) { die '$AssignProcessToJobObject GLR=' . Win32::GetLastError(); }
    # passing AssignProcessToJobObject() the psuedo-handle/perma-const from
    # GetCurrentProcess() makes it fail with 87 ERROR_INVALID_PARAMETER
    $b = $AssignProcessToJobObject->Call($hJob, $hCurrentProcess);
    if (!$b) { die '$AssignProcessToJobObject->Call() GLR=' . Win32::GetLastError(); }
    my $str = '';
    my $tstr;
    while (length ($str) < ($howManyMBsString * 1024 * 1024)) {
        $tstr = sprintf('_123456789abcd_%016x',length($str));
        $str .= $tstr;
        #print $tstr;
    }
    print "Success, Perl assembled the ".length($str)." bytes long string.\n"
        ."It will now be printed to STDOUT.  "
        ."2 kernel handles were leaked in this code.\n"
        ."This is a good time to hit Ctrl-C instead of hitting Spacebar or Enter.";
    system 'pause';
    print $str;