diff --git a/components/fpdebug/fpdbgclasses.pp b/components/fpdebug/fpdbgclasses.pp index e43cc2a1cb..b1519a29d8 100644 --- a/components/fpdebug/fpdbgclasses.pp +++ b/components/fpdebug/fpdbgclasses.pp @@ -288,6 +288,7 @@ type function CheckForConsoleOutput(ATimeOutMs: integer): integer; virtual; function GetConsoleOutput: string; virtual; + procedure SendConsoleInput(AString: string); virtual; function AddThread(AThreadIdentifier: THandle): TDbgThread; procedure LoadInfo; override; @@ -849,6 +850,11 @@ begin result := ''; end; +procedure TDbgProcess.SendConsoleInput(AString: string); +begin + // Do nothing +end; + function TDbgProcess.AddThread(AThreadIdentifier: THandle): TDbgThread; var IsMainThread: boolean; diff --git a/components/fpdebug/fpdbglinuxclasses.pas b/components/fpdebug/fpdbglinuxclasses.pas index efa7f0057f..25f97c5582 100644 --- a/components/fpdebug/fpdbglinuxclasses.pas +++ b/components/fpdebug/fpdbglinuxclasses.pas @@ -9,6 +9,7 @@ uses Classes, SysUtils, BaseUnix, + termio, process, FpDbgClasses, FpDbgLoader, @@ -159,6 +160,8 @@ type u_debugreg : array[0..7] of longint; end; +function login_tty(__fd:longint):longint;cdecl;external 'c' name 'login_tty'; +function openpty(__amaster:Plongint; __aslave:Plongint; __name:Pchar; __termp:pointer{Ptermios}; __winp:pointer{Pwinsize}):longint;cdecl;external 'util' name 'openpty'; const R15 = 0; @@ -245,6 +248,7 @@ type FProcProcess: TProcess; FIsTerminating: boolean; FExceptionSignal: PtrUInt; + FMasterPtyFd: cint; {$ifndef VER2_6} procedure OnForkEvent(Sender : TObject); {$endif} @@ -262,6 +266,7 @@ type function CheckForConsoleOutput(ATimeOutMs: integer): integer; override; function GetConsoleOutput: string; override; + procedure SendConsoleInput(AString: string); override; function GetInstructionPointerRegisterValue: TDbgPtr; override; function GetStackPointerRegisterValue: TDbgPtr; override; @@ -277,6 +282,9 @@ procedure RegisterDbgClasses; implementation +var + GSlavePtyFd: cint; + procedure RegisterDbgClasses; begin OSDbgClasses.DbgProcessClass:=TDbgLinuxProcess; @@ -298,12 +306,19 @@ procedure OnForkEvent; var e: integer; begin + login_tty(GSlavePtyFd); + e := fpgeterrno; + if e <> 0 then + begin + writeln('Failed to login to pty. Errcode: '+inttostr(e)+' - '+inttostr(GSlavePtyFd)); + end; + fpPTrace(PTRACE_TRACEME, 0, nil, nil); e := fpgeterrno; if e <> 0 then begin writeln('Failed to start trace of process. Errcode: '+inttostr(e)); - end + end; end; function TDbgLinuxThread.GetDebugRegOffset(ind: byte): pointer; @@ -542,12 +557,15 @@ end; constructor TDbgLinuxProcess.Create(const AName: string; const AProcessID, AThreadID: Integer; AOnLog: TOnLog); begin + FMasterPtyFd:=-1; inherited Create(AName, AProcessID, AThreadID, AOnLog); end; destructor TDbgLinuxProcess.Destroy; begin FProcProcess.Free; + if FMasterPtyFd>-1 then + FpClose(FMasterPtyFd); inherited Destroy; end; @@ -555,6 +573,7 @@ class function TDbgLinuxProcess.StartInstance(AFileName: string; AParams, AnEnvi var PID: TPid; AProcess: TProcess; + AMasterPtyFd: cint; AnExecutabeFilename: string; begin result := nil; @@ -579,12 +598,14 @@ begin AProcess.Parameters:=AParams; AProcess.Environment:=AnEnvironment; AProcess.CurrentDirectory:=AWorkingDirectory; - AProcess.Options := AProcess.Options + [poUsePipes]; + if openpty(@AMasterPtyFd, @GSlavePtyFd, nil, nil, nil) <> 0 then + AOnLog('Failed to open new pty. Errcode: '+inttostr(fpgeterrno), dllDebug); AProcess.Execute; PID:=AProcess.ProcessID; sleep(100); result := TDbgLinuxProcess.Create(AFileName, Pid, -1, AOnLog); + TDbgLinuxProcess(result).FMasterPtyFd := AMasterPtyFd; TDbgLinuxProcess(result).FProcProcess := AProcess; except on E: Exception do @@ -714,24 +735,34 @@ begin sleepytime.tv_sec := ATimeOutMs div 1000; sleepytime.tv_usec := (ATimeOutMs mod 1000)*1000; FpFD_ZERO(f); - fpFD_SET(FProcProcess.Output.Handle,f); - result := fpselect(FProcProcess.Output.Handle+1,@f,nil,nil,@sleepytime); + fpFD_SET(FMasterPtyFd,f); + result := fpselect(FMasterPtyFd+1,@f,nil,nil,@sleepytime); end; function TDbgLinuxProcess.GetConsoleOutput: string; var ABytesAvailable: DWord; + ABytesRead: cint; begin - ABytesAvailable := FProcProcess.Output.NumBytesAvailable; + if fpioctl(FMasterPtyFd, FIONREAD, @ABytesAvailable)<0 then + ABytesAvailable := 0; + if ABytesAvailable>0 then begin setlength(result, ABytesAvailable); - FProcProcess.Output.Read(result[1], ABytesAvailable); + ABytesRead := fpRead(FMasterPtyFd, result[1], ABytesAvailable); + SetLength(result, ABytesRead); end else result := ''; end; +procedure TDbgLinuxProcess.SendConsoleInput(AString: string); +begin + if FpWrite(FMasterPtyFd, AString[1], length(AString)) <> Length(AString) then + Log('Failed to send input to console.', dllDebug); +end; + function TDbgLinuxProcess.GetInstructionPointerRegisterValue: TDbgPtr; begin if Mode=dm32 then diff --git a/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas b/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas index 839af009a2..10fafdf47c 100644 --- a/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas +++ b/components/lazdebuggers/lazdebuggerfp/fpdebugdebugger.pas @@ -297,8 +297,8 @@ var begin if (Data=0) or assigned(TFpDebugDebugger(Data).FConsoleOutputThread) then begin - RTLeventSetEvent(FHasConsoleOutputQueued); s := FFpDebugDebugger.FDbgController.CurrentProcess.GetConsoleOutput; + RTLeventSetEvent(FHasConsoleOutputQueued); FFpDebugDebugger.OnConsoleOutput(self, s); end; end; @@ -1482,6 +1482,10 @@ begin String(AParams[1].VPointer^), TDBGType(AParams[2].VPointer^), EvalFlags); end; + dcSendConsoleInput: + begin + FDbgController.CurrentProcess.SendConsoleInput(String(AParams[0].VAnsiString)); + end; end; {case} end; @@ -1740,7 +1744,7 @@ end; function TFpDebugDebugger.GetSupportedCommands: TDBGCommands; begin Result:=[dcRun, dcStop, dcStepIntoInstr, dcStepOverInstr, dcStepOver, - dcRunTo, dcPause, dcStepOut, dcStepInto, dcEvaluate]; + dcRunTo, dcPause, dcStepOut, dcStepInto, dcEvaluate, dcSendConsoleInput]; end; end.