Chebmaster
31-12-2009, 10:13 AM
The problem is quite old and quite annoying.
Imagine this: You choose a module structure for your engine, with one main exe and one to many DLLs. Then you find, with great dismay, that the try...except blocks in your DLL(s) don't catch the system exceptions (say, Access Violations). These exceptions shoot straight to the closest try... block of your exe.
What is more dismaying, in Linux everything works perfectly.
Here's my solution: to install your own top level unhandled exception handler instead the one installed by RTL. It checks if the exception is happened inside your dll. If not, it calls the old RTL handler. If yes, it shuffles the resume address to the procedure that raises native Pascal exception in your DLL. The Pascal exception is then easily caught by all try... blocks in the DLL :)
This solution isn't 100% bullet-proof as if the exception happens in, say, dsound.dll due to call from your DLL, it will still shoot through right to the EXE's try... block.
But still.. ;D
sehhck_dll.pas
library sehhck_dll;
{$mode objfpc}{$H+}
uses
Classes, SysUtils, Windows;
procedure mytestproc; cdecl; export;
begin
try
WriteLn('Now DLL will raise an Access Violation...');
byte(nil^):= 0;
except
WriteLn('DLL caught an exception:');
WriteLn(' "' + (ExceptObject as Exception).Message
+ '" of ' + (ExceptObject as Exception).ClassName);
end;
end;
procedure myraiseproc; cdecl; export;
begin
WriteLn('Now DLL will raise a Pascal exception...');
Raise Exception.Create('Manually raised Pascal exception');
end;
exports
mytestproc name 'mytestproc',
myraiseproc name 'myraiseproc';
end.
sehhck_exe.pas
program sehhk_exe;
{$mode delphi}
{$longstrings on}
{$apptype console}
uses
Classes, SysUtils, Windows;
//Copy-pasted from the System unit --------------------------------------------\
{
Error code definitions for the Win32 API functions
Values are 32 bit values layed out as follows:
3 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1
1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0
+---+-+-+-----------------------+-------------------------------+
|Sev|C|R| Facility | Code |
+---+-+-+-----------------------+-------------------------------+
where
Sev - is the severity code
00 - Success
01 - Informational
10 - Warning
11 - Error
C - is the Customer code flag
R - is a reserved bit
Facility - is the facility code
Code - is the facility's status code
}
const
SEVERITY_SUCCESS = $00000000;
SEVERITY_INFORMATIONAL = $40000000;
SEVERITY_WARNING = $80000000;
SEVERITY_ERROR = $C0000000;
const
STATUS_SEGMENT_NOTIFICATION = $40000005;
DBG_TERMINATE_THREAD = $40010003;
DBG_TERMINATE_PROCESS = $40010004;
DBG_CONTROL_C = $40010005;
DBG_CONTROL_BREAK = $40010008;
STATUS_GUARD_PAGE_VIOLATION = $80000001;
STATUS_DATATYPE_MISALIGNMENT = $80000002;
STATUS_BREAKPOINT = $80000003;
STATUS_SINGLE_STEP = $80000004;
DBG_EXCEPTION_NOT_HANDLED = $80010001;
STATUS_ACCESS_VIOLATION = $C0000005;
STATUS_IN_PAGE_ERROR = $C0000006;
STATUS_INVALID_HANDLE = $C0000008;
STATUS_NO_MEMORY = $C0000017;
STATUS_ILLEGAL_INSTRUCTION = $C000001D;
STATUS_NONCONTINUABLE_EXCEPTION = $C0000025;
STATUS_INVALID_DISPOSITION = $C0000026;
STATUS_ARRAY_BOUNDS_EXCEEDED = $C000008C;
STATUS_FLOAT_DENORMAL_OPERAND = $C000008D;
STATUS_FLOAT_DIVIDE_BY_ZERO = $C000008E;
STATUS_FLOAT_INEXACT_RESULT = $C000008F;
STATUS_FLOAT_INVALID_OPERATION = $C0000090;
STATUS_FLOAT_OVERFLOW = $C0000091;
STATUS_FLOAT_STACK_CHECK = $C0000092;
STATUS_FLOAT_UNDERFLOW = $C0000093;
STATUS_INTEGER_DIVIDE_BY_ZERO = $C0000094;
STATUS_INTEGER_OVERFLOW = $C0000095;
STATUS_PRIVILEGED_INSTRUCTION = $C0000096;
STATUS_STACK_OVERFLOW = $C00000FD;
STATUS_CONTROL_C_EXIT = $C000013A;
STATUS_FLOAT_MULTIPLE_FAULTS = $C00002B4;
STATUS_FLOAT_MULTIPLE_TRAPS = $C00002B5;
STATUS_REG_NAT_CONSUMPTION = $C00002C9;
EXCEPTION_EXECUTE_HANDLER = 1;
EXCEPTION_CONTINUE_EXECUTION = -1;
EXCEPTION_CONTINUE_SEARCH = 0;
EXCEPTION_MAXIMUM_PARAMETERS = 15;
CONTEXT_X86 = $00010000;
CONTEXT_CONTROL = CONTEXT_X86 or $00000001;
CONTEXT_INTEGER = CONTEXT_X86 or $00000002;
CONTEXT_SEGMENTS = CONTEXT_X86 or $00000004;
CONTEXT_FLOATING_POINT = CONTEXT_X86 or $00000008;
CONTEXT_DEBUG_REGISTERS = CONTEXT_X86 or $00000010;
CONTEXT_EXTENDED_REGISTERS = CONTEXT_X86 or $00000020;
CONTEXT_FULL= CONTEXT_CONTROL or CONTEXT_INTEGER or CONTEXT_SEGMENTS;
MAXIMUM_SUPPORTED_EXTENSION = 512;
type
PFloatingSaveArea = ^TFloatingSaveArea;
TFloatingSaveArea = packed record
ControlWord : Cardinal;
StatusWord : Cardinal;
TagWord : Cardinal;
ErrorOffset : Cardinal;
ErrorSelector : Cardinal;
DataOffset : Cardinal;
DataSelector : Cardinal;
RegisterArea : array[0..79] of Byte;
Cr0NpxState : Cardinal;
end;
PContext = ^TContext;
TContext = packed record
//
// The flags values within this flag control the contents of
// a CONTEXT record.
//
ContextFlags : Cardinal;
//
// This section is specified/returned if CONTEXT_DEBUG_REGISTERS is
// set in ContextFlags. Note that CONTEXT_DEBUG_REGISTERS is NOT
// included in CONTEXT_FULL.
//
Dr0, Dr1, Dr2,
Dr3, Dr6, Dr7 : Cardinal;
//
// This section is specified/returned if the
// ContextFlags word contains the flag CONTEXT_FLOATING_POINT.
//
FloatSave : TFloatingSaveArea;
//
// This section is specified/returned if the
// ContextFlags word contains the flag CONTEXT_SEGMENTS.
//
SegGs, SegFs,
SegEs, SegDs : Cardinal;
//
// This section is specified/returned if the
// ContextFlags word contains the flag CONTEXT_INTEGER.
//
Edi, Esi, Ebx,
Edx, Ecx, Eax : Cardinal;
//
// This section is specified/returned if the
// ContextFlags word contains the flag CONTEXT_CONTROL.
//
Ebp : Cardinal;
Eip : Cardinal;
SegCs : Cardinal;
EFlags, Esp, SegSs : Cardinal;
//
// This section is specified/returned if the ContextFlags word
// contains the flag CONTEXT_EXTENDED_REGISTERS.
// The format and contexts are processor specific
//
ExtendedRegisters : array[0..MAXIMUM_SUPPORTED_EXTENSION-1] of Byte;
end;
type
PExceptionRecord = ^TExceptionRecord;
TExceptionRecord = packed record
ExceptionCode : cardinal;
ExceptionFlags : Longint;
ExceptionRecord : PExceptionRecord;
ExceptionAddress : Pointer;
NumberParameters : Longint;
ExceptionInformation : array[0..EXCEPTION_MAXIMUM_PARAMETERS-1] of Pointer;
end;
PExceptionPointers = ^TExceptionPointers;
TExceptionPointers = packed record
ExceptionRecord : PExceptionRecord;
ContextRecord : PContext;
end;
{ type of functions that should be used for exception handling }
TTopLevelExceptionFilter
= function (excep : PExceptionPointers) : Longint;stdcall;
function SetUnhandledExceptionFilter( lpTopLevelExceptionFilter:
TTopLevelExceptionFilter) : TTopLevelExceptionFilter;
stdcall;external 'kernel32' name 'SetUnhandledExceptionFilter';
//end copy-paste --------------------------------------------------------------/
var
Mydll: THandle = 0;
OldFilter: TTopLevelExceptionFilter = nil;
answer: string;
dllraiseproc: procedure; cdecl;
dlltestproc: procedure; cdecl;
procedure JumpToDllRaiseFunction;
begin
SysResetFPU;
dllraiseproc;
raise Exception.Create('Oops... Should''ve never reached this point!');
end;
function GetModuleByAddr(addr: pointer): THandle;
var
Tmm: TMemoryBasicInformation;
begin
if VirtualQuery(addr, @Tmm, SizeOf(Tmm)) <> sizeof(Tmm)
then Result:=0
else Result:= THandle(Tmm.AllocationBase);
end;
function MyExceptionFilter(excep : PExceptionPointers) : Longint; stdcall;
var
res: longint;
err: byte;
must_reset_fpu: boolean;
begin
WriteLn('System called our top level unhandled exception filter.'#10#13
+' Exception code = '
+ IntToHex(excep^.ExceptionRecord^.ExceptionCode, 8));
if MyDll = GetModuleByAddr(pointer(excep^.ContextRecord^.Eip) ) then begin
WriteLn('The exception adress does belong to our DLL.');
excep^.ContextRecord^.Eip := Longint(@JumpToDllRaiseFunction);
excep^.ExceptionRecord^.ExceptionCode := 0;
Result := EXCEPTION_CONTINUE_EXECUTION;
end
else begin
WriteLn('The exception address doesn''t belong to our DLL.'#10#13
+' Calling the old filter installed by RTL.');
Result:= OldFilter(excep);
end;
end;
procedure InstallHack;
begin
OldFilter:= SetUnhandledExceptionFilter(MyExceptionFilter);
Writeln('Ensuring that the hack didn''t broke our own exception mechanism...');
try
WriteLn('Raising an AV...');
byte(nil^):= 0;
except
WriteLn('Exe caught an exception: '#10#13' "'
+ (ExceptObject as Exception).Message
+ '" by ' + (ExceptObject as Exception).ClassName);
end;
end;
begin
try
WriteLn('Loading the dll...');
MyDll:= LoadLibrary('./sehhck_dll.dll');
if MyDll = 0
then raise Exception.Create('Failed to load the dll! :(');
dllraiseproc:= GetProcAddress(MyDll, PChar('myraiseproc'));
dlltestproc:= GetProcAddress(MyDll, PChar('mytestproc'));
if not Assigned(@dlltestproc) or not Assigned(@dllraiseproc)
then raise Exception.Create('Failed to load procedures from the DLL');
WriteLn('Use the SEH hack? ("yes" / "no")') ;
answer:= '';
repeat
if answer <> '' then Writeln('Please enter "yes" or "no".');
readln(answer);
if answer = '' then Halt(0);
answer:= UpperCase(answer);
until (answer = 'YES') or (answer = 'NO');
if answer = 'YES' then InstallHack;
WriteLn('Testing!');
dlltestproc;
except
WriteLn('Exe caught an exception: '#10#13' "'
+ (ExceptObject as Exception).Message
+ '" by ' + (ExceptObject as Exception).ClassName);
end;
WriteLn('Press Enter to close.');
ReadLn;
end.
Imagine this: You choose a module structure for your engine, with one main exe and one to many DLLs. Then you find, with great dismay, that the try...except blocks in your DLL(s) don't catch the system exceptions (say, Access Violations). These exceptions shoot straight to the closest try... block of your exe.
What is more dismaying, in Linux everything works perfectly.
Here's my solution: to install your own top level unhandled exception handler instead the one installed by RTL. It checks if the exception is happened inside your dll. If not, it calls the old RTL handler. If yes, it shuffles the resume address to the procedure that raises native Pascal exception in your DLL. The Pascal exception is then easily caught by all try... blocks in the DLL :)
This solution isn't 100% bullet-proof as if the exception happens in, say, dsound.dll due to call from your DLL, it will still shoot through right to the EXE's try... block.
But still.. ;D
sehhck_dll.pas
library sehhck_dll;
{$mode objfpc}{$H+}
uses
Classes, SysUtils, Windows;
procedure mytestproc; cdecl; export;
begin
try
WriteLn('Now DLL will raise an Access Violation...');
byte(nil^):= 0;
except
WriteLn('DLL caught an exception:');
WriteLn(' "' + (ExceptObject as Exception).Message
+ '" of ' + (ExceptObject as Exception).ClassName);
end;
end;
procedure myraiseproc; cdecl; export;
begin
WriteLn('Now DLL will raise a Pascal exception...');
Raise Exception.Create('Manually raised Pascal exception');
end;
exports
mytestproc name 'mytestproc',
myraiseproc name 'myraiseproc';
end.
sehhck_exe.pas
program sehhk_exe;
{$mode delphi}
{$longstrings on}
{$apptype console}
uses
Classes, SysUtils, Windows;
//Copy-pasted from the System unit --------------------------------------------\
{
Error code definitions for the Win32 API functions
Values are 32 bit values layed out as follows:
3 3 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1
1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0 9 8 7 6 5 4 3 2 1 0
+---+-+-+-----------------------+-------------------------------+
|Sev|C|R| Facility | Code |
+---+-+-+-----------------------+-------------------------------+
where
Sev - is the severity code
00 - Success
01 - Informational
10 - Warning
11 - Error
C - is the Customer code flag
R - is a reserved bit
Facility - is the facility code
Code - is the facility's status code
}
const
SEVERITY_SUCCESS = $00000000;
SEVERITY_INFORMATIONAL = $40000000;
SEVERITY_WARNING = $80000000;
SEVERITY_ERROR = $C0000000;
const
STATUS_SEGMENT_NOTIFICATION = $40000005;
DBG_TERMINATE_THREAD = $40010003;
DBG_TERMINATE_PROCESS = $40010004;
DBG_CONTROL_C = $40010005;
DBG_CONTROL_BREAK = $40010008;
STATUS_GUARD_PAGE_VIOLATION = $80000001;
STATUS_DATATYPE_MISALIGNMENT = $80000002;
STATUS_BREAKPOINT = $80000003;
STATUS_SINGLE_STEP = $80000004;
DBG_EXCEPTION_NOT_HANDLED = $80010001;
STATUS_ACCESS_VIOLATION = $C0000005;
STATUS_IN_PAGE_ERROR = $C0000006;
STATUS_INVALID_HANDLE = $C0000008;
STATUS_NO_MEMORY = $C0000017;
STATUS_ILLEGAL_INSTRUCTION = $C000001D;
STATUS_NONCONTINUABLE_EXCEPTION = $C0000025;
STATUS_INVALID_DISPOSITION = $C0000026;
STATUS_ARRAY_BOUNDS_EXCEEDED = $C000008C;
STATUS_FLOAT_DENORMAL_OPERAND = $C000008D;
STATUS_FLOAT_DIVIDE_BY_ZERO = $C000008E;
STATUS_FLOAT_INEXACT_RESULT = $C000008F;
STATUS_FLOAT_INVALID_OPERATION = $C0000090;
STATUS_FLOAT_OVERFLOW = $C0000091;
STATUS_FLOAT_STACK_CHECK = $C0000092;
STATUS_FLOAT_UNDERFLOW = $C0000093;
STATUS_INTEGER_DIVIDE_BY_ZERO = $C0000094;
STATUS_INTEGER_OVERFLOW = $C0000095;
STATUS_PRIVILEGED_INSTRUCTION = $C0000096;
STATUS_STACK_OVERFLOW = $C00000FD;
STATUS_CONTROL_C_EXIT = $C000013A;
STATUS_FLOAT_MULTIPLE_FAULTS = $C00002B4;
STATUS_FLOAT_MULTIPLE_TRAPS = $C00002B5;
STATUS_REG_NAT_CONSUMPTION = $C00002C9;
EXCEPTION_EXECUTE_HANDLER = 1;
EXCEPTION_CONTINUE_EXECUTION = -1;
EXCEPTION_CONTINUE_SEARCH = 0;
EXCEPTION_MAXIMUM_PARAMETERS = 15;
CONTEXT_X86 = $00010000;
CONTEXT_CONTROL = CONTEXT_X86 or $00000001;
CONTEXT_INTEGER = CONTEXT_X86 or $00000002;
CONTEXT_SEGMENTS = CONTEXT_X86 or $00000004;
CONTEXT_FLOATING_POINT = CONTEXT_X86 or $00000008;
CONTEXT_DEBUG_REGISTERS = CONTEXT_X86 or $00000010;
CONTEXT_EXTENDED_REGISTERS = CONTEXT_X86 or $00000020;
CONTEXT_FULL= CONTEXT_CONTROL or CONTEXT_INTEGER or CONTEXT_SEGMENTS;
MAXIMUM_SUPPORTED_EXTENSION = 512;
type
PFloatingSaveArea = ^TFloatingSaveArea;
TFloatingSaveArea = packed record
ControlWord : Cardinal;
StatusWord : Cardinal;
TagWord : Cardinal;
ErrorOffset : Cardinal;
ErrorSelector : Cardinal;
DataOffset : Cardinal;
DataSelector : Cardinal;
RegisterArea : array[0..79] of Byte;
Cr0NpxState : Cardinal;
end;
PContext = ^TContext;
TContext = packed record
//
// The flags values within this flag control the contents of
// a CONTEXT record.
//
ContextFlags : Cardinal;
//
// This section is specified/returned if CONTEXT_DEBUG_REGISTERS is
// set in ContextFlags. Note that CONTEXT_DEBUG_REGISTERS is NOT
// included in CONTEXT_FULL.
//
Dr0, Dr1, Dr2,
Dr3, Dr6, Dr7 : Cardinal;
//
// This section is specified/returned if the
// ContextFlags word contains the flag CONTEXT_FLOATING_POINT.
//
FloatSave : TFloatingSaveArea;
//
// This section is specified/returned if the
// ContextFlags word contains the flag CONTEXT_SEGMENTS.
//
SegGs, SegFs,
SegEs, SegDs : Cardinal;
//
// This section is specified/returned if the
// ContextFlags word contains the flag CONTEXT_INTEGER.
//
Edi, Esi, Ebx,
Edx, Ecx, Eax : Cardinal;
//
// This section is specified/returned if the
// ContextFlags word contains the flag CONTEXT_CONTROL.
//
Ebp : Cardinal;
Eip : Cardinal;
SegCs : Cardinal;
EFlags, Esp, SegSs : Cardinal;
//
// This section is specified/returned if the ContextFlags word
// contains the flag CONTEXT_EXTENDED_REGISTERS.
// The format and contexts are processor specific
//
ExtendedRegisters : array[0..MAXIMUM_SUPPORTED_EXTENSION-1] of Byte;
end;
type
PExceptionRecord = ^TExceptionRecord;
TExceptionRecord = packed record
ExceptionCode : cardinal;
ExceptionFlags : Longint;
ExceptionRecord : PExceptionRecord;
ExceptionAddress : Pointer;
NumberParameters : Longint;
ExceptionInformation : array[0..EXCEPTION_MAXIMUM_PARAMETERS-1] of Pointer;
end;
PExceptionPointers = ^TExceptionPointers;
TExceptionPointers = packed record
ExceptionRecord : PExceptionRecord;
ContextRecord : PContext;
end;
{ type of functions that should be used for exception handling }
TTopLevelExceptionFilter
= function (excep : PExceptionPointers) : Longint;stdcall;
function SetUnhandledExceptionFilter( lpTopLevelExceptionFilter:
TTopLevelExceptionFilter) : TTopLevelExceptionFilter;
stdcall;external 'kernel32' name 'SetUnhandledExceptionFilter';
//end copy-paste --------------------------------------------------------------/
var
Mydll: THandle = 0;
OldFilter: TTopLevelExceptionFilter = nil;
answer: string;
dllraiseproc: procedure; cdecl;
dlltestproc: procedure; cdecl;
procedure JumpToDllRaiseFunction;
begin
SysResetFPU;
dllraiseproc;
raise Exception.Create('Oops... Should''ve never reached this point!');
end;
function GetModuleByAddr(addr: pointer): THandle;
var
Tmm: TMemoryBasicInformation;
begin
if VirtualQuery(addr, @Tmm, SizeOf(Tmm)) <> sizeof(Tmm)
then Result:=0
else Result:= THandle(Tmm.AllocationBase);
end;
function MyExceptionFilter(excep : PExceptionPointers) : Longint; stdcall;
var
res: longint;
err: byte;
must_reset_fpu: boolean;
begin
WriteLn('System called our top level unhandled exception filter.'#10#13
+' Exception code = '
+ IntToHex(excep^.ExceptionRecord^.ExceptionCode, 8));
if MyDll = GetModuleByAddr(pointer(excep^.ContextRecord^.Eip) ) then begin
WriteLn('The exception adress does belong to our DLL.');
excep^.ContextRecord^.Eip := Longint(@JumpToDllRaiseFunction);
excep^.ExceptionRecord^.ExceptionCode := 0;
Result := EXCEPTION_CONTINUE_EXECUTION;
end
else begin
WriteLn('The exception address doesn''t belong to our DLL.'#10#13
+' Calling the old filter installed by RTL.');
Result:= OldFilter(excep);
end;
end;
procedure InstallHack;
begin
OldFilter:= SetUnhandledExceptionFilter(MyExceptionFilter);
Writeln('Ensuring that the hack didn''t broke our own exception mechanism...');
try
WriteLn('Raising an AV...');
byte(nil^):= 0;
except
WriteLn('Exe caught an exception: '#10#13' "'
+ (ExceptObject as Exception).Message
+ '" by ' + (ExceptObject as Exception).ClassName);
end;
end;
begin
try
WriteLn('Loading the dll...');
MyDll:= LoadLibrary('./sehhck_dll.dll');
if MyDll = 0
then raise Exception.Create('Failed to load the dll! :(');
dllraiseproc:= GetProcAddress(MyDll, PChar('myraiseproc'));
dlltestproc:= GetProcAddress(MyDll, PChar('mytestproc'));
if not Assigned(@dlltestproc) or not Assigned(@dllraiseproc)
then raise Exception.Create('Failed to load procedures from the DLL');
WriteLn('Use the SEH hack? ("yes" / "no")') ;
answer:= '';
repeat
if answer <> '' then Writeln('Please enter "yes" or "no".');
readln(answer);
if answer = '' then Halt(0);
answer:= UpperCase(answer);
until (answer = 'YES') or (answer = 'NO');
if answer = 'YES' then InstallHack;
WriteLn('Testing!');
dlltestproc;
except
WriteLn('Exe caught an exception: '#10#13' "'
+ (ExceptObject as Exception).Message
+ '" by ' + (ExceptObject as Exception).ClassName);
end;
WriteLn('Press Enter to close.');
ReadLn;
end.