-----------------------------------------------------------------------
--  awa-components-wikis -- Wiki rendering component
--  Copyright (C) 2011, 2015 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.Strings.Wide_Wide_Unbounded;

with Util.Beans.Basic;
with Util.Beans.Objects;

with ASF.Contexts.Faces;
with ASF.Components;
with ASF.Components.Html;

with Wiki.Parsers;
with Wiki.Render;
package AWA.Components.Wikis is

   use ASF.Contexts.Faces;

   --  The wiki format of the wiki text.  The valid values are:
   --  dotclear, google, creole, phpbb, mediawiki
   FORMAT_NAME : constant String := "format";

   VALUE_NAME  : constant String := ASF.Components.VALUE_NAME;

   --  The link renderer bean that controls the generation of page and image links.
   LINKS_NAME  : constant String := "links";

   --  ------------------------------
   --  Wiki component
   --  ------------------------------
   --
   --  <awa:wiki value="wiki-text" format="dotclear|google|creole|phpbb" styleClass="class"/>
   --
   type UIWiki is new ASF.Components.Html.UIHtmlComponent with null record;
   type UIWiki_Access is access all UIWiki'Class;

   --  Get the wiki format style.  The format style is obtained from the <b>format</b>
   --  attribute name.
   function Get_Wiki_Style (UI      : in UIWiki;
                            Context : in Faces_Context'Class)
                            return Wiki.Parsers.Wiki_Syntax_Type;

   --  Get the links renderer that must be used to render image and page links.
   function Get_Links_Renderer (UI      : in UIWiki;
                                Context : in Faces_Context'Class)
                                return Wiki.Render.Link_Renderer_Access;

   --  Render the wiki text
   overriding
   procedure Encode_Begin (UI      : in UIWiki;
                           Context : in out Faces_Context'Class);

   use Ada.Strings.Wide_Wide_Unbounded;

   type Link_Renderer_Bean is new Util.Beans.Basic.Readonly_Bean
     and Wiki.Render.Link_Renderer with record
      Page_Prefix  : Unbounded_Wide_Wide_String;
      Image_Prefix : Unbounded_Wide_Wide_String;
   end record;

   --  Make a link adding a prefix unless the link is already absolute.
   procedure Make_Link (Renderer : in Link_Renderer_Bean;
                        Link     : in Unbounded_Wide_Wide_String;
                        Prefix   : in Unbounded_Wide_Wide_String;
                        URI      : out Unbounded_Wide_Wide_String);

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Link_Renderer_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Get the image link that must be rendered from the wiki image link.
   overriding
   procedure Make_Image_Link (Renderer : in Link_Renderer_Bean;
                              Link     : in Unbounded_Wide_Wide_String;
                              URI      : out Unbounded_Wide_Wide_String;
                              Width    : out Natural;
                              Height   : out Natural);

   --  Get the page link that must be rendered from the wiki page link.
   overriding
   procedure Make_Page_Link (Renderer : in Link_Renderer_Bean;
                             Link     : in Unbounded_Wide_Wide_String;
                             URI      : out Unbounded_Wide_Wide_String;
                             Exists   : out Boolean);

private

   function Starts_With (Content : in Unbounded_Wide_Wide_String;
                         Item    : in String) return Boolean;

end AWA.Components.Wikis;

-----------------------------------------------------------------------
--  awa-components-wikis -- Wiki rendering component
--  Copyright (C) 2011, 2015 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.Strings.Wide_Wide_Unbounded;

with Util.Beans.Basic;
with Util.Beans.Objects;

with ASF.Contexts.Faces;
with ASF.Components;
with ASF.Components.Html;

with Wiki.Parsers;
with Wiki.Render;
package AWA.Components.Wikis is

   use ASF.Contexts.Faces;

   --  The wiki format of the wiki text.  The valid values are:
   --  dotclear, google, creole, phpbb, mediawiki
   FORMAT_NAME : constant String := "format";

   VALUE_NAME  : constant String := ASF.Components.VALUE_NAME;

   --  The link renderer bean that controls the generation of page and image links.
   LINKS_NAME  : constant String := "links";

   --  ------------------------------
   --  Wiki component
   --  ------------------------------
   --
   --  <awa:wiki value="wiki-text" format="dotclear|google|creole|phpbb" styleClass="class"/>
   --
   type UIWiki is new ASF.Components.Html.UIHtmlComponent with null record;
   type UIWiki_Access is access all UIWiki'Class;

   --  Get the wiki format style.  The format style is obtained from the <b>format</b>
   --  attribute name.
   function Get_Wiki_Style (UI      : in UIWiki;
                            Context : in Faces_Context'Class)
                            return Wiki.Parsers.Wiki_Syntax_Type;

   --  Get the links renderer that must be used to render image and page links.
   function Get_Links_Renderer (UI      : in UIWiki;
                                Context : in Faces_Context'Class)
                                return Wiki.Render.Link_Renderer_Access;

   --  Render the wiki text
   overriding
   procedure Encode_Begin (UI      : in UIWiki;
                           Context : in out Faces_Context'Class);

   use Ada.Strings.Wide_Wide_Unbounded;

   type Link_Renderer_Bean is new Util.Beans.Basic.Readonly_Bean
     and Wiki.Render.Link_Renderer with record
      Page_Prefix  : Unbounded_Wide_Wide_String;
      Image_Prefix : Unbounded_Wide_Wide_String;
   end record;

   --  Return true if the link is an absolute link.
   function Is_Link_Absolute (Renderer : in Link_Renderer_Bean;
                              Link     : in Unbounded_Wide_Wide_String) return Boolean;

   --  Make a link adding a prefix unless the link is already absolute.
   procedure Make_Link (Renderer : in Link_Renderer_Bean;
                        Link     : in Unbounded_Wide_Wide_String;
                        Prefix   : in Unbounded_Wide_Wide_String;
                        URI      : out Unbounded_Wide_Wide_String);

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Link_Renderer_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Get the image link that must be rendered from the wiki image link.
   overriding
   procedure Make_Image_Link (Renderer : in Link_Renderer_Bean;
                              Link     : in Unbounded_Wide_Wide_String;
                              URI      : out Unbounded_Wide_Wide_String;
                              Width    : out Natural;
                              Height   : out Natural);

   --  Get the page link that must be rendered from the wiki page link.
   overriding
   procedure Make_Page_Link (Renderer : in Link_Renderer_Bean;
                             Link     : in Unbounded_Wide_Wide_String;
                             URI      : out Unbounded_Wide_Wide_String;
                             Exists   : out Boolean);

private

   function Starts_With (Content : in Unbounded_Wide_Wide_String;
                         Item    : in String) return Boolean;

end AWA.Components.Wikis;

Declare Is_Link_Absolute function

Declare Is_Link_Absolute function


-----------------------------------------------------------------------
--  Logs -- Utility Log Package
--  Copyright (C) 2001, 2002, 2003, 2006, 2008, 2009, 2010, 2011 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.Strings;
with Ada.Strings.Fixed;

package body Util.Log is

   --  ------------------------------
   --  Get the log level name.
   --  ------------------------------
   function Get_Level_Name (Level : Level_Type) return String is
   begin
      if Level = FATAL_LEVEL then
         return "FATAL";
      elsif Level = ERROR_LEVEL then
         return "ERROR";
      elsif Level = WARN_LEVEL then
         return "WARN ";
      elsif Level = INFO_LEVEL then
         return "INFO ";
      elsif Level = DEBUG_LEVEL then
         return "DEBUG";
      else
         return Level_Type'Image (Level);
      end if;
   end Get_Level_Name;

   --  ------------------------------
   --  Get the log level from the property value
   --  ------------------------------
   function Get_Level (Value   : in String;
                       Default : in Level_Type := INFO_LEVEL) return Level_Type is
      use Ada.Strings;

      Val : constant String  := Fixed.Trim (Value, Both);
      Pos : constant Natural := Fixed.Index (Val, ",");
   begin
      if Pos > Val'First then
         return Get_Level (Val (Val'First .. Pos - 1), Default);
      elsif Val = "INFO" then
         return INFO_LEVEL;
      elsif Val = "DEBUG" then
         return DEBUG_LEVEL;
      elsif Val = "WARN" then
         return WARN_LEVEL;
      elsif Val = "ERROR" then
         return ERROR_LEVEL;
      elsif Val = "FATAL" then
         return FATAL_LEVEL;
      else
         return Default;
      end if;
   end Get_Level;

end Util.Log;

-----------------------------------------------------------------------
--  util-log -- Utility Log Package
--  Copyright (C) 2001, 2002, 2003, 2006, 2008, 2009, 2010, 2011, 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 Ada.Strings;
with Ada.Strings.Fixed;

package body Util.Log is

   --  ------------------------------
   --  Get the log level name.
   --  ------------------------------
   function Get_Level_Name (Level : Level_Type) return String is
   begin
      if Level = FATAL_LEVEL then
         return "FATAL";
      elsif Level = ERROR_LEVEL then
         return "ERROR";
      elsif Level = WARN_LEVEL then
         return "WARN ";
      elsif Level = INFO_LEVEL then
         return "INFO ";
      elsif Level = DEBUG_LEVEL then
         return "DEBUG";
      else
         return Level_Type'Image (Level);
      end if;
   end Get_Level_Name;

   --  ------------------------------
   --  Get the log level from the property value
   --  ------------------------------
   function Get_Level (Value   : in String;
                       Default : in Level_Type := INFO_LEVEL) return Level_Type is
      use Ada.Strings;

      Val : constant String  := Fixed.Trim (Value, Both);
      Pos : constant Natural := Fixed.Index (Val, ",");
   begin
      if Pos > Val'First then
         return Get_Level (Val (Val'First .. Pos - 1), Default);
      elsif Val = "INFO" then
         return INFO_LEVEL;
      elsif Val = "DEBUG" then
         return DEBUG_LEVEL;
      elsif Val = "WARN" then
         return WARN_LEVEL;
      elsif Val = "ERROR" then
         return ERROR_LEVEL;
      elsif Val = "FATAL" then
         return FATAL_LEVEL;
      else
         return Default;
      end if;
   end Get_Level;

end Util.Log;

Fix header style

Fix header style


-----------------------------------------------------------------------
--  mat-events-targets - Events received and collected from a target
--  Copyright (C) 2014, 2015 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.Containers.Ordered_Maps;
with Ada.Containers.Vectors;

with Util.Concurrent.Counters;

with MAT.Frames;
package MAT.Events.Targets is

   Not_Found : exception;

   type Event_Type is mod 16;
   type Probe_Index_Type is mod 16;

   type Event_Id_Type is new Natural;

   type Probe_Event_Type is record
      Id       : Event_Id_Type;
      Event    : MAT.Types.Uint16;
      Index    : Probe_Index_Type;
      Time     : MAT.Types.Target_Tick_Ref;
      Thread   : MAT.Types.Target_Thread_Ref;
      Frame    : MAT.Frames.Frame_Type;
      Addr     : MAT.Types.Target_Addr;
      Size     : MAT.Types.Target_Size;
      Old_Addr : MAT.Types.Target_Addr;
   end record;

   subtype Target_Event is Probe_Event_Type;

   package Target_Event_Vectors is
     new Ada.Containers.Vectors (Positive, Target_Event);

   subtype Target_Event_Vector is Target_Event_Vectors.Vector;
   subtype Target_Event_Cursor is Target_Event_Vectors.Cursor;

   type Target_Events is tagged limited private;
   type Target_Events_Access is access all Target_Events'Class;

   --  Add the event in the list of events and increment the event counter.
   procedure Insert (Target : in out Target_Events;
                     Event  : in Probe_Event_Type);

   procedure Get_Events (Target : in out Target_Events;
                         Start  : in MAT.Types.Target_Time;
                         Finish : in MAT.Types.Target_Time;
                         Into   : in out Target_Event_Vector);

   --  Get the start and finish time for the events that have been received.
   procedure Get_Time_Range (Target : in out Target_Events;
                             Start  : out MAT.Types.Target_Time;
                             Finish : out MAT.Types.Target_Time);

   --  Get the probe event with the given allocated unique id.
   function Get_Event (Target : in Target_Events;
                       Id     : in Event_Id_Type) return Probe_Event_Type;

   --  Get the current event counter.
   function Get_Event_Counter (Target : in Target_Events) return Integer;

private

   EVENT_BLOCK_SIZE : constant Event_Id_Type := 1024;

   type Probe_Event_Array is array (1 .. EVENT_BLOCK_SIZE) of Probe_Event_Type;

   type Event_Block is record
      Start  : MAT.Types.Target_Time;
      Finish : MAT.Types.Target_Time;
      Count  : Event_Id_Type := 0;
      Events : Probe_Event_Array;
   end record;
   type Event_Block_Access is access all Event_Block;

   use type MAT.Types.Target_Time;
   package Event_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Time,
                                      Element_Type => Event_Block_Access);

   subtype Event_Map is Event_Maps.Map;
   subtype Event_Cursor is Event_Maps.Cursor;

   package Event_Id_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => Event_Id_Type,
                                      Element_Type => Event_Block_Access);

   subtype Event_Id_Map is Event_Id_Maps.Map;
   subtype Event_Id_Cursor is Event_Id_Maps.Cursor;

   protected type Event_Collector is

      --  Add the event in the list of events.
      procedure Insert (Event  : in Probe_Event_Type);

      procedure Get_Events (Start  : in MAT.Types.Target_Time;
                            Finish : in MAT.Types.Target_Time;
                            Into   : in out Target_Event_Vector);

      --  Get the start and finish time for the events that have been received.
      procedure Get_Time_Range (Start  : out MAT.Types.Target_Time;
                                Finish : out MAT.Types.Target_Time);

      --  Get the probe event with the given allocated unique id.
      function Get_Event (Id : in Event_Id_Type) return Probe_Event_Type;

      --  Iterate over the events starting from the <tt>Start</tt> event and until the
      --  <tt>Finish</tt> event is found (inclusive).  Execute the <tt>Process</tt> procedure
      --  with each event instance.
      procedure Iterate (Start   : in Event_Id_Type;
                         Finish  : in Event_Id_Type;
                         Process : access procedure (Event : in Probe_Event_Type));

   private
      Current       : Event_Block_Access := null;
      Events        : Event_Map;
      Ids           : Event_Id_Map;
      Last_Id       : Event_Id_Type := 0;
   end Event_Collector;

   type Target_Events is tagged limited record
      Events      : Event_Collector;
      Event_Count : Util.Concurrent.Counters.Counter;
   end record;

end MAT.Events.Targets;

-----------------------------------------------------------------------
--  mat-events-targets - Events received and collected from a target
--  Copyright (C) 2014, 2015 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.Containers.Ordered_Maps;
with Ada.Containers.Vectors;

with Util.Concurrent.Counters;

with MAT.Frames;
package MAT.Events.Targets is

   Not_Found : exception;

   type Event_Type is mod 16;
   type Probe_Index_Type is mod 16;

   type Event_Id_Type is new Natural;

   type Probe_Event_Type is record
      Id       : Event_Id_Type;
      Event    : MAT.Types.Uint16;
      Index    : Probe_Index_Type;
      Time     : MAT.Types.Target_Tick_Ref;
      Thread   : MAT.Types.Target_Thread_Ref;
      Frame    : MAT.Frames.Frame_Type;
      Addr     : MAT.Types.Target_Addr;
      Size     : MAT.Types.Target_Size;
      Old_Addr : MAT.Types.Target_Addr;
   end record;

   subtype Target_Event is Probe_Event_Type;

   package Target_Event_Vectors is
     new Ada.Containers.Vectors (Positive, Target_Event);

   subtype Target_Event_Vector is Target_Event_Vectors.Vector;
   subtype Target_Event_Cursor is Target_Event_Vectors.Cursor;

   type Target_Events is tagged limited private;
   type Target_Events_Access is access all Target_Events'Class;

   --  Add the event in the list of events and increment the event counter.
   procedure Insert (Target : in out Target_Events;
                     Event  : in Probe_Event_Type);

   procedure Get_Events (Target : in out Target_Events;
                         Start  : in MAT.Types.Target_Time;
                         Finish : in MAT.Types.Target_Time;
                         Into   : in out Target_Event_Vector);

   --  Get the start and finish time for the events that have been received.
   procedure Get_Time_Range (Target : in out Target_Events;
                             Start  : out MAT.Types.Target_Time;
                             Finish : out MAT.Types.Target_Time);

   --  Get the probe event with the given allocated unique id.
   function Get_Event (Target : in Target_Events;
                       Id     : in Event_Id_Type) return Probe_Event_Type;

   --  Get the current event counter.
   function Get_Event_Counter (Target : in Target_Events) return Integer;

   --  Iterate over the events starting from the <tt>Start</tt> event and until the
   --  <tt>Finish</tt> event is found (inclusive).  Execute the <tt>Process</tt> procedure
   --  with each event instance.
   procedure Iterate (Target  : in out Target_Events;
                      Start   : in Event_Id_Type;
                      Finish  : in Event_Id_Type;
                      Process : access procedure (Event : in Probe_Event_Type));

private

   EVENT_BLOCK_SIZE : constant Event_Id_Type := 1024;

   type Probe_Event_Array is array (1 .. EVENT_BLOCK_SIZE) of Probe_Event_Type;

   type Event_Block is record
      Start  : MAT.Types.Target_Time;
      Finish : MAT.Types.Target_Time;
      Count  : Event_Id_Type := 0;
      Events : Probe_Event_Array;
   end record;
   type Event_Block_Access is access all Event_Block;

   use type MAT.Types.Target_Time;
   package Event_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Time,
                                      Element_Type => Event_Block_Access);

   subtype Event_Map is Event_Maps.Map;
   subtype Event_Cursor is Event_Maps.Cursor;

   package Event_Id_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => Event_Id_Type,
                                      Element_Type => Event_Block_Access);

   subtype Event_Id_Map is Event_Id_Maps.Map;
   subtype Event_Id_Cursor is Event_Id_Maps.Cursor;

   protected type Event_Collector is

      --  Add the event in the list of events.
      procedure Insert (Event  : in Probe_Event_Type);

      procedure Get_Events (Start  : in MAT.Types.Target_Time;
                            Finish : in MAT.Types.Target_Time;
                            Into   : in out Target_Event_Vector);

      --  Get the start and finish time for the events that have been received.
      procedure Get_Time_Range (Start  : out MAT.Types.Target_Time;
                                Finish : out MAT.Types.Target_Time);

      --  Get the probe event with the given allocated unique id.
      function Get_Event (Id : in Event_Id_Type) return Probe_Event_Type;

      --  Iterate over the events starting from the <tt>Start</tt> event and until the
      --  <tt>Finish</tt> event is found (inclusive).  Execute the <tt>Process</tt> procedure
      --  with each event instance.
      procedure Iterate (Start   : in Event_Id_Type;
                         Finish  : in Event_Id_Type;
                         Process : access procedure (Event : in Probe_Event_Type));

   private
      Current       : Event_Block_Access := null;
      Events        : Event_Map;
      Ids           : Event_Id_Map;
      Last_Id       : Event_Id_Type := 0;
   end Event_Collector;

   type Target_Events is tagged limited record
      Events      : Event_Collector;
      Event_Count : Util.Concurrent.Counters.Counter;
   end record;

end MAT.Events.Targets;

Declare the Iterate procedure

Declare the Iterate procedure


-----------------------------------------------------------------------
--  Memory clients - Client info related to its memory
--  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 MAT.Frames;
with MAT.Readers;
with MAT.Memory.Tools;
with MAT.Expressions;
package MAT.Memory.Targets is

   --  Define some global statistics about the memory slots.
   type Memory_Stat is record
      Thread_Count  : Natural;
      Total_Alloc   : MAT.Types.Target_Size;
      Total_Free    : MAT.Types.Target_Size;
      Malloc_Count  : Natural;
      Free_Count    : Natural;
      Realloc_Count : Natural;
   end record;

   type Target_Memory is tagged limited private;
   type Client_Memory_Ref is access all Target_Memory;

   --  Initialize the target memory object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory events.
   procedure Initialize (Memory : in out Target_Memory;
                         Reader : in out MAT.Readers.Manager_Base'Class);

   --  Take into account a malloc probe.  The memory slot [Addr .. Slot.Size] is inserted
   --  in the used slots map.  The freed slots that intersect the malloc'ed region are
   --  removed from the freed map.
   procedure Probe_Malloc (Memory : in out Target_Memory;
                           Addr   : in MAT.Types.Target_Addr;
                           Slot   : in Allocation);

   --  Take into account a free probe.  Add the memory slot in the freed map and remove
   --  the slot from the used slots map.
   procedure Probe_Free (Memory : in out Target_Memory;
                         Addr   : in MAT.Types.Target_Addr;
                         Slot   : in Allocation);

   --  Take into account a realloc probe.  The old memory slot represented by Old_Addr is
   --  removed from the used slots maps and the new memory slot [Addr .. Slot.Size] is
   --  inserted in the used slots map.
   procedure Probe_Realloc (Memory   : in out Target_Memory;
                            Addr     : in MAT.Types.Target_Addr;
                            Old_Addr : in MAT.Types.Target_Addr;
                            Slot     : in Allocation);

   --  Insert in the frame tree the new stack frame represented by <tt>Pc</tt>.
   --  If the frame is already known, the frame reference counter is incremented.
   --  The frame represented by <tt>Pc</tt> is returned in <tt>Result</tt>.
   procedure Create_Frame (Memory : in out Target_Memory;
                           Pc     : in MAT.Frames.Frame_Table;
                           Result : out MAT.Frames.Frame_Type);

   --  Collect the information about memory slot sizes allocated by the application.
   procedure Size_Information (Memory : in out Target_Memory;
                               Sizes  : in out MAT.Memory.Tools.Size_Info_Map);

   --  Collect the information about threads and the memory allocations they've made.
   procedure Thread_Information (Memory  : in out Target_Memory;
                                 Threads : in out Memory_Info_Map);

   --  Collect the information about frames and the memory allocations they've made.
   procedure Frame_Information (Memory : in out Target_Memory;
                                Level  : in Natural;
                                Frames : in out Frame_Info_Map);

   --  Find from the <tt>Memory</tt> map the memory slots whose address intersects
   --  the region [From .. To] and which is selected by the given filter expression.
   --  Add the memory slot in the <tt>Into</tt> list if it does not already contains
   --  the memory slot.
   procedure Find (Memory : in out Target_Memory;
                   From   : in MAT.Types.Target_Addr;
                   To     : in MAT.Types.Target_Addr;
                   Filter : in MAT.Expressions.Expression_Type;
                   Into   : in out MAT.Memory.Allocation_Map);

private

   protected type Memory_Allocator is

      --  Take into account a malloc probe.  The memory slot [Addr .. Slot.Size] is inserted
      --  in the used slots map.  The freed slots that intersect the malloc'ed region are
      --  removed from the freed map.
      procedure Probe_Malloc (Addr   : in MAT.Types.Target_Addr;
                              Slot   : in Allocation);

      --  Take into account a free probe.  Add the memory slot in the freed map and remove
      --  the slot from the used slots map.
      procedure Probe_Free (Addr   : in MAT.Types.Target_Addr;
                            Slot   : in Allocation);

      --  Take into account a realloc probe.  The old memory slot represented by Old_Addr is
      --  removed from the used slots maps and the new memory slot [Addr .. Slot.Size] is
      --  inserted in the used slots map.
      procedure Probe_Realloc (Addr     : in MAT.Types.Target_Addr;
                               Old_Addr : in MAT.Types.Target_Addr;
                               Slot     : in Allocation);

      --  Insert in the frame tree the new stack frame represented by <tt>Pc</tt>.
      --  If the frame is already known, the frame reference counter is incremented.
      --  The frame represented by <tt>Pc</tt> is returned in <tt>Result</tt>.
      procedure Create_Frame (Pc     : in MAT.Frames.Frame_Table;
                              Result : out MAT.Frames.Frame_Type);

      --  Collect the information about memory slot sizes allocated by the application.
      procedure Size_Information (Sizes  : in out MAT.Memory.Tools.Size_Info_Map);

      --  Collect the information about threads and the memory allocations they've made.
      procedure Thread_Information (Threads : in out Memory_Info_Map);

      --  Collect the information about frames and the memory allocations they've made.
      procedure Frame_Information (Level  : in Natural;
                                   Frames : in out Frame_Info_Map);

      --  Find from the <tt>Memory</tt> map the memory slots whose address intersects
      --  the region [From .. To] and which is selected by the given filter expression.
      --  Add the memory slot in the <tt>Into</tt> list if it does not already contains
      --  the memory slot.
      procedure Find (From   : in MAT.Types.Target_Addr;
                      To     : in MAT.Types.Target_Addr;
                      Filter : in MAT.Expressions.Expression_Type;
                      Into   : in out MAT.Memory.Allocation_Map);

      --  Get the global memory and allocation statistics.
      procedure Stat_Information (Result : out Memory_Stat);

   private
      Used_Slots    : Allocation_Map;
      Freed_Slots   : Allocation_Map;
      Stats         : Memory_Stat;
      Frames        : MAT.Frames.Frame_Type := MAT.Frames.Create_Root;
   end Memory_Allocator;

   type Target_Memory is tagged limited record
      Reader        : MAT.Readers.Reader_Access;
      Memory        : Memory_Allocator;
   end record;

end MAT.Memory.Targets;

-----------------------------------------------------------------------
--  Memory clients - Client info related to its memory
--  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 MAT.Frames;
with MAT.Readers;
with MAT.Memory.Tools;
with MAT.Expressions;
package MAT.Memory.Targets is

   --  Define some global statistics about the memory slots.
   type Memory_Stat is record
      Thread_Count  : Natural;
      Total_Alloc   : MAT.Types.Target_Size;
      Total_Free    : MAT.Types.Target_Size;
      Malloc_Count  : Natural;
      Free_Count    : Natural;
      Realloc_Count : Natural;
   end record;

   type Target_Memory is tagged limited private;
   type Client_Memory_Ref is access all Target_Memory;

   --  Initialize the target memory object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory events.
   procedure Initialize (Memory : in out Target_Memory;
                         Reader : in out MAT.Readers.Manager_Base'Class);

   --  Take into account a malloc probe.  The memory slot [Addr .. Slot.Size] is inserted
   --  in the used slots map.  The freed slots that intersect the malloc'ed region are
   --  removed from the freed map.
   procedure Probe_Malloc (Memory : in out Target_Memory;
                           Addr   : in MAT.Types.Target_Addr;
                           Slot   : in Allocation);

   --  Take into account a free probe.  Add the memory slot in the freed map and remove
   --  the slot from the used slots map.
   procedure Probe_Free (Memory : in out Target_Memory;
                         Addr   : in MAT.Types.Target_Addr;
                         Slot   : in Allocation);

   --  Take into account a realloc probe.  The old memory slot represented by Old_Addr is
   --  removed from the used slots maps and the new memory slot [Addr .. Slot.Size] is
   --  inserted in the used slots map.
   procedure Probe_Realloc (Memory   : in out Target_Memory;
                            Addr     : in MAT.Types.Target_Addr;
                            Old_Addr : in MAT.Types.Target_Addr;
                            Slot     : in Allocation);

   --  Insert in the frame tree the new stack frame represented by <tt>Pc</tt>.
   --  If the frame is already known, the frame reference counter is incremented.
   --  The frame represented by <tt>Pc</tt> is returned in <tt>Result</tt>.
   procedure Create_Frame (Memory : in out Target_Memory;
                           Pc     : in MAT.Frames.Frame_Table;
                           Result : out MAT.Frames.Frame_Type);

   --  Collect the information about memory slot sizes allocated by the application.
   procedure Size_Information (Memory : in out Target_Memory;
                               Sizes  : in out MAT.Memory.Tools.Size_Info_Map);

   --  Collect the information about threads and the memory allocations they've made.
   procedure Thread_Information (Memory  : in out Target_Memory;
                                 Threads : in out Memory_Info_Map);

   --  Collect the information about frames and the memory allocations they've made.
   procedure Frame_Information (Memory : in out Target_Memory;
                                Level  : in Natural;
                                Frames : in out Frame_Info_Map);

   --  Get the global memory and allocation statistics.
   procedure Stat_Information (Memory : in out Target_Memory;
                               Result : out Memory_Stat);

   --  Find from the <tt>Memory</tt> map the memory slots whose address intersects
   --  the region [From .. To] and which is selected by the given filter expression.
   --  Add the memory slot in the <tt>Into</tt> list if it does not already contains
   --  the memory slot.
   procedure Find (Memory : in out Target_Memory;
                   From   : in MAT.Types.Target_Addr;
                   To     : in MAT.Types.Target_Addr;
                   Filter : in MAT.Expressions.Expression_Type;
                   Into   : in out MAT.Memory.Allocation_Map);

private

   protected type Memory_Allocator is

      --  Take into account a malloc probe.  The memory slot [Addr .. Slot.Size] is inserted
      --  in the used slots map.  The freed slots that intersect the malloc'ed region are
      --  removed from the freed map.
      procedure Probe_Malloc (Addr   : in MAT.Types.Target_Addr;
                              Slot   : in Allocation);

      --  Take into account a free probe.  Add the memory slot in the freed map and remove
      --  the slot from the used slots map.
      procedure Probe_Free (Addr   : in MAT.Types.Target_Addr;
                            Slot   : in Allocation);

      --  Take into account a realloc probe.  The old memory slot represented by Old_Addr is
      --  removed from the used slots maps and the new memory slot [Addr .. Slot.Size] is
      --  inserted in the used slots map.
      procedure Probe_Realloc (Addr     : in MAT.Types.Target_Addr;
                               Old_Addr : in MAT.Types.Target_Addr;
                               Slot     : in Allocation);

      --  Insert in the frame tree the new stack frame represented by <tt>Pc</tt>.
      --  If the frame is already known, the frame reference counter is incremented.
      --  The frame represented by <tt>Pc</tt> is returned in <tt>Result</tt>.
      procedure Create_Frame (Pc     : in MAT.Frames.Frame_Table;
                              Result : out MAT.Frames.Frame_Type);

      --  Collect the information about memory slot sizes allocated by the application.
      procedure Size_Information (Sizes  : in out MAT.Memory.Tools.Size_Info_Map);

      --  Collect the information about threads and the memory allocations they've made.
      procedure Thread_Information (Threads : in out Memory_Info_Map);

      --  Collect the information about frames and the memory allocations they've made.
      procedure Frame_Information (Level  : in Natural;
                                   Frames : in out Frame_Info_Map);

      --  Find from the <tt>Memory</tt> map the memory slots whose address intersects
      --  the region [From .. To] and which is selected by the given filter expression.
      --  Add the memory slot in the <tt>Into</tt> list if it does not already contains
      --  the memory slot.
      procedure Find (From   : in MAT.Types.Target_Addr;
                      To     : in MAT.Types.Target_Addr;
                      Filter : in MAT.Expressions.Expression_Type;
                      Into   : in out MAT.Memory.Allocation_Map);

      --  Get the global memory and allocation statistics.
      procedure Stat_Information (Result : out Memory_Stat);

   private
      Used_Slots    : Allocation_Map;
      Freed_Slots   : Allocation_Map;
      Stats         : Memory_Stat;
      Frames        : MAT.Frames.Frame_Type := MAT.Frames.Create_Root;
   end Memory_Allocator;

   type Target_Memory is tagged limited record
      Reader        : MAT.Readers.Reader_Access;
      Memory        : Memory_Allocator;
   end record;

end MAT.Memory.Targets;

Declare the Stat_Information procedure

Declare the Stat_Information procedure


-----------------------------------------------------------------------
--  Memory clients - Client info related to its memory
--  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 MAT.Frames;
with Util.Events;
with MAT.Memory.Events;
with MAT.Readers;
with Ada.Containers.Ordered_Maps;
package MAT.Memory.Targets is

   type Target_Memory is record
      Reader        : MAT.Readers.Reader_Access;
      Memory_Slots  : Allocation_Map;
      Frames        : MAT.Frames.Frame;
--        Event_Channel : MAT.Memory.Events.Memory_Event_Channel.Channel;
   end record;
   type Client_Memory_Ref is access all Target_Memory;

   --  Initialize the target memory object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory events.
   procedure Initialize (Memory : in out Target_Memory;
                         Reader : in out MAT.Readers.Manager_Base'Class);

   type Size_Info_Type is record
      Count : Natural;
   end record;

   use type MAT.Types.Target_Size;

   package Size_Info_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type => MAT.Types.Target_Size,
                                      Element_Type => Size_Info_Type);
   subtype Size_Info_Map is Size_Info_Maps.Map;
   subtype Size_Info_Cursor is Size_Info_Maps.Cursor;

   --  Collect the information about memory slot sizes allocated by the application.
   procedure Size_Information (Memory : in Target_Memory;
                               Sizes  : in out Size_Info_Map);

end MAT.Memory.Targets;

-----------------------------------------------------------------------
--  Memory clients - Client info related to its memory
--  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 MAT.Frames;
with Util.Events;
with MAT.Memory.Events;
with MAT.Readers;
with Ada.Containers.Ordered_Maps;
package MAT.Memory.Targets is

   type Target_Memory is record
      Reader        : MAT.Readers.Reader_Access;
      Memory_Slots  : Allocation_Map;
      Frames        : MAT.Frames.Frame_Ptr;
--        Event_Channel : MAT.Memory.Events.Memory_Event_Channel.Channel;
   end record;
   type Client_Memory_Ref is access all Target_Memory;

   --  Initialize the target memory object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory events.
   procedure Initialize (Memory : in out Target_Memory;
                         Reader : in out MAT.Readers.Manager_Base'Class);

   type Size_Info_Type is record
      Count : Natural;
   end record;

   use type MAT.Types.Target_Size;

   package Size_Info_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type => MAT.Types.Target_Size,
                                      Element_Type => Size_Info_Type);
   subtype Size_Info_Map is Size_Info_Maps.Map;
   subtype Size_Info_Cursor is Size_Info_Maps.Cursor;

   --  Collect the information about memory slot sizes allocated by the application.
   procedure Size_Information (Memory : in Target_Memory;
                               Sizes  : in out Size_Info_Map);

end MAT.Memory.Targets;

Change the frame object to a Frame_PTr

Change the frame object to a Frame_PTr


-----------------------------------------------------------------------
--  awa-storages-services -- Storage service
--  Copyright (C) 2012, 2016 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.Calendar;
with Ada.Strings.Unbounded;

with Util.Concurrent.Counters;

with Security.Permissions;

with ADO;
with ASF.Parts;
with AWA.Modules;
with AWA.Modules.Lifecycles;

with AWA.Storages.Models;
with AWA.Storages.Stores;
with AWA.Storages.Stores.Databases;

--  == Storage Service ==
--  The <tt>Storage_Service</tt> provides the operations to access and use the persisent storage.
--  It controls the permissions that grant access to the service for users.
--
--  Other modules can be notified of storage changes by registering a listener
--  on the storage module.
--
--  @include awa-storages-stores.ads
package AWA.Storages.Services is

   package ACL_Create_Storage is new Security.Permissions.Definition ("storage-create");
   package ACL_Delete_Storage is new Security.Permissions.Definition ("storage-delete");
   package ACL_Create_Folder is new Security.Permissions.Definition ("folder-create");

   type Read_Mode is (READ, WRITE);

   type Expire_Type is (ONE_HOUR, ONE_DAY, TWO_DAYS, ONE_WEEK, ONE_YEAR, NEVER);

   package Storage_Lifecycle is
     new AWA.Modules.Lifecycles (Element_Type => AWA.Storages.Models.Storage_Ref'Class);

   subtype Listener is Storage_Lifecycle.Listener;

   --  ------------------------------
   --  Storage Service
   --  ------------------------------
   --  The Storage_Service defines a set of operations to store and retrieve
   --  a data object from the persistent storage.  The data object is treated as a raw
   --  byte stream.  The persistent storage can be implemented by a database, a file
   --  system or a remote service such as Amazon AWS.
   type Storage_Service is new AWA.Modules.Module_Manager with private;
   type Storage_Service_Access is access all Storage_Service'Class;

   --  Initializes the storage service.
   overriding
   procedure Initialize (Service : in out Storage_Service;
                         Module  : in AWA.Modules.Module'Class);

   --  Get the persistent store that manages the data store identified by <tt>Kind</tt>.
   function Get_Store (Service : in Storage_Service;
                       Kind    : in AWA.Storages.Models.Storage_Type)
                       return AWA.Storages.Stores.Store_Access;

   --  Create or save the folder.
   procedure Save_Folder (Service : in Storage_Service;
                          Folder  : in out AWA.Storages.Models.Storage_Folder_Ref'Class);

   --  Load the folder instance identified by the given identifier.
   procedure Load_Folder (Service : in Storage_Service;
                          Folder  : in out AWA.Storages.Models.Storage_Folder_Ref'Class;
                          Id      : in ADO.Identifier);

   --  Save the data object contained in the Data part element into the
   --  target storage represented by Into.
   procedure Save (Service : in Storage_Service;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   Data    : in ASF.Parts.Part'Class;
                   Storage : in AWA.Storages.Models.Storage_Type);

   --  Save the file described File in the storage
   --  object represented by Into and managed by the storage service.
   procedure Save (Service : in Storage_Service;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   File    : in AWA.Storages.Storage_File;
                   Storage : in AWA.Storages.Models.Storage_Type);

   --  Save the file pointed to by the Path string in the storage
   --  object represented by Into and managed by the storage service.
   procedure Save (Service : in Storage_Service;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   Path    : in String;
                   Storage : in AWA.Storages.Models.Storage_Type);

   --  Load the storage instance identified by the given identifier.
   procedure Load_Storage (Service : in Storage_Service;
                           Storage : in out AWA.Storages.Models.Storage_Ref'Class;
                           Id      : in ADO.Identifier);

   --  Load the storage instance stored in a folder and identified by a name.
   procedure Load_Storage (Service : in Storage_Service;
                           Storage : in out AWA.Storages.Models.Storage_Ref'Class;
                           Folder  : in ADO.Identifier;
                           Name    : in String;
                           Found   : out Boolean);

   --  Load the storage content identified by From into the blob descriptor Into.
   --  Raises the NOT_FOUND exception if there is no such storage.
   procedure Load (Service : in Storage_Service;
                   From    : in ADO.Identifier;
                   Name    : out Ada.Strings.Unbounded.Unbounded_String;
                   Mime    : out Ada.Strings.Unbounded.Unbounded_String;
                   Date    : out Ada.Calendar.Time;
                   Into    : out ADO.Blob_Ref);

   --  Load the storage content into a file.  If the data is not stored in a file, a temporary
   --  file is created with the data content fetched from the store (ex: the database).
   --  The `Mode` parameter indicates whether the file will be read or written.
   --  The `Expire` parameter allows to control the expiration of the temporary file.
   procedure Get_Local_File (Service : in Storage_Service;
                             From    : in ADO.Identifier;
                             Mode    : in Read_Mode := READ;
                             Into    : out Storage_File);

   procedure Create_Local_File (Service : in out Storage_Service;
                                Into    : in out AWA.Storages.Storage_File);

   --  Deletes the storage instance.
   procedure Delete (Service : in Storage_Service;
                     Storage : in out AWA.Storages.Models.Storage_Ref'Class);

   --  Deletes the storage instance.
   procedure Delete (Service : in Storage_Service;
                     Storage : in ADO.Identifier);

private

   type Store_Access_Array is
     array (AWA.Storages.Models.Storage_Type) of AWA.Storages.Stores.Store_Access;

   type Storage_Service is new AWA.Modules.Module_Manager with record
      Stores         : Store_Access_Array;
      Database_Store : aliased AWA.Storages.Stores.Databases.Database_Store;
      Temp_Id        : Util.Concurrent.Counters.Counter;
   end record;

end AWA.Storages.Services;

-----------------------------------------------------------------------
--  awa-storages-services -- Storage service
--  Copyright (C) 2012, 2016 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.Calendar;
with Ada.Strings.Unbounded;

with Util.Concurrent.Counters;

with Security.Permissions;

with ADO;
with ASF.Parts;
with AWA.Modules;
with AWA.Modules.Lifecycles;

with AWA.Storages.Models;
with AWA.Storages.Stores;
with AWA.Storages.Stores.Databases;

--  == Storage Service ==
--  The <tt>Storage_Service</tt> provides the operations to access and use the persisent storage.
--  It controls the permissions that grant access to the service for users.
--
--  Other modules can be notified of storage changes by registering a listener
--  on the storage module.
--
--  @include awa-storages-stores.ads
package AWA.Storages.Services is

   package ACL_Create_Storage is new Security.Permissions.Definition ("storage-create");
   package ACL_Delete_Storage is new Security.Permissions.Definition ("storage-delete");
   package ACL_Create_Folder is new Security.Permissions.Definition ("folder-create");

   type Read_Mode is (READ, WRITE);

   type Expire_Type is (ONE_HOUR, ONE_DAY, TWO_DAYS, ONE_WEEK, ONE_YEAR, NEVER);

   package Storage_Lifecycle is
     new AWA.Modules.Lifecycles (Element_Type => AWA.Storages.Models.Storage_Ref'Class);

   subtype Listener is Storage_Lifecycle.Listener;

   --  ------------------------------
   --  Storage Service
   --  ------------------------------
   --  The Storage_Service defines a set of operations to store and retrieve
   --  a data object from the persistent storage.  The data object is treated as a raw
   --  byte stream.  The persistent storage can be implemented by a database, a file
   --  system or a remote service such as Amazon AWS.
   type Storage_Service is new AWA.Modules.Module_Manager with private;
   type Storage_Service_Access is access all Storage_Service'Class;

   --  Initializes the storage service.
   overriding
   procedure Initialize (Service : in out Storage_Service;
                         Module  : in AWA.Modules.Module'Class);

   --  Get the persistent store that manages the data store identified by <tt>Kind</tt>.
   function Get_Store (Service : in Storage_Service;
                       Kind    : in AWA.Storages.Models.Storage_Type)
                       return AWA.Storages.Stores.Store_Access;

   --  Create or save the folder.
   procedure Save_Folder (Service : in Storage_Service;
                          Folder  : in out AWA.Storages.Models.Storage_Folder_Ref'Class);

   --  Load the folder instance identified by the given identifier.
   procedure Load_Folder (Service : in Storage_Service;
                          Folder  : in out AWA.Storages.Models.Storage_Folder_Ref'Class;
                          Id      : in ADO.Identifier);

   --  Save the data object contained in the Data part element into the
   --  target storage represented by Into.
   procedure Save (Service : in Storage_Service;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   Data    : in ASF.Parts.Part'Class;
                   Storage : in AWA.Storages.Models.Storage_Type);

   --  Save the file described File in the storage
   --  object represented by Into and managed by the storage service.
   procedure Save (Service : in Storage_Service;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   File    : in AWA.Storages.Storage_File;
                   Storage : in AWA.Storages.Models.Storage_Type);

   --  Save the file pointed to by the Path string in the storage
   --  object represented by Into and managed by the storage service.
   procedure Save (Service : in Storage_Service;
                   Into    : in out AWA.Storages.Models.Storage_Ref'Class;
                   Path    : in String;
                   Storage : in AWA.Storages.Models.Storage_Type);

   --  Load the storage instance identified by the given identifier.
   procedure Load_Storage (Service : in Storage_Service;
                           Storage : in out AWA.Storages.Models.Storage_Ref'Class;
                           Id      : in ADO.Identifier);

   --  Load the storage instance stored in a folder and identified by a name.
   procedure Load_Storage (Service : in Storage_Service;
                           Storage : in out AWA.Storages.Models.Storage_Ref'Class;
                           Folder  : in ADO.Identifier;
                           Name    : in String;
                           Found   : out Boolean);

   --  Load the storage content identified by From into the blob descriptor Into.
   --  Raises the NOT_FOUND exception if there is no such storage.
   procedure Load (Service : in Storage_Service;
                   From    : in ADO.Identifier;
                   Name    : out Ada.Strings.Unbounded.Unbounded_String;
                   Mime    : out Ada.Strings.Unbounded.Unbounded_String;
                   Date    : out Ada.Calendar.Time;
                   Into    : out ADO.Blob_Ref);

   --  Load the storage content into a file.  If the data is not stored in a file, a temporary
   --  file is created with the data content fetched from the store (ex: the database).
   --  The `Mode` parameter indicates whether the file will be read or written.
   --  The `Expire` parameter allows to control the expiration of the temporary file.
   procedure Get_Local_File (Service : in Storage_Service;
                             From    : in ADO.Identifier;
                             Mode    : in Read_Mode := READ;
                             Into    : in out Storage_File);

   procedure Create_Local_File (Service : in out Storage_Service;
                                Into    : in out AWA.Storages.Storage_File);

   --  Deletes the storage instance.
   procedure Delete (Service : in Storage_Service;
                     Storage : in out AWA.Storages.Models.Storage_Ref'Class);

   --  Deletes the storage instance.
   procedure Delete (Service : in Storage_Service;
                     Storage : in ADO.Identifier);

private

   type Store_Access_Array is
     array (AWA.Storages.Models.Storage_Type) of AWA.Storages.Stores.Store_Access;

   type Storage_Service is new AWA.Modules.Module_Manager with record
      Stores         : Store_Access_Array;
      Database_Store : aliased AWA.Storages.Stores.Databases.Database_Store;
      Temp_Id        : Util.Concurrent.Counters.Counter;
   end record;

end AWA.Storages.Services;

Change Get_Local_File to use a in out parameter for the storage file


-----------------------------------------------------------------------
--  ASF tests - ASF Tests Framework
--  Copyright (C) 2011, 2012, 2015, 2020 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.Properties;
with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with ASF.Server;
with ASF.Applications.Main;
with Servlet.Tests;
with Util.Tests;
with Util.XUnit;

with EL.Contexts.Default;
with EL.Variables;

with GNAT.Source_Info;

--  The <b>ASF.Tests</b> package provides a set of utility procedures to write a unit test
--  on top of ASF.
package ASF.Tests is

   --  Initialize the asf test framework mockup.  If the application is not specified,
   --  a default ASF application is created.
   procedure Initialize (Props       : in Util.Properties.Manager;
                         Application : in ASF.Applications.Main.Application_Access := null;
                         Factory     : in out ASF.Applications.Main.Application_Factory'Class);

   --  Called when the testsuite execution has finished.
   procedure Finish (Status : in Util.XUnit.Status) renames Servlet.Tests.Finish;

   --  Get the server
   function Get_Server return access ASF.Server.Container renames Servlet.Tests.Get_Server;

   --  Get the test application.
   function Get_Application return ASF.Applications.Main.Application_Access;

   --  Simulate a GET request on the given URI with the request parameters.
   --  Get the result in the response object.
   procedure Do_Get (Request  : in out ASF.Requests.Mockup.Request;
                     Response : in out ASF.Responses.Mockup.Response;
                     URI      : in String;
                     Save     : in String := "") renames Servlet.Tests.Do_Get;

   --  Simulate a POST request on the given URI with the request parameters.
   --  Get the result in the response object.
   procedure Do_Post (Request  : in out ASF.Requests.Mockup.Request'Class;
                      Response : in out ASF.Responses.Mockup.Response'Class;
                      URI      : in String;
                      Save     : in String := "") renames Servlet.Tests.Do_Post;

   --  Simulate a raw request.  The URI and method must have been set on the Request object.
   procedure Do_Req (Request  : in out ASF.Requests.Mockup.Request'Class;
                     Response : in out ASF.Responses.Mockup.Response'Class)
                     renames Servlet.Tests.Do_Req;

   --  Check that the response body contains the string
   procedure Assert_Contains (T       : in Util.Tests.Test'Class;
                              Value   : in String;
                              Reply   : in out ASF.Responses.Mockup.Response;
                              Message : in String := "Test failed";
                              Source  : String := GNAT.Source_Info.File;
                              Line    : Natural := GNAT.Source_Info.Line)
                              renames Servlet.Tests.Assert_Contains;

   --  Check that the response body matches the regular expression
   procedure Assert_Matches (T       : in Util.Tests.Test'Class;
                             Pattern : in String;
                             Reply   : in out ASF.Responses.Mockup.Response;
                             Message : in String := "Test failed";
                             Status  : in Natural := ASF.Responses.SC_OK;
                             Source  : String := GNAT.Source_Info.File;
                             Line    : Natural := GNAT.Source_Info.Line)
                             renames Servlet.Tests.Assert_Matches;

   --  Check that the response body is a redirect to the given URI.
   procedure Assert_Redirect (T       : in Util.Tests.Test'Class;
                              Value   : in String;
                              Reply   : in out ASF.Responses.Mockup.Response;
                              Message : in String := "Test failed";
                              Source  : String := GNAT.Source_Info.File;
                              Line    : Natural := GNAT.Source_Info.Line)
                              renames Servlet.Tests.Assert_Redirect;

   --  Check that the response contains the given header.
   procedure Assert_Header (T       : in Util.Tests.Test'Class;
                            Header  : in String;
                            Value   : in String;
                            Reply   : in out ASF.Responses.Mockup.Response;
                            Message : in String := "Test failed";
                            Status  : in Natural := ASF.Responses.SC_OK;
                            Source  : String := GNAT.Source_Info.File;
                            Line    : Natural := GNAT.Source_Info.Line)
                            renames Servlet.Tests.Assert_Header;

   type EL_Test is new Util.Tests.Test with record
      --  The ELContext, Variables, Resolver, Form area controlled object.
      --  Due to AUnit implementation, we cannot store a controlled object in the Test object.
      --  This is due to the 'for Obj'Address use Ret;' clause used by AUnit to allocate
      --  a test object.
      --  The application object is allocated dyanmically by Set_Up.
      ELContext      : EL.Contexts.Default.Default_Context_Access;
      Variables      : EL.Variables.Variable_Mapper_Access;
      Root_Resolver  : EL.Contexts.Default.Default_ELResolver_Access;
   end record;

   --  Cleanup the test instance.
   overriding
   procedure Tear_Down (T : in out EL_Test);

   --  Setup the test instance.
   overriding
   procedure Set_Up (T : in out EL_Test);

end ASF.Tests;

-----------------------------------------------------------------------
--  ASF tests - ASF Tests Framework
--  Copyright (C) 2011, 2012, 2015, 2020 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.Properties;
with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with ASF.Server;
with ASF.Applications.Main;
with Servlet.Tests;
with Util.Tests;
with Util.XUnit;

with EL.Contexts.Default;
with EL.Variables;

with GNAT.Source_Info;

--  The <b>ASF.Tests</b> package provides a set of utility procedures to write a unit test
--  on top of ASF.
package ASF.Tests is

   --  Initialize the asf test framework mockup.  If the application is not specified,
   --  a default ASF application is created.
   procedure Initialize (Props       : in Util.Properties.Manager;
                         Application : in ASF.Applications.Main.Application_Access := null;
                         Factory     : in out ASF.Applications.Main.Application_Factory'Class);

   --  Called when the testsuite execution has finished.
   procedure Finish (Status : in Util.XUnit.Status) renames Servlet.Tests.Finish;

   --  Get the server
   function Get_Server return access ASF.Server.Container renames Servlet.Tests.Get_Server;

   --  Get the test application.
   function Get_Application return ASF.Applications.Main.Application_Access;

   --  Simulate a GET request on the given URI with the request parameters.
   --  Get the result in the response object.
   procedure Do_Get (Request  : in out ASF.Requests.Mockup.Request'Class;
                     Response : in out ASF.Responses.Mockup.Response'Class;
                     URI      : in String;
                     Save     : in String := "") renames Servlet.Tests.Do_Get;

   --  Simulate a POST request on the given URI with the request parameters.
   --  Get the result in the response object.
   procedure Do_Post (Request  : in out ASF.Requests.Mockup.Request'Class;
                      Response : in out ASF.Responses.Mockup.Response'Class;
                      URI      : in String;
                      Save     : in String := "") renames Servlet.Tests.Do_Post;

   --  Simulate a raw request.  The URI and method must have been set on the Request object.
   procedure Do_Req (Request  : in out ASF.Requests.Mockup.Request'Class;
                     Response : in out ASF.Responses.Mockup.Response'Class)
                     renames Servlet.Tests.Do_Req;

   --  Check that the response body contains the string
   procedure Assert_Contains (T       : in Util.Tests.Test'Class;
                              Value   : in String;
                              Reply   : in out ASF.Responses.Mockup.Response;
                              Message : in String := "Test failed";
                              Source  : String := GNAT.Source_Info.File;
                              Line    : Natural := GNAT.Source_Info.Line)
                              renames Servlet.Tests.Assert_Contains;

   --  Check that the response body matches the regular expression
   procedure Assert_Matches (T       : in Util.Tests.Test'Class;
                             Pattern : in String;
                             Reply   : in out ASF.Responses.Mockup.Response;
                             Message : in String := "Test failed";
                             Status  : in Natural := ASF.Responses.SC_OK;
                             Source  : String := GNAT.Source_Info.File;
                             Line    : Natural := GNAT.Source_Info.Line)
                             renames Servlet.Tests.Assert_Matches;

   --  Check that the response body is a redirect to the given URI.
   procedure Assert_Redirect (T       : in Util.Tests.Test'Class;
                              Value   : in String;
                              Reply   : in out ASF.Responses.Mockup.Response;
                              Message : in String := "Test failed";
                              Source  : String := GNAT.Source_Info.File;
                              Line    : Natural := GNAT.Source_Info.Line)
                              renames Servlet.Tests.Assert_Redirect;

   --  Check that the response contains the given header.
   procedure Assert_Header (T       : in Util.Tests.Test'Class;
                            Header  : in String;
                            Value   : in String;
                            Reply   : in out ASF.Responses.Mockup.Response;
                            Message : in String := "Test failed";
                            Status  : in Natural := ASF.Responses.SC_OK;
                            Source  : String := GNAT.Source_Info.File;
                            Line    : Natural := GNAT.Source_Info.Line)
                            renames Servlet.Tests.Assert_Header;

   type EL_Test is new Util.Tests.Test with record
      --  The ELContext, Variables, Resolver, Form area controlled object.
      --  Due to AUnit implementation, we cannot store a controlled object in the Test object.
      --  This is due to the 'for Obj'Address use Ret;' clause used by AUnit to allocate
      --  a test object.
      --  The application object is allocated dyanmically by Set_Up.
      ELContext      : EL.Contexts.Default.Default_Context_Access;
      Variables      : EL.Variables.Variable_Mapper_Access;
      Root_Resolver  : EL.Contexts.Default.Default_ELResolver_Access;
   end record;

   --  Cleanup the test instance.
   overriding
   procedure Tear_Down (T : in out EL_Test);

   --  Setup the test instance.
   overriding
   procedure Set_Up (T : in out EL_Test);

end ASF.Tests;

Update Do_Get to allow class wide request and response


-----------------------------------------------------------------------
--  util-encoders -- Encode/Decode streams and strings from one format to another
--  Copyright (C) 2009, 2010, 2011, 2016 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.Unchecked_Deallocation;
with Util.Encoders.Base16;
with Util.Encoders.Base64;
with Util.Encoders.SHA1;
package body Util.Encoders is

   use Ada;
   use Ada.Strings.Unbounded;

   use type Ada.Streams.Stream_Element_Offset;

   --  ------------------------------
   --  Encodes the input string Data using the transformation
   --  rules provided by the E encoder.
   --
   --  Returns the encoded string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be encoded.
   --  Raises the Not_Supported exception if the encoding is not
   --  supported.
   --  ------------------------------
   function Encode (E    : in Encoder;
                    Data : in String) return String is
   begin
      if E.Encode = null then
         raise Not_Supported with "There is no encoder";
      end if;
      return E.Encode.Transform (Data);
   end Encode;

   --  ------------------------------
   --  Decodes the input string Data using the transformation
   --  rules provided by the E encoder.
   --
   --  Returns the encoded string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be decoded.
   --  Raises the Not_Supported exception if the decoding is not
   --  supported.
   --  ------------------------------
   function Decode (E    : in Encoder;
                    Data : in String) return String is
   begin
      if E.Decode = null then
         raise Not_Supported with "There is no decoder";
      end if;
      return E.Decode.Transform (Data);
   end Decode;

   MIN_BUFFER_SIZE : constant Streams.Stream_Element_Offset := 64;
   MAX_BUFFER_SIZE : constant Streams.Stream_Element_Offset := 2_048;

   function Best_Size (Length : Natural) return Streams.Stream_Element_Offset;
   pragma Inline (Best_Size);

   --  ------------------------------
   --  Compute a good size for allocating a buffer on the stack
   --  ------------------------------
   function Best_Size (Length : Natural) return Streams.Stream_Element_Offset is
   begin
      if Length < Natural (MIN_BUFFER_SIZE) then
         return MIN_BUFFER_SIZE;
      elsif Length > Natural (MAX_BUFFER_SIZE) then
         return MAX_BUFFER_SIZE;
      else
         return Streams.Stream_Element_Offset (((Length + 15) / 16) * 16);
      end if;
   end Best_Size;

   --  ------------------------------
   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer.
   --
   --  Returns the transformed string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   --  ------------------------------
   function Transform (E    : in Transformer'Class;
                       Data : in String) return String is
      Buf_Size : constant Streams.Stream_Element_Offset := Best_Size (Data'Length);
      Buf      : Streams.Stream_Element_Array (1 .. Buf_Size);
      Res      : Streams.Stream_Element_Array (1 .. Buf_Size);
      Tmp      : String (1 .. Natural (Buf_Size));
      Result   : Ada.Strings.Unbounded.Unbounded_String;
      Pos      : Natural := Data'First;
   begin
      while Pos <= Data'Last loop
         declare
            Last_Encoded  : Streams.Stream_Element_Offset;
            First_Encoded : Streams.Stream_Element_Offset := 1;
            Last          : Streams.Stream_Element_Offset;
            Size          : Streams.Stream_Element_Offset;
            Next_Pos      : Natural;
         begin
            --  Fill the stream buffer with our input string
            Size := Streams.Stream_Element_Offset (Data'Last - Pos + 1);
            if Size > Buf'Length then
               Size := Buf'Length;
            end if;
            for I in 1 .. Size loop
               Buf (I) := Character'Pos (Data (Natural (I) + Pos - 1));
            end loop;
            Next_Pos := Pos + Natural (Size);

            --  Encode that buffer and put the result in out result string.
            loop
               E.Transform (Data    => Buf (First_Encoded .. Size),
                            Into    => Res,
                            Encoded => Last_Encoded,
                            Last    => Last);

               --  If the encoder generated nothing, move the position backward
               --  to take into account the remaining bytes not taken into account.
               if Last < 1 then
                  Next_Pos := Next_Pos - Natural (Size - First_Encoded + 1);
                  exit;
               end if;
               for I in 1 .. Last loop
                  Tmp (Natural (I)) := Character'Val (Res (I));
               end loop;
               Append (Result, Tmp (1 .. Natural (Last)));
               exit when Last_Encoded = Size;
               First_Encoded := Last_Encoded + 1;
            end loop;

            --  The encoder cannot encode the data
            if Pos = Next_Pos then
               raise Encoding_Error with "Encoding cannot proceed";
            end if;
            Pos := Next_Pos;
         end;
      end loop;
      return To_String (Result);
   end Transform;

   --  ------------------------------
   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer and return the data in
   --  the Into array, setting Last to the last index.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   --  ------------------------------
   procedure Transform (E    : in Transformer'Class;
                        Data : in String;
                        Into : out Ada.Streams.Stream_Element_Array;
                        Last : out Ada.Streams.Stream_Element_Offset) is
      Buf_Size : constant Streams.Stream_Element_Offset := Best_Size (Data'Length);
      Buf      : Streams.Stream_Element_Array (1 .. Buf_Size);
      Pos      : Natural := Data'First;
      First    : Streams.Stream_Element_Offset := Into'First;
   begin
      Last := Into'First - 1;
      while Pos <= Data'Last and Last < Into'Last loop
         declare
            Last_Encoded  : Streams.Stream_Element_Offset;
            Size          : Streams.Stream_Element_Offset;
            Next_Pos      : Natural;
         begin
            --  Fill the stream buffer with our input string
            Size := Streams.Stream_Element_Offset (Data'Last - Pos + 1);
            if Size > Buf'Length then
               Size := Buf'Length;
            end if;
            for I in 1 .. Size loop
               Buf (I) := Character'Pos (Data (Natural (I) + Pos - 1));
            end loop;
            Next_Pos := Pos + Natural (Size);

            --  Encode that buffer and put the result in the output data array.
            E.Transform (Data    => Buf (1 .. Size),
                         Into    => Into (First .. Into'Last),
                         Encoded => Last_Encoded,
                         Last    => Last);

            --  If the encoded has not used all the data, update the position for the next run.
            if Last_Encoded /= Size then
               Next_Pos := Next_Pos - Natural (Size - Last_Encoded + 1);
            end if;

            --  The encoder cannot encode the data
            if Pos = Next_Pos then
               raise Encoding_Error with "Encoding cannot proceed";
            end if;
            First := Last;
            Pos := Next_Pos;
         end;
      end loop;
      if Pos <= Data'Last then
         raise Encoding_Error with "Not enough space for encoding";
      end if;
   end Transform;

   --  ------------------------------
   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer.
   --
   --  Returns the transformed string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   --  ------------------------------
   function Transform (E    : in Transformer'Class;
                       Data : in Streams.Stream_Element_Array) return String is
      Buf_Size : constant Streams.Stream_Element_Offset := Best_Size (Data'Length);
      Res      : Streams.Stream_Element_Array (1 .. Buf_Size);
      Tmp      : String (1 .. Natural (Buf_Size));
      Result   : Ada.Strings.Unbounded.Unbounded_String;
      Last_Encoded  : Streams.Stream_Element_Offset;
      Last          : Streams.Stream_Element_Offset;
   begin

      --  Encode that buffer and put the result in out result string.
      E.Transform (Data    => Data,
                   Into    => Res,
                   Encoded => Last_Encoded,
                   Last    => Last);

      for I in 1 .. Last loop
         Tmp (Natural (I)) := Character'Val (Res (I));
      end loop;
      Append (Result, Tmp (1 .. Natural (Last)));
      return To_String (Result);
   end Transform;

   --  ------------------------------
   --  Encode the value represented by <tt>Val</tt> in the stream array <tt>Into</tt> starting
   --  at position <tt>Pos</tt> in that array.  The value is encoded using LEB128 format, 7-bits
   --  at a time until all non zero bits are written.  The <tt>Last</tt> parameter is updated
   --  to indicate the position of the last valid byte written in <tt>Into</tt>.
   --  ------------------------------
   procedure Encode_LEB128 (Into  : in out Ada.Streams.Stream_Element_Array;
                            Pos   : in Ada.Streams.Stream_Element_Offset;
                            Val   : in Interfaces.Unsigned_64;
                            Last  : out Ada.Streams.Stream_Element_Offset) is
      use type Interfaces.Unsigned_64;

      P    : Ada.Streams.Stream_Element_Offset := Pos;
      V, U : Interfaces.Unsigned_64;
   begin
      V := Val;
      loop
         if V < 16#07F# then
            Into (P) := Ada.Streams.Stream_Element (V);
            Last := P;
            return;
         end if;
         U := V and 16#07F#;
         Into (P) := Ada.Streams.Stream_Element (U or 16#80#);
         P := P + 1;
         V := Interfaces.Shift_Right (V, 7);
      end loop;
   end Encode_LEB128;

   --  ------------------------------
   --  Decode from the byte array <tt>From</tt> the value represented as LEB128 format starting
   --  at position <tt>Pos</tt> in that array.  After decoding, the <tt>Last</tt> index is updated
   --  to indicate the last position in the byte array.
   --  ------------------------------
   procedure Decode_LEB128 (From  : in Ada.Streams.Stream_Element_Array;
                            Pos   : in Ada.Streams.Stream_Element_Offset;
                            Val   : out Interfaces.Unsigned_64;
                            Last  : out Ada.Streams.Stream_Element_Offset) is
      use type Interfaces.Unsigned_64;
      use type Interfaces.Unsigned_8;

      P     : Ada.Streams.Stream_Element_Offset := Pos;
      Value : Interfaces.Unsigned_64 := 0;
      V     : Interfaces.Unsigned_8;
      Shift : Integer := 0;
   begin
      loop
         V := Interfaces.Unsigned_8 (From (P));
         if (V and 16#80#) = 0 then
            Val := Interfaces.Shift_Left (Interfaces.Unsigned_64 (V), Shift) or Value;
            Last := P + 1;
            return;
         end if;
         V := V and 16#07F#;
         Value := Interfaces.Shift_Left (Interfaces.Unsigned_64 (V), Shift) or Value;
         P := P + 1;
         Shift := Shift + 7;
      end loop;
   end Decode_LEB128;

   --  ------------------------------
   --  Create the encoder object for the specified algorithm.
   --  ------------------------------
   function Create (Name : String) return Encoder is
   begin
      if Name = BASE_16 or Name = HEX then
         return E : Encoder do
            E.Encode := new Util.Encoders.Base16.Encoder;
            E.Decode := new Util.Encoders.Base16.Decoder;
         end return;

      elsif Name = BASE_64 then
         return E : Encoder do
            E.Encode := new Util.Encoders.Base64.Encoder;
            E.Decode := new Util.Encoders.Base64.Decoder;
         end return;

      elsif Name = BASE_64_URL then
         return E : Encoder do
            E.Encode := Util.Encoders.Base64.Create_URL_Encoder;
            E.Decode := Util.Encoders.Base64.Create_URL_Decoder;
         end return;

      elsif Name = HASH_SHA1 then
         return E : Encoder do
            E.Encode := new Util.Encoders.SHA1.Encoder;
            E.Decode := new Util.Encoders.Base64.Decoder;
         end return;
      end if;
      raise Not_Supported with "Invalid encoder: " & Name;
   end Create;

   --  ------------------------------
   --  Delete the transformers
   --  ------------------------------
   overriding
   procedure Finalize (E : in out Encoder) is

      procedure Free is
        new Ada.Unchecked_Deallocation (Transformer'Class, Transformer_Access);

   begin
      Free (E.Encode);
      Free (E.Decode);
   end Finalize;

end Util.Encoders;

-----------------------------------------------------------------------
--  util-encoders -- Encode/Decode streams and strings from one format to another
--  Copyright (C) 2009, 2010, 2011, 2016, 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 Ada.Strings.Unbounded;
with Ada.Unchecked_Deallocation;
with Util.Encoders.Base16;
with Util.Encoders.Base64;
with Util.Encoders.SHA1;
package body Util.Encoders is

   use Ada;
   use Ada.Strings.Unbounded;

   use type Ada.Streams.Stream_Element_Offset;

   --  ------------------------------
   --  Encodes the input string Data using the transformation
   --  rules provided by the E encoder.
   --
   --  Returns the encoded string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be encoded.
   --  Raises the Not_Supported exception if the encoding is not
   --  supported.
   --  ------------------------------
   function Encode (E    : in Encoder;
                    Data : in String) return String is
   begin
      if E.Encode = null then
         raise Not_Supported with "There is no encoder";
      end if;
      return E.Encode.Transform (Data);
   end Encode;

   --  ------------------------------
   --  Decodes the input string Data using the transformation
   --  rules provided by the E encoder.
   --
   --  Returns the encoded string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be decoded.
   --  Raises the Not_Supported exception if the decoding is not
   --  supported.
   --  ------------------------------
   function Decode (E    : in Encoder;
                    Data : in String) return String is
   begin
      if E.Decode = null then
         raise Not_Supported with "There is no decoder";
      end if;
      return E.Decode.Transform (Data);
   end Decode;

   MIN_BUFFER_SIZE : constant Streams.Stream_Element_Offset := 64;
   MAX_BUFFER_SIZE : constant Streams.Stream_Element_Offset := 2_048;

   function Best_Size (Length : Natural) return Streams.Stream_Element_Offset;
   pragma Inline (Best_Size);

   --  ------------------------------
   --  Compute a good size for allocating a buffer on the stack
   --  ------------------------------
   function Best_Size (Length : Natural) return Streams.Stream_Element_Offset is
   begin
      if Length < Natural (MIN_BUFFER_SIZE) then
         return MIN_BUFFER_SIZE;
      elsif Length > Natural (MAX_BUFFER_SIZE) then
         return MAX_BUFFER_SIZE;
      else
         return Streams.Stream_Element_Offset (((Length + 15) / 16) * 16);
      end if;
   end Best_Size;

   --  ------------------------------
   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer.
   --
   --  Returns the transformed string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   --  ------------------------------
   function Transform (E    : in out Transformer'Class;
                       Data : in String) return String is
      Buf_Size : constant Streams.Stream_Element_Offset := Best_Size (Data'Length);
      Buf      : Streams.Stream_Element_Array (1 .. Buf_Size);
      Res      : Streams.Stream_Element_Array (1 .. Buf_Size);
      Tmp      : String (1 .. Natural (Buf_Size));
      Result   : Ada.Strings.Unbounded.Unbounded_String;
      Pos      : Natural := Data'First;
   begin
      while Pos <= Data'Last loop
         declare
            Last_Encoded  : Streams.Stream_Element_Offset;
            First_Encoded : Streams.Stream_Element_Offset := 1;
            Last          : Streams.Stream_Element_Offset;
            Size          : Streams.Stream_Element_Offset;
            Next_Pos      : Natural;
         begin
            --  Fill the stream buffer with our input string
            Size := Streams.Stream_Element_Offset (Data'Last - Pos + 1);
            if Size > Buf'Length then
               Size := Buf'Length;
            end if;
            for I in 1 .. Size loop
               Buf (I) := Character'Pos (Data (Natural (I) + Pos - 1));
            end loop;
            Next_Pos := Pos + Natural (Size);

            --  Encode that buffer and put the result in out result string.
            loop
               E.Transform (Data    => Buf (First_Encoded .. Size),
                            Into    => Res,
                            Encoded => Last_Encoded,
                            Last    => Last);

               --  If the encoder generated nothing, move the position backward
               --  to take into account the remaining bytes not taken into account.
               if Last < 1 then
                  Next_Pos := Next_Pos - Natural (Size - First_Encoded + 1);
                  exit;
               end if;
               for I in 1 .. Last loop
                  Tmp (Natural (I)) := Character'Val (Res (I));
               end loop;
               Append (Result, Tmp (1 .. Natural (Last)));
               exit when Last_Encoded = Size;
               First_Encoded := Last_Encoded + 1;
            end loop;

            --  The encoder cannot encode the data
            if Pos = Next_Pos then
               raise Encoding_Error with "Encoding cannot proceed";
            end if;
            Pos := Next_Pos;
         end;
      end loop;
      return To_String (Result);
   end Transform;

   --  ------------------------------
   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer and return the data in
   --  the Into array, setting Last to the last index.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   --  ------------------------------
   procedure Transform (E    : in out Transformer'Class;
                        Data : in String;
                        Into : out Ada.Streams.Stream_Element_Array;
                        Last : out Ada.Streams.Stream_Element_Offset) is
      Buf_Size : constant Streams.Stream_Element_Offset := Best_Size (Data'Length);
      Buf      : Streams.Stream_Element_Array (1 .. Buf_Size);
      Pos      : Natural := Data'First;
      First    : Streams.Stream_Element_Offset := Into'First;
   begin
      Last := Into'First - 1;
      while Pos <= Data'Last and Last < Into'Last loop
         declare
            Last_Encoded  : Streams.Stream_Element_Offset;
            Size          : Streams.Stream_Element_Offset;
            Next_Pos      : Natural;
         begin
            --  Fill the stream buffer with our input string
            Size := Streams.Stream_Element_Offset (Data'Last - Pos + 1);
            if Size > Buf'Length then
               Size := Buf'Length;
            end if;
            for I in 1 .. Size loop
               Buf (I) := Character'Pos (Data (Natural (I) + Pos - 1));
            end loop;
            Next_Pos := Pos + Natural (Size);

            --  Encode that buffer and put the result in the output data array.
            E.Transform (Data    => Buf (1 .. Size),
                         Into    => Into (First .. Into'Last),
                         Encoded => Last_Encoded,
                         Last    => Last);

            --  If the encoded has not used all the data, update the position for the next run.
            if Last_Encoded /= Size then
               Next_Pos := Next_Pos - Natural (Size - Last_Encoded + 1);
            end if;

            --  The encoder cannot encode the data
            if Pos = Next_Pos then
               raise Encoding_Error with "Encoding cannot proceed";
            end if;
            First := Last;
            Pos := Next_Pos;
         end;
      end loop;
      if Pos <= Data'Last then
         raise Encoding_Error with "Not enough space for encoding";
      end if;
   end Transform;

   --  ------------------------------
   --  Transform the input string Data using the transformation
   --  rules provided by the E transformer.
   --
   --  Returns the transformed string.
   --
   --  Raises the Encoding_Error exception if the source string
   --  cannot be transformed
   --  ------------------------------
   function Transform (E    : in out Transformer'Class;
                       Data : in Streams.Stream_Element_Array) return String is
      Buf_Size : constant Streams.Stream_Element_Offset := Best_Size (Data'Length);
      Res      : Streams.Stream_Element_Array (1 .. Buf_Size);
      Tmp      : String (1 .. Natural (Buf_Size));
      Result   : Ada.Strings.Unbounded.Unbounded_String;
      Last_Encoded  : Streams.Stream_Element_Offset;
      Last          : Streams.Stream_Element_Offset;
   begin

      --  Encode that buffer and put the result in out result string.
      E.Transform (Data    => Data,
                   Into    => Res,
                   Encoded => Last_Encoded,
                   Last    => Last);

      for I in 1 .. Last loop
         Tmp (Natural (I)) := Character'Val (Res (I));
      end loop;
      Append (Result, Tmp (1 .. Natural (Last)));
      return To_String (Result);
   end Transform;

   --  ------------------------------
   --  Encode the value represented by <tt>Val</tt> in the stream array <tt>Into</tt> starting
   --  at position <tt>Pos</tt> in that array.  The value is encoded using LEB128 format, 7-bits
   --  at a time until all non zero bits are written.  The <tt>Last</tt> parameter is updated
   --  to indicate the position of the last valid byte written in <tt>Into</tt>.
   --  ------------------------------
   procedure Encode_LEB128 (Into  : in out Ada.Streams.Stream_Element_Array;
                            Pos   : in Ada.Streams.Stream_Element_Offset;
                            Val   : in Interfaces.Unsigned_64;
                            Last  : out Ada.Streams.Stream_Element_Offset) is
      use type Interfaces.Unsigned_64;

      P    : Ada.Streams.Stream_Element_Offset := Pos;
      V, U : Interfaces.Unsigned_64;
   begin
      V := Val;
      loop
         if V < 16#07F# then
            Into (P) := Ada.Streams.Stream_Element (V);
            Last := P;
            return;
         end if;
         U := V and 16#07F#;
         Into (P) := Ada.Streams.Stream_Element (U or 16#80#);
         P := P + 1;
         V := Interfaces.Shift_Right (V, 7);
      end loop;
   end Encode_LEB128;

   --  ------------------------------
   --  Decode from the byte array <tt>From</tt> the value represented as LEB128 format starting
   --  at position <tt>Pos</tt> in that array.  After decoding, the <tt>Last</tt> index is updated
   --  to indicate the last position in the byte array.
   --  ------------------------------
   procedure Decode_LEB128 (From  : in Ada.Streams.Stream_Element_Array;
                            Pos   : in Ada.Streams.Stream_Element_Offset;
                            Val   : out Interfaces.Unsigned_64;
                            Last  : out Ada.Streams.Stream_Element_Offset) is
      use type Interfaces.Unsigned_64;
      use type Interfaces.Unsigned_8;

      P     : Ada.Streams.Stream_Element_Offset := Pos;
      Value : Interfaces.Unsigned_64 := 0;
      V     : Interfaces.Unsigned_8;
      Shift : Integer := 0;
   begin
      loop
         V := Interfaces.Unsigned_8 (From (P));
         if (V and 16#80#) = 0 then
            Val := Interfaces.Shift_Left (Interfaces.Unsigned_64 (V), Shift) or Value;
            Last := P + 1;
            return;
         end if;
         V := V and 16#07F#;
         Value := Interfaces.Shift_Left (Interfaces.Unsigned_64 (V), Shift) or Value;
         P := P + 1;
         Shift := Shift + 7;
      end loop;
   end Decode_LEB128;

   --  ------------------------------
   --  Create the encoder object for the specified algorithm.
   --  ------------------------------
   function Create (Name : String) return Encoder is
   begin
      if Name = BASE_16 or Name = HEX then
         return E : Encoder do
            E.Encode := new Util.Encoders.Base16.Encoder;
            E.Decode := new Util.Encoders.Base16.Decoder;
         end return;

      elsif Name = BASE_64 then
         return E : Encoder do
            E.Encode := new Util.Encoders.Base64.Encoder;
            E.Decode := new Util.Encoders.Base64.Decoder;
         end return;

      elsif Name = BASE_64_URL then
         return E : Encoder do
            E.Encode := Util.Encoders.Base64.Create_URL_Encoder;
            E.Decode := Util.Encoders.Base64.Create_URL_Decoder;
         end return;

      elsif Name = HASH_SHA1 then
         return E : Encoder do
            E.Encode := new Util.Encoders.SHA1.Encoder;
            E.Decode := new Util.Encoders.Base64.Decoder;
         end return;
      end if;
      raise Not_Supported with "Invalid encoder: " & Name;
   end Create;

   --  ------------------------------
   --  Delete the transformers
   --  ------------------------------
   overriding
   procedure Finalize (E : in out Encoder) is

      procedure Free is
        new Ada.Unchecked_Deallocation (Transformer'Class, Transformer_Access);

   begin
      Free (E.Encode);
      Free (E.Decode);
   end Finalize;

end Util.Encoders;

Change the Transformer interface to accept in out parameter for the Transformer