[Delphi] Check if ASLR is enabled

[Agmcz]

Check if ASLR is enabled.

{************************************
* Coded by Agmcz                    *
* Hints by naquadria                *
* Date: 2018-01-07                  *
************************************}

unit uCheckASLR;

interface

uses
  Windows;

function CheckASLR(const FileName: string): Boolean;

implementation

const
  IMAGE_DLLCHARACTERISTICS_DYNAMIC_BASE = $0040;
  IMAGE_DIRECTORY_ENTRY_BASERELOC = 5;

function CheckASLR(const FileName: string): Boolean;
var
  hFile: THandle;
  hMapping: DWORD;
  pMap: Pointer;
  dwSize: DWORD;
  IDH: PImageDosHeader;
  INH: PImageNtHeaders;
  ISH: PImageSectionHeader;
  n: Word;
  dwRelocAddr, dwRelocSize: DWORD;
begin
  Result := False;
  hFile := CreateFile(PChar(FileName), GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
  if hFile <> INVALID_HANDLE_VALUE then
  begin
    dwSize := GetFileSize(hFile, nil);
    hMapping := CreateFileMapping(hFile, nil, PAGE_READONLY, 0, dwSize, nil);
    if hMapping <> 0 then
    begin
      pMap := MapViewOfFile(hMapping, FILE_MAP_READ, 0, 0, 0);
      if pMap <> nil then
      begin
        IDH := PImageDosHeader(pMap);
        if IDH.e_magic = IMAGE_DOS_SIGNATURE then
        begin
          INH := PImageNtHeaders(DWORD(pMap) + LongWord(IDH._lfanew));
          if INH.Signature = IMAGE_NT_SIGNATURE then
          begin
            if (INH.OptionalHeader.DllCharacteristics and IMAGE_DLLCHARACTERISTICS_DYNAMIC_BASE) = IMAGE_DLLCHARACTERISTICS_DYNAMIC_BASE then
            begin
              ISH := PImageSectionHeader(DWORD(pMap) + LongWord(IDH._lfanew) + SizeOf(DWORD) + SizeOf(INH.FileHeader) + INH.FileHeader.SizeOfOptionalHeader);
              dwRelocAddr := INH.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_BASERELOC].VirtualAddress;
              dwRelocSize := INH.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_BASERELOC].Size;
              if (dwRelocAddr <> 0) and (dwRelocSize <> 0) then
              begin
                for n := 0 to INH.FileHeader.NumberOfSections - 1 do
                begin
                  if ISH.VirtualAddress = dwRelocAddr then
                  begin
                    if (ISH.Misc.VirtualSize <> 0) and  (ISH.PointerToRawData <> 0) and (ISH.SizeOfRawData <> 0) then
                      Result := True;
                    Break;
                  end;
                  Inc(ISH);
                end;
              end;
            end;
          end;
        end;
        UnmapViewOfFile(pMap);
      end;
      CloseHandle(hMapping);
    end;
    CloseHandle(hFile);
  end;
end;

end.

[ontryit]

Can post the attachment outside of this board? Thx

[NoneForce]

Hi,

https://nofile.io/f/YtbJBoKEcTt/ASLR+Checker.rar

[dosprog]

Why not simply check the bit "Relocations Stripped" at PE characteristics, as does the PE_ASLR.HEM HIEW32 plugin?

[Kerlingen]

Because that's just plain wrong, the two flags don't exclude each other.

[dosprog]

But when DLLCHARACTERISTICS.RelocationsStrippedBit=1 all others ignored. Agree?

..however you are right, if the file is processed by the plugin PE_ASLR.HEM with this bit set to 1, then additional checks will be required after clear it.

[Kerlingen]

Microsoft didn't implement two linker options for fun, these are two individual flags doing different things and can be enabled or disabled independently from each other.

So if you want to know if a file is ASLR enabled, then you check the flag telling you if a file is ASLR enabled and not the flag telling you if a file has relocations.

