WebSocket implementation is buggy or bad documented.

[reznikmm]

Hello,
I have a problem with Web_Socket API in AWS (server side). The AWS.Net.WebSocket has this:

   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

Looks like to create a custom web socket object one needs to define a function with the same profile and register it with the Register procedure. One (like me) could think that this function will be called to construct a custom web socket when a http client call an URL. AWS indeed calls this, but then it will destroy the object. So if you keep the object to send messages to the client it will raise PROTOCOL_ERRORaws-net-buffered.adb:147 access check failed with traceback like:

#5  0x00007fc950be087f in <__gnat_rcheck_CE_Access_Check> (file=..., line=...) at a-except.adb:1208
#6  0x00007fc951ce0f82 in aws.net.buffered.get_write_cache (socket=..., <get_write_cacheL>=...) at /tmp/openwrt/aws/src/core/aws-net-buffered.adb:147
#7  0x00007fc951ce2dff in aws.net.buffered.write (socket=..., item=...) at /tmp/openwrt/aws/src/core/aws-net-buffered.adb:440
#8  0x00007fc951d3cf34 in aws.net.websocket.protocol.rfc6455.send_frame_header (protocol=..., socket=..., opcd=..., data_length=..., has_mask=..., mask=...) at /tmp/openwrt/aws/src/core/aws-net-websocket-protocol-rfc6455.adb:767
#9  0x00007fc951d3c903 in aws.net.websocket.protocol.rfc6455.send (protocol=..., socket=..., data=..., from_client=...) at /tmp/openwrt/aws/src/core/aws-net-websocket-protocol-rfc6455.adb:626
#10 0x00007fc951da2a62 in aws.net.websocket.send (socket=..., message=..., is_binary=...) at /tmp/openwrt/aws/src/core/aws-net-websocket.adb:597

Property named C is reset by Finalize:

(gdb) bt
#0  aws.net.finalize (socket=...) at /home/max/net/aws/src/core/aws-net.adb:137
#1  0x00007f6a3fd143a6 in web_socket__handlers__aws_handlers__aws_web_socketDF__2 () at /home/max/net/matreshka/source/web/spikedog/aws/web_socket-handlers-aws_handlers.ads:69
#2  0x00007f6a3e7d2a34 in aws.server.http_utils.send (answer=..., http_server=..., line_index=..., c_stat=..., socket_taken=..., will_close=...) at /home/max/net/aws/src/core/aws-server-http_utils.adb:1657
#3  0x00007f6a3e7c2869 in aws.server.http_utils.answer_to_client (http_server=..., line_index=..., c_stat=..., socket_taken=..., will_close=...) at /home/max/net/aws/src/core/aws-server-http_utils.adb:400
#4  0x00007f6a3e7f5fdb in aws.server.protocol_handler (la=...) at /home/max/net/aws/src/core/aws-server-protocol_handler.adb:264
#5  0x00007f6a3e7f2e81 in aws.server.line (<_task>=...) at /home/max/net/aws/src/core/aws-server.adb:327
#6  0x00007f6a3da253f6 in system.tasking.stages.task_wrapper () from /home/max/net/gnat-gpl-2019/lib/gcc/x86_64-pc-linux-gnu/8.3.1/adalib/libgnarl-2019.so

Try to run the example from aws/demos/websockets under debugger. The exampe tries to add its own field C and populate ith with zero:

      return Object'(Net.WebSocket.Object
                       (Net.WebSocket.Create (Socket, Request)) with C => 0);

But when On_Open is called C has a garbage:

(gdb) print Socket.C
$3 = 538976288

(gdb) bt
#0  websock_cb.on_open (socket=..., message=...) at /home/max/net/aws/demos/websockets/websock_cb.adb:118
#1  0x00007ffff77c3d90 in aws.net.websocket.registry.watch (websocket=...) at /home/max/net/aws/src/core/aws-net-websocket-registry.adb:1514
#2  0x00007ffff7772650 in aws.net.websocket.registry.utils.watch (websocket=...) at /home/max/net/aws/src/core/aws-net-websocket-registry-utils.adb:49
#3  0x00007ffff782ce61 in aws.server.http_utils.send (answer=..., http_server=..., line_index=..., c_stat=..., socket_taken=..., will_close=...) at /home/max/net/aws/src/core/aws-server-http_utils.adb:1694
#4  0x00007ffff781c869 in aws.server.http_utils.answer_to_client (http_server=..., line_index=..., c_stat=..., socket_taken=..., will_close=...) at /home/max/net/aws/src/core/aws-server-http_utils.adb:400
#5  0x00007ffff784ffdb in aws.server.protocol_handler (la=...) at /home/max/net/aws/src/core/aws-server-protocol_handler.adb:264
#6  0x00007ffff784ce81 in aws.server.line (<_task>=...) at /home/max/net/aws/src/core/aws-server.adb:327
#7  0x00007ffff6a7f3f6 in system.tasking.stages.task_wrapper () from /home/max/net/aws/demos/websockets/debug/../../../..//gnat-gpl-2019/lib/gcc/x86_64-pc-linux-gnu/8.3.1/adalib/libgnarl-2019.so

Could you suggest how should I create a Web_Socket object to be able to send some message from the server to the client outside of 'On_OpenandOn_Message` callback?

PS Cross-reference to matreshka issue.

[briot]

I had noticed the same issue (among with many others related to memory management, not calling On_Close in all cases, using the stack even when the message is larger than 2MB, some useless conversions back to Unbounded_String,...).

