From c20f74439da13a19cb2ab9b74c29c73485582058 Mon Sep 17 00:00:00 2001 From: joost Date: Wed, 12 Mar 2014 21:35:06 +0000 Subject: [PATCH] * Implemented basic debug-support for Darwin git-svn-id: trunk@44413 - --- .gitattributes | 2 + components/fpdebug/app/fpd/Info.plist | 20 ++ components/fpdebug/app/fpd/fpd.lpi | 6 + components/fpdebug/app/fpd/fpdloop.pas | 12 + components/fpdebug/fpdbgclasses.pp | 11 +- components/fpdebug/fpdbgdarwinclasses.pas | 278 ++++++++++++++++++++++ components/fpdebug/fpdebug.lpk | 16 +- components/fpdebug/fpdebug.pas | 10 +- 8 files changed, 343 insertions(+), 12 deletions(-) create mode 100644 components/fpdebug/app/fpd/Info.plist create mode 100644 components/fpdebug/fpdbgdarwinclasses.pas diff --git a/.gitattributes b/.gitattributes index ebfb70255c..292c252f13 100644 --- a/.gitattributes +++ b/.gitattributes @@ -1254,6 +1254,7 @@ components/fpcunit/languages/guitestrunner.ru.po svneol=native#text/plain components/fpcunit/languages/guitestrunner.uk.po svneol=native#text/plain components/fpdebug/README_DUBY.txt svneol=native#text/pascal components/fpdebug/README_macho.txt svneol=native#text/pascal +components/fpdebug/app/fpd/Info.plist svneol=native#text/plain components/fpdebug/app/fpd/README.txt svneol=native#text/plain components/fpdebug/app/fpd/fpd.lpi svneol=native#text/pascal components/fpdebug/app/fpd/fpd.lpr svneol=native#text/pascal @@ -1265,6 +1266,7 @@ components/fpdebug/app/fpd/fpdtype.pas svneol=native#text/pascal components/fpdebug/app/fpdd/fpdumpdwarf.lpi svneol=native#text/plain components/fpdebug/app/fpdd/fpdumpdwarf.lpr svneol=native#text/pascal components/fpdebug/fpdbgclasses.pp svneol=native#text/pascal +components/fpdebug/fpdbgdarwinclasses.pas svneol=native#text/plain components/fpdebug/fpdbgdisasx86.pp svneol=native#text/plain components/fpdebug/fpdbgdwarf.pas svneol=native#text/pascal components/fpdebug/fpdbgdwarfconst.pas svneol=native#text/pascal diff --git a/components/fpdebug/app/fpd/Info.plist b/components/fpdebug/app/fpd/Info.plist new file mode 100644 index 0000000000..b456027f29 --- /dev/null +++ b/components/fpdebug/app/fpd/Info.plist @@ -0,0 +1,20 @@ + + + + + CFBundleDevelopmentRegion + English + CFBundleIdentifier + org.freepascal.fpd + CFBundleInfoDictionaryVersion + 6.0 + CFBundleName + tfpexample + CFBundleVersion + 1.0 + SecTaskAccess + + allowed + + + diff --git a/components/fpdebug/app/fpd/fpd.lpi b/components/fpdebug/app/fpd/fpd.lpi index a2b6fd09c5..f95709ba06 100644 --- a/components/fpdebug/app/fpd/fpd.lpi +++ b/components/fpdebug/app/fpd/fpd.lpi @@ -63,6 +63,12 @@ + + + + + + diff --git a/components/fpdebug/app/fpd/fpdloop.pas b/components/fpdebug/app/fpd/fpdloop.pas index c0e6b778a6..1208eb6d55 100644 --- a/components/fpdebug/app/fpd/fpdloop.pas +++ b/components/fpdebug/app/fpd/fpdloop.pas @@ -58,6 +58,7 @@ procedure DebugLoop; Code, CodeBytes: String; begin WriteLN('==='); + {$ifdef windows} {$ifdef cpui386} a := GCurrentContext^.EIP; Write(' [', FormatAddress(a), ']'); @@ -67,6 +68,9 @@ procedure DebugLoop; Write(' [', FormatAddress(a), ']'); Disassemble(GCurrentProcess.Handle, True, a, CodeBytes, Code); {$endif} + {$else} + a := 0; + {$endif} WriteLN(' ', CodeBytes, ' ', Code); end; @@ -78,11 +82,15 @@ procedure DebugLoop; Name: String; begin WriteLN('==='); + {$ifdef windows} {$ifdef cpui386} a := GCurrentContext^.EIP; {$else} a := GCurrentContext^.RIP; {$endif} + {$else} + a := 0; + {$endif} sym := GCurrentProcess.FindSymbol(a); if sym = nil then begin @@ -204,6 +212,10 @@ begin then GState := dsPause; end; + deBreakpoint : + begin + GState:=dsPause; + end; end; {case} end; until (GState in [dsStop, dsPause, dsQuit]); diff --git a/components/fpdebug/fpdbgclasses.pp b/components/fpdebug/fpdbgclasses.pp index bdb1cca55d..bf8d3992a0 100644 --- a/components/fpdebug/fpdbgclasses.pp +++ b/components/fpdebug/fpdbgclasses.pp @@ -151,7 +151,7 @@ type function GetLastEventProcessIdentifier: THandle; virtual; public class function StartInstance(AFileName: string; AParams: string): TDbgProcess; virtual; - constructor Create(const AName: string; const AProcessID, AThreadID: Integer); + constructor Create(const AName: string; const AProcessID, AThreadID: Integer); virtual; destructor Destroy; override; function AddBreak(const ALocation: TDbgPtr): TDbgBreakpoint; function FindSymbol(const AName: String): TFpDbgSymbol; @@ -206,6 +206,10 @@ implementation uses FpDbgWinClasses; {$endif} +{$ifdef darwin} +uses + FpDbgDarwinClasses; +{$endif} var GOSDbgClasses : TOSDbgClasses; @@ -221,6 +225,9 @@ begin {$ifdef windows} RegisterDbgClasses; {$endif windows} + {$ifdef darwin} + RegisterDbgClasses; + {$endif darwin} end; result := GOSDbgClasses; end; @@ -535,7 +542,7 @@ const begin if not FProcess.ReadData(FLocation, 1, FOrgValue) then begin - Log('Unable to read breakpoint at $%p', [FLocation]); + Log('Unable to read breakpoint at '+FormatAddress(FLocation)); Exit; end; diff --git a/components/fpdebug/fpdbgdarwinclasses.pas b/components/fpdebug/fpdbgdarwinclasses.pas new file mode 100644 index 0000000000..f06a0be9f4 --- /dev/null +++ b/components/fpdebug/fpdbgdarwinclasses.pas @@ -0,0 +1,278 @@ +unit FpDbgDarwinClasses; + +{$mode objfpc}{$H+} +{$linkframework security} + +interface + +uses + Classes, + SysUtils, + BaseUnix, + FpDbgClasses, + FpDbgLoader, + DbgIntfBaseTypes, + FpDbgLinuxExtra, + FpDbgInfo, + MacOSAll, + FpDbgUtil, + LazLoggerBase; + +type + + { TDbgDarwinProcess } + + TDbgDarwinProcess = class(TDbgProcess) + private + FStatus: cint; + FProcessStarted: boolean; + FTaskPort: mach_port_name_t; + function GetDebugAccessRights: boolean; + protected + function InitializeLoader: TDbgImageLoader; override; + public + class function StartInstance(AFileName: string; AParams: string): TDbgProcess; override; + constructor Create(const AName: string; const AProcessID, AThreadID: Integer); override; + + function ReadData(const AAdress: TDbgPtr; const ASize: Cardinal; out AData): Boolean; override; + function WriteData(const AAdress: TDbgPtr; const ASize: Cardinal; const AData): Boolean; override; + + function Continue(AProcess: TDbgProcess; AThread: TDbgThread; AState: TFPDState): boolean; override; + function WaitForDebugEvent(out ProcessIdentifier: THandle): boolean; override; + function ResolveDebugEvent(AThread: TDbgThread): TFPDEvent; override; + end; + +procedure RegisterDbgClasses; + +implementation + +type + vm_map_t = mach_port_t; + vm_offset_t = UIntPtr; + vm_address_t = vm_offset_t; + vm_size_t = UIntPtr; + vm_prot_t = cint; + mach_vm_address_t = uint64; + mach_msg_Type_number_t = natural_t; + mach_vm_size_t = uint64; + +function task_for_pid(target_tport: mach_port_name_t; pid: integer; var t: mach_port_name_t): kern_return_t; cdecl external name 'task_for_pid'; +function mach_task_self: mach_port_name_t; cdecl external name 'mach_task_self'; +function mach_error_string(error_value: mach_error_t): pchar; cdecl; external name 'mach_error_string'; +function vm_protect(target_task: vm_map_t; adress: vm_address_t; size: vm_size_t; set_maximum: boolean_t; new_protection: vm_prot_t): kern_return_t; cdecl external name 'vm_protect'; +function mach_vm_write(target_task: vm_map_t; address: mach_vm_address_t; data: vm_offset_t; dataCnt: mach_msg_Type_number_t): kern_return_t; cdecl external name 'mach_vm_write'; +function mach_vm_read(target_task: vm_map_t; address: mach_vm_address_t; size: mach_vm_size_t; var data: vm_offset_t; var dataCnt: mach_msg_Type_number_t): kern_return_t; cdecl external name 'mach_vm_read'; + +procedure RegisterDbgClasses; +begin + OSDbgClasses.DbgProcessClass:=TDbgDarwinProcess; +end; + +{ TDbgDarwinProcess } + +function TDbgDarwinProcess.GetDebugAccessRights: boolean; +var + authFlags: AuthorizationFlags; + stat: OSStatus; + author: AuthorizationRef; + authItem: AuthorizationItem; + authRights: AuthorizationRights; +begin + result := false; + authFlags := kAuthorizationFlagExtendRights or kAuthorizationFlagPreAuthorize or kAuthorizationFlagInteractionAllowed or ( 1 << 5); + + stat := AuthorizationCreate(nil, kAuthorizationEmptyEnvironment, authFlags, author); + if stat <> errAuthorizationSuccess then + begin + debugln('Failed to create authorization. Authorization error: ' + inttostr(stat)); + exit; + end; + + authItem.name:='system.privilege.taskport'; + authItem.flags:=0; + authItem.value:=nil; + authItem.valueLength:=0; + + authRights.count:=1; + authRights.items:=@authItem; + + stat := AuthorizationCopyRights(author, authRights, kAuthorizationEmptyEnvironment, authFlags, nil); + if stat <> errAuthorizationSuccess then + begin + debugln('Failed to get debug-(taskport)-privilege. Authorization error: ' + inttostr(stat)); + exit; + end; + result := true; +end; + +function TDbgDarwinProcess.InitializeLoader: TDbgImageLoader; +begin + result := TDbgImageLoader.Create(Name); +end; + +constructor TDbgDarwinProcess.Create(const AName: string; const AProcessID, AThreadID: Integer); +var + aKernResult: kern_return_t; +begin + inherited Create(AName, AProcessID, AThreadID); + + LoadInfo; + + if DbgInfo.HasInfo + then FSymInstances.Add(Self); + + GetDebugAccessRights; + aKernResult:=task_for_pid(mach_task_self, AProcessID, FTaskPort); + if aKernResult <> KERN_SUCCESS then + begin + DebugLn('Failed to get task for process '+IntToStr(AProcessID)+'. Probably insufficient rights to debug applications. Mach error: '+mach_error_string(aKernResult)); + end; +end; + +class function TDbgDarwinProcess.StartInstance(AFileName: string; AParams: string): TDbgProcess; +var + PID: TPid; + stat: longint; +begin + pid := FpFork; + if PID=0 then + begin + // We are in the child-process + fpPTrace(PTRACE_TRACEME, 0, nil, nil); + FpExecve(AFileName, nil, nil); + end + else if PID<>-1 then + begin + sleep(100); + result := TDbgDarwinProcess.Create(AFileName, Pid,-1); + end; +end; + +function TDbgDarwinProcess.ReadData(const AAdress: TDbgPtr; + const ASize: Cardinal; out AData): Boolean; +var + aKernResult: kern_return_t; + cnt: mach_msg_Type_number_t; + b: pointer; +begin + result := false; + + aKernResult := mach_vm_read(FTaskPort, AAdress, ASize, PtrUInt(b), cnt); + if aKernResult <> KERN_SUCCESS then + begin + DebugLn('Failed to read data at address '+FormatAddress(ProcessID)+'. Mach error: '+mach_error_string(aKernResult)); + Exit; + end; + System.Move(b^, AData, Cnt); + result := true; +end; + +function TDbgDarwinProcess.WriteData(const AAdress: TDbgPtr; + const ASize: Cardinal; const AData): Boolean; +var + aKernResult: kern_return_t; +begin + result := false; + aKernResult:=vm_protect(FTaskPort, PtrUInt(AAdress), ASize, boolean_t(false), 7 {VM_PROT_READ + VM_PROT_WRITE + VM_PROT_COPY}); + if aKernResult <> KERN_SUCCESS then + begin + DebugLn('Failed to call vm_protect for address '+FormatAddress(AAdress)+'. Mach error: '+mach_error_string(aKernResult)); + Exit; + end; + + aKernResult := mach_vm_write(FTaskPort, AAdress, vm_offset_t(@AData), ASize); + if aKernResult <> KERN_SUCCESS then + begin + DebugLn('Failed to write data at address '+FormatAddress(AAdress)+'. Mach error: '+mach_error_string(aKernResult)); + Exit; + end; + + result := true; +end; + +function TDbgDarwinProcess.Continue(AProcess: TDbgProcess; AThread: TDbgThread; + AState: TFPDState): boolean; +var + e: integer; +begin + fpseterrno(0); +{$ifdef linux} + fpPTrace(PTRACE_CONT, ProcessID, nil, nil); +{$endif linux} +{$ifdef darwin} + fpPTrace(PTRACE_CONT, ProcessID, pointer(1), nil); +{$endif darwin} + writeln('Cont'); + e := fpgeterrno; + if e <> 0 then + begin + writeln('Failed to continue process. Errcode: ',e); + result := false; + end + else + result := true; +end; + +function TDbgDarwinProcess.WaitForDebugEvent(out ProcessIdentifier: THandle): boolean; +begin + ProcessIdentifier:=FpWaitPid(-1, FStatus, 0); + writeln('waited'); + result := ProcessIdentifier<>-1; + if not result then + writeln('Failed to wait for debug event. Errcode: ', fpgeterrno); +end; + +function TDbgDarwinProcess.ResolveDebugEvent(AThread: TDbgThread): TFPDEvent; + + Function WIFSTOPPED(Status: Integer): Boolean; + begin + WIFSTOPPED:=((Status and $FF)=$7F); + end; + +begin + if wifexited(FStatus) then + begin + SetExitCode(wexitStatus(FStatus)); + writeln('Exit'); + result := deExitProcess + end + else if WIFSTOPPED(FStatus) then + begin + writeln('Stopped ',FStatus, ' signal: ',wstopsig(FStatus)); + case wstopsig(FStatus) of + SIGTRAP: + begin + if not FProcessStarted then + begin + result := deCreateProcess; + FProcessStarted:=true; + end + else + begin + result := deBreakpoint; + writeln('Breakpoint'); + end; + end; + SIGBUS: + begin + writeln('Received SIGBUS'); + result := deException; + end; + SIGINT: + begin + writeln('Received SIGINT'); + result := deException; + end; + SIGSEGV: + begin + writeln('Received SIGSEGV'); + result := deException; + end; + end; {case} + end + else if wifsignaled(FStatus) then + writeln('ERROR: ', wtermsig(FStatus)); +end; + +end. + diff --git a/components/fpdebug/fpdebug.lpk b/components/fpdebug/fpdebug.lpk index 3e0f789c4d..5a45160e70 100644 --- a/components/fpdebug/fpdebug.lpk +++ b/components/fpdebug/fpdebug.lpk @@ -34,7 +34,7 @@ File(s) with other licenses (see also header in file(s): (Any modifications/translations of this file are from duby) "/> - + @@ -69,6 +69,7 @@ File(s) with other licenses (see also header in file(s): + @@ -117,13 +118,18 @@ File(s) with other licenses (see also header in file(s): - - + + + - - + + + + + + diff --git a/components/fpdebug/fpdebug.pas b/components/fpdebug/fpdebug.pas index a6c2cf6f82..e27d90c793 100644 --- a/components/fpdebug/fpdebug.pas +++ b/components/fpdebug/fpdebug.pas @@ -7,11 +7,11 @@ unit fpdebug; interface uses - FpDbgClasses, FpDbgDisasX86, FpDbgDwarf, FpDbgDwarfConst, FpDbgLoader, FpDbgPETypes, - FpDbgSymbols, FpDbgUtil, FpDbgWinExtra, FpImgReaderWinPE, FpImgReaderElf, - FpImgReaderElfTypes, FpImgReaderBase, FpPascalParser, macho, FpImgReaderMachoFile, - FpImgReaderMacho, FpPascalBuilder, FpDbgInfo, FpdMemoryTools, FpErrorMessages, - LazarusPackageIntf; + FpDbgClasses, FpDbgDisasX86, FpDbgDwarf, FpDbgDwarfConst, FpDbgLoader, + FpDbgPETypes, FpDbgSymbols, FpDbgUtil, FpImgReaderWinPE, FpImgReaderElf, + FpImgReaderElfTypes, FpImgReaderBase, FpPascalParser, macho, + FpImgReaderMachoFile, FpImgReaderMacho, FpPascalBuilder, FpDbgInfo, + FpdMemoryTools, FpErrorMessages, LazarusPackageIntf; implementation