LazDebuggerFp, FpDebug: Attach and Detach (Windows/Linux)

Attach on Linux does not work for apps started with "run without debugging". (Maybe/Probably because the IDE does a separate waitpid on those, and interferes with the waitpid of the debugger?)

git-svn-id: trunk@61967 -
This commit is contained in:
martin 2019-10-03 18:38:10 +00:00
parent 69d200ec8d
commit 3e1d403bae
6 changed files with 221 additions and 25 deletions

View File

@ -364,12 +364,14 @@ type
FMainThread: TDbgThread;
function GetHandle: THandle; virtual;
procedure SetThreadId(AThreadId: Integer);
procedure SetExitCode(AValue: DWord);
function GetLastEventProcessIdentifier: THandle; virtual;
function DoBreak(BreakpointAddress: TDBGPtr; AThreadID: integer): Boolean;
function InsertBreakInstructionCode(const ALocation: TDBGPtr; out OrigValue: Byte): Boolean; //virtual;
function RemoveBreakInstructionCode(const ALocation: TDBGPtr; const OrigValue: Byte): Boolean; //virtual;
procedure RemoveAllBreakPoints;
procedure BeforeChangingInstructionCode(const ALocation: TDBGPtr); virtual;
procedure AfterChangingInstructionCode(const ALocation: TDBGPtr); virtual;
@ -380,6 +382,7 @@ type
function AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent; virtual; abstract;
public
class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags): TDbgProcess; virtual;
class function AttachToInstance(AFileName: string; APid: Integer): TDbgProcess; virtual;
constructor Create(const AFileName: string; const AProcessID, AThreadID: Integer); virtual;
destructor Destroy; override;
function AddInternalBreak(const ALocation: TDBGPtr): TFpInternalBreakpoint; overload;
@ -425,6 +428,7 @@ type
function WriteData(const AAdress: TDbgPtr; const ASize: Cardinal; const AData): Boolean; virtual;
procedure TerminateProcess; virtual; abstract;
function Detach(AProcess: TDbgProcess; AThread: TDbgThread): boolean; virtual;
property Handle: THandle read GetHandle;
property Name: String read FFileName write SetFileName;
@ -1432,21 +1436,31 @@ begin
result := 0;
end;
procedure TDbgProcess.SetThreadId(AThreadId: Integer);
begin
assert(FThreadID = 0, 'TDbgProcess.SetThreadId: FThreadID = 0');
FThreadID := AThreadId;
end;
procedure TDbgProcess.SetExitCode(AValue: DWord);
begin
FExitCode:=AValue;
end;
resourcestring
sNoDebugSupport = 'Debug support is not available for this platform .';
class function TDbgProcess.StartInstance(AFileName: string; AParams, AnEnvironment: TStrings;
AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags): TDbgProcess;
begin
DebugLn(DBG_VERBOSE, sNoDebugSupport);
DebugLn(DBG_VERBOSE, 'Debug support is not available for this platform.');
result := nil;
end;
class function TDbgProcess.AttachToInstance(AFileName: string; APid: Integer
): TDbgProcess;
begin
DebugLn(DBG_VERBOSE, 'Attach not supported');
Result := nil;
end;
procedure TDbgProcess.ThreadDestroyed(const AThread: TDbgThread);
begin
if AThread = FMainThread
@ -1550,6 +1564,22 @@ begin
AfterChangingInstructionCode(ALocation);
end;
procedure TDbgProcess.RemoveAllBreakPoints;
var
b: TFpInternalBreakpoint;
i: LongInt;
begin
i := FBreakpointList.Count - 1;
while i >= 0 do begin
b := FBreakpointList[i];
b.ResetBreak;
b.FProcess := nil;
FBreakpointList.Delete(i);
dec(i);
end;
assert(FBreakMap.Count = 0, 'TDbgProcess.RemoveAllBreakPoints: FBreakMap.Count = 0');
end;
procedure TDbgProcess.BeforeChangingInstructionCode(const ALocation: TDBGPtr);
begin
//
@ -1635,6 +1665,12 @@ begin
result := false;
end;
function TDbgProcess.Detach(AProcess: TDbgProcess; AThread: TDbgThread
): boolean;
begin
Result := False;
end;
{ TDbgThread }
function TDbgThread.GetRegisterValueList: TDbgRegisterValueList;

