FPDServer: Stand-alone debugger that can be controlled from the console or remote through tcp/ip

git-svn-id: trunk@48991 -

.gitattributes

@@ -1343,6 +1343,14 @@ components/fpdebug/app/fpd/fpdpeimage.pas svneol=native#text/pascal
 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/app/fpdserver/Info.plist svneol=native#text/plain
+components/fpdebug/app/fpdserver/debuginoutputprocessor.pas svneol=native#text/plain
+components/fpdebug/app/fpdserver/debugtcpserver.pas svneol=native#text/plain
+components/fpdebug/app/fpdserver/debugthread.pas svneol=native#text/plain
+components/fpdebug/app/fpdserver/debugthreadcommand.pas svneol=native#text/plain
+components/fpdebug/app/fpdserver/fpdserver.lpi svneol=native#text/plain
+components/fpdebug/app/fpdserver/fpdserver.lpr svneol=native#text/plain
+components/fpdebug/app/fpdserver/readme.txt svneol=native#text/plain
 components/fpdebug/fpdbgclasses.pp svneol=native#text/pascal
 components/fpdebug/fpdbgcontroller.pas svneol=native#text/plain
 components/fpdebug/fpdbgdarwinclasses.pas svneol=native#text/plain

components/fpdebug/app/fpdserver/Info.plist

@@ -0,0 +1,20 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
+<plist version="1.0">
+  <dict>
+    <key>CFBundleDevelopmentRegion</key>
+    <string>English</string>
+    <key>CFBundleIdentifier</key>
+    <string>org.freepascal.fpdserver</string>
+    <key>CFBundleInfoDictionaryVersion</key>
+    <string>6.0</string>
+    <key>CFBundleName</key>
+    <string>fpdserver</string>
+    <key>CFBundleVersion</key>
+    <string>1.0</string>
+    <key>SecTaskAccess</key>
+    <array>
+      <string>allowed</string>
+    </array>
+  </dict>
+</plist>

components/fpdebug/app/fpdserver/debuginoutputprocessor.pas

@@ -0,0 +1,197 @@
+unit DebugInOutputProcessor;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes,
+  SysUtils,
+  fpjson,
+  FpDbgUtil,
+  DebugThreadCommand,
+  debugthread,
+  FpDbgClasses,
+  typinfo,
+  varutils,
+  variants,
+  jsonparser;
+
+type
+
+  { TCustomInOutputProcessor }
+
+  TCustomInOutputProcessor = class
+  private
+    FConnectionIdentifier: integer;
+  protected
+    FOnLog: TOnLog;
+  public
+    constructor create(AConnectionIdentifier: integer; AnOnLog: TOnLog); virtual;
+    function TextToCommand(const ACommandText: string): TFpDebugThreadCommand; virtual; abstract;
+    function EventToText(AnEvent: TFpDebugEvent): string; virtual; abstract;
+  end;
+
+  { TJSonInOutputProcessor }
+
+  TJSonInOutputProcessor = class(TCustomInOutputProcessor)
+  public
+    function TextToCommand(const ACommandText: string): TFpDebugThreadCommand; override;
+    function EventToText(AnEvent: TFpDebugEvent): string; override;
+  end;
+
+implementation
+
+var
+  GJSonInOutputProcessor: TJSonInOutputProcessor = nil;
+
+{ TCustomInOutputProcessor }
+
+constructor TCustomInOutputProcessor.create(AConnectionIdentifier: integer; AnOnLog: TOnLog);
+begin
+  FConnectionIdentifier:=AConnectionIdentifier;
+  FOnLog:=AnOnLog;
+end;
+
+{ TJSonInOutputProcessor }
+
+function TJSonInOutputProcessor.TextToCommand(const ACommandText: string): TFpDebugThreadCommand;
+var
+  AJSonCommand: TJSONData;
+  AJSonProp: TJSONData;
+  AJSonUID: TJSONData;
+  AnUID: variant;
+  ACommandClass: TFpDebugThreadCommandClass;
+  s: string;
+  i: integer;
+  APropCount: integer;
+  APropList: PPropList;
+  APropName: string;
+begin
+  result := nil;
+  try
+    AJSonCommand := GetJSON(ACommandText);
+  except
+    on E: Exception do
+      begin
+      TFpDebugThread.Instance.SendNotification(FConnectionIdentifier, ntInvalidCommand, NULL, 'Command "%s" is not a valid JSON string: %s', ACommandText, [ACommandText, e.Message]);
+      Exit;
+      end;
+  end;
+  if not assigned(AJSonCommand) then
+    begin
+    TFpDebugThread.Instance.SendNotification(FConnectionIdentifier, ntInvalidCommand, NULL, 'Command "%s" is not a valid JSON string.', ACommandText, [ACommandText]);
+    exit;
+    end;
+
+  try
+    if AJSonCommand.JSONType<>jtObject then
+      begin
+      TFpDebugThread.Instance.SendNotification(FConnectionIdentifier, ntInvalidCommand, NULL, 'Command "%s" is not a JSON-object.', ACommandText, [ACommandText]);
+      exit;
+      end;
+    s := TJSONObject(AJSonCommand).Get('command', '');
+    if s = '' then
+      begin
+      TFpDebugThread.Instance.SendNotification(FConnectionIdentifier, ntInvalidCommand, NULL, 'Command "%s" does not contain a "command" entry.', ACommandText,[ACommandText]);
+      exit;
+      end;
+    ACommandClass := TFpDebugThreadCommandList.instance.GetCommandByName(s);
+    if not assigned(ACommandClass) then
+      begin
+      TFpDebugThread.Instance.SendNotification(FConnectionIdentifier, ntInvalidCommand, NULL, 'Command "%s" does not exist.', s, [S]);
+      exit;
+      end;
+
+    AJSonUID := TJSONObject(AJSonCommand).find('uid');
+    if assigned(AJSonUID) then
+      AnUID := AJSonUID.Value
+    else
+      AnUID := null;
+
+    result := ACommandClass.Create(FConnectionIdentifier, AnUID, FOnLog);
+    APropCount := GetPropList(result, APropList);
+    for i := 0 to APropCount-1 do
+      begin
+      APropName := APropList^[i]^.Name;
+      AJSonProp := TJSONObject(AJSonCommand).Find(LowerCase(APropName));
+
+      if assigned(AJSonProp) then
+        begin
+        case APropList^[i]^.PropType^.Kind of
+          tkAString, tkString, tkUString:
+            SetStrProp(result, APropList^[i], AJSonProp.AsString);
+          tkInteger:
+            SetOrdProp(result, APropList^[i], AJSonProp.AsInteger);
+        end;
+        end;
+      end;
+  finally
+    AJSonCommand.Free;
+  end;
+end;
+
+function TJSonInOutputProcessor.EventToText(AnEvent: TFpDebugEvent): string;
+var
+  s: string;
+  JSonEvent: TJSONObject;
+  JSonLocationRec: TJSONObject;
+begin
+  JSonEvent := TJSONObject.Create;
+  try
+    JSonEvent.Add('type',FpEventTypeNames[AnEvent.EventType]);
+    if AnEvent.BreakpointAddr<>0 then
+      JSonEvent.Add('breakpointLocation', FormatAddress(AnEvent.BreakpointAddr));
+    if AnEvent.SendByConnectionIdentifier>0 then
+      JSonEvent.Add('connIdentifier', AnEvent.SendByConnectionIdentifier);
+    if AnEvent.LocationRec.Address <> 0 then
+      begin
+      JSonLocationRec := TJSONObject.Create;
+      JSonLocationRec.Add('address', FormatAddress(AnEvent.LocationRec.Address));
+      JSonLocationRec.Add('funcName', AnEvent.LocationRec.FuncName);
+      JSonLocationRec.Add('srcFile', AnEvent.LocationRec.SrcFile);
+      JSonLocationRec.Add('srcFullName', AnEvent.LocationRec.SrcFullName);
+      JSonLocationRec.Add('srcLine', AnEvent.LocationRec.SrcLine);
+      JSonEvent.Add('locationRec',JSonLocationRec);
+      end;
+    if not varisnull(AnEvent.AnUID) then
+      begin
+      if VarIsOrdinal(AnEvent.AnUID) then
+        JSonEvent.Add('uid', integer(AnEvent.AnUID))
+      else
+        JSonEvent.Add('uid', VarToStr(AnEvent.AnUID));
+      end;
+    case AnEvent.EventType of
+      etEvent:
+        begin
+        JSonEvent.Add('eventName',AnEvent.EventName);
+        if AnEvent.InstructionPointerRegValue<>0 then
+          JSonEvent.Add('instrPointer', FormatAddress(AnEvent.InstructionPointerRegValue));
+        end;
+      etLog  :
+        begin
+        JSonEvent.Add('message',AnEvent.Message);
+        case AnEvent.LogLevel of
+          dllDebug: JSonEvent.Add('logType','debug');
+          dllError: JSonEvent.Add('logType','error');
+          dllInfo: JSonEvent.Add('logType','info');
+        end;
+        end;
+      etNotification:
+        begin
+        JSonEvent.Add('notificationType',FpDebugNotificationTypeNames[AnEvent.NotificationType]);
+        JSonEvent.Add('message',AnEvent.Message);
+        if AnEvent.EventName<>'' then
+          JSonEvent.Add('command',AnEvent.EventName);
+        end;
+    end;
+    result := JSonEvent.AsJSON;
+  finally
+    JSonEvent.Free;
+  end;
+end;
+
+finalization
+  GJSonInOutputProcessor := nil;
+end.
+

