-----------------------------------------------------------------------
--  awa-wikis-beans -- Beans for module wikis
--  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 Ada.Strings.Unbounded;
with Ada.Strings.Wide_Wide_Unbounded;

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

with ADO;
with ADO.Objects;

with ASF.Helpers.Beans;

with AWA.Wikis.Modules;
with AWA.Wikis.Models;
with AWA.Tags.Beans;
with AWA.Counters.Beans;
with AWA.Components.Wikis;

package AWA.Wikis.Beans is

   use Ada.Strings.Wide_Wide_Unbounded;

   type Wiki_Links_Bean is new AWA.Components.Wikis.Link_Renderer_Bean with record
      --  The wiki space identifier.
      Wiki_Space_Id : ADO.Identifier;
   end record;

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

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

   type Wiki_View_Bean is new AWA.Wikis.Models.Wiki_View_Info with record
      --  The wiki module instance.
      Module        : Modules.Wiki_Module_Access := null;

      --  The wiki space identifier.
      Wiki_Space_Id : ADO.Identifier;

      --  List of tags associated with the wiki page.
      Tags          : aliased AWA.Tags.Beans.Tag_List_Bean;
      Tags_Bean     : Util.Beans.Basic.Readonly_Bean_Access;

      --  The read page counter associated with the wiki page.
      Counter       : aliased AWA.Counters.Beans.Counter_Bean (Of_Type => ADO.Objects.KEY_INTEGER,
                                                               Of_Class => Models.WIKI_PAGE_TABLE);
      Counter_Bean  : Util.Beans.Basic.Readonly_Bean_Access;

      --  The wiki page links.
      Links         : aliased Wiki_Links_Bean;
      Links_Bean    : Util.Beans.Basic.Readonly_Bean_Access;
   end record;
   type Wiki_View_Bean_Access is access all Wiki_View_Bean'Class;

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

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

   --  Load the information about the wiki page to display it.
   overriding
   procedure Load (Bean    : in out Wiki_View_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Wiki_View_Bean bean instance.
   function Create_Wiki_View_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                  return Util.Beans.Basic.Readonly_Bean_Access;

   function Get_Wiki_View_Bean is
     new ASF.Helpers.Beans.Get_Bean (Element_Type   => Wiki_View_Bean,
                                     Element_Access => Wiki_View_Bean_Access);

   type Wiki_Space_Bean is new AWA.Wikis.Models.Wiki_Space_Bean with record
      Module    : Modules.Wiki_Module_Access := null;

      --  List of tags associated with the question.
      Tags      : aliased AWA.Tags.Beans.Tag_List_Bean;
      Tags_Bean : Util.Beans.Basic.Readonly_Bean_Access;
   end record;
   type Wiki_Space_Bean_Access is access all Wiki_Space_Bean'Class;

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

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

   --  Create or save the wiki space.
   overriding
   procedure Save (Bean    : in out Wiki_Space_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Load the wiki space information.
   overriding
   procedure Load (Bean    : in out Wiki_Space_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Delete the wiki space.
   procedure Delete (Bean    : in out Wiki_Space_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Wiki_Space_Bean bean instance.
   function Create_Wiki_Space_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                  return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Wiki Page Bean
   --  ------------------------------
   --  The <tt>Wiki_Page_Bean</tt> is used to edit a wiki page.  The model type inherit from
   --  the <tt>Wiki_Page</tt> and the wiki page text is hold in the <tt>Content</tt> member.
   --  When a new content is updated, the <tt>Set_Value</tt> procedure sets it in the
   --  <tt>New_Content</tt> member.  It is compared to the current wiki text to decide whether
   --  we have to create a new version or not.
   type Wiki_Page_Bean is new AWA.Wikis.Models.Wiki_Page_Bean with record
      Module     : Modules.Wiki_Module_Access := null;

      --  The page content.
      Content     : Models.Wiki_Content_Ref;
      Has_Content : Boolean := False;
      New_Content : Ada.Strings.Unbounded.Unbounded_String;
      New_Comment : Ada.Strings.Unbounded.Unbounded_String;

      Wiki_Space  : Wiki_Space_Bean;

      --  List of tags associated with the wiki page.
      Tags        : aliased AWA.Tags.Beans.Tag_List_Bean;
      Tags_Bean   : Util.Beans.Basic.Readonly_Bean_Access;
   end record;
   type Wiki_Page_Bean_Access is access all Wiki_Page_Bean'Class;

   --  Returns True if the wiki page has a new text content and requires
   --  a new version to be created.
   function Has_New_Content (Bean : in Wiki_Page_Bean) return Boolean;

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

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

   --  Create or save the wiki page.
   overriding
   procedure Save (Bean    : in out Wiki_Page_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Load the wiki page.
   overriding
   procedure Load (Bean    : in out Wiki_Page_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Delete the wiki page.
   overriding
   procedure Delete (Bean    : in out Wiki_Page_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Wiki_Page_Bean bean instance.
   function Create_Wiki_Page_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Wiki List Bean
   --  ------------------------------
   --  The Wiki_List_Bean gives a list of visible wikis to be displayed to users.
   --  The list can be filtered by a given tag.  The list pagination is supported.
   type Wiki_List_Bean is new AWA.Wikis.Models.Wiki_Page_List_Bean with record
      Module     : Modules.Wiki_Module_Access := null;
      Pages      : aliased AWA.Wikis.Models.Wiki_Page_Info_List_Bean;
      Tags       : AWA.Tags.Beans.Entity_Tag_Map;
      Pages_Bean : AWA.Wikis.Models.Wiki_Page_Info_List_Bean_Access;
   end record;
   type Wiki_List_Bean_Access is access all Wiki_List_Bean'Class;

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

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

   overriding
   procedure Load (From    : in out Wiki_List_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Load the list of pages.  If a tag was set, filter the list of pages with the tag.
   procedure Load_List (Into : in out Wiki_List_Bean);

   --  Create the Post_List_Bean bean instance.
   function Create_Wiki_List_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                   return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Wiki Version List Bean
   --  ------------------------------
   type Wiki_Version_List_Bean is new AWA.Wikis.Models.Wiki_Version_List_Bean with record
      Module        : Modules.Wiki_Module_Access := null;
      Versions      : aliased AWA.Wikis.Models.Wiki_Version_Info_List_Bean;
      Versions_Bean : AWA.Wikis.Models.Wiki_Version_Info_List_Bean_Access;
   end record;
   type Wiki_Version_List_Bean_Access is access all Wiki_Version_List_Bean'Class;

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

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

   overriding
   procedure Load (Into    : in out Wiki_Version_List_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Post_List_Bean bean instance.
   function Create_Wiki_Version_List_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                           return Util.Beans.Basic.Readonly_Bean_Access;

   type Init_Flag is (INIT_WIKI_LIST);
   type Init_Map is array (Init_Flag) of Boolean;

   --  ------------------------------
   --  Admin List Bean
   --  ------------------------------
   --  The Wiki_Admin_Bean is used for the administration of a wiki.  It gives the
   --  list of wikis and pages that are created, published or not.
   type Wiki_Admin_Bean is new Util.Beans.Basic.Bean with record
      Module : AWA.Wikis.Modules.Wiki_Module_Access := null;

      --  The wiki space identifier.
      Wiki_Id          : ADO.Identifier := ADO.NO_IDENTIFIER;

      --  List of blogs.
      Wiki_List        : aliased AWA.Wikis.Models.Wiki_Info_List_Bean;
      Wiki_List_Bean   : AWA.Wikis.Models.Wiki_Info_List_Bean_Access;

      --  Initialization flags.
      Init_Flags       : aliased Init_Map := (others => False);
      Flags            : access Init_Map;
   end record;
   type Wiki_Admin_Bean_Access is access all Wiki_Admin_Bean;

   --  Get the wiki space identifier.
   function Get_Wiki_Id (List : in Wiki_Admin_Bean) return ADO.Identifier;

   overriding
   function Get_Value (List : in Wiki_Admin_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

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

   --  Load the list of wikis.
   procedure Load_Wikis (List : in Wiki_Admin_Bean);

   --  Create the Wiki_Admin_Bean bean instance.
   function Create_Wiki_Admin_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access;

end AWA.Wikis.Beans;

-----------------------------------------------------------------------
--  awa-wikis-beans -- Beans for module wikis
--  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 Ada.Strings.Unbounded;
with Ada.Strings.Wide_Wide_Unbounded;

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

with ADO;
with ADO.Objects;

with ASF.Helpers.Beans;

with AWA.Wikis.Modules;
with AWA.Wikis.Models;
with AWA.Tags.Beans;
with AWA.Counters.Beans;
with AWA.Components.Wikis;

package AWA.Wikis.Beans is

   use Ada.Strings.Wide_Wide_Unbounded;

   type Wiki_Links_Bean is new AWA.Components.Wikis.Link_Renderer_Bean with record
      --  The wiki space identifier.
      Wiki_Space_Id : ADO.Identifier;
   end record;

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

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

   type Wiki_View_Bean is new AWA.Wikis.Models.Wiki_View_Info with record
      --  The wiki module instance.
      Module        : Modules.Wiki_Module_Access := null;

      --  The wiki space identifier.
      Wiki_Space_Id : ADO.Identifier;

      --  List of tags associated with the wiki page.
      Tags          : aliased AWA.Tags.Beans.Tag_List_Bean;
      Tags_Bean     : Util.Beans.Basic.Readonly_Bean_Access;

      --  The read page counter associated with the wiki page.
      Counter       : aliased AWA.Counters.Beans.Counter_Bean (Of_Type => ADO.Objects.KEY_INTEGER,
                                                               Of_Class => Models.WIKI_PAGE_TABLE);
      Counter_Bean  : Util.Beans.Basic.Readonly_Bean_Access;

      --  The wiki page links.
      Links         : aliased Wiki_Links_Bean;
      Links_Bean    : Util.Beans.Basic.Readonly_Bean_Access;
   end record;
   type Wiki_View_Bean_Access is access all Wiki_View_Bean'Class;

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

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

   --  Load the information about the wiki page to display it.
   overriding
   procedure Load (Bean    : in out Wiki_View_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Wiki_View_Bean bean instance.
   function Create_Wiki_View_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                  return Util.Beans.Basic.Readonly_Bean_Access;

   function Get_Wiki_View_Bean is
     new ASF.Helpers.Beans.Get_Bean (Element_Type   => Wiki_View_Bean,
                                     Element_Access => Wiki_View_Bean_Access);

   --  Get a select item list which contains a list of wiki formats.
   function Create_Format_List_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                     return Util.Beans.Basic.Readonly_Bean_Access;

   type Wiki_Space_Bean is new AWA.Wikis.Models.Wiki_Space_Bean with record
      Module    : Modules.Wiki_Module_Access := null;

      --  List of tags associated with the question.
      Tags      : aliased AWA.Tags.Beans.Tag_List_Bean;
      Tags_Bean : Util.Beans.Basic.Readonly_Bean_Access;
   end record;
   type Wiki_Space_Bean_Access is access all Wiki_Space_Bean'Class;

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

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

   --  Create or save the wiki space.
   overriding
   procedure Save (Bean    : in out Wiki_Space_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Load the wiki space information.
   overriding
   procedure Load (Bean    : in out Wiki_Space_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Delete the wiki space.
   procedure Delete (Bean    : in out Wiki_Space_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Wiki_Space_Bean bean instance.
   function Create_Wiki_Space_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                  return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Wiki Page Bean
   --  ------------------------------
   --  The <tt>Wiki_Page_Bean</tt> is used to edit a wiki page.  The model type inherit from
   --  the <tt>Wiki_Page</tt> and the wiki page text is hold in the <tt>Content</tt> member.
   --  When a new content is updated, the <tt>Set_Value</tt> procedure sets it in the
   --  <tt>New_Content</tt> member.  It is compared to the current wiki text to decide whether
   --  we have to create a new version or not.
   type Wiki_Page_Bean is new AWA.Wikis.Models.Wiki_Page_Bean with record
      Module     : Modules.Wiki_Module_Access := null;

      --  The page content.
      Content     : Models.Wiki_Content_Ref;
      Has_Content : Boolean := False;
      New_Content : Ada.Strings.Unbounded.Unbounded_String;
      New_Comment : Ada.Strings.Unbounded.Unbounded_String;

      Wiki_Space  : Wiki_Space_Bean;

      --  List of tags associated with the wiki page.
      Tags        : aliased AWA.Tags.Beans.Tag_List_Bean;
      Tags_Bean   : Util.Beans.Basic.Readonly_Bean_Access;
   end record;
   type Wiki_Page_Bean_Access is access all Wiki_Page_Bean'Class;

   --  Returns True if the wiki page has a new text content and requires
   --  a new version to be created.
   function Has_New_Content (Bean : in Wiki_Page_Bean) return Boolean;

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

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

   --  Create or save the wiki page.
   overriding
   procedure Save (Bean    : in out Wiki_Page_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Load the wiki page.
   overriding
   procedure Load (Bean    : in out Wiki_Page_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Delete the wiki page.
   overriding
   procedure Delete (Bean    : in out Wiki_Page_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Wiki_Page_Bean bean instance.
   function Create_Wiki_Page_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Wiki List Bean
   --  ------------------------------
   --  The Wiki_List_Bean gives a list of visible wikis to be displayed to users.
   --  The list can be filtered by a given tag.  The list pagination is supported.
   type Wiki_List_Bean is new AWA.Wikis.Models.Wiki_Page_List_Bean with record
      Module     : Modules.Wiki_Module_Access := null;
      Pages      : aliased AWA.Wikis.Models.Wiki_Page_Info_List_Bean;
      Tags       : AWA.Tags.Beans.Entity_Tag_Map;
      Pages_Bean : AWA.Wikis.Models.Wiki_Page_Info_List_Bean_Access;
   end record;
   type Wiki_List_Bean_Access is access all Wiki_List_Bean'Class;

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

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

   overriding
   procedure Load (From    : in out Wiki_List_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Load the list of pages.  If a tag was set, filter the list of pages with the tag.
   procedure Load_List (Into : in out Wiki_List_Bean);

   --  Create the Post_List_Bean bean instance.
   function Create_Wiki_List_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                   return Util.Beans.Basic.Readonly_Bean_Access;

   --  ------------------------------
   --  Wiki Version List Bean
   --  ------------------------------
   type Wiki_Version_List_Bean is new AWA.Wikis.Models.Wiki_Version_List_Bean with record
      Module        : Modules.Wiki_Module_Access := null;
      Versions      : aliased AWA.Wikis.Models.Wiki_Version_Info_List_Bean;
      Versions_Bean : AWA.Wikis.Models.Wiki_Version_Info_List_Bean_Access;
   end record;
   type Wiki_Version_List_Bean_Access is access all Wiki_Version_List_Bean'Class;

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

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

   overriding
   procedure Load (Into    : in out Wiki_Version_List_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String);

   --  Create the Post_List_Bean bean instance.
   function Create_Wiki_Version_List_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                           return Util.Beans.Basic.Readonly_Bean_Access;

   type Init_Flag is (INIT_WIKI_LIST);
   type Init_Map is array (Init_Flag) of Boolean;

   --  ------------------------------
   --  Admin List Bean
   --  ------------------------------
   --  The Wiki_Admin_Bean is used for the administration of a wiki.  It gives the
   --  list of wikis and pages that are created, published or not.
   type Wiki_Admin_Bean is new Util.Beans.Basic.Bean with record
      Module : AWA.Wikis.Modules.Wiki_Module_Access := null;

      --  The wiki space identifier.
      Wiki_Id          : ADO.Identifier := ADO.NO_IDENTIFIER;

      --  List of blogs.
      Wiki_List        : aliased AWA.Wikis.Models.Wiki_Info_List_Bean;
      Wiki_List_Bean   : AWA.Wikis.Models.Wiki_Info_List_Bean_Access;

      --  Initialization flags.
      Init_Flags       : aliased Init_Map := (others => False);
      Flags            : access Init_Map;
   end record;
   type Wiki_Admin_Bean_Access is access all Wiki_Admin_Bean;

   --  Get the wiki space identifier.
   function Get_Wiki_Id (List : in Wiki_Admin_Bean) return ADO.Identifier;

   overriding
   function Get_Value (List : in Wiki_Admin_Bean;
                       Name : in String) return Util.Beans.Objects.Object;

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

   --  Load the list of wikis.
   procedure Load_Wikis (List : in Wiki_Admin_Bean);

   --  Create the Wiki_Admin_Bean bean instance.
   function Create_Wiki_Admin_Bean (Module : in AWA.Wikis.Modules.Wiki_Module_Access)
                                    return Util.Beans.Basic.Readonly_Bean_Access;

end AWA.Wikis.Beans;

Declare Create_Format_List_Bean function for the creation of wiki format selector


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

with MAT.Readers.Marshaller;
package body MAT.Events.Probes is

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

   procedure Read_Probe (Client : in out Probe_Manager_Type;
                         Msg    : in out MAT.Readers.Message_Type);

   P_TIME_SEC         : constant MAT.Events.Internal_Reference := 0;
   P_TIME_USEC        : constant MAT.Events.Internal_Reference := 1;
   P_THREAD_ID        : constant MAT.Events.Internal_Reference := 2;
   P_THREAD_SP        : constant MAT.Events.Internal_Reference := 3;
   P_RUSAGE_MINFLT    : constant MAT.Events.Internal_Reference := 4;
   P_RUSAGE_MAJFLT    : constant MAT.Events.Internal_Reference := 5;
   P_RUSAGE_NVCSW     : constant MAT.Events.Internal_Reference := 6;
   P_RUSAGE_NIVCSW    : constant MAT.Events.Internal_Reference := 7;
   P_FRAME            : constant MAT.Events.Internal_Reference := 8;
   P_FRAME_PC         : constant MAT.Events.Internal_Reference := 9;

   TIME_SEC_NAME      : aliased constant String := "time-sec";
   TIME_USEC_NAME     : aliased constant String := "time-usec";
   THREAD_ID_NAME     : aliased constant String := "thread-id";
   THREAD_SP_NAME     : aliased constant String := "thread-sp";
   RUSAGE_MINFLT_NAME : aliased constant String := "ru-minflt";
   RUSAGE_MAJFLT_NAME : aliased constant String := "ru-majflt";
   RUSAGE_NVCSW_NAME  : aliased constant String := "ru-nvcsw";
   RUSAGE_NIVCSW_NAME : aliased constant String := "ru-nivcsw";
   FRAME_NAME         : aliased constant String := "frame";
   FRAME_PC_NAME      : aliased constant String := "frame-pc";

   Probe_Attributes : aliased constant MAT.Events.Attribute_Table :=
     (1 => (Name => TIME_SEC_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_TIME_SEC),
      2 => (Name => TIME_USEC_NAME'Access,
             Size => 0,
             Kind => MAT.Events.T_SIZE_T,
             Ref  => P_TIME_USEC),
      3 => (Name => THREAD_ID_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_THREAD_ID),
      4 => (Name => THREAD_SP_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_THREAD_SP),
      5 => (Name => FRAME_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_FRAME),
      6 => (Name => FRAME_PC_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_FRAME_PC),
      7 => (Name => RUSAGE_MINFLT_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_RUSAGE_MINFLT),
      8 => (Name => RUSAGE_MAJFLT_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_RUSAGE_MAJFLT),
      9 => (Name => RUSAGE_NVCSW_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_RUSAGE_NVCSW),
      10 => (Name => RUSAGE_NIVCSW_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_RUSAGE_NIVCSW)
     );

   function Hash (Key : in MAT.Types.Uint16) return Ada.Containers.Hash_Type is
   begin
      return Ada.Containers.Hash_Type (Key);
   end Hash;

   --  ------------------------------
   --  Update the Size and Prev_Id information in the event identified by <tt>Id</tt>.
   --  Update the event represented by <tt>Prev_Id</tt> so that its Next_Id refers
   --  to the <tt>Id</tt> event.
   --  ------------------------------
   procedure Update_Event (Probe   : in Probe_Type;
                           Id      : in MAT.Events.Event_Id_Type;
                           Size    : in MAT.Types.Target_Size;
                           Prev_Id : in MAT.Events.Event_Id_Type) is
   begin
      Probe.Owner.Get_Target_Events.Update_Event (Id, Size, Prev_Id);
   end Update_Event;

   --  ------------------------------
   --  Initialize the manager instance.
   --  ------------------------------
   overriding
   procedure Initialize (Manager : in out Probe_Manager_Type) is
   begin
      Manager.Events := new MAT.Events.Targets.Target_Events;
      Manager.Frames := MAT.Frames.Create_Root;
   end Initialize;

   --  ------------------------------
   --  Register the probe to handle the event identified by the given name.
   --  The event is mapped to the given id and the attributes table is used
   --  to setup the mapping from the data stream attributes.
   --  ------------------------------
   procedure Register_Probe (Into   : in out Probe_Manager_Type;
                             Probe  : in Probe_Type_Access;
                             Name   : in String;
                             Id     : in MAT.Events.Probe_Index_Type;
                             Model  : in MAT.Events.Const_Attribute_Table_Access) is
      Handler : Probe_Handler;
   begin
      Handler.Probe := Probe;
      Handler.Id    := Id;
      Handler.Attributes  := Model;
      Handler.Mapping     := null;
      Into.Probes.Insert (Name, Handler);
      Probe.Owner := Into'Unchecked_Access;
   end Register_Probe;

   --  ------------------------------
   --  Get the target events.
   --  ------------------------------
   function Get_Target_Events (Client : in Probe_Manager_Type)
                               return MAT.Events.Targets.Target_Events_Access is
   begin
      return Client.Events;
   end Get_Target_Events;

   procedure Read_Probe (Client : in out Probe_Manager_Type;
                         Msg    : in out MAT.Readers.Message) is
      use type MAT.Types.Target_Tick_Ref;

      Count     : Natural := 0;
      Time_Sec  : MAT.Types.Uint32  := 0;
      Time_Usec : MAT.Types.Uint32 := 0;
      Frame     : constant access MAT.Events.Frame_Info := Client.Frame;
   begin
      Client.Event.Thread := 0;
      Frame.Stack  := 0;
      Frame.Cur_Depth := 0;
      for I in Client.Probe'Range loop
         declare
            Def : MAT.Events.Attribute renames Client.Probe (I);
         begin
            case Def.Ref is
               when P_TIME_SEC =>
                  Time_Sec := MAT.Readers.Marshaller.Get_Target_Uint32 (Msg, Def.Kind);

               when P_TIME_USEC =>
                  Time_Usec := MAT.Readers.Marshaller.Get_Target_Uint32 (Msg, Def.Kind);

               when P_THREAD_ID =>
                  Client.Event.Thread := MAT.Types.Target_Thread_Ref
                    (MAT.Readers.Marshaller.Get_Target_Uint32 (Msg, Def.Kind));

               when P_THREAD_SP =>
                  Frame.Stack := MAT.Readers.Marshaller.Get_Target_Addr (Msg, Def.Kind);

               when P_FRAME =>
                  Count := Natural (MAT.Readers.Marshaller.Get_Target_Uint32 (Msg,
                                    Def.Kind));

               when P_FRAME_PC =>
                  for I in 1 .. Count loop --  reverse Count .. 1 loop
                     if Count < Frame.Depth then
                        Frame.Frame (Count - I + 1) := MAT.Readers.Marshaller.Get_Target_Addr (Msg,
                                                                                Def.Kind);
                     end if;
                  end loop;

               when others =>
                  null;

            end case;
         end;
      end loop;
      --  Convert the time in usec to make computation easier.
      Client.Event.Time := MAT.Types.Target_Tick_Ref (Time_Sec) * 1_000_000;
      Client.Event.Time := Client.Event.Time + MAT.Types.Target_Tick_Ref (Time_Usec);
      Frame.Cur_Depth := Count;

   exception
      when E : others =>
         Log.Error ("Marshaling error, frame count {0}", Natural'Image (Count));
         raise;

   end Read_Probe;

   procedure Dispatch_Message (Client : in out Probe_Manager_Type;
                               Msg    : in out MAT.Readers.Message_Type) is
      use type MAT.Events.Attribute_Table_Ptr;
      use type MAT.Events.Targets.Target_Events_Access;

      Event : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Pos   : constant Handler_Maps.Cursor := Client.Handlers.Find (Event);
   begin
      if Log.Get_Level = Util.Log.DEBUG_LEVEL then
         Log.Debug ("Dispatch message {0} - size {1}",
                    MAT.Types.Uint16'Image (Event),
                    Natural'Image (Msg.Size));
      end if;

      if not Handler_Maps.Has_Element (Pos) then
         --  Message is not handled, skip it.
         null;
      else
         if Client.Probe /= null then
            Read_Probe (Client, Msg);
         end if;
         declare
            Handler : constant Probe_Handler := Handler_Maps.Element (Pos);
         begin
            Client.Event.Prev_Id := 0;
            Client.Event.Old_Size := 0;
            Client.Event.Event := Event;
            Client.Event.Index := Handler.Id;
            Handler.Probe.Extract (Handler.Mapping.all'Access, Msg, Client.Event);
            MAT.Frames.Insert (Frame  => Client.Frames,
                               Pc     => Client.Frame.Frame (1 .. Client.Frame.Cur_Depth),
                               Result => Client.Event.Frame);
            Client.Events.Insert (Client.Event);
            Handler.Probe.Execute (Client.Event);
         end;
      end if;

   exception
      when E : others =>
         Log.Error ("Exception while processing event " & MAT.Types.Uint16'Image (Event), E, True);
   end Dispatch_Message;

   --  ------------------------------
   --  Read an event definition from the stream and configure the reader.
   --  ------------------------------
   procedure Read_Definition (Client : in out Probe_Manager_Type;
                              Msg    : in out MAT.Readers.Message_Type) is
      Name  : constant String := MAT.Readers.Marshaller.Get_String (Msg);
      Event : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Count : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Pos   : constant Probe_Maps.Cursor := Client.Probes.Find (Name);
      Frame : Probe_Handler;

      procedure Add_Handler (Key     : in String;
                             Element : in out Probe_Handler);

      procedure Add_Handler (Key     : in String;
                             Element : in out Probe_Handler) is
         pragma Unreferenced (Key);
      begin
         Client.Handlers.Insert (Event, Element);
      end Add_Handler;

   begin
      Log.Debug ("Read event definition {0} with {1} attributes",
                 Name, MAT.Types.Uint16'Image (Count));

      if Name = "start" then
         Frame.Mapping := new MAT.Events.Attribute_Table (1 .. Natural (Count));
         Frame.Attributes := Probe_Attributes'Access;
         Client.Probe := Frame.Mapping;
      else
         Frame.Mapping := null;
      end if;
      for I in 1 .. Natural (Count) loop
         declare
            Name : constant String := MAT.Readers.Marshaller.Get_String (Msg);
            Size : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);

            procedure Read_Attribute (Key     : in String;
                                      Element : in out Probe_Handler);

            procedure Read_Attribute (Key     : in String;
                                      Element : in out Probe_Handler) is
               pragma Unreferenced (Key);
               use type MAT.Events.Attribute_Table_Ptr;
            begin
               if Element.Mapping = null then
                  Element.Mapping := new MAT.Events.Attribute_Table (1 .. Natural (Count));
               end if;
               for J in Element.Attributes'Range loop
                  if Element.Attributes (J).Name.all = Name then
                     Element.Mapping (I) := Element.Attributes (J);
                     if Size = 1 then
                        Element.Mapping (I).Kind := MAT.Events.T_UINT8;
                     elsif Size = 2 then
                        Element.Mapping (I).Kind := MAT.Events.T_UINT16;
                     elsif Size = 4 then
                        Element.Mapping (I).Kind := MAT.Events.T_UINT32;
                     elsif Size = 8 then
                        Element.Mapping (I).Kind := MAT.Events.T_UINT64;
                     else
                        Element.Mapping (I).Kind := MAT.Events.T_UINT32;
                     end if;
                  end if;
               end loop;
            end Read_Attribute;

            use type MAT.Events.Attribute_Table_Ptr;
         begin
            if Probe_Maps.Has_Element (Pos) then
               Client.Probes.Update_Element (Pos, Read_Attribute'Access);
            end if;
            if Frame.Mapping /= null then
               Read_Attribute ("start", Frame);
            end if;
         end;
      end loop;
      if Probe_Maps.Has_Element (Pos) then
         Client.Probes.Update_Element (Pos, Add_Handler'Access);
      end if;
   end Read_Definition;

   --  ------------------------------
   --  Read a list of event definitions from the stream and configure the reader.
   --  ------------------------------
   procedure Read_Event_Definitions (Client : in out Probe_Manager_Type;
                                     Msg    : in out MAT.Readers.Message) is
      Count : MAT.Types.Uint16;
   begin
      if Client.Frame = null then
         Client.Frame := new MAT.Events.Frame_Info (512);
      end if;
      Client.Version := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Count := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);

      Log.Info ("Read event stream version {0} with {1} definitions",
                MAT.Types.Uint16'Image (Client.Version),
                MAT.Types.Uint16'Image (Count));
      for I in 1 .. Count loop
         Read_Definition (Client, Msg);
      end loop;

      --  Look at the probe definition to gather the target address size.
      Client.Addr_Size := MAT.Events.T_UINT32;
      for I in Client.Probe'Range loop
         declare
            Def : MAT.Events.Attribute renames Client.Probe (I);
         begin
            if Def.Ref = P_THREAD_SP or Def.Ref = P_FRAME_PC then
               Client.Addr_Size := Def.Kind;
               exit;
            end if;
         end;
      end loop;

   exception
      when E : MAT.Readers.Marshaller.Buffer_Underflow_Error =>
         Log.Error ("Not enough data in the message", E, True);

   end Read_Event_Definitions;

   --  ------------------------------
   --  Get the size of a target address (4 or 8 bytes).
   --  ------------------------------
   function Get_Address_Size (Client : in Probe_Manager_Type) return MAT.Events.Attribute_Type is
   begin
      return Client.Addr_Size;
   end Get_Address_Size;

end MAT.Events.Probes;

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

with MAT.Readers.Marshaller;
package body MAT.Events.Probes is

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

   procedure Read_Probe (Client : in out Probe_Manager_Type;
                         Msg    : in out MAT.Readers.Message_Type);

   P_TIME_SEC         : constant MAT.Events.Internal_Reference := 0;
   P_TIME_USEC        : constant MAT.Events.Internal_Reference := 1;
   P_THREAD_ID        : constant MAT.Events.Internal_Reference := 2;
   P_THREAD_SP        : constant MAT.Events.Internal_Reference := 3;
   P_RUSAGE_MINFLT    : constant MAT.Events.Internal_Reference := 4;
   P_RUSAGE_MAJFLT    : constant MAT.Events.Internal_Reference := 5;
   P_RUSAGE_NVCSW     : constant MAT.Events.Internal_Reference := 6;
   P_RUSAGE_NIVCSW    : constant MAT.Events.Internal_Reference := 7;
   P_FRAME            : constant MAT.Events.Internal_Reference := 8;
   P_FRAME_PC         : constant MAT.Events.Internal_Reference := 9;

   TIME_SEC_NAME      : aliased constant String := "time-sec";
   TIME_USEC_NAME     : aliased constant String := "time-usec";
   THREAD_ID_NAME     : aliased constant String := "thread-id";
   THREAD_SP_NAME     : aliased constant String := "thread-sp";
   RUSAGE_MINFLT_NAME : aliased constant String := "ru-minflt";
   RUSAGE_MAJFLT_NAME : aliased constant String := "ru-majflt";
   RUSAGE_NVCSW_NAME  : aliased constant String := "ru-nvcsw";
   RUSAGE_NIVCSW_NAME : aliased constant String := "ru-nivcsw";
   FRAME_NAME         : aliased constant String := "frame";
   FRAME_PC_NAME      : aliased constant String := "frame-pc";

   Probe_Attributes : aliased constant MAT.Events.Attribute_Table :=
     (1 => (Name => TIME_SEC_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_TIME_SEC),
      2 => (Name => TIME_USEC_NAME'Access,
             Size => 0,
             Kind => MAT.Events.T_SIZE_T,
             Ref  => P_TIME_USEC),
      3 => (Name => THREAD_ID_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_THREAD_ID),
      4 => (Name => THREAD_SP_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_THREAD_SP),
      5 => (Name => FRAME_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_FRAME),
      6 => (Name => FRAME_PC_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_FRAME_PC),
      7 => (Name => RUSAGE_MINFLT_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_RUSAGE_MINFLT),
      8 => (Name => RUSAGE_MAJFLT_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_RUSAGE_MAJFLT),
      9 => (Name => RUSAGE_NVCSW_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_RUSAGE_NVCSW),
      10 => (Name => RUSAGE_NIVCSW_NAME'Access,
            Size => 0,
            Kind => MAT.Events.T_SIZE_T,
            Ref  => P_RUSAGE_NIVCSW)
     );

   function Hash (Key : in MAT.Types.Uint16) return Ada.Containers.Hash_Type is
   begin
      return Ada.Containers.Hash_Type (Key);
   end Hash;

   --  ------------------------------
   --  Update the Size and Prev_Id information in the event identified by <tt>Id</tt>.
   --  Update the event represented by <tt>Prev_Id</tt> so that its Next_Id refers
   --  to the <tt>Id</tt> event.
   --  ------------------------------
   procedure Update_Event (Probe   : in Probe_Type;
                           Id      : in MAT.Events.Event_Id_Type;
                           Size    : in MAT.Types.Target_Size;
                           Prev_Id : in MAT.Events.Event_Id_Type) is
   begin
      Probe.Owner.Get_Target_Events.Update_Event (Id, Size, Prev_Id);
   end Update_Event;

   --  ------------------------------
   --  Initialize the manager instance.
   --  ------------------------------
   overriding
   procedure Initialize (Manager : in out Probe_Manager_Type) is
   begin
      Manager.Events := new MAT.Events.Targets.Target_Events;
   end Initialize;

   --  ------------------------------
   --  Register the probe to handle the event identified by the given name.
   --  The event is mapped to the given id and the attributes table is used
   --  to setup the mapping from the data stream attributes.
   --  ------------------------------
   procedure Register_Probe (Into   : in out Probe_Manager_Type;
                             Probe  : in Probe_Type_Access;
                             Name   : in String;
                             Id     : in MAT.Events.Probe_Index_Type;
                             Model  : in MAT.Events.Const_Attribute_Table_Access) is
      Handler : Probe_Handler;
   begin
      Handler.Probe := Probe;
      Handler.Id    := Id;
      Handler.Attributes  := Model;
      Handler.Mapping     := null;
      Into.Probes.Insert (Name, Handler);
      Probe.Owner := Into'Unchecked_Access;
   end Register_Probe;

   --  ------------------------------
   --  Get the target events.
   --  ------------------------------
   function Get_Target_Events (Client : in Probe_Manager_Type)
                               return MAT.Events.Targets.Target_Events_Access is
   begin
      return Client.Events;
   end Get_Target_Events;

   procedure Read_Probe (Client : in out Probe_Manager_Type;
                         Msg    : in out MAT.Readers.Message) is
      use type MAT.Types.Target_Tick_Ref;

      Count     : Natural := 0;
      Time_Sec  : MAT.Types.Uint32  := 0;
      Time_Usec : MAT.Types.Uint32 := 0;
      Frame     : constant access MAT.Events.Frame_Info := Client.Frame;
   begin
      Client.Event.Thread := 0;
      Frame.Stack  := 0;
      Frame.Cur_Depth := 0;
      for I in Client.Probe'Range loop
         declare
            Def : MAT.Events.Attribute renames Client.Probe (I);
         begin
            case Def.Ref is
               when P_TIME_SEC =>
                  Time_Sec := MAT.Readers.Marshaller.Get_Target_Uint32 (Msg, Def.Kind);

               when P_TIME_USEC =>
                  Time_Usec := MAT.Readers.Marshaller.Get_Target_Uint32 (Msg, Def.Kind);

               when P_THREAD_ID =>
                  Client.Event.Thread := MAT.Types.Target_Thread_Ref
                    (MAT.Readers.Marshaller.Get_Target_Uint32 (Msg, Def.Kind));

               when P_THREAD_SP =>
                  Frame.Stack := MAT.Readers.Marshaller.Get_Target_Addr (Msg, Def.Kind);

               when P_FRAME =>
                  Count := Natural (MAT.Readers.Marshaller.Get_Target_Uint32 (Msg,
                                    Def.Kind));

               when P_FRAME_PC =>
                  for I in 1 .. Count loop --  reverse Count .. 1 loop
                     if Count < Frame.Depth then
                        Frame.Frame (Count - I + 1) := MAT.Readers.Marshaller.Get_Target_Addr (Msg,
                                                                                Def.Kind);
                     end if;
                  end loop;

               when others =>
                  null;

            end case;
         end;
      end loop;
      --  Convert the time in usec to make computation easier.
      Client.Event.Time := MAT.Types.Target_Tick_Ref (Time_Sec) * 1_000_000;
      Client.Event.Time := Client.Event.Time + MAT.Types.Target_Tick_Ref (Time_Usec);
      Frame.Cur_Depth := Count;

   exception
      when E : others =>
         Log.Error ("Marshaling error, frame count {0}", Natural'Image (Count));
         raise;

   end Read_Probe;

   procedure Dispatch_Message (Client : in out Probe_Manager_Type;
                               Msg    : in out MAT.Readers.Message_Type) is
      use type MAT.Events.Attribute_Table_Ptr;
      use type MAT.Events.Targets.Target_Events_Access;

      Event : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Pos   : constant Handler_Maps.Cursor := Client.Handlers.Find (Event);
   begin
      if Log.Get_Level = Util.Log.DEBUG_LEVEL then
         Log.Debug ("Dispatch message {0} - size {1}",
                    MAT.Types.Uint16'Image (Event),
                    Natural'Image (Msg.Size));
      end if;

      if not Handler_Maps.Has_Element (Pos) then
         --  Message is not handled, skip it.
         null;
      else
         if Client.Probe /= null then
            Read_Probe (Client, Msg);
         end if;
         declare
            Handler : constant Probe_Handler := Handler_Maps.Element (Pos);
         begin
            Client.Event.Prev_Id := 0;
            Client.Event.Old_Size := 0;
            Client.Event.Event := Event;
            Client.Event.Index := Handler.Id;
            Handler.Probe.Extract (Handler.Mapping.all'Access, Msg, Client.Event);
            Client.Frames.Insert (Pc     => Client.Frame.Frame (1 .. Client.Frame.Cur_Depth),
                                  Result => Client.Event.Frame);
            Client.Events.Insert (Client.Event);
            Handler.Probe.Execute (Client.Event);
         end;
      end if;

   exception
      when E : others =>
         Log.Error ("Exception while processing event " & MAT.Types.Uint16'Image (Event), E, True);
   end Dispatch_Message;

   --  ------------------------------
   --  Read an event definition from the stream and configure the reader.
   --  ------------------------------
   procedure Read_Definition (Client : in out Probe_Manager_Type;
                              Msg    : in out MAT.Readers.Message_Type) is
      Name  : constant String := MAT.Readers.Marshaller.Get_String (Msg);
      Event : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Count : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Pos   : constant Probe_Maps.Cursor := Client.Probes.Find (Name);
      Frame : Probe_Handler;

      procedure Add_Handler (Key     : in String;
                             Element : in out Probe_Handler);

      procedure Add_Handler (Key     : in String;
                             Element : in out Probe_Handler) is
         pragma Unreferenced (Key);
      begin
         Client.Handlers.Insert (Event, Element);
      end Add_Handler;

   begin
      Log.Debug ("Read event definition {0} with {1} attributes",
                 Name, MAT.Types.Uint16'Image (Count));

      if Name = "start" then
         Frame.Mapping := new MAT.Events.Attribute_Table (1 .. Natural (Count));
         Frame.Attributes := Probe_Attributes'Access;
         Client.Probe := Frame.Mapping;
      else
         Frame.Mapping := null;
      end if;
      for I in 1 .. Natural (Count) loop
         declare
            Name : constant String := MAT.Readers.Marshaller.Get_String (Msg);
            Size : constant MAT.Types.Uint16 := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);

            procedure Read_Attribute (Key     : in String;
                                      Element : in out Probe_Handler);

            procedure Read_Attribute (Key     : in String;
                                      Element : in out Probe_Handler) is
               pragma Unreferenced (Key);
               use type MAT.Events.Attribute_Table_Ptr;
            begin
               if Element.Mapping = null then
                  Element.Mapping := new MAT.Events.Attribute_Table (1 .. Natural (Count));
               end if;
               for J in Element.Attributes'Range loop
                  if Element.Attributes (J).Name.all = Name then
                     Element.Mapping (I) := Element.Attributes (J);
                     if Size = 1 then
                        Element.Mapping (I).Kind := MAT.Events.T_UINT8;
                     elsif Size = 2 then
                        Element.Mapping (I).Kind := MAT.Events.T_UINT16;
                     elsif Size = 4 then
                        Element.Mapping (I).Kind := MAT.Events.T_UINT32;
                     elsif Size = 8 then
                        Element.Mapping (I).Kind := MAT.Events.T_UINT64;
                     else
                        Element.Mapping (I).Kind := MAT.Events.T_UINT32;
                     end if;
                  end if;
               end loop;
            end Read_Attribute;

            use type MAT.Events.Attribute_Table_Ptr;
         begin
            if Probe_Maps.Has_Element (Pos) then
               Client.Probes.Update_Element (Pos, Read_Attribute'Access);
            end if;
            if Frame.Mapping /= null then
               Read_Attribute ("start", Frame);
            end if;
         end;
      end loop;
      if Probe_Maps.Has_Element (Pos) then
         Client.Probes.Update_Element (Pos, Add_Handler'Access);
      end if;
   end Read_Definition;

   --  ------------------------------
   --  Read a list of event definitions from the stream and configure the reader.
   --  ------------------------------
   procedure Read_Event_Definitions (Client : in out Probe_Manager_Type;
                                     Msg    : in out MAT.Readers.Message) is
      Count : MAT.Types.Uint16;
   begin
      if Client.Frame = null then
         Client.Frame := new MAT.Events.Frame_Info (512);
      end if;
      Client.Version := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);
      Count := MAT.Readers.Marshaller.Get_Uint16 (Msg.Buffer);

      Log.Info ("Read event stream version {0} with {1} definitions",
                MAT.Types.Uint16'Image (Client.Version),
                MAT.Types.Uint16'Image (Count));
      for I in 1 .. Count loop
         Read_Definition (Client, Msg);
      end loop;

      --  Look at the probe definition to gather the target address size.
      Client.Addr_Size := MAT.Events.T_UINT32;
      for I in Client.Probe'Range loop
         declare
            Def : MAT.Events.Attribute renames Client.Probe (I);
         begin
            if Def.Ref = P_THREAD_SP or Def.Ref = P_FRAME_PC then
               Client.Addr_Size := Def.Kind;
               exit;
            end if;
         end;
      end loop;

   exception
      when E : MAT.Readers.Marshaller.Buffer_Underflow_Error =>
         Log.Error ("Not enough data in the message", E, True);

   end Read_Event_Definitions;

   --  ------------------------------
   --  Get the size of a target address (4 or 8 bytes).
   --  ------------------------------
   function Get_Address_Size (Client : in Probe_Manager_Type) return MAT.Events.Attribute_Type is
   begin
      return Client.Addr_Size;
   end Get_Address_Size;

end MAT.Events.Probes;

Update to use the Target_Frames type

Update to use the Target_Frames type


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

with Util.Log.Loggers;

with Security.Auth.OpenID;
with Security.Auth.OAuth.Facebook;
with Security.Auth.OAuth.Googleplus;
package body Security.Auth is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Security.Auth");

   --  ------------------------------
   --  Get the provider.
   --  ------------------------------
   function Get_Provider (Assoc : in Association) return String is
   begin
      return To_String (Assoc.Provider);
   end Get_Provider;

   --  ------------------------------
   --  Get the email address
   --  ------------------------------
   function Get_Email (Auth : in Authentication) return String is
   begin
      return To_String (Auth.Email);
   end Get_Email;

   --  ------------------------------
   --  Get the user first name.
   --  ------------------------------
   function Get_First_Name (Auth : in Authentication) return String is
   begin
      return To_String (Auth.First_Name);
   end Get_First_Name;

   --  ------------------------------
   --  Get the user last name.
   --  ------------------------------
   function Get_Last_Name (Auth : in Authentication) return String is
   begin
      return To_String (Auth.Last_Name);
   end Get_Last_Name;

   --  ------------------------------
   --  Get the user full name.
   --  ------------------------------
   function Get_Full_Name (Auth : in Authentication) return String is
   begin
      return To_String (Auth.Full_Name);
   end Get_Full_Name;

   --  ------------------------------
   --  Get the user identity.
   --  ------------------------------
   function Get_Identity (Auth : in Authentication) return String is
   begin
      return To_String (Auth.Identity);
   end Get_Identity;

   --  ------------------------------
   --  Get the user claimed identity.
   --  ------------------------------
   function Get_Claimed_Id (Auth : in Authentication) return String is
   begin
      return To_String (Auth.Claimed_Id);
   end Get_Claimed_Id;

   --  ------------------------------
   --  Get the user language.
   --  ------------------------------
   function Get_Language (Auth : in Authentication) return String is
   begin
      return To_String (Auth.Language);
   end Get_Language;

   --  ------------------------------
   --  Get the user country.
   --  ------------------------------
   function Get_Country (Auth : in Authentication) return String is
   begin
      return To_String (Auth.Country);
   end Get_Country;

   --  ------------------------------
   --  Get the result of the authentication.
   --  ------------------------------
   function Get_Status (Auth : in Authentication) return Auth_Result is
   begin
      return Auth.Status;
   end Get_Status;

   --  ------------------------------
   --  Default principal
   --  ------------------------------

   --  ------------------------------
   --  Get the principal name.
   --  ------------------------------
   function Get_Name (From : in Principal) return String is
   begin
      return Get_First_Name (From.Auth) & " " & Get_Last_Name (From.Auth);
   end Get_Name;

   --  ------------------------------
   --  Get the user email address.
   --  ------------------------------
   function Get_Email (From : in Principal) return String is
   begin
      return Get_Email (From.Auth);
   end Get_Email;

   --  ------------------------------
   --  Get the authentication data.
   --  ------------------------------
   function Get_Authentication (From : in Principal) return Authentication is
   begin
      return From.Auth;
   end Get_Authentication;

   --  ------------------------------
   --  Create a principal with the given authentication results.
   --  ------------------------------
   function Create_Principal (Auth : in Authentication) return Principal_Access is
      P : constant Principal_Access := new Principal;
   begin
      P.Auth := Auth;
      return P;
   end Create_Principal;

   --  ------------------------------
   --  Default factory used by `Initialize`.  It supports OpenID, Google, Facebook.
   --  ------------------------------
   function Default_Factory (Provider : in String) return Manager_Access is
   begin
      if Provider = PROVIDER_OPENID then
         return new Security.Auth.OpenID.Manager;

      elsif Provider = PROVIDER_FACEBOOK then
         return new Security.Auth.OAuth.Facebook.Manager;

      elsif Provider = PROVIDER_GOOGLE_PLUS then
         return new Security.Auth.OAuth.Googleplus.Manager;

      else
         Log.Error ("Authentication provider {0} not recognized", Provider);
         raise Service_Error with "Authentication provider not supported";
      end if;
   end Default_Factory;

   --  ------------------------------
   --  Initialize the OpenID realm.
   --  ------------------------------
   procedure Initialize (Realm  : in out Manager;
                         Params : in Parameters'Class;
                         Name   : in String := PROVIDER_OPENID) is
   begin
      Initialize (Realm, Params, Default_Factory'Access, Name);
   end Initialize;

   procedure Initialize (Realm   : in out Manager;
                         Params  : in Parameters'Class;
                         Factory : not null
                         access function (Name : in String) return Manager_Access;
                         Name    : in String := PROVIDER_OPENID) is
      Provider : constant String := Params.Get_Parameter ("auth.provider." & Name);
      Impl     : constant Manager_Access := Factory (Provider);
   begin
      if Impl = null then
         Log.Error ("Authentication provider {0} not recognized", Provider);
         raise Service_Error with "Authentication provider not supported";
      end if;
      Realm.Delegate := Impl;
      Impl.Initialize (Params, Name);
      Realm.Provider := To_Unbounded_String (Name);
   end Initialize;

   --  ------------------------------
   --  Discover the OpenID provider that must be used to authenticate the user.
   --  The <b>Name</b> can be an URL or an alias that identifies the provider.
   --  A cached OpenID provider can be returned.
   --  (See OpenID Section 7.3 Discovery)
   --  ------------------------------
   procedure Discover (Realm  : in out Manager;
                       Name   : in String;
                       Result : out End_Point) is
   begin
      if Realm.Delegate /= null then
         Realm.Delegate.Discover (Name, Result);
      else
--           Result.URL := Realm.Realm;
         Result.Alias := To_Unbounded_String ("");
      end if;
   end Discover;

   --  ------------------------------
   --  Associate the application (relying party) with the OpenID provider.
   --  The association can be cached.
   --  (See OpenID Section 8 Establishing Associations)
   --  ------------------------------
   procedure Associate (Realm  : in out Manager;
                        OP     : in End_Point;
                        Result : out Association) is
   begin
      Result.Provider := Realm.Provider;
      if Realm.Delegate /= null then
         Realm.Delegate.Associate (OP, Result);
      end if;
   end Associate;

   --  ------------------------------
   --  Get the authentication URL to which the user must be redirected for authentication
   --  by the authentication server.
   --  ------------------------------
   function Get_Authentication_URL (Realm : in Manager;
                                    OP    : in End_Point;
                                    Assoc : in Association) return String is
   begin
      if Realm.Delegate /= null then
         return Realm.Delegate.Get_Authentication_URL (OP, Assoc);
      else
         return To_String (OP.URL);
      end if;
   end Get_Authentication_URL;

   procedure Set_Result (Result  : in out Authentication;
                         Status  : in Auth_Result;
                         Message : in String) is
   begin
      if Status /= AUTHENTICATED then
         Log.Error ("OpenID verification failed: {0}", Message);
      else
         Log.Info ("OpenID verification: {0}", Message);
      end if;
      Result.Status := Status;
   end Set_Result;

   --  ------------------------------
   --  Verify the authentication result
   --  ------------------------------
   procedure Verify (Realm   : in out Manager;
                     Assoc   : in Association;
                     Request : in Parameters'Class;
                     Result  : out Authentication) is
   begin
      if Realm.Delegate /= null then
         Realm.Delegate.Verify (Assoc, Request, Result);
      else
         Set_Result (Result, SETUP_NEEDED, "Setup is needed");
      end if;
   end Verify;

   function To_String (OP : End_Point) return String is
   begin
      return "openid://" & To_String (OP.URL);
   end To_String;

   function To_String (Assoc : Association) return String is
   begin
      return "session_type=" & To_String (Assoc.Session_Type)
        & "&assoc_type=" & To_String (Assoc.Assoc_Type)
        & "&assoc_handle=" & To_String (Assoc.Assoc_Handle)
        & "&mac_key=" & To_String (Assoc.Mac_Key);
   end To_String;

end Security.Auth;

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

with Security.Auth.OpenID;
with Security.Auth.OAuth.Facebook;
with Security.Auth.OAuth.Googleplus;
package body Security.Auth is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Security.Auth");

   --  ------------------------------
   --  Get the provider.
   --  ------------------------------
   function Get_Provider (Assoc : in Association) return String is
   begin
      return To_String (Assoc.Provider);
   end Get_Provider;

   --  ------------------------------
   --  Get the email address
   --  ------------------------------
   function Get_Email (Auth : in Authentication) return String is
   begin
      return To_String (Auth.Email);
   end Get_Email;

   --  ------------------------------
   --  Get the user first name.
   --  ------------------------------
   function Get_First_Name (Auth : in Authentication) return String is
   begin
      return To_String (Auth.First_Name);
   end Get_First_Name;

   --  ------------------------------
   --  Get the user last name.
   --  ------------------------------
   function Get_Last_Name (Auth : in Authentication) return String is
   begin
      return To_String (Auth.Last_Name);
   end Get_Last_Name;

   --  ------------------------------
   --  Get the user full name.
   --  ------------------------------
   function Get_Full_Name (Auth : in Authentication) return String is
   begin
      return To_String (Auth.Full_Name);
   end Get_Full_Name;

   --  ------------------------------
   --  Get the user identity.
   --  ------------------------------
   function Get_Identity (Auth : in Authentication) return String is
   begin
      return To_String (Auth.Identity);
   end Get_Identity;

   --  ------------------------------
   --  Get the user claimed identity.
   --  ------------------------------
   function Get_Claimed_Id (Auth : in Authentication) return String is
   begin
      return To_String (Auth.Claimed_Id);
   end Get_Claimed_Id;

   --  ------------------------------
   --  Get the user language.
   --  ------------------------------
   function Get_Language (Auth : in Authentication) return String is
   begin
      return To_String (Auth.Language);
   end Get_Language;

   --  ------------------------------
   --  Get the user country.
   --  ------------------------------
   function Get_Country (Auth : in Authentication) return String is
   begin
      return To_String (Auth.Country);
   end Get_Country;

   --  ------------------------------
   --  Get the result of the authentication.
   --  ------------------------------
   function Get_Status (Auth : in Authentication) return Auth_Result is
   begin
      return Auth.Status;
   end Get_Status;

   --  ------------------------------
   --  Default principal
   --  ------------------------------

   --  ------------------------------
   --  Get the principal name.
   --  ------------------------------
   function Get_Name (From : in Principal) return String is
   begin
      return Get_First_Name (From.Auth) & " " & Get_Last_Name (From.Auth);
   end Get_Name;

   --  ------------------------------
   --  Get the user email address.
   --  ------------------------------
   function Get_Email (From : in Principal) return String is
   begin
      return Get_Email (From.Auth);
   end Get_Email;

   --  ------------------------------
   --  Get the authentication data.
   --  ------------------------------
   function Get_Authentication (From : in Principal) return Authentication is
   begin
      return From.Auth;
   end Get_Authentication;

   --  ------------------------------
   --  Create a principal with the given authentication results.
   --  ------------------------------
   function Create_Principal (Auth : in Authentication) return Principal_Access is
      P : constant Principal_Access := new Principal;
   begin
      P.Auth := Auth;
      return P;
   end Create_Principal;

   --  ------------------------------
   --  Default factory used by `Initialize`.  It supports OpenID, Google, Facebook.
   --  ------------------------------
   function Default_Factory (Provider : in String) return Manager_Access is
   begin
      if Provider = PROVIDER_OPENID then
         return new Security.Auth.OpenID.Manager;

      elsif Provider = PROVIDER_FACEBOOK then
         return new Security.Auth.OAuth.Facebook.Manager;

      elsif Provider = PROVIDER_GOOGLE_PLUS then
         return new Security.Auth.OAuth.Googleplus.Manager;

      else
         Log.Error ("Authentication provider {0} not recognized", Provider);
         raise Service_Error with "Authentication provider not supported";
      end if;
   end Default_Factory;

   --  ------------------------------
   --  Initialize the OpenID realm.
   --  ------------------------------
   procedure Initialize (Realm  : in out Manager;
                         Params : in Parameters'Class;
                         Name   : in String := PROVIDER_OPENID) is
   begin
      Initialize (Realm, Params, Default_Factory'Access, Name);
   end Initialize;

   procedure Initialize (Realm   : in out Manager;
                         Params  : in Parameters'Class;
                         Factory : not null
                         access function (Name : in String) return Manager_Access;
                         Name    : in String := PROVIDER_OPENID) is
      Provider : constant String := Params.Get_Parameter ("auth.provider." & Name);
      Impl     : constant Manager_Access := Factory (Provider);
   begin
      if Impl = null then
         Log.Error ("Authentication provider {0} not recognized", Provider);
         raise Service_Error with "Authentication provider not supported";
      end if;
      Realm.Delegate := Impl;
      Impl.Initialize (Params, Name);
      Realm.Provider := To_Unbounded_String (Name);
   end Initialize;

   --  ------------------------------
   --  Discover the OpenID provider that must be used to authenticate the user.
   --  The <b>Name</b> can be an URL or an alias that identifies the provider.
   --  A cached OpenID provider can be returned.
   --  (See OpenID Section 7.3 Discovery)
   --  ------------------------------
   procedure Discover (Realm  : in out Manager;
                       Name   : in String;
                       Result : out End_Point) is
   begin
      if Realm.Delegate /= null then
         Realm.Delegate.Discover (Name, Result);
      else
--           Result.URL := Realm.Realm;
         Result.Alias := To_Unbounded_String ("");
      end if;
   end Discover;

   --  ------------------------------
   --  Associate the application (relying party) with the OpenID provider.
   --  The association can be cached.
   --  (See OpenID Section 8 Establishing Associations)
   --  ------------------------------
   procedure Associate (Realm  : in out Manager;
                        OP     : in End_Point;
                        Result : out Association) is
   begin
      Result.Provider := Realm.Provider;
      if Realm.Delegate /= null then
         Realm.Delegate.Associate (OP, Result);
      end if;
   end Associate;

   --  ------------------------------
   --  Get the authentication URL to which the user must be redirected for authentication
   --  by the authentication server.
   --  ------------------------------
   function Get_Authentication_URL (Realm : in Manager;
                                    OP    : in End_Point;
                                    Assoc : in Association) return String is
   begin
      if Realm.Delegate /= null then
         return Realm.Delegate.Get_Authentication_URL (OP, Assoc);
      else
         return To_String (OP.URL);
      end if;
   end Get_Authentication_URL;

   procedure Set_Result (Result  : in out Authentication;
                         Status  : in Auth_Result;
                         Message : in String) is
   begin
      if Status /= AUTHENTICATED then
         Log.Error ("OpenID verification failed: {0}", Message);
      else
         Log.Info ("OpenID verification: {0}", Message);
      end if;
      Result.Status := Status;
   end Set_Result;

   --  ------------------------------
   --  Verify the authentication result
   --  ------------------------------
   procedure Verify (Realm   : in out Manager;
                     Assoc   : in Association;
                     Request : in Parameters'Class;
                     Result  : out Authentication) is
   begin
      if Realm.Delegate /= null then
         Realm.Delegate.Verify (Assoc, Request, Result);
      else
         Set_Result (Result, SETUP_NEEDED, "Setup is needed");
      end if;
   end Verify;

   function To_String (OP : End_Point) return String is
   begin
      return "openid://" & To_String (OP.URL);
   end To_String;

   function To_String (Assoc : Association) return String is
   begin
      return "session_type=" & To_String (Assoc.Session_Type)
        & "&assoc_type=" & To_String (Assoc.Assoc_Type)
        & "&assoc_handle=" & To_String (Assoc.Assoc_Handle)
        & "&mac_key=" & To_String (Assoc.Mac_Key);
   end To_String;

   overriding
   procedure Finalize (Realm : in out Manager) is
      procedure Free is
         new Ada.Unchecked_Deallocation (Manager'Class, Manager_Access);
   begin
      Free (Realm.Delegate);
   end Finalize;

end Security.Auth;

Add Finalize and release the OAuth delegate implementation


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

   --  ------------------------------
   --  Get the number of arguments available.
   --  ------------------------------
   overriding
   function Get_Count (List : in Default_Argument_List) return Natural is
      Count : constant Natural := Ada.Command_Line.Argument_Count;
   begin
      if Count > List.Offset then
         return Count - List.Offset;
      else
         return 0;
      end if;
   end Get_Count;

   --  ------------------------------
   --  Get the argument at the given position.
   --  ------------------------------
   overriding
   function Get_Argument (List : in Default_Argument_List;
                          Pos  : in Positive) return String is
   begin
      return Ada.Command_Line.Argument (Pos + List.Offset);
   end Get_Argument;

   --  ------------------------------
   --  Get the command name.
   --  ------------------------------
   function Get_Command_Name (List : in Default_Argument_List) return String is
      pragma Unreferenced (List);
   begin
      return Ada.Command_Line.Command_Name;
   end Get_Command_Name;

   --  ------------------------------
   --  Set the argument list to the given string and split the arguments.
   --  ------------------------------
   procedure Initialize (List : in out String_Argument_List;
                         Line : in String) is
      First : Natural := Line'First;
   begin
      List.Length := Line'Length;
      List.Line (1 .. Line'Length) := Line;
      List.Count := 0;
      loop
         while First <= Line'Length
           and then Ada.Characters.Handling.Is_Space (List.Line (First)) loop
            First := First + 1;
         end loop;
         exit when First > Line'Length;
         List.Start_Pos (List.Count) := First;
         while First <= Line'Length
           and then not Ada.Characters.Handling.Is_Space (List.Line (First)) loop
            First := First + 1;
         end loop;
         List.End_Pos (List.Count) := First - 1;
         List.Count := List.Count + 1;
      end loop;
      if List.Count > 0 then
         List.Count := List.Count - 1;
      end if;
   end Initialize;

   --  ------------------------------
   --  Get the number of arguments available.
   --  ------------------------------
   overriding
   function Get_Count (List : in String_Argument_List) return Natural is
   begin
      return List.Count;
   end Get_Count;

   --  ------------------------------
   --  Get the argument at the given position.
   --  ------------------------------
   overriding
   function Get_Argument (List : in String_Argument_List;
                          Pos  : in Positive) return String is
   begin
      return List.Line (List.Start_Pos (Pos) .. List.End_Pos (Pos));
   end Get_Argument;

   --  ------------------------------
   --  Get the command name.
   --  ------------------------------
   overriding
   function Get_Command_Name (List : in String_Argument_List) return String is
   begin
      return List.Line (List.Start_Pos (0) .. List.End_Pos (0));
   end Get_Command_Name;

   --  ------------------------------
   --  Get the number of arguments available.
   --  ------------------------------
   function Get_Count (List : in Dynamic_Argument_List) return Natural is
   begin
      return Natural (List.List.Length);
   end Get_Count;

   --  ------------------------------
   --  Get the argument at the given position.
   --  ------------------------------
   function Get_Argument (List : in Dynamic_Argument_List;
                          Pos  : in Positive) return String is
   begin
      return List.List.Element (Pos);
   end Get_Argument;

   --  ------------------------------
   --  Get the command name.
   --  ------------------------------
   function Get_Command_Name (List : in Dynamic_Argument_List) return String is
   begin
      return List.List.Element (1);
   end Get_Command_Name;

end Util.Commands;

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

   --  ------------------------------
   --  Get the number of arguments available.
   --  ------------------------------
   overriding
   function Get_Count (List : in Default_Argument_List) return Natural is
      Count : constant Natural := Ada.Command_Line.Argument_Count;
   begin
      if Count > List.Offset then
         return Count - List.Offset;
      else
         return 0;
      end if;
   end Get_Count;

   --  ------------------------------
   --  Get the argument at the given position.
   --  ------------------------------
   overriding
   function Get_Argument (List : in Default_Argument_List;
                          Pos  : in Positive) return String is
   begin
      return Ada.Command_Line.Argument (Pos + List.Offset);
   end Get_Argument;

   --  ------------------------------
   --  Get the command name.
   --  ------------------------------
   function Get_Command_Name (List : in Default_Argument_List) return String is
      pragma Unreferenced (List);
   begin
      return Ada.Command_Line.Command_Name;
   end Get_Command_Name;

   --  ------------------------------
   --  Set the argument list to the given string and split the arguments.
   --  ------------------------------
   procedure Initialize (List : in out String_Argument_List;
                         Line : in String) is
      First : Natural := Line'First;
   begin
      List.Length := Line'Length;
      List.Line (1 .. Line'Length) := Line;
      List.Count := 0;
      loop
         while First <= Line'Length
           and then Ada.Characters.Handling.Is_Space (List.Line (First)) loop
            First := First + 1;
         end loop;
         exit when First > Line'Length;
         List.Start_Pos (List.Count) := First;
         while First <= Line'Length
           and then not Ada.Characters.Handling.Is_Space (List.Line (First)) loop
            First := First + 1;
         end loop;
         List.End_Pos (List.Count) := First - 1;
         List.Count := List.Count + 1;
      end loop;
      if List.Count > 0 then
         List.Count := List.Count - 1;
      end if;
   end Initialize;

   --  ------------------------------
   --  Get the number of arguments available.
   --  ------------------------------
   overriding
   function Get_Count (List : in String_Argument_List) return Natural is
   begin
      return List.Count;
   end Get_Count;

   --  ------------------------------
   --  Get the argument at the given position.
   --  ------------------------------
   overriding
   function Get_Argument (List : in String_Argument_List;
                          Pos  : in Positive) return String is
   begin
      return List.Line (List.Start_Pos (Pos) .. List.End_Pos (Pos));
   end Get_Argument;

   --  ------------------------------
   --  Get the command name.
   --  ------------------------------
   overriding
   function Get_Command_Name (List : in String_Argument_List) return String is
   begin
      return List.Line (List.Start_Pos (0) .. List.End_Pos (0));
   end Get_Command_Name;

   --  ------------------------------
   --  Get the number of arguments available.
   --  ------------------------------
   function Get_Count (List : in Dynamic_Argument_List) return Natural is
   begin
      return Natural (List.List.Length);
   end Get_Count;

   --  ------------------------------
   --  Get the argument at the given position.
   --  ------------------------------
   function Get_Argument (List : in Dynamic_Argument_List;
                          Pos  : in Positive) return String is
   begin
      return List.List.Element (Pos);
   end Get_Argument;

   --  ------------------------------
   --  Get the command name.
   --  ------------------------------
   function Get_Command_Name (List : in Dynamic_Argument_List) return String is
   begin
      return Ada.Strings.Unbounded.To_String (List.Name);
   end Get_Command_Name;

end Util.Commands;

Update Get_Command_Name to use the name member


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

package body MAT.Consoles is

   --  ------------------------------
   --  Format the address and print it for the given field.
   --  ------------------------------
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Addr    : in MAT.Types.Target_Addr) is
      Value : constant String := MAT.Types.Hex_Image (Addr);
   begin
      Console_Type'Class (Console).Print_Field (Field, Value);
   end Print_Field;

end MAT.Consoles;

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

package body MAT.Consoles is

   --  ------------------------------
   --  Format the address and print it for the given field.
   --  ------------------------------
   procedure Print_Field (Console : in out Console_Type;
                          Field   : in Field_Type;
                          Addr    : in MAT.Types.Target_Addr) is
      Value : constant String := MAT.Types.Hex_Image (Addr);
   begin
      Console_Type'Class (Console).Print_Field (Field, Value);
   end Print_Field;

   --  ------------------------------
   --  Format the size and print it for the given field.
   --  ------------------------------
   procedure Print_Size (Console : in out Console_Type;
                         Field   : in Field_Type;
                         Size    : in MAT.Types.Target_Size) is
      Value : constant String := MAT.Types.Target_Size'Image (Size);
   begin
      Console_Type'Class (Console).Print_Field (Field, Value);
   end Print_Size;

end MAT.Consoles;

Implement the Print_Size operation

Implement the Print_Size operation