View File

@ -147,6 +147,8 @@ type
TDbgController = class
private
FRunning, FPauseRequest: cardinal;
FAttachToPid: Integer;
FDetaching: cardinal;
FEnvironment: TStrings;
FExecutableFilename: string;
FForceNewConsoleWin: boolean;
@ -186,10 +188,12 @@ type
procedure Step;
procedure StepOut;
function Pause: boolean;
function Detach: boolean;
procedure ProcessLoop;
procedure SendEvents(out continue: boolean);
property ExecutableFilename: string read FExecutableFilename write SetExecutableFilename;
property AttachToPid: Integer read FAttachToPid write FAttachToPid;
property CurrentProcess: TDbgProcess read FCurrentProcess;
property CurrentThread: TDbgThread read FCurrentThread;
property CurrentThreadId: Integer read GetCurrentThreadId write SetCurrentThreadId;
@ -770,7 +774,10 @@ begin
Flags := [];
if RedirectConsoleOutput then Include(Flags, siRediretOutput);
if ForceNewConsoleWin then Include(Flags, siForceNewConsole);
FCurrentProcess := OSDbgClasses.DbgProcessClass.StartInstance(FExecutableFilename, Params, Environment, WorkingDirectory, FConsoleTty, Flags);
if AttachToPid <> 0 then
FCurrentProcess := OSDbgClasses.DbgProcessClass.AttachToInstance(FExecutableFilename, AttachToPid)
else
FCurrentProcess := OSDbgClasses.DbgProcessClass.StartInstance(FExecutableFilename, Params, Environment, WorkingDirectory, FConsoleTty, Flags);
if assigned(FCurrentProcess) then
begin
FProcessMap.Add(FCurrentProcess.ProcessID, FCurrentProcess);
@ -820,8 +827,26 @@ begin
Result := FCurrentProcess.Pause;
end;
function TDbgController.Detach: boolean;
begin
InterLockedExchange(FDetaching, 1);
Result := Pause;
end;
procedure TDbgController.ProcessLoop;
function MaybeDetach: boolean;
begin
Result := InterLockedExchange(FDetaching, 0) <> 0;
if not Result then
exit;
if Assigned(FCommand) then
FreeAndNil(FCommand);
FPDEvent := deFinishedStep; // go to pause, if detach fails
if FCurrentProcess.Detach(FCurrentProcess, FCurrentThread) then
FPDEvent := deExitProcess;
end;
var
AProcessIdentifier: THandle;
AThreadIdentifier: THandle;
@ -843,6 +868,9 @@ begin
if FCommand <> nil then
FCommand.DoBeforeLoopStart;
if MaybeDetach then
exit;
repeat
if assigned(FCurrentProcess) and not assigned(FMainProcess) then begin
// IF there is a pause-request, we will hit a deCreateProcess.
@ -858,25 +886,26 @@ begin
// if Pause() is called right here, an Interrupt-Event is scheduled, even though we do not run (yet)
if InterLockedExchangeAdd(FPauseRequest, 0) = 1 then begin
FPDEvent := deBreakpoint;
InterLockedExchange(FRunning, 0);
break; // no event handling. Keep Process/Thread from last run
end
else begin
if not assigned(FCommand) then
begin
DebugLn(FPDBG_COMMANDS, 'Continue process without command.');
FCurrentProcess.Continue(FCurrentProcess, FCurrentThread, False)
end
else
begin
DebugLn(FPDBG_COMMANDS, 'Continue process with command '+FCommand.ClassName);
FCommand.DoContinue(FCurrentProcess, FCurrentThread);
end;
if not assigned(FCommand) then
begin
DebugLn(FPDBG_COMMANDS, 'Continue process without command.');
FCurrentProcess.Continue(FCurrentProcess, FCurrentThread, False)
end
else
begin
DebugLn(FPDBG_COMMANDS, 'Continue process with command '+FCommand.ClassName);
FCommand.DoContinue(FCurrentProcess, FCurrentThread);
end;
// TODO: replace the dangling pointer with the next best value....
// There is still a race condition, for another thread to access it...
if (ctid <> 0) and not FCurrentProcess.GetThread(ctid, DummyThread) then
FCurrentThread := nil;
end;
// TODO: replace the dangling pointer with the next best value....
// There is still a race condition, for another thread to access it...
if (ctid <> 0) and not FCurrentProcess.GetThread(ctid, DummyThread) then
FCurrentThread := nil;
end;
end;
if not FCurrentProcess.WaitForDebugEvent(AProcessIdentifier, AThreadIdentifier) then
Continue;
@ -931,6 +960,7 @@ begin
this will remove CurrentThread form the list of threads
CurrentThread is then destroyed in the next call to continue....
*)
FPDEvent:=FCurrentProcess.ResolveDebugEvent(FCurrentThread);
DebugLn(DBG_VERBOSE, 'Process stopped with event %s. IP=%s, SP=%s, BSP=%s. HasBreak: %s',
[FPDEventNames[FPDEvent],
@ -938,6 +968,10 @@ begin
FCurrentProcess.FormatAddress(FCurrentThread.GetStackPointerRegisterValue),
FCurrentProcess.FormatAddress(FCurrentThread.GetStackBasePointerRegisterValue),
dbgs(CurrentProcess.CurrentBreakpoint<>nil)]);
if MaybeDetach then
break;
IsHandled:=false;
IsFinished:=false;
if FPDEvent=deExitProcess then