components/fpdebug/app/fpdserver/debugtcpserver.pas

@@ -0,0 +1,297 @@
+unit DebugTCPServer;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes,
+  SysUtils,
+  ssockets,
+  BaseUnix,
+  debugthread,
+  sockets,
+  syncobjs,
+  FpDbgClasses,
+  lazfglhash,
+  lazCollections,
+  fpjson,
+  fgl,
+  DebugInOutputProcessor,
+  DebugThreadCommand;
+
+type
+
+  { TFpDebugTcpServer }
+
+  TFpDebugTcpConnectionThread = class;
+  TThreadedQueueString = specialize TLazThreadedQueue<string>;
+  TConnectionList = specialize TFPGObjectList<TFpDebugTcpConnectionThread>;
+
+  TFpDebugTcpServer = class(TThread)
+  private
+    FTCPConnection: TInetServer;
+    FConnectionList: TConnectionList;
+    FDebugThread: TFpDebugThread;
+    procedure FTCPConnectionConnect(Sender: TObject; Data: TSocketStream);
+    procedure FTCPConnectionAcceptError(Sender: TObject; ASocket: Longint; E: Exception; var ErrorAction: TAcceptErrorAction);
+    procedure FTCPConnectionConnectQuery(Sender: TObject; ASocket: Longint; var Allow: Boolean);
+  protected
+    procedure Execute; override;
+  public
+    procedure StopListening;
+    constructor create(ADebugThread: TFpDebugThread);
+    procedure RemoveConnection(ADebugTcpConnectionThread: TFpDebugTcpConnectionThread);
+    destructor Destroy; override;
+  end;
+
+  { TFpDebugTcpConnectionThread }
+
+  TFpDebugTcpConnectionThread = class(tthread, IFpDebugListener)
+  private
+    FData: TSocketStream;
+    FDebugThread: TFpDebugThread;
+    FResponseQueue: TThreadedQueueString;
+    FDebugTcpServer: TFpDebugTcpServer;
+    FConnectionIdentifier: integer;
+    FInOutputProcessor: TCustomInOutputProcessor;
+  protected
+    procedure Execute; override;
+    procedure SendCommand(ACommandStr: string);
+  public
+    procedure SendEvent(AnEvent: TFpDebugEvent);
+    function GetOrigin: string;
+    constructor create(ADebugThread: TFpDebugThread; ADebugTcpServer: TFpDebugTcpServer; Data: TSocketStream);
+    destructor Destroy; override;
+  end;
+
+implementation
+
+{ TFpDebugTcpConnectionThread }
+
+function STrToStr(AStr: string): string;
+var i : integer;
+begin
+  result := '';
+  for i := 1 to length(AStr) do
+    if ord(AStr[i])<20 then
+      result := result +'#'+inttostr(ord(AStr[i]))
+    else
+      result := result + Astr[i];
+end;
+
+procedure TFpDebugTcpConnectionThread.Execute;
+
+  procedure WriteString(AStr: string);
+  var
+    i: integer;
+  begin
+    AStr := AStr + #10;
+    i := FData.Write(AStr[1], length(AStr));
+
+    if i < 0 then
+      begin
+      if FData.LastError=32 then
+        begin
+        // Lost connection
+        end
+      else
+        FDebugThread.SendNotification(FConnectionIdentifier, ntConnectionProblem, null, 'Error during write. Socket-error: %d', '', [FData.LastError]);
+      Terminate;
+      end
+    else if i < length(AStr) then
+      raise exception.create('Message has not been send to client entirely');
+  end;
+
+const
+  InputBufferSize = 1024;
+var
+  s: string;
+  i: integer;
+  InputBuffer: array[0..InputBufferSize-1] of char;
+  InputStr: string;
+begin
+  WriteString('Welcome to FPDebug-server.');
+  if not Terminated then
+    WriteString('Your connection-idenfifier is '+IntToStr(FConnectionIdentifier)+'.');
+  if not Terminated then
+    WriteString('Send "help<enter>" for more information.');
+  while not terminated do
+    begin
+    i := FData.Read(InputBuffer[0], InputBufferSize);
+    if i > 0 then
+      begin
+      setlength(s,i);
+      move(InputBuffer[0],s[1],i);
+      s := StringReplace(s,#13#10,#10,[rfReplaceAll]);
+      InputStr:=InputStr+s;
+      i := pos(#10, InputStr);
+      while i > 0 do
+        begin
+        s := copy(InputStr, 1, i-1);
+        delete(InputStr,1,i);
+        SendCommand(S);
+        i := pos(#10, InputStr);
+        end;
+      end
+    else if i < 0 then
+      begin
+      if FData.LastError<>35 {EAGAIN} then
+        begin
+        writeln('Error during write. Socket-error: '+inttostr(FData.LastError));
+        Terminate;
+        end;
+      end
+    else if i = 0 then
+      begin
+      // Zero-count -> Connection closed
+      Terminate;
+      end;
+
+    if not terminated and (FResponseQueue.PopItem(s) = wrSignaled) then
+      begin
+      WriteString(s);
+      end;
+    end;
+  FDebugTcpServer.RemoveConnection(self);
+end;
+
+procedure TFpDebugTcpConnectionThread.SendCommand(ACommandStr: string);
+var
+  ACommand: TFpDebugThreadCommand;
+begin
+  ACommand := FInOutputProcessor.TextToCommand(ACommandStr);
+  if assigned(ACommand) then
+    FDebugThread.QueueCommand(ACommand);
+end;
+
+procedure TFpDebugTcpConnectionThread.SendEvent(AnEvent: TFpDebugEvent);
+var
+  s: string;
+begin
+  s := FInOutputProcessor.EventToText(AnEvent);
+  FResponseQueue.PushItem(s);
+end;
+
+function TFpDebugTcpConnectionThread.GetOrigin: string;
+begin
+  result :=  format('%d.%d.%d.%d:%d', [FData.RemoteAddress.sin_addr.s_bytes[1], FData.RemoteAddress.sin_addr.s_bytes[2],FData.RemoteAddress.sin_addr.s_bytes[3], FData.RemoteAddress.sin_addr.s_bytes[4], FData.RemoteAddress.sin_port])
+end;
+
+constructor TFpDebugTcpConnectionThread.create(ADebugThread: TFpDebugThread;
+  ADebugTcpServer: TFpDebugTcpServer; Data: TSocketStream);
+begin
+  FData := data;
+
+  // Set non-blocking
+  fpfcntl(FData.Handle,F_SETFL,O_NONBLOCK);
+
+  FDebugThread := ADebugThread;
+  FDebugTcpServer := ADebugTcpServer;
+  FResponseQueue:=TThreadedQueueString.create(100, INFINITE, 100);
+  FConnectionIdentifier := FDebugThread.AddListener(self);
+  FInOutputProcessor := TJSonInOutputProcessor.create(FConnectionIdentifier, @ADebugThread.SendLogMessage);
+  inherited create(false);
+end;
+
+destructor TFpDebugTcpConnectionThread.Destroy;
+begin
+  FInOutputProcessor.Free;
+  FDebugThread.RemoveListener(self);
+  FResponseQueue.Free;
+  FData.Free;
+  inherited Destroy;
+end;
+
+{ TFpDebugTcpServer }
+
+procedure TFpDebugTcpServer.FTCPConnectionAcceptError(Sender: TObject;
+  ASocket: Longint; E: Exception; var ErrorAction: TAcceptErrorAction);
+begin
+  if E is ESocketError and (ESocketError(E).Code=seAcceptFailed) and (socketerror=53) {ECONNABORTED} then
+    begin
+    // The socket has stopped listening. The TCP-server is shutting down...
+    ErrorAction:=aeaStop;
+    end
+  else
+    writeln('ErrorAction a: '+e.ClassName + ' -- ',ErrorAction, '::',socketerror);
+end;
+
+procedure TFpDebugTcpServer.FTCPConnectionConnectQuery(Sender: TObject;
+  ASocket: Longint; var Allow: Boolean);
+begin
+  Allow:=true;
+end;
+
+procedure TFpDebugTcpServer.FTCPConnectionConnect(Sender: TObject; Data: TSocketStream);
+var
+  AConnectionThread: TFpDebugTcpConnectionThread;
+begin
+  AConnectionThread:=TFpDebugTcpConnectionThread.create(FDebugThread, Self, data);
+  AConnectionThread.FreeOnTerminate:=true;
+  FConnectionList.Add(AConnectionThread);
+end;
+
+procedure TFpDebugTcpServer.Execute;
+var
+  AConnection: TInetServer;
+begin
+  try
+    FTCPConnection := TInetServer.Create(9001);
+    try
+      FTCPConnection.OnConnect:=@FTCPConnectionConnect;
+      FTCPConnection.OnConnectQuery:=@FTCPConnectionConnectQuery;
+      FTCPConnection.OnAcceptError:=@FTCPConnectionAcceptError;
+      FTCPConnection.Listen;
+      FTCPConnection.StartAccepting;
+    finally
+      AConnection:=FTCPConnection;
+      FTCPConnection := nil;
+      AConnection.Free;
+    end;
+  Except
+    on E: Exception do
+      begin
+      if (E is ESocketError) and (ESocketError(E).Code=seBindFailed) then
+        FDebugThread.SendNotification(-1, ntConnectionProblem, null, 'Failed to start listening for incoming TCP-connections: %s', '', [e.Message])
+      else
+        WriteLn('Exception: '+e.Message);
+      end;
+  end;
+end;
+
+procedure TFpDebugTcpServer.StopListening;
+begin
+  Terminate;
+  if assigned(FTCPConnection) then
+    FTCPConnection.StopAccepting(true);
+end;
+
+constructor TFpDebugTcpServer.create(ADebugThread: TFpDebugThread);
+begin
+  FDebugThread:=ADebugThread;
+  FConnectionList:=TConnectionList.Create(false);
+  inherited Create(false);
+end;
+
+procedure TFpDebugTcpServer.RemoveConnection(ADebugTcpConnectionThread: TFpDebugTcpConnectionThread);
+begin
+  FConnectionList.Remove(ADebugTcpConnectionThread);
+end;
+
+destructor TFpDebugTcpServer.Destroy;
+var
+  i: integer;
+begin
+  for i := 0 to FConnectionList.Count-1 do
+    FConnectionList[i].Terminate;
+  for i := 0 to FConnectionList.Count-1 do
+    FConnectionList[i].WaitFor;
+  if FConnectionList.Count<>0 then
+    raise exception.create('Not all connections are cleared.');
+  FConnectionList.Free;
+  inherited Destroy;
+end;
+
+end.
+

components/fpdebug/app/fpdserver/debugthread.pas

@@ -0,0 +1,410 @@
+unit debugthread;
+
+{$mode objfpc}{$H+}
+{$INTERFACES CORBA}
+
+interface
+
+uses
+  Classes,
+  SysUtils,
+  FPDbgController,
+  DbgIntfBaseTypes,
+  DbgIntfDebuggerBase,
+  lazfglhash,
+  fpjson,
+  FpDbgClasses;
+
+type
+  // The debug-thread sends three different kind of messages to it's listeners
+  TFpDebugEventType = (
+    etEvent,             // Messages that are send by the debugger. (debuggee has been started, pauzed, stopped, etc.)
+    etLog,               // Log-messages send by the debugger. (Fpdebug also uses log-messages to inform users of some
+                         // events (the dllInfo-log messages)
+    etNotification       // Messages from the debug-thread itself. Including new or lost connections and commands that
+                         // are queued or executed.
+  );
+
+  // The different kinds of etNotifications
+  TFpDebugNotificationType = (
+    ntNewConnection,
+    ntLostConnection,
+    ntInvalidCommand,
+    ntConnectionProblem,
+    ntReceivedCommand,
+    ntExecutedCommand,
+    ntFailedCommand
+  );
+
+  // This record is used to pass debugging-events. Not every field is applicable for each type of event.
+  TFpDebugEvent = record
+    SendByConnectionIdentifier: integer;
+    EventType: TFpDebugEventType;
+    NotificationType: TFpDebugNotificationType;
+    Message: string;
+    EventName: string;
+    LogLevel: TFPDLogLevel;
+    InstructionPointerRegValue: TDBGPtr;
+    AnUID: variant;
+    BreakpointAddr: TDBGPtr;
+    LocationRec: TDBGLocationRec;
+  end;
+
+  // Each listener should implement this interface.
+  IFpDebugListener = interface ['{2230763A-672E-4EC1-941D-6B8814D789C8}']
+     // This procedure is called by the debugthread when there is a message for the listener.
+     // Not that this procedure will be called from within the debug-thread, and should not take too much
+     // resources, or ot will slow down the debugging.
+     procedure SendEvent(AnEvent: TFpDebugEvent);
+     // Gives more information about the origin of the listener.
+     function GetOrigin: string;
+  end;
+
+  TFpDebugThread = class;
+
+  { TFpDebugThreadCommand }
+
+  // The base class for all commands that can be send to the debug-thread.
+
+  TFpDebugThreadCommand = class
+  private
+    FOnLog: TOnLog;
+  protected
+    FListenerIdentifier: integer;
+    FUID: variant;
+    procedure Log(const AString: string; const ALogLevel: TFPDLogLevel);
+  public
+    constructor Create(AListenerIdentifier: integer; AnUID: variant; AOnLog: TOnLog); virtual;
+    // Descendents may override this procedure to add additionol information to the event that will
+    // be send to all listeners when a command has been received succesfully
+    procedure ComposeReceiveEvent(var AnEvent: TFpDebugEvent); virtual;
+    // As above, for commands that has been executed successfully
+    procedure ComposeSuccessEvent(var AnEvent: TFpDebugEvent); virtual;
+    // As above, for commands that has failed to execute.
+    procedure ComposeFailureEvent(var AnEvent: TFpDebugEvent); virtual;
+    // Descendents have to override this function to implement the actual command. This function is called from within
+    // the debug-controller's debug loop. (This means it is only executed when the debuggee is paused or stopped)
+    // Should return tru on success, false on a failure. Set DoProcessLoop to true when the debuggee should continue,
+    // make it false if the debuggee should stay in a paused state.
+    function Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean; virtual; abstract;
+    // The name that is used to identify the command
+    class function TextName: string; virtual; abstract;
+    // The identifier of the Listener that has send this command
+    property ListenerIdentifier: integer read FListenerIdentifier;
+  end;
+  TFpDebugThreadCommandClass = class of TFpDebugThreadCommand;
+
+  { TFpDebugThread }
+
+  TFpDebugThread = class(TThread)
+  private
+    FCommandQueue: TThreadList;
+    FController: TDbgController;
+    FListenerList: TThreadList;
+  protected
+    // Handlers for the FController-events
+    procedure FControllerHitBreakpointEvent(var continue: boolean; const Breakpoint: TDbgBreakpoint);
+    procedure FControllerProcessExitEvent(ExitCode: DWord);
+    procedure FControllerCreateProcessEvent(var continue: boolean);
+    // Main debug thread-loop
+    procedure Execute; override;
+    // Send an event to all listeners
+    procedure SendEvent(ADebugEvent: TFpDebugEvent);
+    procedure ClearEvent(var AnEvent: TFpDebugEvent);
+  public
+    constructor Create;
+    destructor Destroy; override;
+    class function Instance: TFpDebugThread;
+    // Sends a command to the command-queue, the command-queue takes ownership of the command.
+    procedure QueueCommand(ACommand: TFpDebugThreadCommand);
+    // Procedures to send notifications and log-messages to the listeners
+    procedure SendNotification(AConnectionIdentifier: integer; ANotificationType: TFpDebugNotificationType; AnUID: variant; AMessage, ACommand: string);
+    procedure SendNotification(AConnectionIdentifier: integer; ANotificationType: TFpDebugNotificationType; AnUID: variant; AMessage, ACommand: string; Arg: array of const); overload;
+    procedure SendLogMessage(const AString: string; const ALogLevel: TFPDLogLevel);
+    // Methods to add and remove listeners
+    function AddListener(AFpDebugListener: IFpDebugListener): integer;
+    procedure RemoveListener(AFpDebugListener: IFpDebugListener);
+  end;
+
+const
+  FpEventTypeNames: array[TFpDebugEventType] of string = (
+    'event',
+    'log',
+    'notification');
+  FpDebugNotificationTypeNames: array[TFpDebugNotificationType] of string = (
+    'NewConnection',
+    'LostConnection',
+    'InvalidCommand',
+    'ConnectionProblem',
+    'ReceivedCommand',
+    'ExecutedCommand',
+    'FailedCommand');
+
+
+implementation
+
+var
+  FFpDebugThread: TFpDebugThread;
+
+{ TFpDebugThreadCommand }
+
+procedure TFpDebugThreadCommand.Log(const AString: string; const ALogLevel: TFPDLogLevel);
+begin
+  if assigned(FOnLog) then
+    FOnLog(AString, ALogLevel);
+end;
+
+constructor TFpDebugThreadCommand.Create(AListenerIdentifier: integer;
+  AnUID: variant; AOnLog: TOnLog);
+begin
+  FListenerIdentifier:=AListenerIdentifier;
+  FUID:=AnUID;
+  FOnLog:=AOnLog;
+end;
+
+procedure TFpDebugThreadCommand.ComposeReceiveEvent(var AnEvent: TFpDebugEvent);
+begin
+  AnEvent.EventType:=etNotification;
+  AnEvent.NotificationType:=ntReceivedCommand;
+  AnEvent.SendByConnectionIdentifier:=ListenerIdentifier;
+  AnEvent.AnUID:=FUID;
+  AnEvent.EventName:=TextName;
+  AnEvent.Message:=Format('Received %s-command.',[TextName]);
+end;
+
+procedure TFpDebugThreadCommand.ComposeSuccessEvent(var AnEvent: TFpDebugEvent);
+begin
+  AnEvent.EventType:=etNotification;
+  AnEvent.NotificationType:=ntExecutedCommand;
+  AnEvent.SendByConnectionIdentifier:=ListenerIdentifier;
+  AnEvent.AnUID:=FUID;
+  AnEvent.EventName:=TextName;
+  AnEvent.Message:=Format('%s-command executed succesfully.',[TextName]);
+end;
+
+procedure TFpDebugThreadCommand.ComposeFailureEvent(var AnEvent: TFpDebugEvent);
+begin
+  AnEvent.EventType:=etNotification;
+  AnEvent.NotificationType:=ntFailedCommand;
+  AnEvent.SendByConnectionIdentifier:=ListenerIdentifier;
+  AnEvent.AnUID:=FUID;
+  AnEvent.EventName:=TextName;
+  AnEvent.Message:=Format('%s-command failed.',[TextName]);
+end;
+
+{ TFpDebugThread }
+
+procedure TFpDebugThread.SendLogMessage(const AString: string; const ALogLevel: TFPDLogLevel);
+var
+  ADebugEvent: TFpDebugEvent;
+begin
+  ClearEvent(ADebugEvent);
+  ADebugEvent.EventType:=etLog;
+  ADebugEvent.Message:=AString;
+  ADebugEvent.LogLevel:=ALogLevel;
+
+  SendEvent(ADebugEvent);
+end;
+
+procedure TFpDebugThread.ClearEvent(var AnEvent: TFpDebugEvent);
+begin
+  AnEvent.AnUID:=null;
+  AnEvent.SendByConnectionIdentifier:=-1;
+  AnEvent.InstructionPointerRegValue:=0;
+  AnEvent.BreakpointAddr:=0;
+  AnEvent.LocationRec.Address:=0;
+end;
+
+procedure TFpDebugThread.FControllerHitBreakpointEvent(var continue: boolean; const Breakpoint: TDbgBreakpoint);
+var
+  ADebugEvent: TFpDebugEvent;
+begin
+  ClearEvent(ADebugEvent);
+  ADebugEvent.EventType:=etEvent;
+  ADebugEvent.EventName:='BreakPoint';
+  ADebugEvent.InstructionPointerRegValue:=FController.CurrentProcess.GetInstructionPointerRegisterValue;
+  if assigned(Breakpoint) then
+    ADebugEvent.BreakpointAddr:=Breakpoint.Location;
+
+  SendEvent(ADebugEvent);
+  continue:=false;
+end;
+
+procedure TFpDebugThread.FControllerProcessExitEvent(ExitCode: DWord);
+var
+  ADebugEvent: TFpDebugEvent;
+begin
+  ClearEvent(ADebugEvent);
+  ADebugEvent.EventType:=etEvent;
+  ADebugEvent.EventName:='ExitProcess';
+  ADebugEvent.InstructionPointerRegValue:=FController.CurrentProcess.GetInstructionPointerRegisterValue;
+
+  SendEvent(ADebugEvent);
+end;
+
+procedure TFpDebugThread.FControllerCreateProcessEvent(var continue: boolean);
+var
+  ADebugEvent: TFpDebugEvent;
+begin
+  ClearEvent(ADebugEvent);
+  ADebugEvent.EventType:=etEvent;
+  ADebugEvent.EventName:='CreateProcess';
+  ADebugEvent.InstructionPointerRegValue:=FController.CurrentProcess.GetInstructionPointerRegisterValue;
+
+  SendEvent(ADebugEvent);
+  continue:=false;
+end;
+
+procedure TFpDebugThread.Execute;
+var
+  AList: TList;
+  ACommand: TFpDebugThreadCommand;
+  ARunLoop: boolean;
+  AnEvent: TFpDebugEvent;
+begin
+  FController := TDbgController.Create;
+  FController.OnCreateProcessEvent:=@FControllerCreateProcessEvent;
+  FController.OnProcessExitEvent:=@FControllerProcessExitEvent;
+  FController.OnHitBreakpointEvent:=@FControllerHitBreakpointEvent;
+  FController.OnLog:=@SendLogMessage;
+
+  try
+    repeat
+    try
+      ACommand:=nil;
+      AList := FCommandQueue.LockList;
+      try
+        if AList.Count>0 then
+          begin
+          ACommand:=TFpDebugThreadCommand(AList.Items[0]);
+          AList.Delete(0);
+          end;
+      finally
+        FCommandQueue.UnlockList;
+      end;
+
+      if assigned(ACommand) then
+        begin
+        try
+          ClearEvent(AnEvent);
+          ACommand.ComposeReceiveEvent(AnEvent);
+          SendEvent(AnEvent);
+          if ACommand.Execute(FController, ARunLoop) then
+            begin
+            ClearEvent(AnEvent);
+            ACommand.ComposeSuccessEvent(AnEvent);
+            SendEvent(AnEvent);
+            end
+          else
+            begin
+            ClearEvent(AnEvent);
+            ACommand.ComposeFailureEvent(AnEvent);
+            SendEvent(AnEvent);
+            end;
+        finally
+          ACommand.Free;
+        end;
+
+        while ARunLoop do
+          begin
+          FController.ProcessLoop;
+          FController.SendEvents(ARunLoop);
+          end;
+        end;
+
+      sleep(100);
+    except
+      on E: Exception do
+        writeln('Exception in debug-thread: '+e.Message); // just continue
+    end;
+    until terminated;
+
+  finally
+    FController.Free;
+  end;
+end;
+
+procedure TFpDebugThread.SendEvent(ADebugEvent: TFpDebugEvent);
+var
+  i: integer;
+  AList: TList;
+begin
+  AList:=FListenerList.LockList;
+  try
+    for i := 0 to AList.Count-1 do
+      begin
+      IFpDebugListener(AList[i]).SendEvent(ADebugEvent);
+      end;
+  finally
+    FListenerList.UnlockList;
+  end;
+end;
+
+constructor TFpDebugThread.Create;
+begin
+  inherited create(false);
+  FCommandQueue := TThreadList.Create;
+  FListenerList:=TThreadList.Create;
+end;
+
+destructor TFpDebugThread.Destroy;
+begin
+  FListenerList.Free;
+  FCommandQueue.Free;
+  inherited Destroy;
+end;
+
+class function TFpDebugThread.Instance: TFpDebugThread;
+begin
+  if not assigned(FFpDebugThread) then
+    FFpDebugThread:=TFpDebugThread.Create;
+  result := FFpDebugThread;
+end;
+
+procedure TFpDebugThread.QueueCommand(ACommand: TFpDebugThreadCommand);
+begin
+  FCommandQueue.Add(ACommand);
+end;
+
+procedure TFpDebugThread.SendNotification(AConnectionIdentifier: integer; ANotificationType: TFpDebugNotificationType; AnUID: variant; AMessage, ACommand: string);
+var
+  AnEvent: TFpDebugEvent;
+begin
+  ClearEvent(AnEvent);
+  AnEvent.SendByConnectionIdentifier:=AConnectionIdentifier;
+  AnEvent.EventType:=etNotification;
+  AnEvent.NotificationType:=ANotificationType;
+  anEvent.EventName:=ACommand;
+  AnEvent.Message:=AMessage;
+  AnEvent.AnUID:=AnUID;
+  SendEvent(AnEvent);
+end;
+
+procedure TFpDebugThread.SendNotification(AConnectionIdentifier: integer; ANotificationType: TFpDebugNotificationType; AnUID: variant; AMessage, ACommand: string;
+  Arg: array of const);
+begin
+  SendNotification(AConnectionIdentifier, ANotificationType, AnUID, format(AMessage, Arg), ACommand);
+end;
+
+var
+  GIdentifierCount: integer = 0;
+
+function TFpDebugThread.AddListener(AFpDebugListener: IFpDebugListener): integer;
+begin
+  inc(GIdentifierCount);
+  result := GIdentifierCount;
+  SendNotification(result, ntNewConnection, null, 'New connection from %s', '',[AFpDebugListener.GetOrigin]);
+  FListenerList.Add(AFpDebugListener);
+end;
+
+procedure TFpDebugThread.RemoveListener(AFpDebugListener: IFpDebugListener);
+begin
+  FListenerList.Remove(AFpDebugListener);
+end;
+
+initialization
+  FFpDebugThread := nil;
+finalization
+  FFpDebugThread.Free;
+end.
+

components/fpdebug/app/fpdserver/debugthreadcommand.pas

@@ -0,0 +1,404 @@
+unit DebugThreadCommand;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes,
+  contnrs,
+  FPDbgController,
+  FpDbgClasses,
+  FpDbgUtil,
+  FpDbgInfo,
+  DbgIntfDebuggerBase,
+  DbgIntfBaseTypes,
+  strutils,
+  debugthread,
+  SysUtils;
+
+type
+
+  { TFpDebugThreadCommandList }
+
+  TFpDebugThreadCommandList = class(TFPList)
+  public
+    class function instance: TFpDebugThreadCommandList;
+    function GetCommandByName(ATextName: string): TFpDebugThreadCommandClass;
+  end;
+
+  { TFpDebugThreadSetFilenameCommand }
+
+  TFpDebugThreadSetFilenameCommand = class(TFpDebugThreadCommand)
+  private
+    FFileName: string;
+  public
+    function Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean; override;
+    class function TextName: string; override;
+  published
+    property Filename: string read FFileName write FFileName;
+  end;
+
+  { TFpDebugThreadRunCommand }
+
+  TFpDebugThreadRunCommand = class(TFpDebugThreadCommand)
+  public
+    function Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean; override;
+    class function TextName: string; override;
+  end;
+
+  { TFpDebugThreadContinueCommand }
+
+  TFpDebugThreadContinueCommand = class(TFpDebugThreadCommand)
+  public
+    function Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean; override;
+    class function TextName: string; override;
+  end;
+
+  { TFpDebugThreadNextCommand }
+
+  TFpDebugThreadNextCommand = class(TFpDebugThreadCommand)
+  public
+    function Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean; override;
+    class function TextName: string; override;
+  end;
+
+  { TFpDebugThreadStepCommand }
+
+  TFpDebugThreadStepCommand = class(TFpDebugThreadCommand)
+  public
+    function Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean; override;
+    class function TextName: string; override;
+  end;
+
+  { TFpDebugThreadStepOutCommand }
+
+  TFpDebugThreadStepOutCommand = class(TFpDebugThreadCommand)
+  public
+    function Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean; override;
+    class function TextName: string; override;
+  end;
+
+  { TFpDebugThreadStepIntoInstrCommand }
+
+  TFpDebugThreadStepIntoInstrCommand = class(TFpDebugThreadCommand)
+  public
+    function Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean; override;
+    class function TextName: string; override;
+  end;
+
+  { TFpDebugThreadStepOverInstrCommand }
+
+  TFpDebugThreadStepOverInstrCommand = class(TFpDebugThreadCommand)
+  public
+    function Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean; override;
+    class function TextName: string; override;
+  end;
+
+  { TFpDebugThreadStopCommand }
+
+  TFpDebugThreadStopCommand = class(TFpDebugThreadCommand)
+  public
+    function Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean; override;
+    class function TextName: string; override;
+  end;
+
+  { TFpDebugThreadAddBreakpointCommand }
+
+  TFpDebugThreadAddBreakpointCommand = class(TFpDebugThreadCommand)
+  private
+    FFileName: string;
+    FLine: integer;
+    FBreakPoint: FpDbgClasses.TDbgBreakpoint;
+  public
+    procedure ComposeSuccessEvent(var AnEvent: TFpDebugEvent); override;
+    function Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean; override;
+    class function TextName: string; override;
+  published
+    property Filename: string read FFileName write FFileName;
+    property Line: integer read FLine write FLine;
+  end;
+
+  { TFpDebugThreadGetLocationInfoCommand }
+
+  TFpDebugThreadGetLocationInfoCommand = class(TFpDebugThreadCommand)
+  private
+    FLocationRec: TDBGLocationRec;
+    FAddressValue: TDBGPtr;
+    function GetAddress: string;
+    procedure SetAddress(AValue: string);
+  protected
+    procedure ComposeSuccessEvent(var AnEvent: TFpDebugEvent); override;
+  public
+    function Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean; override;
+    class function TextName: string; override;
+  published
+    property Address: string read GetAddress write SetAddress;
+  end;
+
+implementation
+
+{ TFpDebugThreadCommandList }
+
+var
+  GFpDebugThreadCommandList: TFpDebugThreadCommandList = nil;
+
+{ TFpDebugThreadStopCommand }
+
+function TFpDebugThreadStopCommand.Execute(AController: TDbgController; out
+  DoProcessLoop: boolean): boolean;
+begin
+  AController.Stop;
+  DoProcessLoop:=true;
+  result := true;
+end;
+
+class function TFpDebugThreadStopCommand.TextName: string;
+begin
+  result := 'stop';
+end;
+
+{ TFpDebugThreadStepOutCommand }
+
+function TFpDebugThreadStepOutCommand.Execute(AController: TDbgController; out
+  DoProcessLoop: boolean): boolean;
+begin
+  AController.StepOut;
+  DoProcessLoop:=true;
+  result := true;
+end;
+
+class function TFpDebugThreadStepOutCommand.TextName: string;
+begin
+  result := 'stepout';
+end;
+
+{ TFpDebugThreadStepOverInstrCommand }
+
+function TFpDebugThreadStepOverInstrCommand.Execute(
+  AController: TDbgController; out DoProcessLoop: boolean): boolean;
+begin
+  AController.StepOverInstr;
+  DoProcessLoop:=true;
+  result := true;
+end;
+
+class function TFpDebugThreadStepOverInstrCommand.TextName: string;
+begin
+  result := 'stepoverinstr';
+end;
+
+{ TFpDebugThreadStepIntoInstrCommand }
+
+function TFpDebugThreadStepIntoInstrCommand.Execute(
+  AController: TDbgController; out DoProcessLoop: boolean): boolean;
+begin
+  AController.StepIntoInstr;
+  DoProcessLoop:=true;
+  result := true;
+end;
+
+class function TFpDebugThreadStepIntoInstrCommand.TextName: string;
+begin
+  result := 'stepintoinstr';
+end;
+
+{ TFpDebugThreadStepCommand }
+
+function TFpDebugThreadStepCommand.Execute(AController: TDbgController; out
+  DoProcessLoop: boolean): boolean;
+begin
+  AController.Step;
+  DoProcessLoop:=true;
+  result := true;
+end;
+
+class function TFpDebugThreadStepCommand.TextName: string;
+begin
+  result := 'step';
+end;
+
+{ TFpDebugThreadNextCommand }
+
+function TFpDebugThreadNextCommand.Execute(AController: TDbgController; out
+  DoProcessLoop: boolean): boolean;
+begin
+  AController.Next;
+  DoProcessLoop:=true;
+  result := true;
+end;
+
+class function TFpDebugThreadNextCommand.TextName: string;
+begin
+  result := 'next';
+end;
+
+{ TFpDebugThreadGetLocationInfoCommand }
+
+function TFpDebugThreadGetLocationInfoCommand.GetAddress: string;
+begin
+  result := FormatAddress(FAddressValue);
+end;
+
+procedure TFpDebugThreadGetLocationInfoCommand.SetAddress(AValue: string);
+begin
+  FAddressValue := Hex2Dec(AValue);
+end;
+
+procedure TFpDebugThreadGetLocationInfoCommand.ComposeSuccessEvent(var AnEvent: TFpDebugEvent);
+begin
+  inherited ComposeSuccessEvent(AnEvent);
+  AnEvent.LocationRec:=FLocationRec;
+end;
+
+function TFpDebugThreadGetLocationInfoCommand.Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean;
+var
+  sym, symproc: TFpDbgSymbol;
+begin
+  DoProcessLoop:=false;
+  result := false;
+  if Assigned(AController.CurrentProcess) then
+    begin
+    FLocationRec.FuncName:='';
+    FLocationRec.SrcFile:='';
+    FLocationRec.SrcFullName:='';
+    FLocationRec.SrcLine:=0;
+
+    if FAddressValue=0 then
+      FLocationRec.Address := AController.CurrentProcess.GetInstructionPointerRegisterValue
+    else
+      FLocationRec.Address := FAddressValue;
+
+    sym := AController.CurrentProcess.FindSymbol(FLocationRec.Address);
+    if sym = nil then
+      Exit;
+
+    FLocationRec.SrcFile := ExtractFileName(sym.FileName);
+    FLocationRec.SrcLine := sym.Line;
+    FLocationRec.SrcFullName := sym.FileName;
+
+    symproc := sym;
+    while not (symproc.kind in [skProcedure, skFunction]) do
+      symproc := symproc.Parent;
+
+    if assigned(symproc) then
+      FLocationRec.FuncName:=symproc.Name;
+    sym.free;
+    result := true;
+    end;
+end;
+
+class function TFpDebugThreadGetLocationInfoCommand.TextName: string;
+begin
+  result := 'getlocationinfo'
+end;
+
+{ TFpDebugThreadAddBreakpointCommand }
+
+procedure TFpDebugThreadAddBreakpointCommand.ComposeSuccessEvent(var AnEvent: TFpDebugEvent);
+begin
+  inherited ComposeSuccessEvent(AnEvent);
+  AnEvent.BreakpointAddr:=FBreakPoint.Location;
+end;
+
+function TFpDebugThreadAddBreakpointCommand.Execute(AController: TDbgController; out DoProcessLoop: boolean): boolean;
+begin
+  result := false;
+  DoProcessLoop:=false;
+  if not assigned(AController.CurrentProcess) then
+    begin
+    log('Failed to add breakpoint: No process', dllInfo);
+    exit;
+    end;
+  if (Filename<>'') and (line>-1) then
+    begin
+    FBreakPoint := AController.CurrentProcess.AddBreak(FileName, Line);
+    result := assigned(FBreakPoint);
+    end
+  else
+    log('Failed to add breakpoint: No filename and line-number given', dllInfo);
+end;
+
+class function TFpDebugThreadAddBreakpointCommand.TextName: string;
+begin
+  result := 'breakpoint';
+end;
+
+class function TFpDebugThreadCommandList.instance: TFpDebugThreadCommandList;
+begin
+  if not assigned(GFpDebugThreadCommandList) then
+    GFpDebugThreadCommandList := TFpDebugThreadCommandList.Create;
+  result := GFpDebugThreadCommandList;
+end;
+
+function TFpDebugThreadCommandList.GetCommandByName(ATextName: string): TFpDebugThreadCommandClass;
+var
+  i: Integer;
+begin
+  result := nil;
+  for i := 0 to count -1 do
+    begin
+    if TFpDebugThreadCommandClass(Items[i]).TextName=ATextName then
+      result := TFpDebugThreadCommandClass(Items[i]);
+    end;
+end;
+
+{ TFpDebugThreadContinueCommand }
+
+function TFpDebugThreadContinueCommand.Execute(AController: TDbgController; out
+  DoProcessLoop: boolean): boolean;
+begin
+  DoProcessLoop:=true;
+  result := true;
+end;
+
+class function TFpDebugThreadContinueCommand.TextName: string;
+begin
+  result := 'continue';
+end;
+
+{ TFpDebugThreadRunCommand }
+
+function TFpDebugThreadRunCommand.Execute(AController: TDbgController; out
+  DoProcessLoop: boolean): boolean;
+begin
+  DoProcessLoop := AController.Run;
+  result := DoProcessLoop;
+end;
+
+class function TFpDebugThreadRunCommand.TextName: string;
+begin
+  result := 'run';
+end;
+
+{ TFpDebugThreadSetFilenameCommand }
+
+function TFpDebugThreadSetFilenameCommand.Execute(AController: TDbgController;
+  out DoProcessLoop: boolean): boolean;
+begin
+  AController.ExecutableFilename:=FFileName;
+  DoProcessLoop:=false;
+  result:=true;
+end;
+
+class function TFpDebugThreadSetFilenameCommand.TextName: string;
+begin
+  result := 'filename'
+end;
+
+initialization
+  TFpDebugThreadCommandList.instance.Add(TFpDebugThreadSetFilenameCommand);
+  TFpDebugThreadCommandList.instance.Add(TFpDebugThreadRunCommand);
+  TFpDebugThreadCommandList.instance.Add(TFpDebugThreadContinueCommand);
+  TFpDebugThreadCommandList.instance.Add(TFpDebugThreadStepOverInstrCommand);
+  TFpDebugThreadCommandList.instance.Add(TFpDebugThreadStepIntoInstrCommand);
+  TFpDebugThreadCommandList.instance.Add(TFpDebugThreadNextCommand);
+  TFpDebugThreadCommandList.instance.Add(TFpDebugThreadStepCommand);
+  TFpDebugThreadCommandList.instance.Add(TFpDebugThreadStepOutCommand);
+  TFpDebugThreadCommandList.instance.Add(TFpDebugThreadStopCommand);
+  TFpDebugThreadCommandList.instance.Add(TFpDebugThreadAddBreakpointCommand);
+  TFpDebugThreadCommandList.instance.Add(TFpDebugThreadGetLocationInfoCommand);
+finalization
+  GFpDebugThreadCommandList.Free;
+end.
+

components/fpdebug/app/fpdserver/fpdserver.lpi

@@ -0,0 +1,105 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="FPD Server"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="2">
+      <Item1>
+        <PackageName Value="LazUtils"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="fpdebug"/>
+      </Item2>
+    </RequiredPackages>
+    <Units Count="5">
+      <Unit0>
+        <Filename Value="fpdserver.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="debugthread.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="debugthread"/>
+      </Unit1>
+      <Unit2>
+        <Filename Value="debugthreadcommand.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="DebugThreadCommand"/>
+      </Unit2>
+      <Unit3>
+        <Filename Value="debugtcpserver.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="DebugTCPServer"/>
+      </Unit3>
+      <Unit4>
+        <Filename Value="debuginoutputprocessor.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="DebugInOutputProcessor"/>
+      </Unit4>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="fpdserver"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Debugging>
+        <UseHeaptrc Value="True"/>
+      </Debugging>
+      <Options>
+        <PassLinkerOptions Value="True"/>
+        <LinkerOptions Value="-sectcreate __TEXT __info_plist Info.plist"/>
+      </Options>
+    </Linking>
+    <Other>
+      <ExecuteAfter>
+        <Command Value="codesign -s fpdebug fpdserver"/>
+        <CompileReasons Run="False"/>
+      </ExecuteAfter>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

components/fpdebug/app/fpdserver/fpdserver.lpr

@@ -0,0 +1,197 @@
+program fpdserver;
+
+{ FPDebug server
+
+  Copyright (C) 2015 Joost van der Sluis joost@cnoc.nl
+
+  This source is free software; you can redistribute it and/or modify it under the terms of the GNU General Public
+  License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later
+  version.
+
+  This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied
+  warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License for more
+  details.
+
+  A copy of the GNU General Public License is available on the World Wide Web at
+  <http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing to the Free Software Foundation, Inc., 59
+  Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+}
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}
+  cthreads,
+  {$ENDIF}
+  Classes,
+  SysUtils,
+  CustApp,
+  syncobjs,
+  pipes,
+  lazfglhash,
+  debugthread,
+  DebugThreadCommand,
+  lazCollections,
+  DebugInOutputProcessor,
+  DebugTCPServer;
+
+type
+
+  TFpDebugEventQueue = specialize TLazThreadedQueue<TFpDebugEvent>;
+
+  { TFPDServerApplication }
+
+  TFPDServerApplication = class(TCustomApplication, IFpDebugListener)
+  private
+    FEventQueue: TFpDebugEventQueue;
+    FInOutputProcessor: TCustomInOutputProcessor;
+    FConnectionIdentifier: integer;
+  protected
+    procedure DoRun; override;
+  public
+    constructor Create(TheOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure WriteHelp; virtual;
+    // IFpDebugListener
+    procedure SendEvent(AnEvent: TFpDebugEvent);
+    function GetOrigin: string;
+  end;
+
+{ TFPDServerApplication }
+
+procedure TFPDServerApplication.DoRun;
+var
+  ErrorMsg: String;
+  DebugThread: TFpDebugThread;
+  DebugEvent: TFpDebugEvent;
+  InputStream: TInputPipeStream;
+  CommandStr: string;
+  TCPServerThread: TFpDebugTcpServer;
+  ACommand: TFpDebugThreadCommand;
+  b: char;
+begin
+  // quick check parameters
+  ErrorMsg:=CheckOptions('hf', ['help']);
+  if ErrorMsg<>'' then
+    begin
+    ShowException(Exception.Create(ErrorMsg));
+    Terminate;
+    Exit;
+    end;
+
+  // parse parameters
+  if HasOption('h', 'help') then
+    begin
+    WriteHelp;
+    Terminate;
+    Exit;
+    end;
+
+  DebugThread := TFpDebugThread.Instance;
+  TCPServerThread := TFpDebugTcpServer.Create(DebugThread);
+
+  if HasOption('f') then
+    begin
+    CommandStr := GetOptionValue('f');
+    if CommandStr<>'' then
+      begin
+      ACommand := TFpDebugThreadSetFilenameCommand.create(-1, null, @DebugThread.SendLogMessage);
+      TFpDebugThreadSetFilenameCommand(ACommand).Filename:=CommandStr;
+      DebugThread.QueueCommand(ACommand);
+      end
+    else
+      begin
+      WriteHelp;
+      Terminate;
+      end;
+    CommandStr:='';
+    end;
+
+  InputStream:=TInputPipeStream.Create(StdInputHandle);
+
+  FConnectionIdentifier := DebugThread.AddListener(self);
+  FInOutputProcessor := TJSonInOutputProcessor.create(FConnectionIdentifier, @DebugThread.SendLogMessage);
+  try
+
+    while not terminated do
+      begin
+      if FEventQueue.PopItem(DebugEvent) = wrSignaled then
+        begin
+        writeln(FInOutputProcessor.EventToText(DebugEvent));
+        end;
+      while InputStream.NumBytesAvailable>0 do
+        begin
+        InputStream.Read(b,sizeof(b));
+        if b <> #10 then
+          CommandStr:=CommandStr+b
+        else
+          begin
+          if CommandStr='q' then
+            Terminate
+          else
+            begin
+            ACommand := FInOutputProcessor.TextToCommand(CommandStr);
+            if assigned(ACommand) then
+              DebugThread.QueueCommand(ACommand);
+            end;
+          CommandStr:='';
+          end;
+        end;
+      CheckSynchronize;
+      end;
+
+    DebugThread.RemoveListener(self);
+
+  finally
+    FInOutputProcessor.Free;
+  end;
+
+
+  TCPServerThread.StopListening;
+  TCPServerThread.WaitFor;
+  TCPServerThread.Free;
+  DebugThread.Terminate;
+  DebugThread.WaitFor;
+  InputStream.Free;
+
+  terminate;
+end;
+
+constructor TFPDServerApplication.Create(TheOwner: TComponent);
+begin
+  inherited Create(TheOwner);
+  FEventQueue:=TFpDebugEventQueue.Create(100, INFINITE, 100);
+  StopOnException:=True;
+end;
+
+destructor TFPDServerApplication.Destroy;
+begin
+  FEventQueue.Free;
+  inherited Destroy;
+end;
+
+procedure TFPDServerApplication.SendEvent(AnEvent: TFpDebugEvent);
+begin
+  FEventQueue.PushItem(AnEvent);
+end;
+
+function TFPDServerApplication.GetOrigin: string;
+begin
+  result := 'console';
+end;
+
+procedure TFPDServerApplication.WriteHelp;
+begin
+  { add your help code here }
+  writeln('Usage: ', ExeName, ' --help -h -f <executable name>');
+end;
+
+var
+  Application: TFPDServerApplication;
+begin
+  Application:=TFPDServerApplication.Create(nil);
+  Application.Title:='FPD Server';
+  Application.Run;
+  Application.Free;
+end.
+

components/fpdebug/app/fpdserver/readme.txt

@@ -0,0 +1,22 @@
+FPDebug-Server
+
+The FPDebug-server contains a single fpdebug-thread to be able to debug one application at a time.
+
+Multiple listeners can attach to this debug-thread so that they will receive messages from the fpdebug-thread about
+the application being debugged.
+The listeners can also send commands to the debug-thread, all listeners will receive information about all comands.
+
+By default there are two listeners, one to communicate with the console. That way the debugger can be controlled from
+the console. The other listener is setting up a tcp-server listening on port 9001. It's possible to connect to this
+port using telnet to control the debugging.
+
+In- and output are in a a json-format, but it is possible to register multiple formats.
+
+The FPDebug-server could be used as a stand-alone debugger, controlled using the console. Or it could be used by other
+front-ends using the tcp-listener. Multiple connections can be used to monitor what is happening.
+
+The goal is to add a Lazarus as a front end. It can be used for remote-debugging, and it can be used to avoid the
+necessity to sign the Lazarus-executable to be able to debug on OS/X. (Only the FPDebug-server has to be signed)
+
+Joost van der Sluis, may 2015.
+