raw
smg_comms_genesis       1  -- S.MG, 2018
smg_comms_genesis       2  -- prototype implementation of S.MG communication protocol
smg_comms_genesis       3 
smg_comms_genesis       4 with GNAT.Sockets; use GNAT.Sockets;
smg_comms_genesis       5 with Ada.Text_IO; use Ada.Text_IO;
smg_comms_genesis       6 with Ada.Streams; use Ada.Streams;
smg_comms_genesis       7 with Interfaces; use Interfaces;
smg_comms_genesis       8 
smg_comms_genesis       9 with SMG_comms_types; use SMG_comms_types;
smg_comms_genesis      10 
smg_comms_genesis      11 procedure test_comms is
smg_comms_genesis      12   Port_No : constant := 2222;
smg_comms_genesis      13 
smg_comms_genesis      14   task type Client is
smg_comms_genesis      15     entry Send;
smg_comms_genesis      16   end Client;
smg_comms_genesis      17 
smg_comms_genesis      18   task type Server is
smg_comms_genesis      19     entry Listen;
smg_comms_genesis      20     entry Ready;
smg_comms_genesis      21   end Server;
smg_comms_genesis      22 
smg_comms_genesis      23   task body Client is
smg_comms_genesis      24     Sock: Socket_Type;
smg_comms_genesis      25     Address: Sock_Addr_Type;
smg_comms_genesis      26     Data: Ada.Streams.Stream_Element_Array(1..10) := (others => 42);
smg_comms_genesis      27     Last: Ada.Streams.Stream_Element_Offset;
smg_comms_genesis      28     N   : Integer_8 := -36;
smg_comms_genesis      29   begin
smg_comms_genesis      30     accept Send; -- task WILL block here until asked to send
smg_comms_genesis      31     Address.Port := Port_No;
smg_comms_genesis      32     Address.Addr := Inet_Addr("127.0.0.1");
smg_comms_genesis      33     Create_Socket(Sock, Family_Inet, Socket_Datagram);
smg_comms_genesis      34 
smg_comms_genesis      35     ToNetworkFormat( N, Data(1..1));
smg_comms_genesis      36 
smg_comms_genesis      37     Send_Socket(Sock, Data, Last, Address);
smg_comms_genesis      38     Put_Line("Client sent data " & "last: " & Last'Img);
smg_comms_genesis      39   end Client;
smg_comms_genesis      40 
smg_comms_genesis      41   task body Server is
smg_comms_genesis      42     Sock: Socket_Type;
smg_comms_genesis      43     Address, From: Sock_Addr_Type;
smg_comms_genesis      44     Data: Ada.Streams.Stream_Element_Array(1..512);
smg_comms_genesis      45     Last: Ada.Streams.Stream_Element_Offset;
smg_comms_genesis      46     N : Integer_8;
smg_comms_genesis      47   begin
smg_comms_genesis      48     accept Listen; -- wait to be started!
smg_comms_genesis      49     Put_Line("Server started!");
smg_comms_genesis      50     -- create UDP socket
smg_comms_genesis      51     Create_Socket( Sock, Family_Inet, Socket_Datagram );
smg_comms_genesis      52 
smg_comms_genesis      53     -- set options on UDP socket
smg_comms_genesis      54     Set_Socket_Option( Sock, Socket_Level, (Reuse_Address, True));
smg_comms_genesis      55     Set_Socket_Option( Sock, Socket_Level, (Receive_Timeout, Timeout => 10.0));
smg_comms_genesis      56 
smg_comms_genesis      57     -- set address and bind
smg_comms_genesis      58     Address.Addr := Any_Inet_Addr;
smg_comms_genesis      59     Address.Port := Port_No;
smg_comms_genesis      60     Bind_Socket( Sock, Address );
smg_comms_genesis      61 
smg_comms_genesis      62     accept Ready; -- server IS ready, when here
smg_comms_genesis      63     -- receive on socket
smg_comms_genesis      64     begin
smg_comms_genesis      65       Receive_Socket( Sock, Data, Last, From );
smg_comms_genesis      66       Put_Line("last: " & Last'Img);
smg_comms_genesis      67       Put_Line("from: " & Image(From.Addr));
smg_comms_genesis      68       Put_Line("data is:");
smg_comms_genesis      69       for I in Data'First .. Last loop
smg_comms_genesis      70         FromNetworkFormat(Data(I..I), N);
smg_comms_genesis      71         Put_Line(N'Image);
smg_comms_genesis      72       end loop;
smg_comms_genesis      73     exception
smg_comms_genesis      74       when Socket_Error =>
smg_comms_genesis      75       Put_Line("Socket error! (timeout?)");
smg_comms_genesis      76     end;  -- end of receive
smg_comms_genesis      77 
smg_comms_genesis      78   end Server;
smg_comms_genesis      79 
smg_comms_genesis      80   S: Server;
smg_comms_genesis      81   C: Client;
smg_comms_genesis      82 begin
smg_comms_genesis      83   S.Listen;
smg_comms_genesis      84   S.Ready; -- WAIT for server to be ready!
smg_comms_genesis      85   C.Send;  -- client is started only after server!
smg_comms_genesis      86 end test_comms;
smg_comms_genesis      87