View File

@ -293,6 +293,8 @@ type
public
class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings;
AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags): TDbgProcess; override;
class function AttachToInstance(AFileName: string; APid: Integer
): TDbgProcess; override;
constructor Create(const AName: string; const AProcessID, AThreadID: Integer); override;
destructor Destroy; override;
@ -305,6 +307,7 @@ type
procedure TerminateProcess; override;
function Pause: boolean; override;
function Detach(AProcess: TDbgProcess; AThread: TDbgThread): boolean; override;
function Continue(AProcess: TDbgProcess; AThread: TDbgThread; SingleStep: boolean): boolean; override;
function WaitForDebugEvent(out ProcessIdentifier, ThreadIdentifier: THandle): boolean; override;
@ -841,6 +844,17 @@ begin
end;
end;
class function TDbgLinuxProcess.AttachToInstance(AFileName: string;
APid: Integer): TDbgProcess;
begin
Result := nil;
fpPTrace(PTRACE_ATTACH, APid, nil, Pointer(PTRACE_O_TRACECLONE));
result := TDbgLinuxProcess.Create(AFileName, APid, 0);
// TODO: change the filename to the actual exe-filename. Load the correct dwarf info
end;
function TDbgLinuxProcess.ReadData(const AAdress: TDbgPtr;
const ASize: Cardinal; out AData): Boolean;
@ -1008,6 +1022,14 @@ begin
end;
end;
function TDbgLinuxProcess.Detach(AProcess: TDbgProcess; AThread: TDbgThread): boolean;
begin
RemoveAllBreakPoints;
fpPTrace(PTRACE_DETACH, AThread.ID, nil, pointer(wstopsig(TDbgLinuxThread(AThread).FExceptionSignal)));
Result := True;
end;
function TDbgLinuxProcess.Continue(AProcess: TDbgProcess; AThread: TDbgThread; SingleStep: boolean): boolean;
function CheckNoError: Boolean;
var
@ -1234,6 +1256,16 @@ begin
Exit;
end;
if (not FProcessStarted) and (wstopsig(FStatus) <> SIGTRAP) then begin
// attached, should be SigStop, but may be out of order
debugln(DBG_VERBOSE, ['Attached ', wstopsig(FStatus)]);
result := deCreateProcess;
FProcessStarted:=true;
if not wstopsig(FStatus) = SIGSTOP then
FPostponedSignals.AddSignal(AThread.Id, FStatus);
end
else
case wstopsig(FStatus) of
SIGTRAP:
begin

View File

@ -44,6 +44,8 @@ const
PTRACE_O_TRACECLONE = 1 << PTRACE_EVENT_CLONE;
{$endif linux}
PTRACE_ATTACH = 16;
PTRACE_DETACH = 17;
PTRACE_SEIZE = $4206;
RIP = 16;