(I'm aware the code posted here does check for a relocation table, but relocations are no requirement for ASLR)

[Agmcz]

you must check bit "IMAGE_DLLCHARACTERISTICS_DYNAMIC_BASE" in PE.OPTIONAL_HEADER.DllCharacteristics member.

[Agmcz]

more...
check if ASLR is enabled from process

unit uCheckASLR;

// Original C++ Source: https://stackoverflow.com/questions/47105480/how-to-check-if-aslr-is-enabled-for-a-process
// Converted to Delphi by Agmcz 28-12-2017 2:25:32

interface

uses
  Windows;

function CheckASLR(dwProcessId: ULONG; out bASLR: Boolean): ULONG;

implementation

const
  PROCESS_QUERY_LIMITED_INFORMATION = $1000;

type
 TSectionImageInformation  = record
    TransferAddress: Pointer;
    ZeroBits: ULONG;
    MaximumStackSize: ULONG;
    CommittedStackSize: ULONG;
    SubSystemType: ULONG;
    MinorSubsystemVersion: Word;
    MajorSubsystemVersion: Word;
    GpValue: ULONG;
    ImageCharacteristics: Word;
    DllCharacteristics: Word;
    Machine: Word;
    ImageContainsCode: Boolean;
    ImageFlags: Byte;
    LoaderFlags: ULONG;
    ImageFileSize: ULONG;
    CheckSum: ULONG;
  end;

  PROCESSINFOCLASS = (
    ProcessBasicInformation,
    ProcessQuotaLimits,
    ProcessIoCounters,
    ProcessVmCounters,
    ProcessTimes,
    ProcessBasePriority,
    ProcessRaisePriority,
    ProcessDebugPort,
    ProcessExceptionPort,
    ProcessAccessToken,
    ProcessLdtInformation,
    ProcessLdtSize,
    ProcessDefaultHardErrorMode,
    ProcessIoPortHandlers,
    ProcessPooledUsageAndLimits,
    ProcessWorkingSetWatch,
    ProcessUserModeIOPL,
    ProcessEnableAlignmentFaultFixup,
    ProcessPriorityClass,
    ProcessWx86Information,
    ProcessHandleCount,
    ProcessAffinityMask,
    ProcessPriorityBoost,
    ProcessDeviceMap,
    ProcessSessionInformation,
    ProcessForegroundInformation,
    ProcessWow64Information,
    ProcessImageFileName,
    ProcessLUIDDeviceMapsEnabled,
    ProcessBreakOnTermination,
    ProcessDebugObjectHandle,
    ProcessDebugFlags,
    ProcessHandleTracing,
    ProcessIoPriority,
    ProcessExecuteFlags,
    ProcessResourceManagement,
    ProcessCookie,
    ProcessImageInformation,
    MaxProcessInfoClass);

type
  NTSTATUS = LongWord;

function NtQueryInformationProcess(ProcessHandle: THandle; ProcessInformationClass: PROCESSINFOCLASS; ProcessInformation: Pointer; ProcessInformationLength: ULONG; ReturnLength: PULONG ): LongInt; stdcall; external 'ntdll.dll';
function RtlNtStatusToDosError(Status: NTSTATUS): Integer; stdcall; external 'ntdll.dll';

function CheckASLR(dwProcessId: ULONG; out bASLR: Boolean): ULONG;
var
 hProcess: THandle;
 sii: TSectionImageInformation;
 status: NTSTATUS;
begin
  hProcess := OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, False, dwProcessId);
  if (hProcess <> 0) and (hProcess <> INVALID_HANDLE_VALUE) then
  begin
    status := NtQueryInformationProcess(hProcess, ProcessImageInformation, @sii, SizeOf(sii), 0);
    CloseHandle(hProcess);
    if 0 <= status then
    begin
      bASLR := Boolean(sii.ImageFlags);
      Result := NOERROR;
      Exit;
    end;
    Result := RtlNtStatusToDosError(status);
    Exit;
  end;
  Result := GetLastError;
end;

end.

[evlncrn8]

