Skip to content

Commit c1300c2

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 2c11a1c commit c1300c2

7 files changed

+111
-71
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 Containers.Ordered_Maps (UID, Object_Class, "=" => Same_WS);
95100

@@ -1164,7 +1169,7 @@ package body AWS.Net.WebSocket.Registry is
11641169
end loop;
11651170
end if;
11661171

1167-
return Create'Access;
1172+
return Create_Default_Socket'Access;
11681173
end Constructor;
11691174

11701175
------------
@@ -1291,17 +1296,15 @@ package body AWS.Net.WebSocket.Registry is
12911296
Factories.Insert (URI, Factory);
12921297
end Register;
12931298

1294-
function Register (WebSocket : Object'Class) return Object_Class is
1295-
WS : Object_Class := new Object'Class'(WebSocket);
1299+
procedure Register (WebSocket : in out Object_Class) is
12961300
Success : Boolean;
12971301
begin
1298-
DB.Register (WS, Success);
1302+
DB.Register (WebSocket, Success);
12991303

13001304
if not Success then
1301-
Unchecked_Free (WS);
1305+
Free (WebSocket.all);
1306+
Unchecked_Free (WebSocket);
13021307
end if;
1303-
1304-
return WS;
13051308
end Register;
13061309

13071310
----------------------

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

Lines changed: 11 additions & 6 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

@@ -141,7 +146,7 @@ package AWS.Net.WebSocket.Registry is
141146
with Pre => To /= No_Recipient;
142147
-- Close connections
143148

144-
-- Targetting a single WebSocket, these routines are equivalent to the
149+
-- Targeting a single WebSocket, these routines are equivalent to the
145150
-- Net.WebSocket ones but are thread-safe. That is, they can be mixed
146151
-- with other WebSocket activity to and from the clients.
147152

@@ -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
--------------------
@@ -626,6 +600,30 @@ package body AWS.Net.WebSocket is
626600
Socket.P_State.State.Send (Socket, Message);
627601
end Send;
628602

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

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

Lines changed: 18 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
@@ -259,6 +249,20 @@ package AWS.Net.WebSocket is
259249
-- Returns a unique id for the given socket. The uniqueness for this socket
260250
-- is guaranteed during the lifetime of the application.
261251

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

264268
type Internal_State is record
@@ -350,6 +354,8 @@ private
350354
(Socket : Object; Size : Natural) is null;
351355

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

354360
No_UID : constant UID := 0;
355361

‎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;
@@ -1668,33 +1669,50 @@ package body AWS.Server.HTTP_Utils is
16681669
-- if the WebSocket is not to be accepted. In this case
16691670
-- a forbidden message is sent back.
16701671

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

1679-
if WS in Net.WebSocket.Handshake_Error.Object'Class then
1691+
if WS = null then
1692+
Send_WebSocket_Handshake_Error
1693+
(Messages.S412, "no route defined");
1694+
1695+
elsif WS.all
1696+
in Net.WebSocket.Handshake_Error.Object'Class
1697+
then
16801698
declare
16811699
E : constant Net.WebSocket.Handshake_Error.Object :=
1682-
Net.WebSocket.Handshake_Error.Object (WS);
1700+
Net.WebSocket.Handshake_Error.Object (WS.all);
16831701
begin
16841702
Send_WebSocket_Handshake_Error
16851703
(E.Status_Code, E.Reason_Phrase);
1704+
WS.Free;
1705+
Unchecked_Free (WS);
16861706
end;
16871707

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

1691-
declare
1692-
use type Net.WebSocket.Object_Class;
1693-
W : Net.WebSocket.Object_Class;
16941711
begin
1695-
W := Net.WebSocket.Registry.Utils.Register (WS);
1712+
Net.WebSocket.Registry.Utils.Register (WS);
1713+
Registered := True;
16961714

1697-
if W = null then
1715+
if WS = null then
16981716
Send_WebSocket_Handshake_Error
16991717
(Messages.S412,
17001718
"too many WebSocket registered");
@@ -1706,7 +1724,7 @@ package body AWS.Server.HTTP_Utils is
17061724
Socket_Taken := True;
17071725
Will_Close := False;
17081726

1709-
Net.WebSocket.Registry.Utils.Watch (W);
1727+
Net.WebSocket.Registry.Utils.Watch (WS);
17101728
end if;
17111729
end;
17121730
end if;
@@ -1716,7 +1734,16 @@ package body AWS.Server.HTTP_Utils is
17161734
Send_WebSocket_Handshake_Error
17171735
(Messages.S403,
17181736
Exception_Message (E));
1719-
WS.Shutdown;
1737+
1738+
if Registered then
1739+
-- Close will automatically free the memory for WS
1740+
-- itself, by looking up the pointer in the
1741+
-- registry.
1742+
Net.WebSocket.Registry.Close
1743+
(WS.all, "closed on error");
1744+
else
1745+
Unchecked_Free (WS);
1746+
end if;
17201747
end;
17211748

17221749
exception

0 commit comments

Comments
 (0)