-- main is main file of main project written with Ada. -- Main is Copyright (C) 2025 Manuel De Girardi ;  -- -- 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 -- -- Date := 2025-09-28 12:41:51 ;  -- Version := 0.22.5a ;  with Gnat.Sockets; use Gnat.Sockets; with Ada.Task_Identification; use Ada.Task_Identification; with Gnat.Sha1; use Gnat; with Ada.Unchecked_Deallocation; with Text_Io; with Ada.Wide_Text_Io; use Ada.Wide_Text_Io; with Ada.Characters.Handling; use Ada.Characters.Handling; with Ada.Containers.Vectors; use Ada.Containers; with Ada.Calendar; with Ada.Calendar.Formatting; use Ada.Calendar; with Sky.Stock; with sky.Stocks_manager; with M.Accountant; with M.Balance; use Sky.Stock; use Sky.Stocks_manager; use M.Accountant; use M.Balance; with Ada.Calendar; use Ada.Calendar; with M.Errors; use M.Errors; with Ada.Strings.Wide_Fixed; use Ada.Strings.Wide_Fixed; use Ada.Strings; with M.Project; with Gnat.Directory_operations; use Gnat.Directory_operations; with Gnat.Directory_Operations.Iteration; use Gnat.Directory_Operations.Iteration; with gnat.os_lib; use Gnat; package body M.Servers is use Engineer; use Engineer.Classes; use Engineer.Classes.Abstract_Vectors; procedure Product_save(Product : in Product_Class;File : in out File_Type) is begin Put_Line(File, To_Wide_String(Product.Name.all)); Put_Line(To_Wide_String(Product.Name.all)); Put_Line(File, Product.Description.all); Put_Line(Product.Description.all); Put_Line(File, To_Wide_String(Product.Documentation.all)); Put_Line(To_Wide_String(Product.Documentation.all)); Put_Line(File, To_Wide_String(Fixed_Unit_Ht'Image(Product.Unit_HT))); Put_Line(To_Wide_String(Fixed_Unit_Ht'Image(Product.Unit_HT))); Put_Line(File, To_Wide_String(Fixed_Factor'Image(Product.TVA_Rate))); Put_Line(To_Wide_String(Fixed_Factor'Image(Product.TVA_Rate))); Put_Line(File, To_Wide_String(Fixed_Total'Image(Product.TVA))); Put_Line(To_Wide_String(Fixed_Total'Image(Product.TVA))); Put_Line(File, To_Wide_String(Fixed_Unit_TTC'Image(Product.Unit_TTC))); Put_Line(To_Wide_String(Fixed_Unit_TTC'Image(Product.Unit_TTC))); end Product_Save; procedure Product_Restore(Product : out Product_Class;File : in out File_Type) is begin Product.Name := new String ' (To_String(Get_Line(File))); Put_Line(To_Wide_String(Product.Name.all)); Product.Description := new Wide_String ' (Get_Line(File)); Put_Line(Product.Description.all); Product.Documentation := new String ' (To_String(Get_Line(File))); Put_Line(To_Wide_String(Product.Documentation.all)); Product.Unit_Ht := Fixed_Unit_Ht'Value(To_String(Get_Line(File))); Put_Line(To_Wide_String(Fixed_Unit_Ht'Image(Product.Unit_HT))); Product.TVA_Rate := Fixed_Factor'Value(To_String(Get_Line(File))); Put_Line(To_Wide_String(Fixed_Factor'Image(Product.TVA_Rate))); Product.TVA := Fixed_Total'Value(To_String(Get_Line(File))); Put_Line(To_Wide_String(Fixed_Total'Image(Product.TVA))); Product.Unit_TTC := Fixed_Unit_Ttc'Value(To_String(Get_Line(File))); Put_Line(To_Wide_String(Fixed_Unit_TTC'Image(Product.Unit_TTC))); end Product_Restore; procedure Game_Save is File : File_Type; begin Create(File, Out_File, "main_game.txt", Form => "WCEM=8"); if Current_Game.Count /= 0 then for I in 1..Current_Game.Count loop Product_Save(Current_Game.Products(I).all, File); end loop; end if; Close(File); end Game_Save; procedure Game_Restore is File : File_Type; begin Open(File, In_File, "main_game.txt", Form => "WCEM=8"); while not End_Of_File(File) loop declare Product : Product_Access := new Product_Class; begin Product_Restore(Product.all, File); Current_Game.Products(Current_Game.Count+1) := Product; Current_Game.Count := Current_Game.Count + 1; end; end loop; Close(File); exception when Name_Error => Put_Line("Products file : main_game.txt : not found."); raise; when End_Error => Close(File); end Game_Restore; function Equal_Command (Left, Right : Command_Record) return Boolean is begin return Left = Right; end Equal_Command; function Equal_Facture (Left, Right : Facture_Record) return Boolean is begin return Left = Right; end Equal_Facture; function Equal_Client (Left, Right : Client_Record) return Boolean is begin return Left = Right; end Equal_Client; subtype Command_Index is Positive; subtype facture_Index is Positive; subtype Client_Index is Positive; package Command_vectors is new Vectors (Command_Index, Command_Record, equal_Command); package Facture_Vectors is new Vectors (Facture_Index, Facture_Record, equal_Facture); package Client_Vectors is new Vectors (Client_Index, Client_Record, equal_Client); type Business_Manager; task type Console_Process(Business : access Business_Manager) is entry Add(Client : in out Client_Record; Command : in out Command_Record; Facture : in out Facture_Record; Success : out Boolean; Id_Transaction : out Natural); entry Delete(Client : in Client_Record; Success : out Boolean); entry Delete(Id_Transaction : in Natural; Success : out Boolean); entry Get(Id_Transaction : in Natural; Facture : out Facture_Record; Success : out Boolean); entry Paiement(Id_Transaction : in Natural); entry Message (Msg : in Wide_String); entry Receive (Wchar : in Wide_Character); entry Halt; end Console_Process; type Business_Manager is limited record Num_Deal : Natural := 0; Id_Transaction : Natural := 0; Commandes : Command_Vectors.Vector; Factures : Facture_Vectors.Vector; Clients : Client_Vectors.Vector; Console : Console_Process(Business_Manager'access); end record; task body Console_Process is begin loop select accept Get(Id_Transaction : in Natural; Facture : out Facture_Record; Success : out boolean) do Success := False; for F in 1..Facture_Vectors.Last_Index(Business.factures) loop declare E : constant facture_Record := Facture_Vectors.Element(Business.Factures, F); begin if E.Id_transaction = Id_Transaction then Facture := E; Success := True; end if; end; end loop; end Get; or accept Paiement(Id_Transaction : in Natural) do for F in 1..Facture_Vectors.Last_Index(Business.factures) loop declare E : facture_Record := Facture_Vectors.Element(Business.Factures, F); begin if E.Id_transaction = Id_Transaction then E.Payed := True; Facture_Vectors.Replace_element(Business.Factures, F, E); end if; end; end loop; for Cmd in 1..Command_Vectors.Last_Index(Business.Commandes) loop declare E : Command_Record := Command_Vectors.Element(Business.Commandes, Cmd); begin if E.Id_transaction = Id_Transaction then E.Payed := True; Command_Vectors.Replace_element(Business.Commandes, Cmd, E); end if; end; end loop; for F in 1..Client_Vectors.Last_Index(Business.Clients) loop declare E : Client_Record := Client_Vectors.Element(Business.Clients, F); begin if E.Id_transaction = Id_Transaction then E.Payed := True; Client_Vectors.Replace_element(Business.Clients, F, E); end if; end; end loop; end Paiement; or accept Delete(Id_Transaction : in Natural; Success : out Boolean) do Success := False; for C in 1..Client_Vectors.Last_Index(Business.Clients) loop declare E : constant Client_Record := Client_Vectors.Element(Business.Clients, C); begin if E.Id_transaction = Id_Transaction then for F in 1..Facture_Vectors.Last_Index(Business.factures) loop declare E : constant facture_Record := Facture_Vectors.Element(Business.Factures, F); begin if Client_record(E).Id_transaction = Id_Transaction then Facture_Vectors.delete(Business.Factures, F); end if; end; end loop; for cmd in 1..Command_Vectors.Last_Index(Business.Commandes) loop declare E : constant Command_Record := Command_Vectors.Element(Business.Commandes, cmd); begin if Client_record(E).Id_Transaction = Id_transaction then Command_Vectors.delete(Business.Commandes, cmd); end if; end; end loop; Client_Vectors.delete(Business.Clients, C); Success := True; end if; end; end loop; end Delete; or accept Add(Client : in out Client_Record; Command : in out Command_Record; Facture : in out Facture_Record; Success : out Boolean; Id_Transaction : out Natural) do Success := False; Client.Id_Transaction := Business.Id_Transaction + 1; Command.Id_Transaction := Business.Id_Transaction + 1; Facture.Id_Transaction := Business.Id_Transaction + 1; Business.Clients := Client_Vectors."&"(Business.Clients, Client); Business.Commandes := Command_Vectors."&"(Business.Commandes, Command); Business.Factures := Facture_Vectors."&"(Business.Factures, Facture); Success := True; Id_Transaction := Business.Id_Transaction + 1; Business.Id_Transaction := Business.Id_Transaction + 1; end Add; or accept Delete(Client : in Client_Record; Success : out Boolean) do Success := False; for C in 1..Client_Vectors.Last_Index(Business.Clients) loop declare E : constant Client_Record := Client_Vectors.Element(Business.Clients, C); begin if E = Client then for F in 1..Facture_Vectors.Last_Index(Business.factures) loop declare E : constant facture_Record := Facture_Vectors.Element(Business.Factures, F); begin if Client_record(E) = Client then Facture_Vectors.delete(Business.Factures, F); end if; end; end loop; for cmd in 1..Command_Vectors.Last_Index(Business.Commandes) loop declare E : constant Command_Record := Command_Vectors.Element(Business.Commandes, cmd); begin if Client_record(E) = Client then Command_Vectors.delete(Business.Commandes, cmd); end if; end; end loop; Client_Vectors.delete(Business.Clients, C); Success := True; end if; end; end loop; end Delete; or accept Message(Msg : in Wide_String) do New_Line; Put_Line(Msg); New_Line; end Message; or accept Receive (Wchar : in Wide_Character); or accept Halt; exit; end select; end loop; end Console_Process; Business : Business_Manager; task Main_Server is entry Initialize; entry Start; entry Stop; entry Halt; end Main_Server; task Products_Server is entry Initialize; entry Start; entry Stop; entry Halt; end Products_Server; task body Server is End_Of_Task : Boolean := False; Add : Gnat.sockets.Sock_Addr_Type; Socket : Socket_Type; begin accept Initialize; Products_Server.Initialize; Main_Server.Initialize; accept Start do Products_Server.Start; Main_Server.Start; end Start; loop select accept Initialize; or accept Standby(End_Of_Program : out Boolean) do End_Of_Program := End_Of_Task; end Standby; exit; or accept Start do Products_Server.Start; Main_Server.Start; end Start; or accept Stop; Add.Addr := Gnat.Sockets.Addresses (Gnat.Sockets.Get_Host_By_Name ("localhost"), 1); Add.Port := 1970; Gnat.sockets.Create_Socket (Socket); delay 0.1; Gnat.Sockets.Set_Socket_Option (Socket, Gnat.Sockets.Socket_Level, (Gnat.Sockets.Reuse_Address, True)); delay 0.1; Gnat.sockets.Connect_Socket (Socket, Add); delay 0.1; Sockets.Close_Socket(Socket); Main_Server.Stop; Add.Port := 1988; Gnat.sockets.Create_Socket (Socket); delay 0.1; Gnat.Sockets.Set_Socket_Option (Socket, Gnat.Sockets.Socket_Level, (Gnat.Sockets.Reuse_Address, True)); delay 0.1; Gnat.sockets.Connect_Socket (Socket, Add); delay 0.1; Sockets.Close_Socket(Socket); Products_Server.Stop; or accept Halt do End_Of_Task := True; Business.Console.halt; end Halt; Main_Server.Halt; Products_Server.Halt; exit; end select; end loop; end Server; procedure Ctrl_C_Procedure is Add : Gnat.sockets.Sock_Addr_Type; Socket : Socket_Type; begin Add.Addr := Gnat.Sockets.Addresses (Gnat.Sockets.Get_Host_By_Name ("localhost"), 1); Add.Port := 1970; Gnat.sockets.Create_Socket (Socket); delay 0.1; Gnat.Sockets.Set_Socket_Option (Socket, Gnat.Sockets.Socket_Level, (Gnat.Sockets.Reuse_Address, True)); delay 0.1; Gnat.sockets.Connect_Socket (Socket, Add); delay 0.1; Sockets.Close_Socket(Socket); Add.Port := 1988; Gnat.sockets.Create_Socket (Socket); delay 0.1; Gnat.Sockets.Set_Socket_Option (Socket, Gnat.Sockets.Socket_Level, (Gnat.Sockets.Reuse_Address, True)); delay 0.1; Gnat.sockets.Connect_Socket (Socket, Add); delay 0.1; Sockets.Close_Socket(Socket); Server.Halt; Put_Line("End of Ctrl_C_Process"); end Ctrl_C_Procedure; type Socket_Access is access all Socket_Type; task type Human_Thread_Server(Socket : Socket_Access) is entry Get_Id(Id : out Task_Id); end Human_Thread_Server; type Thread_server_Access is access Human_Thread_server; type Human_Thread_Server_Task is record Id : Task_Id := Null_Task_id; Thread_server : Thread_server_access; end record; type thread_server_Task_Access is access Human_Thread_Server_Task; -- task body Human_Thread_Server is -- type String_Access is access all String; -- Channel : constant Stream_Access := Stream(Socket.all); -- Logname : constant String_Access := new String ' ("webi"); -- Passwd : constant Gnat.sha1.Message_Digest := Sha1.Digest("webi"); -- Logged : Boolean := False; -- Logname_Input : String_Access; -- Passwd_Input : Gnat.Sha1.Message_Digest; -- Enregistrement : Enregistrement_Record; -- Bank_Info : Bank_Info_Type := Null_Card; -- Command : Command_Record; -- Index : Natural := 0; -- Facture : Facture_Record; -- Sum : Price_Type := 0.0; -- TVA : Price_Type := 0.0; -- Client : Client_Record; -- Bank_Card : Bank_Info_Type := Null_Card; -- Success : Boolean := False; -- Id_Transaction : Natural := 0; -- Step : Command_Enum := Null_item; -- File : File_Type; -- Payed : Boolean := False; -- begin -- accept Get_Id(Id : out Task_Id) do -- Id := Current_Task; -- end Get_Id;  -- Logname_input := new String ' (String'Input(Channel));  -- Passwd_Input := Sha1.Message_Digest'Input(Channel); -- if Logname_Input.all = Logname.all and -- Passwd_Input = Passwd then -- --Wide_Text_Io.Put_Line("Checking for user """ & Logname.all & """");  -- Logged := True; -- --Wide_Text_Io.Put_Line("Adduser for user """ & Logname.all & """"); -- end if;  -- Boolean'Output(Channel, Logged); -- Text_Io.Put_Line("Logged : " & Boolean'Image(Logged)); -- if Logged then -- Step := Command_Enum'Input(Channel); -- Put_Line("Step : " & To_Wide_String(Command_Enum'Image(Step))); -- case Step is -- when Cmd => -- Open(File, Append_File, "cmd.txt", Form=>"WCEM=8"); -- Put_Line(File, "Command: " & To_Wide_String(Formatting.Image(Clock))); -- Put_Line("Command: " & To_Wide_String(Formatting.Image(Clock))); -- begin -- Text_Io.Put_Line("Command..."); -- Enregistrement.coordonates.name := Wide_String'Input(Channel); -- Enregistrement.coordonates.Email := String'Input(Channel); -- Enregistrement.coordonates.Address := Wide_String'Input(Channel); -- Enregistrement.coordonates.Phone := String'Input(Channel); -- Enregistrement.Programs(1) := String'Input(Channel); -- Enregistrement.Programs(2) := String'Input(Channel); -- Enregistrement.Programs(3) := String'Input(Channel); -- Enregistrement.Programs(4) := String'Input(Channel); -- Enregistrement.Programs(5) := String'Input(Channel); -- Enregistrement.Programs(6) := String'Input(Channel); -- Enregistrement.Programs(7) := String'Input(Channel); -- Enregistrement.Programs(8) := String'Input(Channel); -- Enregistrement.Programs(9) := String'Input(Channel); -- Enregistrement.Programs(10) := String'Input(Channel); -- Enregistrement.Logicial.Objectif := Wide_String'Input(Channel); -- Enregistrement.Logicial.Motivations := Wide_String'Input(Channel); -- Enregistrement.Logicial.Objet := Wide_String'Input(Channel); -- Enregistrement.Logicial.Arguments := Wide_String'Input(Channel); -- New_Line; -- for Program in 1..5 loop -- declare -- Product : Product_Enum := Null_Item; -- begin -- Product := Product_Enum'Value(Enregistrement.Programs(Program)); -- if Product /= Null_Item then -- Command.Products(Product) := My_Prices(Product);  -- Index := Index + 1; -- end if; -- exception -- when others => -- null;  -- end; -- end loop; -- Text_Io.Put_Line("Prices..."); -- for Product in Product_Enum loop -- Command.Ht_Sum := Command.Ht_Sum + Command.Products(Product); -- end loop; -- for Product in Product_Enum loop -- Command.TVA := Command.TVA + Price_Type(Price_type(Command.Products(Product) / 100.0)) * 10.0; -- end loop; -- Text_Io.Put_Line("TVA..."); -- Command.TTC_Sum := Command.Ht_Sum + Command.Tva; -- Text_Io.Put_Line("Total..."); -- Natural'Output(Channel, Index); -- Text_Io.Put_Line("index..."); -- for Product in skywalker..Product_Enum'Pred(Null_Item) loop -- if Command.Products(Product) /= 0.0 then -- Product_enum'Output (Channel, Product); -- Price_Type 'Output(Channel, Command.Products(Product));  -- end if; -- end loop; -- Price_Type'Output(Channel, Command.Ht_Sum); -- Price_Type'Output(Channel, Command.TVA); -- Price_Type'Output(Channel, Command.TTC_Sum); -- Put_Line(File, "-----------------------------------------------------"); -- Put_Line(File, "-- --"); -- Put_Line(File, "-- NEW CLIENT --"); -- Put_Line(File, "-- --"); -- Put_Line(File, "-----------------------------------------------------"); -- Put_Line(File, Enregistrement.Coordonates.Name); -- Put_Line(File, To_Wide_String(Enregistrement.Coordonates.Email)); -- Put_Line(File, Enregistrement.Coordonates.Address); -- Put_Line(File, To_Wide_String(Enregistrement.Coordonates.Phone)); -- New_Line(File);  -- New_Line(File); -- Put_Line(File, Enregistrement.logicial.Objectif); -- Put_Line(File, Enregistrement.logicial.Motivations); -- Put_Line(File, Enregistrement.logicial.Objet); -- Put_Line(File, Enregistrement.logicial.Arguments); -- New_Line(File); -- for Product in Skywalker..Product_Enum'Pred(Null_Item) loop -- if Command.Products(Product) /= 0.0 then -- Put(File, To_Wide_String(Product_Enum'Image(Product)) & " : "); -- Put_Line(File, To_Wide_String(Price_Type 'image(Command.Products(Product))) & " euro ;");  -- end if; -- end loop; -- Put_Line(File, "Total HT : " & To_Wide_String(Price_Type'image(Command.Ht_Sum)) & " euro ; "); -- Put_Line(File, "Total TVA : " & To_Wide_String(Price_Type'image(Command.TVA)) & " euro ; "); -- Put_Line(File, "total TTC : " & To_Wide_String(Price_Type'image(Command.TTC_Sum)) & " euro "); -- Close(File); -- Command_Record(Facture) := Command;  -- Client := Client_Record(Facture); -- Business.Console.Add(Client, Command, Facture, Success, Id_transaction); -- if Success then -- if Id_Transaction /= 0 then -- Natural'Output(Channel, Id_Transaction); -- end if;  -- else -- Business.Console.Message("Client " & Client.Name & " not registered !"); -- -- Put_Line(Enregistrement.Coordonates.Name); -- -- Put_Line(To_Wide_String(Enregistrement.Coordonates.Email)); -- -- Put_Line(Enregistrement.Coordonates.Address); -- -- Put_Line(To_Wide_String(Enregistrement.Coordonates.Phone)); -- -- New_Line; -- -- for I in 1..5 loop -- -- Put_Line(To_Wide_String(Enregistrement.Programs(I))); -- -- end loop; -- -- New_Line; -- -- Put_Line(Enregistrement.logicial.Objectif); -- -- Put_Line(Enregistrement.logicial.Motivations); -- -- Put_Line(Enregistrement.logicial.Objet); -- -- Put_Line(Enregistrement.logicial.Arguments); -- -- New_Line; -- -- else -- -- Business.Console.Message("Client " & Client.Name & " deleted !"); -- -- end if;  -- end if; -- exception -- when Socket_Exception : Socket_Error =>  -- --Ada.Text_Io.Put_Line(Error_Type'Image(Resolve_Exception(Socket_Exception))); -- raise; -- when Host_Exception : Host_Error => -- --Ada.Text_Io.Put_Line(Error_Type'Image(Resolve_Exception(Host_Exception))); -- raise; -- when others =>  -- --Environment_Thread.Halt; -- --Text_Io.Put_Line("Human_Thread_Server : others exception environment halted.");  -- raise; -- end; -- when Paiement => -- Open(File, Append_File,"cmd.Txt", Form=>"WCEM=8"); -- Put_Line(File, "Paiement: "); -- Id_Transaction := Natural'Input(Channel); -- Put_Line(File, "Transaction No" & To_Wide_String(Natural'Image(Id_Transaction))); -- Business.Console.Get(Id_Transaction, Facture, success); -- if Success then -- Command := Command_Record(Facture); -- for Product in Skywalker..Product_Enum'Pred(Null_Item) loop -- if Command.Products(Product) /= 0.0 then -- Put(To_Wide_String(Product_Enum'Image(Product)) & " : "); -- Put_Line(To_Wide_String(Price_Type 'image(Command.Products(Product))) & " No ;");  -- Index := Index + 1; -- end if; -- end loop; -- Put_Line(File, "Total HT : " & To_Wide_String(Price_Type'image(Command.Ht_Sum)) & " euro. ; "); -- Put_Line(File, "Total TVA : " & To_Wide_String(Price_Type'image(Command.TVA)) & " euro. ; "); -- Put_Line(File, "total TTC : " & To_Wide_String(Price_Type'image(Command.TTC_Sum)) & " euro. "); -- -------------------------------------------------- -- -- Facture : -- --------------------------------------------------  -- Natural'Output(Channel, Index);  -- for Product in Skywalker..Product_Enum'Pred(Null_Item) loop -- if Command.Products(Product) /= 0.0 then -- Product_enum'Output (Channel, Product); -- Price_Type 'Output(Channel, Command.Products(Product));  -- end if; -- end loop; -- Price_Type'Output(Channel, Command.Ht_Sum); -- Price_Type'Output(Channel, Command.TVA); -- Price_Type'Output(Channel, Command.TTC_Sum);  -- declare -- Outvoice : OutVoice_Record; -- begin -- Outvoice.Account_Num := 707; -- Outvoice.Total_Ht := Fixed_Total(Command.Ht_Sum); -- Outvoice.Total_TVA := Fixed_Total(Command.TVA); -- Outvoice.Total_TTC := Fixed_Total(Command.TTC_Sum); -- Outvoice.Date := Clock; -- Charge(M.Balance.Balance, Outvoice, Payed); -- if Payed then -- Outvoice.Date := Clock; -- Outvoice.Account_Num := Outvoice.Accounting(1).Account_Num; -- Outvoice.voice_Num := M.Balance.Outvoice_Num + 1; -- M.Balance.Outvoice_Num := M.Balance.Outvoice_Num + 1; -- if Save(Outvoice, "charged.txt") then -- Add(Accounts, Outvoice); -- for Product in Skywalker..Product_Enum'Pred(Null_Item) loop -- if Command.Products(Product) /= 0.0 then -- declare -- Stock : Stock_Record; -- begin -- Move(To_Wide_String(Product_Enum'Image(Product)), stock.Name); -- Sky.Stocks_Manager.Remove_From_stock(Sky.Stocks_Manager.Hardware, Stock.Name, 1.0); -- end; -- end if; -- end loop; -- Outvoice := Null_Outvoice; -- end if; -- else -- Put_Line("bad Request in Get"); -- end if; -- end; -- end if; -- Close(File); -- when others => -- raise Program_Error; -- end case; -- --Environment_Thread.Halt; -- --Text_Io.Put_Line("Human_Thread_Server : environment halted."); -- Gnat.Sockets.Close_Socket(Socket.all); -- else -- Gnat.Sockets.Close_Socket (Socket.all); -- end if; -- exception -- when Constraint_Error => -- --Text_Io.Put_Line("Human_Thread_Server : Constraint_error"); -- Gnat.Sockets.Close_Socket(Socket.all); -- end Human_Thread_Server; Errno : Integer := 0; function System(Line : in String) return Integer; pragma Import (C, System, "system"); procedure Last_Planning (Obj : in Abstract_Access;Vector : in out Abstract_Vectors.Vector) is begin if Obj = null then return; end if; if Obj.all in Planning_Class then Vector := Vector & Obj; end if; if Abstract_Vectors.Length(Obj.Childs) /= 0 then for Child in 1..Abstract_Vectors.Length(Obj.Childs) loop declare E : constant Abstract_Access := Abstract_Vectors.Element(Obj.Childs, Abstract_Index(Child)); begin Last_Planning(E, Vector); end; end loop; end if; end last_Planning; task body Human_Thread_Server is type String_Access is access all String; Channel : constant Stream_Access := Stream(Socket.all); Logname : constant String_Access := new String ' ("webi"); Passwd : constant Gnat.sha1.Message_Digest := Sha1.Digest("webi"); Logged : Boolean := False; Logname_Input : String_Access; Passwd_Input : Gnat.Sha1.Message_Digest; Enregistrement : Enregistrement_Record; Bank_Info : Bank_Info_Type := Null_Card; Command : Command_Record; Index : Natural := 0; Facture : Facture_Record; Sum : Price_Type := 0.0; TVA : Price_Type := 0.0; Client : Client_Record; Bank_Card : Bank_Info_Type := Null_Card; Success : Boolean := False; Id_Transaction : Natural := 0; Step : Command_Enum := Null_item; File : File_Type; Payed : Boolean := False; Project_Name : Wide_String_Access; Filename : String_Access; Directory : String_Access; fullpath : String_Access; Version_Line : String_Access; Project_File : File_Type; Lib_Set : Wide_String_Set(255); Lib_Last : Natural := 0; Old_Pwd : Wide_String_Access; Errno : Integer := 0; Month_Count : Natural := 0; Done : String_Access; Buff : Engineer.Classes.Abstract_Access; begin accept Get_Id(Id : out Task_Id) do Id := Current_Task; end Get_Id; Logname_input := new String ' (String'Input(Channel)); Passwd_Input := Sha1.Message_Digest'Input(Channel); if Logname_Input.all = Logname.all and Passwd_Input = Passwd then --Wide_Text_Io.Put_Line("Checking for user """ & Logname.all & """");  Logged := True; --Wide_Text_Io.Put_Line("Adduser for user """ & Logname.all & """"); end if; Boolean'Output(Channel, Logged); if Logged then Step := Command_Enum'Input(Channel); case Step is when Cmd => begin Enregistrement.coordonates.name := Wide_String'Input(Channel); Enregistrement.coordonates.Email := String'Input(Channel); Enregistrement.coordonates.Address := Wide_String'Input(Channel); Enregistrement.coordonates.Phone := String'Input(Channel); Enregistrement.Programs(1) := String'Input(Channel); Enregistrement.Programs(2) := String'Input(Channel); Enregistrement.Programs(3) := String'Input(Channel); Enregistrement.Programs(4) := String'Input(Channel); Enregistrement.Programs(5) := String'Input(Channel); Enregistrement.Programs(6) := String'Input(Channel); Enregistrement.Programs(7) := String'Input(Channel); Enregistrement.Programs(8) := String'Input(Channel); Enregistrement.Programs(9) := String'Input(Channel); Enregistrement.Programs(10) := String'Input(Channel); Enregistrement.Logicial.Objectif := Wide_String'Input(Channel); Enregistrement.Logicial.Motivations := Wide_String'Input(Channel); Enregistrement.Logicial.Objet := Wide_String'Input(Channel); Enregistrement.Logicial.Arguments := Wide_String'Input(Channel); for Program in 1..Product_Enum'Pos(Product_Enum'Last) + 1 loop declare Product : Product_Enum := Null_Item; begin Product := Product_Enum'Value(Enregistrement.Programs(Program)); if Product /= Null_Item then Command.Products(Product) := My_Prices(Product); Index := Index + 1; end if; exception when others => null; end; end loop; -- for Program in Product_Enum'first..Product_Enum'Pred(Null_Item) loop -- declare -- Product : Product_Enum := Null_Item; -- begin -- Product := Product_Enum'Value(Enregistrement.Programs(Product_Enum'Pos(Program)+1)); -- if Product /= Null_Item then -- Command.Products(Product) := My_Prices(Product);  -- Index := Index + 1; -- end if; -- exception -- when others => -- null; -- end; -- end loop; for Product in Product_Enum loop Command.Ht_Sum := Command.Ht_Sum + Command.Products(Product); end loop; for Product in Product_Enum loop Command.TVA := Command.TVA + Price_Type(Price_type(Command.Products(Product) / 100.0)) * 10.0; end loop; Command.TTC_Sum := Command.Ht_Sum + Command.Tva; Natural'Output(Channel, Index); for Product in skywalker..Product_Enum'Pred(Null_Item) loop if Command.Products(Product) /= 0.0 then Product_enum'Output (Channel, Product); Price_Type 'Output(Channel, Command.Products(Product)); end if; end loop; Price_Type'Output(Channel, Command.Ht_Sum); Price_Type'Output(Channel, Command.TVA); Price_Type'Output(Channel, Command.TTC_Sum); Command_Record(Facture) := Command; Client := Client_Record(Facture); Business.Console.Add(Client, Command, Facture, Success, Id_transaction); if Success then if Id_Transaction /= 0 then Natural'Output(Channel, Id_Transaction); end if; -- else -- Business.Console.Message("Client " & Client.Name & " not registered !"); -- -- Put_Line(Enregistrement.Coordonates.Name); -- -- Put_Line(To_Wide_String(Enregistrement.Coordonates.Email)); -- -- Put_Line(Enregistrement.Coordonates.Address); -- -- Put_Line(To_Wide_String(Enregistrement.Coordonates.Phone)); -- -- New_Line; -- -- for I in 1..5 loop -- -- Put_Line(To_Wide_String(Enregistrement.Programs(I))); -- -- end loop; -- -- New_Line; -- -- Put_Line(Enregistrement.logicial.Objectif); -- -- Put_Line(Enregistrement.logicial.Motivations); -- -- Put_Line(Enregistrement.logicial.Objet); -- -- Put_Line(Enregistrement.logicial.Arguments); -- -- New_Line; -- -- else -- -- Business.Console.Message("Client " & Client.Name & " deleted !"); -- -- end if;  end if; exception when Socket_Exception : Socket_Error => --Ada.Text_Io.Put_Line(Error_Type'Image(Resolve_Exception(Socket_Exception))); raise; when Host_Exception : Host_Error => --Ada.Text_Io.Put_Line(Error_Type'Image(Resolve_Exception(Host_Exception))); raise; when others => --Environment_Thread.Halt; --Text_Io.Put_Line("Human_Thread_Server : others exception environment halted.");  raise; end; when Validation => Enregistrement := Enregistrement_Record'Input(Channel); Enregistrement_Record'Output(Channel, enregistrement); begin Id_Transaction := Natural'Input(Channel); Business.Console.Delete(Id_Transaction, Success); Enregistrement.coordonates.name := Wide_String'Input(Channel); Enregistrement.coordonates.Email := String'Input(Channel); Enregistrement.coordonates.Address := Wide_String'Input(Channel); Enregistrement.coordonates.Phone := String'Input(Channel); Enregistrement.Programs(1) := String'Input(Channel); Enregistrement.Programs(2) := String'Input(Channel); Enregistrement.Programs(3) := String'Input(Channel); Enregistrement.Programs(4) := String'Input(Channel); Enregistrement.Programs(5) := String'Input(Channel); Enregistrement.Programs(6) := String'Input(Channel); Enregistrement.Programs(7) := String'Input(Channel); Enregistrement.Programs(8) := String'Input(Channel); Enregistrement.Programs(9) := String'Input(Channel); Enregistrement.Programs(10) := String'Input(Channel); Enregistrement.Logicial.Objectif := Wide_String'Input(Channel); Enregistrement.Logicial.Motivations := Wide_String'Input(Channel); Enregistrement.Logicial.Objet := Wide_String'Input(Channel); Enregistrement.Logicial.Arguments := Wide_String'Input(Channel); ---------------------------------------------------------------- -- Create project -- ---------------------------------------------------------------- -- -- -- 1) Create project -- -- 2) Create planning -- -- 3) Calculate price -- -- 4) Create archive -- ---------------------------------------------------------------- -- Quickstart -- ---------------------------------------------------------------- project_name := new Wide_String ' (Enregistrement.Solution.Name(Index_Non_Blank(Enregistrement.Solution.Name)..Index_Non_Blank(Enregistrement.solution.Name, backward))); Version_Line := new string ' ("0.0.0r"); filename := new string ' (To_String(Project_Name.all & '-' & To_Wide_String(Version_line.all))); directory := new string ' (To_String(Enregistrement.coordonates.Name(Index_Non_Blank(Enregistrement.coordonates.Name)..Index_Non_Blank(Enregistrement.coordonates.Name, backward)))); fullpath := new string ' ("/var/www/html/" & Directory.all & "/" & filename.all & ".txt"); Buff := Engineer.Classes.Abstract_Vectors.Element(Engy.Terminal.Root.childs, 2); declare Planning : Engineer.Classes.Abstract_Access := new Planning_Class; Lasts_Planning : Vector; Last_Plan : Abstract_Access; Job : Engineer.Classes.Abstract_Access := new Job_Class; begin Create(project_file, out_file, Fullpath.all, Form => "WCEM=8"); Put_Line(Project_File, Enregistrement.Solution.Axiomatic(Index_Non_Blank(Enregistrement.Solution.Axiomatic)..Natural'Min(Wide_Fixed.Index_Non_blank(Enregistrement.Solution.Axiomatic, backward), 80))); New_Line(Project_File); Put_Line(Project_File, Project_Name.all); Put_Line(Project_File, Project_Name.all); Month_Count := Method_Enum'Pos(Enregistrement.Solution.Method) + Boolean'Pos(Enregistrement.Solution.Contexts(Context_Enum'First)) + Boolean'Pos(Enregistrement.Solution.Contexts(Gtk)) + Boolean'Pos(Enregistrement.Solution.Contexts(Assemblage)) + Boolean'Pos(Enregistrement.Solution.Contexts(SQL)) + Boolean'Pos(Enregistrement.Solution.ints(Cmd_line)) + Boolean'Pos(Enregistrement.Solution.ints(Win)) + Boolean'Pos(Enregistrement.Solution.ints(Network)) + Boolean'Pos(Enregistrement.Solution.ints(html)); Last_Planning(Engy.Terminal.root, Lasts_Planning); if not Is_Empty(Lasts_Planning) then Date_Sorting.Sort(Lasts_Planning); end if; if not (Length(Lasts_Planning) = 0) then Last_Plan := Last_Element(Lasts_Planning); Planning.Info.Created := Clock; Planning.Info.index := Abstract_Index(buff.Info.Childs_Num) + 1; Planning.Info.Name := new Wide_String ' (To_Wide_String(Filename.all)); Planning_Class(Planning.all).From := Time_Of(Year(Planning_Class(Last_Plan.all).to), Month(Planning_Class(Last_Plan.all).To) + 2, 05, 43200.0); Planning_Class(Planning.all).To := Planning_Class(Planning.all).From + (86400.0 * 30.0 * Duration(Month_Count + 1)); else Planning.Info.Created := Clock; Planning.Info.index := Abstract_Index(buff.Info.Childs_Num) + 1; Planning.Info.Name := new Wide_String ' (To_Wide_String(Filename.all)); Planning_Class(Planning.all).From := Time_Of(Year(Clock), Month(clock) + 2, 05, 43200.0); Planning_Class(Planning.all).To := Planning_Class(Planning.all).From + (86400.0 * 30.0 * Duration(Month_Count + 1)); end if; Job.Info.Created := Clock; Job.Info.Name := new Wide_String ' ("Planning"); Job.Date := Planning_Class(Planning.all).From + 3600.0; Job.Period := 43200.0; Job.Locality := new Wide_String ' (Project_Name(Project_Name'First..Natural'min(Project_Name'Length, 16))); Job.Define := new wide_String ' (Enregistrement.Solution.Name(Index_Non_Blank(Enregistrement.Solution.Name)..Natural'min(Index_Non_Blank(Enregistrement.Solution.Name, Backward), 16))); Job.Info.Index := 1; Planning.Childs := Planning.Childs & Job; Buff.Childs := Engineer.Classes.Abstract_Vectors."&"(Buff.Childs, Planning); buff.Info.Childs_Num := buff.Info.Childs_Num + 1; Command.Products(Null_item) := Price_type(Month_Count) * 16000.0 + (Solution_Enum'Pos(Enregistrement.Solution.Formule) +1) * 16000.0; Index := Index + 1; --------------------------------------------------------- -- Elements -- --------------------------------------------------------- --------------------------------------------------------- -- Solution -- --------------------------------------------------------- --------------------------------------------------------- -- -- --------------------------------------------------------- -- -- --------------------------------------------------------- --------------------------------------------------------- -- -- --------------------------------------------------------- -- Common libraries -- --------------------------------------------------------- Add_Line(Lib_Set, Lib_Last, "org"); Add_Line(Lib_Set, Lib_Last, "org-errors"); Add_Line(Lib_Set, Lib_Last, "org-versions"); Add_Line(Lib_Set, Lib_Last, "org-versions-version_io"); Add_Line(Lib_Set, Lib_Last, "org-parameters"); Add_Line(Lib_Set, Lib_Last, "org-options"); Add_Line(Lib_Set, Lib_Last, "org-interfaces"); Add_Line(Lib_Set, Lib_Last, "org-strings"); if Enregistrement.Solution.Ints(win) then if Enregistrement.Solution.Contexts(Gtk) then Add_Line(Lib_Set, Lib_Last, "org-gtk_widgets"); Add_Line(Lib_Set, Lib_Last, "org-gtk_applications"); else Add_Line(Lib_Set, Lib_Last, "org-ansi"); Add_Line(Lib_Set, Lib_Last, "org-ansi-console"); Add_Line(Lib_Set, Lib_Last, "org-ansi-windows"); Add_Line(Lib_Set, Lib_Last, "org-windows"); Add_Line(Lib_Set, Lib_Last, "org-styles"); end if; end if; Add_Line(Lib_Set, Lib_Last, "org-center"); Add_Line(Lib_Set, Lib_Last, "org-" & Enregistrement.Solution.Name(Index_Non_Blank(Enregistrement.Solution.Name)..Index_Non_Blank(Enregistrement.solution.Name, backward))); --------------------------------------------------------- -- -- -- Libraries constructor -- -- -- --------------------------------------------------------- -- -- --------------------------------------------------------- -- -- Writting libraries -- for Line in 1..Lib_Set.Line_Last loop Put_Line(Project_File, Lib_Set.Lines(Line).all); end loop; -- --------------------------------------------------------- Set_Free(Lib_Set); New_Line(Project_File); Put_Line(Project_File, To_Wide_String(Version_Line.all)); Put_Line(Project_File, To_Wide_String(Directory.all)); Close(project_file); -- Add to project. exception when others => null; end; ---------------------------------------------------------------- -- -- ---------------------------------------------------------------- -- End Create project -- ---------------------------------------------------------------- for Program in 1..10 loop declare Product : Product_Enum := Null_Item; begin Product := Product_Enum'Value(Enregistrement.Programs(Program)); if Product /= Null_Item then Command.Products(Product) := My_Prices(Product); Index := Index + 1; end if; exception when others => null; end; end loop; -- for Program in Product_Enum'first..Product_Enum'Pred(Null_Item) loop -- declare -- Product : Product_Enum := Null_Item; -- begin -- Product := Product_Enum'Value(Enregistrement.Programs(Product_Enum'Pos(Program)+1)); -- if Product /= Null_Item then -- Command.Products(Product) := My_Prices(Product);  -- Index := Index + 1; -- end if; -- exception -- when others => -- null; -- end; -- end loop; for Product in Product_Enum loop Command.Ht_Sum := Command.Ht_Sum + Command.Products(Product); end loop; for Product in Product_Enum loop Command.TVA := Command.TVA + Price_Type(Price_type(Command.Products(Product) / 100.0)) * 10.0; end loop; Command.TTC_Sum := Command.Ht_Sum + Command.Tva; Natural'Output(Channel, Index); for Product in skywalker..Null_Item loop if Command.Products(Product) /= 0.0 then Product_enum'Output (Channel, Product); Price_Type 'Output(Channel, Command.Products(Product)); end if; end loop; Price_Type'Output(Channel, Command.Ht_Sum); Price_Type'Output(Channel, Command.TVA); Price_Type'Output(Channel, Command.TTC_Sum); Old_Pwd := new Wide_String ' (To_wide_String(Os_Lib.Getenv("PWD").all)); Change_Dir("/var/www/html/" & Directory.all); Errno := System("/usr/bin/bash -c ""/home/manuel/.bin/quickstart.sh " & fullpath.all & " " & To_String(Project_Name.all) & " " & Version_line.all & """" & Character'Val(0)); Errno := System("cp -ar /var/www/html/" & Directory.all & '/' & Filename.all & " /home/manuel/devel/" & Character'Val(0)); Open(File, Append_File, "/home/manuel/devel/Projects.lst", Form =>"WCEM=8"); Put_Line(File, To_Wide_String(Filename.all & ' ' & Long_Float'Image(0.0))); Close(File); Change_Dir(To_String(Old_Pwd.all)); Open(File, Append_File, "cmd.txt", Form=>"WCEM=8"); Put_Line(File, "-----------------------------------------------------"); Put_Line(File, "-- --"); Put_Line(File, "-- NEW CLIENT --"); Put_Line(File, "-- --"); Put_Line(File, "-----------------------------------------------------"); Put_Line(File, Enregistrement.Coordonates.Name); Put_Line(File, To_Wide_String(Enregistrement.Coordonates.Email)); Put_Line(File, Enregistrement.Coordonates.Address); Put_Line(File, To_Wide_String(Enregistrement.Coordonates.Phone)); New_Line(File); New_Line(File); Put_Line(File, Enregistrement.logicial.Objectif); Put_Line(File, Enregistrement.logicial.Motivations); Put_Line(File, Enregistrement.logicial.Objet); Put_Line(File, Enregistrement.logicial.Arguments); Put_Line(File, Enregistrement.Solution.name); Put_Line(File, Enregistrement.Solution.Axiomatic); Put_Line(File, To_Wide_String(Solution_Enum'Image(Enregistrement.Solution.Formule))); if Enregistrement.Solution.Formule = Carte then for I in Enregistrement.Solution.Forfaits'Range loop if Enregistrement.Solution.Forfaits(I) then Put_Line(File, To_Wide_String(Forfait_Enum'Image(I))); end if; end loop; end if; Put_Line(File, To_Wide_String(Method_Enum'Image(Enregistrement.Solution.Method))); for I in Enregistrement.Solution.Contexts'Range loop if Enregistrement.Solution.Contexts(I) then Put_Line(File, To_Wide_String(Context_Enum'Image(I))); end if; end loop; Put_Line(File, To_Wide_String(Process_Enum'Image(Enregistrement.Solution.Process))); for I in Enregistrement.Solution.ints'Range loop if Enregistrement.Solution.ints(I) then Put_Line(File, To_Wide_String(Int_Enum'Image(I))); end if; end loop; New_Line(File); put_line(File, "Filename : " & To_Wide_String(Filename.all)); put_line(File, "Project Name : " & Project_Name.all); put_line(File, "Version : " & To_Wide_String(Version_line.all)); for Product in Skywalker..Null_Item loop if Command.Products(Product) /= 0.0 then Put(File, To_Wide_String(Product_Enum'Image(Product)) & " : "); Put_Line(File, To_Wide_String(Price_Type 'image(Command.Products(Product))) & " euro"); end if; end loop; Put_Line(File, "Total HT : " & To_Wide_String(Price_Type'image(Command.Ht_Sum)) & " euro "); Put_Line(File, "Total TVA : " & To_Wide_String(Price_Type'image(Command.TVA)) & " euro "); Put_Line(File, "total TTC : " & To_Wide_String(Price_Type'image(Command.TTC_Sum)) & " euro "); Command_Record(Facture) := Command; Client := Client_Record(Facture); Business.Console.Add(Client, Command, Facture, Success, Id_transaction); if Success then Done := new String '(String'Input(Channel)); if Id_Transaction /= 0 then Natural'Output(Channel, Id_Transaction); Put_Line(File, "Transaction No" & To_Wide_String(Natural'Image(Id_Transaction))); end if; -- else -- Business.Console.Message("Client " & Client.Name & " not registered !"); -- -- Put_Line(Enregistrement.Coordonates.Name); -- -- Put_Line(To_Wide_String(Enregistrement.Coordonates.Email)); -- -- Put_Line(Enregistrement.Coordonates.Address); -- -- Put_Line(To_Wide_String(Enregistrement.Coordonates.Phone)); -- -- New_Line; -- -- for I in 1..5 loop -- -- Put_Line(To_Wide_String(Enregistrement.Programs(I))); -- -- end loop; -- -- New_Line; -- -- Put_Line(Enregistrement.logicial.Objectif); -- -- Put_Line(Enregistrement.logicial.Motivations); -- -- Put_Line(Enregistrement.logicial.Objet); -- -- Put_Line(Enregistrement.logicial.Arguments); -- -- New_Line; -- -- else -- -- Business.Console.Message("Client " & Client.Name & " deleted !"); -- -- end if;  end if; Close(File); exception when Socket_Exception : Socket_Error => --Ada.Text_Io.Put_Line(Error_Type'Image(Resolve_Exception(Socket_Exception))); raise; when Host_Exception : Host_Error => --Ada.Text_Io.Put_Line(Error_Type'Image(Resolve_Exception(Host_Exception))); raise; when others => --Environment_Thread.Halt; --Text_Io.Put_Line("Human_Thread_Server : others exception environment halted.");  raise; end; when Paiement => Open(File, Append_File,"cmd.txt", Form=>"WCEM=8"); Put_Line(File, "Paiement: "); Id_Transaction := Natural'Input(Channel); Put_Line(File, "Transaction No" & To_Wide_String(Natural'Image(Id_Transaction))); Business.Console.Get(Id_Transaction, Facture, success); if Success then Command := Command_Record(Facture); for Product in Skywalker..Null_Item loop if Command.Products(Product) /= 0.0 then Put(To_Wide_String(Product_Enum'Image(Product)) & " : "); Put_Line(To_Wide_String(Price_Type 'image(Command.Products(Product))) & " euro"); Index := Index + 1; end if; end loop; -------------------------------------------------- -- Facture : --------------------------------------------------  Natural'Output(Channel, Index); for Product in Skywalker..Null_Item loop if Command.Products(Product) /= 0.0 then Product_enum'Output (Channel, Product); Price_Type 'Output(Channel, Command.Products(Product)); end if; end loop; Price_Type'Output(Channel, Command.Ht_Sum); Price_Type'Output(Channel, Command.TVA); Price_Type'Output(Channel, Command.TTC_Sum); declare Outvoice : OutVoice_Record; begin Outvoice.Account_Num := 707; Outvoice.Total_Ht := Fixed_Total(Command.Ht_Sum); Outvoice.Total_TVA := Fixed_Total(Command.TVA); Outvoice.Total_TTC := Fixed_Total(Command.TTC_Sum); Outvoice.Date := Clock; Charge(M.Balance.Balance, Outvoice, Payed); if Payed then Outvoice.Date := Clock; Outvoice.Account_Num := 707; Outvoice.voice_Num := M.Balance.Outvoice_Num + 1; M.Balance.Outvoice_Num := M.Balance.Outvoice_Num + 1; if Save(Outvoice, "charged.txt") then Add(Accounts, Outvoice); for Product in Skywalker..Null_Item loop if Command.Products(Product) /= 0.0 then declare Stock : Stock_Record; begin Move(To_Wide_String(Product_Enum'Image(Product)), stock.Name); Sky.Stocks_Manager.Remove_From_stock(Sky.Stocks_Manager.Hardware, Stock.Name, 1.0); end; end if; end loop; Outvoice := Null_Outvoice; end if; else Put_Line("bad Request in Get"); end if; end; end if; Close(File); when others => raise Program_Error; end case; -- Open(File, Append_File,"cmd.Txt", Form=>"WCEM=8"); -- Put_Line(File, "Paiement: "); -- Id_Transaction := Natural'Input(Channel); -- Put_Line(File, "Transaction No" & To_Wide_String(Natural'Image(Id_Transaction))); -- Business.Console.Get(Id_Transaction, Facture, success); -- if Success then -- Command := Command_Record(Facture); -- for Product in Skywalker..Product_Enum'Pred(Null_Item) loop -- if Command.Products(Product) /= 0.0 then -- Put(To_Wide_String(Product_Enum'Image(Product)) & " : "); -- Put_Line(To_Wide_String(Price_Type 'image(Command.Products(Product))) & " euro");  -- Index := Index + 1; -- end if; -- end loop; -- Put_Line(File, "Total HT : " & To_Wide_String(Price_Type'image(Command.Ht_Sum)) & " euro "); -- Put_Line(File, "Total TVA : " & To_Wide_String(Price_Type'image(Command.TVA)) & " euro "); -- Put_Line(File, "total TTC : " & To_Wide_String(Price_Type'image(Command.TTC_Sum)) & " euro. "); -- -------------------------------------------------- -- -- Facture : -- --------------------------------------------------  -- Natural'Output(Channel, Index);  -- for Product in Skywalker..Product_Enum'Pred(Null_Item) loop -- if Command.Products(Product) /= 0.0 then -- Product_enum'Output (Channel, Product); -- Price_Type 'Output(Channel, Command.Products(Product));  -- end if; -- end loop; -- Price_Type'Output(Channel, Command.Ht_Sum); -- Price_Type'Output(Channel, Command.TVA); -- Price_Type'Output(Channel, Command.TTC_Sum);  -- else -- Put_Line("bad Request in Get"); -- end if; -- Close(File); -- when others => -- raise Program_Error; -- end case; --Environment_Thread.Halt; --Text_Io.Put_Line("Human_Thread_Server : environment halted."); Gnat.Sockets.Close_Socket(Socket.all); else Gnat.Sockets.Close_Socket (Socket.all); end if; exception when Constraint_Error => --Text_Io.Put_Line("Human_Thread_Server : Constraint_error"); Gnat.Sockets.Close_Socket(Socket.all); end Human_Thread_Server; procedure Unchecked_Deallocation_thread_server is new Ada.Unchecked_Deallocation(Human_Thread_Server,thread_server_Access); procedure Unchecked_Deallocation_thread_server_task is new Ada.Unchecked_Deallocation(Human_Thread_Server_Task,thread_server_Task_Access); task body Main_Server is Max_Client : constant Positive := 500; Liste : array(1..Max_Client) of Socket_access; Liste_Thread_task : array(1..Max_Client) of Thread_Server_Task_Access; Bliste : array(1..Max_Client) of Boolean; Reads,Write : Socket_Set_Type; Selector : Selector_Type; Srv_Adr,Adr : Sock_Addr_Type; Srv_Socket : Socket_Type; Status : Selector_Status; Ptr : Integer := 0; function Chercher return Natural is begin for I in 1..Max_Client loop if Liste_Thread_Task(I) = null then return I; elsif not Is_callable(Liste_Thread_Task(I).Id) or Is_terminated(Liste_Thread_Task(I).Id) then Unchecked_Deallocation_Thread_Server(Liste_Thread_Task(I).Thread_Server); Unchecked_Deallocation_Thread_Server_Task(Liste_Thread_Task(I)); Liste_Thread_Task(I) := null; Liste(I) := new Socket_Type; return I; end if; end loop; return 0; end Chercher; Thread_Suivant : Natural := 0; End_Of_Task : Boolean := False; Run : Boolean := False; begin accept Initialize; for I in 1..Max_Client loop liste(I) := new Socket_Type; end loop; Text_Io.Put_Line("Server initialize sockets..."); Bliste := (others => False); Srv_Adr.Addr := Any_Inet_Addr; Srv_Adr.Port := 1970; Create_Socket(Srv_Socket); Set_Socket_Option (Srv_Socket, Socket_Level, (Reuse_Address, True)); delay 0.2; Bind_Socket(Srv_Socket,Srv_Adr); Listen_Socket(Srv_Socket); Create_Selector(Selector); while not End_Of_Task loop loop select accept Initialize; or accept Start; exit; or accept Stop; or accept Halt do End_Of_Task := True; end Halt; exit; end select; end loop; Text_Io.Put_Line("Server sockets initialized."); while not End_Of_Task loop select accept Initialize; or accept Start; or accept Stop; exit; or accept Halt do End_Of_Task := True; end Halt; exit; or delay 0.0; Empty(Reads); Set(Reads,Srv_Socket); for I in 1..Max_Client loop if Bliste(I) then Set(Reads, Liste(I).all); end if; end loop; Check_Selector(Selector, Reads, Write, Status); case Status is when Completed => if Is_Set(Reads,Srv_Socket) then Thread_Suivant := Chercher; if Thread_Suivant /= 0 then Ptr := Thread_Suivant; --Text_Io.Put_Line("Server accept"); Accept_Socket(Srv_Socket, Liste(Ptr).all, Adr); --Text_Io.Put_Line("Server accepted"); -- Set_Socket_Option -- (Liste(Ptr).all, -- Socket_Level, -- (Reuse_Address, True)); select accept Halt do End_Of_Task := True; end Halt; exit; or accept Stop; exit; or delay 2.0; end select; Bliste(Ptr) := True; else delay 1.0; -- Text_Io.Put_Line("Client suivant = zero "); -- select -- accept Halt;  -- --Ptr := Chercher; -- exit; -- or delay 2.0; -- end select; end if; else for I in 1..Max_Client loop if bliste(I) then if Is_Set(Reads,Liste(I).all) then Liste_Thread_Task(I) := new Human_Thread_Server_Task; Liste_Thread_Task(I).Thread_Server := new Human_Thread_Server(Liste(i)); Liste_Thread_Task(i).Thread_Server.Get_Id(Liste_Thread_Task(i).Id); Bliste(i) := false; end if; end if; end loop; end if; when Expired => Text_Io.Put_Line("expired"); when Aborted => Text_Io.Put_Line("aborted"); end case; end select; end loop; end loop; Put_Line("Main server halted"); end Main_Server; -------------------------------------------------------------------------------------- -- Products server -- -------------------------------------------------------------------------------------- -- -- Products server is products server for web gate. -- -- Version : 1.0.0 -- Date : 2025-06-25 12:00:00 -- task type Products_Thread_Server(Socket : Socket_Access) is entry Get_Id(Id : out Task_Id); end Products_Thread_Server; type Products_server_Access is access Products_Thread_server; type Products_Thread_Server_Task is record Id : Task_Id := Null_Task_id; Thread_server : Products_server_access; end record; type Products_server_Task_Access is access Products_Thread_Server_Task; task body Products_Thread_Server is type String_Access is access all String; Channel : constant Stream_Access := Stream(Socket.all); Logtype : String_Access; begin accept Get_Id(Id : out Task_Id) do Id := Current_Task; end Get_Id; delay 0.2; Logtype := new String ' (String'Input(Channel)); if Logtype.all = "Products" then delay 0.2; Natural'Output(Channel, Current_Game.Count); delay 0.2; if Current_Game.Count /= 0 then for I in 1..Current_Game.Count loop Wide_String'Output(Channel, To_Wide_String(Current_Game.Products(I).Name.all)); Wide_String'Output(Channel, Current_Game.Products(I).Description.all); Wide_String'Output(Channel, To_Wide_String(Current_Game.Products(I).Documentation.all)); Fixed_Unit_Ht'Output(Channel, Current_Game.Products(I).Unit_Ht); Fixed_Factor'Output(Channel, Current_Game.Products(I).TVA_Rate); Fixed_Total'Output(Channel, Current_Game.Products(I).TVA); Fixed_Unit_Ttc'Output(Channel, Current_Game.Products(I).Unit_TTC); delay 0.1; end loop; end if; Gnat.Sockets.Close_Socket(Socket.all); else Gnat.Sockets.Close_Socket (Socket.all); end if; end Products_Thread_Server; procedure Unchecked_Deallocation_Products_server is new Ada.Unchecked_Deallocation(Products_Thread_Server, Products_server_Access); procedure Unchecked_Deallocation_Products_server_task is new Ada.Unchecked_Deallocation(Products_Thread_Server_Task, Products_server_Task_Access); task body Products_Server is Max_Client : constant Positive := 500; Liste : array(1..Max_Client) of Socket_access; Liste_Thread_task : array(1..Max_Client) of Products_Server_Task_Access; Bliste : array(1..Max_Client) of Boolean; Reads,Write : Socket_Set_Type; Selector : Selector_Type; Srv_Adr,Adr : Sock_Addr_Type; Srv_Socket : Socket_Type; Status : Selector_Status; Ptr : Integer := 0; function Chercher return Natural is begin for I in 1..Max_Client loop if Liste_Thread_Task(I) = null then return I; elsif not Is_callable(Liste_Thread_Task(I).Id) or Is_terminated(Liste_Thread_Task(I).Id) then Unchecked_Deallocation_Products_Server(Liste_Thread_Task(I).Thread_Server); Unchecked_Deallocation_Products_Server_Task(Liste_Thread_Task(I)); Liste_Thread_Task(I) := null; Liste(I) := new Socket_Type; return I; end if; end loop; return 0; end Chercher; Thread_Suivant : Natural := 0; End_Of_Task : Boolean := False; Run : Boolean := False; begin accept Initialize; for I in 1..Max_Client loop liste(I) := new Socket_Type; end loop; Text_Io.Put_Line("Server initialize sockets..."); Bliste := (others => False); Srv_Adr.Addr := Any_Inet_Addr; Srv_Adr.Port := 1988; Create_Socket(Srv_Socket); Set_Socket_Option (Srv_Socket, Socket_Level, (Reuse_Address, True)); delay 0.2; Bind_Socket(Srv_Socket,Srv_Adr); Listen_Socket(Srv_Socket); Create_Selector(Selector); while not End_Of_Task loop loop select accept Initialize; or accept Start; exit; or accept Stop; or accept Halt do End_Of_Task := True; end Halt; exit; end select; end loop; Text_Io.Put_Line("Server sockets initialized."); while not End_Of_Task loop select accept Initialize; or accept Start; or accept Stop; exit; or accept Halt do End_Of_Task := True; end Halt; exit; or delay 0.0; Empty(Reads); Set(Reads,Srv_Socket); for I in 1..Max_Client loop if Bliste(I) then Set(Reads, Liste(I).all); end if; end loop; Check_Selector(Selector, Reads, Write, Status); case Status is when Completed => if Is_Set(Reads,Srv_Socket) then Thread_Suivant := Chercher; if Thread_Suivant /= 0 then Ptr := Thread_Suivant; --Text_Io.Put_Line("Server accept"); Accept_Socket(Srv_Socket, Liste(Ptr).all, Adr); --Text_Io.Put_Line("Server accepted"); -- Set_Socket_Option -- (Liste(Ptr).all, -- Socket_Level, -- (Reuse_Address, True)); select accept Halt do End_Of_Task := True; end Halt; exit; or accept Stop; exit; or delay 2.0; end select; Bliste(Ptr) := True; else delay 1.0; -- Text_Io.Put_Line("Client suivant = zero "); -- select -- accept Halt;  -- --Ptr := Chercher; -- exit; -- or delay 2.0; -- end select; end if; else for I in 1..Max_Client loop if bliste(I) then if Is_Set(Reads,Liste(I).all) then Liste_Thread_Task(I) := new Products_Thread_Server_Task; Liste_Thread_Task(I).Thread_Server := new Products_Thread_Server(Liste(i)); Liste_Thread_Task(i).Thread_Server.Get_Id(Liste_Thread_Task(i).Id); Bliste(i) := false; end if; end if; end loop; end if; when Expired => Text_Io.Put_Line("expired"); when Aborted => Text_Io.Put_Line("aborted"); end case; end select; end loop; end loop; Put_Line("Product server halted"); end Products_Server; end M.Servers ;