paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-13 21:19:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

FpDebugServer: Added --interactive option to return an easy parseable output with the tcp-port number.

Browse Source 
git-svn-id: trunk@49134 -
This commit is contained in:
joost 2015-05-22 19:54:47 +00:00
parent 05aa7ea1ca
commit 8b2acf39c1
3 changed files with 60 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
components/fpdebug/app/fpdserver/debuginoutputprocessor.pas
View File

@ -38,6 +38,7 @@ type
public
function TextToCommand(const ACommandText: string): TFpDebugThreadCommand; override;
function EventToText(AnEvent: TFpDebugEvent): string; override;
class function InteractiveInitializationMessage(APort: integer): string;
end;
implementation
@ -195,6 +196,24 @@ begin
end;
end;
class function TJSonInOutputProcessor.InteractiveInitializationMessage(APort: integer): string;
var
s: string;
JSonMessage: TJSONObject;
JSonLocationRec: TJSONObject;
begin
JSonMessage := TJSONObject.Create;
try
JSonMessage.Add('welcome', 'FPDebug Server');
JSonMessage.Add('copyright', 'Joost van der Sluis (2015)');
if APort>-1 then
JSonMessage.Add('port', APort);
result := JSonMessage.AsJSON;
finally
JSonMessage.Free;
end;
end;
finalization
GJSonInOutputProcessor := nil;
end.

17
components/fpdebug/app/fpdserver/debugtcpserver.pas
View File

@ -35,6 +35,7 @@ type
FTCPConnection: TInetServer;
FConnectionList: TConnectionList;
FDebugThread: TFpDebugThread;
FInitializationFinished: PRTLEvent;
function CreateInetServer: TInetServer;
procedure FTCPConnectionConnect(Sender: TObject; Data: TSocketStream);
procedure FTCPConnectionAcceptError(Sender: TObject; ASocket: Longint; E: Exception; var ErrorAction: TAcceptErrorAction);
@ -42,6 +43,7 @@ type
protected
procedure Execute; override;
public
procedure WaitForInitialization(out Port: integer);
procedure StopListening;
constructor create(ADebugThread: TFpDebugThread; APort, ASensePorts: integer);
procedure RemoveConnection(ADebugTcpConnectionThread: TFpDebugTcpConnectionThread);
@ -260,10 +262,14 @@ begin
if conn then
begin
result := InetServer;
FDebugThread.SendNotification(-1, ntListenerMessage, null, 'Listening for incoming TCP-connections on port %d', '', [result.Port])
FPort:=result.Port;
FDebugThread.SendNotification(-1, ntListenerMessage, null, 'Listening for incoming TCP-connections on port %d', '', [FPort])
end
else
begin
FPort:=-1;
FDebugThread.SendNotification(-1, ntConnectionProblem, null, 'Failed to start listening for incoming TCP-connections: %s', '', [FFirstError])
end;
end;
procedure TFpDebugTcpServer.FTCPConnectionConnect(Sender: TObject; Data: TSocketStream);
@ -281,6 +287,7 @@ var
begin
try
FTCPConnection := CreateInetServer;
RTLeventSetEvent(FInitializationFinished);
if assigned(FTCPConnection) then
begin
try
@ -302,6 +309,12 @@ begin
end;
end;
procedure TFpDebugTcpServer.WaitForInitialization(out Port: integer);
begin
RTLeventWaitFor(FInitializationFinished);
Port := FPort;
end;
procedure TFpDebugTcpServer.StopListening;
begin
Terminate;
@ -317,6 +330,7 @@ begin
FSensePorts:=ASensePorts;
FDebugThread:=ADebugThread;
FConnectionList:=TConnectionList.Create(false);
FInitializationFinished:=RTLEventCreate;
inherited Create(false);
end;
@ -329,6 +343,7 @@ destructor TFpDebugTcpServer.Destroy;
var
i: integer;
begin
RTLeventdestroy(FInitializationFinished);
for i := 0 to FConnectionList.Count-1 do
FConnectionList[i].Terminate;
for i := 0 to FConnectionList.Count-1 do

34
components/fpdebug/app/fpdserver/fpdserver.lpr
View File

@ -58,10 +58,13 @@ var
CommandStr: string;
begin
// quick check parameters
ErrorMsg:=CheckOptions('hf:tdp:a::', ['help','filename:','tcp','daemon','port:','autoport::'], True);
ErrorMsg:=CheckOptions('hf:tdp:a::i', ['help','filename:','tcp','daemon','port:','autoport::','interactive'], True);
writeln('FPDebug Server');
writeln('Copyright (c) 2015 by Joost van der Sluis');
if not HasOption('i','interactive') then
begin
writeln('FPDebug Server');
writeln('Copyright (c) 2015 by Joost van der Sluis');
end;
if ErrorMsg<>'' then
begin
@ -121,6 +124,18 @@ begin
else
TCPServerThread := nil;
if HasOption('i','interactive') then
begin
if assigned(TCPServerThread) then
begin
TCPServerThread.WaitForInitialization(Port);
end
else
Port := -1;
writeln(TJSonInOutputProcessor.InteractiveInitializationMessage(Port));
FlushThread;
end;
CommandStr := GetOptionValue('f', 'filename');
if CommandStr<>'' then
begin
@ -168,13 +183,14 @@ procedure TFPDServerApplication.WriteHelp;
begin
writeln('fpdserver [options]');
writeln(' List of options without argument:');
writeln(' -h --help Show this help message');
writeln(' -t --tcp Start listening to incoming tcp-connections');
writeln(' -d --daemon Do not use the console in- or output');
writeln(' -h --help Show this help message');
writeln(' -t --tcp Start listening to incoming tcp-connections');
writeln(' -d --daemon Do not use the console in- or output');
writeln(' -i --interactive Run in interactive mode for automatic parsing');
writeln(' List of options with argument:');
writeln(' -f --filename Set the filename of the executable to debug');
writeln(' -p --port Set the port (9159) to listen for incoming tcp-connections');
writeln(' -a --autoport Try to bind to n (5) sequential ports when a port is in use');
writeln(' -f --filename Set the filename of the executable to debug');
writeln(' -p --port Set the port (9159) to listen for incoming tcp-connections');
writeln(' -a --autoport Try to bind to n (5) sequential ports when a port is in use');
end;
var