-----------------------------------------------------------------------
--  awa-setup -- Setup and installation
--  Copyright (C) 2016 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Text_IO;
with Ada.IO_Exceptions;
with Util.Files;
with Util.Log.Loggers;
with Util.Strings;
with ASF.Events.Faces.Actions;
with ASF.Applications.Main.Configs;
with AWA.Applications;
package body AWA.Setup.Applications is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Setup.Applications");

   package Save_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => Application,
                                                      Method => Save,
                                                      Name   => "save");

   package Finish_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => Application,
                                                      Method => Finish,
                                                      Name   => "finish");
   package Configure_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => Application,
                                                      Method => Configure_Database,
                                                      Name   => "configure_database");

   Binding_Array : aliased constant Util.Beans.Methods.Method_Binding_Array
     := (Save_Binding.Proxy'Access,
         Finish_Binding.Proxy'Access,
         Configure_Binding.Proxy'Access);

   --  Get the value identified by the name.
   function Get_Value (From : in Application;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "database_name" then
         return Util.Beans.Objects.To_Object (From.Database.Get_Database);
      elsif Name = "database_server" then
         return Util.Beans.Objects.To_Object (From.Database.Get_Server);
      elsif Name = "database_port" then
         return Util.Beans.Objects.To_Object (From.Database.Get_Port);
      elsif Name = "database_user" then
         return Util.Beans.Objects.To_Object (From.Database.Get_Property ("user"));
      elsif Name = "database_password" then
         return Util.Beans.Objects.To_Object (From.Database.Get_Property ("password"));
      end if;
      if From.Changed.Exists (Name) then
         return Util.Beans.Objects.To_Object (String '(From.Changed.Get (Name)));
      end if;
      declare
         Param : constant String := From.Config.Get (Name);
      begin
         return Util.Beans.Objects.To_Object (Param);
      end;

   exception
      when others =>
         return Util.Beans.Objects.Null_Object;
   end Get_Value;

   --  Set the value identified by the name.
   procedure Set_Value (From  : in out Application;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "database_name" then
         From.Database.Set_Database (Util.Beans.Objects.To_String (Value));
      elsif Name = "database_server" then
         From.Database.Set_Server (Util.Beans.Objects.To_String (Value));
      elsif Name = "database_port" then
         From.Database.Set_Port (Util.Beans.Objects.To_Integer (Value));
      elsif Name = "database_user" then
         From.Database.Set_Property ("user", Util.Beans.Objects.To_String (Value));
      elsif Name = "database_password" then
         From.Database.Set_Property ("password", Util.Beans.Objects.To_String (Value));
      else
         From.Changed.Set (Name, Util.Beans.Objects.To_String (Value));
      end if;
   end Set_Value;

   --  Configure the database.
   procedure Configure_Database (From    : in out Application;
                                 Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Log.Info ("Configure database");
   end Configure_Database;

   --  Save the configuration.
   procedure Save (From    : in out Application;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      Path     : constant String := Ada.Strings.Unbounded.To_String (From.Path);
      New_File : constant String := Path & ".tmp";
      Output   : Ada.Text_IO.File_Type;

      procedure Read_Property (Line : in String) is
         Pos : constant Natural := Util.Strings.Index (Line, '=');
      begin
         if Pos = 0 or else not From.Changed.Exists (Line (Line'First .. Pos - 1)) then
            Ada.Text_IO.Put_Line (Line);
            return;
         end if;
         Ada.Text_IO.Put (Line (Line'First .. Pos));
         Ada.Text_IO.Put_Line (From.Changed.Get (Line (Line'First .. Pos - 1)));
      end Read_Property;

   begin
      Log.Info ("Saving configuration file {0}", Path);
      Ada.Text_IO.Create (File => Output, Name => Path);
      Util.Files.Read_File (Path, Read_Property'Access);
      Ada.Text_IO.Close (Output);
   end Save;

   --  Finish the setup and exit the setup.
   procedure Finish (From    : in out Application;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Log.Info ("Finish configuration");
      From.Done := True;
   end Finish;

   --  This bean provides some methods that can be used in a Method_Expression
   overriding
   function Get_Method_Bindings (From : in Application)
                                 return Util.Beans.Methods.Method_Binding_Array_Access is
   begin
      return Binding_Array'Access;
   end Get_Method_Bindings;

   --  Enter in the application setup
   procedure Setup (App    : in out Application;
                    Config : in String;
                    Server : in out ASF.Server.Container'Class) is
   begin
      Log.Info ("Entering configuration for {0}", Config);
      App.Path := Ada.Strings.Unbounded.To_Unbounded_String (Config);
      begin
         App.Config.Load_Properties (Config);
         Util.Log.Loggers.Initialize (Config);

      exception
         when Ada.IO_Exceptions.Name_Error =>
            Log.Error ("Cannot read application configuration file: {0}", Config);
      end;
      App.Initialize (App.Config, App.Factory);
      App.Set_Global ("contextPath", App.Config.Get ("contextPath"));
      App.Set_Global ("setup",
                      Util.Beans.Objects.To_Object (App'Unchecked_Access,
                        Util.Beans.Objects.STATIC));
      App.Add_Servlet (Name   => "faces",
                       Server => App.Faces'Unchecked_Access);
      App.Add_Servlet (Name   => "files",
                       Server => App.Files'Unchecked_Access);
      App.Add_Mapping (Pattern => "*.html",
                       Name    => "faces");
      App.Add_Mapping (Pattern => "*.css",
                       Name    => "files");
      App.Add_Mapping (Pattern => "*.js",
                       Name    => "files");

      declare
         Paths : constant String := App.Get_Config (AWA.Applications.P_Module_Dir.P);
         Path  : constant String := Util.Files.Find_File_Path ("setup.xml", Paths);
      begin
         ASF.Applications.Main.Configs.Read_Configuration (App, Path);

      exception
         when Ada.IO_Exceptions.Name_Error =>
            Log.Error ("Setup configuration file '{0}' does not exist", Path);
      end;
      App.Database.Set_Connection (App.Config.Get ("database", "mysql://localhost:3306/db"));
      Server.Register_Application (App.Config.Get ("contextPath"), App'Unchecked_Access);
      Server.Start;
      while not App.Done loop
         delay 5.0;
      end loop;
   end Setup;

end AWA.Setup.Applications;

-----------------------------------------------------------------------
--  awa-setup -- Setup and installation
--  Copyright (C) 2016 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Text_IO;
with Ada.IO_Exceptions;
with Util.Files;
with Util.Log.Loggers;
with Util.Strings;
with ASF.Events.Faces.Actions;
with ASF.Applications.Main.Configs;
with AWA.Applications;
package body AWA.Setup.Applications is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Setup.Applications");

   package Save_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => Application,
                                                      Method => Save,
                                                      Name   => "save");

   package Finish_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => Application,
                                                      Method => Finish,
                                                      Name   => "finish");
   package Configure_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => Application,
                                                      Method => Configure_Database,
                                                      Name   => "configure_database");

   Binding_Array : aliased constant Util.Beans.Methods.Method_Binding_Array
     := (Save_Binding.Proxy'Access,
         Finish_Binding.Proxy'Access,
         Configure_Binding.Proxy'Access);

   --  Get the value identified by the name.
   function Get_Value (From : in Application;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "database_name" then
         return Util.Beans.Objects.To_Object (From.Database.Get_Database);
      elsif Name = "database_server" then
         return Util.Beans.Objects.To_Object (From.Database.Get_Server);
      elsif Name = "database_port" then
         return Util.Beans.Objects.To_Object (From.Database.Get_Port);
      elsif Name = "database_user" then
         return Util.Beans.Objects.To_Object (From.Database.Get_Property ("user"));
      elsif Name = "database_password" then
         return Util.Beans.Objects.To_Object (From.Database.Get_Property ("password"));
      end if;
      if From.Changed.Exists (Name) then
         return Util.Beans.Objects.To_Object (String '(From.Changed.Get (Name)));
      end if;
      declare
         Param : constant String := From.Config.Get (Name);
      begin
         return Util.Beans.Objects.To_Object (Param);
      end;

   exception
      when others =>
         return Util.Beans.Objects.Null_Object;
   end Get_Value;

   --  Set the value identified by the name.
   procedure Set_Value (From  : in out Application;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "database_name" then
         From.Database.Set_Database (Util.Beans.Objects.To_String (Value));
      elsif Name = "database_server" then
         From.Database.Set_Server (Util.Beans.Objects.To_String (Value));
      elsif Name = "database_port" then
         From.Database.Set_Port (Util.Beans.Objects.To_Integer (Value));
      elsif Name = "database_user" then
         From.Database.Set_Property ("user", Util.Beans.Objects.To_String (Value));
      elsif Name = "database_password" then
         From.Database.Set_Property ("password", Util.Beans.Objects.To_String (Value));
      elsif Name = "callback_url" then
         From.Changed.Set (Name, Util.Beans.Objects.To_String (Value));
         From.Changed.Set ("facebook.callback_url",
                           Util.Beans.Objects.To_String (Value) & "#{contextPath}/auth/verify");
         From.Changed.Set ("google-plus.callback_url",
                           Util.Beans.Objects.To_String (Value) & "#{contextPath}/auth/verify");
      else
         From.Changed.Set (Name, Util.Beans.Objects.To_String (Value));
      end if;
   end Set_Value;

   --  Configure the database.
   procedure Configure_Database (From    : in out Application;
                                 Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Log.Info ("Configure database");
   end Configure_Database;

   --  Save the configuration.
   procedure Save (From    : in out Application;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      Path     : constant String := Ada.Strings.Unbounded.To_String (From.Path);
      New_File : constant String := Path & ".tmp";
      Output   : Ada.Text_IO.File_Type;

      procedure Read_Property (Line : in String) is
         Pos : constant Natural := Util.Strings.Index (Line, '=');
      begin
         if Pos = 0 or else not From.Changed.Exists (Line (Line'First .. Pos - 1)) then
            Ada.Text_IO.Put_Line (Output, Line);
            return;
         end if;
         Ada.Text_IO.Put (Output, Line (Line'First .. Pos));
         Ada.Text_IO.Put_Line (Output, From.Changed.Get (Line (Line'First .. Pos - 1)));
      end Read_Property;

   begin
      Log.Info ("Saving configuration file {0}", Path);
      Ada.Text_IO.Create (File => Output, Name => New_File);
      Util.Files.Read_File (Path, Read_Property'Access);
      Ada.Text_IO.Close (Output);
   end Save;

   --  Finish the setup and exit the setup.
   procedure Finish (From    : in out Application;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Log.Info ("Finish configuration");
      From.Done := True;
   end Finish;

   --  This bean provides some methods that can be used in a Method_Expression
   overriding
   function Get_Method_Bindings (From : in Application)
                                 return Util.Beans.Methods.Method_Binding_Array_Access is
   begin
      return Binding_Array'Access;
   end Get_Method_Bindings;

   --  Enter in the application setup
   procedure Setup (App    : in out Application;
                    Config : in String;
                    Server : in out ASF.Server.Container'Class) is
   begin
      Log.Info ("Entering configuration for {0}", Config);
      App.Path := Ada.Strings.Unbounded.To_Unbounded_String (Config);
      begin
         App.Config.Load_Properties (Config);
         Util.Log.Loggers.Initialize (Config);

      exception
         when Ada.IO_Exceptions.Name_Error =>
            Log.Error ("Cannot read application configuration file: {0}", Config);
      end;
      App.Initialize (App.Config, App.Factory);
      App.Set_Global ("contextPath", App.Config.Get ("contextPath"));
      App.Set_Global ("setup",
                      Util.Beans.Objects.To_Object (App'Unchecked_Access,
                        Util.Beans.Objects.STATIC));
      App.Add_Servlet (Name   => "faces",
                       Server => App.Faces'Unchecked_Access);
      App.Add_Servlet (Name   => "files",
                       Server => App.Files'Unchecked_Access);
      App.Add_Mapping (Pattern => "*.html",
                       Name    => "faces");
      App.Add_Mapping (Pattern => "*.css",
                       Name    => "files");
      App.Add_Mapping (Pattern => "*.js",
                       Name    => "files");

      declare
         Paths : constant String := App.Get_Config (AWA.Applications.P_Module_Dir.P);
         Path  : constant String := Util.Files.Find_File_Path ("setup.xml", Paths);
      begin
         ASF.Applications.Main.Configs.Read_Configuration (App, Path);

      exception
         when Ada.IO_Exceptions.Name_Error =>
            Log.Error ("Setup configuration file '{0}' does not exist", Path);
      end;

      declare
         URL : constant String := App.Config.Get ("google-plus.callback_url", "");
         Pos : Natural := Util.Strings.Index (URL, '#');
      begin
         if Pos > 0 then
            App.Changed.Set ("callback_url", URL (URL'First .. Pos - 1));
         end if;
      end;
      App.Database.Set_Connection (App.Config.Get ("database", "mysql://localhost:3306/db"));
      Server.Register_Application (App.Config.Get ("contextPath"), App'Unchecked_Access);
      Server.Start;
      while not App.Done loop
         delay 5.0;
      end loop;
   end Setup;

end AWA.Setup.Applications;

Configure the OAuth callbacks

Configure the OAuth callbacks


-----------------------------------------------------------------------
--  security-openid -- Open ID 2.0 Support
--  Copyright (C) 2009, 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.Strings.Unbounded;
with Ada.Calendar;
with Ada.Finalization;

--  == OpenID ==
--  The Security.Openid package implements an authentication framework based
--  on OpenID 2.0.
--
--  See OpenID Authentication 2.0 - Final
--  http://openid.net/specs/openid-authentication-2_0.html
--
--  There are basically two steps that an application must implement:
--
--    * Discovery: to resolve and use the OpenID provider and redirect the user to the
--      provider authentication form.
--    * Verify: to decode the authentication and check its result.
--
--  [http://ada-security.googlecode.com/svn/wiki/OpenID.png]
--
--  The authentication process is the following:
--
--    * The application should redirect the user to the authentication URL.
--    * The OpenID provider authenticate the user and redirects the user to the callback CB.
--    * The association is decoded from the callback parameter.
--    * The Verify procedure is called with the association to check the result and
--      obtain the authentication results.
--
--  === Initialization ===
--  The initialization process must be done before each two steps (discovery and verify).
--  The OpenID manager must be declared and configured.
--
--    Mgr   : Openid.Manager;
--
--  For the configuration, the Initialize procedure is called to configure
--  the OpenID realm and set the OpenID return callback CB.  The return callback
--  must be a valid URL that is based on the realm.  Example:
--
--    Mgr.Initialize (Name      => "http://app.site.com/auth",
--                    Return_To => "http://app.site.com/auth/verify");
--
--  After this initialization, the OpenID manager can be used in the authentication process.
--
--  === Discovery: creating the authentication URL ===
--  The first step is to create an authentication URL to which the user must be redirected.
--  In this step, we have to create an OpenId manager, discover the OpenID provider,
--  do the association and get an End_Point.
--
--    OP    : Openid.End_Point;
--    Assoc : constant Association_Access := new Association;
--
--  The following steps are performed:
--
--    * The Discover procedure is called to retrieve from the OpenID provider the XRDS
--      stream and identify the provider.  An End_Point is returned in <tt>OP</tt>.
--    * The Associate procedure is called to make the association with the End_Point.
--      The Association record holds session, and authentication.
--
--    Mgr.Discover (Provider, OP);  --  Yadis discovery (get the XRDS file).
--    Mgr.Associate (OP, Assoc.all);--  Associate and get an end-point with a key.
--
--  After this first step, you must manage to save the association in the HTTP session.
--  Then you must redirect to the authentication URL that is obtained by using:
--
--    Auth_URL : constant String := Mgr.Get_Authentication_URL (OP, Assoc.all);
--
--  === Verify: acknowledge the authentication in the callback URL ===
--  The second step is done when the user has finished the authentication successfully or not.
--  For this step, the application must get back the association that was saved in the session.
--  It must also prepare a parameters object that allows the OpenID framework to get the
--  URI parameters from the return callback.
--
--    Assoc   : Association_Access := ...;  --  Get the association saved in the session.
--    Auth    : Openid.Authentication;
--    Params  : Auth_Params;
--
--  The OpenID manager must be initialized and the Verify procedure is called with
--  the association, parameters and the authentication result.  The Get_Status function
--  must be used to check that the authentication succeeded.
--
--    Mgr.Verify (Assoc.all, Params, Auth);
--    if Openid.Get_Status (Auth) /= Openid.AUTHENTICATED then ...  -- Failure.
--
--
--
package Security.Openid is

   Invalid_End_Point : exception;

   Service_Error     : exception;

   type Parameters is limited interface;

   function Get_Parameter (Params : in Parameters;
                           Name   : in String) return String is abstract;

   --  ------------------------------
   --  OpenID provider
   --  ------------------------------
   --  The End_Point represents the OpenID provider that will authenticate
   --  the user.
   type End_Point is private;

   function To_String (OP : End_Point) return String;

   --  ------------------------------
   --  Association
   --  ------------------------------
   --  The OpenID association contains the shared secret between the relying party
   --  and the OpenID provider.  The association can be cached and reused to authenticate
   --  different users using the same OpenID provider.  The association also has an
   --  expiration date.
   type Association is private;

   --  Dump the association as a string (for debugging purposes)
   function To_String (Assoc : Association) return String;

   type Auth_Result is (AUTHENTICATED, CANCEL, SETUP_NEEDED, UNKNOWN, INVALID_SIGNATURE);

   --  ------------------------------
   --  OpenID provider
   --  ------------------------------
   --
   type Authentication is private;

   --  Get the email address
   function Get_Email (Auth : in Authentication) return String;

   --  Get the user first name.
   function Get_First_Name (Auth : in Authentication) return String;

   --  Get the user last name.
   function Get_Last_Name (Auth : in Authentication) return String;

   --  Get the user full name.
   function Get_Full_Name (Auth : in Authentication) return String;

   --  Get the user identity.
   function Get_Identity (Auth : in Authentication) return String;

   --  Get the user claimed identity.
   function Get_Claimed_Id (Auth : in Authentication) return String;

   --  Get the user language.
   function Get_Language (Auth : in Authentication) return String;

   --  Get the user country.
   function Get_Country (Auth : in Authentication) return String;

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

   --  ------------------------------
   --  OpenID Default principal
   --  ------------------------------
   type Principal is new Security.Principal with private;
   type Principal_Access is access all Principal'Class;

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

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

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

   --  Create a principal with the given authentication results.
   function Create_Principal (Auth : in Authentication) return Principal_Access;

   --  ------------------------------
   --  OpenID Manager
   --  ------------------------------
   --  The Manager provides the core operations for the OpenID process.
   type Manager is tagged limited private;

   --  Initialize the OpenID realm.
   procedure Initialize (Realm     : in out Manager;
                         Name      : in String;
                         Return_To : in String);

   --  Discover the OpenID provider that must be used to authenticate the user.
   --  The Name 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);

   --  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);

   function Get_Authentication_URL (Realm : in Manager;
                                    OP    : in End_Point;
                                    Assoc : in Association) return String;

   --  Verify the authentication result
   procedure Verify (Realm   : in out Manager;
                     Assoc   : in Association;
                     Request : in Parameters'Class;
                     Result  : out Authentication);

   --  Verify the authentication result
   procedure Verify_Discovered (Realm   : in out Manager;
                                Assoc   : in Association;
                                Request : in Parameters'Class;
                                Result  : out Authentication);

   --  Verify the signature part of the result
   procedure Verify_Signature (Realm   : in Manager;
                               Assoc   : in Association;
                               Request : in Parameters'Class;
                               Result  : in out Authentication);

   --  Read the XRDS document from the URI and initialize the OpenID provider end point.
   procedure Discover_XRDS (Realm  : in out Manager;
                            URI    : in String;
                            Result : out End_Point);

   --  Extract from the XRDS content the OpenID provider URI.
   --  The default implementation is very basic as it returns the first <URI>
   --  available in the stream without validating the XRDS document.
   --  Raises the Invalid_End_Point exception if the URI cannot be found.
   procedure Extract_XRDS (Realm   : in out Manager;
                           Content : in String;
                           Result  : out End_Point);

private

   use Ada.Strings.Unbounded;

   type Association is record
      Session_Type : Unbounded_String;
      Assoc_Type   : Unbounded_String;
      Assoc_Handle : Unbounded_String;
      Mac_Key      : Unbounded_String;
      Expired      : Ada.Calendar.Time;
   end record;

   type Authentication is record
      Status     : Auth_Result;
      Identity   : Unbounded_String;
      Claimed_Id : Unbounded_String;
      Email      : Unbounded_String;
      Full_Name  : Unbounded_String;
      First_Name : Unbounded_String;
      Last_Name  : Unbounded_String;
      Language   : Unbounded_String;
      Country    : Unbounded_String;
      Gender     : Unbounded_String;
      Timezone   : Unbounded_String;
      Nickname   : Unbounded_String;
   end record;

   type End_Point is record
      URL        : Unbounded_String;
      Alias      : Unbounded_String;
      Expired    : Ada.Calendar.Time;
   end record;

   type Manager is new Ada.Finalization.Limited_Controlled with record
      Realm     : Unbounded_String;
      Return_To : Unbounded_String;
   end record;

   type Principal is new Security.Principal with record
      Auth : Authentication;
   end record;

end Security.Openid;

-----------------------------------------------------------------------
--  security-openid -- Open ID 2.0 Support
--  Copyright (C) 2009, 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.Strings.Unbounded;
with Ada.Calendar;
with Ada.Finalization;

--  == OpenID ==
--  The Security.Openid package implements an authentication framework based
--  on OpenID 2.0.
--
--  See OpenID Authentication 2.0 - Final
--  http://openid.net/specs/openid-authentication-2_0.html
--
--  There are basically two steps that an application must implement:
--
--    * Discovery: to resolve and use the OpenID provider and redirect the user to the
--      provider authentication form.
--    * Verify: to decode the authentication and check its result.
--
--  [http://ada-security.googlecode.com/svn/wiki/OpenID.png]
--
--  The authentication process is the following:
--
--    * The application should redirect the user to the authentication URL.
--    * The OpenID provider authenticate the user and redirects the user to the callback CB.
--    * The association is decoded from the callback parameter.
--    * The Verify procedure is called with the association to check the result and
--      obtain the authentication results.
--
--  === Initialization ===
--  The initialization process must be done before each two steps (discovery and verify).
--  The OpenID manager must be declared and configured.
--
--    Mgr   : Openid.Manager;
--
--  For the configuration, the Initialize procedure is called to configure
--  the OpenID realm and set the OpenID return callback URL.  The return callback
--  must be a valid URL that is based on the realm.  Example:
--
--    Mgr.Initialize (Name      => "http://app.site.com/auth",
--                    Return_To => "http://app.site.com/auth/verify");
--
--  After this initialization, the OpenID manager can be used in the authentication process.
--
--  === Discovery: creating the authentication URL ===
--  The first step is to create an authentication URL to which the user must be redirected.
--  In this step, we have to create an OpenId manager, discover the OpenID provider,
--  do the association and get an End_Point.  The OpenID provider is specified as an
--  URL, below is an example for Google OpenID:
--
--    Provider : constant String := "https://www.google.com/accounts/o8/id";
--    OP    : Openid.End_Point;
--    Assoc : constant Association_Access := new Association;
--
--  The following steps are performed:
--
--    * The Discover procedure is called to retrieve from the OpenID provider the XRDS
--      stream and identify the provider.  An End_Point is returned in <tt>OP</tt>.
--    * The Associate procedure is called to make the association with the End_Point.
--      The Association record holds session, and authentication.
--
--    Mgr.Discover (Provider, OP);  --  Yadis discovery (get the XRDS file).
--    Mgr.Associate (OP, Assoc.all);--  Associate and get an end-point with a key.
--
--  After this first step, you must manage to save the association in the HTTP session.
--  Then you must redirect to the authentication URL that is obtained by using:
--
--    Auth_URL : constant String := Mgr.Get_Authentication_URL (OP, Assoc.all);
--
--  === Verify: acknowledge the authentication in the callback URL ===
--  The second step is done when the user has finished the authentication successfully or not.
--  For this step, the application must get back the association that was saved in the session.
--  It must also prepare a parameters object that allows the OpenID framework to get the
--  URI parameters from the return callback.
--
--    Assoc   : Association_Access := ...;  --  Get the association saved in the session.
--    Auth    : Openid.Authentication;
--    Params  : Auth_Params;
--
--  The OpenID manager must be initialized and the Verify procedure is called with
--  the association, parameters and the authentication result.  The Get_Status function
--  must be used to check that the authentication succeeded.
--
--    Mgr.Verify (Assoc.all, Params, Auth);
--    if Openid.Get_Status (Auth) /= Openid.AUTHENTICATED then ...  -- Failure.
--
--
--
package Security.Openid is

   Invalid_End_Point : exception;

   Service_Error     : exception;

   type Parameters is limited interface;

   function Get_Parameter (Params : in Parameters;
                           Name   : in String) return String is abstract;

   --  ------------------------------
   --  OpenID provider
   --  ------------------------------
   --  The End_Point represents the OpenID provider that will authenticate
   --  the user.
   type End_Point is private;

   function To_String (OP : End_Point) return String;

   --  ------------------------------
   --  Association
   --  ------------------------------
   --  The OpenID association contains the shared secret between the relying party
   --  and the OpenID provider.  The association can be cached and reused to authenticate
   --  different users using the same OpenID provider.  The association also has an
   --  expiration date.
   type Association is private;

   --  Dump the association as a string (for debugging purposes)
   function To_String (Assoc : Association) return String;

   type Auth_Result is (AUTHENTICATED, CANCEL, SETUP_NEEDED, UNKNOWN, INVALID_SIGNATURE);

   --  ------------------------------
   --  OpenID provider
   --  ------------------------------
   --
   type Authentication is private;

   --  Get the email address
   function Get_Email (Auth : in Authentication) return String;

   --  Get the user first name.
   function Get_First_Name (Auth : in Authentication) return String;

   --  Get the user last name.
   function Get_Last_Name (Auth : in Authentication) return String;

   --  Get the user full name.
   function Get_Full_Name (Auth : in Authentication) return String;

   --  Get the user identity.
   function Get_Identity (Auth : in Authentication) return String;

   --  Get the user claimed identity.
   function Get_Claimed_Id (Auth : in Authentication) return String;

   --  Get the user language.
   function Get_Language (Auth : in Authentication) return String;

   --  Get the user country.
   function Get_Country (Auth : in Authentication) return String;

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

   --  ------------------------------
   --  OpenID Default principal
   --  ------------------------------
   type Principal is new Security.Principal with private;
   type Principal_Access is access all Principal'Class;

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

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

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

   --  Create a principal with the given authentication results.
   function Create_Principal (Auth : in Authentication) return Principal_Access;

   --  ------------------------------
   --  OpenID Manager
   --  ------------------------------
   --  The Manager provides the core operations for the OpenID process.
   type Manager is tagged limited private;

   --  Initialize the OpenID realm.
   procedure Initialize (Realm     : in out Manager;
                         Name      : in String;
                         Return_To : in String);

   --  Discover the OpenID provider that must be used to authenticate the user.
   --  The Name 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);

   --  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);

   function Get_Authentication_URL (Realm : in Manager;
                                    OP    : in End_Point;
                                    Assoc : in Association) return String;

   --  Verify the authentication result
   procedure Verify (Realm   : in out Manager;
                     Assoc   : in Association;
                     Request : in Parameters'Class;
                     Result  : out Authentication);

   --  Verify the authentication result
   procedure Verify_Discovered (Realm   : in out Manager;
                                Assoc   : in Association;
                                Request : in Parameters'Class;
                                Result  : out Authentication);

   --  Verify the signature part of the result
   procedure Verify_Signature (Realm   : in Manager;
                               Assoc   : in Association;
                               Request : in Parameters'Class;
                               Result  : in out Authentication);

   --  Read the XRDS document from the URI and initialize the OpenID provider end point.
   procedure Discover_XRDS (Realm  : in out Manager;
                            URI    : in String;
                            Result : out End_Point);

   --  Extract from the XRDS content the OpenID provider URI.
   --  The default implementation is very basic as it returns the first <URI>
   --  available in the stream without validating the XRDS document.
   --  Raises the Invalid_End_Point exception if the URI cannot be found.
   procedure Extract_XRDS (Realm   : in out Manager;
                           Content : in String;
                           Result  : out End_Point);

private

   use Ada.Strings.Unbounded;

   type Association is record
      Session_Type : Unbounded_String;
      Assoc_Type   : Unbounded_String;
      Assoc_Handle : Unbounded_String;
      Mac_Key      : Unbounded_String;
      Expired      : Ada.Calendar.Time;
   end record;

   type Authentication is record
      Status     : Auth_Result;
      Identity   : Unbounded_String;
      Claimed_Id : Unbounded_String;
      Email      : Unbounded_String;
      Full_Name  : Unbounded_String;
      First_Name : Unbounded_String;
      Last_Name  : Unbounded_String;
      Language   : Unbounded_String;
      Country    : Unbounded_String;
      Gender     : Unbounded_String;
      Timezone   : Unbounded_String;
      Nickname   : Unbounded_String;
   end record;

   type End_Point is record
      URL        : Unbounded_String;
      Alias      : Unbounded_String;
      Expired    : Ada.Calendar.Time;
   end record;

   type Manager is new Ada.Finalization.Limited_Controlled with record
      Realm     : Unbounded_String;
      Return_To : Unbounded_String;
   end record;

   type Principal is new Security.Principal with record
      Auth : Authentication;
   end record;

end Security.Openid;

Update the documentation

Update the documentation


-----------------------------------------------------------------------
--  properties -- Generic name/value property management
--  Copyright (C) 2001, 2002, 2003, 2006, 2008, 2009, 2010, 2014, 2017 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Ada.Finalization;
with Ada.Text_IO;
with Util.Beans.Objects;
with Util.Beans.Basic;
with Util.Strings.Vectors;
private with Util.Concurrent.Counters;
package Util.Properties is

   NO_PROPERTY : exception;

   use Ada.Strings.Unbounded;

   subtype Value is Util.Beans.Objects.Object;

   function "+" (S : String) return Unbounded_String renames To_Unbounded_String;

   function "-" (S : Unbounded_String) return String renames To_String;

   function To_String (V : in Value) return String
     renames Util.Beans.Objects.To_String;

   --  The manager holding the name/value pairs and providing the operations
   --  to get and set the properties.
   type Manager is new Ada.Finalization.Controlled and Util.Beans.Basic.Bean with private;
   type Manager_Access is access all Manager'Class;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : in Manager;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   --  If the map contains the given name, the value changed.
   --  Otherwise name is added to the map and the value associated with it.
   overriding
   procedure Set_Value (From  : in out Manager;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Returns TRUE if the property exists.
   function Exists (Self : in Manager'Class;
                    Name : in Unbounded_String) return Boolean;

   --  Returns TRUE if the property exists.
   function Exists (Self : in Manager'Class;
                    Name : in String) return Boolean;

   --  Returns the property value.  Raises an exception if not found.
   function Get (Self : in Manager'Class;
                 Name : in String) return String;

   --  Returns the property value.  Raises an exception if not found.
   function Get (Self : in Manager'Class;
                 Name : in String) return Unbounded_String;

   --  Returns the property value.  Raises an exception if not found.
   function Get (Self : in Manager'Class;
                 Name : in Unbounded_String) return Unbounded_String;

   --  Returns the property value.  Raises an exception if not found.
   function Get (Self : in Manager'Class;
                 Name : in Unbounded_String) return String;

   --  Returns the property value or Default if it does not exist.
   function Get (Self : in Manager'Class;
                 Name : in String;
                 Default : in String) return String;

   --  Returns a property manager that is associated with the given name.
   --  Raises NO_PROPERTY if there is no such property manager or if a property exists
   --  but is not a property manager.
   function Get (Self : in Manager'Class;
                 Name : in String) return Manager;

   --  Create a property manager and associated it with the given name.
   function Create (Self : in out Manager'Class;
                    Name : in String) return Manager;

   --  Set the value of the property.  The property is created if it
   --  does not exists.
   procedure Set (Self : in out Manager'Class;
                  Name : in String;
                  Item : in String);

   --  Set the value of the property.  The property is created if it
   --  does not exists.
   procedure Set (Self : in out Manager'Class;
                  Name : in String;
                  Item : in Unbounded_String);

   --  Set the value of the property.  The property is created if it
   --  does not exists.
   procedure Set (Self : in out Manager'Class;
                  Name : in Unbounded_String;
                  Item : in Unbounded_String);

   --  Remove the property given its name.  If the property does not
   --  exist, raises NO_PROPERTY exception.
   procedure Remove (Self : in out Manager'Class;
                     Name : in String);

   --  Remove the property given its name.  If the property does not
   --  exist, raises NO_PROPERTY exception.
   procedure Remove (Self : in out Manager'Class;
                     Name : in Unbounded_String);

   --  Iterate over the properties and execute the given procedure passing the
   --  property name and its value.
   procedure Iterate (Self    : in Manager'Class;
                      Process : access procedure (Name : in String;
                                                  Item : in Value));

   --  Collect the name of the properties defined in the manager.
   --  When a prefix is specified, only the properties starting with the prefix are
   --  returned.
   procedure Get_Names (Self   : in Manager;
                        Into   : in out Util.Strings.Vectors.Vector;
                        Prefix : in String := "");

   --  Load the properties from the file input stream.  The file must follow
   --  the definition of Java property files.  When a prefix is specified, keep
   --  only the properties that starts with the prefix.  When Strip is True,
   --  the prefix part is removed from the property name.
   procedure Load_Properties (Self   : in out Manager'Class;
                              File   : in Ada.Text_IO.File_Type;
                              Prefix : in String := "";
                              Strip  : in Boolean := False);

   --  Load the properties from the file.  The file must follow the
   --  definition of Java property files.  When a prefix is specified, keep
   --  only the properties that starts with the prefix.  When Strip is True,
   --  the prefix part is removed from the property name.
   --  Raises NAME_ERROR if the file does not exist.
   procedure Load_Properties (Self   : in out Manager'Class;
                              Path   : in String;
                              Prefix : in String := "";
                              Strip  : in Boolean := False);

   --  Save the properties in the given file path.
   procedure Save_Properties (Self   : in out Manager'Class;
                              Path   : in String;
                              Prefix : in String := "");

   --  Copy the properties from FROM which start with a given prefix.
   --  If the prefix is empty, all properties are copied.  When Strip is True,
   --  the prefix part is removed from the property name.
   procedure Copy (Self   : in out Manager'Class;
                   From   : in Manager'Class;
                   Prefix : in String := "";
                   Strip  : in Boolean := False);

   --  Get the property manager represented by the item value.
   --  Raise the Conversion_Error exception if the value is not a property manager.
   function To_Manager (Item : in Value) return Manager;

   --  Returns True if the item value represents a property manager.
   function Is_Manager (Item : in Value) return Boolean;

private

   --  Abstract interface for the implementation of Properties
   --  (this allows to decouples the implementation from the API)
   package Interface_P is

      type Manager is abstract limited new Util.Beans.Basic.Bean with record
         Count  : Util.Concurrent.Counters.Counter;
         Shared : Boolean := False;
      end record;
      type Manager_Access is access all Manager'Class;

      --  Returns TRUE if the property exists.
      function Exists (Self : in Manager;
                       Name : in String)
                       return Boolean is abstract;

      --  Remove the property given its name.
      procedure Remove (Self : in out Manager;
                        Name : in String) is abstract;

      --  Iterate over the properties and execute the given procedure passing the
      --  property name and its value.
      procedure Iterate (Self    : in Manager;
                         Process : access procedure (Name : in String;
                                                     Item : in Value))
      is abstract;

      --  Deep copy of properties stored in 'From' to 'To'.
      function Create_Copy (Self : in Manager)
                            return Manager_Access is abstract;

   end Interface_P;

   --  Create a property implementation if there is none yet.
   procedure Check_And_Create_Impl (Self : in out Manager);

   type Manager is new Ada.Finalization.Controlled and Util.Beans.Basic.Bean with record
      Impl : Interface_P.Manager_Access := null;
   end record;

   overriding
   procedure Adjust   (Object : in out Manager);

   overriding
   procedure Finalize (Object : in out Manager);

end Util.Properties;

-----------------------------------------------------------------------
--  properties -- Generic name/value property management
--  Copyright (C) 2001, 2002, 2003, 2006, 2008, 2009, 2010, 2014, 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.Strings.Unbounded;
with Ada.Finalization;
with Ada.Text_IO;
with Util.Beans.Objects;
with Util.Beans.Basic;
with Util.Strings.Vectors;
private with Util.Concurrent.Counters;

--  = Property Files =
--  The `Util.Properties` package and children implements support to read, write and use
--  property files either in the Java property file format or the Windows INI configuration file.
--  Each property is assigned a key and a value.  The list of properties are stored in the
--  `Util.Properties.Manager` tagged record and they are indexed by the key name.  A property
--  is therefore unique in the list.  Properties can be grouped together in sub-properties so
--  that a key can represent another list of properties.
--
--  == File formats ==
--  The property file consists of a simple name and value pair separated by the `=` sign.
--  Thanks to the Windows INI file format, list of properties can be grouped together
--  in sections by using the `[section-name`] notation.
--
--    test.count=20
--    test.repeat=5
--    [FileTest]
--    test.count=5
--    test.repeat=2
--
--  == Using property files ==
--  An instance of the `Util.Properties.Manager` tagged record must be declared and it provides
--  various operations that can be used.  When created, the property manager is empty.  One way
--  to fill it is by using the `Load_Properties` procedure to read the property file.  Another
--  way is by using the `Set` procedure to insert or change a property by giving its name
--  and its value.
--
--  In this example, the property file `test.properties` is loaded and assuming that it contains
--  the above configuration example, the `Get ("test.count")` will return the string `"20"`.
--
--    with Util.Properties;
--    ...
--       Props : Util.Properties.Manager;
--       ...
--          Props.Load_Properties (Path => "test.properties");
--          Ada.Text_IO.Put_Line ("Count: " & Props.Get ("test.count");
--          Props.Set ("test.repeat", "23");
--          Props.Save_Properties (Path => "test.properties");
--
--  To be able to access a section from the property manager, it is necessary to retrieve it
--  by using the `Get` function and giving the section name.  For example, to retrieve the
--  `test.count` property of the `FileTest` section, the following code is used:
--
--       FileTest : Util.Properties.Manager := Props.Get ("FileTest");
--       ...
--          Ada.Text_IO.Put_Line ("[FileTest] Count: " & FileTest.Get ("test.count");
--
--  @include util-properties-json.ads
--  @include util-properties-bundles.ads
package Util.Properties is

   NO_PROPERTY : exception;

   use Ada.Strings.Unbounded;

   subtype Value is Util.Beans.Objects.Object;

   function "+" (S : String) return Unbounded_String renames To_Unbounded_String;

   function "-" (S : Unbounded_String) return String renames To_String;

   function To_String (V : in Value) return String
     renames Util.Beans.Objects.To_String;

   --  The manager holding the name/value pairs and providing the operations
   --  to get and set the properties.
   type Manager is new Ada.Finalization.Controlled and Util.Beans.Basic.Bean with private;
   type Manager_Access is access all Manager'Class;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : in Manager;
                       Name : in String) return Util.Beans.Objects.Object;

   --  Set the value identified by the name.
   --  If the map contains the given name, the value changed.
   --  Otherwise name is added to the map and the value associated with it.
   overriding
   procedure Set_Value (From  : in out Manager;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object);

   --  Returns TRUE if the property exists.
   function Exists (Self : in Manager'Class;
                    Name : in Unbounded_String) return Boolean;

   --  Returns TRUE if the property exists.
   function Exists (Self : in Manager'Class;
                    Name : in String) return Boolean;

   --  Returns the property value.  Raises an exception if not found.
   function Get (Self : in Manager'Class;
                 Name : in String) return String;

   --  Returns the property value.  Raises an exception if not found.
   function Get (Self : in Manager'Class;
                 Name : in String) return Unbounded_String;

   --  Returns the property value.  Raises an exception if not found.
   function Get (Self : in Manager'Class;
                 Name : in Unbounded_String) return Unbounded_String;

   --  Returns the property value.  Raises an exception if not found.
   function Get (Self : in Manager'Class;
                 Name : in Unbounded_String) return String;

   --  Returns the property value or Default if it does not exist.
   function Get (Self : in Manager'Class;
                 Name : in String;
                 Default : in String) return String;

   --  Returns a property manager that is associated with the given name.
   --  Raises NO_PROPERTY if there is no such property manager or if a property exists
   --  but is not a property manager.
   function Get (Self : in Manager'Class;
                 Name : in String) return Manager;

   --  Create a property manager and associated it with the given name.
   function Create (Self : in out Manager'Class;
                    Name : in String) return Manager;

   --  Set the value of the property.  The property is created if it
   --  does not exists.
   procedure Set (Self : in out Manager'Class;
                  Name : in String;
                  Item : in String);

   --  Set the value of the property.  The property is created if it
   --  does not exists.
   procedure Set (Self : in out Manager'Class;
                  Name : in String;
                  Item : in Unbounded_String);

   --  Set the value of the property.  The property is created if it
   --  does not exists.
   procedure Set (Self : in out Manager'Class;
                  Name : in Unbounded_String;
                  Item : in Unbounded_String);

   --  Remove the property given its name.  If the property does not
   --  exist, raises NO_PROPERTY exception.
   procedure Remove (Self : in out Manager'Class;
                     Name : in String);

   --  Remove the property given its name.  If the property does not
   --  exist, raises NO_PROPERTY exception.
   procedure Remove (Self : in out Manager'Class;
                     Name : in Unbounded_String);

   --  Iterate over the properties and execute the given procedure passing the
   --  property name and its value.
   procedure Iterate (Self    : in Manager'Class;
                      Process : access procedure (Name : in String;
                                                  Item : in Value));

   --  Collect the name of the properties defined in the manager.
   --  When a prefix is specified, only the properties starting with the prefix are
   --  returned.
   procedure Get_Names (Self   : in Manager;
                        Into   : in out Util.Strings.Vectors.Vector;
                        Prefix : in String := "");

   --  Load the properties from the file input stream.  The file must follow
   --  the definition of Java property files.  When a prefix is specified, keep
   --  only the properties that starts with the prefix.  When Strip is True,
   --  the prefix part is removed from the property name.
   procedure Load_Properties (Self   : in out Manager'Class;
                              File   : in Ada.Text_IO.File_Type;
                              Prefix : in String := "";
                              Strip  : in Boolean := False);

   --  Load the properties from the file.  The file must follow the
   --  definition of Java property files.  When a prefix is specified, keep
   --  only the properties that starts with the prefix.  When Strip is True,
   --  the prefix part is removed from the property name.
   --  Raises NAME_ERROR if the file does not exist.
   procedure Load_Properties (Self   : in out Manager'Class;
                              Path   : in String;
                              Prefix : in String := "";
                              Strip  : in Boolean := False);

   --  Save the properties in the given file path.
   procedure Save_Properties (Self   : in out Manager'Class;
                              Path   : in String;
                              Prefix : in String := "");

   --  Copy the properties from FROM which start with a given prefix.
   --  If the prefix is empty, all properties are copied.  When Strip is True,
   --  the prefix part is removed from the property name.
   procedure Copy (Self   : in out Manager'Class;
                   From   : in Manager'Class;
                   Prefix : in String := "";
                   Strip  : in Boolean := False);

   --  Get the property manager represented by the item value.
   --  Raise the Conversion_Error exception if the value is not a property manager.
   function To_Manager (Item : in Value) return Manager;

   --  Returns True if the item value represents a property manager.
   function Is_Manager (Item : in Value) return Boolean;

private

   --  Abstract interface for the implementation of Properties
   --  (this allows to decouples the implementation from the API)
   package Interface_P is

      type Manager is abstract limited new Util.Beans.Basic.Bean with record
         Count  : Util.Concurrent.Counters.Counter;
         Shared : Boolean := False;
      end record;
      type Manager_Access is access all Manager'Class;

      --  Returns TRUE if the property exists.
      function Exists (Self : in Manager;
                       Name : in String)
                       return Boolean is abstract;

      --  Remove the property given its name.
      procedure Remove (Self : in out Manager;
                        Name : in String) is abstract;

      --  Iterate over the properties and execute the given procedure passing the
      --  property name and its value.
      procedure Iterate (Self    : in Manager;
                         Process : access procedure (Name : in String;
                                                     Item : in Value))
      is abstract;

      --  Deep copy of properties stored in 'From' to 'To'.
      function Create_Copy (Self : in Manager)
                            return Manager_Access is abstract;

   end Interface_P;

   --  Create a property implementation if there is none yet.
   procedure Check_And_Create_Impl (Self : in out Manager);

   type Manager is new Ada.Finalization.Controlled and Util.Beans.Basic.Bean with record
      Impl : Interface_P.Manager_Access := null;
   end record;

   overriding
   procedure Adjust   (Object : in out Manager);

   overriding
   procedure Finalize (Object : in out Manager);

end Util.Properties;

Document the properties framework

Document the properties framework


-----------------------------------------------------------------------
--  babel-base-users-tests - Unit tests for babel users
--  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 Util.Test_Caller;

package body Babel.Base.Users.Tests is

   use type Babel.Uid_Type;
   use type Babel.Gid_Type;
   use type Util.Strings.Name_Access;

   package Caller is new Util.Test_Caller (Test, "Base.Users");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Babel.Base.Users.Find",
                       Test_Find'Access);
      Caller.Add_Test (Suite, "Test Babel.Base.Users.Get_Name",
                       Test_Get_Name'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test the Find function resolving some existing user.
   --  ------------------------------
   procedure Test_Find (T : in out Test) is
      Db   : Babel.Base.Users.Database;
      User : User_Type;
   begin
      User := Db.Find (0, 0);
      T.Assert (User.Name /= null, "User uid=0 was not found");
      T.Assert (User.Group /= null, "User gid=0 was not found");
      Util.Tests.Assert_Equals (T, "root", User.Name.all, "Invalid root user name");
      Util.Tests.Assert_Equals (T, "root", User.Group.all, "Invalid root group name");

      User := Db.Find ("bin", "daemon");
      T.Assert (User.Name /= null, "User bin was not found");
      T.Assert (User.Group /= null, "Group daemon was not found");
      Util.Tests.Assert_Equals (T, "bin", User.Name.all, "Invalid 'bin' user name");
      Util.Tests.Assert_Equals (T, "daemon", User.Group.all, "Invalid 'daemon' group name");
      T.Assert (User.Uid > 0, "Invalid 'bin' uid");
      T.Assert (User.Gid > 0, "Invalid 'daemon' gid");
   end Test_Find;

   --  ------------------------------
   --  Test the Get_Name operation.
   --  ------------------------------
   procedure Test_Get_Name (T : in out Test) is
      Name : Name_Access;
      Db   : Database;
   begin
      Name := Db.Get_Name (0);
      T.Assert (Name /= null, "Get_Name (0) returned null");
      Util.Tests.Assert_Equals (T, "root", Name.all, "Invalid name returned for Get_Name (0)");

      Name := Db.Get_Name (1);
      T.Assert (Name /= null, "Get_Name (1) returned null");

      Name := Db.Get_Name (55555);
      T.Assert (Name = null, "Get_Name (55555) returned a non null name");
   end Test_Get_Name;

end Babel.Base.Users.Tests;

-----------------------------------------------------------------------
--  babel-base-users-tests - Unit tests for babel users
--  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 Util.Test_Caller;

package body Babel.Base.Users.Tests is

   use type Babel.Uid_Type;
   use type Babel.Gid_Type;
   use type Util.Strings.Name_Access;

   package Caller is new Util.Test_Caller (Test, "Base.Users");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Babel.Base.Users.Find",
                       Test_Find'Access);
      Caller.Add_Test (Suite, "Test Babel.Base.Users.Get_Name",
                       Test_Get_Name'Access);
      Caller.Add_Test (Suite, "Test Babel.Base.Users.Get_Uid",
                       Test_Get_Uid'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test the Find function resolving some existing user.
   --  ------------------------------
   procedure Test_Find (T : in out Test) is
      Db   : Babel.Base.Users.Database;
      User : User_Type;
   begin
      User := Db.Find (0, 0);
      T.Assert (User.Name /= null, "User uid=0 was not found");
      T.Assert (User.Group /= null, "User gid=0 was not found");
      Util.Tests.Assert_Equals (T, "root", User.Name.all, "Invalid root user name");
      Util.Tests.Assert_Equals (T, "root", User.Group.all, "Invalid root group name");

      User := Db.Find ("bin", "daemon");
      T.Assert (User.Name /= null, "User bin was not found");
      T.Assert (User.Group /= null, "Group daemon was not found");
      Util.Tests.Assert_Equals (T, "bin", User.Name.all, "Invalid 'bin' user name");
      Util.Tests.Assert_Equals (T, "daemon", User.Group.all, "Invalid 'daemon' group name");
      T.Assert (User.Uid > 0, "Invalid 'bin' uid");
      T.Assert (User.Gid > 0, "Invalid 'daemon' gid");
   end Test_Find;

   --  ------------------------------
   --  Test the Get_Name operation.
   --  ------------------------------
   procedure Test_Get_Name (T : in out Test) is
      Name : Name_Access;
      Db   : Database;
   begin
      Name := Db.Get_Name (0);
      T.Assert (Name /= null, "Get_Name (0) returned null");
      Util.Tests.Assert_Equals (T, "root", Name.all, "Invalid name returned for Get_Name (0)");

      Name := Db.Get_Name (1);
      T.Assert (Name /= null, "Get_Name (1) returned null");

      Name := Db.Get_Name (55555);
      T.Assert (Name = null, "Get_Name (55555) returned a non null name");
   end Test_Get_Name;

   --  ------------------------------
   --  Test the Get_Uid operation.
   --  ------------------------------
   procedure Test_Get_Uid (T : in out Test) is
      Db  : Database;
      Uid : Uid_Type;
   begin
      Uid := Db.Get_Uid ("root");
      Util.Tests.Assert_Equals (T, 0, Natural (Uid), "Get_Uid (root) returned invalid uid");

      Uid := Db.Get_Uid ("admin");
      T.Assert (Uid /= 0, "Get_Uid (admin) returned invalid uid");

      Uid := Db.Get_Uid ("Katniss");
      T.Assert (Uid /= 0, "Get_Uid (Katniss) returned invalid uid");
   end Test_Get_Uid;

end Babel.Base.Users.Tests;

Implement the Test_Get_Uid procedure and add a new test case to check the Get_Uid operation


-----------------------------------------------------------------------
--  applications-main-configs -- Configuration support for ASF Applications
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 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 EL.Functions.Namespaces;

with ASF.Navigations;
with ASF.Navigations.Mappers;
with ASF.Servlets.Mappers;
with ASF.Servlets.Faces.Mappers;
with ASF.Beans.Mappers;
with ASF.Views.Nodes.Core;

package body ASF.Applications.Main.Configs is

   use Util.Log;

   --  The logger
   Log : constant Loggers.Logger := Loggers.Create ("ASF.Applications.Main.Configs");

   function Get_Locale (Value : in Util.Beans.Objects.Object) return Util.Locales.Locale;

   function Get_Locale (Value : in Util.Beans.Objects.Object) return Util.Locales.Locale is
      Name   : constant String := Util.Beans.Objects.To_String (Value);
      Locale : constant Util.Locales.Locale := Util.Locales.Get_Locale (Name);
   begin
      return Locale;
   end Get_Locale;

   --  ------------------------------
   --  Save in the application config object the value associated with the given field.
   --  When the TAG_MESSAGE_BUNDLE field is reached, insert the new bundle definition
   --  in the application.
   --  ------------------------------
   procedure Set_Member (N     : in out Application_Config;
                         Field : in Application_Fields;
                         Value : in Util.Beans.Objects.Object) is
   begin
      case Field is
         when TAG_MESSAGE_VAR =>
            N.Name := Value;

         when TAG_MESSAGE_BUNDLE =>
            declare
               Bundle : constant String := Util.Beans.Objects.To_String (Value);
            begin
               if Util.Beans.Objects.Is_Null (N.Name) then
                  N.App.Register (Name   => Bundle & "Msg",
                                  Bundle => Bundle);
               else
                  N.App.Register (Name   => Util.Beans.Objects.To_String (N.Name),
                                  Bundle => Bundle);
               end if;
               N.Name := Util.Beans.Objects.Null_Object;
            end;

         when TAG_DEFAULT_LOCALE =>
            N.App.Set_Default_Locale (Get_Locale (Value));

         when TAG_SUPPORTED_LOCALE =>
            N.App.Add_Supported_Locale (Get_Locale (Value));

      end case;
   end Set_Member;

   AMapper : aliased Application_Mapper.Mapper;

   --  ------------------------------
   --  Setup the XML parser to read the managed bean definitions.
   --  By instantiating this package, the Reader gets populated with the XML mappings
   --  to read the servlet, managed beans and navigation rules.
   --  ------------------------------
   package body Reader_Config is
      procedure Set_Property_Context (Params : in Util.Properties.Manager'Class);

      --  Get the navigation handler for the Navigation_Config instantiation
      --  GNAT crashes if the call is made in the instantiation part.
      Nav     : constant ASF.Navigations.Navigation_Handler_Access := App.Get_Navigation_Handler;

      package Bean_Config is
        new ASF.Beans.Mappers.Reader_Config (Reader, App.Factory'Access,
                                             Context.all'Access);
      package Navigation_Config is
        new ASF.Navigations.Mappers.Reader_Config (Reader, Nav, Context.all'Access);

      package Servlet_Config is
        new ASF.Servlets.Mappers.Reader_Config (Reader, App.all'Access,
                                                Context.all'Access);
      package Faces_Config is
        new ASF.Servlets.Faces.Mappers.Reader_Config (Reader, App.all'Access,
                                                      Context.all'Access);
      pragma Warnings (Off, Bean_Config);
      pragma Warnings (Off, Navigation_Config);
      pragma Warnings (Off, Faces_Config);

      Config    : aliased Application_Config;
      NS_Mapper : aliased EL.Functions.Namespaces.NS_Function_Mapper;

      procedure Set_Property_Context (Params : in Util.Properties.Manager'Class) is
      begin
         Prop_Context.Set_Properties (Params);
      end Set_Property_Context;

   begin
      --  Install the property context that gives access
      --  to the application configuration properties
      App.Get_Init_Parameters (Set_Property_Context'Access);
      Context.Set_Resolver (Prop_Context'Unchecked_Access);

      --  Setup the function mapper to resolve uses of functions within EL expressions.
      NS_Mapper.Set_Namespace (Prefix => "fn",
                               URI    => ASF.Views.Nodes.Core.FN_URI);
      NS_Mapper.Set_Function_Mapper (App.Functions'Unchecked_Access);
      Context.Set_Function_Mapper (NS_Mapper'Unchecked_Access);

      Reader.Add_Mapping ("faces-config", AMapper'Access);
      Reader.Add_Mapping ("module", AMapper'Access);
      Reader.Add_Mapping ("web-app", AMapper'Access);
      Config.App := App;
      Servlet_Config.Config.Override_Context := Override_Context;
      Application_Mapper.Set_Context (Reader, Config'Unchecked_Access);
   end Reader_Config;

   --  ------------------------------
   --  Read the configuration file associated with the application.  This includes:
   --

   --
The servlet and filter mappings

   --
The managed bean definitions

   --
The navigation rules

   --

   --  ------------------------------
   procedure Read_Configuration (App  : in out Application'Class;
                                 File : in String) is

      Reader  : Util.Serialize.IO.XML.Parser;
      Context : aliased EL.Contexts.Default.Default_Context;

      --  Setup the Reader to parse and build the configuration for managed beans,
      --  navigation rules, servlet rules.  Each package instantiation creates a local variable
      --  used while parsing the XML file.
      package Config is
        new Reader_Config (Reader, App'Unchecked_Access, Context'Unchecked_Access);

      pragma Warnings (Off, Config);
   begin
      Log.Info ("Reading module configuration file {0}", File);

      --        Util.Serialize.IO.Dump (Reader, AWA.Modules.Log);

      --  Read the configuration file and record managed beans, navigation rules.
      Reader.Parse (File);
   end Read_Configuration;

   --  ------------------------------
   --  Create the configuration parameter definition instance.
   --  ------------------------------
   package body Parameter is
      PARAM_NAME  : aliased constant String := Name;
      PARAM_VALUE : aliased constant String := Default;
      Param       : constant Config_Param := ASF.Applications.P '(Name => PARAM_NAME'Access,
                                                                  Default => PARAM_VALUE'Access);

      --  ------------------------------
      --  Returns the configuration parameter.
      --  ------------------------------
      function P return Config_Param is
      begin
         return Param;
      end P;

   end Parameter;

begin
   AMapper.Add_Mapping ("application/message-bundle/@var", TAG_MESSAGE_VAR);
   AMapper.Add_Mapping ("application/message-bundle", TAG_MESSAGE_BUNDLE);
   AMapper.Add_Mapping ("application/locale-config/default-locale", TAG_DEFAULT_LOCALE);
   AMapper.Add_Mapping ("application/locale-config/supported-locale", TAG_SUPPORTED_LOCALE);
end ASF.Applications.Main.Configs;

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

with Util.Log.Loggers;
with EL.Functions.Namespaces;

with ASF.Navigations;
with ASF.Navigations.Mappers;
with ASF.Servlets.Mappers;
with ASF.Servlets.Faces.Mappers;
with ASF.Beans.Mappers;
with ASF.Views.Nodes.Core;

package body ASF.Applications.Main.Configs is

   use Util.Log;

   --  The logger
   Log : constant Loggers.Logger := Loggers.Create ("ASF.Applications.Main.Configs");

   function Get_Locale (Value : in Util.Beans.Objects.Object) return Util.Locales.Locale;

   function Get_Locale (Value : in Util.Beans.Objects.Object) return Util.Locales.Locale is
      Name   : constant String := Util.Beans.Objects.To_String (Value);
      Locale : constant Util.Locales.Locale := Util.Locales.Get_Locale (Name);
   begin
      return Locale;
   end Get_Locale;

   --  ------------------------------
   --  Save in the application config object the value associated with the given field.
   --  When the TAG_MESSAGE_BUNDLE field is reached, insert the new bundle definition
   --  in the application.
   --  ------------------------------
   procedure Set_Member (N     : in out Application_Config;
                         Field : in Application_Fields;
                         Value : in Util.Beans.Objects.Object) is
   begin
      case Field is
         when TAG_MESSAGE_VAR =>
            N.Name := Value;

         when TAG_MESSAGE_BUNDLE =>
            declare
               Bundle : constant String := Util.Beans.Objects.To_String (Value);
            begin
               if Util.Beans.Objects.Is_Null (N.Name) then
                  N.App.Register (Name   => Bundle & "Msg",
                                  Bundle => Bundle);
               else
                  N.App.Register (Name   => Util.Beans.Objects.To_String (N.Name),
                                  Bundle => Bundle);
               end if;
               N.Name := Util.Beans.Objects.Null_Object;
            end;

         when TAG_DEFAULT_LOCALE =>
            N.App.Set_Default_Locale (Get_Locale (Value));

         when TAG_SUPPORTED_LOCALE =>
            N.App.Add_Supported_Locale (Get_Locale (Value));

      end case;
   end Set_Member;

   AMapper : aliased Application_Mapper.Mapper;

   --  ------------------------------
   --  Setup the XML parser to read the managed bean definitions.
   --  By instantiating this package, the Reader gets populated with the XML mappings
   --  to read the servlet, managed beans and navigation rules.
   --  ------------------------------
   package body Reader_Config is
      procedure Set_Property_Context (Params : in Util.Properties.Manager'Class);

      --  Get the navigation handler for the Navigation_Config instantiation
      --  GNAT crashes if the call is made in the instantiation part.
      Nav     : constant ASF.Navigations.Navigation_Handler_Access := App.Get_Navigation_Handler;

      package Bean_Config is
        new ASF.Beans.Mappers.Reader_Config (Mapper, App.Factory'Access,
                                             Context.all'Access);
      package Navigation_Config is
        new ASF.Navigations.Mappers.Reader_Config (Mapper, Nav, Context.all'Access);

      package Servlet_Config is
        new ASF.Servlets.Mappers.Reader_Config (Mapper, App.all'Access,
                                                Context.all'Access);
      package Faces_Config is
        new ASF.Servlets.Faces.Mappers.Reader_Config (Mapper, App.all'Access,
                                                      Context.all'Access);
      pragma Warnings (Off, Bean_Config);
      pragma Warnings (Off, Navigation_Config);
      pragma Warnings (Off, Faces_Config);

      Config    : aliased Application_Config;
      NS_Mapper : aliased EL.Functions.Namespaces.NS_Function_Mapper;

      procedure Set_Property_Context (Params : in Util.Properties.Manager'Class) is
      begin
         Prop_Context.Set_Properties (Params);
      end Set_Property_Context;

   begin
      --  Install the property context that gives access
      --  to the application configuration properties
      App.Get_Init_Parameters (Set_Property_Context'Access);
      Context.Set_Resolver (Prop_Context'Unchecked_Access);

      --  Setup the function mapper to resolve uses of functions within EL expressions.
      NS_Mapper.Set_Namespace (Prefix => "fn",
                               URI    => ASF.Views.Nodes.Core.FN_URI);
      NS_Mapper.Set_Function_Mapper (App.Functions'Unchecked_Access);
      Context.Set_Function_Mapper (NS_Mapper'Unchecked_Access);

      Mapper.Add_Mapping ("faces-config", AMapper'Access);
      Mapper.Add_Mapping ("module", AMapper'Access);
      Mapper.Add_Mapping ("web-app", AMapper'Access);
      Config.App := App;
      Servlet_Config.Config.Override_Context := Override_Context;
      Application_Mapper.Set_Context (Mapper, Config'Unchecked_Access);
   end Reader_Config;

   --  ------------------------------
   --  Read the configuration file associated with the application.  This includes:
   --

   --
The servlet and filter mappings

   --
The managed bean definitions

   --
The navigation rules

   --

   --  ------------------------------
   procedure Read_Configuration (App  : in out Application'Class;
                                 File : in String) is

      Reader  : Util.Serialize.IO.XML.Parser;
      Mapper  : Util.Serialize.Mappers.Processing;
      Context : aliased EL.Contexts.Default.Default_Context;

      --  Setup the Reader to parse and build the configuration for managed beans,
      --  navigation rules, servlet rules.  Each package instantiation creates a local variable
      --  used while parsing the XML file.
      package Config is
        new Reader_Config (Mapper, App'Unchecked_Access, Context'Unchecked_Access);

      pragma Warnings (Off, Config);
   begin
      Log.Info ("Reading module configuration file {0}", File);

      --        Util.Serialize.IO.Dump (Reader, AWA.Modules.Log);

      --  Read the configuration file and record managed beans, navigation rules.
      Reader.Parse (File, Mapper);
   end Read_Configuration;

   --  ------------------------------
   --  Create the configuration parameter definition instance.
   --  ------------------------------
   package body Parameter is
      PARAM_NAME  : aliased constant String := Name;
      PARAM_VALUE : aliased constant String := Default;
      Param       : constant Config_Param := ASF.Applications.P '(Name => PARAM_NAME'Access,
                                                                  Default => PARAM_VALUE'Access);

      --  ------------------------------
      --  Returns the configuration parameter.
      --  ------------------------------
      function P return Config_Param is
      begin
         return Param;
      end P;

   end Parameter;

begin
   AMapper.Add_Mapping ("application/message-bundle/@var", TAG_MESSAGE_VAR);
   AMapper.Add_Mapping ("application/message-bundle", TAG_MESSAGE_BUNDLE);
   AMapper.Add_Mapping ("application/locale-config/default-locale", TAG_DEFAULT_LOCALE);
   AMapper.Add_Mapping ("application/locale-config/supported-locale", TAG_SUPPORTED_LOCALE);
end ASF.Applications.Main.Configs;

Update the Reader_Config to use the new parser/mapper interface


-----------------------------------------------------------------------
--  asf-components-widgets-inputs -- Input widget components
--  Copyright (C) 2013 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.Beans.Objects;
with Util.Beans.Basic;

with ASF.Components.Html.Forms;
with ASF.Contexts.Faces;
with ASF.Contexts.Writer;
with ASF.Events.Faces;

package ASF.Components.Widgets.Inputs is

   use ASF.Contexts.Faces;
   use ASF.Contexts.Writer;

   --  ------------------------------
   --  Input component
   --  ------------------------------
   --  The AWA input component overrides the ASF input component to build a compact component
   --  that displays a label, the input field and the associated error message if necessary.
   --
   --  The generated HTML looks like:
   --
   --

   --
title required

   --
<input type='text' ...>
   --        message
   --

   --

   type UIInput is new ASF.Components.Html.Forms.UIInput with null record;
   type UIInput_Access is access all UIInput'Class;

   --  Render the input field title.
   procedure Render_Title (UI      : in UIInput;
                           Name    : in String;
                           Writer  : in Response_Writer_Access;
                           Context : in out Faces_Context'Class);

   --  Render the input component.  Starts the DL/DD list and write the input
   --  component with the possible associated error message.
   overriding
   procedure Encode_Begin (UI      : in UIInput;
                           Context : in out Faces_Context'Class);

   --  Render the end of the input component.  Closes the DL/DD list.
   overriding
   procedure Encode_End (UI      : in UIInput;
                         Context : in out Faces_Context'Class);

   --  ------------------------------
   --  The auto complete component.
   --  ------------------------------
   --
   type UIComplete is new UIInput with private;
   type UIComplete_Access is access all UIInput'Class;

   --  Render the end of the input component.  Closes the DL/DD list.
   overriding
   procedure Encode_End (UI      : in UIComplete;
                         Context : in out Faces_Context'Class);
   overriding
   procedure Process_Decodes (UI      : in out UIComplete;
                              Context : in out Faces_Context'Class);

   overriding
   procedure Process_Updates (UI      : in out UIComplete;
                              Context : in out Faces_Context'Class);

   --  Broadcast the event to the event listeners installed on this component.
   --  Listeners are called in the order in which they were added.
   overriding
   procedure Broadcast (UI      : in out UIComplete;
                        Event   : not null access ASF.Events.Faces.Faces_Event'Class;
                        Context : in out Faces_Context'Class);

   procedure Render_List (UI      : in UIComplete;
                          Match   : in String;
                          Context : in out Faces_Context'Class);

private

   type UIComplete is new UIInput with record
      Match_Value : Util.Beans.Objects.Object;
   end record;

end ASF.Components.Widgets.Inputs;

-----------------------------------------------------------------------
--  asf-components-widgets-inputs -- Input widget components
--  Copyright (C) 2013 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.Beans.Objects;

with ASF.Components.Html.Forms;
with ASF.Contexts.Faces;
with ASF.Contexts.Writer;
with ASF.Events.Faces;

package ASF.Components.Widgets.Inputs is

   use ASF.Contexts.Faces;
   use ASF.Contexts.Writer;

   --  ------------------------------
   --  Input component
   --  ------------------------------
   --  The AWA input component overrides the ASF input component to build a compact component
   --  that displays a label, the input field and the associated error message if necessary.
   --
   --  The generated HTML looks like:
   --
   --

   --
title required

   --
<input type='text' ...>
   --        message
   --

   --

   type UIInput is new ASF.Components.Html.Forms.UIInput with null record;
   type UIInput_Access is access all UIInput'Class;

   --  Render the input field title.
   procedure Render_Title (UI      : in UIInput;
                           Name    : in String;
                           Writer  : in Response_Writer_Access;
                           Context : in out Faces_Context'Class);

   --  Render the input component.  Starts the DL/DD list and write the input
   --  component with the possible associated error message.
   overriding
   procedure Encode_Begin (UI      : in UIInput;
                           Context : in out Faces_Context'Class);

   --  Render the end of the input component.  Closes the DL/DD list.
   overriding
   procedure Encode_End (UI      : in UIInput;
                         Context : in out Faces_Context'Class);

   --  ------------------------------
   --  The auto complete component.
   --  ------------------------------
   --
   type UIComplete is new UIInput with private;
   type UIComplete_Access is access all UIInput'Class;

   --  Render the end of the input component.  Closes the DL/DD list.
   overriding
   procedure Encode_End (UI      : in UIComplete;
                         Context : in out Faces_Context'Class);
   overriding
   procedure Process_Decodes (UI      : in out UIComplete;
                              Context : in out Faces_Context'Class);

   overriding
   procedure Process_Updates (UI      : in out UIComplete;
                              Context : in out Faces_Context'Class);

   --  Broadcast the event to the event listeners installed on this component.
   --  Listeners are called in the order in which they were added.
   overriding
   procedure Broadcast (UI      : in out UIComplete;
                        Event   : not null access ASF.Events.Faces.Faces_Event'Class;
                        Context : in out Faces_Context'Class);

   procedure Render_List (UI      : in UIComplete;
                          Match   : in String;
                          Context : in out Faces_Context'Class);

   --  ------------------------------
   --  The input date component.
   --  ------------------------------
   --
   type UIInputDate is new UIInput with null record;
   type UIInputDate_Access is access all UIInputDate'Class;

   --  Render the end of the input component.  Closes the DL/DD list.
   overriding
   procedure Encode_End (UI      : in UIInputDate;
                         Context : in out Faces_Context'Class);

private

   type UIComplete is new UIInput with record
      Match_Value : Util.Beans.Objects.Object;
   end record;

end ASF.Components.Widgets.Inputs;

Declare the inputDate component

Declare the inputDate component