diff --git a/src/core/aws-net-websocket-registry-utils.adb b/src/core/aws-net-websocket-registry-utils.adb index 0fd6f89427..1050e8d13e 100644 --- a/src/core/aws-net-websocket-registry-utils.adb +++ b/src/core/aws-net-websocket-registry-utils.adb @@ -35,9 +35,9 @@ package body AWS.Net.WebSocket.Registry.Utils is -- Register -- -------------- - function Register (WebSocket : Object'Class) return Object_Class is + procedure Register (WebSocket : in out Object_Class) is begin - return Net.WebSocket.Registry.Register (WebSocket); + Net.WebSocket.Registry.Register (WebSocket); end Register; ----------- diff --git a/src/core/aws-net-websocket-registry-utils.ads b/src/core/aws-net-websocket-registry-utils.ads index 8df4ef2b93..9e0729f727 100644 --- a/src/core/aws-net-websocket-registry-utils.ads +++ b/src/core/aws-net-websocket-registry-utils.ads @@ -31,10 +31,11 @@ package AWS.Net.WebSocket.Registry.Utils is - function Register (WebSocket : Object'Class) return Object_Class; - -- Register WebSocket, returns a pointer to the registered WebSocket or - -- null if it was not possible to register the WebSocket. This can happen - -- if the server has reached the limit of opened WebSocket for example. + procedure Register (WebSocket : in out Object_Class); + -- Register WebSocket. + -- Free it and set it to null if it was not possible to register the + -- WebSocket. This can happen if the server has reached the limit of opened + -- WebSocket for example. procedure Watch (WebSocket : in out Object_Class) with Pre => WebSocket /= null; diff --git a/src/core/aws-net-websocket-registry.adb b/src/core/aws-net-websocket-registry.adb index f224c457eb..b7e1752d07 100644 --- a/src/core/aws-net-websocket-registry.adb +++ b/src/core/aws-net-websocket-registry.adb @@ -90,6 +90,11 @@ package body AWS.Net.WebSocket.Registry is (Left.Id = Right.Id); -- Equality is based on the unique id + function Create_Default_Socket + (Request_Ignored : AWS.Status.Data) return Object_Class + is (new Object); + -- Default factory + package WebSocket_Map is new Containers.Ordered_Maps (UID, Object_Class, "=" => Same_WS); @@ -1164,7 +1169,7 @@ package body AWS.Net.WebSocket.Registry is end loop; end if; - return Create'Access; + return Create_Default_Socket'Access; end Constructor; ------------ @@ -1291,17 +1296,15 @@ package body AWS.Net.WebSocket.Registry is Factories.Insert (URI, Factory); end Register; - function Register (WebSocket : Object'Class) return Object_Class is - WS : Object_Class := new Object'Class'(WebSocket); + procedure Register (WebSocket : in out Object_Class) is Success : Boolean; begin - DB.Register (WS, Success); + DB.Register (WebSocket, Success); if not Success then - Unchecked_Free (WS); + Free (WebSocket.all); + Unchecked_Free (WebSocket); end if; - - return WS; end Register; ---------------------- diff --git a/src/core/aws-net-websocket-registry.ads b/src/core/aws-net-websocket-registry.ads index 5b7ef4428e..2d39e51110 100644 --- a/src/core/aws-net-websocket-registry.ads +++ b/src/core/aws-net-websocket-registry.ads @@ -39,8 +39,13 @@ private with GNAT.Regexp; package AWS.Net.WebSocket.Registry is type Factory is not null access function - (Socket : Socket_Access; - Request : AWS.Status.Data) return Object'Class; + (Request : AWS.Status.Data) return Object_Class; + -- Return a newly allocated object. + -- You can use AWS.Status.Parameters (Request) to check what additional + -- parameters were sent by the user. + -- + -- This object will later be initialized automatically, via a call to + -- AWS.Net.WebSocket.Setup_Socket. -- Creating and Registering WebSockets @@ -141,7 +146,7 @@ package AWS.Net.WebSocket.Registry is with Pre => To /= No_Recipient; -- Close connections - -- Targetting a single WebSocket, these routines are equivalent to the + -- Targeting a single WebSocket, these routines are equivalent to the -- Net.WebSocket ones but are thread-safe. That is, they can be mixed -- with other WebSocket activity to and from the clients. @@ -207,9 +212,9 @@ private procedure Shutdown; -- Stop the WebServer's servers - function Register (WebSocket : Object'Class) return Object_Class; - -- Register a new WebSocket, returns a reference to the registered - -- WebSocket or null if it was impossible to register it. + procedure Register (WebSocket : in out Object_Class); + -- Register a new WebSocket. + -- Sets it to null (and free memory) if it was impossible to register it. procedure Watch (WebSocket : in out Object_Class) with Pre => WebSocket /= null; diff --git a/src/core/aws-net-websocket.adb b/src/core/aws-net-websocket.adb index 2894870a6d..fb7b429bfd 100644 --- a/src/core/aws-net-websocket.adb +++ b/src/core/aws-net-websocket.adb @@ -134,32 +134,6 @@ package body AWS.Net.WebSocket is Socket.On_Open ("WebSocket connected with " & URI); end Connect; - ------------ - -- Create -- - ------------ - - function Create - (Socket : Socket_Access; - Request : AWS.Status.Data) return Object'Class - is - Result : Object; - Protocol : Net.WebSocket.Protocol.State_Class; - Headers : constant AWS.Headers.List := - AWS.Status.Header (Request); - begin - if Headers.Exist (Messages.Sec_WebSocket_Key1_Token) - and then Headers.Exist (Messages.Sec_WebSocket_Key2_Token) - then - Protocol := new Net.WebSocket.Protocol.Draft76.State; - else - Protocol := new Net.WebSocket.Protocol.RFC6455.State; - end if; - - Initialize (Result, Socket, Protocol, Headers); - Result.Request := Request; - return Result; - end Create; - -------------------- -- End_Of_Message -- -------------------- @@ -626,6 +600,30 @@ package body AWS.Net.WebSocket is Socket.P_State.State.Send (Socket, Message); end Send; + ------------------ + -- Setup_Socket -- + ------------------ + + procedure Setup_Socket + (WS : not null Object_Class; + Socket : not null Socket_Access; + Request : AWS.Status.Data) + is + Protocol : Net.WebSocket.Protocol.State_Class; + Headers : constant AWS.Headers.List := AWS.Status.Header (Request); + begin + if Headers.Exist (Messages.Sec_WebSocket_Key1_Token) + and then Headers.Exist (Messages.Sec_WebSocket_Key2_Token) + then + Protocol := new Net.WebSocket.Protocol.Draft76.State; + else + Protocol := new Net.WebSocket.Protocol.RFC6455.State; + end if; + + Initialize (WS.all, Socket, Protocol, Headers); + WS.Request := Request; + end Setup_Socket; + -------------- -- Shutdown -- -------------- diff --git a/src/core/aws-net-websocket.ads b/src/core/aws-net-websocket.ads index f2a24d04da..23d686eb7a 100644 --- a/src/core/aws-net-websocket.ads +++ b/src/core/aws-net-websocket.ads @@ -47,8 +47,8 @@ package AWS.Net.WebSocket is type Object_Class is access all Object'Class; -- To implement your own handling of messages, you need to extend this -- type and override at least the On_Message primitive operation. - -- In addition, you need to register a factory (to create new objects based - -- on the URI) using AWS.Net.WebSocket.Registry.Register). + -- In addition, you need to register a factory (to create new objects + -- based on the URI) using AWS.Net.WebSocket.Registry.Register). No_Object : constant Object'Class; @@ -81,16 +81,6 @@ package AWS.Net.WebSocket is -- the default Send implementation should be ok for most usages. -- - function Create - (Socket : Socket_Access; - Request : AWS.Status.Data) return Object'Class - with Pre => Socket /= null; - -- Create a new instance of the WebSocket, this is used by AWS internal - -- server to create a default WebSocket if no other constructor are - -- provided. It is also needed when deriving from WebSocket. - -- - -- This function must be registered via AWS.Net.WebSocket.Registry.Register - procedure On_Message (Socket : in out Object; Message : String) is null; -- Default implementation does nothing, it needs to be overridden by the -- end-user. This is the callback that will get activated for every server @@ -259,6 +249,20 @@ package AWS.Net.WebSocket is -- Returns a unique id for the given socket. The uniqueness for this socket -- is guaranteed during the lifetime of the application. + ----------------------- + -- Internal services -- + ----------------------- + -- These subprograms are used internally by AWS, and do not need to be + -- called explicitly in user code. + + procedure Setup_Socket + (WS : not null Object_Class; + Socket : not null Socket_Access; + Request : AWS.Status.Data); + -- Setup WS. + -- It will be called automatically for any websocket returned by a factory, + -- so in general you do not need to call it explicitly. + private type Internal_State is record @@ -350,6 +354,8 @@ private (Socket : Object; Size : Natural) is null; overriding procedure Free (Socket : in out Object); + -- This is called automatically when the socket is no longer needed, do not + -- call directly from user code. No_UID : constant UID := 0; diff --git a/src/core/aws-server-http_utils.adb b/src/core/aws-server-http_utils.adb index 42cd481f43..9ff61eb9e5 100644 --- a/src/core/aws-server-http_utils.adb +++ b/src/core/aws-server-http_utils.adb @@ -37,6 +37,7 @@ with Ada.Strings.Fixed; with Ada.Strings.Maps; with Ada.Strings.Unbounded; with Ada.Text_IO; +with Ada.Unchecked_Deallocation; with GNAT.MD5; with GNAT.OS_Lib; @@ -1668,33 +1669,48 @@ package body AWS.Server.HTTP_Utils is -- if the WebSocket is not to be accepted. In this case -- a forbidden message is sent back. - WS : constant Net.WebSocket.Object'Class := - Net.WebSocket.Registry.Constructor - (Status.URI (C_Stat)) - (Socket => Status.Socket (C_Stat), - Request => C_Stat); + procedure Unchecked_Free is + new Ada.Unchecked_Deallocation + (Net.WebSocket.Object'Class, + Net.WebSocket.Object_Class); + + use type Net.WebSocket.Object_Class; + WS : Net.WebSocket.Object_Class; begin + WS := Net.WebSocket.Registry.Constructor + (Status.URI (C_Stat)) (C_Stat); + + if WS /= null then + Net.WebSocket.Setup_Socket + (WS, Status.Socket (C_Stat), C_Stat); + end if; + -- Register this new WebSocket - if WS in Net.WebSocket.Handshake_Error.Object'Class then + if WS = null then + Send_WebSocket_Handshake_Error + (Messages.S412, "no route defined"); + + elsif WS.all + in Net.WebSocket.Handshake_Error.Object'Class + then declare E : constant Net.WebSocket.Handshake_Error.Object := - Net.WebSocket.Handshake_Error.Object (WS); + Net.WebSocket.Handshake_Error.Object (WS.all); begin Send_WebSocket_Handshake_Error (E.Status_Code, E.Reason_Phrase); + WS.Free; + Unchecked_Free (WS); end; else -- First try to register the WebSocket object - declare - use type Net.WebSocket.Object_Class; - W : Net.WebSocket.Object_Class; begin - W := Net.WebSocket.Registry.Utils.Register (WS); + Net.WebSocket.Registry.Utils.Register (WS); - if W = null then + if WS = null then Send_WebSocket_Handshake_Error (Messages.S412, "too many WebSocket registered"); @@ -1706,7 +1722,7 @@ package body AWS.Server.HTTP_Utils is Socket_Taken := True; Will_Close := False; - Net.WebSocket.Registry.Utils.Watch (W); + Net.WebSocket.Registry.Utils.Watch (WS); end if; end; end if; @@ -1716,7 +1732,11 @@ package body AWS.Server.HTTP_Utils is Send_WebSocket_Handshake_Error (Messages.S403, Exception_Message (E)); + + -- ??? Is the socket automatically unregistered WS.Shutdown; + WS.Free; + Unchecked_Free (WS); end; exception