theres a bug in the code above..

bASLR := Boolean(sii.ImageFlags);

right there..

ImageFlags is a set of bitflags, to test for the aslr portion you need to and it and check the result, so you need to check bit 2, you're just blindly assuming that any non zero value for the whole thing means alsr is enabled.. this is wrong

-----

UINT8 ImageFlags; // 0x0023 / 0x0033; 0x0001 / 0x0001 Bytes
struct // 7 / 7 elements; 0x0001 / 0x0001 Bytes
{
UINT8 ComPlusNativeReady : 1; // 0x0023 / 0x0033; Bit: 0
UINT8 ComPlusILOnly : 1; // 0x0023 / 0x0033; Bit: 1
UINT8 ImageDynamicallyRelocated : 1; // 0x0023 / 0x0033; Bit: 2
UINT8 ImageMappedFlat : 1; // 0x0023 / 0x0033; Bit: 3
UINT8 BaseBelow4gb : 1; // 0x0023 / 0x0033; Bit: 4
UINT8 ComPlusPrefer32bit : 1; // 0x0023 / 0x0033; Bit: 5
UINT8 Reserved : 2; // 0x0023 / 0x0033; Bits: 6 - 7
};

[Agmcz]

Okay
now it works correctly.

unit uCheckASLR;

// Original C++ Source: https://stackoverflow.com/questions/47105480/how-to-check-if-aslr-is-enabled-for-a-process
// Ported to Delphi by Agmcz 28-12-2017 2:25:32
// Fix 04-08-2018 10:56:25

interface

uses
  Windows;

function CheckASLR(dwProcessId: LongWord; out bASLR: Boolean): LongWord;

implementation

const
  PROCESS_QUERY_LIMITED_INFORMATION = $1000;

type
 TSectionImageInformation  = record
    TransferAddress: Pointer;
    ZeroBits: LongWord;
    MaximumStackSize: LongWord;
    CommittedStackSize: LongWord;
    SubSystemType: LongWord;
    MinorSubsystemVersion: Word;
    MajorSubsystemVersion: Word;
    GpValue: LongWord;
    ImageCharacteristics: Word;
    DllCharacteristics: Word;
    Machine: Word;
    ImageContainsCode: Boolean;
    ImageFlags: Byte;
    LoaderFlags: LongWord;
    ImageFileSize: LongWord;
    CheckSum: LongWord;
  end;

  PROCESSINFOCLASS = (
    ProcessBasicInformation,
    ProcessQuotaLimits,
    ProcessIoCounters,
    ProcessVmCounters,
    ProcessTimes,
    ProcessBasePriority,
    ProcessRaisePriority,
    ProcessDebugPort,
    ProcessExceptionPort,
    ProcessAccessToken,
    ProcessLdtInformation,
    ProcessLdtSize,
    ProcessDefaultHardErrorMode,
    ProcessIoPortHandlers,
    ProcessPooledUsageAndLimits,
    ProcessWorkingSetWatch,
    ProcessUserModeIOPL,
    ProcessEnableAlignmentFaultFixup,
    ProcessPriorityClass,
    ProcessWx86Information,
    ProcessHandleCount,
    ProcessAffinityMask,
    ProcessPriorityBoost,
    ProcessDeviceMap,
    ProcessSessionInformation,
    ProcessForegroundInformation,
    ProcessWow64Information,
    ProcessImageFileName,
    ProcessLUIDDeviceMapsEnabled,
    ProcessBreakOnTermination,
    ProcessDebugObjectHandle,
    ProcessDebugFlags,
    ProcessHandleTracing,
    ProcessIoPriority,
    ProcessExecuteFlags,
    ProcessResourceManagement,
    ProcessCookie,
    ProcessImageInformation,
    MaxProcessInfoClass);

type
  NTSTATUS = LongWord;

