Skip to content

Commit 71f2ded

Browse files
briotbriot
committed
(websockets): let users create new websocket types
This is needed to override On_Message and other callbacks, but previous versions were destroying the object created by the user, and we thus ended up with uninitialized fields. Fixes #138
1 parent 7f7f059 commit 71f2ded

7 files changed

+111
-70
lines changed

‎src/core/aws-net-websocket-registry-utils.adb‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -35,9 +35,9 @@ package body AWS.Net.WebSocket.Registry.Utils is
3535
-- Register --
3636
--------------
3737

38-
function Register (WebSocket : Object'Class) return Object_Class is
38+
procedure Register (WebSocket : in out Object_Class) is
3939
begin
40-
return Net.WebSocket.Registry.Register (WebSocket);
40+
Net.WebSocket.Registry.Register (WebSocket);
4141
end Register;
4242

4343
-----------

‎src/core/aws-net-websocket-registry-utils.ads‎

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -31,10 +31,11 @@
3131

3232
package AWS.Net.WebSocket.Registry.Utils is
3333

34-
function Register (WebSocket : Object'Class) return Object_Class;
35-
-- Register WebSocket, returns a pointer to the registered WebSocket or
36-
-- null if it was not possible to register the WebSocket. This can happen
37-
-- if the server has reached the limit of opened WebSocket for example.
34+
procedure Register (WebSocket : in out Object_Class);
35+
-- Register WebSocket.
36+
-- Free it and set it to null if it was not possible to register the
37+
-- WebSocket. This can happen if the server has reached the limit of opened
38+
-- WebSocket for example.
3839

3940
procedure Watch (WebSocket : in out Object_Class) with
4041
Pre => WebSocket /= null;

‎src/core/aws-net-websocket-registry.adb‎

Lines changed: 10 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -90,6 +90,11 @@ package body AWS.Net.WebSocket.Registry is
9090
(Left.Id = Right.Id);
9191
-- Equality is based on the unique id
9292

93+
function Create_Default_Socket
94+
(Request_Ignored : AWS.Status.Data) return Object_Class
95+
is (new Object);
96+
-- Default factory
97+
9398
package WebSocket_Map is
9499
new Ada.Containers.Ordered_Maps (UID, Object_Class, "=" => Same_WS);
95100

@@ -1187,7 +1192,7 @@ package body AWS.Net.WebSocket.Registry is
11871192
end loop;
11881193
end if;
11891194

1190-
return Create'Access;
1195+
return Create_Default_Socket'Access;
11911196
end Constructor;
11921197

11931198
------------
@@ -1314,17 +1319,15 @@ package body AWS.Net.WebSocket.Registry is
13141319
Factories.Insert (URI, Factory);
13151320
end Register;
13161321

1317-
function Register (WebSocket : Object'Class) return Object_Class is
1318-
WS : Object_Class := new Object'Class'(WebSocket);
1322+
procedure Register (WebSocket : in out Object_Class) is
13191323
Success : Boolean;
13201324
begin
1321-
DB.Register (WS, Success);
1325+
DB.Register (WebSocket, Success);
13221326

13231327
if not Success then
1324-
Unchecked_Free (WS);
1328+
Free (WebSocket.all);
1329+
Unchecked_Free (WebSocket);
13251330
end if;
1326-
1327-
return WS;
13281331
end Register;
13291332

13301333
----------------------

‎src/core/aws-net-websocket-registry.ads‎

Lines changed: 10 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -39,8 +39,13 @@ private with GNAT.Regexp;
3939
package AWS.Net.WebSocket.Registry is
4040

4141
type Factory is not null access function
42-
(Socket : Socket_Access;
43-
Request : AWS.Status.Data) return Object'Class;
42+
(Request : AWS.Status.Data) return Object_Class;
43+
-- Return a newly allocated object.
44+
-- You can use AWS.Status.Parameters (Request) to check what additional
45+
-- parameters were sent by the user.
46+
--
47+
-- This object will later be initialized automatically, via a call to
48+
-- AWS.Net.WebSocket.Setup_Socket.
4449

4550
-- Creating and Registering WebSockets
4651

@@ -207,9 +212,9 @@ private
207212
procedure Shutdown;
208213
-- Stop the WebServer's servers
209214

210-
function Register (WebSocket : Object'Class) return Object_Class;
211-
-- Register a new WebSocket, returns a reference to the registered
212-
-- WebSocket or null if it was impossible to register it.
215+
procedure Register (WebSocket : in out Object_Class);
216+
-- Register a new WebSocket.
217+
-- Sets it to null (and free memory) if it was impossible to register it.
213218

214219
procedure Watch (WebSocket : in out Object_Class)
215220
with Pre => WebSocket /= null;

‎src/core/aws-net-websocket.adb‎

Lines changed: 24 additions & 26 deletions
Original file line numberDiff line numberDiff line change
@@ -134,32 +134,6 @@ package body AWS.Net.WebSocket is
134134
Socket.On_Open ("WebSocket connected with " & URI);
135135
end Connect;
136136

137-
------------
138-
-- Create --
139-
------------
140-
141-
function Create
142-
(Socket : Socket_Access;
143-
Request : AWS.Status.Data) return Object'Class
144-
is
145-
Result : Object;
146-
Protocol : Net.WebSocket.Protocol.State_Class;
147-
Headers : constant AWS.Headers.List :=
148-
AWS.Status.Header (Request);
149-
begin
150-
if Headers.Exist (Messages.Sec_WebSocket_Key1_Token)
151-
and then Headers.Exist (Messages.Sec_WebSocket_Key2_Token)
152-
then
153-
Protocol := new Net.WebSocket.Protocol.Draft76.State;
154-
else
155-
Protocol := new Net.WebSocket.Protocol.RFC6455.State;
156-
end if;
157-
158-
Initialize (Result, Socket, Protocol, Headers);
159-
Result.Request := Request;
160-
return Result;
161-
end Create;
162-
163137
--------------------
164138
-- End_Of_Message --
165139
--------------------
@@ -627,6 +601,30 @@ package body AWS.Net.WebSocket is
627601
Socket.P_State.State.Send (Socket, Message);
628602
end Send;
629603

604+
------------------
605+
-- Setup_Socket --
606+
------------------
607+
608+
procedure Setup_Socket
609+
(WS : not null Object_Class;
610+
Socket : not null Socket_Access;
611+
Request : AWS.Status.Data)
612+
is
613+
Protocol : Net.WebSocket.Protocol.State_Class;
614+
Headers : constant AWS.Headers.List := AWS.Status.Header (Request);
615+
begin
616+
if Headers.Exist (Messages.Sec_WebSocket_Key1_Token)
617+
and then Headers.Exist (Messages.Sec_WebSocket_Key2_Token)
618+
then
619+
Protocol := new Net.WebSocket.Protocol.Draft76.State;
620+
else
621+
Protocol := new Net.WebSocket.Protocol.RFC6455.State;
622+
end if;
623+
624+
Initialize (WS.all, Socket, Protocol, Headers);
625+
WS.Request := Request;
626+
end Setup_Socket;
627+
630628
--------------
631629
-- Shutdown --
632630
--------------

‎src/core/aws-net-websocket.ads‎

Lines changed: 19 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -47,8 +47,8 @@ package AWS.Net.WebSocket is
4747
type Object_Class is access all Object'Class;
4848
-- To implement your own handling of messages, you need to extend this
4949
-- type and override at least the On_Message primitive operation.
50-
-- In addition, you need to register a factory (to create new objects based
51-
-- on the URI) using AWS.Net.WebSocket.Registry.Register).
50+
-- In addition, you need to register a factory (to create new objects
51+
-- based on the URI) using AWS.Net.WebSocket.Registry.Register).
5252

5353
No_Object : constant Object'Class;
5454

@@ -81,16 +81,6 @@ package AWS.Net.WebSocket is
8181
-- the default Send implementation should be ok for most usages.
8282
--
8383

84-
function Create
85-
(Socket : Socket_Access;
86-
Request : AWS.Status.Data) return Object'Class
87-
with Pre => Socket /= null;
88-
-- Create a new instance of the WebSocket, this is used by AWS internal
89-
-- server to create a default WebSocket if no other constructor are
90-
-- provided. It is also needed when deriving from WebSocket.
91-
--
92-
-- This function must be registered via AWS.Net.WebSocket.Registry.Register
93-
9484
procedure On_Message (Socket : in out Object; Message : String) is null;
9585
-- Default implementation does nothing, it needs to be overridden by the
9686
-- end-user. This is the callback that will get activated for every server
@@ -261,8 +251,23 @@ package AWS.Net.WebSocket is
261251
-- Returns a unique id for the given socket. The uniqueness for this socket
262252
-- is guaranteed during the lifetime of the application.
263253

254+
264255
overriding function Is_Secure (Socket : Object) return Boolean;
265256

257+
-----------------------
258+
-- Internal services --
259+
-----------------------
260+
-- These subprograms are used internally by AWS, and do not need to be
261+
-- called explicitly in user code.
262+
263+
procedure Setup_Socket
264+
(WS : not null Object_Class;
265+
Socket : not null Socket_Access;
266+
Request : AWS.Status.Data);
267+
-- Setup WS.
268+
-- It will be called automatically for any websocket returned by a factory,
269+
-- so in general you do not need to call it explicitly.
270+
266271
private
267272

268273
type Internal_State is record
@@ -355,6 +360,8 @@ private
355360
(Socket : Object; Size : Natural) is null;
356361

357362
overriding procedure Free (Socket : in out Object);
363+
-- This is called automatically when the socket is no longer needed, do not
364+
-- call directly from user code.
358365

359366
No_UID : constant UID := 0;
360367

‎src/core/aws-server-http_utils.adb‎

Lines changed: 41 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -37,6 +37,7 @@ with Ada.Strings.Fixed;
3737
with Ada.Strings.Maps;
3838
with Ada.Strings.Unbounded;
3939
with Ada.Text_IO;
40+
with Ada.Unchecked_Deallocation;
4041

4142
with GNAT.MD5;
4243
with GNAT.OS_Lib;
@@ -1667,33 +1668,50 @@ package body AWS.Server.HTTP_Utils is
16671668
-- if the WebSocket is not to be accepted. In this case
16681669
-- a forbidden message is sent back.
16691670

1670-
WS : constant Net.WebSocket.Object'Class :=
1671-
Net.WebSocket.Registry.Constructor
1672-
(Status.URI (C_Stat))
1673-
(Socket => Status.Socket (C_Stat),
1674-
Request => C_Stat);
1671+
procedure Unchecked_Free is
1672+
new Ada.Unchecked_Deallocation
1673+
(Net.WebSocket.Object'Class,
1674+
Net.WebSocket.Object_Class);
1675+
1676+
use type Net.WebSocket.Object_Class;
1677+
WS : Net.WebSocket.Object_Class;
1678+
Registered : Boolean := False;
16751679
begin
1680+
WS := Net.WebSocket.Registry.Constructor
1681+
(Status.URI (C_Stat)) (C_Stat);
1682+
1683+
if WS /= null then
1684+
Net.WebSocket.Setup_Socket
1685+
(WS, Status.Socket (C_Stat), C_Stat);
1686+
end if;
1687+
16761688
-- Register this new WebSocket
16771689

1678-
if WS in Net.WebSocket.Handshake_Error.Object'Class then
1690+
if WS = null then
1691+
Send_WebSocket_Handshake_Error
1692+
(Messages.S412, "no route defined");
1693+
1694+
elsif WS.all
1695+
in Net.WebSocket.Handshake_Error.Object'Class
1696+
then
16791697
declare
16801698
E : constant Net.WebSocket.Handshake_Error.Object :=
1681-
Net.WebSocket.Handshake_Error.Object (WS);
1699+
Net.WebSocket.Handshake_Error.Object (WS.all);
16821700
begin
16831701
Send_WebSocket_Handshake_Error
16841702
(E.Status_Code, E.Reason_Phrase);
1703+
WS.Free;
1704+
Unchecked_Free (WS);
16851705
end;
16861706

16871707
else
16881708
-- First try to register the WebSocket object
16891709

1690-
declare
1691-
use type Net.WebSocket.Object_Class;
1692-
W : Net.WebSocket.Object_Class;
16931710
begin
1694-
W := Net.WebSocket.Registry.Utils.Register (WS);
1711+
Net.WebSocket.Registry.Utils.Register (WS);
1712+
Registered := True;
16951713

1696-
if W = null then
1714+
if WS = null then
16971715
Send_WebSocket_Handshake_Error
16981716
(Messages.S412,
16991717
"too many WebSocket registered");
@@ -1705,7 +1723,7 @@ package body AWS.Server.HTTP_Utils is
17051723
Socket_Taken := True;
17061724
Will_Close := False;
17071725

1708-
Net.WebSocket.Registry.Utils.Watch (W);
1726+
Net.WebSocket.Registry.Utils.Watch (WS);
17091727
end if;
17101728
end;
17111729
end if;
@@ -1715,7 +1733,16 @@ package body AWS.Server.HTTP_Utils is
17151733
Send_WebSocket_Handshake_Error
17161734
(Messages.S403,
17171735
Exception_Message (E));
1718-
WS.Shutdown;
1736+
1737+
if Registered then
1738+
-- Close will automatically free the memory for WS
1739+
-- itself, by looking up the pointer in the
1740+
-- registry.
1741+
Net.WebSocket.Registry.Close
1742+
(WS.all, "closed on error");
1743+
else
1744+
Unchecked_Free (WS);
1745+
end if;
17191746
end;
17201747

17211748
exception

0 commit comments

Comments
 (0)