-----------------------------------------------------------------------
--  util-serialize-mappers -- Serialize objects in various formats
--  Copyright (C) 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 Util.Strings;
with Util.Log.Loggers;
with Ada.Unchecked_Deallocation;
package body Util.Serialize.Mappers is

   use Util.Log;

   --  The logger
   Log : constant Loggers.Logger := Loggers.Create ("Util.Serialize.Mappers",
                                                    Util.Log.WARN_LEVEL);

   --  -----------------------
   --  Execute the mapping operation on the object associated with the current context.
   --  The object is extracted from the context and the Execute operation is called.
   --  -----------------------
   procedure Execute (Handler : in Mapper;
                      Map     : in Mapping'Class;
                      Ctx     : in out Util.Serialize.Contexts.Context'Class;
                      Value   : in Util.Beans.Objects.Object) is
   begin
      if Handler.Mapper /= null then
         Handler.Mapper.all.Execute (Map, Ctx, Value);
      end if;
   end Execute;

   function Is_Proxy (Controller : in Mapper) return Boolean is
   begin
      return Controller.Is_Proxy_Mapper;
   end Is_Proxy;

   --  -----------------------
   --  Find the mapper associated with the given name.
   --  Returns null if there is no mapper.
   --  -----------------------
   function Find_Mapper (Controller : in Mapper;
                         Name       : in String;
                         Attribute  : in Boolean := False) return Mapper_Access is
      use type Ada.Strings.Unbounded.Unbounded_String;
      Node : Mapper_Access := Controller.First_Child;
   begin
      if Node = null and Controller.Mapper /= null then
         return Controller.Mapper.Find_Mapper (Name, Attribute);
      end if;
      while Node /= null loop
         if Node.Name = Name then
            if (Attribute = False and Node.Mapping = null)
              or else not Node.Mapping.Is_Attribute then
               return Node;
            end if;
            if Attribute and Node.Mapping.Is_Attribute then
               return Node;
            end if;
         end if;
         Node := Node.Next_Mapping;
      end loop;
      return null;
   end Find_Mapper;

   --  -----------------------
   --  Find a path component representing a child mapper under From and
   --  identified by the given Name.  If the mapper is not found, a new
   --  Mapper_Node is created.
   --  -----------------------
   procedure Find_Path_Component (From   : in out Mapper'Class;
                                  Name   : in String;
                                  Result : out Mapper_Access) is
      use Ada.Strings.Unbounded;

      Node : Mapper_Access := From.First_Child;
   begin
      if Node = null then
         Result := new Mapper;
         Result.Name := To_Unbounded_String (Name);
         From.First_Child := Result;
         return;
      end if;
      loop
         if Node.Name = Name then
            Result := Node;
            return;
         end if;
         if Node.Next_Mapping = null then
            Result := new Mapper;
            Result.Name := To_Unbounded_String (Name);
            Node.Next_Mapping := Result;
            return;
         end if;
         Node := Node.Next_Mapping;
      end loop;
   end Find_Path_Component;

   --  -----------------------
   --  Build the mapping tree that corresponds to the given Path.
   --  Each path component is represented by a Mapper_Node element.
   --  The node is created if it does not exists.
   --  -----------------------
   procedure Build_Path (Into     : in out Mapper'Class;
                         Path     : in String;
                         Last_Pos : out Natural;
                         Node     : out Mapper_Access) is
      Pos      : Natural;
   begin
      Node     := Into'Unchecked_Access;
      Last_Pos := Path'First;
      loop
         Pos := Util.Strings.Index (Source => Path,
                                    Char   => '/',
                                    From   => Last_Pos);
         if Pos = 0 then
            Node.Find_Path_Component (Name   => Path (Last_Pos .. Path'Last),
                                      Result => Node);
            Last_Pos := Path'Last + 1;
         else
            Node.Find_Path_Component (Name   => Path (Last_Pos .. Pos - 1),
                                      Result => Node);
            Last_Pos := Pos + 1;
         end if;
         exit when Last_Pos > Path'Last;
      end loop;
   end Build_Path;

   --  -----------------------
   --  Add a mapping to associate the given Path to the mapper defined in Map.
   --  The Path string describes the matching node using a simplified XPath notation.
   --  Example:
   --     info/first_name    matches:  <info><first_name>...</first_name></info>
   --     info/a/b/name      matches:  <info><name>...</name></info>
   --  -----------------------
   procedure Add_Mapping (Into : in out Mapper;
                          Path : in String;
                          Map  : in Mapper_Access) is
      Node     : Mapper_Access;
      Last_Pos : Natural;

      procedure Copy (To   : in Mapper_Access;
                      From : in Mapper_Access) is
         N   : Mapper_Access;
         Src : Mapper_Access := From;
      begin
         while Src /= null loop
            N := Src.Clone;
            N.Is_Clone := True;
            N.Next_Mapping := To.First_Child;
            To.First_Child := N;
            if Src.First_Child /= null then
               Copy (N, Src.First_Child);
            end if;
            Src := Src.Next_Mapping;
         end loop;
      end Copy;

   begin
      Log.Info ("Mapping {0} for mapper X", Path);

      --  Find or build the mapping tree.
      Into.Build_Path (Path, Last_Pos, Node);

      if Last_Pos < Path'Last then
         Log.Warn ("Ignoring the end of mapping path {0}", Path);
      end if;
      if Node.Mapper /= null then
         Log.Warn ("Overriding the mapping {0} for mapper X", Path);
      end if;
      Copy (Node, Map.First_Child);
   end Add_Mapping;

   procedure Add_Mapping (Into : in out Mapper;
                          Path : in String;
                          Map  : in Mapping_Access) is
      use Ada.Strings.Unbounded;
      Node     : Mapper_Access;
      Last_Pos : Natural;
   begin
      Log.Info ("Mapping {0}", Path);

      --  Find or build the mapping tree.
      Into.Build_Path (Path, Last_Pos, Node);

      if Last_Pos < Path'Last then
         Log.Warn ("Ignoring the end of mapping path {0}", Path);
      end if;
      if Node.Mapping /= null then
         Log.Warn ("Overriding the mapping {0} for mapper X", Path);
      end if;
      if Length (Node.Name) = 0 then
         Log.Warn ("Mapped name is empty in mapping path {0}", Path);
      elsif Element (Node.Name, 1) = '@' then
         Delete (Node.Name, 1, 1);
         Map.Is_Attribute := True;
      else
         Map.Is_Attribute := False;
      end if;

      Node.Mapping := Map;
      Node.Mapper  := Into'Unchecked_Access;
   end Add_Mapping;

   --  -----------------------
   --  Clone the Handler instance and get a copy of that single object.
   --  -----------------------
   function Clone (Handler : in Mapper) return Mapper_Access is
      Result : constant Mapper_Access := new Mapper;
   begin
      Result.Name            := Handler.Name;
      Result.Mapper          := Handler.Mapper;
      Result.Mapping         := Handler.Mapping;
      Result.Is_Proxy_Mapper := Handler.Is_Proxy_Mapper;
      Result.Is_Clone        := True;
      return Result;
   end Clone;

   --  -----------------------
   --  Set the name/value pair on the current object.  For each active mapping,
   --  find whether a rule matches our name and execute it.
   --  -----------------------
   procedure Set_Member (Handler   : in Mapper;
                         Name      : in String;
                         Value     : in Util.Beans.Objects.Object;
                         Attribute : in Boolean := False;
                         Context   : in out Util.Serialize.Contexts.Context'Class) is
      Map : constant Mapper_Access := Mapper'Class (Handler).Find_Mapper (Name, Attribute);
   begin
      if Map /= null and then Map.Mapping /= null and then Map.Mapper /= null then
         Map.Mapper.all.Execute (Map.Mapping.all, Context, Value);
      end if;
   end Set_Member;

   procedure Start_Object (Handler : in Mapper;
                           Context : in out Util.Serialize.Contexts.Context'Class;
                           Name    : in String) is
   begin
      if Handler.Mapper /= null then
         Handler.Mapper.Start_Object (Context, Name);
      end if;
   end Start_Object;

   procedure Finish_Object (Handler : in Mapper;
                            Context : in out Util.Serialize.Contexts.Context'Class;
                            Name    : in String) is
   begin
      if Handler.Mapper /= null then
         Handler.Mapper.Finish_Object (Context, Name);
      end if;
   end Finish_Object;

   --  -----------------------
   --  Dump the mapping tree on the logger using the INFO log level.
   --  -----------------------
   procedure Dump (Handler : in Mapper'Class;
                   Log     : in Util.Log.Loggers.Logger'Class;
                   Prefix  : in String := "") is
      procedure Dump (Map : in Mapper'Class);

      --  -----------------------
      --  Dump the mapping description
      --  -----------------------
      procedure Dump (Map : in Mapper'Class) is
      begin
         if Map.Mapping /= null and then Map.Mapping.Is_Attribute then
            Log.Info (" {0}@{1}", Prefix,
                      Ada.Strings.Unbounded.To_String (Map.Mapping.Name));
         else
            Log.Info (" {0}/{1}", Prefix, Ada.Strings.Unbounded.To_String (Map.Name));
            Dump (Map, Log, Prefix & "/" & Ada.Strings.Unbounded.To_String (Map.Name));
         end if;
      end Dump;
   begin
      Iterate (Handler, Dump'Access);
   end Dump;

   procedure Iterate (Controller : in Mapper;
                      Process : not null access procedure (Map : in Mapper'Class)) is
      Node : Mapper_Access := Controller.First_Child;
   begin
      --  Pass 1: process the attributes first
      while Node /= null loop
         if Node.Mapping /= null and then Node.Mapping.Is_Attribute then
            Process.all (Node.all);
         end if;
         Node := Node.Next_Mapping;
      end loop;

      --  Pass 2: process the elements
      Node := Controller.First_Child;
      while Node /= null loop
         if Node.Mapping = null or else not Node.Mapping.Is_Attribute then
            Process.all (Node.all);
         end if;
         Node := Node.Next_Mapping;
      end loop;
   end Iterate;

   --  -----------------------
   --  Finalize the object and release any mapping.
   --  -----------------------
   overriding
   procedure Finalize (Controller : in out Mapper) is
      procedure Free is new Ada.Unchecked_Deallocation (Mapper'Class, Mapper_Access);
      procedure Free is new Ada.Unchecked_Deallocation (Mapping'Class, Mapping_Access);

      Node : Mapper_Access := Controller.First_Child;
      Next : Mapper_Access;
   begin
      Controller.First_Child := null;
      while Node /= null loop
         Next := Node.Next_Mapping;
         Free (Node);
         Node := Next;
      end loop;
      if not Controller.Is_Clone then
         Free (Controller.Mapping);
      else
         Controller.Mapping := null;
      end if;
   end Finalize;

end Util.Serialize.Mappers;

-----------------------------------------------------------------------
--  util-serialize-mappers -- Serialize objects in various formats
--  Copyright (C) 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 Util.Strings;
with Util.Log.Loggers;
with Ada.Unchecked_Deallocation;
package body Util.Serialize.Mappers is

   use Util.Log;

   --  The logger
   Log : constant Loggers.Logger := Loggers.Create ("Util.Serialize.Mappers",
                                                    Util.Log.WARN_LEVEL);

   --  -----------------------
   --  Execute the mapping operation on the object associated with the current context.
   --  The object is extracted from the context and the Execute operation is called.
   --  -----------------------
   procedure Execute (Handler : in Mapper;
                      Map     : in Mapping'Class;
                      Ctx     : in out Util.Serialize.Contexts.Context'Class;
                      Value   : in Util.Beans.Objects.Object) is
   begin
      if Handler.Mapper /= null then
         Handler.Mapper.all.Execute (Map, Ctx, Value);
      end if;
   end Execute;

   function Is_Proxy (Controller : in Mapper) return Boolean is
   begin
      return Controller.Is_Proxy_Mapper;
   end Is_Proxy;

   --  -----------------------
   --  Find the mapper associated with the given name.
   --  Returns null if there is no mapper.
   --  -----------------------
   function Find_Mapper (Controller : in Mapper;
                         Name       : in String;
                         Attribute  : in Boolean := False) return Mapper_Access is
      use type Ada.Strings.Unbounded.Unbounded_String;
      Node : Mapper_Access := Controller.First_Child;
   begin
      if Node = null and Controller.Mapper /= null then
         return Controller.Mapper.Find_Mapper (Name, Attribute);
      end if;
      while Node /= null loop
         if Node.Name = Name then
            if (Attribute = False and Node.Mapping = null)
              or else not Node.Mapping.Is_Attribute then
               return Node;
            end if;
            if Attribute and Node.Mapping.Is_Attribute then
               return Node;
            end if;
         end if;
         Node := Node.Next_Mapping;
      end loop;
      return null;
   end Find_Mapper;

   --  -----------------------
   --  Find a path component representing a child mapper under From and
   --  identified by the given Name.  If the mapper is not found, a new
   --  Mapper_Node is created.
   --  -----------------------
   procedure Find_Path_Component (From   : in out Mapper'Class;
                                  Name   : in String;
                                  Result : out Mapper_Access) is
      use Ada.Strings.Unbounded;

      Node : Mapper_Access := From.First_Child;
   begin
      if Node = null then
         Result := new Mapper;
         Result.Name := To_Unbounded_String (Name);
         From.First_Child := Result;
         return;
      end if;
      loop
         if Node.Name = Name then
            Result := Node;
            return;
         end if;
         if Node.Next_Mapping = null then
            Result := new Mapper;
            Result.Name := To_Unbounded_String (Name);
            Node.Next_Mapping := Result;
            return;
         end if;
         Node := Node.Next_Mapping;
      end loop;
   end Find_Path_Component;

   --  -----------------------
   --  Build the mapping tree that corresponds to the given Path.
   --  Each path component is represented by a Mapper_Node element.
   --  The node is created if it does not exists.
   --  -----------------------
   procedure Build_Path (Into     : in out Mapper'Class;
                         Path     : in String;
                         Last_Pos : out Natural;
                         Node     : out Mapper_Access) is
      Pos      : Natural;
   begin
      Node     := Into'Unchecked_Access;
      Last_Pos := Path'First;
      loop
         Pos := Util.Strings.Index (Source => Path,
                                    Char   => '/',
                                    From   => Last_Pos);
         if Pos = 0 then
            Node.Find_Path_Component (Name   => Path (Last_Pos .. Path'Last),
                                      Result => Node);
            Last_Pos := Path'Last + 1;
         else
            Node.Find_Path_Component (Name   => Path (Last_Pos .. Pos - 1),
                                      Result => Node);
            Last_Pos := Pos + 1;
         end if;
         exit when Last_Pos > Path'Last;
      end loop;
   end Build_Path;

   --  -----------------------
   --  Add a mapping to associate the given Path to the mapper defined in Map.
   --  The Path string describes the matching node using a simplified XPath notation.
   --  Example:
   --     info/first_name    matches:  <info><first_name>...</first_name></info>
   --     info/a/b/name      matches:  <info><name>...</name></info>
   --  -----------------------
   procedure Add_Mapping (Into : in out Mapper;
                          Path : in String;
                          Map  : in Mapper_Access) is
      Node     : Mapper_Access;
      Last_Pos : Natural;

      procedure Copy (To   : in Mapper_Access;
                      From : in Mapper_Access) is
         N   : Mapper_Access;
         Src : Mapper_Access := From;
      begin
         while Src /= null loop
            N := Src.Clone;
            N.Is_Clone := True;
            N.Next_Mapping := To.First_Child;
            To.First_Child := N;
            if Src.First_Child /= null then
               Copy (N, Src.First_Child);
            end if;
            Src := Src.Next_Mapping;
         end loop;
      end Copy;

   begin
      Log.Info ("Mapping {0} for mapper X", Path);

      --  Find or build the mapping tree.
      Into.Build_Path (Path, Last_Pos, Node);

      if Last_Pos < Path'Last then
         Log.Warn ("Ignoring the end of mapping path {0}", Path);
      end if;
      if Node.Mapper /= null then
         Log.Warn ("Overriding the mapping {0} for mapper X", Path);
      end if;
      if Map.First_Child /= null then
         Copy (Node, Map.First_Child);
      else
         Node.Mapper := Map;
      end if;
   end Add_Mapping;

   procedure Add_Mapping (Into : in out Mapper;
                          Path : in String;
                          Map  : in Mapping_Access) is
      use Ada.Strings.Unbounded;
      Node     : Mapper_Access;
      Last_Pos : Natural;
   begin
      Log.Info ("Mapping {0}", Path);

      --  Find or build the mapping tree.
      Into.Build_Path (Path, Last_Pos, Node);

      if Last_Pos < Path'Last then
         Log.Warn ("Ignoring the end of mapping path {0}", Path);
      end if;
      if Node.Mapping /= null then
         Log.Warn ("Overriding the mapping {0} for mapper X", Path);
      end if;
      if Length (Node.Name) = 0 then
         Log.Warn ("Mapped name is empty in mapping path {0}", Path);
      elsif Element (Node.Name, 1) = '@' then
         Delete (Node.Name, 1, 1);
         Map.Is_Attribute := True;
      else
         Map.Is_Attribute := False;
      end if;

      Node.Mapping := Map;
      Node.Mapper  := Into'Unchecked_Access;
   end Add_Mapping;

   --  -----------------------
   --  Clone the Handler instance and get a copy of that single object.
   --  -----------------------
   function Clone (Handler : in Mapper) return Mapper_Access is
      Result : constant Mapper_Access := new Mapper;
   begin
      Result.Name            := Handler.Name;
      Result.Mapper          := Handler.Mapper;
      Result.Mapping         := Handler.Mapping;
      Result.Is_Proxy_Mapper := Handler.Is_Proxy_Mapper;
      Result.Is_Clone        := True;
      return Result;
   end Clone;

   --  -----------------------
   --  Set the name/value pair on the current object.  For each active mapping,
   --  find whether a rule matches our name and execute it.
   --  -----------------------
   procedure Set_Member (Handler   : in Mapper;
                         Name      : in String;
                         Value     : in Util.Beans.Objects.Object;
                         Attribute : in Boolean := False;
                         Context   : in out Util.Serialize.Contexts.Context'Class) is
      Map : constant Mapper_Access := Mapper'Class (Handler).Find_Mapper (Name, Attribute);
   begin
      if Map /= null and then Map.Mapping /= null and then Map.Mapper /= null then
         Map.Mapper.all.Execute (Map.Mapping.all, Context, Value);
      end if;
   end Set_Member;

   procedure Start_Object (Handler : in Mapper;
                           Context : in out Util.Serialize.Contexts.Context'Class;
                           Name    : in String) is
   begin
      if Handler.Mapper /= null then
         Handler.Mapper.Start_Object (Context, Name);
      end if;
   end Start_Object;

   procedure Finish_Object (Handler : in Mapper;
                            Context : in out Util.Serialize.Contexts.Context'Class;
                            Name    : in String) is
   begin
      if Handler.Mapper /= null then
         Handler.Mapper.Finish_Object (Context, Name);
      end if;
   end Finish_Object;

   --  -----------------------
   --  Dump the mapping tree on the logger using the INFO log level.
   --  -----------------------
   procedure Dump (Handler : in Mapper'Class;
                   Log     : in Util.Log.Loggers.Logger'Class;
                   Prefix  : in String := "") is
      procedure Dump (Map : in Mapper'Class);

      --  -----------------------
      --  Dump the mapping description
      --  -----------------------
      procedure Dump (Map : in Mapper'Class) is
      begin
         if Map.Mapping /= null and then Map.Mapping.Is_Attribute then
            Log.Info (" {0}@{1}", Prefix,
                      Ada.Strings.Unbounded.To_String (Map.Mapping.Name));
         else
            Log.Info (" {0}/{1}", Prefix, Ada.Strings.Unbounded.To_String (Map.Name));
            Dump (Map, Log, Prefix & "/" & Ada.Strings.Unbounded.To_String (Map.Name));
         end if;
      end Dump;
   begin
      Iterate (Handler, Dump'Access);
   end Dump;

   procedure Iterate (Controller : in Mapper;
                      Process : not null access procedure (Map : in Mapper'Class)) is
      Node : Mapper_Access := Controller.First_Child;
   begin
      --  Pass 1: process the attributes first
      while Node /= null loop
         if Node.Mapping /= null and then Node.Mapping.Is_Attribute then
            Process.all (Node.all);
         end if;
         Node := Node.Next_Mapping;
      end loop;

      --  Pass 2: process the elements
      Node := Controller.First_Child;
      while Node /= null loop
         if Node.Mapping = null or else not Node.Mapping.Is_Attribute then
            Process.all (Node.all);
         end if;
         Node := Node.Next_Mapping;
      end loop;
   end Iterate;

   --  -----------------------
   --  Finalize the object and release any mapping.
   --  -----------------------
   overriding
   procedure Finalize (Controller : in out Mapper) is
      procedure Free is new Ada.Unchecked_Deallocation (Mapper'Class, Mapper_Access);
      procedure Free is new Ada.Unchecked_Deallocation (Mapping'Class, Mapping_Access);

      Node : Mapper_Access := Controller.First_Child;
      Next : Mapper_Access;
   begin
      Controller.First_Child := null;
      while Node /= null loop
         Next := Node.Next_Mapping;
         Free (Node);
         Node := Next;
      end loop;
      if not Controller.Is_Clone then
         Free (Controller.Mapping);
      else
         Controller.Mapping := null;
      end if;
   end Finalize;

end Util.Serialize.Mappers;

Fix serialization mapping for vectors - when adding a vector mapping, do not copy the mapping but set the mapper to the vector mapping


-----------------------------------------------------------------------
--  mat-events-timelines - Timelines
--  Copyright (C) 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 MAT.Frames;
package body MAT.Events.Timelines is

   use MAT.Events.Targets;

   ITERATE_COUNT : constant MAT.Events.Event_Id_Type := 10_000;

   procedure Extract (Target : in out MAT.Events.Targets.Target_Events'Class;
                      Level  : in Positive;
                      Into   : in out Timeline_Info_Vector) is
      use type MAT.Types.Target_Time;
      use type MAT.Types.Target_Size;
      procedure Collect (Event : in MAT.Events.Target_Event_Type);

      First_Event : MAT.Events.Target_Event_Type;
      Last_Event  : MAT.Events.Target_Event_Type;
      Prev_Event  : MAT.Events.Target_Event_Type;
      Info        : Timeline_Info;
      First_Id    : MAT.Events.Event_Id_Type;
      Limit       : MAT.Types.Target_Time := MAT.Types.Target_Time (Level * 1_000_000);

      procedure Collect (Event : in MAT.Events.Target_Event_Type) is
         Dt : constant MAT.Types.Target_Time := Event.Time - Prev_Event.Time;
      begin
         if Dt > Limit then
            Into.Append (Info);
            Info.Malloc_Count := 0;
            Info.Realloc_Count := 0;
            Info.Free_Count := 0;
            Info.First_Event := Event;
            Info.Free_Size := 0;
            Info.Alloc_Size := 0;
            Prev_Event := Event;
         end if;
         Info.Last_Event := Event;
         if Event.Event = 2 then
            Info.Malloc_Count := Info.Malloc_Count + 1;
            Info.Alloc_Size := Info.Alloc_Size + Event.Size;
         elsif Event.Event = 3 then
            Info.Realloc_Count := Info.Realloc_Count + 1;
            Info.Alloc_Size := Info.Alloc_Size + Event.Size;
            Info.Free_Size := Info.Free_Size + Event.Old_Size;
         elsif Event.Event = 4 then
            Info.Free_Count := Info.Free_Count + 1;
            Info.Free_Size := Info.Free_Size + Event.Size;
         end if;
      end Collect;

   begin
      Target.Get_Limits (First_Event, Last_Event);
      Prev_Event      := First_Event;
      Info.First_Event := First_Event;
      First_Id := First_Event.Id;
      while First_Id < Last_Event.Id loop
         Target.Iterate (Start   => First_Id,
                         Finish  => First_Id + ITERATE_COUNT,
                         Process => Collect'Access);
         First_Id := First_Id + ITERATE_COUNT;
      end loop;
   end Extract;

   --  ------------------------------
   --  Find in the events stream the events which are associated with a given event.
   --  When the <tt>Event</tt> is a memory allocation, find the associated reallocation
   --  and free events.  When the event is a free, find the associated allocations.
   --  Collect at most <tt>Max</tt> events.
   --  ------------------------------
   procedure Find_Related (Target : in out MAT.Events.Targets.Target_Events'Class;
                           Event  : in MAT.Events.Target_Event_Type;
                           Max    : in Positive;
                           List   : in out MAT.Events.Tools.Target_Event_Vector) is

      procedure Collect_Free (Event : in MAT.Events.Target_Event_Type);
      procedure Collect_Alloc (Event : in MAT.Events.Target_Event_Type);

      First_Id    : MAT.Events.Event_Id_Type;
      Last_Id     : MAT.Events.Event_Id_Type;
      First_Event : MAT.Events.Target_Event_Type;
      Last_Event  : MAT.Events.Target_Event_Type;
      Addr        : MAT.Types.Target_Addr := Event.Addr;

      Done : exception;

      procedure Collect_Free (Event : in MAT.Events.Target_Event_Type) is
      begin
         if Event.Index = MAT.Events.MSG_FREE and then Event.Addr = Addr then
            List.Append (Event);
            raise Done;
         end if;
         if Event.Index = MAT.Events.MSG_REALLOC and then Event.Old_Addr = Addr then
            List.Append (Event);
            if Positive (List.Length) >= Max then
               raise Done;
            end if;
            Addr := Event.Addr;
         end if;
      end Collect_Free;

      procedure Collect_Alloc (Event : in MAT.Events.Target_Event_Type) is
      begin
         if Event.Index = MAT.Events.MSG_MALLOC and then Event.Addr = Addr then
            List.Append (Event);
            raise Done;
         end if;
         if Event.Index = MAT.Events.MSG_REALLOC and then Event.Addr = Addr then
            List.Append (Event);
            if Positive (List.Length) >= Max then
               raise Done;
            end if;
            Addr := Event.Old_Addr;
         end if;
      end Collect_Alloc;

   begin
      Target.Get_Limits (First_Event, Last_Event);
      First_Id := Event.Id;
      if Event.Index = MAT.Events.MSG_FREE then
         --  Search backward for MSG_MALLOC and MSG_REALLOC.
         First_Id := First_Id - 1;
         while First_Id > First_Event.Id loop
            if First_Id > ITERATE_COUNT then
               Last_Id := First_Id - ITERATE_COUNT;
            else
               Last_Id := First_Event.Id;
            end if;
            Target.Iterate (Start   => First_Id,
                            Finish  => Last_Id,
                            Process => Collect_Alloc'Access);
            First_Id := Last_Id;
         end loop;
      else
         --  Search forward for MSG_REALLOC and MSG_FREE
         First_Id := First_Id + 1;
         while First_Id < Last_Event.Id loop
            Target.Iterate (Start   => First_Id,
                            Finish  => First_Id + ITERATE_COUNT,
                            Process => Collect_Free'Access);
            First_Id := First_Id + ITERATE_COUNT;
         end loop;
      end if;

   exception
      when Done =>
         null;
   end Find_Related;

   --  ------------------------------
   --  Find the sizes of malloc and realloc events which is selected by the given filter.
   --  Update the <tt>Sizes</tt> map to keep track of the first event and last event and
   --  the number of events found for the corresponding size.
   --  ------------------------------
   procedure Find_Sizes (Target : in out MAT.Events.Targets.Target_Events'Class;
                         Filter : in MAT.Expressions.Expression_Type;
                         Sizes  : in out MAT.Events.Tools.Size_Event_Info_Map) is
      procedure Collect_Event (Event : in MAT.Events.Target_Event_Type);

      procedure Collect_Event (Event : in MAT.Events.Target_Event_Type) is
         procedure Update_Size (Size : in MAT.Types.Target_Size;
                                Info : in out MAT.Events.Tools.Event_Info_Type);

         procedure Update_Size (Size : in MAT.Types.Target_Size;
                                Info : in out MAT.Events.Tools.Event_Info_Type) is
            pragma Unreferenced (Size);
         begin
            MAT.Events.Tools.Collect_Info (Info, Event);
         end Update_Size;

      begin
         --  Look for malloc or realloc events which are selected by the filter.
         if (Event.Index /= MAT.Events.MSG_MALLOC
             and Event.Index /= MAT.Events.MSG_FREE
             and Event.Index /= MAT.Events.MSG_REALLOC)
           or else not Filter.Is_Selected (Event)
         then
            return;
         end if;
         declare
            Pos : constant MAT.Events.Tools.Size_Event_Info_Cursor := Sizes.Find (Event.Size);
         begin
            if MAT.Events.Tools.Size_Event_Info_Maps.Has_Element (Pos) then
               --  Increment the count and update the last event.
               Sizes.Update_Element (Pos, Update_Size'Access);
            else
               declare
                  Info : MAT.Events.Tools.Event_Info_Type;
               begin
                  --  Insert a new size with the event.
                  Info.First_Event := Event;
                  MAT.Events.Tools.Collect_Info (Info, Event);
                  Sizes.Insert (Event.Size, Info);
               end;
            end if;
         end;
      end Collect_Event;

   begin
      Target.Iterate (Process => Collect_Event'Access);
   end Find_Sizes;

   --  ------------------------------
   --  Find the function address from the call event frames for the events which is selected
   --  by the given filter.  The function addresses are collected up to the given frame depth.
   --  Update the <tt>Frames</tt> map to keep track of the first event and last event and
   --  the number of events found for the corresponding frame address.
   --  ------------------------------
   procedure Find_Frames (Target : in out MAT.Events.Targets.Target_Events'Class;
                          Filter : in MAT.Expressions.Expression_Type;
                          Depth  : in Positive;
                          Exact  : in Boolean;
                          Frames : in out MAT.Events.Tools.Frame_Event_Info_Map) is
      procedure Collect_Event (Event : in MAT.Events.Target_Event_Type);

      procedure Collect_Event (Event : in MAT.Events.Target_Event_Type) is

         procedure Update_Size (Key  : in MAT.Events.Tools.Frame_Key_Type;
                                Info : in out MAT.Events.Tools.Event_Info_Type);

         procedure Update_Size (Key  : in MAT.Events.Tools.Frame_Key_Type;
                                Info : in out MAT.Events.Tools.Event_Info_Type) is
            pragma Unreferenced (Key);
         begin
            MAT.Events.Tools.Collect_Info (Info, Event);
         end Update_Size;

      begin
         --  Look for events which are selected by the filter.
         if not Filter.Is_Selected (Event) then
            return;
         end if;
         declare
            Backtrace : constant MAT.Frames.Frame_Table := MAT.Frames.Backtrace (Event.Frame);
            Key       : MAT.Events.Tools.Frame_Key_Type;
            First     : Natural;
            Last      : Natural;
         begin
            if Exact then
               First := Depth;
            else
               First := Backtrace'First;
            end if;
            if Depth < Backtrace'Last then
               Last := Depth;
            else
               Last := Backtrace'Last;
            end if;
            for I in First .. Last loop
               Key.Addr  := Backtrace (Backtrace'Last - I + 1);
               Key.Level := I;
               declare
                  Pos : constant MAT.Events.Tools.Frame_Event_Info_Cursor
                    := Frames.Find (Key);
               begin
                  if MAT.Events.Tools.Frame_Event_Info_Maps.Has_Element (Pos) then
                     --  Increment the count and update the last event.
                     Frames.Update_Element (Pos, Update_Size'Access);
                  else
                     declare
                        Info : MAT.Events.Tools.Event_Info_Type;
                     begin
                        --  Insert a new size with the event.
                        Info.First_Event := Event;
                        Info.Count := 0;
                        MAT.Events.Tools.Collect_Info (Info, Event);
                        Frames.Insert (Key, Info);
                     end;
                  end if;
               end;
            end loop;
         end;
      end Collect_Event;

   begin
      Target.Iterate (Process => Collect_Event'Access);
   end Find_Frames;

   --  ------------------------------
   --  Collect the events that match the filter and append them to the events vector.
   --  ------------------------------
   procedure Filter_Events (Target : in out MAT.Events.Targets.Target_Events'Class;
                            Filter : in MAT.Expressions.Expression_Type;
                            Events : in out MAT.Events.Tools.Target_Event_Vector) is
      procedure Collect_Event (Event : in MAT.Events.Target_Event_Type);

      procedure Collect_Event (Event : in MAT.Events.Target_Event_Type) is
      begin
         if Filter.Is_Selected (Event) then
            Events.Append (Event);
         end if;
      end Collect_Event;

   begin
      Target.Iterate (Process => Collect_Event'Access);
   end Filter_Events;

end MAT.Events.Timelines;

-----------------------------------------------------------------------
--  mat-events-timelines - Timelines
--  Copyright (C) 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 MAT.Frames;
package body MAT.Events.Timelines is

   use MAT.Events.Targets;

   ITERATE_COUNT : constant MAT.Events.Event_Id_Type := 10_000;

   procedure Extract (Target : in out MAT.Events.Targets.Target_Events'Class;
                      Level  : in Positive;
                      Into   : in out Timeline_Info_Vector) is
      use type MAT.Types.Target_Time;
      use type MAT.Types.Target_Size;
      procedure Collect (Event : in MAT.Events.Target_Event_Type);

      First_Event : MAT.Events.Target_Event_Type;
      Last_Event  : MAT.Events.Target_Event_Type;
      Prev_Event  : MAT.Events.Target_Event_Type;
      Info        : Timeline_Info;
      First_Id    : MAT.Events.Event_Id_Type;
      Limit       : MAT.Types.Target_Time := MAT.Types.Target_Time (Level * 1_000_000);

      procedure Collect (Event : in MAT.Events.Target_Event_Type) is
         Dt : constant MAT.Types.Target_Time := Event.Time - Prev_Event.Time;
      begin
         if Dt > Limit then
            Into.Append (Info);
            Info.Malloc_Count := 0;
            Info.Realloc_Count := 0;
            Info.Free_Count := 0;
            Info.First_Event := Event;
            Info.Free_Size := 0;
            Info.Alloc_Size := 0;
            Prev_Event := Event;
         end if;
         Info.Last_Event := Event;
         if Event.Index = MAT.Events.MSG_MALLOC then
            Info.Malloc_Count := Info.Malloc_Count + 1;
            Info.Alloc_Size := Info.Alloc_Size + Event.Size;
         elsif Event.Index = MAT.Events.MSG_REALLOC then
            Info.Realloc_Count := Info.Realloc_Count + 1;
            Info.Alloc_Size := Info.Alloc_Size + Event.Size;
            Info.Free_Size := Info.Free_Size + Event.Old_Size;
         elsif Event.Index = MAT.Events.MSG_FREE then
            Info.Free_Count := Info.Free_Count + 1;
            Info.Free_Size := Info.Free_Size + Event.Size;
         end if;
      end Collect;

   begin
      Target.Get_Limits (First_Event, Last_Event);
      Prev_Event      := First_Event;
      Info.First_Event := First_Event;
      First_Id := First_Event.Id;
      while First_Id < Last_Event.Id loop
         Target.Iterate (Start   => First_Id,
                         Finish  => First_Id + ITERATE_COUNT,
                         Process => Collect'Access);
         First_Id := First_Id + ITERATE_COUNT;
      end loop;
   end Extract;

   --  ------------------------------
   --  Find in the events stream the events which are associated with a given event.
   --  When the <tt>Event</tt> is a memory allocation, find the associated reallocation
   --  and free events.  When the event is a free, find the associated allocations.
   --  Collect at most <tt>Max</tt> events.
   --  ------------------------------
   procedure Find_Related (Target : in out MAT.Events.Targets.Target_Events'Class;
                           Event  : in MAT.Events.Target_Event_Type;
                           Max    : in Positive;
                           List   : in out MAT.Events.Tools.Target_Event_Vector) is

      procedure Collect_Free (Event : in MAT.Events.Target_Event_Type);
      procedure Collect_Alloc (Event : in MAT.Events.Target_Event_Type);

      First_Id    : MAT.Events.Event_Id_Type;
      Last_Id     : MAT.Events.Event_Id_Type;
      First_Event : MAT.Events.Target_Event_Type;
      Last_Event  : MAT.Events.Target_Event_Type;
      Addr        : MAT.Types.Target_Addr := Event.Addr;

      Done : exception;

      procedure Collect_Free (Event : in MAT.Events.Target_Event_Type) is
      begin
         if Event.Index = MAT.Events.MSG_FREE and then Event.Addr = Addr then
            List.Append (Event);
            raise Done;
         end if;
         if Event.Index = MAT.Events.MSG_REALLOC and then Event.Old_Addr = Addr then
            List.Append (Event);
            if Positive (List.Length) >= Max then
               raise Done;
            end if;
            Addr := Event.Addr;
         end if;
      end Collect_Free;

      procedure Collect_Alloc (Event : in MAT.Events.Target_Event_Type) is
      begin
         if Event.Index = MAT.Events.MSG_MALLOC and then Event.Addr = Addr then
            List.Append (Event);
            raise Done;
         end if;
         if Event.Index = MAT.Events.MSG_REALLOC and then Event.Addr = Addr then
            List.Append (Event);
            if Positive (List.Length) >= Max then
               raise Done;
            end if;
            Addr := Event.Old_Addr;
         end if;
      end Collect_Alloc;

   begin
      Target.Get_Limits (First_Event, Last_Event);
      First_Id := Event.Id;
      if Event.Index = MAT.Events.MSG_FREE then
         --  Search backward for MSG_MALLOC and MSG_REALLOC.
         First_Id := First_Id - 1;
         while First_Id > First_Event.Id loop
            if First_Id > ITERATE_COUNT then
               Last_Id := First_Id - ITERATE_COUNT;
            else
               Last_Id := First_Event.Id;
            end if;
            Target.Iterate (Start   => First_Id,
                            Finish  => Last_Id,
                            Process => Collect_Alloc'Access);
            First_Id := Last_Id;
         end loop;
      else
         --  Search forward for MSG_REALLOC and MSG_FREE
         First_Id := First_Id + 1;
         while First_Id < Last_Event.Id loop
            Target.Iterate (Start   => First_Id,
                            Finish  => First_Id + ITERATE_COUNT,
                            Process => Collect_Free'Access);
            First_Id := First_Id + ITERATE_COUNT;
         end loop;
      end if;

   exception
      when Done =>
         null;
   end Find_Related;

   --  ------------------------------
   --  Find the sizes of malloc and realloc events which is selected by the given filter.
   --  Update the <tt>Sizes</tt> map to keep track of the first event and last event and
   --  the number of events found for the corresponding size.
   --  ------------------------------
   procedure Find_Sizes (Target : in out MAT.Events.Targets.Target_Events'Class;
                         Filter : in MAT.Expressions.Expression_Type;
                         Sizes  : in out MAT.Events.Tools.Size_Event_Info_Map) is
      procedure Collect_Event (Event : in MAT.Events.Target_Event_Type);

      procedure Collect_Event (Event : in MAT.Events.Target_Event_Type) is
         procedure Update_Size (Size : in MAT.Types.Target_Size;
                                Info : in out MAT.Events.Tools.Event_Info_Type);

         procedure Update_Size (Size : in MAT.Types.Target_Size;
                                Info : in out MAT.Events.Tools.Event_Info_Type) is
            pragma Unreferenced (Size);
         begin
            MAT.Events.Tools.Collect_Info (Info, Event);
         end Update_Size;

      begin
         --  Look for malloc or realloc events which are selected by the filter.
         if (Event.Index /= MAT.Events.MSG_MALLOC
             and Event.Index /= MAT.Events.MSG_FREE
             and Event.Index /= MAT.Events.MSG_REALLOC)
           or else not Filter.Is_Selected (Event)
         then
            return;
         end if;
         declare
            Pos : constant MAT.Events.Tools.Size_Event_Info_Cursor := Sizes.Find (Event.Size);
         begin
            if MAT.Events.Tools.Size_Event_Info_Maps.Has_Element (Pos) then
               --  Increment the count and update the last event.
               Sizes.Update_Element (Pos, Update_Size'Access);
            else
               declare
                  Info : MAT.Events.Tools.Event_Info_Type;
               begin
                  --  Insert a new size with the event.
                  Info.First_Event := Event;
                  MAT.Events.Tools.Collect_Info (Info, Event);
                  Sizes.Insert (Event.Size, Info);
               end;
            end if;
         end;
      end Collect_Event;

   begin
      Target.Iterate (Process => Collect_Event'Access);
   end Find_Sizes;

   --  ------------------------------
   --  Find the function address from the call event frames for the events which is selected
   --  by the given filter.  The function addresses are collected up to the given frame depth.
   --  Update the <tt>Frames</tt> map to keep track of the first event and last event and
   --  the number of events found for the corresponding frame address.
   --  ------------------------------
   procedure Find_Frames (Target : in out MAT.Events.Targets.Target_Events'Class;
                          Filter : in MAT.Expressions.Expression_Type;
                          Depth  : in Positive;
                          Exact  : in Boolean;
                          Frames : in out MAT.Events.Tools.Frame_Event_Info_Map) is
      procedure Collect_Event (Event : in MAT.Events.Target_Event_Type);

      procedure Collect_Event (Event : in MAT.Events.Target_Event_Type) is

         procedure Update_Size (Key  : in MAT.Events.Tools.Frame_Key_Type;
                                Info : in out MAT.Events.Tools.Event_Info_Type);

         procedure Update_Size (Key  : in MAT.Events.Tools.Frame_Key_Type;
                                Info : in out MAT.Events.Tools.Event_Info_Type) is
            pragma Unreferenced (Key);
         begin
            MAT.Events.Tools.Collect_Info (Info, Event);
         end Update_Size;

      begin
         --  Look for events which are selected by the filter.
         if not Filter.Is_Selected (Event) then
            return;
         end if;
         declare
            Backtrace : constant MAT.Frames.Frame_Table := MAT.Frames.Backtrace (Event.Frame);
            Key       : MAT.Events.Tools.Frame_Key_Type;
            First     : Natural;
            Last      : Natural;
         begin
            if Exact then
               First := Depth;
            else
               First := Backtrace'First;
            end if;
            if Depth < Backtrace'Last then
               Last := Depth;
            else
               Last := Backtrace'Last;
            end if;
            for I in First .. Last loop
               Key.Addr  := Backtrace (Backtrace'Last - I + 1);
               Key.Level := I;
               declare
                  Pos : constant MAT.Events.Tools.Frame_Event_Info_Cursor
                    := Frames.Find (Key);
               begin
                  if MAT.Events.Tools.Frame_Event_Info_Maps.Has_Element (Pos) then
                     --  Increment the count and update the last event.
                     Frames.Update_Element (Pos, Update_Size'Access);
                  else
                     declare
                        Info : MAT.Events.Tools.Event_Info_Type;
                     begin
                        --  Insert a new size with the event.
                        Info.First_Event := Event;
                        Info.Count := 0;
                        MAT.Events.Tools.Collect_Info (Info, Event);
                        Frames.Insert (Key, Info);
                     end;
                  end if;
               end;
            end loop;
         end;
      end Collect_Event;

   begin
      Target.Iterate (Process => Collect_Event'Access);
   end Find_Frames;

   --  ------------------------------
   --  Collect the events that match the filter and append them to the events vector.
   --  ------------------------------
   procedure Filter_Events (Target : in out MAT.Events.Targets.Target_Events'Class;
                            Filter : in MAT.Expressions.Expression_Type;
                            Events : in out MAT.Events.Tools.Target_Event_Vector) is
      procedure Collect_Event (Event : in MAT.Events.Target_Event_Type);

      procedure Collect_Event (Event : in MAT.Events.Target_Event_Type) is
      begin
         if Filter.Is_Selected (Event) then
            Events.Append (Event);
         end if;
      end Collect_Event;

   begin
      Target.Iterate (Process => Collect_Event'Access);
   end Filter_Events;

end MAT.Events.Timelines;

Use the Probe_Index_Type enum values to analyze the timeline event


-----------------------------------------------------------------------
--  awa-users-principals -- User principals
--  Copyright (C) 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.
-----------------------------------------------------------------------

package body AWA.Users.Principals is

   --  ------------------------------
   --  Get the principal name.
   --  ------------------------------
   function Get_Name (From : in Principal) return String is
   begin
      return From.User.Get_Name;
   end Get_Name;

   --  ------------------------------
   --  Returns true if the given role is stored in the user principal.
   --  ------------------------------
   function Has_Role (User : in Principal;
                      Role : in Security.Permissions.Role_Type) return Boolean is
   begin
      return User.Roles (Role);
   end Has_Role;

   --  ------------------------------
   --  Get the principal identifier (name)
   --  ------------------------------
   function Get_Id (From : in Principal) return String is
   begin
      return From.User.Get_Name;
   end Get_Id;

   --  ------------------------------
   --  Get the user associated with the principal.
   --  ------------------------------
   function Get_User (From : in Principal) return AWA.Users.Models.User_Ref is
   begin
      return From.User;
   end Get_User;

   --  ------------------------------
   --  Get the current user identifier invoking the service operation.
   --  Returns NO_IDENTIFIER if there is none.
   --  ------------------------------
   function Get_User_Identifier (From : in Principal) return ADO.Identifier is
   begin
      return From.User.Get_Id;
   end Get_User_Identifier;

   --  ------------------------------
   --  Get the connection session used by the user.
   --  ------------------------------
   function Get_Session (From : in Principal) return AWA.Users.Models.Session_Ref is
   begin
      return From.Session;
   end Get_Session;

   --  ------------------------------
   --  Get the connection session identifier used by the user.
   --  ------------------------------
   function Get_Session_Identifier (From : in Principal) return ADO.Identifier is
   begin
      return From.Session.Get_Id;
   end Get_Session_Identifier;

   --  ------------------------------
   --  Create a principal for the given user.
   --  ------------------------------
   function Create (User    : in AWA.Users.Models.User_Ref;
                    Session : in AWA.Users.Models.Session_Ref) return Principal_Access is
      Result : constant Principal_Access := new Principal;
   begin
      Result.User    := User;
	  Result.Session := Session;
      return Result;
   end Create;

   --  ------------------------------
   --  Get the current user identifier invoking the service operation.
   --  Returns NO_IDENTIFIER if there is none or if the principal is not an AWA principal.
   --  ------------------------------
   function Get_User_Identifier (From : in Security.Permissions.Principal_Access)
                                 return ADO.Identifier is
      use type Security.Permissions.Principal_Access;
   begin
      if From = null then
         return ADO.NO_IDENTIFIER;

      elsif not (From.all in Principal'Class) then
         return ADO.NO_IDENTIFIER;

      else
         return Principal'Class (From.all).Get_User_Identifier;
      end if;
   end Get_User_Identifier;

end AWA.Users.Principals;

-----------------------------------------------------------------------
--  awa-users-principals -- User principals
--  Copyright (C) 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.
-----------------------------------------------------------------------

package body AWA.Users.Principals is

   --  ------------------------------
   --  Get the principal name.
   --  ------------------------------
   function Get_Name (From : in Principal) return String is
   begin
      return From.User.Get_Name;
   end Get_Name;

   --  ------------------------------
   --  Returns true if the given role is stored in the user principal.
   --  ------------------------------
   function Has_Role (User : in Principal;
                      Role : in Security.Permissions.Role_Type) return Boolean is
   begin
      return User.Roles (Role);
   end Has_Role;

   --  ------------------------------
   --  Get the principal identifier (name)
   --  ------------------------------
   function Get_Id (From : in Principal) return String is
   begin
      return From.User.Get_Name;
   end Get_Id;

   --  ------------------------------
   --  Get the user associated with the principal.
   --  ------------------------------
   function Get_User (From : in Principal) return AWA.Users.Models.User_Ref is
   begin
      return From.User;
   end Get_User;

   --  ------------------------------
   --  Get the current user identifier invoking the service operation.
   --  Returns NO_IDENTIFIER if there is none.
   --  ------------------------------
   function Get_User_Identifier (From : in Principal) return ADO.Identifier is
   begin
      return From.User.Get_Id;
   end Get_User_Identifier;

   --  ------------------------------
   --  Get the connection session used by the user.
   --  ------------------------------
   function Get_Session (From : in Principal) return AWA.Users.Models.Session_Ref is
   begin
      return From.Session;
   end Get_Session;

   --  ------------------------------
   --  Get the connection session identifier used by the user.
   --  ------------------------------
   function Get_Session_Identifier (From : in Principal) return ADO.Identifier is
   begin
      return From.Session.Get_Id;
   end Get_Session_Identifier;

   --  ------------------------------
   --  Create a principal for the given user.
   --  ------------------------------
   function Create (User    : in AWA.Users.Models.User_Ref;
                    Session : in AWA.Users.Models.Session_Ref) return Principal_Access is
      Result : constant Principal_Access := new Principal;
   begin
      Result.User    := User;
	  Result.Session := Session;
      return Result;
   end Create;

   --  ------------------------------
   --  Get the current user identifier invoking the service operation.
   --  Returns NO_IDENTIFIER if there is none or if the principal is not an AWA principal.
   --  ------------------------------
   function Get_User_Identifier (From : in ASF.Principals.Principal_Access)
                                 return ADO.Identifier is
      use type ASF.Principals.Principal_Access;
   begin
      if From = null then
         return ADO.NO_IDENTIFIER;

      elsif not (From.all in Principal'Class) then
         return ADO.NO_IDENTIFIER;

      else
         return Principal'Class (From.all).Get_User_Identifier;
      end if;
   end Get_User_Identifier;

end AWA.Users.Principals;

Use ASF.Principals definition

Use ASF.Principals definition


-----------------------------------------------------------------------
--  security-policies-urls -- URL security policy
--  Copyright (C) 2010, 2011, 2012 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.Hashed_Maps;
with Ada.Containers.Vectors;

with Util.Refs;
with Util.Strings;
with Util.Serialize.IO.XML;

with GNAT.Regexp;

with Security.Contexts;

--  == URL Security Policy ==
--  The <tt>Security.Policies.Urls</tt> implements a security policy intended to be used
--  in web servers.  It allows to protect an URL by defining permissions that must be granted
--  for a user to get access to the URL.  A typical example is a web server that has a set of
--  administration pages, these pages should be accessed by users having some admin permission.
--
--  === Policy creation ===
--  An instance of the <tt>URL_Policy</tt> must be created and registered in the policy manager.
--  Get or declare the following variables:
--
--    Manager : Security.Policies.Policy_Manager;
--    Policy  : Security.Policies.Urls.URL_Policy_Access;
--
--  Create the URL policy and register it in the policy manager as follows:
--
--    Policy := new URL_Policy;
--    Manager.Add_Policy (Policy.all'Access);
--
--  === Policy Configuration ===
--  Once the URL policy is registered, the policy manager can read and process the following
--  XML configuration:
--
--    <policy-rules>
--      <url-policy id='1'>
--        <permission>create-workspace</permission>
--        <permission>admin</permission>
--        <url-pattern>/workspace/create</url-pattern>
--        <url-pattern>/workspace/setup/*</url-pattern>
--      </url-policy>
--      ...
--    </policy-rules>
--
--  This policy gives access to the URL that match one of the URL pattern if the
--  security context has the permission create-workspace or admin.
--  These two permissions are checked according to another security policy.
--  The XML configuration can define several <tt>url-policy</tt>.  They are checked in
--  the order defined in the XML.  In other words, the first <tt>url-policy</tt> that matches
--  the URL is used to verify the permission.
--
--  The <tt>url-policy</tt> definition can contain several <tt>permission</tt>.
--  The first permission that is granted gives access to the URL.
--
--  === Checking for permission ===
--  To check a URL permission, you must declare a <tt>URL_Permission</tt> object with the URL.
--
--     URL    : constant String := ...;
--     Perm   : constant Policies.URLs.URL_Permission (URL'Length)
--               := URL_Permission '(Len => URI'Length, URL => URL);
--
--  Then, we can check the permission:
--
--     Result : Boolean := Security.Contexts.Has_Permission (Perm);
--
package Security.Policies.URLs is

   NAME : constant String := "URL-Policy";

   package P_URL is new Security.Permissions.Definition ("url");

   --  ------------------------------
   --  URL Permission
   --  ------------------------------
   --  Represents a permission to access a given URL.
   type URL_Permission (Len : Natural) is new Permissions.Permission (P_URL.Permission) with record
      URL : String (1 .. Len);
   end record;

   --  ------------------------------
   --  URL policy
   --  ------------------------------
   type URL_Policy is new Policy with private;
   type URL_Policy_Access is access all URL_Policy'Class;

   Invalid_Name : exception;

   --  Get the policy name.
   overriding
   function Get_Name (From : in URL_Policy) return String;

   --  Returns True if the user has the permission to access the given URI permission.
   function Has_Permission (Manager    : in URL_Policy;
                            Context    : in Contexts.Security_Context'Class;
                            Permission : in URL_Permission'Class) return Boolean;

   --  Grant the permission to access to the given URI to users having the To
   --  permissions.
   procedure Grant_URI_Permission (Manager : in out URL_Policy;
                                   URI     : in String;
                                   To      : in String);

   --  Initialize the permission manager.
   overriding
   procedure Initialize (Manager : in out URL_Policy);

   --  Finalize the permission manager.
   overriding
   procedure Finalize (Manager : in out URL_Policy);

   --  Setup the XML parser to read the policy description.
   overriding
   procedure Prepare_Config (Policy : in out URL_Policy;
                             Reader : in out Util.Serialize.IO.XML.Parser);

   --  Get the URL policy associated with the given policy manager.
   --  Returns the URL policy instance or null if it was not registered in the policy manager.
   function Get_URL_Policy (Manager : in Security.Policies.Policy_Manager'Class)
                            return URL_Policy_Access;

private

   use Util.Strings;

   --  The Access_Rule represents a list of permissions to verify to grant
   --  access to the resource.  To make it simple, the user must have one of the
   --  permission from the list.  Each permission will refer to a specific permission
   --  controller.
   type Access_Rule (Count : Natural) is new Util.Refs.Ref_Entity with record
      Permissions : Permission_Index_Array (1 .. Count);
   end record;
   type Access_Rule_Access is access all Access_Rule;

   package Access_Rule_Refs is
     new Util.Refs.Indefinite_References (Element_Type   => Access_Rule,
                                          Element_Access => Access_Rule_Access);
   subtype Access_Rule_Ref is Access_Rule_Refs.Ref;

   --  Find the access rule of the policy that matches the given URI.
   --  Returns the No_Rule value (disable access) if no rule is found.
   function Find_Access_Rule (Manager : in URL_Policy;
                              URI     : in String) return Access_Rule_Ref;

   --  The Policy defines the access rules that are applied on a given
   --  URL, set of URLs or files.
   type Policy is record
      Id      : Natural;
      Pattern : GNAT.Regexp.Regexp;
      Rule    : Access_Rule_Ref;
   end record;

   --  The Policy_Vector represents the whole permission policy.  The order of
   --  policy in the list is important as policies can override each other.
   package Policy_Vector is new Ada.Containers.Vectors (Index_Type   => Positive,
                                                        Element_Type => Policy);

   package Rules_Maps is new Ada.Containers.Hashed_Maps (Key_Type        => String_Ref,
                                                         Element_Type    => Access_Rule_Ref,
                                                         Hash            => Hash,
                                                         Equivalent_Keys => Equivalent_Keys,
                                                         "="             => Access_Rule_Refs."=");

   type Rules is new Util.Refs.Ref_Entity with record
      Map : Rules_Maps.Map;
   end record;
   type Rules_Access is access all Rules;

   package Rules_Ref is new Util.Refs.References (Rules, Rules_Access);

   type Rules_Ref_Access is access Rules_Ref.Atomic_Ref;

   type Controller_Access_Array_Access is access all Controller_Access_Array;

   type URL_Policy is new Security.Policies.Policy with record
      Cache        : Rules_Ref_Access;
      Policies     : Policy_Vector.Vector;
      Id           : Natural := 0;
      Permissions  : Util.Beans.Objects.Vectors.Vector;
      Patterns     : Util.Beans.Objects.Vectors.Vector;
   end record;

end Security.Policies.URLs;

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

with Ada.Containers.Hashed_Maps;
with Ada.Containers.Vectors;

with Util.Refs;
with Util.Strings;
with Util.Serialize.Mappers;

with GNAT.Regexp;

with Security.Contexts;

--  == URL Security Policy ==
--  The <tt>Security.Policies.Urls</tt> implements a security policy intended to be used
--  in web servers.  It allows to protect an URL by defining permissions that must be granted
--  for a user to get access to the URL.  A typical example is a web server that has a set of
--  administration pages, these pages should be accessed by users having some admin permission.
--
--  === Policy creation ===
--  An instance of the <tt>URL_Policy</tt> must be created and registered in the policy manager.
--  Get or declare the following variables:
--
--    Manager : Security.Policies.Policy_Manager;
--    Policy  : Security.Policies.Urls.URL_Policy_Access;
--
--  Create the URL policy and register it in the policy manager as follows:
--
--    Policy := new URL_Policy;
--    Manager.Add_Policy (Policy.all'Access);
--
--  === Policy Configuration ===
--  Once the URL policy is registered, the policy manager can read and process the following
--  XML configuration:
--
--    <policy-rules>
--      <url-policy id='1'>
--        <permission>create-workspace</permission>
--        <permission>admin</permission>
--        <url-pattern>/workspace/create</url-pattern>
--        <url-pattern>/workspace/setup/*</url-pattern>
--      </url-policy>
--      ...
--    </policy-rules>
--
--  This policy gives access to the URL that match one of the URL pattern if the
--  security context has the permission create-workspace or admin.
--  These two permissions are checked according to another security policy.
--  The XML configuration can define several <tt>url-policy</tt>.  They are checked in
--  the order defined in the XML.  In other words, the first <tt>url-policy</tt> that matches
--  the URL is used to verify the permission.
--
--  The <tt>url-policy</tt> definition can contain several <tt>permission</tt>.
--  The first permission that is granted gives access to the URL.
--
--  === Checking for permission ===
--  To check a URL permission, you must declare a <tt>URL_Permission</tt> object with the URL.
--
--     URL    : constant String := ...;
--     Perm   : constant Policies.URLs.URL_Permission (URL'Length)
--               := URL_Permission '(Len => URI'Length, URL => URL);
--
--  Then, we can check the permission:
--
--     Result : Boolean := Security.Contexts.Has_Permission (Perm);
--
package Security.Policies.URLs is

   NAME : constant String := "URL-Policy";

   package P_URL is new Security.Permissions.Definition ("url");

   --  ------------------------------
   --  URL Permission
   --  ------------------------------
   --  Represents a permission to access a given URL.
   type URL_Permission (Len : Natural) is new Permissions.Permission (P_URL.Permission) with record
      URL : String (1 .. Len);
   end record;

   --  ------------------------------
   --  URL policy
   --  ------------------------------
   type URL_Policy is new Policy with private;
   type URL_Policy_Access is access all URL_Policy'Class;

   Invalid_Name : exception;

   --  Get the policy name.
   overriding
   function Get_Name (From : in URL_Policy) return String;

   --  Returns True if the user has the permission to access the given URI permission.
   function Has_Permission (Manager    : in URL_Policy;
                            Context    : in Contexts.Security_Context'Class;
                            Permission : in URL_Permission'Class) return Boolean;

   --  Grant the permission to access to the given URI to users having the To
   --  permissions.
   procedure Grant_URI_Permission (Manager : in out URL_Policy;
                                   URI     : in String;
                                   To      : in String);

   --  Initialize the permission manager.
   overriding
   procedure Initialize (Manager : in out URL_Policy);

   --  Finalize the permission manager.
   overriding
   procedure Finalize (Manager : in out URL_Policy);

   --  Setup the XML parser to read the policy description.
   overriding
   procedure Prepare_Config (Policy : in out URL_Policy;
                             Mapper : in out Util.Serialize.Mappers.Processing);

   --  Get the URL policy associated with the given policy manager.
   --  Returns the URL policy instance or null if it was not registered in the policy manager.
   function Get_URL_Policy (Manager : in Security.Policies.Policy_Manager'Class)
                            return URL_Policy_Access;

private

   use Util.Strings;

   --  The Access_Rule represents a list of permissions to verify to grant
   --  access to the resource.  To make it simple, the user must have one of the
   --  permission from the list.  Each permission will refer to a specific permission
   --  controller.
   type Access_Rule (Count : Natural) is new Util.Refs.Ref_Entity with record
      Permissions : Permission_Index_Array (1 .. Count);
   end record;
   type Access_Rule_Access is access all Access_Rule;

   package Access_Rule_Refs is
     new Util.Refs.Indefinite_References (Element_Type   => Access_Rule,
                                          Element_Access => Access_Rule_Access);
   subtype Access_Rule_Ref is Access_Rule_Refs.Ref;

   --  Find the access rule of the policy that matches the given URI.
   --  Returns the No_Rule value (disable access) if no rule is found.
   function Find_Access_Rule (Manager : in URL_Policy;
                              URI     : in String) return Access_Rule_Ref;

   --  The Policy defines the access rules that are applied on a given
   --  URL, set of URLs or files.
   type Policy is record
      Id      : Natural;
      Pattern : GNAT.Regexp.Regexp;
      Rule    : Access_Rule_Ref;
   end record;

   --  The Policy_Vector represents the whole permission policy.  The order of
   --  policy in the list is important as policies can override each other.
   package Policy_Vector is new Ada.Containers.Vectors (Index_Type   => Positive,
                                                        Element_Type => Policy);

   package Rules_Maps is new Ada.Containers.Hashed_Maps (Key_Type        => String_Ref,
                                                         Element_Type    => Access_Rule_Ref,
                                                         Hash            => Hash,
                                                         Equivalent_Keys => Equivalent_Keys,
                                                         "="             => Access_Rule_Refs."=");

   type Rules is new Util.Refs.Ref_Entity with record
      Map : Rules_Maps.Map;
   end record;
   type Rules_Access is access all Rules;

   package Rules_Ref is new Util.Refs.References (Rules, Rules_Access);

   type Rules_Ref_Access is access Rules_Ref.Atomic_Ref;

   type Controller_Access_Array_Access is access all Controller_Access_Array;

   type URL_Policy is new Security.Policies.Policy with record
      Cache        : Rules_Ref_Access;
      Policies     : Policy_Vector.Vector;
      Id           : Natural := 0;
      Permissions  : Util.Beans.Objects.Vectors.Vector;
      Patterns     : Util.Beans.Objects.Vectors.Vector;
   end record;

end Security.Policies.URLs;

Change the Mapper parameter to use the Mappers.Processing type


-----------------------------------------------------------------------
--  util-system-os -- Unix system operations
--  Copyright (C) 2011, 2012, 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 System;
with Interfaces.C;
with Interfaces.C.Strings;
with Util.Processes;
with Util.Systems.Constants;
with Util.Systems.Types;

--  The Util.Systems.Os package defines various types and operations which are specific
--  to the OS (Unix).
package Util.Systems.Os is

   --  The directory separator.
   Directory_Separator : constant Character := '/';

   --  The path separator.
   Path_Separator      : constant Character := ':';

   subtype Ptr is Interfaces.C.Strings.chars_ptr;
   subtype Ptr_Array is Interfaces.C.Strings.chars_ptr_array;
   type Ptr_Ptr_Array is access all Ptr_Array;

   type File_Type is new Integer;

   --  Standard file streams Posix, X/Open standard values.
   STDIN_FILENO  : constant File_Type := 0;
   STDOUT_FILENO : constant File_Type := 1;
   STDERR_FILENO : constant File_Type := 2;

   --  File is not opened
   NO_FILE       : constant File_Type := -1;

   --  The following values should be externalized.  They are valid for GNU/Linux.
   F_SETFL    : constant Interfaces.C.int := Util.Systems.Constants.F_SETFL;
   FD_CLOEXEC : constant Interfaces.C.int := Util.Systems.Constants.FD_CLOEXEC;

   --  These values are specific to Linux.
   O_RDONLY   : constant Interfaces.C.int := Util.Systems.Constants.O_RDONLY;
   O_WRONLY   : constant Interfaces.C.int := Util.Systems.Constants.O_WRONLY;
   O_RDWR     : constant Interfaces.C.int := Util.Systems.Constants.O_RDWR;
   O_CREAT    : constant Interfaces.C.int := Util.Systems.Constants.O_CREAT;
   O_EXCL     : constant Interfaces.C.int := Util.Systems.Constants.O_EXCL;
   O_TRUNC    : constant Interfaces.C.int := Util.Systems.Constants.O_TRUNC;
   O_APPEND   : constant Interfaces.C.int := Util.Systems.Constants.O_APPEND;

   type Size_T is mod 2 ** Standard'Address_Size;

   type Ssize_T is range -(2 ** (Standard'Address_Size - 1))
     .. +(2 ** (Standard'Address_Size - 1)) - 1;

   function Close (Fd : in File_Type) return Integer;
   pragma Import (C, Close, "close");

   function Read (Fd   : in File_Type;
                  Buf  : in System.Address;
                  Size : in Size_T) return Ssize_T;
   pragma Import (C, Read, "read");

   function Write (Fd   : in File_Type;
                   Buf  : in System.Address;
                   Size : in Size_T) return Ssize_T;
   pragma Import (C, Write, "write");

   --  System exit without any process cleaning.
   --  (destructors, finalizers, atexit are not called)
   procedure Sys_Exit (Code : in Integer);
   pragma Import (C, Sys_Exit, "_exit");

   --  Fork a new process
   function Sys_Fork return Util.Processes.Process_Identifier;
   pragma Import (C, Sys_Fork, "fork");

   --  Fork a new process (vfork implementation)
   function Sys_VFork return Util.Processes.Process_Identifier;
   pragma Import (C, Sys_VFork, "fork");

   --  Execute a process with the given arguments.
   function Sys_Execvp (File : in Ptr;
                        Args : in Ptr_Array) return Integer;
   pragma Import (C, Sys_Execvp, "execvp");

   --  Wait for the process Pid to finish and return
   function Sys_Waitpid (Pid     : in Integer;
                         Status  : in System.Address;
                         Options : in Integer) return Integer;
   pragma Import (C, Sys_Waitpid, "waitpid");

   --  Create a bi-directional pipe
   function Sys_Pipe (Fds : in System.Address) return Integer;
   pragma Import (C, Sys_Pipe, "pipe");

   --  Make fd2 the copy of fd1
   function Sys_Dup2 (Fd1, Fd2 : in File_Type) return Integer;
   pragma Import (C, Sys_Dup2, "dup2");

   --  Close a file
   function Sys_Close (Fd : in File_Type) return Integer;
   pragma Import (C, Sys_Close, "close");

   --  Open a file
   function Sys_Open (Path  : in Ptr;
                      Flags : in Interfaces.C.int;
                      Mode  : in Interfaces.C.int) return File_Type;
   pragma Import (C, Sys_Open, "open");

   --  Change the file settings
   function Sys_Fcntl (Fd    : in File_Type;
                       Cmd   : in Interfaces.C.int;
                       Flags : in Interfaces.C.int) return Integer;
   pragma Import (C, Sys_Fcntl, "fcntl");

   function Sys_Kill (Pid : in Integer;
                      Signal : in Integer) return Integer;
   pragma Import (C, Sys_Kill, "kill");

   function Sys_Stat (Path : in Ptr;
                      Stat : access Util.Systems.Types.Stat_Type) return Integer;
   pragma Import (C, Sys_Stat, Util.Systems.Types.STAT_NAME);

   function Sys_Fstat (Fs : in File_Type;
                       Stat : access Util.Systems.Types.Stat_Type) return Integer;
   pragma Import (C, Sys_Fstat, Util.Systems.Types.FSTAT_NAME);

end Util.Systems.Os;

-----------------------------------------------------------------------
--  util-system-os -- Unix system operations
--  Copyright (C) 2011, 2012, 2014, 2015, 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 System;
with Interfaces.C;
with Interfaces.C.Strings;
with Util.Processes;
with Util.Systems.Constants;
with Util.Systems.Types;

--  The Util.Systems.Os package defines various types and operations which are specific
--  to the OS (Unix).
package Util.Systems.Os is

   --  The directory separator.
   Directory_Separator : constant Character := '/';

   --  The path separator.
   Path_Separator      : constant Character := ':';

   subtype Ptr is Interfaces.C.Strings.chars_ptr;
   subtype Ptr_Array is Interfaces.C.Strings.chars_ptr_array;
   type Ptr_Ptr_Array is access all Ptr_Array;

   type File_Type is new Integer;

   --  Standard file streams Posix, X/Open standard values.
   STDIN_FILENO  : constant File_Type := 0;
   STDOUT_FILENO : constant File_Type := 1;
   STDERR_FILENO : constant File_Type := 2;

   --  File is not opened
   NO_FILE       : constant File_Type := -1;

   --  The following values should be externalized.  They are valid for GNU/Linux.
   F_SETFL    : constant Interfaces.C.int := Util.Systems.Constants.F_SETFL;
   FD_CLOEXEC : constant Interfaces.C.int := Util.Systems.Constants.FD_CLOEXEC;

   --  These values are specific to Linux.
   O_RDONLY   : constant Interfaces.C.int := Util.Systems.Constants.O_RDONLY;
   O_WRONLY   : constant Interfaces.C.int := Util.Systems.Constants.O_WRONLY;
   O_RDWR     : constant Interfaces.C.int := Util.Systems.Constants.O_RDWR;
   O_CREAT    : constant Interfaces.C.int := Util.Systems.Constants.O_CREAT;
   O_EXCL     : constant Interfaces.C.int := Util.Systems.Constants.O_EXCL;
   O_TRUNC    : constant Interfaces.C.int := Util.Systems.Constants.O_TRUNC;
   O_APPEND   : constant Interfaces.C.int := Util.Systems.Constants.O_APPEND;

   type Size_T is mod 2 ** Standard'Address_Size;

   type Ssize_T is range -(2 ** (Standard'Address_Size - 1))
     .. +(2 ** (Standard'Address_Size - 1)) - 1;

   function Close (Fd : in File_Type) return Integer;
   pragma Import (C, Close, "close");

   function Read (Fd   : in File_Type;
                  Buf  : in System.Address;
                  Size : in Size_T) return Ssize_T;
   pragma Import (C, Read, "read");

   function Write (Fd   : in File_Type;
                   Buf  : in System.Address;
                   Size : in Size_T) return Ssize_T;
   pragma Import (C, Write, "write");

   --  System exit without any process cleaning.
   --  (destructors, finalizers, atexit are not called)
   procedure Sys_Exit (Code : in Integer);
   pragma Import (C, Sys_Exit, "_exit");

   --  Fork a new process
   function Sys_Fork return Util.Processes.Process_Identifier;
   pragma Import (C, Sys_Fork, "fork");

   --  Fork a new process (vfork implementation)
   function Sys_VFork return Util.Processes.Process_Identifier;
   pragma Import (C, Sys_VFork, "fork");

   --  Execute a process with the given arguments.
   function Sys_Execvp (File : in Ptr;
                        Args : in Ptr_Array) return Integer;
   pragma Import (C, Sys_Execvp, "execvp");

   --  Wait for the process Pid to finish and return
   function Sys_Waitpid (Pid     : in Integer;
                         Status  : in System.Address;
                         Options : in Integer) return Integer;
   pragma Import (C, Sys_Waitpid, "waitpid");

   --  Create a bi-directional pipe
   function Sys_Pipe (Fds : in System.Address) return Integer;
   pragma Import (C, Sys_Pipe, "pipe");

   --  Make fd2 the copy of fd1
   function Sys_Dup2 (Fd1, Fd2 : in File_Type) return Integer;
   pragma Import (C, Sys_Dup2, "dup2");

   --  Close a file
   function Sys_Close (Fd : in File_Type) return Integer;
   pragma Import (C, Sys_Close, "close");

   --  Open a file
   function Sys_Open (Path  : in Ptr;
                      Flags : in Interfaces.C.int;
                      Mode  : in Interfaces.C.int) return File_Type;
   pragma Import (C, Sys_Open, "open");

   --  Change the file settings
   function Sys_Fcntl (Fd    : in File_Type;
                       Cmd   : in Interfaces.C.int;
                       Flags : in Interfaces.C.int) return Integer;
   pragma Import (C, Sys_Fcntl, "fcntl");

   function Sys_Kill (Pid : in Integer;
                      Signal : in Integer) return Integer;
   pragma Import (C, Sys_Kill, "kill");

   function Sys_Stat (Path : in Ptr;
                      Stat : access Util.Systems.Types.Stat_Type) return Integer;
   pragma Import (C, Sys_Stat, Util.Systems.Types.STAT_NAME);

   function Sys_Fstat (Fs : in File_Type;
                       Stat : access Util.Systems.Types.Stat_Type) return Integer;
   pragma Import (C, Sys_Fstat, Util.Systems.Types.FSTAT_NAME);

   function Sys_Lseek (Fs : in File_Type;
                       Offset : in Util.Systems.Types.off_t;
                       Mode   : in Util.Systems.Types.Seek_Mode) return Util.Systems.Types.off_t;
   pragma Import (C, Sys_Lseek, "lseek");

end Util.Systems.Os;

Declare Sys_Lseek import definition

Declare Sys_Lseek import definition


-----------------------------------------------------------------------
--  awa-workspaces-beans -- Beans for module workspaces
--  Copyright (C) 2011, 2012 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 Util.Beans.Basic;
with Util.Beans.Objects;
with Util.Beans.Methods;

with AWA.Events;
with AWA.Workspaces.Models;
with AWA.Workspaces.Modules;
package AWA.Workspaces.Beans is

   type Invitation_Bean is new AWA.Workspaces.Models.Invitation_Bean with record
      Module : AWA.Workspaces.Modules.Workspace_Module_Access := null;
   end record;
   type Invitation_Bean_Access is access all Invitation_Bean'Class;

   overriding
   procedure Load (Bean : in out Invitation_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   overriding
   procedure Accept_Invitation (Bean    : in out Invitation_Bean;
                                Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   overriding
   procedure Send (Bean    : in out Invitation_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   type Workspaces_Bean is new Util.Beans.Basic.Bean
     and Util.Beans.Methods.Method_Bean with record
      Module : AWA.Workspaces.Modules.Workspace_Module_Access := null;
      Count  : Natural := 0;
   end record;
   type Workspaces_Bean_Access is access all Workspaces_Bean'Class;

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

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Workspaces_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  This bean provides some methods that can be used in a Method_Expression
   overriding
   function Get_Method_Bindings (From : in Workspaces_Bean)
                                 return Util.Beans.Methods.Method_Binding_Array_Access;

   --  Event action called to create the workspace when the given event is posted.
   procedure Create (Bean  : in out Workspaces_Bean;
                     Event : in AWA.Events.Module_Event'Class);

   --  Example of action method.
   procedure Action (Bean    : in out Workspaces_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Workspaces_Bean bean instance.
   function Create_Workspaces_Bean (Module : in AWA.Workspaces.Modules.Workspace_Module_Access)
      return Util.Beans.Basic.Readonly_Bean_Access;

   type Member_List_Bean is new AWA.Workspaces.Models.Member_List_Bean with record
      Module : AWA.Workspaces.Modules.Workspace_Module_Access;
   end record;

   --  Load the list of members.
   overriding
   procedure Load (Bean    : in out Workspaces_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

end AWA.Workspaces.Beans;

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

with Ada.Strings.Unbounded;

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

with AWA.Events;
with AWA.Workspaces.Models;
with AWA.Workspaces.Modules;
package AWA.Workspaces.Beans is

   type Invitation_Bean is new AWA.Workspaces.Models.Invitation_Bean with record
      Module : AWA.Workspaces.Modules.Workspace_Module_Access := null;
   end record;
   type Invitation_Bean_Access is access all Invitation_Bean'Class;

   overriding
   procedure Load (Bean : in out Invitation_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   overriding
   procedure Accept_Invitation (Bean    : in out Invitation_Bean;
                                Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   overriding
   procedure Send (Bean    : in out Invitation_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   type Workspaces_Bean is new Util.Beans.Basic.Bean
     and Util.Beans.Methods.Method_Bean with record
      Module : AWA.Workspaces.Modules.Workspace_Module_Access := null;
      Count  : Natural := 0;
   end record;
   type Workspaces_Bean_Access is access all Workspaces_Bean'Class;

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

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Workspaces_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  This bean provides some methods that can be used in a Method_Expression
   overriding
   function Get_Method_Bindings (From : in Workspaces_Bean)
                                 return Util.Beans.Methods.Method_Binding_Array_Access;

   --  Event action called to create the workspace when the given event is posted.
   procedure Create (Bean  : in out Workspaces_Bean;
                     Event : in AWA.Events.Module_Event'Class);

   --  Example of action method.
   procedure Action (Bean    : in out Workspaces_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Workspaces_Bean bean instance.
   function Create_Workspaces_Bean (Module : in AWA.Workspaces.Modules.Workspace_Module_Access)
      return Util.Beans.Basic.Readonly_Bean_Access;

   type Member_List_Bean is new AWA.Workspaces.Models.Member_List_Bean with record
      Module       : AWA.Workspaces.Modules.Workspace_Module_Access;

      --  The list of workspace members.
      Members      : aliased AWA.Workspaces.Models.Member_Info_List_Bean;
      Members_Bean : Util.Beans.Basic.Readonly_Bean_Access;
   end record;

   --  Load the list of members.
   overriding
   procedure Load (Into    : in out Member_List_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

end AWA.Workspaces.Beans;

Add Members and Members_Bean to the Member_List_Bean type