cheddar_3.3.0_aea10b3c/ellidiss/sockets_overlay.adb

------------------------------------------------------------------------------
------------------------------------------------------------------------------
-- Cheddar is a GNU GPL real-time scheduling analysis tool.
-- This program provides services to automatically check schedulability and
-- other performance criteria of real-time architecture models.
--
-- Copyright (C) 2002-2023, Frank Singhoff, Alain Plantec, Jerome Legrand,
--                          Hai Nam Tran, Stephane Rubini
--
-- The Cheddar project was started in 2002 by
-- Frank Singhoff, Lab-STICC UMR CNRS 6285, Universite de Bretagne Occidentale
--
-- Cheddar has been published in the "Agence de Protection des Programmes/France" in 2008.
-- Since 2008, Ellidiss technologies also contributes to the development of
-- Cheddar and provides industrial support.
--
-- The full list of contributors and sponsors can be found in README.md
--
-- This program is free software; you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation; either version 2 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program; if not, write to the Free Software
-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
--
--
-- Contact : cheddar@listes.univ-brest.fr
--
------------------------------------------------------------------------------
-- Last update :
--    $Rev: 4589 $
--    $Date: 2023-09-29 16:02:19 +0200 (ven., 29 sept. 2023) $
--    $Author: singhoff $
------------------------------------------------------------------------------
------------------------------------------------------------------------------

with Ada.Streams;
with Ada.Streams.Stream_IO;

with Tasks;                             use Tasks;
with Systems;                           use Systems;
with task_set;                          use task_set;
with Resources;                         use Resources;
with Ada.Text_IO;                       use Ada.Text_IO;
with resource_set;                      use resource_set;
with GNAT.Sockets;                      use GNAT.Sockets;
with Marzhin_Utils;                     use Marzhin_Utils;
with Ada.Strings.Maps;                  use Ada.Strings.Maps;
with time_unit_events;                  use time_unit_events;
with Ada.Strings.Fixed;                 use Ada.Strings.Fixed;
with unbounded_strings;                 use unbounded_strings;
with Ada.Strings.Unbounded;             use Ada.Strings.Unbounded;
with Ada.Strings.Unbounded.Text_IO;     use Ada.Strings.Unbounded.Text_IO;
with Multiprocessor_Services_Interface; use Multiprocessor_Services_Interface;

use type Ada.Streams.Stream_Element_Count;
use type time_unit_events.time_unit_range;
use type Multiprocessor_Services_Interface.scheduling_table_range;

--#[debug]
with debug; use debug;

---------------------------------------------------------------------
-- Package Sockets_Overlay
-- Purpose: Contain types definitions, functions and procedures
--          usefull for sockets manipulations such as IO and configuration.
-- Extra: # Documentations on methods are puts in the specification file.
--        # AADLInspector related procedures could be factorized and
--          added to a new package `AADLInspector_Communication`.
---------------------------------------------------------------------
package body Sockets_Overlay is

   -- ASCII strings:
   LF   : constant Character := ASCII.LF;
   CRLF : constant String    := ASCII.CR & ASCII.LF;

   --------------------------------------
   -- Data_Communication --
   --------------------------------------

   procedure Data_Communication
     (Sys             : in     system;
      Result          : in     scheduling_table_ptr;
      J               : in     scheduling_table_range;
      Current_Time    : in     Natural;
      Last_Time_Mod   : in out Natural;
      SpeedFactor     : in     Duration;
      Speed           : in out Duration;
      Slice_Size      : in out Natural;
      Exit_Simulation : in out Boolean)
   is
      Event_XML          : Unbounded_String;
      Event_String       : Unbounded_String;
      Task_Id_String     : Unbounded_String;
      Message_To_Send    : Unbounded_String;
      Message_Received   : Unbounded_String;
      Resource_Id_String : Unbounded_String;
      Current_Task       : generic_task_ptr;
      Current_Resource   : generic_resource_ptr;
   begin
      -- For each scheduler entrey check the event entries at current time
      -- and construct the server response with current events data:
      for Current_Entry in 0 .. Result.entries (J).data.result.nb_entries - 1
      loop

         -- Check for arrival of a socket commmand:
         GNAT.Sockets.Set (Input_Set, Command_Socket);
         Check_Selector (Input_Selector, Input_Set, WSet, Input_Status, 0.0);
         if Input_Status = Completed then
            Current_Communication_State := running;
            Command_Communication
              (Slice_Size,
               Last_Time_Mod,
               Speed,
               SpeedFactor,
               Exit_Simulation);
            if Exit_Simulation then
               return;
            end if;
         end if;

         -- Process the time unit event data to be sent on socket:
         if Result.entries (J).data.result.entries (Current_Entry).item =
           Current_Time
         then
            -- Initialization value for current entry:
            Event_XML :=
              xml_string
                (Result.entries (J).data.result.entries (Current_Entry).data);
            Message_To_Send := To_Unbounded_String ("");

            -- Get the Cheddar's event name:
            Get_Event_String_From_XML (Event_XML, Event_String);

            -- Get the current resource of the event:
            if Is_Resource_Event (Event_String) then
               Get_Resource_Id_From_XML
                 (Event_XML,
                  Event_String,
                  Resource_Id_String);
               Current_Resource :=
                 search_resource_by_id (Sys.Resources, Resource_Id_String);
            end if;

            -- Get the task linked to the current event:
            Get_Task_Id_From_XML (Event_XML, Event_String, Task_Id_String);
            Current_Task := search_task_by_id (Sys.Tasks, Task_Id_String);

            -- Transform the Cheddar EventString to a Marzhin EventString:
            Set_To_Marzhin_Event (Event_String);

            -- Output the event on socket:
            Message_To_Send :=
              To_Marzhin_Output_Format
                (Current_Time,
                 Event_String,
                 Current_Task.name) &
              Message_To_Send;
            Write_Channel (Data_Channel, Message_To_Send & LF);
