FpDebugger (pure): Use a pseudo-terminal instead of pipes to read the debuggees out- and in-put

git-svn-id: trunk@46070 -

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;

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);
+  fpFD_SET(FMasterPtyFd,f);
-  result := fpselect(FProcProcess.Output.Handle+1,@f,nil,nil,@sleepytime);
+  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

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.