function NtQueryInformationProcess(ProcessHandle: THandle; ProcessInformationClass: PROCESSINFOCLASS; ProcessInformation: Pointer; ProcessInformationLength: ULONG; ReturnLength: PULONG ): LongInt; stdcall; external 'ntdll.dll';
function RtlNtStatusToDosError(Status: NTSTATUS): Integer; stdcall; external 'ntdll.dll';

function ImageDynamicallyRelocated(sii: TSectionImageInformation): Boolean;
begin
  Result := (sii.ImageFlags and (1 shl 2)) = 1;
end;

function CheckASLR(dwProcessId: LongWord; out bASLR: Boolean): LongWord;
var
 hProcess: THandle;
 sii: TSectionImageInformation;
 status: NTSTATUS;
begin
  hProcess := OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, False, dwProcessId);
  if (hProcess <> 0) and (hProcess <> INVALID_HANDLE_VALUE) then
  begin
    status := NtQueryInformationProcess(hProcess, ProcessImageInformation, @sii, SizeOf(sii), 0);
    CloseHandle(hProcess);
    if 0 <= status then
    begin
      bASLR := ImageDynamicallyRelocated(sii);
      Result := NOERROR;
      Exit;
    end;
    Result := RtlNtStatusToDosError(status);
    Exit;
  end;
  Result := GetLastError;
end;

end.

[allan]

What is the version of Delphi that you guys are using?

[Agmcz]

Fix func ImageDynamicallyRelocated

unit uCheckASLR;

// Original C++ Source: https://stackoverflow.com/questions/47105480/how-to-check-if-aslr-is-enabled-for-a-process
// Ported to Delphi by Agmcz 28-12-2017 2:25:32
// Fix 08-04-2018 10:56:25
// Fix2 01-05-2018 2:28:15

interface

uses
  Windows;

function CheckASLR(dwProcessId: LongWord; out bASLR: Boolean): LongWord;

implementation

const
  PROCESS_QUERY_LIMITED_INFORMATION = $1000;

type
 TSectionImageInformation  = record
    TransferAddress: Pointer;
    ZeroBits: LongWord;
    MaximumStackSize: LongWord;
    CommittedStackSize: LongWord;
    SubSystemType: LongWord;
    MinorSubsystemVersion: Word;
    MajorSubsystemVersion: Word;
    GpValue: LongWord;
    ImageCharacteristics: Word;
    DllCharacteristics: Word;
    Machine: Word;
    ImageContainsCode: Boolean;
    ImageFlags: Byte;
    LoaderFlags: LongWord;
    ImageFileSize: LongWord;
    CheckSum: LongWord;
  end;

  PROCESSINFOCLASS = (
    ProcessBasicInformation,
    ProcessQuotaLimits,
    ProcessIoCounters,
    ProcessVmCounters,
    ProcessTimes,
    ProcessBasePriority,
    ProcessRaisePriority,
    ProcessDebugPort,
    ProcessExceptionPort,
    ProcessAccessToken,
    ProcessLdtInformation,
    ProcessLdtSize,
    ProcessDefaultHardErrorMode,
    ProcessIoPortHandlers,
    ProcessPooledUsageAndLimits,
    ProcessWorkingSetWatch,
    ProcessUserModeIOPL,
    ProcessEnableAlignmentFaultFixup,
    ProcessPriorityClass,
    ProcessWx86Information,
    ProcessHandleCount,
    ProcessAffinityMask,
    ProcessPriorityBoost,
    ProcessDeviceMap,
    ProcessSessionInformation,
    ProcessForegroundInformation,
    ProcessWow64Information,
    ProcessImageFileName,
    ProcessLUIDDeviceMapsEnabled,
    ProcessBreakOnTermination,
    ProcessDebugObjectHandle,
    ProcessDebugFlags,
    ProcessHandleTracing,
    ProcessIoPriority,
    ProcessExecuteFlags,
    ProcessTlsInformation,
    ProcessCookie,
    ProcessImageInformation,
    ProcessCycleTime,
    ProcessPagePriority,
    ProcessInstrumentationCallback,
    ProcessThreadStackAllocation,
    ProcessWorkingSetWatchEx,
    ProcessImageFileNameWin32,
    ProcessImageFileMapping,
    ProcessAffinityUpdateMode,
    ProcessMemoryAllocationMode,
    ProcessGroupInformation,
    ProcessTokenVirtualizationEnabled,
    ProcessConsoleHostProcess,
    ProcessWindowInformation,
    MaxProcessInfoClass);

