diff --git a/docs/source/high_level_services.rst b/docs/source/high_level_services.rst index 2ddd7520a..be4dc0d47 100644 --- a/docs/source/high_level_services.rst +++ b/docs/source/high_level_services.rst @@ -1435,8 +1435,8 @@ some high level services on the server side and also on the client side. .. _WebSockets_on_the_client: -WebSockets on the client ------------------------- +WebSockets on the client (javascript) +------------------------------------- The WebSocket is created on the client side. As there is some differences between Web browsers, AWS provides a wrapper routine to create a @@ -1499,6 +1499,42 @@ Likewise for the other events. .. _WebSockets_on_the_server: +WebSockets on the client (Ada) +------------------------------ + +AWS also supports writing websocket clients directly in Ada. Here is an +example:: + + type MySocket is new AWS.Net.WebSocket.Object with null record; + overriding procedure On_Message (Self : in out MySocket; Str : String); + -- You would likely also override On_Error and On_Close + + overriding procedure On_Message (Self : in out MySocket; Str : String) is + begin + Ada.Text_IO.Put_Line ("++ Got message '" & Str & "'"); + end On_Message; + + declare + Socket : MySocket; + begin + AWS.Net.WebSocket.Connect (Socket, "ws://localhost:8765"); + + -- Send one message + Socket.Send ("some message"); + + -- Then wait for any number of messages from the server. Give up if + -- no message is available for 2s. If messages become available, the + -- procedure On_Message will be called. + while Socket.Poll (Timeout => 2.0) loop + null; + end loop; + + Socket.Close (""); + end; + +You are responsible for checking regularly whether any message has been +received from the server. + WebSockets on the server ------------------------ diff --git a/makefile.conf b/makefile.conf index fdd4ff057..92f293d44 100644 --- a/makefile.conf +++ b/makefile.conf @@ -121,7 +121,7 @@ LDAP = false # # DEBUG = [true|false] # -DEBUG = false +DEBUG = true ############################################################################## # Number of parallel compilations to do. diff --git a/src/core/aws-client.ads b/src/core/aws-client.ads index d0a6c1049..5b6aa51c4 100644 --- a/src/core/aws-client.ads +++ b/src/core/aws-client.ads @@ -277,6 +277,7 @@ package AWS.Client is --------------------------------------- type HTTP_Connection is limited private; + type HTTP_Connection_Access is access all HTTP_Connection; function Create (Host : String; @@ -558,8 +559,6 @@ private Undefined_Length : Response.Content_Length_Type renames Response.Undefined_Length; - type HTTP_Connection_Access is access all HTTP_Connection; - type Authentication_Level is (WWW, Proxy); type Authentication_Type is record @@ -644,9 +643,7 @@ private -- Check timeout and Try_Count and set error responce into Result -- if necessary. - function Get_Socket - (Connection : HTTP_Connection) - return Net.Socket_Access + function Get_Socket (Connection : HTTP_Connection) return Net.Socket_Access is (Connection.Socket); end AWS.Client; diff --git a/src/core/aws-net-websocket-protocol-draft76.adb b/src/core/aws-net-websocket-protocol-draft76.adb index b84f0187b..ba11c92b9 100644 --- a/src/core/aws-net-websocket-protocol-draft76.adb +++ b/src/core/aws-net-websocket-protocol-draft76.adb @@ -43,6 +43,21 @@ package body AWS.Net.WebSocket.Protocol.Draft76 is use Ada.Text_IO; + ------------------------- + -- Add_Connect_Headers -- + ------------------------- + + overriding procedure Add_Connect_Headers + (Protocol : State; + URI : String; + Headers : in out AWS.Headers.List) + is + pragma Unreferenced (Protocol, URI, Headers); + begin + raise Program_Error + with "Connecting with draft76 protocol is not supported"; + end Add_Connect_Headers; + -------------------- -- End_Of_Message -- -------------------- diff --git a/src/core/aws-net-websocket-protocol-draft76.ads b/src/core/aws-net-websocket-protocol-draft76.ads index 708750d7f..5daa4a5ee 100644 --- a/src/core/aws-net-websocket-protocol-draft76.ads +++ b/src/core/aws-net-websocket-protocol-draft76.ads @@ -70,4 +70,10 @@ package AWS.Net.WebSocket.Protocol.Draft76 is (Sock : Net.Socket_Type'Class; Request : AWS.Status.Data); -- Send specific header for this protocol + overriding procedure Add_Connect_Headers + (Protocol : State; + URI : String; + Headers : in out AWS.Headers.List); + -- See inherited documentation + end AWS.Net.WebSocket.Protocol.Draft76; diff --git a/src/core/aws-net-websocket-protocol-rfc6455.adb b/src/core/aws-net-websocket-protocol-rfc6455.adb index 5cd674033..05fd0ea3f 100644 --- a/src/core/aws-net-websocket-protocol-rfc6455.adb +++ b/src/core/aws-net-websocket-protocol-rfc6455.adb @@ -119,6 +119,50 @@ package body AWS.Net.WebSocket.Protocol.RFC6455 is function Create_Random_Mask return Masking_Key; -- Create a random masking key + ------------------------- + -- Add_Connect_Headers -- + ------------------------- + + overriding procedure Add_Connect_Headers + (Protocol : State; + URI : String; + Headers : in out AWS.Headers.List) + is + pragma Unreferenced (Protocol); + Ints : array (1 .. 4) of AWS.Utils.Random_Integer := + (others => AWS.Utils.Random); + H : Stream_Element_Array (1 .. 16) with Import, Address => Ints'Address; + + begin + Headers.Add ("Host", URI); + Headers.Add ("Upgrade", "websocket"); + Headers.Add ("Connection", "Upgrade"); + Headers.Add ("Sec-WebSocket-Key", Translator.Base64_Encode (H)); + Headers.Add ("Sec-WebSocket-Protocol", "chat"); + Headers.Add ("Sec-WebSocket-Version", "13"); + end Add_Connect_Headers; + + ---------------------------- + -- Check_Connect_Response -- + ---------------------------- + + overriding function Check_Connect_Response + (Protocol : State; + Request : AWS.Headers.List; + Response : AWS.Response.Data) + return Boolean + is + pragma Unreferenced (Protocol); + Expected : constant String := + Get_Websocket_Accept + (AWS.Headers.Get + (Request, AWS.Messages.Sec_WebSocket_Key_Token)); + Actual : constant String := AWS.Response.Header + (Response, AWS.Messages.Sec_WebSocket_Accept_Token); + begin + return Expected = Actual; + end Check_Connect_Response; + ----------- -- Close -- ----------- @@ -530,11 +574,13 @@ package body AWS.Net.WebSocket.Protocol.RFC6455 is if Socket.State.Kind = Text then Send_Frame_Header (Protocol, Socket, O_Text, Stream_Element_Offset (Len_Data), - Has_Mask => From_Client, Mask => Mask); + Has_Mask => From_Client, + Mask => Mask); else Send_Frame_Header (Protocol, Socket, O_Binary, Stream_Element_Offset (Len_Data), - Has_Mask => From_Client, Mask => Mask); + Has_Mask => From_Client, + Mask => Mask); end if; Send_Data : loop @@ -542,7 +588,8 @@ package body AWS.Net.WebSocket.Protocol.RFC6455 is declare S : Stream_Element_Array := - Translator.To_Stream_Element_Array (Slice (Data, First, Last)); + Translator.To_Stream_Element_Array + (Slice (Data, First, Last)); begin if From_Client then for Idx in S'Range loop @@ -595,6 +642,7 @@ package body AWS.Net.WebSocket.Protocol.RFC6455 is xor Mask (Stream_Element_Offset (Mask_Pos)); Mask_Pos := Mask_Pos + 1; end loop; + Net.Buffered.Write (Socket, D); end; diff --git a/src/core/aws-net-websocket-protocol-rfc6455.ads b/src/core/aws-net-websocket-protocol-rfc6455.ads index 9aa7ede72..1a03f2d43 100644 --- a/src/core/aws-net-websocket-protocol-rfc6455.ads +++ b/src/core/aws-net-websocket-protocol-rfc6455.ads @@ -69,6 +69,16 @@ package AWS.Net.WebSocket.Protocol.RFC6455 is (Sock : Net.Socket_Type'Class; Request : AWS.Status.Data); -- Send specific header for this protocol + overriding procedure Add_Connect_Headers + (Protocol : State; + URI : String; + Headers : in out AWS.Headers.List); + overriding function Check_Connect_Response + (Protocol : State; + Request : AWS.Headers.List; + Response : AWS.Response.Data) return Boolean; + -- See inherited documentation + private -- Protocol specific status diff --git a/src/core/aws-net-websocket-protocol.ads b/src/core/aws-net-websocket-protocol.ads index cad0d8b62..831e7548d 100644 --- a/src/core/aws-net-websocket-protocol.ads +++ b/src/core/aws-net-websocket-protocol.ads @@ -29,6 +29,8 @@ -- Parent of all implemented protocols which are for internal use only +with AWS.Headers; +with AWS.Response; with Interfaces; package AWS.Net.WebSocket.Protocol is @@ -71,4 +73,17 @@ package AWS.Net.WebSocket.Protocol is function End_Of_Message (Protocol : State) return Boolean is abstract; -- Returns True if we have read a whole message + procedure Add_Connect_Headers + (Protocol : State; + URI : String; + Headers : in out AWS.Headers.List) is abstract; + -- Add all required headers to establish a websocket connection to a server + + function Check_Connect_Response + (Protocol_Ignored : State; + Request_Ignored : AWS.Headers.List; + Response_Ignored : AWS.Response.Data) return Boolean is (True); + -- Check whether the server's response matches the headers we sent to + -- establish a connection. + end AWS.Net.WebSocket.Protocol; diff --git a/src/core/aws-net-websocket.adb b/src/core/aws-net-websocket.adb index 50f1cd91e..b716b548a 100644 --- a/src/core/aws-net-websocket.adb +++ b/src/core/aws-net-websocket.adb @@ -48,7 +48,7 @@ package body AWS.Net.WebSocket is end record; procedure Unchecked_Free is new Ada.Unchecked_Deallocation - (AWS.Client.HTTP_Connection, HTTP_Connection_Access); + (AWS.Client.HTTP_Connection, AWS.Client.HTTP_Connection_Access); procedure Unchecked_Free is new Unchecked_Deallocation (Net.WebSocket.Protocol.State'Class, Net.WebSocket.Protocol.State_Class); @@ -69,9 +69,69 @@ package body AWS.Net.WebSocket is Message : String; Error : Error_Type := Normal_Closure) is begin + -- When the user explicitly closes a web socket, we do not call + -- On_Close (this is only called when the other end closes the socket) + Socket.P_State.State.Close (Socket, Message, Error_Code (Error)); + exception + when AWS.Net.Socket_Error => + null; end Close; + ------------- + -- Connect -- + ------------- + + procedure Connect + (Socket : in out Object'Class; + URI : String) + is + Headers : AWS.Headers.List := AWS.Headers.Empty_List; + Resp : AWS.Response.Data; + Protocol : AWS.Net.WebSocket.Protocol.State_Class; + begin + -- Initially, the connection is initiated with standard http GET. + + Socket.Connection := new AWS.Client.HTTP_Connection; + Protocol := new Net.WebSocket.Protocol.RFC6455.State; + + AWS.Client.Create + (Socket.Connection.all, + Host => URI, + User => AWS.Client.No_Data, + Pwd => AWS.Client.No_Data, + Proxy => AWS.Client.No_Data, + Proxy_User => AWS.Client.No_Data, + Proxy_Pwd => AWS.Client.No_Data, + Persistent => False, + Certificate => AWS.Default.Client_Certificate, + Timeouts => AWS.Client.No_Timeout); + + Protocol.Add_Connect_Headers (URI, Headers); + + AWS.Client.Get + (Socket.Connection.all, + Result => Resp, + URI => AWS.Client.No_Data, + Data_Range => AWS.Client.No_Range, + Headers => Headers); + + if not Protocol.Check_Connect_Response (Headers, Resp) then + Unchecked_Free (Protocol); + Unchecked_Free (Socket.Connection); + raise AWS.Client.Protocol_Error with "Invalid accept from server"; + end if; + + Initialize + (Socket, + AWS.Client.Get_Socket (Socket.Connection.all), + Protocol, + Headers); + AWS.Status.Set.Request (Socket.Request, "GET", URI, "1.1"); + + Socket.On_Open ("WebSocket connected with " & URI); + end Connect; + ------------ -- Create -- ------------ @@ -83,7 +143,7 @@ package body AWS.Net.WebSocket is Result : Object; Protocol : Net.WebSocket.Protocol.State_Class; Headers : constant AWS.Headers.List := - AWS.Status.Header (Request); + AWS.Status.Header (Request); begin if Headers.Exist (Messages.Sec_WebSocket_Key1_Token) and then Headers.Exist (Messages.Sec_WebSocket_Key2_Token) @@ -151,6 +211,7 @@ package body AWS.Net.WebSocket is ---------- overriding procedure Free (Socket : in out Object) is + use type AWS.Client.HTTP_Connection_Access; procedure Unchecked_Free is new Unchecked_Deallocation (Internal_State, Internal_State_Access); procedure Unchecked_Free is @@ -163,7 +224,13 @@ package body AWS.Net.WebSocket is Unchecked_Free (Socket.P_State); end if; - Free (Socket.Socket); + if Socket.Connection /= null then + -- Also closes Socket.Socket, since it is shared + Unchecked_Free (Socket.Connection); + else + Free (Socket.Socket); + end if; + Free (Socket.Mem_Sock); end Free; @@ -326,6 +393,62 @@ package body AWS.Net.WebSocket is return Socket.Socket.Pending; end Pending; + ---------- + -- Poll -- + ---------- + + function Poll + (Socket : in out Object'Class; + Timeout : Duration) + return Boolean + is + procedure Do_Receive + (Socket : not null access Object'Class; + Data : out Ada.Streams.Stream_Element_Array; + Last : out Ada.Streams.Stream_Element_Offset); + -- Fetch available data on the socket + + ---------------- + -- Do_Receive -- + ---------------- + + procedure Do_Receive + (Socket : not null access Object'Class; + Data : out Ada.Streams.Stream_Element_Array; + Last : out Ada.Streams.Stream_Element_Offset) is + begin + Socket.Receive (Data, Last); + end Do_Receive; + + function Read_Message is new AWS.Net.WebSocket.Read_Message + (Receive => Do_Receive); + + Obj : Object_Class := Socket'Unrestricted_Access; + Event : AWS.Net.Event_Set; + Msg : Ada.Strings.Unbounded.Unbounded_String; + begin + Event := Socket.Poll + ((AWS.Net.Input => True, others => False), Timeout => Timeout); + + if Event (AWS.Net.Input) then + -- Block until we have received all chunks of the frame + while not Read_Message (Obj, Msg) loop + null; + end loop; + return True; + + elsif Event (AWS.Net.Error) then + Socket.On_Error ("Socket error"); + end if; + + return False; + + exception + when AWS.Net.Socket_Error => + -- Socket has been closed + return False; + end Poll; + ---------------------- -- Protocol_Version -- ---------------------- @@ -361,6 +484,7 @@ package body AWS.Net.WebSocket is Abnormal_Closure); On_Error (WebSocket); end if; + return True; end; @@ -371,7 +495,6 @@ package body AWS.Net.WebSocket is Translator.To_String (Data (Data'First .. Last))); if WebSocket.End_Of_Message then - -- Validate the message as being valid UTF-8 string if WebSocket.Kind = Text @@ -384,6 +507,7 @@ package body AWS.Net.WebSocket is WebSocket.On_Message (Message); On_Success (WebSocket); end if; + return True; end if; @@ -413,6 +537,7 @@ package body AWS.Net.WebSocket is On_Free (WebSocket); return True; end case; + return False; end Read_Message; diff --git a/src/core/aws-net-websocket.ads b/src/core/aws-net-websocket.ads index 9b945313c..ee6ad6f92 100644 --- a/src/core/aws-net-websocket.ads +++ b/src/core/aws-net-websocket.ads @@ -138,6 +138,46 @@ package AWS.Net.WebSocket is Error : Error_Type := Normal_Closure); -- Send a close frame to the WebSocket + -- + -- Client side + -- + + procedure Connect + (Socket : in out Object'Class; + URI : String); + -- Connect to a remote server using websockets. + -- Socket can then be used to Send messages to the server. It will + -- also receive data from the server, via the On_Message, when you call + -- Poll + + function Poll + (Socket : in out Object'Class; + Timeout : Duration) return Boolean; + -- Wait for up to Timeout seconds for some message. + -- + -- In the websockets protocol, a message can be split (by the server) + -- onto several frames, so that for instance the server doesn't have to + -- store the whole message in its memory. + -- The size of those frames, however, is not limited, and they will + -- therefore possibly be split into several chunks by the transport + -- layer. + -- + -- These function waits until it either receives a close or an error, or + -- the beginning of a message frame. In the latter case, the function + -- will then block until it has receives all chunks of that frame, which + -- might take longer than Timeout. + -- + -- The function will return early if it doesn't receive the beginning + -- of a frame within Timeout seconds. + -- + -- When a full frame has been received, it will be sent to the + -- Socket.On_Message primitive operation. Remember this might not be the + -- whole message however, and you should check Socket.End_Of_Message to + -- check. + -- + -- Return True if a message was processed, False if nothing happened during + -- Timeout. + -- -- Simple accessors to WebSocket state -- @@ -223,8 +263,6 @@ private end record; type Internal_State_Access is access Internal_State; - type HTTP_Connection_Access is access all AWS.Client.HTTP_Connection; - type Protocol_State; type Protocol_State_Access is access Protocol_State; @@ -238,14 +276,14 @@ private Mem_Sock : Net.Socket_Access; In_Mem : Boolean := False; - Connection : HTTP_Connection_Access; + Connection : AWS.Client.HTTP_Connection_Access; -- Only set when the web socket is initialized as a client. -- It is used to keep the connection open while the socket -- exists. end record; - function Is_Client_Side (Socket : Object'Class) return Boolean - is (Socket.Connection /= null); + function Is_Client_Side (Socket : Object'Class) return Boolean is + (AWS.Client."/=" (Socket.Connection, null)); -- True if this is a socket from client to server. Its messages -- then need to be masked. @@ -304,15 +342,15 @@ private No_Object : constant Object'Class := Object' (Net.Socket_Type with - Socket => null, - Id => No_UID, - Request => <>, - Version => 0, - State => null, - P_State => null, - Mem_Sock => null, + Socket => null, + Id => No_UID, + Request => <>, + Version => 0, + State => null, + P_State => null, + Mem_Sock => null, Connection => null, - In_Mem => False); + In_Mem => False); -- Error codes corresponding to all errors