View File

@ -187,7 +187,9 @@ type
function HandleDebugEvent(const ADebugEvent: TDebugEvent): Boolean;
class function StartInstance(AFileName: string; AParams, AnEnvironment: TStrings; AWorkingDirectory, AConsoleTty: string; AFlags: TStartInstanceFlags): TDbgProcess; override;
class function AttachToInstance(AFileName: string; APid: Integer): TDbgProcess; override;
function Continue(AProcess: TDbgProcess; AThread: TDbgThread; SingleStep: boolean): boolean; override;
function Detach(AProcess: TDbgProcess; AThread: TDbgThread): boolean; override;
function WaitForDebugEvent(out ProcessIdentifier, ThreadIdentifier: THandle): boolean; override;
function AnalyseDebugEvent(AThread: TDbgThread): TFPDEvent; override;
function CreateThread(AthreadIdentifier: THandle; out IsMainThread: boolean): TDbgThread; override;
@ -290,7 +292,8 @@ var
_CreateRemoteThread: function(hProcess: THandle; lpThreadAttributes: Pointer; dwStackSize: DWORD; lpStartAddress: TFNThreadStartRoutine; lpParameter: Pointer; dwCreationFlags: DWORD; var lpThreadId: DWORD): THandle; stdcall = nil;
_GetFinalPathNameByHandle: function(hFile: HANDLE; lpFilename:LPWSTR; cchFilePath, dwFlags: DWORD):DWORD; stdcall = nil;
_QueryFullProcessImageName: function (hProcess:HANDLE; dwFlags: DWord; lpExeName:LPWSTR; var lpdwSize:DWORD):BOOL; stdcall = nil;
_DebugActiveProcessStop : function (ProcessId:DWORD):BOOL; stdcall = nil;
_DebugActiveProcessStop: function (ProcessId:DWORD):BOOL; stdcall = nil;
_DebugActiveProcess: function (ProcessId:DWORD):BOOL; stdcall = nil;
_IsWow64Process: function (hProcess:HANDLE; WoW64Process: PBOOL):BOOL; stdcall = nil;
_Wow64GetThreadContext: function (hThread: THandle; var lpContext: WOW64_CONTEXT): BOOL; stdcall = nil;
_Wow64SetThreadContext: function (hThread: THandle; const lpContext: WOW64_CONTEXT): BOOL; stdcall = nil;
@ -310,6 +313,7 @@ begin
Pointer(_CreateRemoteThread) := GetProcAddress(hMod, 'CreateRemoteThread');
Pointer(_QueryFullProcessImageName) := GetProcAddress(hMod, 'QueryFullProcessImageNameW'); // requires Vista
Pointer(_DebugActiveProcessStop) := GetProcAddress(hMod, 'DebugActiveProcessStop');
Pointer(_DebugActiveProcess) := GetProcAddress(hMod, 'DebugActiveProcess');
Pointer(_GetFinalPathNameByHandle) := GetProcAddress(hMod, 'GetFinalPathNameByHandleW');
{$ifdef cpux86_64}
Pointer(_IsWow64Process) := GetProcAddress(hMod, 'IsWow64Process');
@ -320,6 +324,8 @@ begin
DebugLn(DBG_WARNINGS and (DebugBreakAddr = nil), ['WARNING: Failed to get DebugBreakAddr']);
DebugLn(DBG_WARNINGS and (_CreateRemoteThread = nil), ['WARNING: Failed to get CreateRemoteThread']);
DebugLn(DBG_WARNINGS and (_QueryFullProcessImageName = nil), ['WARNING: Failed to get QueryFullProcessImageName']);
DebugLn(DBG_WARNINGS and (_DebugActiveProcessStop = nil), ['WARNING: Failed to get DebugActiveProcessStop']);
DebugLn(DBG_WARNINGS and (_DebugActiveProcess = nil), ['WARNING: Failed to get DebugActiveProcess']);
DebugLn(DBG_WARNINGS and (_GetFinalPathNameByHandle = nil), ['WARNING: Failed to get GetFinalPathNameByHandle']);
{$ifdef cpux86_64}
DebugLn(DBG_WARNINGS and (_IsWow64Process = nil), ['WARNING: Failed to get IsWow64Process']);
@ -599,6 +605,18 @@ begin
end;
end;
class function TDbgWinProcess.AttachToInstance(AFileName: string; APid: Integer
): TDbgProcess;
begin
Result := nil;
if _DebugActiveProcess = nil then
exit;
if not _DebugActiveProcess(APid) then
exit;
result := TDbgWinProcess.Create(AFileName, APid, 0);
// TODO: change the filename to the actual exe-filename. Load the correct dwarf info
end;
function TDbgWinProcess.Continue(AProcess: TDbgProcess; AThread: TDbgThread;
SingleStep: boolean): boolean;
@ -700,6 +718,58 @@ if AThread<>nil then debugln(['## ath.iss ',AThread.NextIsSingleStep]);
result := true;
end;
function TDbgWinProcess.Detach(AProcess: TDbgProcess; AThread: TDbgThread
): boolean;
var
t: TDbgWinThread;
PendingDebugEvent: TDebugEvent;
begin
Result := _DebugActiveProcessStop <> nil;
if not Result then
exit;
RemoveAllBreakPoints;
// Collect all pending events // Deal with any breakpoint/int3 hit
if not GetThread(MDebugEvent.dwThreadId, TDbgThread(AThread)) then begin
assert(False, 'TDbgWinProcess.Detach: Missing thread');
TDbgThread(AThread) := AddThread(MDebugEvent.dwThreadId);
end;
for TDbgThread(t) in FThreadMap do
if not t.ID = MDebugEvent.dwThreadId then
t.Suspend;
TDbgWinThread(AThread).SetSingleStep;
Windows.ContinueDebugEvent(MDebugEvent.dwProcessId, MDebugEvent.dwThreadId, DBG_CONTINUE);
while Windows.WaitForDebugEvent(PendingDebugEvent, 1) do begin
if PendingDebugEvent.dwThreadId = MDebugEvent.dwThreadId then
break;
case PendingDebugEvent.dwDebugEventCode of
CREATE_PROCESS_DEBUG_EVENT: begin
if PendingDebugEvent.CreateProcessInfo.hFile <> 0 then
CloseHandle(PendingDebugEvent.CreateProcessInfo.hFile);
_DebugActiveProcessStop(PendingDebugEvent.dwProcessId);
end;
EXCEPTION_DEBUG_EVENT:
case PendingDebugEvent.Exception.ExceptionRecord.ExceptionCode of
EXCEPTION_BREAKPOINT, STATUS_WX86_BREAKPOINT: begin
if not GetThread(PendingDebugEvent.dwThreadId, TDbgThread(t)) then
TDbgThread(t) := AddThread(PendingDebugEvent.dwThreadId);
t.CheckAndResetInstructionPointerAfterBreakpoint;
end;
end;
end;
Windows.ContinueDebugEvent(PendingDebugEvent.dwProcessId, PendingDebugEvent.dwThreadId, DBG_CONTINUE);
end;
for TDbgThread(t) in FThreadMap do
t.Resume;
Result := _DebugActiveProcessStop(ProcessID);
// Windows.ContinueDebugEvent(MDebugEvent.dwProcessId, MDebugEvent.dwThreadId, DBG_CONTINUE);
end;
function TDbgWinProcess.WaitForDebugEvent(out ProcessIdentifier, ThreadIdentifier: THandle): boolean;
var
t: TDbgWinThread;
@ -742,7 +812,7 @@ begin
DebugLn([dbgs(MDebugEvent), ' ', Result]);
for TDbgThread(t) in FThreadMap do begin
if t.ReadThreadState then
DebugLn('Thr.Id:%d SSTep %s EF %s DR6:%x WP:%x RegAcc: %d, SStep: %d Task: %d, ExcBrk: %d', [t.ID, dbgs(t.FCurrentContext^.def.EFlags and FLAG_TRACE_BIT), dbghex(t.FCurrentContext^.def.EFlags), t.FCurrentContext^.def.Dr6, t.FCurrentContext^.def.Dr6 and 15, t.FCurrentContext^.def.Dr6 and (1<< 13), t.FCurrentContext^.def.Dr6 and (1<< 14), t.FCurrentContext^.def.Dr6 and (1<< 15), t.FCurrentContext^.def.Dr6 and (1<< 16)]);
DebugLn('Thr.Id:%d %x SSTep %s EF %s DR6:%x WP:%x RegAcc: %d, SStep: %d Task: %d, ExcBrk: %d', [t.ID, t.GetInstructionPointerRegisterValue, dbgs(t.FCurrentContext^.def.EFlags and FLAG_TRACE_BIT), dbghex(t.FCurrentContext^.def.EFlags), t.FCurrentContext^.def.Dr6, t.FCurrentContext^.def.Dr6 and 15, t.FCurrentContext^.def.Dr6 and (1<< 13), t.FCurrentContext^.def.Dr6 and (1<< 14), t.FCurrentContext^.def.Dr6 and (1<< 15), t.FCurrentContext^.def.Dr6 and (1<< 16)]);
end;
{$ENDIF}
@ -1132,6 +1202,8 @@ var
{$endif}
begin
FInfo := AInfo;
if ThreadID = 0 then
SetThreadId(AThreadID);
{$ifdef cpui386}
FBitness := b32; // only 32 bit supported
{$else}

