Skip to content

Commit 9c73caf

Browse files
reznikmmreznikmm
committed
Add Secure_Message_Loggers package
to skip dumps of long messages or edited code.
1 parent cb07aee commit 9c73caf

7 files changed

+650
-4
lines changed

‎source/ada/lsp-ada_driver.adb

Lines changed: 20 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -56,10 +56,12 @@ with LSP.Ada_Handlers.Refactor.Replace_Type;
5656
with LSP.Ada_Handlers.Refactor.Sort_Dependencies;
5757
with LSP.Ada_Handlers.Refactor.Suppress_Seperate;
5858
with LSP.Ada_Handlers.Suspend_Executions;
59+
with LSP.GNATCOLL_Trace_Streams;
5960
with LSP.GNATCOLL_Tracers;
6061
with LSP.GPR_Handlers;
6162
with LSP.Memory_Statistics;
6263
with LSP.Predefined_Completion;
64+
with LSP.Secure_Message_Loggers;
6365
with LSP.Servers;
6466
with LSP.Stdio_Streams;
6567

@@ -127,6 +129,17 @@ procedure LSP.Ada_Driver is
127129
-- Traces that logs all input & output. For debugging purposes.
128130
Tracer : aliased LSP.GNATCOLL_Tracers.Tracer;
129131

