ada/aws
0
0
Fork 0
mirror of https://github.com/AdaCore/aws.git synced 2026-02-12 12:29:46 -08:00
Code Issues Packages Projects Releases Wiki Activity

Add support for websocket clients

Browse Source
This commit is contained in:
Emmanuel Briot
2018-10-09 18:10:27 +02:00
parent 66d5ef1aec
commit 9bf04443ea
10 changed files with 318 additions and 28 deletions
Download Patch File Download Diff File Expand all files Collapse all files

40
docs/source/high_level_services.rst
View File

@@ -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
------------------------

2
makefile.conf
View File

@@ -121,7 +121,7 @@ LDAP = false
#
# DEBUG = [true|false]
#
DEBUG = false
DEBUG = true
##############################################################################
# Number of parallel compilations to do.

7
src/core/aws-client.ads
View File

@@ -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;

15
src/core/aws-net-websocket-protocol-draft76.adb
View File

@@ -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 --
--------------------

6
src/core/aws-net-websocket-protocol-draft76.ads
View File

@@ -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;

54
src/core/aws-net-websocket-protocol-rfc6455.adb
View File

@@ -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;

10
src/core/aws-net-websocket-protocol-rfc6455.ads
View File

@@ -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

15
src/core/aws-net-websocket-protocol.ads
View File

@@ -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;

133
src/core/aws-net-websocket.adb
View File

@@ -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;

64
src/core/aws-net-websocket.ads
View File

@@ -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