View File

@ -1839,7 +1839,7 @@ begin
FDbgController.NextOnlyStopOnStartLine := TFpDebugDebuggerProperties(GetProperties).NextOnlyStopOnStartLine;
if (ACommand in [dcRun, dcStepOver, dcStepInto, dcStepOut, dcRunTo, dcJumpto,
dcStepOverInstr, dcStepIntoInstr]) and
dcStepOverInstr, dcStepIntoInstr, dcAttach]) and
not assigned(FDbgController.MainProcess)
then
begin
@ -1855,6 +1855,15 @@ begin
{$ifdef windows}
FDbgController.ForceNewConsoleWin:=TFpDebugDebuggerProperties(GetProperties).ForceNewConsole;
{$endif windows}
//FDbgController.AttachToPid := 0;
if ACommand = dcAttach then begin
FDbgController.AttachToPid := StrToIntDef(String(AParams[0].VAnsiString), 0);
Result := FDbgController.AttachToPid <> 0;
if not Result then begin
FileName := '';
Exit;
end;
end;
FFpDebugThread := TFpDebugThread.Create(Self);
RTLeventWaitFor(FFpDebugThread.DebugLoopStoppedEvent);
RTLeventResetEvent(FFpDebugThread.DebugLoopStoppedEvent);
@ -1947,6 +1956,12 @@ begin
StartDebugLoop;
result := true;
end;
dcDetach:
begin
Result := FDbgController.Detach;
if Result and (State in [dsPause, dsInternalPause]) then
StartDebugLoop;
end;
dcEvaluate:
begin
EvalFlags := TDBGEvaluateFlags(AParams[1].VInteger);
@ -2001,7 +2016,9 @@ begin
because any callstack (never mind which to which IDE-thread object it belongs
will always get the data for the current thread only
TODO: callstacks need a field with the thread-id to which they belong *)
if (Threads <> nil) and (Threads.CurrentThreads <> nil) then
if (Threads <> nil) and (Threads.CurrentThreads <> nil) and
(FDbgController.CurrentThread <> nil)
then
Threads.CurrentThreads.CurrentThreadId := FDbgController.CurrentThreadId;
FDbgController.SendEvents(Cont); // This may free the TFpDebugDebugger (self)
@ -2300,7 +2317,10 @@ end;
function TFpDebugDebugger.GetSupportedCommands: TDBGCommands;
begin
Result:=[dcRun, dcStop, dcStepIntoInstr, dcStepOverInstr, dcStepOver,
dcRunTo, dcPause, dcStepOut, dcStepInto, dcEvaluate, dcSendConsoleInput];
dcRunTo, dcPause, dcStepOut, dcStepInto, dcEvaluate, dcSendConsoleInput
{$IFDEF windows} , dcAttach, dcDetach {$ENDIF}
{$IFDEF linux} , dcAttach, dcDetach {$ENDIF}
];
if State = dsStop then
Result := Result - [dcStepInto, dcStepOver, dcStepOut, dcStepIntoInstr, dcStepOverInstr];
end;