From 2456438046cb338ee460b9eb4c6d0754247b2133 Mon Sep 17 00:00:00 2001 From: Joost van der Sluis Date: Mon, 17 Jun 2024 15:11:16 +0200 Subject: [PATCH 1/5] Ability to choose between TCP/IP and pipes as comunication layer --- src/protocol/PasLS.TextLoop.pas | 408 +++++++++++++++++++++++++------- src/standard/pasls.lpr | 36 ++- 2 files changed, 348 insertions(+), 96 deletions(-) diff --git a/src/protocol/PasLS.TextLoop.pas b/src/protocol/PasLS.TextLoop.pas index 1e751b6..14252cc 100644 --- a/src/protocol/PasLS.TextLoop.pas +++ b/src/protocol/PasLS.TextLoop.pas @@ -24,9 +24,10 @@ interface uses - Classes, SysUtils, LSP.Base, LSP.Messages, fpjson; + Classes, SysUtils, ssockets, LSP.Base, LSP.Messages, fpjson; Type + TCreateLSPContextEvent = function(OutStream, LogStream: THandleStream): TLSPContext; { TTextLSPContext } PText = ^Text; @@ -34,34 +35,101 @@ interface { TLSPTextTransport } TLSPTextTransport = class(TMessageTransport) - FOutput : PText; - FError : PText; + FOutput : THandleStream; + // Logging occurs to stdout (tcpip), or stderr (pipes) + FLog : THandleStream; Protected Procedure DoSendMessage(aMessage: TJSONData); override; Procedure DoSendDiagnostic(const aMessage: UTF8String); override; Public - constructor Create(aOutput,aError : PText); reintroduce; + constructor Create(aOutput,aLog : THandleStream); reintroduce; Procedure EmitMessage(aMessage: TJSONStringType); end; - - -Procedure SetupTextLoop(var aInput,aOutput,aError : Text); -Procedure RunMessageLoop(var aInput,aOutput,aError : Text; aContext : TLSPContext); +Procedure SetupTextLoop(); +Procedure RunMessageLoop(aDoCreateContext: TCreateLSPContextEvent; aTcpip: Boolean; aListenIpAddress: string; aListenPort: Integer); procedure DebugSendMessage(var aFile : Text; aContext : TLSPContext; const aMethod, aParams: String); implementation -Procedure SetupTextLoop(var aInput,aOutput,aError : Text); +const + ContentType = 'application/vscode-jsonrpc; charset=utf-8'; + CRLF = #13#10; + +type + TTcpipConnectionThread = class; + + { TRunLoop } + + // To be able to handle both TCP/IP and pipes, the THandleStream and + // TSocketStream classes are used. + // + // To handle the different nature of TCP/IP running as a server and piped + // communication two threads are used. + // + // The first thread is only started in case TCP/IP is used and this thread + // just waits for an incoming TCP/IP connection. (the client) Only one + // connection is accepted and the thread immediately ends afterwards. + // (In principle PasLS could be extended to handle multiple clients/sessions + // simultaneously, but this is not implemented) + // + // The second thread is started at application start (pipe) or on an incoming + // connection (TCP/IP) and waits in the background for incoming LSP messages + // and send those to the main-thread to be handled. + TRunLoop = class + private + FDoCreateContext: TCreateLSPContextEvent; + FListenIp: string; + FListenPort: Integer; + // We only allow one connection, this boolean is set when this connection is + // made + FHasConnection: Boolean; + + FMustStop: Boolean; + FContext: TLSPContext; + FIO: TLSPTextTransport; + FLogStream: THandleStream; + + procedure HandleNewConnection(aSender: TObject; aData: TSocketStream); + procedure StopExecution(); + procedure ListenForIncomingConnections(); + procedure InitializeLSPTextTransport(aOutStream, aLogStream: THandleStream); + public + constructor Create(aDoCreateContext: TCreateLSPContextEvent; aListenIpAddress: string; aListenPort: Integer); + procedure Execute(aTcpip: Boolean); + property DoCreateContext: TCreateLSPContextEvent read FDoCreateContext; + end; + + { TTcpipConnectionThread } + + TTcpipConnectionThread = class(TThread) + private + FInStream: THandleStream; + FContent: UnicodeString; + FContext: TLSPContext; + FIO: TLSPTextTransport; + FRunLoop: TRunLoop; + protected + // Processes all incoming LSP messages within the main thread and sends a + // LSP-response when applicable + procedure ProcessMessage(); + // Waits for a new incoming LSP message and returns the message as a array of bytes + function AwaitMessage(aInStream: THandleStream; aVerboseOutput: Boolean): TBytes; + public + constructor Create(aInStream: THandleStream; aContext: TLSPContext; aIO: TLSPTextTransport; aRunLoop: TRunLoop); + destructor Destroy; override; + // Main execution loop that runs in a background thread and waits for incoming + // messages (blocking). Once a message is received it is signaled to be + // processed in the main-thread. + procedure Execute; override; + end; + +Procedure SetupTextLoop(); begin TJSONData.CompressedJSON := True; - SetTextLineEnding(aInput, #13#10); - SetTextLineEnding(aOutput, #13#10); - SetTextLineEnding(aError, #13#10); end; - procedure DebugSendMessage(var aFile : Text; aContext : TLSPContext; const aMethod, aParams: String); var @@ -88,43 +156,6 @@ procedure DebugSendMessage(var aFile : Text; aContext : TLSPContext; const aMeth end; end; - - -Function ReadRequest(var aFile : text; aContext : TLSPContext) : TJSONData; - -Var - Header,Name,Value: String; - Content : TJSONStringType; - I,ContentLength : Integer; - P : PJSONCharType; - -begin - Result:=Nil; - aContext.Log('Reading request'); - ReadLn(aFile,Header); - while Header <> '' do - begin - aContext.Log('Read header: %s',[Header]); - I := Pos(':', Header); - Name := Copy(Header, 1, I - 1); - Delete(Header, 1, i); - Value := Trim(Header); - if Name = 'Content-Length' then - ContentLength := StrToIntDef(Value,0); - ReadLn(aFile,Header); - end; - Content:=''; - SetLength(Content,ContentLength); - P:=PJSONCharType(Content); - for I:=1 to ContentLength do - begin - Read(aFile,P^); - inc(P); - end; - if Content<>'' then - Result:=GetJSON(Content, True); -end; - Procedure SendResponse(aTransport : TMessageTransport; aContext : TLSPContext; aResponse : TJSONData; aFreeResponse : Boolean = True); Var @@ -147,68 +178,170 @@ procedure DebugSendMessage(var aFile : Text; aContext : TLSPContext; const aMeth end; end; -Procedure RunMessageLoop(var aInput,aOutput,aError : Text; aContext : TLSPContext); +{ TTcpipConnectionThread } +// Should always run in main thread +procedure TTcpipConnectionThread.ProcessMessage(); var Request, Response: TJSONData; VerboseDebugging: boolean = false; - IO : TLSPTextTransport; - begin - IO:=Nil; - Request:=Nil; - try - if aContext.Transport is TLSPTextTransport then - IO:=aContext.Transport as TLSPTextTransport - else - IO:=TLSPTextTransport.Create(@aOutput,@aError); - while not EOF(aInput) do - begin - Request:=ReadRequest(aInput,aContext); + if FContent = '' then + begin + // Empty content means disconnect + FContext.Log('Lost connection, stop.'); + FRunLoop.StopExecution; + end + else + begin + try // log request payload if VerboseDebugging then - begin - Writeln(aError, Request.FormatJSON); - Flush(aError); - end; - Response := aContext.Execute(Request); + FContext.Log(FContent); + Request:=GetJSON(FContent, True); + + Response := FContext.Execute(Request); if Assigned(Response) then begin // log response payload if VerboseDebugging then - begin - writeln(aError, Response.asJSON); - Flush(aError); - end; - SendResponse(IO, aContext, Response,True); + FContext.Log(Response.AsJSON); + + SendResponse(FIO, FContext, Response, True) end else - aContext.Log('No response to request'); - FreeAndNil(Request); + FContext.Log('No response to request'); + finally + Request.Free; + end; + end; +end; + +function TTcpipConnectionThread.AwaitMessage(aInStream: THandleStream; aVerboseOutput: Boolean): TBytes; + +var + ContentSize: Integer; + + procedure ParseLine(Line: AnsiString); + var + I: Integer; + Value, Name: String; + begin + FContext.Log('Read header: %s',[Line]); + + I := Pos(':', Line); + Name := Copy(Line, 1, I - 1); + Delete(Line, 1, i); + Value := Trim(Line); + if Name = 'Content-Length' then + ContentSize := StrToIntDef(Value,0); + end; + +var + Buf: array[1..1023] of Byte; + s: AnsiString; + BytesRead: Integer; + Line: AnsiString; + PosCrLf: SizeInt; +begin + Line := ''; + ContentSize:=0; + s := ''; + FContext.Log('Reading request'); + repeat + PosCrLf := Pos(CRLF, s); + if PosCrLf > 0 then + begin + Line := Copy(s, 1, PosCrLf-1); + s := Copy(s, PosCrLf+2, MaxInt); + ParseLine(Line); + end + else + begin + // TInetSocket raises an exception when it is closed and then tried + // to read from. We don't want the exception but return without any response. + if (aInStream is TInetSocket) then + if TInetSocket(aInStream).Closed then + Exit([]); + + BytesRead := aInStream.Read(Buf, SizeOf(Buf)); + if BytesRead=0 then + begin + FContext.Log('Lost connection'); + Exit([]); end; + s := s + TEncoding.ASCII.GetAnsiString(@Buf[1], 0, BytesRead); + end; + until (Line='') and (ContentSize>0); + Result := TEncoding.ASCII.GetAnsiBytes(s); + BytesRead:=Length(Result); + if BytesRead < ContentSize then + begin + SetLength(Result, ContentSize); + aInStream.ReadBuffer(Result, BytesRead, ContentSize-BytesRead); + end; +end; + +procedure TTcpipConnectionThread.Execute; +var + IncomingBytes: TBytes; +begin + repeat + IncomingBytes := AwaitMessage(FInStream, True); + FContent := TEncoding.UTF8.GetString(IncomingBytes); + // Handle the message (or absence of a message) in the main thread + Synchronize(@ProcessMessage); + + // If IncomingBytes is empty, AwaitMessage discovered a disconnect + until Length(IncomingBytes) = 0; +end; + +constructor TTcpipConnectionThread.Create(aInStream: THandleStream; aContext: TLSPContext; aIO: TLSPTextTransport; aRunLoop: TRunLoop); +begin + FInStream := aInStream; + FContext:=aContext; + FIO:=aIO; + FRunLoop:=aRunLoop; + inherited Create(False); +end; + +destructor TTcpipConnectionThread.Destroy; +begin + FInStream.Free; + inherited Destroy; +end; + +Procedure RunMessageLoop(aDoCreateContext: TCreateLSPContextEvent; aTcpip: Boolean; aListenIpAddress: string; aListenPort: Integer); + +var + RunLoop: TRunLoop; + +begin + RunLoop := TRunLoop.Create(aDoCreateContext, aListenIpAddress, aListenPort); + try + RunLoop.Execute(aTcpip); finally - if IO<>aContext.Transport then - IO.Free; - Request.Free; + RunLoop.Free; end; end; { TTextLSPContext } -constructor TLSPTextTransport.Create(aOutput, aError: PText); +constructor TLSPTextTransport.Create(aOutput, aLog: THandleStream); begin FOutput:=aOutput; - FError:=aError; + FLog:=aLog; end; procedure TLSPTextTransport.EmitMessage(aMessage: TJSONStringType); +var + Message: string; begin Try - WriteLn(Foutput^,'Content-Type: ', ContentType); - WriteLn(Foutput^,'Content-Length: ', Length(aMessage)); - WriteLn(Foutput^); - Write(Foutput^,aMessage); - Flush(Foutput^); + Message:='Content-Type: '+ ContentType+CRLF; + Message:=Message+'Content-Length: '+IntToStr(Length(aMessage))+CRLF+CRLF; + FOutput.WriteBuffer(Message[1], Length(Message)); + FOutput.WriteBuffer(aMessage[1], Length(aMessage)); except on e : exception do DoLog('Exception %s during output: %s',[E.ClassName,E.Message]); @@ -228,15 +361,116 @@ procedure TLSPTextTransport.DoSendMessage(aMessage: TJSONData); procedure TLSPTextTransport.DoSendDiagnostic(const aMessage: UTF8String); begin Try - WriteLn(FError^,aMessage); - Flush(FError^); + FLog.WriteBuffer(aMessage[1], Length(aMessage)); + FLog.WriteBuffer(string(LineEnding)[1], Length(LineEnding)); except on e : exception do DoLog('Exception %s during diagnostic output: %s',[E.ClassName,E.Message]); end; end; +{ TRunLoop } + +procedure TRunLoop.HandleNewConnection(aSender: TObject; aData: TSocketStream); +var + ConnThread: TTcpipConnectionThread; +begin + FHasConnection:=True; + // StdOut is not used for (piped) communication, so log to stdout + FLogStream := THandleStream.Create(StdOutputHandle); + InitializeLSPTextTransport(aData, FLogStream); + + FContext.Log('New incoming connection'); + + ConnThread := TTcpipConnectionThread.create(aData, FContext, FIO, Self); + ConnThread.FreeOnTerminate:=True; +end; + +procedure TRunLoop.StopExecution(); +begin + FMustStop:=True; +end; +procedure TRunLoop.ListenForIncomingConnections(); +var + ServerSocket: TInetServer; +begin + try + ServerSocket := TInetServer.Create(FListenIp, FListenPort, TSocketHandler.Create); + try + ServerSocket.OnConnect:=@HandleNewConnection; + // One connection, when the connection the language server stops. + // (In theory more scenario's are possible, but keep it simple for now) + ServerSocket.MaxConnections:=1; + ServerSocket.ReuseAddress:=True; + ServerSocket.StartAccepting; + finally + ServerSocket.Free; + end; + except + on E: Exception do + WriteLn('Network problem. ', E.Message); + end; + // When there is no connection, stop the application. When there is a connection, + // stop listening but keep the connection-thread (and application) running. + if not FHasConnection then + TThread.Synchronize(TThread.CurrentThread, @StopExecution); +end; + +procedure TRunLoop.InitializeLSPTextTransport(aOutStream, aLogStream: THandleStream); +begin + FContext := FDoCreateContext(aOutStream, aLogStream); + if FContext.Transport is TLSPTextTransport then + FIO:=FContext.Transport as TLSPTextTransport + else + FIO:=TLSPTextTransport.Create(aOutStream, aLogStream); +end; + +constructor TRunLoop.Create(aDoCreateContext: TCreateLSPContextEvent; aListenIpAddress: string; aListenPort: Integer); +begin + FDoCreateContext:=aDoCreateContext; + FListenIp:=aListenIpAddress; + FListenPort:=aListenPort; +end; + +procedure TRunLoop.Execute(aTcpip: Boolean); +var + InStream, OutStream: THandleStream; + ConnThread: TTcpipConnectionThread; +begin + InStream:=nil; + OutStream:=nil; + try + if aTcpip then + // The biggest difference with a tcpip-server (listening) socket is that multiple + // connections can come in. So we have to wait for a connection before + // the real connection can be made using a TTcpipConnectionThread thread. + // So ListenForIncomingConnections is called in the background that will + // create a TTcpipConnectionThread when a (new) connection is made. + TThread.ExecuteInThread(@ListenForIncomingConnections) + else + begin + InStream := THandleStream.Create(StdInputHandle); + OutStream := THandleStream.Create(StdOutputHandle); + FLogStream := THandleStream.Create(StdErrorHandle); + + InitializeLSPTextTransport(OutStream, FLogStream); + + ConnThread := TTcpipConnectionThread.Create(InStream, FContext, FIO, Self); + ConnThread.FreeOnTerminate:=True; + end; + + repeat + CheckSynchronize(-1); + until FMustStop; + finally + InStream.Free; + OutStream.Free; + FLogStream.Free; + if Assigned(FContext) and (FIO<>FContext.Transport) then + fIO.Free; + end; +end; end. diff --git a/src/standard/pasls.lpr b/src/standard/pasls.lpr index ee373a1..fa5681e 100644 --- a/src/standard/pasls.lpr +++ b/src/standard/pasls.lpr @@ -27,7 +27,8 @@ Windows, {$ENDIF} { RTL } - SysUtils, Classes, FPJson, JSONParser, JSONScanner, TypInfo, + {$ifdef unix}cthreads,{$endif} + SysUtils, Classes, FPJson, JSONParser, JSONScanner, TyoInfo, { Protocol } PasLS.AllCommands, PasLS.Settings, PasLS.Commands, LSP.Base, LSP.Basic, LSP.Capabilities, LSP.Options, @@ -294,6 +295,21 @@ procedure TLSPLogContext.DoTransportLog(sender: TObject; const Msg: UTF8String); Log('Transport log: '+Msg); end; +function DoInitializeContext(OutStream, LogStream: THandleStream): TLSPContext; +begin + aTransport:=TLSPTextTransport.Create(OutStream, LogStream); + aDisp:=TLSPLocalDispatcher.Create(aTransport,True); + aContext:=TLSPLogContext.Create(aTransport,aDisp,True); + aTransport.OnLog := @aContext.DoTransportLog; + if not ExecuteCommandLineMessages(aContext) then + exit(nil); + Result := aContext; +end; + +var + Tcpip: Boolean; + ListenIp: String; + Port: Integer; begin // Show help for the server @@ -325,16 +341,18 @@ procedure TLSPLogContext.DoTransportLog(sender: TObject; const Msg: UTF8String); if aCfg.LogFile<>'' then TLSPContext.LogFile := aCfg.LogFile; ConfigEnvironment(aCfg); - SetupTextLoop(Input,Output,StdErr); - aTransport:=TLSPTextTransport.Create(@Output,@StdErr); - aDisp:=TLSPLocalDispatcher.Create(aTransport,True); - aContext:=TLSPLogContext.Create(aTransport,aDisp,True); - aTransport.OnLog := @aContext.DoTransportLog; - if not ExecuteCommandLineMessages(aContext) then - exit; - RunMessageLoop(Input,Output,StdErr,aContext); + + SetupTextLoop(); + + // ToDo: make these configurable + Tcpip := False; + ListenIp := '0.0.0.0'; + Port := 4002; + + RunMessageLoop(@DoInitializeContext, Tcpip, ListenIp, Port); Finally aContext.Free; + aTransport.Free; aCfg.Free; end; end. From fe9ca702227f0472d13e27b6a9dac5b545672d90 Mon Sep 17 00:00:00 2001 From: Joost van der Sluis Date: Sat, 21 Mar 2026 12:38:48 +0100 Subject: [PATCH 2/5] Let the LSP detect whether it is called from witin vscode (using stdin) or not. Adapted the vscode plugin so that it can work usint tcp/ip as well --- clients/pasls-vscode/package.json | 25 ++++- clients/pasls-vscode/src/extension.ts | 89 ++++++++++++++--- src/protocol/PasLS.TextLoop.pas | 135 ++++++++++++++++++++++---- src/standard/pasls.lpr | 9 +- 4 files changed, 220 insertions(+), 38 deletions(-) diff --git a/clients/pasls-vscode/package.json b/clients/pasls-vscode/package.json index f5a87d2..36a92da 100644 --- a/clients/pasls-vscode/package.json +++ b/clients/pasls-vscode/package.json @@ -77,10 +77,32 @@ "default": "off", "description": "Traces the communication between VS Code and the language server." }, + "pascalLanguageServer.transport": { + "type": "string", + "scope": "application", + "default": "stdio", + "enum": [ + "stdio", + "tcp" + ], + "description": "Communication transport used between VS Code and the language server." + }, + "pascalLanguageServer.tcp.host": { + "type": "string", + "scope": "application", + "default": "127.0.0.1", + "description": "Host to connect to when `pascalLanguageServer.transport` is `tcp`." + }, + "pascalLanguageServer.tcp.port": { + "type": "number", + "scope": "application", + "default": 4002, + "description": "Port to connect to when `pascalLanguageServer.transport` is `tcp`." + }, "pascalLanguageServer.executable": { "type": "string", "default": "/usr/local/bin/pasls", - "description": "Path to the language server executable." + "description": "Path to the language server executable that is started when `pascalLanguageServer.transport` is `stdio`." }, "pascalLanguageServer.initializationOptions.program": { "type": "string", @@ -221,6 +243,7 @@ "build": "vsce package" }, "dependencies": { + "vsce": "^2.15.0", "vscode-languageclient": "^6.1.3" }, "devDependencies": { diff --git a/clients/pasls-vscode/src/extension.ts b/clients/pasls-vscode/src/extension.ts index 72821e6..b7d2338 100644 --- a/clients/pasls-vscode/src/extension.ts +++ b/clients/pasls-vscode/src/extension.ts @@ -31,7 +31,9 @@ import { ServerOptions, NotificationType } from 'vscode-languageclient'; +import { StreamMessageReader, StreamMessageWriter } from 'vscode-languageserver-protocol'; import * as fs from 'fs'; +import * as net from 'net'; import { InputRegion , DecorationRangesPair, @@ -59,6 +61,7 @@ const InactiveRegionNotification: NotificationType = new N let client: LanguageClient; let completecmd: Command; let inactiveRegionsDecorations = new Map(); +let tcpSocket: net.Socket | undefined; function invokeFormat(document: TextDocument, range: Range) { let activeEditor = window.activeTextEditor; @@ -236,17 +239,70 @@ export function activate(context: ExtensionContext) { }); - let run: Executable = { - command: executable, - options: { - env: userEnvironmentVariables - } - }; - let debug: Executable = run; - let serverOptions: ServerOptions = { - run: run, - debug: debug - }; + let transport: string = workspace.getConfiguration('pascalLanguageServer').get('transport') || 'stdio'; + transport = transport.toLowerCase(); + let tcpHost: string = workspace.getConfiguration('pascalLanguageServer').get('tcp.host') || '127.0.0.1'; + let tcpPort: number = workspace.getConfiguration('pascalLanguageServer').get('tcp.port') || 4002; + + let serverOptions: ServerOptions; + + if (transport === 'tcp') { + serverOptions = () => { + return new Promise((resolve, reject) => { + let settled = false; + + const startTime = Date.now(); + const maxWaitMs = 10_000; + const retryDelayMs = 200; + + const attemptConnect = () => { + if (settled) return; + + let socket = net.connect({ host: tcpHost, port: tcpPort }); + tcpSocket = socket; + socket.setNoDelay(true); + + socket.once('connect', () => { + if (settled) return; + settled = true; + + resolve({ + detached: false, + reader: new StreamMessageReader(socket), + writer: new StreamMessageWriter(socket) + } as any); + }); + + socket.once('error', (err: Error) => { + socket.destroy(); + tcpSocket = undefined; + + if (settled) return; + if (Date.now() - startTime >= maxWaitMs) { + settled = true; + reject(err); + return; + } + setTimeout(attemptConnect, retryDelayMs); + }); + }; + + attemptConnect(); + }); + }; + } else { + let run: Executable = { + command: executable, + options: { + env: userEnvironmentVariables + } + }; + let debug: Executable = run; + serverOptions = { + run: run, + debug: debug + }; + } let initializationOptions = workspace.getConfiguration('pascalLanguageServer.initializationOptions'); @@ -313,7 +369,16 @@ export function activate(context: ExtensionContext) { export function deactivate(): Thenable | undefined { if (!client) { + if (tcpSocket) { + tcpSocket.destroy(); + tcpSocket = undefined; + } return undefined; } - return client.stop(); + return client.stop().then(() => { + if (tcpSocket) { + tcpSocket.destroy(); + tcpSocket = undefined; + } + }); } diff --git a/src/protocol/PasLS.TextLoop.pas b/src/protocol/PasLS.TextLoop.pas index 14252cc..1213c69 100644 --- a/src/protocol/PasLS.TextLoop.pas +++ b/src/protocol/PasLS.TextLoop.pas @@ -24,6 +24,15 @@ interface uses + {$IFDEF UNIX} + BaseUnix, + termio, + {$ENDIF} + {$IFDEF Windows} + Windows, + WinSock2, + ssockets, + {$ENDIF} Classes, SysUtils, ssockets, LSP.Base, LSP.Messages, fpjson; Type @@ -47,7 +56,7 @@ TLSPTextTransport = class(TMessageTransport) end; Procedure SetupTextLoop(); -Procedure RunMessageLoop(aDoCreateContext: TCreateLSPContextEvent; aTcpip: Boolean; aListenIpAddress: string; aListenPort: Integer); +Procedure RunMessageLoop(aDoCreateContext: TCreateLSPContextEvent; aForceTcpip, aForceStdin: Boolean; aListenIpAddress: string; aListenPort: Integer); procedure DebugSendMessage(var aFile : Text; aContext : TLSPContext; const aMethod, aParams: String); implementation @@ -90,13 +99,17 @@ TRunLoop = class FIO: TLSPTextTransport; FLogStream: THandleStream; + // Wait a brief period of time to check whether valid lsp-commands are received + // on the stream. InitialBuffer returns the content of the + // stream that has already been consumed by the detection-mechanism. + function AutoSenseDABProtocol(const Stream: TStream; out InitialBuffer: string): Boolean; procedure HandleNewConnection(aSender: TObject; aData: TSocketStream); procedure StopExecution(); procedure ListenForIncomingConnections(); procedure InitializeLSPTextTransport(aOutStream, aLogStream: THandleStream); public constructor Create(aDoCreateContext: TCreateLSPContextEvent; aListenIpAddress: string; aListenPort: Integer); - procedure Execute(aTcpip: Boolean); + procedure Execute(ForceTcpip, ForceStdin: Boolean); property DoCreateContext: TCreateLSPContextEvent read FDoCreateContext; end; @@ -109,14 +122,17 @@ TTcpipConnectionThread = class(TThread) FContext: TLSPContext; FIO: TLSPTextTransport; FRunLoop: TRunLoop; + FInitialBuffer: string; protected // Processes all incoming LSP messages within the main thread and sends a // LSP-response when applicable procedure ProcessMessage(); // Waits for a new incoming LSP message and returns the message as a array of bytes - function AwaitMessage(aInStream: THandleStream; aVerboseOutput: Boolean): TBytes; + function AwaitMessage(aInStream: THandleStream; aVerboseOutput: Boolean; anInitialBuffer: string = ''): TBytes; public - constructor Create(aInStream: THandleStream; aContext: TLSPContext; aIO: TLSPTextTransport; aRunLoop: TRunLoop); + // The contents in the initial buffer are processed before the content of the + // stream. + constructor Create(aInStream: THandleStream; aContext: TLSPContext; aIO: TLSPTextTransport; aRunLoop: TRunLoop; anInitialBuffer: string); destructor Destroy; override; // Main execution loop that runs in a background thread and waits for incoming // messages (blocking). Once a message is received it is signaled to be @@ -217,7 +233,7 @@ procedure TTcpipConnectionThread.ProcessMessage(); end; end; -function TTcpipConnectionThread.AwaitMessage(aInStream: THandleStream; aVerboseOutput: Boolean): TBytes; +function TTcpipConnectionThread.AwaitMessage(aInStream: THandleStream; aVerboseOutput: Boolean; anInitialBuffer: string): TBytes; var ContentSize: Integer; @@ -246,7 +262,7 @@ function TTcpipConnectionThread.AwaitMessage(aInStream: THandleStream; aVerboseO begin Line := ''; ContentSize:=0; - s := ''; + s := anInitialBuffer; FContext.Log('Reading request'); repeat PosCrLf := Pos(CRLF, s); @@ -286,22 +302,25 @@ procedure TTcpipConnectionThread.Execute; var IncomingBytes: TBytes; begin - repeat - IncomingBytes := AwaitMessage(FInStream, True); - FContent := TEncoding.UTF8.GetString(IncomingBytes); - // Handle the message (or absence of a message) in the main thread - Synchronize(@ProcessMessage); - + IncomingBytes := AwaitMessage(FInStream, True, FInitialBuffer); + FContext.Log('Tadaa'); // If IncomingBytes is empty, AwaitMessage discovered a disconnect - until Length(IncomingBytes) = 0; + while Length(IncomingBytes) > 0 do + begin + FContent := TEncoding.UTF8.GetString(IncomingBytes); + // Handle the message (or absence of a message) in the main thread + Synchronize(@ProcessMessage); + IncomingBytes := AwaitMessage(FInStream, True); + end; end; -constructor TTcpipConnectionThread.Create(aInStream: THandleStream; aContext: TLSPContext; aIO: TLSPTextTransport; aRunLoop: TRunLoop); +constructor TTcpipConnectionThread.Create(aInStream: THandleStream; aContext: TLSPContext; aIO: TLSPTextTransport; aRunLoop: TRunLoop; anInitialBuffer: string); begin FInStream := aInStream; FContext:=aContext; FIO:=aIO; FRunLoop:=aRunLoop; + FInitialBuffer:=anInitialBuffer; inherited Create(False); end; @@ -311,7 +330,7 @@ destructor TTcpipConnectionThread.Destroy; inherited Destroy; end; -Procedure RunMessageLoop(aDoCreateContext: TCreateLSPContextEvent; aTcpip: Boolean; aListenIpAddress: string; aListenPort: Integer); +Procedure RunMessageLoop(aDoCreateContext: TCreateLSPContextEvent; aForceTcpip, aForceStdIn: Boolean; aListenIpAddress: string; aListenPort: Integer); var RunLoop: TRunLoop; @@ -319,7 +338,7 @@ destructor TTcpipConnectionThread.Destroy; begin RunLoop := TRunLoop.Create(aDoCreateContext, aListenIpAddress, aListenPort); try - RunLoop.Execute(aTcpip); + RunLoop.Execute(aForceTcpip, aForceStdIn); finally RunLoop.Free; end; @@ -382,7 +401,7 @@ procedure TRunLoop.HandleNewConnection(aSender: TObject; aData: TSocketStream); FContext.Log('New incoming connection'); - ConnThread := TTcpipConnectionThread.create(aData, FContext, FIO, Self); + ConnThread := TTcpipConnectionThread.create(aData, FContext, FIO, Self, ''); ConnThread.FreeOnTerminate:=True; end; @@ -433,15 +452,86 @@ constructor TRunLoop.Create(aDoCreateContext: TCreateLSPContextEvent; aListenIpA FListenPort:=aListenPort; end; -procedure TRunLoop.Execute(aTcpip: Boolean); +function TRunLoop.AutoSenseDABProtocol(const Stream: TStream; out InitialBuffer: string): Boolean; + + function NumBytesAvailable: DWord; + begin + {$IFDEF Unix} + if fpioctl((Stream as THandleStream).Handle, FIONREAD, @Result)<0 then + Result := 0; + {$ENDIF Unix} + {$IFDEF Windows} + if Stream is TSocketStream then + begin + if ioctlsocket(TSocketStream(Stream).Handle, FIONREAD, @Result)<0 then + Result := 0; + end + else if Stream is THandleStream then + begin + if not PeekNamedPipe(THandleStream(Stream).Handle, nil, 0, nil, @Result, nil) then + Result := 0; + end + else + Result := 0; + {$ENDIF} + end; + +var + Buf: string; + i,l: LongInt; +begin + Result := False; + InitialBuffer := ''; + + // TInputPipeStream could not be used, because it closes the handle when it + // gets destroyed. + + // Wait at the most 20*10 milliseconds for enough input on the console to detect + // the DAB-protocol. + for i := 0 to 20 do + begin + if NumBytesAvailable > 15 then + begin + // There are at least 16 bytes in the buffer. Check if these bytes look + // like a DAB-header. + Buf:=''; + SetLength(Buf,16); + l := Stream.Read(Buf[1], 16); + SetLength(Buf, l); + Result := Buf = 'Content-Length: '; + + // Fill the initial-buffer with the data that we 'peeked' from stdin + // I could not find a reliable, cross-platform way to perform a 'real' + // peek. + InitialBuffer := Buf; + break; + end; + sleep(10); + end; +end; + + +procedure TRunLoop.Execute(ForceTcpip, ForceStdin: Boolean); var InStream, OutStream: THandleStream; ConnThread: TTcpipConnectionThread; + InitialBuffer: string; + UseTcpIp: Boolean; begin InStream:=nil; OutStream:=nil; try - if aTcpip then + if ForceTcpip then + UseTcpIp:=True + else if not ForceStdin then + begin + // Wait for a small period of time to check whether valid commands are + // received on stdin. If this is the case, use stdin, if not, use tcpip. + InStream := THandleStream.Create(StdInputHandle); + UseTcpIp := not AutoSenseDABProtocol(InStream, InitialBuffer); + end; + + if UseTcpIp then // The biggest difference with a tcpip-server (listening) socket is that multiple // connections can come in. So we have to wait for a connection before // the real connection can be made using a TTcpipConnectionThread thread. @@ -450,14 +540,17 @@ procedure TRunLoop.Execute(aTcpip: Boolean); TThread.ExecuteInThread(@ListenForIncomingConnections) else begin - InStream := THandleStream.Create(StdInputHandle); OutStream := THandleStream.Create(StdOutputHandle); FLogStream := THandleStream.Create(StdErrorHandle); InitializeLSPTextTransport(OutStream, FLogStream); - ConnThread := TTcpipConnectionThread.Create(InStream, FContext, FIO, Self); + ConnThread := TTcpipConnectionThread.Create(InStream, FContext, FIO, Self, InitialBuffer); ConnThread.FreeOnTerminate:=True; + // By assigning nil to InStream, it is not freed. + // This is done because stdin cannot be closed, or else rtl will raise an + // exception when the application terminates. + InStream := nil; end; repeat diff --git a/src/standard/pasls.lpr b/src/standard/pasls.lpr index fa5681e..df55c08 100644 --- a/src/standard/pasls.lpr +++ b/src/standard/pasls.lpr @@ -28,7 +28,7 @@ {$ENDIF} { RTL } {$ifdef unix}cthreads,{$endif} - SysUtils, Classes, FPJson, JSONParser, JSONScanner, TyoInfo, + SysUtils, Classes, FPJson, JSONParser, JSONScanner, TypInfo, { Protocol } PasLS.AllCommands, PasLS.Settings, PasLS.Commands, LSP.Base, LSP.Basic, LSP.Capabilities, LSP.Options, @@ -307,7 +307,7 @@ function DoInitializeContext(OutStream, LogStream: THandleStream): TLSPContext; end; var - Tcpip: Boolean; + ForceTcpip, ForceStdIn: Boolean; ListenIp: String; Port: Integer; @@ -345,11 +345,12 @@ function DoInitializeContext(OutStream, LogStream: THandleStream): TLSPContext; SetupTextLoop(); // ToDo: make these configurable - Tcpip := False; + ForceTcpip := false; + ForceStdIn := false; ListenIp := '0.0.0.0'; Port := 4002; - RunMessageLoop(@DoInitializeContext, Tcpip, ListenIp, Port); + RunMessageLoop(@DoInitializeContext, ForceTcpip, ForceStdIn, ListenIp, Port); Finally aContext.Free; aTransport.Free; From 782b7bdb8bde79b733d57a9d4df5b1ab44d6c247 Mon Sep 17 00:00:00 2001 From: Joost van der Sluis Date: Sat, 21 Mar 2026 15:55:57 +0100 Subject: [PATCH 3/5] Documented running the LSP in tcp/ip mode --- README.md | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 4208f1d..2e2c61a 100644 --- a/README.md +++ b/README.md @@ -97,13 +97,27 @@ The `lspprotocol.lpk` package and `pasls.lpi` are both in the `pascallanguageserver.lpg`project group; if you have project group support enabled, then you can use this to compile this package and the executable. +## Run + +When the Pascal Language Server is started as stand-alone executable, it starts +listening for incoming network connections on a configurable port. So that any +client/editor can connect to it. + +When the application is started as a sub-proces by a client/editor, it will +automatically detect this and use standard input to communicate with the +client. + ## Debugging the LSP server -### The problem +To debug the Pascal language Server, just run it in the debugger and let +the editor/client connect to it usint tcp/ip. + +### Another way to debug VS Code and other editors that use the LSP server start the LSP server and send messages in JSON-RPC style to standard input, and read replies through -standard output. This makes the LSP server process hard to debug. +standard output. When the regular way to run the LSP server in tcp/ip mode +is not suitable, this makes the LSP server process hard to debug. ### The solution To solve this, 2 extra projects have been added: From a12071fbee3279bdd8addcc0414e5498c5a9ce6e Mon Sep 17 00:00:00 2001 From: Joost van der Sluis Date: Sat, 21 Mar 2026 21:23:32 +0100 Subject: [PATCH 4/5] Debug code removed --- src/protocol/PasLS.TextLoop.pas | 1 - 1 file changed, 1 deletion(-) diff --git a/src/protocol/PasLS.TextLoop.pas b/src/protocol/PasLS.TextLoop.pas index 1213c69..8d181dc 100644 --- a/src/protocol/PasLS.TextLoop.pas +++ b/src/protocol/PasLS.TextLoop.pas @@ -303,7 +303,6 @@ procedure TTcpipConnectionThread.Execute; IncomingBytes: TBytes; begin IncomingBytes := AwaitMessage(FInStream, True, FInitialBuffer); - FContext.Log('Tadaa'); // If IncomingBytes is empty, AwaitMessage discovered a disconnect while Length(IncomingBytes) > 0 do begin From 6c001cf1365e92bcc45e7938ba0e0ee386da51fe Mon Sep 17 00:00:00 2001 From: Joost van der Sluis Date: Sat, 21 Mar 2026 21:28:28 +0100 Subject: [PATCH 5/5] Configuration of tcp/ip and stdio mode --- src/protocol/PasLS.TextLoop.pas | 9 +++++++++ src/standard/PasLS.LSConfig.pas | 28 +++++++++++++++++++++++++ src/standard/pasls.lpr | 36 ++++++++++++++++++++++++++++----- 3 files changed, 68 insertions(+), 5 deletions(-) diff --git a/src/protocol/PasLS.TextLoop.pas b/src/protocol/PasLS.TextLoop.pas index 8d181dc..8045b8a 100644 --- a/src/protocol/PasLS.TextLoop.pas +++ b/src/protocol/PasLS.TextLoop.pas @@ -519,6 +519,7 @@ procedure TRunLoop.Execute(ForceTcpip, ForceStdin: Boolean); begin InStream:=nil; OutStream:=nil; + UseTcpIp:=false; try if ForceTcpip then UseTcpIp:=True @@ -528,6 +529,11 @@ procedure TRunLoop.Execute(ForceTcpip, ForceStdin: Boolean); // received on stdin. If this is the case, use stdin, if not, use tcpip. InStream := THandleStream.Create(StdInputHandle); UseTcpIp := not AutoSenseDABProtocol(InStream, InitialBuffer); + if UseTcpIp then + begin + WriteLn('There was no client detected using standard input. To force using '); + WriteLn('standard input set the FORCESTDIN=TRUE environment variable.'); + end; end; if UseTcpIp then @@ -536,7 +542,10 @@ procedure TRunLoop.Execute(ForceTcpip, ForceStdin: Boolean); // the real connection can be made using a TTcpipConnectionThread thread. // So ListenForIncomingConnections is called in the background that will // create a TTcpipConnectionThread when a (new) connection is made. + begin + WriteLn('Start listening for incoming JSON/RPC connections on '+FListenIp+':'+IntToStr(FListenPort)+'.'); TThread.ExecuteInThread(@ListenForIncomingConnections) + end else begin OutStream := THandleStream.Create(StdOutputHandle); diff --git a/src/standard/PasLS.LSConfig.pas b/src/standard/PasLS.LSConfig.pas index e02d1b7..3b997c6 100644 --- a/src/standard/PasLS.LSConfig.pas +++ b/src/standard/PasLS.LSConfig.pas @@ -33,6 +33,10 @@ interface DefaultFPCDir = ''; DefaultTargetOS = {$i %FPCTARGETOS%}; DefaultTargetCPU = {$i %FPCTARGETCPU%}; + DefaultListenPort = 4002; + DefaultListenIP = '0.0.0.0'; + DefaultForceStdin = false; + DefaultForceTcpip = false; Type { TLSPServerConfig } @@ -40,8 +44,12 @@ interface TLSPServerConfig = Class(TObject) private FCompiler: string; + FForceStdin: Boolean; + FForceTcpip: Boolean; FFPCDir: string; FLazarusDir: string; + FListenIp: string; + FListenPort: word; FLogFile: String; FTargetCPU: string; FTargetOS: string; @@ -60,6 +68,10 @@ interface property LazarusDir : string read FLazarusDir write FLazarusDir; property TargetOS : string read FTargetOS write FTargetOS; property TargetCPU : string read FTargetCPU write FTargetCPU; + property ListenIp : string read FListenIp write FListenIp; + property ListenPort : word read FListenPort write FListenPort; + property ForceStdin : Boolean read FForceStdin write FForceStdin; + property ForceTcpip : Boolean read FForceTcpip write FForceTcpip; end; @@ -75,6 +87,10 @@ implementation KeyLazarusDir = 'LazarusDir'; KeyTargetCPU = 'TargetCPU'; KeyTargetOS = 'TargetOS'; + KeyListenIp = 'ListenIp'; + KeyListenPort = 'ListenPort'; + KeyForceStdin = 'ForceStdin'; + KeyForceTcpip = 'ForceTcpip'; { TLSPServerConfig } @@ -91,6 +107,10 @@ procedure TLSPServerConfig.Reset; LazarusDir:=DefaultLazarusDir; TargetCPU:=DefaultTargetCPU; TargetOS:=DefaultTargetOS; + ListenPort:=DefaultListenPort; + ListenIP:=DefaultListenIP; + ForceStdin:=DefaultForceStdin; + ForceTcpip:=DefaultForceTcpip; end; class function TLSPServerConfig.DefaultConfigFile: String; @@ -135,6 +155,10 @@ procedure TLSPServerConfig.LoadFromIni(aIni: TCustomIniFile); With aIni do begin FLogFile:=ReadString(SServer,KeyLogFile,LogFile); + ListenIp:=ReadString(SServer,KeyListenIp,ListenIp); + ListenPort:=ReadInteger(SServer,KeyListenPort,ListenPort); + ForceTcpip:=ReadBool(SServer,KeyForceTcpip,ForceTcpip); + ForceStdin:=ReadBool(SServer,KeyForceStdin,ForceStdin); Compiler:=ReadString(SCodeTools,KeyCompiler,Compiler); FPCDir:=ReadString(SCodetools,KeyFPCDir,FPCDir); LazarusDir:=ReadString(SCodetools,KeyLazarusDir,LazarusDir); @@ -148,6 +172,10 @@ procedure TLSPServerConfig.SaveToIni(aIni: TCustomIniFile); With aIni do begin WriteString(SServer,KeyLogFile,LogFile); + WriteString(SServer,KeyListenIp,ListenIp); + WriteInteger(SServer,KeyListenPort,ListenPort); + WriteBool(SServer,KeyForceStdin,ForceStdin); + WriteBool(SServer,KeyForceTcpip,ForceTcpip); WriteString(SCodeTools,KeyCompiler,Compiler); WriteString(SCodetools,KeyFPCDir,FPCDir); WriteString(SCodetools,KeyLazarusDir,LazarusDir); diff --git a/src/standard/pasls.lpr b/src/standard/pasls.lpr index df55c08..a76d7c8 100644 --- a/src/standard/pasls.lpr +++ b/src/standard/pasls.lpr @@ -29,6 +29,8 @@ { RTL } {$ifdef unix}cthreads,{$endif} SysUtils, Classes, FPJson, JSONParser, JSONScanner, TypInfo, + { Lazarus } + LazUTF8, { Protocol } PasLS.AllCommands, PasLS.Settings, PasLS.Commands, LSP.Base, LSP.Basic, LSP.Capabilities, LSP.Options, @@ -306,6 +308,23 @@ function DoInitializeContext(OutStream, LogStream: THandleStream): TLSPContext; Result := aContext; end; +procedure ApplyEnvironmentVariables; +const + sListenIpEnv = 'LISTENIP'; + sListenPortEnv = 'LISTENPORT'; + sForceStdin = 'FORCESTDIN'; + sForceTcpip = 'FORCETCPIP'; +begin + if GetEnvironmentVariableUTF8(sListenIpEnv)<>'' then + aCfg.ListenIp:=GetEnvironmentVariableUTF8(sListenIpEnv); + if GetEnvironmentVariableUTF8(sListenPortEnv)<>'' then + aCfg.ListenPort:=StrToInt(GetEnvironmentVariableUTF8(sListenPortEnv)); + if GetEnvironmentVariableUTF8(sForceStdin)<>'' then + aCfg.ForceStdin:=StrToBoolDef(GetEnvironmentVariableUTF8(sForceStdin), False); + if GetEnvironmentVariableUTF8(sForceTcpip)<>'' then + aCfg.ForceTcpip:=StrToBoolDef(GetEnvironmentVariableUTF8(sForceTcpip), False); +end; + var ForceTcpip, ForceStdIn: Boolean; ListenIp: String; @@ -342,13 +361,20 @@ function DoInitializeContext(OutStream, LogStream: THandleStream): TLSPContext; TLSPContext.LogFile := aCfg.LogFile; ConfigEnvironment(aCfg); + ApplyEnvironmentVariables(); + SetupTextLoop(); - // ToDo: make these configurable - ForceTcpip := false; - ForceStdIn := false; - ListenIp := '0.0.0.0'; - Port := 4002; + if aCfg.ForceTcpip and aCfg.ForceStdin then + begin + WriteLn('It is not possible to use tcp/ip and stdin simultaneously. Stdin is used.'); + aCfg.ForceTcpip:=False; + end; + + ForceTcpip := aCfg.ForceTcpip; + ForceStdIn := aCfg.ForceStdin; + ListenIp := aCfg.ListenIp; + Port := aCfg.ListenPort; RunMessageLoop(@DoInitializeContext, ForceTcpip, ForceStdIn, ListenIp, Port); Finally