For your particular case, I ended up with the following patch, which you or the AWS maintainers are of course free to use.

commit 666eb952d0b56c3ed7ab808eceb4c1e7bd0b30dc
Author: Emmanuel Briot <emmanuel.briot@deepbluecap.com>
Date:   Tue Oct 9 18:09:49 2018 +0200

    (Initialize): new subprogram

    Extract code from Create, to be used when creating websocket client

diff --git External/Ada_Web_Server/aws-dev/src/core/aws-net-websocket.adb External/Ada_Web_Server/aws-dev/src/core/aws-net-websocket.adb
index 5b802de280..50f1cd91e5 100644
--- External/Ada_Web_Server/aws-dev/src/core/aws-net-websocket.adb
+++ External/Ada_Web_Server/aws-dev/src/core/aws-net-websocket.adb
@@ -47,6 +47,19 @@ package body AWS.Net.WebSocket is
       State : Net.WebSocket.Protocol.State_Class;
    end record;

+   procedure Unchecked_Free is new Ada.Unchecked_Deallocation
+      (AWS.Client.HTTP_Connection, HTTP_Connection_Access);
+   procedure Unchecked_Free is new Unchecked_Deallocation
+     (Net.WebSocket.Protocol.State'Class,
+      Net.WebSocket.Protocol.State_Class);
+
+   procedure Initialize
+      (Self     : in out Object'Class;
+       Socket   : Socket_Access;
+       Protocol : Net.WebSocket.Protocol.State_Class;
+       Headers  : AWS.Headers.List);
+   --  Initialize the fields of Self
+
    -----------
    -- Close --
    -----------
@@ -67,12 +80,10 @@ package body AWS.Net.WebSocket is
      (Socket  : Socket_Access;
       Request : AWS.Status.Data) return Object'Class
    is
-
-      Headers      : constant AWS.Headers.List := AWS.Status.Header (Request);
-      Version      : Natural := 0;
-      Protocol     : Net.WebSocket.Protocol.State_Class;
-      WS_UID_Value : Natural := 0;
-
+      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)
@@ -82,32 +93,9 @@ package body AWS.Net.WebSocket is
          Protocol := new Net.WebSocket.Protocol.RFC6455.State;
       end if;

-      if Headers.Exist (Messages.Sec_WebSocket_Version_Token) then
-         declare
-            Value : constant String :=
-                      Headers.Get (Messages.Sec_WebSocket_Version_Token);
-         begin
-            if Utils.Is_Number (Value) then
-               Version := Natural'Value (Value);
-            end if;
-         end;
-      end if;
-
-      WS_UID.Increment (Value => WS_UID_Value);
-
-      return Object'
-        (Net.Socket_Type with
-           Socket   => Socket,
-           Id       => UID (WS_UID_Value),
-           Request  => Request,
-           Version  => Version,
-           State    => new Internal_State'
-                            (Kind          => Unknown,
-                             Errno         => Interfaces.Unsigned_16'Last,
-                             Last_Activity => Calendar.Clock),
-           P_State  => new Protocol_State'(State => Protocol),
-           Mem_Sock => null,
-           In_Mem   => False);
+      Initialize (Result, Socket, Protocol, Headers);
+      Result.Request := Request;
+      return Result;
    end Create;

    --------------------
@@ -167,9 +155,6 @@ package body AWS.Net.WebSocket is
          new Unchecked_Deallocation (Internal_State, Internal_State_Access);
       procedure Unchecked_Free is
          new Unchecked_Deallocation (Protocol_State, Protocol_State_Access);
-      procedure Unchecked_Free is new Unchecked_Deallocation
-        (Net.WebSocket.Protocol.State'Class,
-         Net.WebSocket.Protocol.State_Class);
    begin
       Unchecked_Free (Socket.State);
@@ -237,6 +222,44 @@ package body AWS.Net.WebSocket is
       return Socket.Id;
    end Get_UID;

+   ----------------
+   -- Initialize --
+   ----------------
+
+   procedure Initialize
+      (Self     : in out Object'Class;
+       Socket   : Socket_Access;
+       Protocol : Net.WebSocket.Protocol.State_Class;
+       Headers  : AWS.Headers.List)
+   is
+      Version      : Natural := 0;
+      WS_UID_Value : Natural := 0;
+   begin
+      if Headers.Exist (Messages.Sec_WebSocket_Version_Token) then
+         declare
+            Value : constant String :=
+                      Headers.Get (Messages.Sec_WebSocket_Version_Token);
+         begin
+            if Utils.Is_Number (Value) then
+               Version := Natural'Value (Value);
+            end if;
+         end;
+      end if;
+
+      WS_UID.Increment (Value => WS_UID_Value);
+
+      Self.Socket   := Socket;
+      Self.Id       := UID (WS_UID_Value);
+      Self.Version  := Version;
+      Self.State    := new Internal_State'
+         (Kind          => Unknown,
+          Errno         => Interfaces.Unsigned_16'Last,
+          Last_Activity => Calendar.Clock);
+      Self.P_State  := new Protocol_State'(State => Protocol);
+      Self.Mem_Sock := null;
+      Self.In_Mem   := False;
+   end Initialize;
+
    ------------------
    -- Is_Listening --
    ------------------

[ohenley]

Why not do a pull request with it?

[briot]

Feel free to do it, no problem with me !

[ohenley]

If I was an AdaCore employee I would.
Anyhow, thanks for the patch.

[briot]

I have now created a PR, after cleaning up the code I have been using for a while