type
  NTSTATUS = LongWord;

function NtQueryInformationProcess(ProcessHandle: THandle; ProcessInformationClass: PROCESSINFOCLASS; ProcessInformation: Pointer; ProcessInformationLength: ULONG; ReturnLength: PULONG ): LongInt; stdcall; external 'ntdll.dll';
function RtlNtStatusToDosError(Status: NTSTATUS): Integer; stdcall; external 'ntdll.dll';

function ImageDynamicallyRelocated(sii: TSectionImageInformation): Boolean;
asm
  MOVZX EAX, BYTE PTR SS:[sii.ImageFlags]
  SHR AL, 2
  AND EAX, 1
end;

function CheckASLR(dwProcessId: LongWord; out bASLR: Boolean): LongWord;
var
 hProcess: THandle;
 sii: TSectionImageInformation;
 status: NTSTATUS;
begin
  hProcess := OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, False, dwProcessId);
  if (hProcess <> 0) and (hProcess <> INVALID_HANDLE_VALUE) then
  begin
    status := NtQueryInformationProcess(hProcess, ProcessImageInformation, @sii, SizeOf(sii), 0);
    CloseHandle(hProcess);
    if 0 <= status then
    begin
      bASLR := ImageDynamicallyRelocated(sii);
      Result := NOERROR;
      Exit;
    end;
    Result := RtlNtStatusToDosError(status);
    Exit;
  end;
  Result := GetLastError;
end;

end.

[Agmcz]

Originally Posted by allan

What is the version of Delphi that you guys are using?

You can use delphi7 or a newer version.

[Agmcz]

More..
Check ASLR from Remote PEB

unit uCheckASLR;

{************************************
* Coded by Agmcz                    *
* Date: 01-05-2018                  *
************************************}

interface

uses
  Windows;

function CheckASLRPEB32(hProcess: THandle): Boolean;

implementation

type
  PProcessBasicInformation = ^TProcessBasicInformation;
  TProcessBasicInformation = record
    ExitStatus: LongInt;
    PebBaseAddress: Pointer;
    AffinityMask: Cardinal;
    BasePriority: LongInt;
    UniqueProcessId: Cardinal;
    InheritedFromUniqueProcessId: Cardinal;
  end;

function NtQueryInformationProcess(ProcessHandle: THandle; ProcessInformationClass: DWORD {PROCESSINFOCLASS}; ProcessInformation: Pointer; ProcessInformationLength: ULONG; ReturnLength: PULONG): LongInt; stdcall; external 'ntdll.dll';
function NtReadVirtualMemory(ProcessHandle: THandle; BaseAddress: Pointer; Buffer: Pointer; BufferLength: ULONG; ReturnLength: PULONG): Longint; stdcall; external 'ntdll.dll';

function ImageDynamicallyRelocated(BitField: Byte): Boolean;
asm
  SHR AL, 2
  AND AL, 1
end;

function CheckASLRPEB32(hProcess: THandle): Boolean;
var
  PBI: TProcessBasicInformation;
  BitField: Byte;
begin
  Result := False;
  if (hProcess <> 0) and (hProcess <> INVALID_HANDLE_VALUE) then
  begin
    if NtQueryInformationProcess(hProcess, 0{ProcessBasicInformation = 0}, @PBI, SizeOf(TProcessBasicInformation), 0) = 0 then
    begin
      if NtReadVirtualMemory(hProcess, Pointer(DWORD(PBI.PebBaseAddress) + 3), @BitField{Peb.BitField}, SizeOf(Byte), 0) = 0 then
        Result := ImageDynamicallyRelocated(BitField);
    end;
  end;
end;

end.