-----------------------------------------------------------------------
--  mat-types -- Global types
--  Copyright (C) 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.IO_Exceptions;

with Util.Log.Loggers;

with GNAT.Sockets;
with Readline;

with MAT.Commands;
with MAT.Targets;
with MAT.Consoles.Text;
with MAT.Readers.Streams.Sockets;
procedure Matp is

   procedure Interactive_Loop is
      Target  : MAT.Targets.Target_Type;
      Console : aliased MAT.Consoles.Text.Console_Type;
      Server  : MAT.Readers.Streams.Sockets.Socket_Listener_Type;
      Address : GNAT.Sockets.Sock_Addr_Type;
   begin
      Target.Console (Console'Unchecked_Access);
      Address.Addr := GNAT.Sockets.Any_Inet_Addr;
      Address.Port := 4096;
      Server.Start (Address);
      loop
         declare
            Line : constant String := Readline.Get_Line ("matp>");
         begin
            MAT.Commands.Execute (Target, Line);

         exception
            when MAT.Commands.Stop_Interp =>
               exit;
         end;
      end loop;

      Server.Stop;
   exception

      when Ada.IO_Exceptions.End_Error =>
         Server.Stop;
         return;

   end Interactive_Loop;

begin
   Util.Log.Loggers.Initialize ("matp.properties");
   Interactive_Loop;
end Matp;

-----------------------------------------------------------------------
--  mat-types -- Global types
--  Copyright (C) 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.IO_Exceptions;

with Util.Log.Loggers;

with GNAT.Sockets;

with MAT.Commands;
with MAT.Targets;
with MAT.Consoles.Text;
with MAT.Readers.Streams.Sockets;
procedure Matp is
   Target  : MAT.Targets.Target_Type;
   Console : aliased MAT.Consoles.Text.Console_Type;
   Server  : MAT.Readers.Streams.Sockets.Socket_Listener_Type;
   Address : GNAT.Sockets.Sock_Addr_Type;
begin
   Util.Log.Loggers.Initialize ("matp.properties");
   Target.Console (Console'Unchecked_Access);
   Address.Addr := GNAT.Sockets.Any_Inet_Addr;
   Address.Port := 4096;
   Server.Start (Address);
   MAT.Commands.Interactive (Target);
   Server.Stop;

exception
   when Ada.IO_Exceptions.End_Error =>
      Server.Stop;
end Matp;

Use the Interactive procedure to simplify the Matp procedure


-----------------------------------------------------------------------
--  util-processes-os -- System specific and low level operations
--  Copyright (C) 2011, 2012, 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with System;

with Ada.Unchecked_Deallocation;
with Ada.Characters.Conversions;

with Util.Log.Loggers;
package body Util.Processes.Os is

   use type Interfaces.C.size_t;

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Util.Processes.Os");

   --  ------------------------------
   --  Wait for the process to exit.
   --  ------------------------------
   overriding
   procedure Wait (Sys     : in out System_Process;
                   Proc    : in out Process'Class;
                   Timeout : in Duration) is

      use type Util.Streams.Output_Stream_Access;

      Result : DWORD;
      T      : DWORD;
      Code   : aliased DWORD;
      Status : BOOL;
   begin
      --  Close the input stream pipe if there is one.
      if Proc.Input /= null then
         Util.Streams.Raw.Raw_Stream'Class (Proc.Input.all).Close;
      end if;

      if Timeout < 0.0 then
         T := DWORD'Last;
      else
         T := DWORD (Timeout * 1000.0);
      end if;
      Log.Debug ("Waiting {0}", DWORD'Image (T));

      Result := Wait_For_Single_Object (H    => Sys.Process_Info.hProcess,
                                        Time => T);

      Log.Debug ("Status {0}", DWORD'Image (Result));

      Status := Get_Exit_Code_Process (Proc => Sys.Process_Info.hProcess,
                                       Code => Code'Unchecked_Access);
      if Status = 0 then
         Log.Error ("Process is still running.  Error {0}", Integer'Image (Get_Last_Error));
      end if;
      Proc.Exit_Value := Integer (Code);
      Log.Debug ("Process exit is: {0}", Integer'Image (Proc.Exit_Value));
   end Wait;

   --  ------------------------------
   --  Terminate the process by sending a signal on Unix and exiting the process on Windows.
   --  This operation is not portable and has a different behavior between Unix and Windows.
   --  Its intent is to stop the process.
   --  ------------------------------
   overriding
   procedure Stop (Sys    : in out System_Process;
                   Proc   : in out Process'Class;
                   Signal : in Positive := 15) is
      Result : Integer;
   begin
      Result := Terminate_Process (Sys.Process_Info.hProcess, DWORD (Signal));
   end Stop;

   --  Spawn a new process.
   overriding
   procedure Spawn (Sys  : in out System_Process;
                    Proc : in out Process'Class;
                    Mode : in Pipe_Mode := NONE) is
      use Util.Streams.Raw;
      use Ada.Characters.Conversions;
      use Interfaces.C;
      use type System.Address;

      Result  : Integer;
      Startup : aliased Startup_Info;
      R       : BOOL;
   begin
      --  Since checks are disabled, verify by hand that the argv table is correct.
      if Sys.Command = null or else Sys.Command'Length < 1 then
         raise Program_Error with "Invalid process argument list";
      end if;

      Startup.cb         := Startup'Size / 8;
      Startup.hStdInput  := Get_Std_Handle (STD_INPUT_HANDLE);
      Startup.hStdOutput := Get_Std_Handle (STD_OUTPUT_HANDLE);
      Startup.hStdError  := Get_Std_Handle (STD_ERROR_HANDLE);
      if Mode = READ or Mode = READ_WRITE or Mode = READ_ALL then
         Build_Output_Pipe (Proc, Startup);
      end if;
      if Mode = WRITE or Mode = READ_WRITE or Mode = READ_WRITE_ALL then
         Build_Input_Pipe (Proc, Startup);
      end if;

      --  Start the child process.
      Result := Create_Process (System.Null_Address,
                                Sys.Command.all'Address,
                                null,
                                null,
                                True,
                                16#0#,
                                System.Null_Address,
                                System.Null_Address,
                                Startup'Unchecked_Access,
                                Sys.Process_Info'Unchecked_Access);

      --  Close the handles which are not necessary.
      if Startup.hStdInput /= Get_Std_Handle (STD_INPUT_HANDLE) then
         R := Close_Handle (Startup.hStdInput);
      end if;
      if Startup.hStdOutput /= Get_Std_Handle (STD_OUTPUT_HANDLE) then
         R := Close_Handle (Startup.hStdOutput);
      end if;
      if Startup.hStdError /= Get_Std_Handle (STD_ERROR_HANDLE) then
         R := Close_Handle (Startup.hStdError);
      end if;
      if Result /= 1 then
         Result := Get_Last_Error;
         Log.Error ("Process creation failed: {0}", Integer'Image (Result));
         raise Process_Error with "Cannot create process";
      end if;

      Proc.Pid := Process_Identifier (Sys.Process_Info.dwProcessId);
   end Spawn;

   --  ------------------------------
   --  Create the output stream to read/write on the process input/output.
   --  Setup the file to be closed on exec.
   --  ------------------------------
   function Create_Stream (File : in Util.Streams.Raw.File_Type)
                           return Util.Streams.Raw.Raw_Stream_Access is
      Stream : constant Util.Streams.Raw.Raw_Stream_Access := new Util.Streams.Raw.Raw_Stream;
   begin
      Stream.Initialize (File);
      return Stream;
   end Create_Stream;

   --  ------------------------------
   --  Build the output pipe redirection to read the process output.
   --  ------------------------------
   procedure Build_Output_Pipe (Proc : in out Process'Class;
                                Into : in out Startup_Info) is
      Sec              : aliased Security_Attributes;
      Read_Handle      : aliased HANDLE;
      Write_Handle     : aliased HANDLE;
      Read_Pipe_Handle : aliased HANDLE;
      Error_Handle     : aliased HANDLE;
      Result           : BOOL;
      Current_Proc     : constant HANDLE := Get_Current_Process;
   begin
      Sec.Length  := Sec'Size / 8;
      Sec.Inherit := True;
      Sec.Security_Descriptor := System.Null_Address;

      Result := Create_Pipe (Read_Handle  => Read_Handle'Unchecked_Access,
                             Write_Handle => Write_Handle'Unchecked_Access,
                             Attributes   => Sec'Unchecked_Access,
                             Buf_Size     => 0);
      if Result = 0 then
         Log.Error ("Cannot create pipe: {0}", Integer'Image (Get_Last_Error));
         raise Program_Error with "Cannot create pipe";
      end if;

      Result := Duplicate_Handle (SourceProcessHandle => Current_Proc,
                                  SourceHandle        => Read_Handle,
                                  TargetProcessHandle => Current_Proc,
                                  TargetHandle        => Read_Pipe_Handle'Unchecked_Access,
                                  DesiredAccess       => 0,
                                  InheritHandle       => 0,
                                  Options             => 2);
      if Result = 0 then
         raise Program_Error with "Cannot create pipe";
      end if;
      Result := Close_Handle (Read_Handle);

      Result := Duplicate_Handle (SourceProcessHandle => Current_Proc,
                                  SourceHandle        => Write_Handle,
                                  TargetProcessHandle => Current_Proc,
                                  TargetHandle        => Error_Handle'Unchecked_Access,
                                  DesiredAccess       => 0,
                                  InheritHandle       => 1,
                                  Options             => 2);
      if Result = 0 then
         raise Program_Error with "Cannot create pipe";
      end if;
      Into.dwFlags    := 16#100#;
      Into.hStdOutput := Write_Handle;
      Into.hStdError  := Error_Handle;
      Proc.Output     := Create_Stream (Read_Pipe_Handle).all'Access;
   end Build_Output_Pipe;

   --  ------------------------------
   --  Build the input pipe redirection to write the process standard input.
   --  ------------------------------
   procedure Build_Input_Pipe (Proc : in out Process'Class;
                               Into : in out Startup_Info) is
      Sec               : aliased Security_Attributes;
      Read_Handle       : aliased HANDLE;
      Write_Handle      : aliased HANDLE;
      Write_Pipe_Handle : aliased HANDLE;
      Result            : BOOL;
      Current_Proc      : constant HANDLE := Get_Current_Process;
   begin
      Sec.Length  := Sec'Size / 8;
      Sec.Inherit := True;
      Sec.Security_Descriptor := System.Null_Address;

      Result := Create_Pipe (Read_Handle  => Read_Handle'Unchecked_Access,
                             Write_Handle => Write_Handle'Unchecked_Access,
                             Attributes   => Sec'Unchecked_Access,
                             Buf_Size     => 0);
      if Result = 0 then
         Log.Error ("Cannot create pipe: {0}", Integer'Image (Get_Last_Error));
         raise Program_Error with "Cannot create pipe";
      end if;

      Result := Duplicate_Handle (SourceProcessHandle => Current_Proc,
                                  SourceHandle        => Write_Handle,
                                  TargetProcessHandle => Current_Proc,
                                  TargetHandle        => Write_Pipe_Handle'Unchecked_Access,
                                  DesiredAccess       => 0,
                                  InheritHandle       => 0,
                                  Options             => 2);
      if Result = 0 then
         raise Program_Error with "Cannot create pipe";
      end if;
      Result := Close_Handle (Write_Handle);

      Into.dwFlags   := 16#100#;
      Into.hStdInput := Read_Handle;
      Proc.Input     := Create_Stream (Write_Pipe_Handle).all'Access;
   end Build_Input_Pipe;

   procedure Free is
      new Ada.Unchecked_Deallocation (Object => Interfaces.C.wchar_array,
                                      Name   => Wchar_Ptr);

   --  ------------------------------
   --  Append the argument to the process argument list.
   --  ------------------------------
   overriding
   procedure Append_Argument (Sys : in out System_Process;
                              Arg : in String) is
      Len : Interfaces.C.size_t := Arg'Length;
   begin
      if Sys.Command /= null then
         Len := Len + Sys.Command'Length + 2;
         declare
            S : constant Wchar_Ptr := new Interfaces.C.wchar_array (0 .. Len);
         begin
            S (Sys.Command'Range) := Sys.Command.all;
            Free (Sys.Command);
            Sys.Command := S;
         end;
         Sys.Command (Sys.Pos) := Interfaces.C.To_C (' ');
         Sys.Pos := Sys.Pos + 1;

      else
         Sys.Command := new Interfaces.C.wchar_array (0 .. Len + 1);
         Sys.Pos := 0;
      end if;
      for I in Arg'Range loop
         Sys.Command (Sys.Pos)
           := Interfaces.C.To_C (Ada.Characters.Conversions.To_Wide_Character (Arg (I)));
         Sys.Pos := Sys.Pos + 1;
      end loop;
      Sys.Command (Sys.Pos) := Interfaces.C.wide_nul;
   end Append_Argument;

   --  ------------------------------
   --  Set the process input, output and error streams to redirect and use specified files.
   --  ------------------------------
   overriding
   procedure Set_Streams (Sys           : in out System_Process;
                          Input         : in String;
                          Output        : in String;
                          Error         : in String;
                          Append_Output : in Boolean;
                          Append_Error  : in Boolean;
                          To_Close      : in File_Type_Array_Access) is
   begin
      Sys.To_Close := To_Close;
   end Set_Streams;

   --  ------------------------------
   --  Deletes the storage held by the system process.
   --  ------------------------------
   overriding
   procedure Finalize (Sys : in out System_Process) is
      use type System.Address;

      Result : BOOL;
      pragma Unreferenced (Result);
   begin
      if Sys.Process_Info.hProcess /= NO_FILE then
         Result := Close_Handle (Sys.Process_Info.hProcess);
         Sys.Process_Info.hProcess := NO_FILE;
      end if;
      if Sys.Process_Info.hThread /= NO_FILE then
         Result := Close_Handle (Sys.Process_Info.hThread);
         Sys.Process_Info.hThread := NO_FILE;
      end if;
      Free (Sys.Command);
   end Finalize;

end Util.Processes.Os;

-----------------------------------------------------------------------
--  util-processes-os -- System specific and low level operations
--  Copyright (C) 2011, 2012, 2018, 2019 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with System;

with Ada.Unchecked_Deallocation;
with Ada.Characters.Conversions;

with Util.Log.Loggers;
package body Util.Processes.Os is

   use type Interfaces.C.size_t;

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Util.Processes.Os");

   procedure Free is
      new Ada.Unchecked_Deallocation (Object => Interfaces.C.wchar_array,
                                      Name   => Wchar_Ptr);

   function To_WSTR (Value : in String) return Wchar_Ptr;

   --  ------------------------------
   --  Wait for the process to exit.
   --  ------------------------------
   overriding
   procedure Wait (Sys     : in out System_Process;
                   Proc    : in out Process'Class;
                   Timeout : in Duration) is

      use type Util.Streams.Output_Stream_Access;

      Result : DWORD;
      T      : DWORD;
      Code   : aliased DWORD;
      Status : BOOL;
   begin
      --  Close the input stream pipe if there is one.
      if Proc.Input /= null then
         Util.Streams.Raw.Raw_Stream'Class (Proc.Input.all).Close;
      end if;

      if Timeout < 0.0 then
         T := DWORD'Last;
      else
         T := DWORD (Timeout * 1000.0);
      end if;
      Log.Debug ("Waiting {0}", DWORD'Image (T));

      Result := Wait_For_Single_Object (H    => Sys.Process_Info.hProcess,
                                        Time => T);

      Log.Debug ("Status {0}", DWORD'Image (Result));

      Status := Get_Exit_Code_Process (Proc => Sys.Process_Info.hProcess,
                                       Code => Code'Unchecked_Access);
      if Status = 0 then
         Log.Error ("Process is still running.  Error {0}", Integer'Image (Get_Last_Error));
      end if;
      Proc.Exit_Value := Integer (Code);
      Log.Debug ("Process exit is: {0}", Integer'Image (Proc.Exit_Value));
   end Wait;

   --  ------------------------------
   --  Terminate the process by sending a signal on Unix and exiting the process on Windows.
   --  This operation is not portable and has a different behavior between Unix and Windows.
   --  Its intent is to stop the process.
   --  ------------------------------
   overriding
   procedure Stop (Sys    : in out System_Process;
                   Proc   : in out Process'Class;
                   Signal : in Positive := 15) is
      pragma Unreferenced (Proc);
      Result : Integer;
      pragma Unreferenced (Result);
   begin
      Result := Terminate_Process (Sys.Process_Info.hProcess, DWORD (Signal));
   end Stop;

   procedure Prepare_Working_Directory (Sys  : in out System_Process;
                                        Proc : in out Process'Class) is
      Dir : constant String := Ada.Strings.Unbounded.To_String (Proc.Dir);
   begin
      Free (Sys.Dir);
      if Dir'Length > 0 then
         if not Ada.Directories.Exists (Dir)
           or else Ada.Directories.Kind (Dir) /= Ada.Directories.Directory
         then
            raise Ada.Directories.Name_Error with "Invalid directory: " & Dir;
         end if;
         Sys.Dir := To_WSTR (Dir);
      end if;
   end Prepare_Working_Directory;

   --  Spawn a new process.
   overriding
   procedure Spawn (Sys  : in out System_Process;
                    Proc : in out Process'Class;
                    Mode : in Pipe_Mode := NONE) is
      use Util.Streams.Raw;
      use Ada.Characters.Conversions;
      use Interfaces.C;
      use type System.Address;

      Result  : Integer;
      Startup : aliased Startup_Info;
      R       : BOOL;
   begin
      Sys.Prepare_Working_Directory (Proc);

      --  Since checks are disabled, verify by hand that the argv table is correct.
      if Sys.Command = null or else Sys.Command'Length < 1 then
         raise Program_Error with "Invalid process argument list";
      end if;

      Startup.cb         := Startup'Size / 8;
      Startup.hStdInput  := Get_Std_Handle (STD_INPUT_HANDLE);
      Startup.hStdOutput := Get_Std_Handle (STD_OUTPUT_HANDLE);
      Startup.hStdError  := Get_Std_Handle (STD_ERROR_HANDLE);
      if Mode = READ or Mode = READ_WRITE or Mode = READ_ALL then
         Build_Output_Pipe (Proc, Startup);
      end if;
      if Mode = WRITE or Mode = READ_WRITE or Mode = READ_WRITE_ALL then
         Build_Input_Pipe (Proc, Startup);
      end if;

      --  Start the child process.
      Result := Create_Process (System.Null_Address,
                                Sys.Command.all'Address,
                                null,
                                null,
                                True,
                                16#0#,
                                System.Null_Address,
                                Sys.Dir,
                                Startup'Unchecked_Access,
                                Sys.Process_Info'Unchecked_Access);

      --  Close the handles which are not necessary.
      if Startup.hStdInput /= Get_Std_Handle (STD_INPUT_HANDLE) then
         R := Close_Handle (Startup.hStdInput);
      end if;
      if Startup.hStdOutput /= Get_Std_Handle (STD_OUTPUT_HANDLE) then
         R := Close_Handle (Startup.hStdOutput);
      end if;
      if Startup.hStdError /= Get_Std_Handle (STD_ERROR_HANDLE) then
         R := Close_Handle (Startup.hStdError);
      end if;
      if Result /= 1 then
         Result := Get_Last_Error;
         Log.Error ("Process creation failed: {0}", Integer'Image (Result));
         raise Process_Error with "Cannot create process";
      end if;

      Proc.Pid := Process_Identifier (Sys.Process_Info.dwProcessId);
   end Spawn;

   --  ------------------------------
   --  Create the output stream to read/write on the process input/output.
   --  Setup the file to be closed on exec.
   --  ------------------------------
   function Create_Stream (File : in Util.Streams.Raw.File_Type)
                           return Util.Streams.Raw.Raw_Stream_Access is
      Stream : constant Util.Streams.Raw.Raw_Stream_Access := new Util.Streams.Raw.Raw_Stream;
   begin
      Stream.Initialize (File);
      return Stream;
   end Create_Stream;

   --  ------------------------------
   --  Build the output pipe redirection to read the process output.
   --  ------------------------------
   procedure Build_Output_Pipe (Proc : in out Process'Class;
                                Into : in out Startup_Info) is
      Sec              : aliased Security_Attributes;
      Read_Handle      : aliased HANDLE;
      Write_Handle     : aliased HANDLE;
      Read_Pipe_Handle : aliased HANDLE;
      Error_Handle     : aliased HANDLE;
      Result           : BOOL;
      Current_Proc     : constant HANDLE := Get_Current_Process;
   begin
      Sec.Length  := Sec'Size / 8;
      Sec.Inherit := True;
      Sec.Security_Descriptor := System.Null_Address;

      Result := Create_Pipe (Read_Handle  => Read_Handle'Unchecked_Access,
                             Write_Handle => Write_Handle'Unchecked_Access,
                             Attributes   => Sec'Unchecked_Access,
                             Buf_Size     => 0);
      if Result = 0 then
         Log.Error ("Cannot create pipe: {0}", Integer'Image (Get_Last_Error));
         raise Program_Error with "Cannot create pipe";
      end if;

      Result := Duplicate_Handle (SourceProcessHandle => Current_Proc,
                                  SourceHandle        => Read_Handle,
                                  TargetProcessHandle => Current_Proc,
                                  TargetHandle        => Read_Pipe_Handle'Unchecked_Access,
                                  DesiredAccess       => 0,
                                  InheritHandle       => 0,
                                  Options             => 2);
      if Result = 0 then
         raise Program_Error with "Cannot create pipe";
      end if;
      Result := Close_Handle (Read_Handle);

      Result := Duplicate_Handle (SourceProcessHandle => Current_Proc,
                                  SourceHandle        => Write_Handle,
                                  TargetProcessHandle => Current_Proc,
                                  TargetHandle        => Error_Handle'Unchecked_Access,
                                  DesiredAccess       => 0,
                                  InheritHandle       => 1,
                                  Options             => 2);
      if Result = 0 then
         raise Program_Error with "Cannot create pipe";
      end if;
      Into.dwFlags    := 16#100#;
      Into.hStdOutput := Write_Handle;
      Into.hStdError  := Error_Handle;
      Proc.Output     := Create_Stream (Read_Pipe_Handle).all'Access;
   end Build_Output_Pipe;

   --  ------------------------------
   --  Build the input pipe redirection to write the process standard input.
   --  ------------------------------
   procedure Build_Input_Pipe (Proc : in out Process'Class;
                               Into : in out Startup_Info) is
      Sec               : aliased Security_Attributes;
      Read_Handle       : aliased HANDLE;
      Write_Handle      : aliased HANDLE;
      Write_Pipe_Handle : aliased HANDLE;
      Result            : BOOL;
      Current_Proc      : constant HANDLE := Get_Current_Process;
   begin
      Sec.Length  := Sec'Size / 8;
      Sec.Inherit := True;
      Sec.Security_Descriptor := System.Null_Address;

      Result := Create_Pipe (Read_Handle  => Read_Handle'Unchecked_Access,
                             Write_Handle => Write_Handle'Unchecked_Access,
                             Attributes   => Sec'Unchecked_Access,
                             Buf_Size     => 0);
      if Result = 0 then
         Log.Error ("Cannot create pipe: {0}", Integer'Image (Get_Last_Error));
         raise Program_Error with "Cannot create pipe";
      end if;

      Result := Duplicate_Handle (SourceProcessHandle => Current_Proc,
                                  SourceHandle        => Write_Handle,
                                  TargetProcessHandle => Current_Proc,
                                  TargetHandle        => Write_Pipe_Handle'Unchecked_Access,
                                  DesiredAccess       => 0,
                                  InheritHandle       => 0,
                                  Options             => 2);
      if Result = 0 then
         raise Program_Error with "Cannot create pipe";
      end if;
      Result := Close_Handle (Write_Handle);

      Into.dwFlags   := 16#100#;
      Into.hStdInput := Read_Handle;
      Proc.Input     := Create_Stream (Write_Pipe_Handle).all'Access;
   end Build_Input_Pipe;

   --  ------------------------------
   --  Append the argument to the process argument list.
   --  ------------------------------
   overriding
   procedure Append_Argument (Sys : in out System_Process;
                              Arg : in String) is
      Len : Interfaces.C.size_t := Arg'Length;
   begin
      if Sys.Command /= null then
         Len := Len + Sys.Command'Length + 2;
         declare
            S : constant Wchar_Ptr := new Interfaces.C.wchar_array (0 .. Len);
         begin
            S (Sys.Command'Range) := Sys.Command.all;
            Free (Sys.Command);
            Sys.Command := S;
         end;
         Sys.Command (Sys.Pos) := Interfaces.C.To_C (' ');
         Sys.Pos := Sys.Pos + 1;

      else
         Sys.Command := new Interfaces.C.wchar_array (0 .. Len + 1);
         Sys.Pos := 0;
      end if;
      for I in Arg'Range loop
         Sys.Command (Sys.Pos)
           := Interfaces.C.To_C (Ada.Characters.Conversions.To_Wide_Character (Arg (I)));
         Sys.Pos := Sys.Pos + 1;
      end loop;
      Sys.Command (Sys.Pos) := Interfaces.C.wide_nul;
   end Append_Argument;

   function To_WSTR (Value : in String) return Wchar_Ptr is
      Result : constant Wchar_Ptr := new Interfaces.C.wchar_array (0 .. Value'Length + 1);
      Pos    : Interfaces.C.size_t := 0;
   begin
      for C of Value loop
         Result (Pos)
           := Interfaces.C.To_C (Ada.Characters.Conversions.To_Wide_Character (C));
         Pos := Pos + 1;
      end loop;
      Result (Pos) := Interfaces.C.wide_nul;
      return Result;
   end To_WSTR;

   --  ------------------------------
   --  Set the process input, output and error streams to redirect and use specified files.
   --  ------------------------------
   overriding
   procedure Set_Streams (Sys           : in out System_Process;
                          Input         : in String;
                          Output        : in String;
                          Error         : in String;
                          Append_Output : in Boolean;
                          Append_Error  : in Boolean;
                          To_Close      : in File_Type_Array_Access) is
   begin
      if Input'Length > 0 then
         Sys.In_File := To_WSTR (Input);
      end if;
      if Output'Length > 0 then
         Sys.Out_File   := To_WSTR (Output);
         Sys.Out_Append := Append_Output;
      end if;
      if Error'Length > 0 then
         Sys.Err_File   := To_WSTR (Error);
         Sys.Err_Append := Append_Error;
      end if;
      Sys.To_Close := To_Close;
   end Set_Streams;

   --  ------------------------------
   --  Deletes the storage held by the system process.
   --  ------------------------------
   overriding
   procedure Finalize (Sys : in out System_Process) is
      use type System.Address;

      Result : BOOL;
      pragma Unreferenced (Result);
   begin
      if Sys.Process_Info.hProcess /= NO_FILE then
         Result := Close_Handle (Sys.Process_Info.hProcess);
         Sys.Process_Info.hProcess := NO_FILE;
      end if;
      if Sys.Process_Info.hThread /= NO_FILE then
         Result := Close_Handle (Sys.Process_Info.hThread);
         Sys.Process_Info.hThread := NO_FILE;
      end if;
      Free (Sys.In_File);
      Free (Sys.Out_File);
      Free (Sys.Err_File);
      Free (Sys.Dir);
      Free (Sys.Command);
   end Finalize;

end Util.Processes.Os;

Fix Set_Streams procedure to take into account redirection to/from a file Add Prepare_Working_Directory to setup the working directory of the process


-----------------------------------------------------------------------
--  Util.Beans.Objects.Maps -- Object maps
--  Copyright (C) 2010, 2011, 2012, 2017 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

package body Util.Beans.Objects.Maps is

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   function Get_Value (From : in Map_Bean;
                       Name : in String) return Object is
      Pos : constant Cursor := From.Find (Name);
   begin
      if Has_Element (Pos) then
         return Element (Pos);
      else
         return Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  If the map contains the given name, the value changed.
   --  Otherwise name is added to the map and the value associated with it.
   --  ------------------------------
   procedure Set_Value (From  : in out Map_Bean;
                        Name  : in String;
                        Value : in Object) is
   begin
      From.Include (Name, Value);
   end Set_Value;

   --  ------------------------------
   --  Iterate over the members of the map.
   --  ------------------------------
   procedure Iterate (From    : in Object;
                      Process : not null access procedure (Name : in String;
                                                           Item : in Object)) is
      procedure Process_One (Pos : in Maps.Cursor);

      procedure Process_One (Pos : in Maps.Cursor) is
      begin
         Process (Maps.Key (Pos), Maps.Element (Pos));
      end Process_One;

      Bean : constant access Util.Beans.Basic.Readonly_Bean'Class := To_Bean (From);
   begin
      if Bean /= null and then Bean.all in Util.Beans.Objects.Maps.Map_Bean'Class then
         Map_Bean'Class (Bean.all).Iterate (Process_One'Access);
      end if;
   end Iterate;

   --  ------------------------------
   --  Create an object that contains a <tt>Map_Bean</tt> instance.
   --  ------------------------------
   function Create return Object is
      M : constant access Map_Bean'Class := new Map_Bean;
   begin
      return To_Object (Value => M, Storage => DYNAMIC);
   end Create;

end Util.Beans.Objects.Maps;

-----------------------------------------------------------------------
--  util-beans-objects-maps -- Object maps
--  Copyright (C) 2010, 2011, 2012, 2017, 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

package body Util.Beans.Objects.Maps is

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   function Get_Value (From : in Map_Bean;
                       Name : in String) return Object is
      Pos : constant Cursor := From.Find (Name);
   begin
      if Has_Element (Pos) then
         return Element (Pos);
      else
         return Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  If the map contains the given name, the value changed.
   --  Otherwise name is added to the map and the value associated with it.
   --  ------------------------------
   procedure Set_Value (From  : in out Map_Bean;
                        Name  : in String;
                        Value : in Object) is
   begin
      From.Include (Name, Value);
   end Set_Value;

   --  ------------------------------
   --  Iterate over the members of the map.
   --  ------------------------------
   procedure Iterate (From    : in Object;
                      Process : not null access procedure (Name : in String;
                                                           Item : in Object)) is
      procedure Process_One (Pos : in Maps.Cursor);

      procedure Process_One (Pos : in Maps.Cursor) is
      begin
         Process (Maps.Key (Pos), Maps.Element (Pos));
      end Process_One;

      Bean : constant access Util.Beans.Basic.Readonly_Bean'Class := To_Bean (From);
   begin
      if Bean /= null and then Bean.all in Util.Beans.Objects.Maps.Map_Bean'Class then
         Map_Bean'Class (Bean.all).Iterate (Process_One'Access);
      end if;
   end Iterate;

   --  ------------------------------
   --  Create an object that contains a <tt>Map_Bean</tt> instance.
   --  ------------------------------
   function Create return Object is
      M : constant access Map_Bean'Class := new Map_Bean;
   begin
      return To_Object (Value => M, Storage => DYNAMIC);
   end Create;

end Util.Beans.Objects.Maps;

Fix header style

Fix header style


-----------------------------------------------------------------------
--  util-encoders-hmac-sha256 -- Compute HMAC-SHA256 authentication code
--  Copyright (C) 2017, 2019 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Streams;
with Ada.Finalization;
with Util.Encoders.SHA256;

--  The Util.Encodes.HMAC.SHA256 package generates HMAC-SHA256 authentication
--  (See RFC 2104 - HMAC: Keyed-Hashing for Message Authentication).
package Util.Encoders.HMAC.SHA256 is

   HASH_SIZE : constant := Util.Encoders.SHA256.HASH_SIZE;

   --  Sign the data string with the key and return the HMAC-SHA256 code in binary.
   function Sign (Key  : in String;
                  Data : in String) return Util.Encoders.SHA256.Hash_Array;

   --  Sign the data string with the key and return the HMAC-SHA256 code as hexadecimal string.
   function Sign (Key  : in String;
                  Data : in String) return Util.Encoders.SHA256.Digest;

   --  Sign the data array with the key and return the HMAC-SHA256 code in the result.
   procedure Sign (Key    : in Ada.Streams.Stream_Element_Array;
                   Data   : in Ada.Streams.Stream_Element_Array;
                   Result : out Util.Encoders.SHA256.Hash_Array);

   procedure Sign (Key    : in Secret_Key;
                   Data   : in Ada.Streams.Stream_Element_Array;
                   Result : out Util.Encoders.SHA256.Hash_Array);

   --  Sign the data string with the key and return the HMAC-SHA256 code as base64 string.
   --  When URL is True, use the base64 URL alphabet to encode in base64.
   function Sign_Base64 (Key  : in String;
                         Data : in String;
                         URL  : in Boolean := False) return Util.Encoders.SHA256.Base64_Digest;

   --  ------------------------------
   --  HMAC-SHA256 Context
   --  ------------------------------
   type Context is limited private;

   --  Set the hmac private key.  The key must be set before calling any Update
   --  procedure.
   procedure Set_Key (E   : in out Context;
                      Key : in String);

   --  Set the hmac private key.  The key must be set before calling any Update
   --  procedure.
   procedure Set_Key (E   : in out Context;
                      Key : in Ada.Streams.Stream_Element_Array);

   --  Update the hash with the string.
   procedure Update (E : in out Context;
                     S : in String);

   --  Update the hash with the string.
   procedure Update (E : in out Context;
                     S : in Ada.Streams.Stream_Element_Array);

   --  Computes the HMAC-SHA256 with the private key and the data collected by
   --  the Update procedures.  Returns the raw binary hash in Hash.
   procedure Finish (E    : in out Context;
                     Hash : out Util.Encoders.SHA256.Hash_Array);

   --  Computes the HMAC-SHA256 with the private key and the data collected by
   --  the Update procedures.  Returns the hexadecimal hash in Hash.
   procedure Finish (E    : in out Context;
                     Hash : out Util.Encoders.SHA256.Digest);

   --  Computes the HMAC-SHA256 with the private key and the data collected by
   --  the Update procedures.  Returns the base64 hash in Hash.
   --  When URL is True, use the base64 URL alphabet to encode in base64.
   procedure Finish_Base64 (E    : in out Context;
                            Hash : out Util.Encoders.SHA256.Base64_Digest;
                            URL  : in Boolean := False);

private

   type Context is new Ada.Finalization.Limited_Controlled with record
      SHA     : Util.Encoders.SHA256.Context;
      Key     : Ada.Streams.Stream_Element_Array (0 .. 63);
      Key_Len : Ada.Streams.Stream_Element_Offset;
   end record;

   --  Initialize the SHA-1 context.
   overriding
   procedure Initialize (E : in out Context);

end Util.Encoders.HMAC.SHA256;

-----------------------------------------------------------------------
--  util-encoders-hmac-sha256 -- Compute HMAC-SHA256 authentication code
--  Copyright (C) 2017, 2019 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Streams;
with Ada.Finalization;
with Util.Encoders.SHA256;

--  The Util.Encodes.HMAC.SHA256 package generates HMAC-SHA256 authentication
--  (See RFC 2104 - HMAC: Keyed-Hashing for Message Authentication).
package Util.Encoders.HMAC.SHA256 is

   HASH_SIZE : constant := Util.Encoders.SHA256.HASH_SIZE;

   --  Sign the data string with the key and return the HMAC-SHA256 code in binary.
   function Sign (Key  : in String;
                  Data : in String) return Util.Encoders.SHA256.Hash_Array;

   --  Sign the data string with the key and return the HMAC-SHA256 code as hexadecimal string.
   function Sign (Key  : in String;
                  Data : in String) return Util.Encoders.SHA256.Digest;

   --  Sign the data array with the key and return the HMAC-SHA256 code in the result.
   procedure Sign (Key    : in Ada.Streams.Stream_Element_Array;
                   Data   : in Ada.Streams.Stream_Element_Array;
                   Result : out Util.Encoders.SHA256.Hash_Array);

   procedure Sign (Key    : in Secret_Key;
                   Data   : in Ada.Streams.Stream_Element_Array;
                   Result : out Util.Encoders.SHA256.Hash_Array);

   --  Sign the data string with the key and return the HMAC-SHA256 code as base64 string.
   --  When URL is True, use the base64 URL alphabet to encode in base64.
   function Sign_Base64 (Key  : in String;
                         Data : in String;
                         URL  : in Boolean := False) return Util.Encoders.SHA256.Base64_Digest;

   --  ------------------------------
   --  HMAC-SHA256 Context
   --  ------------------------------
   type Context is limited private;

   --  Set the hmac private key.  The key must be set before calling any Update
   --  procedure.
   procedure Set_Key (E   : in out Context;
                      Key : in String);

   --  Set the hmac private key.  The key must be set before calling any Update
   --  procedure.
   procedure Set_Key (E   : in out Context;
                      Key : in Ada.Streams.Stream_Element_Array);
   procedure Set_Key (E   : in out Context;
                      Key : in Secret_Key);

   --  Update the hash with the string.
   procedure Update (E : in out Context;
                     S : in String);

   --  Update the hash with the string.
   procedure Update (E : in out Context;
                     S : in Ada.Streams.Stream_Element_Array);

   --  Update the hash with the secret key.
   procedure Update (E : in out Context;
                     S : in Secret_Key);

   --  Computes the HMAC-SHA256 with the private key and the data collected by
   --  the Update procedures.  Returns the raw binary hash in Hash.
   procedure Finish (E    : in out Context;
                     Hash : out Util.Encoders.SHA256.Hash_Array);

   --  Computes the HMAC-SHA256 with the private key and the data collected by
   --  the Update procedures.  Returns the hexadecimal hash in Hash.
   procedure Finish (E    : in out Context;
                     Hash : out Util.Encoders.SHA256.Digest);

   --  Computes the HMAC-SHA256 with the private key and the data collected by
   --  the Update procedures.  Returns the base64 hash in Hash.
   --  When URL is True, use the base64 URL alphabet to encode in base64.
   procedure Finish_Base64 (E    : in out Context;
                            Hash : out Util.Encoders.SHA256.Base64_Digest;
                            URL  : in Boolean := False);

private

   type Context is new Ada.Finalization.Limited_Controlled with record
      SHA     : Util.Encoders.SHA256.Context;
      Key     : Ada.Streams.Stream_Element_Array (0 .. 63);
      Key_Len : Ada.Streams.Stream_Element_Offset;
   end record;

   --  Initialize the SHA-1 context.
   overriding
   procedure Initialize (E : in out Context);

end Util.Encoders.HMAC.SHA256;

Add Set_Key and Update using a Secret_Key object


-----------------------------------------------------------------------
--  mat-readers-sockets -- Reader for TCP/IP sockets
--  Copyright (C) 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Streams;
with Util.Log.Loggers;

package body MAT.Readers.Streams.Sockets is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Readers.Sockets");

   BUFFER_SIZE  : constant Natural := 100 * 1024;

   --  ------------------------------
   --  Initialize the socket listener.
   --  ------------------------------
   overriding
   procedure Initialize (Listener : in out Socket_Listener_Type) is
   begin
      GNAT.Sockets.Create_Selector (Listener.Accept_Selector);
   end Initialize;

   --  ------------------------------
   --  Destroy the socket listener.
   --  ------------------------------
   overriding
   procedure Finalize (Listener : in out Socket_Listener_Type) is
      use type GNAT.Sockets.Selector_Type;
   begin
      GNAT.Sockets.Close_Selector (Listener.Accept_Selector);
   end Finalize;

   --  ------------------------------
   --  Open the socket to accept connections and start the listener task.
   --  ------------------------------
   procedure Start (Listener : in out Socket_Listener_Type;
                    Address  : in GNAT.Sockets.Sock_Addr_Type) is
   begin
      Log.Info ("Starting the listener socket task");

      Listener.Listener.Start (Listener'Unchecked_Access, Address);
   end Start;

   --  ------------------------------
   --  Stop the listener socket.
   --  ------------------------------
   procedure Stop (Listener : in out Socket_Listener_Type) is
   begin
      GNAT.Sockets.Abort_Selector (Listener.Accept_Selector);
   end Stop;

   --  ------------------------------
   --  Create a target instance for the new client.
   --  ------------------------------
   procedure Create_Target (Listener : in out Socket_Listener_Type;
                            Client   : in GNAT.Sockets.Socket_Type;
                            Address  : in GNAT.Sockets.Sock_Addr_Type) is
      Reader : constant Socket_Reader_Type_Access := new Socket_Reader_Type;
   begin
      Reader.Server.Start (Reader, Client);
   end Create_Target;

   task body Socket_Listener_Task is
      use type GNAT.Sockets.Socket_Type;
      use type GNAT.Sockets.Selector_Status;

      Peer     : GNAT.Sockets.Sock_Addr_Type;
      Server   : GNAT.Sockets.Socket_Type;
      Instance : Socket_Listener_Type_Access;
      Client   : GNAT.Sockets.Socket_Type;
      Selector_Status : GNAT.Sockets.Selector_Status;
   begin
      select
         accept Start (Listener : in Socket_Listener_Type_Access;
                       Address  : in GNAT.Sockets.Sock_Addr_Type) do
            Instance := Listener;
            GNAT.Sockets.Create_Socket (Server);
            GNAT.Sockets.Set_Socket_Option (Server, GNAT.Sockets.Socket_Level,
                                            (GNAT.Sockets.Reuse_Address, True));
            GNAT.Sockets.Bind_Socket (Server, Address);
            GNAT.Sockets.Listen_Socket (Server);
         end Start;
      or
         terminate;
      end select;
      loop
         GNAT.Sockets.Accept_Socket (Server   => Server,
                                     Socket   => Client,
                                     Address  => Peer,
                                     Timeout  => GNAT.Sockets.Forever,
                                     Selector => Instance.Accept_Selector'Access,
                                     Status   => Selector_Status);
         exit when Selector_Status = GNAT.Sockets.Aborted;
         if Selector_Status = GNAT.Sockets.Completed then
            Instance.Create_Target (Client  => Client,
                                    Address => Peer);
            GNAT.Sockets.Close_Socket (Client);
         end if;
      end loop;
      GNAT.Sockets.Close_Socket (Server);
   end Socket_Listener_Task;

   task body Socket_Reader_Task is
      use type GNAT.Sockets.Socket_Type;

      Instance : Socket_Reader_Type_Access;
      Socket   : GNAT.Sockets.Socket_Type;
   begin
      select
         accept Start (Reader  : in Socket_Reader_Type_Access;
                       Client  : in GNAT.Sockets.Socket_Type) do
            Instance := Reader;
            Socket := Client;
         end Start;
      or
         terminate;
      end select;
      Instance.Socket.Open (Socket);
      Instance.Read_All;
      GNAT.Sockets.Close_Socket (Socket);

   exception
      when E : others =>
         Log.Error ("Exception", E);
         GNAT.Sockets.Close_Socket (Socket);

   end Socket_Reader_Task;

   procedure Close (Reader : in out Socket_Reader_Type) is
   begin
      Reader.Stop := True;
   end Close;

end MAT.Readers.Streams.Sockets;

-----------------------------------------------------------------------
--  mat-readers-sockets -- Reader for TCP/IP sockets
--  Copyright (C) 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Streams;
with Util.Log.Loggers;

package body MAT.Readers.Streams.Sockets is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Readers.Sockets");

   BUFFER_SIZE  : constant Natural := 100 * 1024;

   --  ------------------------------
   --  Initialize the socket listener.
   --  ------------------------------
   overriding
   procedure Initialize (Listener : in out Socket_Listener_Type) is
   begin
      GNAT.Sockets.Create_Selector (Listener.Accept_Selector);
   end Initialize;

   --  ------------------------------
   --  Destroy the socket listener.
   --  ------------------------------
   overriding
   procedure Finalize (Listener : in out Socket_Listener_Type) is
      use type GNAT.Sockets.Selector_Type;
   begin
      GNAT.Sockets.Close_Selector (Listener.Accept_Selector);
   end Finalize;

   --  ------------------------------
   --  Open the socket to accept connections and start the listener task.
   --  ------------------------------
   procedure Start (Listener : in out Socket_Listener_Type;
                    Address  : in GNAT.Sockets.Sock_Addr_Type) is
   begin
      Log.Info ("Starting the listener socket task");

      Listener.Listener.Start (Listener'Unchecked_Access, Address);
   end Start;

   --  ------------------------------
   --  Stop the listener socket.
   --  ------------------------------
   procedure Stop (Listener : in out Socket_Listener_Type) is
   begin
      GNAT.Sockets.Abort_Selector (Listener.Accept_Selector);
   end Stop;

   --  ------------------------------
   --  Create a target instance for the new client.
   --  ------------------------------
   procedure Create_Target (Listener : in out Socket_Listener_Type;
                            Client   : in GNAT.Sockets.Socket_Type;
                            Address  : in GNAT.Sockets.Sock_Addr_Type) is
      Reader : constant Socket_Reader_Type_Access := new Socket_Reader_Type;
   begin
      Reader.Client := Client;
      Reader.Stream.Initialize (Size   => BUFFER_SIZE,
                                Input  => Reader.Socket'Unchecked_Access,
                                Output => null);
      Reader.Server.Start (Reader, Client);
      Listener.Clients.Append (Reader);
   end Create_Target;

   task body Socket_Listener_Task is
      use type GNAT.Sockets.Socket_Type;
      use type GNAT.Sockets.Selector_Status;

      Peer     : GNAT.Sockets.Sock_Addr_Type;
      Server   : GNAT.Sockets.Socket_Type;
      Instance : Socket_Listener_Type_Access;
      Client   : GNAT.Sockets.Socket_Type;
      Selector_Status : GNAT.Sockets.Selector_Status;
   begin
      select
         accept Start (Listener : in Socket_Listener_Type_Access;
                       Address  : in GNAT.Sockets.Sock_Addr_Type) do
            Instance := Listener;
            GNAT.Sockets.Create_Socket (Server);
            GNAT.Sockets.Set_Socket_Option (Server, GNAT.Sockets.Socket_Level,
                                            (GNAT.Sockets.Reuse_Address, True));
            GNAT.Sockets.Bind_Socket (Server, Address);
            GNAT.Sockets.Listen_Socket (Server);
         end Start;
      or
         terminate;
      end select;
      loop
         GNAT.Sockets.Accept_Socket (Server   => Server,
                                     Socket   => Client,
                                     Address  => Peer,
                                     Timeout  => GNAT.Sockets.Forever,
                                     Selector => Instance.Accept_Selector'Access,
                                     Status   => Selector_Status);
         exit when Selector_Status = GNAT.Sockets.Aborted;
         if Selector_Status = GNAT.Sockets.Completed then
            Instance.Create_Target (Client  => Client,
                                    Address => Peer);
            GNAT.Sockets.Close_Socket (Client);
         end if;
      end loop;
      GNAT.Sockets.Close_Socket (Server);
   end Socket_Listener_Task;

   task body Socket_Reader_Task is
      use type GNAT.Sockets.Socket_Type;

      Instance : Socket_Reader_Type_Access;
      Socket   : GNAT.Sockets.Socket_Type;
   begin
      select
         accept Start (Reader  : in Socket_Reader_Type_Access;
                       Client  : in GNAT.Sockets.Socket_Type) do
            Instance := Reader;
            Socket := Client;
         end Start;
      or
         terminate;
      end select;
      Instance.Socket.Open (Socket);
      Instance.Read_All;
      GNAT.Sockets.Close_Socket (Socket);

   exception
      when E : others =>
         Log.Error ("Exception", E);
         GNAT.Sockets.Close_Socket (Socket);

   end Socket_Reader_Task;

   procedure Close (Reader : in out Socket_Reader_Type) is
   begin
      Reader.Stop := True;
   end Close;

end MAT.Readers.Streams.Sockets;

Initialize the buffer stream when the client socket is created Add the new client in the list of clients


-----------------------------------------------------------------------
--  mat-readers-sockets -- Reader for TCP/IP sockets
--  Copyright (C) 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Util.Log.Loggers;

package body MAT.Readers.Streams.Sockets is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Readers.Sockets");

   BUFFER_SIZE  : constant Natural := 100 * 1024;

   --  ------------------------------
   --  Initialize the socket listener.
   --  ------------------------------
   overriding
   procedure Initialize (Listener : in out Socket_Listener_Type) is
   begin
      GNAT.Sockets.Create_Selector (Listener.Accept_Selector);
   end Initialize;

   --  ------------------------------
   --  Destroy the socket listener.
   --  ------------------------------
   overriding
   procedure Finalize (Listener : in out Socket_Listener_Type) is
      use type GNAT.Sockets.Selector_Type;
   begin
      GNAT.Sockets.Close_Selector (Listener.Accept_Selector);
   end Finalize;

   --  ------------------------------
   --  Open the socket to accept connections and start the listener task.
   --  ------------------------------
   procedure Start (Listener : in out Socket_Listener_Type;
                    List     : in MAT.Readers.Reader_List_Type_Access;
                    Address  : in GNAT.Sockets.Sock_Addr_Type) is
   begin
      Log.Info ("Starting the listener socket task");

      Listener.List := List;
      Listener.Listener.Start (Listener'Unchecked_Access, Address);
   end Start;

   --  ------------------------------
   --  Stop the listener socket.
   --  ------------------------------
   procedure Stop (Listener : in out Socket_Listener_Type) is
   begin
      GNAT.Sockets.Abort_Selector (Listener.Accept_Selector);
   end Stop;

   --  ------------------------------
   --  Create a target instance for the new client.
   --  ------------------------------
   procedure Create_Target (Listener : in out Socket_Listener_Type;
                            Client   : in GNAT.Sockets.Socket_Type;
                            Address  : in GNAT.Sockets.Sock_Addr_Type) is
      Reader : constant Socket_Reader_Type_Access := new Socket_Reader_Type;
   begin
      Reader.Client := Client;
      Reader.Stream.Initialize (Size   => BUFFER_SIZE,
                                Input  => Reader.Socket'Unchecked_Access,
                                Output => null);
      Reader.Server.Start (Reader, Client);
      Listener.List.Initialize (Reader.all);
      Listener.Clients.Append (Reader);
   end Create_Target;

   task body Socket_Listener_Task is
      use type GNAT.Sockets.Socket_Type;
      use type GNAT.Sockets.Selector_Status;

      Peer     : GNAT.Sockets.Sock_Addr_Type;
      Server   : GNAT.Sockets.Socket_Type;
      Instance : Socket_Listener_Type_Access;
      Client   : GNAT.Sockets.Socket_Type;
      Selector_Status : GNAT.Sockets.Selector_Status;
   begin
      select
         accept Start (Listener : in Socket_Listener_Type_Access;
                       Address  : in GNAT.Sockets.Sock_Addr_Type) do
            Instance := Listener;
            GNAT.Sockets.Create_Socket (Server);
            GNAT.Sockets.Set_Socket_Option (Server, GNAT.Sockets.Socket_Level,
                                            (GNAT.Sockets.Reuse_Address, True));
            GNAT.Sockets.Bind_Socket (Server, Address);
            GNAT.Sockets.Listen_Socket (Server);
         end Start;
      or
         terminate;
      end select;
      loop
         GNAT.Sockets.Accept_Socket (Server   => Server,
                                     Socket   => Client,
                                     Address  => Peer,
                                     Timeout  => GNAT.Sockets.Forever,
                                     Selector => Instance.Accept_Selector'Access,
                                     Status   => Selector_Status);
         exit when Selector_Status = GNAT.Sockets.Aborted;
         if Selector_Status = GNAT.Sockets.Completed then
            Instance.Create_Target (Client  => Client,
                                    Address => Peer);
         end if;
      end loop;
      GNAT.Sockets.Close_Socket (Server);
      declare
         Iter : Socket_Client_Lists.Cursor := Instance.Clients.First;
      begin
         while Socket_Client_Lists.Has_Element (Iter) loop
            GNAT.Sockets.Close_Socket (Socket_Client_Lists.Element (Iter).Client);
            Iter := Socket_Client_Lists.Next (Iter);
         end loop;
      end;
   end Socket_Listener_Task;

   task body Socket_Reader_Task is
      use type GNAT.Sockets.Socket_Type;

      Instance : Socket_Reader_Type_Access;
      Socket   : GNAT.Sockets.Socket_Type;
   begin
      select
         accept Start (Reader  : in Socket_Reader_Type_Access;
                       Client  : in GNAT.Sockets.Socket_Type) do
            Instance := Reader;
            Socket := Client;
         end Start;
      or
         terminate;
      end select;
      Instance.Socket.Open (Socket);
      Instance.Read_All;
      GNAT.Sockets.Close_Socket (Socket);

   exception
      when E : others =>
         Log.Error ("Exception", E, True);
         GNAT.Sockets.Close_Socket (Socket);

   end Socket_Reader_Task;

   procedure Close (Reader : in out Socket_Reader_Type) is
   begin
      Reader.Stop := True;
   end Close;

end MAT.Readers.Streams.Sockets;

-----------------------------------------------------------------------
--  mat-readers-sockets -- Reader for TCP/IP sockets
--  Copyright (C) 2014 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Util.Log.Loggers;

package body MAT.Readers.Streams.Sockets is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("MAT.Readers.Sockets");

   BUFFER_SIZE  : constant Natural := 100 * 1024;

   --  ------------------------------
   --  Initialize the socket listener.
   --  ------------------------------
   overriding
   procedure Initialize (Listener : in out Socket_Listener_Type) is
   begin
      GNAT.Sockets.Create_Selector (Listener.Accept_Selector);
   end Initialize;

   --  ------------------------------
   --  Destroy the socket listener.
   --  ------------------------------
   overriding
   procedure Finalize (Listener : in out Socket_Listener_Type) is
      use type GNAT.Sockets.Selector_Type;
   begin
      GNAT.Sockets.Close_Selector (Listener.Accept_Selector);
   end Finalize;

   --  ------------------------------
   --  Open the socket to accept connections and start the listener task.
   --  ------------------------------
   procedure Start (Listener : in out Socket_Listener_Type;
                    List     : in MAT.Events.Probes.Reader_List_Type_Access;
                    Address  : in GNAT.Sockets.Sock_Addr_Type) is
   begin
      Log.Info ("Starting the listener socket task");

      Listener.List := List;
      Listener.Listener.Start (Listener'Unchecked_Access, Address);
   end Start;

   --  ------------------------------
   --  Stop the listener socket.
   --  ------------------------------
   procedure Stop (Listener : in out Socket_Listener_Type) is
   begin
      GNAT.Sockets.Abort_Selector (Listener.Accept_Selector);
   end Stop;

   --  ------------------------------
   --  Create a target instance for the new client.
   --  ------------------------------
   procedure Create_Target (Listener : in out Socket_Listener_Type;
                            Client   : in GNAT.Sockets.Socket_Type;
                            Address  : in GNAT.Sockets.Sock_Addr_Type) is
      Reader : constant Socket_Reader_Type_Access := new Socket_Reader_Type;
   begin
      Reader.Client := Client;
      Reader.Stream.Initialize (Size   => BUFFER_SIZE,
                                Input  => Reader.Socket'Unchecked_Access,
                                Output => null);
      Reader.Server.Start (Reader, Client);
      Listener.List.Initialize (Reader.all);
      Listener.Clients.Append (Reader);
   end Create_Target;

   task body Socket_Listener_Task is
      use type GNAT.Sockets.Socket_Type;
      use type GNAT.Sockets.Selector_Status;

      Peer     : GNAT.Sockets.Sock_Addr_Type;
      Server   : GNAT.Sockets.Socket_Type;
      Instance : Socket_Listener_Type_Access;
      Client   : GNAT.Sockets.Socket_Type;
      Selector_Status : GNAT.Sockets.Selector_Status;
   begin
      select
         accept Start (Listener : in Socket_Listener_Type_Access;
                       Address  : in GNAT.Sockets.Sock_Addr_Type) do
            Instance := Listener;
            GNAT.Sockets.Create_Socket (Server);
            GNAT.Sockets.Set_Socket_Option (Server, GNAT.Sockets.Socket_Level,
                                            (GNAT.Sockets.Reuse_Address, True));
            GNAT.Sockets.Bind_Socket (Server, Address);
            GNAT.Sockets.Listen_Socket (Server);
         end Start;
      or
         terminate;
      end select;
      loop
         GNAT.Sockets.Accept_Socket (Server   => Server,
                                     Socket   => Client,
                                     Address  => Peer,
                                     Timeout  => GNAT.Sockets.Forever,
                                     Selector => Instance.Accept_Selector'Access,
                                     Status   => Selector_Status);
         exit when Selector_Status = GNAT.Sockets.Aborted;
         if Selector_Status = GNAT.Sockets.Completed then
            Instance.Create_Target (Client  => Client,
                                    Address => Peer);
         end if;
      end loop;
      GNAT.Sockets.Close_Socket (Server);
      declare
         Iter : Socket_Client_Lists.Cursor := Instance.Clients.First;
      begin
         while Socket_Client_Lists.Has_Element (Iter) loop
            GNAT.Sockets.Close_Socket (Socket_Client_Lists.Element (Iter).Client);
            Iter := Socket_Client_Lists.Next (Iter);
         end loop;
      end;
   end Socket_Listener_Task;

   task body Socket_Reader_Task is
      use type GNAT.Sockets.Socket_Type;

      Instance : Socket_Reader_Type_Access;
      Socket   : GNAT.Sockets.Socket_Type;
   begin
      select
         accept Start (Reader  : in Socket_Reader_Type_Access;
                       Client  : in GNAT.Sockets.Socket_Type) do
            Instance := Reader;
            Socket := Client;
         end Start;
      or
         terminate;
      end select;
      Instance.Socket.Open (Socket);
      Instance.Read_All;
      GNAT.Sockets.Close_Socket (Socket);

   exception
      when E : others =>
         Log.Error ("Exception", E, True);
         GNAT.Sockets.Close_Socket (Socket);

   end Socket_Reader_Task;

   procedure Close (Reader : in out Socket_Reader_Type) is
   begin
      Reader.Stop := True;
   end Close;

end MAT.Readers.Streams.Sockets;

Fix the Start procedure definition

Fix the Start procedure definition


-----------------------------------------------------------------------
--  ado-queries-tests -- Test loading of database queries
--  Copyright (C) 2011, 2012, 2013, 2014, 2015, 2017 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Util.Test_Caller;
with Util.Properties;

with ADO.Drivers.Connections;
with ADO.Queries.Loaders;
package body ADO.Queries.Tests is

   use Util.Tests;

   package Caller is new Util.Test_Caller (Test, "ADO.Queries");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test ADO.Queries.Read_Query",
                       Test_Load_Queries'Access);
      Caller.Add_Test (Suite, "Test ADO.Queries.Initialize",
                       Test_Initialize'Access);
      Caller.Add_Test (Suite, "Test ADO.Queries.Set_Query",
                       Test_Set_Query'Access);
      Caller.Add_Test (Suite, "Test ADO.Queries.Set_Limit",
                       Test_Set_Limit'Access);
   end Add_Tests;

   package Simple_Query_File is
     new ADO.Queries.Loaders.File (Path => "regtests/files/simple-query.xml",
                                   Sha1 => "");

   package Multi_Query_File is
     new ADO.Queries.Loaders.File (Path => "regtests/files/multi-query.xml",
                                   Sha1 => "");

   package Simple_Query is
     new ADO.Queries.Loaders.Query (Name => "simple-query",
                                    File => Simple_Query_File.File'Access);

   package Simple_Query_2 is
     new ADO.Queries.Loaders.Query (Name => "simple-query",
                                    File => Multi_Query_File.File'Access);

   package Index_Query is
     new ADO.Queries.Loaders.Query (Name => "index",
                                    File => Multi_Query_File.File'Access);

   package Value_Query is
     new ADO.Queries.Loaders.Query (Name => "value",
                                    File => Multi_Query_File.File'Access);

   pragma Warnings (Off, Simple_Query_2);
   pragma Warnings (Off, Value_Query);

   procedure Test_Load_Queries (T : in out Test) is
      use ADO.Drivers.Connections;
      use type ADO.Drivers.Driver_Index;

      Mysql_Driver  : constant Driver_Access := ADO.Drivers.Connections.Get_Driver ("mysql");
      Sqlite_Driver : constant Driver_Access := ADO.Drivers.Connections.Get_Driver ("sqlite");
      Props         : constant Util.Properties.Manager := Util.Tests.Get_Properties;
      Config        : ADO.Drivers.Connections.Configuration;
      Manager       : Query_Manager;
   begin
      --  Configure the XML query loader.
      ADO.Queries.Loaders.Initialize (Manager, Config);

      declare
         SQL : constant String := ADO.Queries.Get_SQL (Simple_Query.Query'Access, Manager, False);
      begin
         Assert_Equals (T, "select count(*) from user", SQL, "Invalid query for 'simple-query'");
      end;

      declare
         SQL : constant String := ADO.Queries.Get_SQL (Index_Query.Query'Access, Manager, False);
      begin
         Assert_Equals (T, "select 0", SQL, "Invalid query for 'index'");
      end;

      if Mysql_Driver /= null and then Manager.Driver = Mysql_Driver.Get_Driver_Index then
         declare
            SQL : constant String := ADO.Queries.Get_SQL (Index_Query.Query'Access,
                                                          Manager,
                                                          False);
         begin
            Assert_Equals (T, "select 1", SQL, "Invalid query for 'index' (MySQL driver)");
         end;
      end if;
      if Sqlite_Driver /= null then
         declare
            SQL : constant String := ADO.Queries.Get_SQL (Index_Query.Query'Access,
                                                          Manager, False);
         begin
            Assert_Equals (T, "select 0", SQL, "Invalid query for 'index' (SQLite driver)");
         end;
      end if;
   end Test_Load_Queries;

   --  ------------------------------
   --  Test the Initialize operation called several times
   --  ------------------------------
   procedure Test_Initialize (T : in out Test) is
      use ADO.Drivers.Connections;

      Props : constant Util.Properties.Manager := Util.Tests.Get_Properties;
      Config        : ADO.Drivers.Connections.Configuration;
      Manager : Query_Manager;
      Info  : Query_Info_Ref.Ref;
   begin
      --  Configure and load the XML queries.
      ADO.Queries.Loaders.Initialize (Manager, Config);
      --  T.Assert (not Simple_Query.Query.Query.Get.Is_Null, "The simple query was not loaded");
      --  T.Assert (not Index_Query.Query.Query.Get.Is_Null, "The index query was not loaded");
--        Info := Simple_Query.Query.Query.Get;

      --  Re-configure but do not reload.
      ADO.Queries.Loaders.Initialize (Manager, Config);
--        T.Assert (Info.Value = Simple_Query.Query.Query.Get.Value,
--                  "The simple query instance was not changed");

      --  Configure again and reload.  The query info must have changed.
      ADO.Queries.Loaders.Initialize (Manager, Config);
--        T.Assert (Info.Value /= Simple_Query.Query.Query.Get.Value,
--                  "The simple query instance was not changed");

      --  Due to the reference held by 'Info', it refers to the data loaded first.
--        T.Assert (Length (Info.Value.Main_Query (0).SQL) > 0, "The old query is not valid");
   end Test_Initialize;

   --  ------------------------------
   --  Test the Set_Query operation.
   --  ------------------------------
   procedure Test_Set_Query (T : in out Test) is
      Query : ADO.Queries.Context;
      Props : constant Util.Properties.Manager := Util.Tests.Get_Properties;
      Manager : Query_Manager;
      Config        : ADO.Drivers.Connections.Configuration;
   begin
      ADO.Queries.Loaders.Initialize (Manager, Config);
      Query.Set_Query ("simple-query");

      declare
         SQL : constant String := Query.Get_SQL (Manager);
      begin
         Assert_Equals (T, "select count(*) from user", SQL, "Invalid query for 'simple-query'");
      end;
   end Test_Set_Query;

   --  ------------------------------
   --  Test the Set_Limit operation.
   --  ------------------------------
   procedure Test_Set_Limit (T : in out Test) is
      Query : ADO.Queries.Context;
   begin
      Query.Set_Query ("index");
      Query.Set_Limit (0, 10);
      Assert_Equals (T, 0, Query.Get_First_Row_Index, "Invalid first row index");
      Assert_Equals (T, 10, Query.Get_Last_Row_Index, "Invalid last row index");
   end Test_Set_Limit;

end ADO.Queries.Tests;

-----------------------------------------------------------------------
--  ado-queries-tests -- Test loading of database queries
--  Copyright (C) 2011, 2012, 2013, 2014, 2015, 2017 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Util.Test_Caller;
with Util.Properties;

with ADO.Drivers.Connections;
with ADO.Queries.Loaders;
package body ADO.Queries.Tests is

   use Util.Tests;

   package Caller is new Util.Test_Caller (Test, "ADO.Queries");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test ADO.Queries.Read_Query",
                       Test_Load_Queries'Access);
      Caller.Add_Test (Suite, "Test ADO.Queries.Find_Query",
                       Test_Find_Query'Access);
      Caller.Add_Test (Suite, "Test ADO.Queries.Initialize",
                       Test_Initialize'Access);
      Caller.Add_Test (Suite, "Test ADO.Queries.Set_Query",
                       Test_Set_Query'Access);
      Caller.Add_Test (Suite, "Test ADO.Queries.Set_Limit",
                       Test_Set_Limit'Access);
   end Add_Tests;

   package Simple_Query_File is
     new ADO.Queries.Loaders.File (Path => "regtests/files/simple-query.xml",
                                   Sha1 => "");

   package Multi_Query_File is
     new ADO.Queries.Loaders.File (Path => "regtests/files/multi-query.xml",
                                   Sha1 => "");

   package Simple_Query is
     new ADO.Queries.Loaders.Query (Name => "simple-query",
                                    File => Simple_Query_File.File'Access);

   package Simple_Query_2 is
     new ADO.Queries.Loaders.Query (Name => "simple-query",
                                    File => Multi_Query_File.File'Access);

   package Index_Query is
     new ADO.Queries.Loaders.Query (Name => "index",
                                    File => Multi_Query_File.File'Access);

   package Value_Query is
     new ADO.Queries.Loaders.Query (Name => "value",
                                    File => Multi_Query_File.File'Access);

   pragma Warnings (Off, Simple_Query_2);
   pragma Warnings (Off, Value_Query);

   procedure Test_Load_Queries (T : in out Test) is
      use ADO.Drivers.Connections;
      use type ADO.Drivers.Driver_Index;

      Mysql_Driver  : constant Driver_Access := ADO.Drivers.Connections.Get_Driver ("mysql");
      Sqlite_Driver : constant Driver_Access := ADO.Drivers.Connections.Get_Driver ("sqlite");
      Props         : constant Util.Properties.Manager := Util.Tests.Get_Properties;
      Config        : ADO.Drivers.Connections.Configuration;
      Manager       : Query_Manager;
   begin
      --  Configure the XML query loader.
      ADO.Queries.Loaders.Initialize (Manager, Config);

      declare
         SQL : constant String := ADO.Queries.Get_SQL (Simple_Query.Query'Access, Manager, False);
      begin
         Assert_Equals (T, "select count(*) from user", SQL, "Invalid query for 'simple-query'");
      end;

      declare
         SQL : constant String := ADO.Queries.Get_SQL (Index_Query.Query'Access, Manager, False);
      begin
         Assert_Equals (T, "select 0", SQL, "Invalid query for 'index'");
      end;

      if Mysql_Driver /= null and then Manager.Driver = Mysql_Driver.Get_Driver_Index then
         declare
            SQL : constant String := ADO.Queries.Get_SQL (Index_Query.Query'Access,
                                                          Manager,
                                                          False);
         begin
            Assert_Equals (T, "select 1", SQL, "Invalid query for 'index' (MySQL driver)");
         end;
      end if;
      if Sqlite_Driver /= null then
         declare
            SQL : constant String := ADO.Queries.Get_SQL (Index_Query.Query'Access,
                                                          Manager, False);
         begin
            Assert_Equals (T, "select 0", SQL, "Invalid query for 'index' (SQLite driver)");
         end;
      end if;
   end Test_Load_Queries;

   --  ------------------------------
   --  Test the Initialize operation called several times
   --  ------------------------------
   procedure Test_Initialize (T : in out Test) is
      use ADO.Drivers.Connections;

      Props : constant Util.Properties.Manager := Util.Tests.Get_Properties;
      Config        : ADO.Drivers.Connections.Configuration;
      Manager : Query_Manager;
      Info  : Query_Info_Ref.Ref;
   begin
      --  Configure and load the XML queries.
      ADO.Queries.Loaders.Initialize (Manager, Config);
      --  T.Assert (not Simple_Query.Query.Query.Get.Is_Null, "The simple query was not loaded");
      --  T.Assert (not Index_Query.Query.Query.Get.Is_Null, "The index query was not loaded");
--        Info := Simple_Query.Query.Query.Get;

      --  Re-configure but do not reload.
      ADO.Queries.Loaders.Initialize (Manager, Config);
--        T.Assert (Info.Value = Simple_Query.Query.Query.Get.Value,
--                  "The simple query instance was not changed");

      --  Configure again and reload.  The query info must have changed.
      ADO.Queries.Loaders.Initialize (Manager, Config);
--        T.Assert (Info.Value /= Simple_Query.Query.Query.Get.Value,
--                  "The simple query instance was not changed");

      --  Due to the reference held by 'Info', it refers to the data loaded first.
--        T.Assert (Length (Info.Value.Main_Query (0).SQL) > 0, "The old query is not valid");
   end Test_Initialize;

   --  ------------------------------
   --  Test the Set_Query operation.
   --  ------------------------------
   procedure Test_Set_Query (T : in out Test) is
      Query : ADO.Queries.Context;
      Props : constant Util.Properties.Manager := Util.Tests.Get_Properties;
      Manager : Query_Manager;
      Config        : ADO.Drivers.Connections.Configuration;
   begin
      ADO.Queries.Loaders.Initialize (Manager, Config);
      Query.Set_Query ("simple-query");

      declare
         SQL : constant String := Query.Get_SQL (Manager);
      begin
         Assert_Equals (T, "select count(*) from user", SQL, "Invalid query for 'simple-query'");
      end;
   end Test_Set_Query;

   --  ------------------------------
   --  Test the Set_Limit operation.
   --  ------------------------------
   procedure Test_Set_Limit (T : in out Test) is
      Query : ADO.Queries.Context;
   begin
      Query.Set_Query ("index");
      Query.Set_Limit (0, 10);
      Assert_Equals (T, 0, Query.Get_First_Row_Index, "Invalid first row index");
      Assert_Equals (T, 10, Query.Get_Last_Row_Index, "Invalid last row index");
   end Test_Set_Limit;

   --  ------------------------------
   --  Test the Find_Query operation.
   --  ------------------------------
   procedure Test_Find_Query (T : in out Test) is
      Q : Query_Definition_Access;
   begin
      Q := ADO.Queries.Loaders.Find_Query ("this query does not exist");
      T.Assert (Q = null, "Find_Query should return null for unkown query");
   end Test_Find_Query;

end ADO.Queries.Tests;

Implement the Test_Find_Query test

Implement the Test_Find_Query test