--#[debug]
            put_debug ("__DEBUG__ :: " & Message_To_Send & LF);

            -- Output resource event on socket (if exist):
            if Is_Resource_Event (Event_String) then
               Set_To_Marzhin_Resource_Event (Event_String);
               Message_To_Send :=
                 To_Marzhin_Output_Format
                   (Current_Time,
                    Event_String,
                    Current_Resource.name);
               Write_Channel (Data_Channel, Message_To_Send & LF);
--#[debug]
               put_debug ("__DEBUG__ :: " & Message_To_Send & LF);
            end if;
--#[debug]
            put_debug ("__DEBUG__ :: " & Event_XML);
         end if;
      end loop;

      -- Output end of tick event:
      Message_To_Send :=
        To_Marzhin_Output_Format
          (Current_Time,
           To_Unbounded_String ("PROCESS_END_TICK"),
           Current_Task.address_space_name);
      Write_Channel (Data_Channel, Message_To_Send & LF);
--#[debug]
      put_debug ("__DEBUG__ :: " & Message_To_Send & LF);

      delay Speed;
   end Data_Communication;

   -------------------
   -- Close_Sockets --
   -------------------

   procedure Close_Sockets is
   begin
      Close_Socket (Ack_Socket);
      Close_Socket (Data_Socket);
      Close_Socket (Command_Socket);
   end Close_Sockets;

   --------------------
   -- Connect_Socket --
   --------------------

   procedure Connect_Socket
     (Serv    : in out Socket_Type;
      Client  : in out Socket_Type;
      Addr    : in     Sock_Addr_Type;
      Channel : in out GNAT.Sockets.Stream_Access)
   is
   begin
      Listen_Socket (Serv);
      Accept_Socket (Serv, Client, Address);
      Channel := GNAT.Sockets.Stream (Client);
   end Connect_Socket;

   -----------------------
   -- Get_Command_Value --
   -----------------------

   function Get_Command_Value (Command : Unbounded_String) return String is
   begin
      return To_String
          (substring
             (Command,
              (Index (Command, "[") + 1),
              (Index (Command, "]") - 1)));
   end Get_Command_Value;

   -----------------------
   -- Initialize_Socket --
   -----------------------

   procedure Initialize_Socket
     (Address : in     Sock_Addr_Type;
      Serv    : in out Socket_Type)
   is
   begin
      Create_Socket (Serv);
      Set_Socket_Option (Serv, Socket_Level, (Reuse_Address, True));
      Bind_Socket (Serv, Address);
   end Initialize_Socket;

   ----------
   -- Read --
   ----------

   function Read
     (Client  : in out Socket_Type;
      Channel : in out Stream_Access) return Unbounded_String
   is
      -- Offset     : Ada.Streams.Stream_Element_Count;
      Buffer     : String (1 .. 256);
      Result     : Unbounded_String := To_Unbounded_String ("");
      Byte_Count : Natural;
   begin
      Byte_Count := 0;
      for Index in Buffer'range loop
         Byte_Count := Byte_Count + 1;
         Character'read (Channel, Buffer (Byte_Count));
         if Buffer (Byte_Count) = ASCII.LF then
            if Buffer (Byte_Count - 1) = ASCII.CR then
               Result := Result & Buffer (1 .. Byte_Count - 2);
               return Result;
            end if;
         end if;
      end loop;
      return Result;
   end Read;

   ------------------
   -- Read_Channel --
   ------------------

   procedure Read_Channel
     (Channel : in out GNAT.Sockets.Stream_Access;
      Data    :    out Unbounded_String)
   is
   -- Size : Integer;
   begin
      Data := To_Unbounded_String (String'input (Channel));
   end Read_Channel;

   ----------------------------
   -- Server_Start_Listening --
   ----------------------------

   procedure Server_Start_Listening
     (Addr    : in     String;
      Port    : in     Port_Type;
      Socket  : in out Socket_Type;
      Channel : in out GNAT.Sockets.Stream_Access)
   is
   begin
      Address.Addr := Inet_Addr (Addr);
      Address.Port := Port;
      Create_Socket (Server);
      Set_Socket_Option (Server, Socket_Level, (Reuse_Address, True));
      Bind_Socket (Server, Address);
      Listen_Socket (Server);
      Accept_Socket (Server, Socket, Address);

      Channel := GNAT.Sockets.Stream (Socket);
   end Server_Start_Listening;

   ------------------------
   -- Sockets_Initialize --
   ------------------------

   procedure Initialize_Sockets is
   begin
      Server_Start_Listening
        ("127.0.0.1",
         8902,
         Command_Socket,
         Command_Channel);
      put_debug ("__INFO__ :: Command socket connected.");
      Server_Start_Listening ("127.0.0.1", 8901, Data_Socket, Data_Channel);
      put_debug ("__INFO__ :: Data socket connected.");
      Server_Start_Listening ("127.0.0.1", 8903, Ack_Socket, Ack_Channel);
      put_debug ("__INFO__ :: Ack socket connected.");
      put_debug ("__INFO__ :: Waiting for simulation start...");

      Create_Selector (Input_Selector);
      Empty (Input_Set);
      Empty (WSet);
   end Initialize_Sockets;

   -----------------------------------------
   -- Command_Communication --
   -----------------------------------------

   procedure Command_Communication
     (Slice_Size      : in out Natural;
      Last_Time_Mod   : in out Natural;
      Speed           : in out Duration;
      SpeedFactor     : in     Duration;
      Exit_Simulation : in out Boolean)
   is
   begin
      case Current_Communication_State is
         when starting =>
            Command_Start_State_Communication
              (Slice_Size,
               Last_Time_Mod,
               Speed,
               SpeedFactor,
               Exit_Simulation);
         when running =>
            Command_Run_State_Communication
              (Slice_Size,
               Last_Time_Mod,
               Speed,
               SpeedFactor,
               Exit_Simulation);
         when ending =>
            Command_End_State_Communication
              (Slice_Size,
               Last_Time_Mod,
               Speed,
               SpeedFactor,
               Exit_Simulation);
         when others =>
            null;
      end case;
   end Command_Communication;

   -------------------------------
   -- Start_State_Communication --
   -------------------------------

   procedure Command_Start_State_Communication
     (Slice_Size      : in out Natural;
      Last_Time_Mod   : in out Natural;
      Speed           : in out Duration;
      SpeedFactor     : in     Duration;
      Exit_Simulation : in out Boolean)
   is
      Message_Received : Unbounded_String;
      Message_To_Send  : Unbounded_String;
   begin
      -- Initialization ended, waiting for a socket message:
      Message_Received :=
        Sockets_Overlay.Read (Command_Socket, Command_Channel);

      put_debug ("__INFO__ :: Message_Received:" & Message_Received);
      while (Index (Message_Received, "simulator play") <= 0) loop
         if (Index (Message_Received, "slice") > 0) then
            Slice_Size := Integer'value (Get_Command_Value (Message_Received));
            Last_Time_Mod := Slice_Size;
         elsif (Index (Message_Received, "speed") > 0) then
            Message_To_Send :=
              To_Unbounded_String ("Change time between tick OK :*");
            Write_Channel (Ack_Channel, Message_To_Send & Character'val (10));
            Speed :=
              SpeedFactor *
              Duration'value (Get_Command_Value (Message_Received));
         elsif (Index (Message_Received, "get_tasks_capacities") > 0) then
            put_debug ("__INFO__ :: Request for table of tasks capacities");
            -- Message_To_Send := Encode_Task_Capacities(Si);
         end if;
         Message_Received :=
           Sockets_Overlay.Read (Command_Socket, Command_Channel);
      end loop;
   end Command_Start_State_Communication;

   -----------------------------
   -- Run_State_Communication --
   -----------------------------

   procedure Command_Run_State_Communication
     (Slice_Size      : in out Natural;
      Last_Time_Mod   : in out Natural;
      Speed           : in out Duration;
      SpeedFactor     : in     Duration;
      Exit_Simulation : in out Boolean)
   is
      Message_Received : Unbounded_String;
      Message_To_Send  : Unbounded_String;
   begin
      Message_Received :=
        Sockets_Overlay.Read (Command_Socket, Command_Channel);
      if (To_String (Message_Received) = "simulator pause") then
         Message_To_Send := To_Unbounded_String ("pause OK");
         Write_Channel (Ack_Channel, Message_To_Send & Character'val (10));
         while (To_String (Message_Received) /= "simulator resume") loop
            Message_Received :=
              Sockets_Overlay.Read (Command_Socket, Command_Channel);
            if (Index (Message_Received, "slice") > 0) then
               Slice_Size :=
                 Integer'value (Get_Command_Value (Message_Received));
               Last_Time_Mod := Last_Time_Mod + Slice_Size;
            elsif (Index (Message_Received, "speed") > 0) then
               Message_To_Send :=
                 To_Unbounded_String ("Change time between tick OK :*");
               Write_Channel
                 (Ack_Channel,
                  Message_To_Send & Character'val (10));
               Speed :=
                 SpeedFactor *
                 Duration'value (Get_Command_Value (Message_Received));
            end if;
         end loop;
         Message_To_Send := To_Unbounded_String ("resume OK");
         Write_Channel (Ack_Channel, Message_To_Send & Character'val (10));
      elsif (Index (Message_Received, "slice") > 0) then
         Slice_Size    := Integer'value (Get_Command_Value (Message_Received));
         Last_Time_Mod := Last_Time_Mod + Slice_Size;
      elsif (Index (Message_Received, "speed") > 0) then
         Message_To_Send :=
           To_Unbounded_String ("Change time between tick OK :*");
         Write_Channel (Ack_Channel, Message_To_Send & Character'val (10));
         Speed :=
           SpeedFactor * Duration'value (Get_Command_Value (Message_Received));
      elsif To_String (Message_Received) = "simulator stop" then
         Exit_Simulation := True;
      end if;
   end Command_Run_State_Communication;

   -----------------------------
   -- End_State_Communication --
   -----------------------------

   procedure Command_End_State_Communication
     (Slice_Size      : in out Natural;
      Last_Time_Mod   : in out Natural;
      Speed           : in out Duration;
      SpeedFactor     : in     Duration;
      Exit_Simulation : in out Boolean)
   is
      Message_Received : Unbounded_String;
      Message_To_Send  : Unbounded_String;
   begin
      Message_Received :=
        Sockets_Overlay.Read (Command_Socket, Command_Channel);
      while (To_String (Message_Received) /= "simulator play") loop
         if (Index (Message_Received, "slice") > 0) then
            Slice_Size := Integer'value (Get_Command_Value (Message_Received));
         end if;
         if (Index (Message_Received, "speed") > 0) then
            Message_To_Send :=
              To_Unbounded_String ("Change time between tick OK :*");
            Write_Channel (Ack_Channel, Message_To_Send & Character'val (10));
            Speed :=
              SpeedFactor *
              Duration'value (Get_Command_Value (Message_Received));
         end if;
         if To_String (Message_Received) = "simulator stop" then
            Exit_Simulation := True;
         end if;
         exit when To_String (Message_Received) = "simulator stop";
         Message_Received :=
           Sockets_Overlay.Read (Command_Socket, Command_Channel);
      end loop;

      Last_Time_Mod := Last_Time_Mod + Slice_Size;
   end Command_End_State_Communication;

   -------------------
   -- Write_Channel --
   -------------------

   procedure Write_Channel
     (Channel : in out GNAT.Sockets.Stream_Access;
      Data    : in     Unbounded_String)
   is
   begin
      String'output (Channel, To_String (Data));
   end Write_Channel;

end Sockets_Overlay;