132+
In_Stream : aliased LSP.GNATCOLL_Trace_Streams.Output_Text_Stream;
133+
-- Output stream for logging input messages into the trace
134+
In_Logger : aliased LSP.Secure_Message_Loggers.Server_Logger
135+
(In_Stream'Unchecked_Access);
136+
-- Logger for logging input messages
137+
Out_Stream : aliased LSP.GNATCOLL_Trace_Streams.Output_Text_Stream;
138+
-- Output stream for logging output messages into the trace
139+
Out_Logger : aliased LSP.Secure_Message_Loggers.Client_Logger
140+
(Out_Stream'Unchecked_Access);
141+
-- Logger for logging output messages
142+
130143
Server : aliased LSP.Servers.Server;
131144
Stream : aliased LSP.Stdio_Streams.Stdio_Stream;
132145
Ada_Handler : aliased LSP.Ada_Handlers.Message_Handler
@@ -268,6 +281,9 @@ begin
268281
end;
269282
end if;
270283

284+
In_Stream.Initialize (Server_Trace);
285+
Out_Stream.Initialize (Server_Trace);
286+
271287
Tracer.Initialize (Server_Trace, In_Trace, Out_Trace);
272288
Tracer.Trace ("ALS version: " & $VERSION & " (" & $BUILD_DATE & ")");
273289

@@ -314,17 +330,17 @@ begin
314330
Server.Run
315331
(GPR_Handler'Unchecked_Access,
316332
Tracer'Unchecked_Access,
317-
In_Logger => null,
318-
Out_Logger => null);
333+
In_Logger => In_Logger'Unchecked_Access,
334+
Out_Logger => Out_Logger'Unchecked_Access);
319335

320336
else
321337
Register_Commands;
322338

323339
Server.Run
324340
(Ada_Handler'Unchecked_Access,
325341
Tracer'Unchecked_Access,
326-
In_Logger => null,
327-
Out_Logger => null);
342+
In_Logger => In_Logger'Unchecked_Access,
343+
Out_Logger => Out_Logger'Unchecked_Access);
328344
end if;
329345
exception
330346
when E : others =>

‎source/lsp_3.17/lsp-client_message_loggers.adb

Lines changed: 42 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,42 @@
1+
--
2+
-- Copyright (C) 2022-2023, AdaCore
3+
--
4+
-- SPDX-License-Identifier: Apache-2.0
5+
--
6+
7+
package body LSP.Client_Message_Loggers is
8+
9+
----------------------------
10+
-- On_Client_Notification --
11+
----------------------------
12+
13+
overriding procedure On_Client_Notification
14+
(Self : in out Client_Logger;
15+
Value : LSP.Client_Notifications.Client_Notification'Class) is
16+
begin
17+
Value.Visit_Client_Receiver (Self.Notification);
18+
end On_Client_Notification;
19+
20+
-----------------------
21+
-- On_Client_Request --
22+
-----------------------
23+
24+
overriding procedure On_Client_Request
25+
(Self : in out Client_Logger;
26+
Value : LSP.Client_Requests.Client_Request'Class) is
27+
begin
28+
Value.Visit_Client_Receiver (Self.Request);
29+
end On_Client_Request;
30+
31+
------------------------
32+
-- On_Client_Response --
33+
------------------------
34+
35+
overriding procedure On_Client_Response
36+
(Self : in out Client_Logger;
37+
Value : LSP.Client_Responses.Client_Response'Class) is
38+
begin
39+
Value.Visit_Client_Receiver (Self.Response);
40+
end On_Client_Response;
41+
42+
end LSP.Client_Message_Loggers;

‎source/lsp_3.17/lsp-client_message_loggers.ads

Lines changed: 44 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,44 @@
1+
--
2+
-- Copyright (C) 2022-2023, AdaCore
3+
--
4+
-- SPDX-License-Identifier: Apache-2.0
5+
--
6+
7+
-- Simple server-to-client message logger that uses 'Image to dump messages.
8+
9+
with VSS.Text_Streams;
10+
11+
with LSP.Client_Message_Visitors;
12+
with LSP.Client_Notification_Loggers;
13+
with LSP.Client_Notifications;
14+
with LSP.Client_Request_Loggers;
15+
with LSP.Client_Requests;
16+
with LSP.Client_Response_Loggers;
17+
with LSP.Client_Responses;
18+
19+
package LSP.Client_Message_Loggers is
20+
pragma Preelaborate;
21+
22+
type Client_Logger
23+
(Output : not null access VSS.Text_Streams.Output_Text_Stream'Class)
24+
is new LSP.Client_Message_Visitors.Client_Message_Visitor with record
25+
Request : LSP.Client_Request_Loggers.Client_Request_Logger (Output);
26+
Response : LSP.Client_Response_Loggers.Client_Response_Logger (Output);
27+
28+
Notification :
29+
LSP.Client_Notification_Loggers.Client_Notification_Logger (Output);
30+
end record;
31+
32+
overriding procedure On_Client_Notification
33+
(Self : in out Client_Logger;
34+
Value : LSP.Client_Notifications.Client_Notification'Class);
35+
36+
overriding procedure On_Client_Request
37+
(Self : in out Client_Logger;
38+
Value : LSP.Client_Requests.Client_Request'Class);
39+
40+
overriding procedure On_Client_Response
41+
(Self : in out Client_Logger;
42+
Value : LSP.Client_Responses.Client_Response'Class);
43+
44+
end LSP.Client_Message_Loggers;

‎source/lsp_3.17/lsp-server_message_loggers.adb

Lines changed: 42 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,42 @@
1+
--
2+
-- Copyright (C) 2022-2023, AdaCore
3+
--
4+
-- SPDX-License-Identifier: Apache-2.0
5+
--
6+
7+
package body LSP.Server_Message_Loggers is
8+
9+
----------------------------
10+
-- On_Server_Notification --
11+
----------------------------
12+
13+
overriding procedure On_Server_Notification
14+
(Self : in out Server_Message_Logger;
15+
Value : LSP.Server_Notifications.Server_Notification'Class) is
16+
begin
17+
Value.Visit_Server_Receiver (Self.Notification);
18+
end On_Server_Notification;
19+
20+
-----------------------
21+
-- On_Server_Request --
22+
-----------------------
23+
24+
overriding procedure On_Server_Request
25+
(Self : in out Server_Message_Logger;
26+
Value : LSP.Server_Requests.Server_Request'Class) is
27+
begin
28+
Value.Visit_Server_Receiver (Self.Request);
29+
end On_Server_Request;
30+
31+
------------------------
32+
-- On_Server_Response --
33+
------------------------
34+
35+
overriding procedure On_Server_Response
36+
(Self : in out Server_Message_Logger;
37+
Value : LSP.Server_Responses.Server_Response'Class) is
38+
begin
39+
Value.Visit_Server_Receiver (Self.Response);
40+
end On_Server_Response;
41+
42+
end LSP.Server_Message_Loggers;

‎source/lsp_3.17/lsp-server_message_loggers.ads

Lines changed: 44 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,44 @@
1+
--
2+
-- Copyright (C) 2022-2023, AdaCore
3+
--
4+
-- SPDX-License-Identifier: Apache-2.0
5+
--
6+
7+
-- Simple client-to-server message logger that uses 'Image to dump messages.
8+
9+
with VSS.Text_Streams;
10+
11+
with LSP.Server_Message_Visitors;
12+
with LSP.Server_Notification_Loggers;
13+
with LSP.Server_Notifications;
14+
with LSP.Server_Request_Loggers;
15+
with LSP.Server_Requests;
16+
with LSP.Server_Response_Loggers;
17+
with LSP.Server_Responses;
18+
19+
package LSP.Server_Message_Loggers is
20+
pragma Preelaborate;
21+
22+
type Server_Message_Logger
23+
(Output : not null access VSS.Text_Streams.Output_Text_Stream'Class)
24+
is new LSP.Server_Message_Visitors.Server_Message_Visitor with record
25+
Request : LSP.Server_Request_Loggers.Server_Request_Logger (Output);
26+
Response : LSP.Server_Response_Loggers.Server_Response_Logger (Output);
27+
28+
Notification :
29+
LSP.Server_Notification_Loggers.Server_Notification_Logger (Output);
30+
end record;
31+
32+
overriding procedure On_Server_Notification
33+
(Self : in out Server_Message_Logger;
34+
Value : LSP.Server_Notifications.Server_Notification'Class);
35+
36+
overriding procedure On_Server_Request
37+
(Self : in out Server_Message_Logger;
38+
Value : LSP.Server_Requests.Server_Request'Class);
39+
40+
overriding procedure On_Server_Response
41+
(Self : in out Server_Message_Logger;
42+
Value : LSP.Server_Responses.Server_Response'Class);
43+
44+
end LSP.Server_Message_Loggers;

0 commit comments

Comments
 (0)