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

with Ada.Strings.Unbounded;

--  == Role Based Security Policy ==
--  The <tt>Security.Policies.Roles</tt> package implements a role based security policy.
--  In this policy, users are assigned one or several roles and permissions are
--  associated with roles.  A permission is granted if the user has one of the roles required
--  by the permission.
--
--  === Policy creation ===
--  An instance of the <tt>Role_Policy</tt> must be created and registered in the policy manager.
--  Get or declare the following variables:
--
--    Manager : Security.Policies.Policy_Manager;
--    Policy  : Security.Policies.Roles.Role_Policy_Access;
--
--  Create the role policy and register it in the policy manager as follows:
--
--    Policy := new Role_Policy;
--    Manager.Add_Policy (Policy.all'Access);
--
--  === Policy Configuration ===
--  A role is represented by a name in security configuration files.  A role based permission
--  is associated with a list of roles.  The permission is granted if the user has one of these
--  roles.  When the role based policy is registered in the policy manager, the following
--  XML configuration is used:
--
--    <policy-rules>
--      <security-role>
--        <role-name>admin</role-name>
--      </security-role>
--      <security-role>
--        <role-name>manager</role-name>
--      </security-role>
--      <role-permission>
--        <name>create-workspace</name>
--        <role>admin</role>
--        <role>manager</role>
--      </role-permission>
--      ...
--    </policy-rules>
--
--  This definition declares two roles: <tt>admin</tt> and <tt>manager</tt>
--  It defines a permission create-workspace that will be granted if the
--  user has either the admin or the manager role.
--
--  Each role is identified by a name in the configuration file.  It is represented by
--  a <tt>Role_Type</tt>.  To provide an efficient implementation, the <tt>Role_Type</tt>
--  is represented as an integer with a limit of 64 different roles.
--
--  === Assigning roles to users ===
--  A <tt>Security_Context</tt> must be associated with a set of roles before checking the
--  permission.  This is done by using the <tt>Set_Role_Context</tt> operation:
--
--     Security.Policies.Roles.Set_Role_Context (Security.Contexts.Current, "admin");
--
package Security.Policies.Roles is

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

   --  Each role is represented by a Role_Type number to provide a fast
   --  and efficient role check.
   type Role_Type is new Natural range 0 .. 63;
   for Role_Type'Size use 8;

   type Role_Type_Array is array (Positive range <>) of Role_Type;

   type Role_Name_Array is array (Role_Type range <>) of Ada.Strings.Unbounded.String_Access;

   --  The Role_Map represents a set of roles which are assigned to a user.
   --  Each role is represented by a boolean in the map.  The implementation is limited
   --  to 64 roles (the number of different permissions can be higher).
   type Role_Map is array (Role_Type'Range) of Boolean;
   pragma Pack (Role_Map);

   --  ------------------------------
   --  Role principal context
   --  ------------------------------
   --  The <tt>Role_Principal_Context</tt> interface must be implemented by the user
   --  <tt>Principal</tt> to be able to use the role based policy.   The role based policy
   --  controller will first check that the <tt>Principal</tt> implements that interface.
   --  It uses the <tt>Get_Roles</tt> function to get the current roles assigned to the user.
   type Role_Principal_Context is limited interface;
   function Get_Roles (User : in Role_Principal_Context) return Role_Map is abstract;

   --  ------------------------------
   --  Policy context
   --  ------------------------------
   --  The Role_Policy_Context gives security context information that the role
   --  based policy can use to verify the permission.
   type Role_Policy_Context is new Policy_Context with record
      Roles : Role_Map;
   end record;
   type Role_Policy_Context_Access is access all Role_Policy_Context'Class;

   --  Set the roles which are assigned to the user in the security context.
   --  The role policy will use these roles to verify a permission.
   procedure Set_Role_Context (Context : in out Security.Contexts.Security_Context'Class;
                               Roles   : in Role_Map);

   --  Set the roles which are assigned to the user in the security context.
   --  The role policy will use these roles to verify a permission.
   procedure Set_Role_Context (Context : in out Security.Contexts.Security_Context'Class;
                               Roles   : in String);

   --  ------------------------------
   --  Role based policy
   --  ------------------------------
   type Role_Policy is new Policy with private;
   type Role_Policy_Access is access all Role_Policy'Class;

   Invalid_Name : exception;

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

   --  Find the role type associated with the role name identified by Name.
   --  Raises Invalid_Name if there is no role type.
   function Find_Role (Manager : in Role_Policy;
                       Name    : in String) return Role_Type;

   --  Get the role name.
   function Get_Role_Name (Manager : in Role_Policy;
                           Role    : in Role_Type) return String;

   --  Get the roles that grant the given permission.
   function Get_Grants (Manager    : in Role_Policy;
                        Permission : in Permissions.Permission_Index) return Role_Map;

   --  Create a role
   procedure Create_Role (Manager : in out Role_Policy;
                          Name    : in String;
                          Role    : out Role_Type);

   --  Get or add a role type for the given name.
   procedure Add_Role_Type (Manager   : in out Role_Policy;
                            Name      : in String;
                            Result    : out Role_Type);

   --  Set the roles specified in the <tt>Roles</tt> parameter.  Each role is represented by
   --  its name and multiple roles are separated by ','.
   --  Raises Invalid_Name if a role was not found.
   procedure Set_Roles (Manager : in Role_Policy;
                        Roles   : in String;
                        Into    : out Role_Map);

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

   --  Finalize the policy manager.
   overriding
   procedure Finalize (Policy : in out Role_Policy);

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

private

   --  Array to map a permission index to a list of roles that are granted the permission.
   type Permission_Role_Array is array (Permission_Index) of Role_Map;

   type Role_Policy is new Policy with record
      Names     : Role_Name_Array (Role_Type'Range) := (others => null);
      Next_Role : Role_Type := Role_Type'First;
      Name      : Util.Beans.Objects.Object;
      Roles     : Role_Type_Array (1 .. Integer (Role_Type'Last)) := (others => 0);
      Count     : Natural := 0;

      --  The Grants array indicates for each permission the list of roles
      --  that are granted the permission.  This array allows a O(1) lookup.
      --  The implementation is limited to 256 permissions and 64 roles so this array uses 2K.
      --  The default is that no role is assigned to the permission.
      Grants    : Permission_Role_Array := (others => (others => False));
   end record;

end Security.Policies.Roles;

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

with Ada.Strings.Unbounded;

--  == Role Based Security Policy ==
--  The <tt>Security.Policies.Roles</tt> package implements a role based security policy.
--  In this policy, users are assigned one or several roles and permissions are
--  associated with roles.  A permission is granted if the user has one of the roles required
--  by the permission.
--
--  === Policy creation ===
--  An instance of the <tt>Role_Policy</tt> must be created and registered in the policy manager.
--  Get or declare the following variables:
--
--    Manager : Security.Policies.Policy_Manager;
--    Policy  : Security.Policies.Roles.Role_Policy_Access;
--
--  Create the role policy and register it in the policy manager as follows:
--
--    Policy := new Role_Policy;
--    Manager.Add_Policy (Policy.all'Access);
--
--  === Policy Configuration ===
--  A role is represented by a name in security configuration files.  A role based permission
--  is associated with a list of roles.  The permission is granted if the user has one of these
--  roles.  When the role based policy is registered in the policy manager, the following
--  XML configuration is used:
--
--    <policy-rules>
--      <security-role>
--        <role-name>admin</role-name>
--      </security-role>
--      <security-role>
--        <role-name>manager</role-name>
--      </security-role>
--      <role-permission>
--        <name>create-workspace</name>
--        <role>admin</role>
--        <role>manager</role>
--      </role-permission>
--      ...
--    </policy-rules>
--
--  This definition declares two roles: <tt>admin</tt> and <tt>manager</tt>
--  It defines a permission create-workspace that will be granted if the
--  user has either the admin or the manager role.
--
--  Each role is identified by a name in the configuration file.  It is represented by
--  a <tt>Role_Type</tt>.  To provide an efficient implementation, the <tt>Role_Type</tt>
--  is represented as an integer with a limit of 64 different roles.
--
--  === Assigning roles to users ===
--  A <tt>Security_Context</tt> must be associated with a set of roles before checking the
--  permission.  This is done by using the <tt>Set_Role_Context</tt> operation:
--
--     Security.Policies.Roles.Set_Role_Context (Security.Contexts.Current, "admin");
--
package Security.Policies.Roles is

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

   --  Each role is represented by a Role_Type number to provide a fast
   --  and efficient role check.
   type Role_Type is new Natural range 0 .. 63;
   for Role_Type'Size use 8;

   type Role_Type_Array is array (Positive range <>) of Role_Type;

   type Role_Name_Array is array (Positive range <>) of Ada.Strings.Unbounded.String_Access;

   --  The Role_Map represents a set of roles which are assigned to a user.
   --  Each role is represented by a boolean in the map.  The implementation is limited
   --  to 64 roles (the number of different permissions can be higher).
   type Role_Map is array (Role_Type'Range) of Boolean;
   pragma Pack (Role_Map);

   --  ------------------------------
   --  Role principal context
   --  ------------------------------
   --  The <tt>Role_Principal_Context</tt> interface must be implemented by the user
   --  <tt>Principal</tt> to be able to use the role based policy.   The role based policy
   --  controller will first check that the <tt>Principal</tt> implements that interface.
   --  It uses the <tt>Get_Roles</tt> function to get the current roles assigned to the user.
   type Role_Principal_Context is limited interface;
   function Get_Roles (User : in Role_Principal_Context) return Role_Map is abstract;

   --  ------------------------------
   --  Policy context
   --  ------------------------------
   --  The Role_Policy_Context gives security context information that the role
   --  based policy can use to verify the permission.
   type Role_Policy_Context is new Policy_Context with record
      Roles : Role_Map;
   end record;
   type Role_Policy_Context_Access is access all Role_Policy_Context'Class;

   --  Set the roles which are assigned to the user in the security context.
   --  The role policy will use these roles to verify a permission.
   procedure Set_Role_Context (Context : in out Security.Contexts.Security_Context'Class;
                               Roles   : in Role_Map);

   --  Set the roles which are assigned to the user in the security context.
   --  The role policy will use these roles to verify a permission.
   procedure Set_Role_Context (Context : in out Security.Contexts.Security_Context'Class;
                               Roles   : in String);

   --  ------------------------------
   --  Role based policy
   --  ------------------------------
   type Role_Policy is new Policy with private;
   type Role_Policy_Access is access all Role_Policy'Class;

   Invalid_Name : exception;

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

   --  Find the role type associated with the role name identified by Name.
   --  Raises Invalid_Name if there is no role type.
   function Find_Role (Manager : in Role_Policy;
                       Name    : in String) return Role_Type;

   --  Get the role name.
   function Get_Role_Name (Manager : in Role_Policy;
                           Role    : in Role_Type) return String;

   --  Get the roles that grant the given permission.
   function Get_Grants (Manager    : in Role_Policy;
                        Permission : in Permissions.Permission_Index) return Role_Map;

   --  Get the list of role names that are defined by the role map.
   function Get_Role_Names (Manager : in Role_Policy;
                            Map     : in Role_Map) return Role_Name_Array;

   --  Create a role
   procedure Create_Role (Manager : in out Role_Policy;
                          Name    : in String;
                          Role    : out Role_Type);

   --  Get or add a role type for the given name.
   procedure Add_Role_Type (Manager   : in out Role_Policy;
                            Name      : in String;
                            Result    : out Role_Type);

   --  Set the roles specified in the <tt>Roles</tt> parameter.  Each role is represented by
   --  its name and multiple roles are separated by ','.
   --  Raises Invalid_Name if a role was not found.
   procedure Set_Roles (Manager : in Role_Policy;
                        Roles   : in String;
                        Into    : out Role_Map);

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

   --  Finalize the policy manager.
   overriding
   procedure Finalize (Policy : in out Role_Policy);

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

private

   --  Array to map a permission index to a list of roles that are granted the permission.
   type Permission_Role_Array is array (Permission_Index) of Role_Map;

   type Role_Map_Name_Array is array (Role_Type'Range) of Ada.Strings.Unbounded.String_Access;

   type Role_Policy is new Policy with record
      Names     : Role_Map_Name_Array := (others => null);
      Next_Role : Role_Type := Role_Type'First;
      Name      : Util.Beans.Objects.Object;
      Roles     : Role_Type_Array (1 .. Integer (Role_Type'Last)) := (others => 0);
      Count     : Natural := 0;

      --  The Grants array indicates for each permission the list of roles
      --  that are granted the permission.  This array allows a O(1) lookup.
      --  The implementation is limited to 256 permissions and 64 roles so this array uses 2K.
      --  The default is that no role is assigned to the permission.
      Grants    : Permission_Role_Array := (others => (others => False));
   end record;

end Security.Policies.Roles;

Declare the Get_Role_Names function

Declare the Get_Role_Names function


-----------------------------------------------------------------------
--  awa-commands-drivers -- Driver for AWA commands for server or admin tool
--  Copyright (C) 2020 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Command_Line;
with Servlet.Core;
package body AWA.Commands.Drivers is

   use Ada.Strings.Unbounded;
   use AWA.Applications;

   function "-" (Message : in String) return String is (Message);

   Help_Command            : aliased AWA.Commands.Drivers.Help_Command_Type;

   --  ------------------------------
   --  Setup the command before parsing the arguments and executing it.
   --  ------------------------------
   overriding
   procedure Setup (Command : in out Command_Type;
                    Config  : in out GNAT.Command_Line.Command_Line_Configuration;
                    Context : in out Context_Type) is
   begin
      GC.Set_Usage (Config => Config,
                    Usage  => Command.Get_Name & " [arguments]",
                    Help   => Command.Get_Description);
      AWA.Commands.Setup_Command (Config, Context);
   end Setup;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Command   : in out Command_Type;
                   Name      : in String;
                   Context   : in out Context_Type) is
      pragma Unreferenced (Command, Context);
   begin
      null;
   end Help;

   --  ------------------------------
   --  Setup the command before parsing the arguments and executing it.
   --  ------------------------------
   overriding
   procedure Setup (Command : in out Application_Command_Type;
                    Config  : in out GNAT.Command_Line.Command_Line_Configuration;
                    Context : in out Context_Type) is
   begin
      GC.Define_Switch (Config => Config,
                        Output => Command.Application_Name'Access,
                        Switch => "-a:",
                        Long_Switch => "--application=",
                        Argument => "NAME",
                        Help   => -("Defines the name or URI of the application"));
      AWA.Commands.Setup_Command (Config, Context);
   end Setup;

   function Is_Application (Command : in Application_Command_Type;
                            URI     : in String) return Boolean is
   begin
      return Command.Application_Name.all = URI;
   end Is_Application;

   overriding
   procedure Execute (Command   : in out Application_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is
      procedure Find (URI : in String;
                      App : in Servlet.Core.Servlet_Registry_Access);

      Count    : Natural := 0;
      Selected : Application_Access;
      App_Name : Unbounded_String;

      procedure Find (URI : in String;
                      App : in Servlet.Core.Servlet_Registry_Access) is
      begin
         if App.all in Application'Class then
            if Command.Is_Application (URI) then
               App_Name := To_Unbounded_String (URI (URI'First + 1 .. URI'Last));
               Selected := Application'Class (App.all)'Unchecked_Access;
               Count := Count + 1;
            elsif Command.Application_Name'Length = 0 then
               App_Name := To_Unbounded_String (URI (URI'First + 1 .. URI'Last));
               Selected := Application'Class (App.all)'Unchecked_Access;
               Count := Count + 1;
            end if;
         end if;
      end Find;

   begin
      WS.Iterate (Find'Access);
      if Count /= 1 then
         Context.Console.Notice (N_ERROR, -("No application found"));
         return;
      end if;

      Configure (Selected.all, To_String (App_Name), Context);
      Application_Command_Type'Class (Command).Execute (Selected.all, Args, Context);
   end Execute;

   --  ------------------------------
   --  Print the command usage.
   --  ------------------------------
   procedure Usage (Args    : in Argument_List'Class;
                    Context : in out Context_Type;
                    Name    : in String := "") is
   begin
      GC.Display_Help (Context.Command_Config);
      if Name'Length > 0 then
         Driver.Usage (Args, Context, Name);
      end if;
      Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
   end Usage;

   --  ------------------------------
   --  Execute the command with its arguments.
   --  ------------------------------
   procedure Execute (Name    : in String;
                      Args    : in Argument_List'Class;
                      Context : in out Context_Type) is
   begin
      Driver.Execute (Name, Args, Context);
   end Execute;

   procedure Run (Context   : in out Context_Type;
                  Arguments : out Util.Commands.Dynamic_Argument_List) is
   begin
      GC.Getopt (Config => Context.Command_Config);
      Util.Commands.Parsers.GNAT_Parser.Get_Arguments (Arguments, GC.Get_Argument);

      --if Context.Debug or Context.Verbose or Context.Dump then
      --   AKT.Configure_Logs (Debug   => Context.Debug,
      --                       Dump    => Context.Dump,
      --                       Verbose => Context.Verbose);
      --end if;

      Context.Load_Configuration;

      declare
         Cmd_Name : constant String := Arguments.Get_Command_Name;
      begin
         if Cmd_Name'Length = 0 then
            Context.Console.Notice (N_ERROR, -("Missing command name to execute."));
            Usage (Arguments, Context);
            Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
            return;
         end if;
         Execute (Cmd_Name, Arguments, Context);

      exception
         when GNAT.Command_Line.Invalid_Parameter =>
            Context.Console.Notice (N_ERROR, -("Missing option parameter"));
            raise Error;
      end;

   end Run;

begin
   Driver.Add_Command ("help",
                       -("print some help"),
                       Help_Command'Access);
end AWA.Commands.Drivers;

-----------------------------------------------------------------------
--  awa-commands-drivers -- Driver for AWA commands for server or admin tool
--  Copyright (C) 2020 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Command_Line;
with Servlet.Core;
package body AWA.Commands.Drivers is

   use Ada.Strings.Unbounded;
   use AWA.Applications;

   function "-" (Message : in String) return String is (Message);

   Help_Command            : aliased AWA.Commands.Drivers.Help_Command_Type;

   --  ------------------------------
   --  Setup the command before parsing the arguments and executing it.
   --  ------------------------------
   overriding
   procedure Setup (Command : in out Command_Type;
                    Config  : in out GNAT.Command_Line.Command_Line_Configuration;
                    Context : in out Context_Type) is
   begin
      GC.Set_Usage (Config => Config,
                    Usage  => Command.Get_Name & " [arguments]",
                    Help   => Command.Get_Description);
      AWA.Commands.Setup_Command (Config, Context);
   end Setup;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Command   : in out Command_Type;
                   Name      : in String;
                   Context   : in out Context_Type) is
      pragma Unreferenced (Command, Context);
   begin
      null;
   end Help;

   --  ------------------------------
   --  Setup the command before parsing the arguments and executing it.
   --  ------------------------------
   overriding
   procedure Setup (Command : in out Application_Command_Type;
                    Config  : in out GNAT.Command_Line.Command_Line_Configuration;
                    Context : in out Context_Type) is
   begin
      GC.Define_Switch (Config => Config,
                        Output => Command.Application_Name'Access,
                        Switch => "-a:",
                        Long_Switch => "--application=",
                        Argument => "NAME",
                        Help   => -("Defines the name or URI of the application"));
      AWA.Commands.Setup_Command (Config, Context);
   end Setup;

   function Is_Application (Command : in Application_Command_Type;
                            URI     : in String) return Boolean is
   begin
      return Command.Application_Name.all = URI;
   end Is_Application;

   overriding
   procedure Execute (Command   : in out Application_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is
      procedure Find (URI : in String;
                      App : in Servlet.Core.Servlet_Registry_Access);

      Count    : Natural := 0;
      Selected : Application_Access;
      App_Name : Unbounded_String;

      procedure Find (URI : in String;
                      App : in Servlet.Core.Servlet_Registry_Access) is
      begin
         if App.all in Application'Class then
            if Command.Is_Application (URI) then
               App_Name := To_Unbounded_String (URI (URI'First + 1 .. URI'Last));
               Selected := Application'Class (App.all)'Unchecked_Access;
               Count := Count + 1;
            elsif Command.Application_Name'Length = 0 then
               App_Name := To_Unbounded_String (URI (URI'First + 1 .. URI'Last));
               Selected := Application'Class (App.all)'Unchecked_Access;
               Count := Count + 1;
            end if;
         end if;
      end Find;

   begin
      WS.Iterate (Find'Access);
      if Count /= 1 then
         Context.Console.Notice (N_ERROR, -("No application found"));
         return;
      end if;

      Configure (Selected.all, To_String (App_Name), Context);
      Application_Command_Type'Class (Command).Execute (Selected.all, Args, Context);
   end Execute;

   --  ------------------------------
   --  Print the command usage.
   --  ------------------------------
   procedure Usage (Args    : in Argument_List'Class;
                    Context : in out Context_Type;
                    Name    : in String := "") is
   begin
      GC.Display_Help (Context.Command_Config);
      if Name'Length > 0 then
         Driver.Usage (Args, Context, Name);
      end if;
      Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
   end Usage;

   --  ------------------------------
   --  Execute the command with its arguments.
   --  ------------------------------
   procedure Execute (Name    : in String;
                      Args    : in Argument_List'Class;
                      Context : in out Context_Type) is
   begin
      Driver.Execute (Name, Args, Context);
   end Execute;

   procedure Run (Context   : in out Context_Type;
                  Arguments : out Util.Commands.Dynamic_Argument_List) is
   begin
      GC.Getopt (Config => Context.Command_Config);
      Util.Commands.Parsers.GNAT_Parser.Get_Arguments (Arguments, GC.Get_Argument);

      --if Context.Debug or Context.Verbose or Context.Dump then
      --   AKT.Configure_Logs (Debug   => Context.Debug,
      --                       Dump    => Context.Dump,
      --                       Verbose => Context.Verbose);
      --end if;

      if Context.Config_File'Length > 0 then
         Context.Load_Configuration (Context.Config_File.all);
      else
         Context.Load_Configuration (Driver_Name & ".properties");
      end if;

      declare
         Cmd_Name : constant String := Arguments.Get_Command_Name;
      begin
         if Cmd_Name'Length = 0 then
            Context.Console.Notice (N_ERROR, -("Missing command name to execute."));
            Usage (Arguments, Context);
            Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
            return;
         end if;
         Execute (Cmd_Name, Arguments, Context);

      exception
         when GNAT.Command_Line.Invalid_Parameter =>
            Context.Console.Notice (N_ERROR, -("Missing option parameter"));
            raise Error;
      end;

   end Run;

begin
   Driver.Add_Command ("help",
                       -("print some help"),
                       Help_Command'Access);
end AWA.Commands.Drivers;

Update call to Load_Configuration to use the driver's name if no -c <path> option is given


-- $Id$

-- Auxiliary types and subprograms to be with-ed and by all the Ada
-- bindings to PLplot

-- Copyright (C) 2006-2010 Jerry Bauck

-- This file is part of PLplot.

-- PLplot is free software; you can redistribute it and/or modify
-- it under the terms of the GNU Library General Public License as published
-- by the Free Software Foundation; either version 2 of the License, or
-- (at your option) any later version.

-- PLplot is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU Library General Public License for more details.

-- You should have received a copy of the GNU Library General Public License
-- along with PLplot; if not, write to the Free Software
-- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA

with
    Ada.Strings.Bounded, -- fixme Probable cruft.
    Ada.Strings.Unbounded;

use
    Ada.Strings.Bounded,
    Ada.Strings.Unbounded;

    with Ada.Numerics.Long_Real_Arrays;

package PLplot_Auxiliary is

--------------------------------------------------------------------------------
--           Utility type declarations used by the bindings                   --
--------------------------------------------------------------------------------

    -- Declarations for Ada 95 and Ada 2005 when it is desired to _not_ invoke
    -- the numerical capability of Annex G.3.
--   type Real_Vector is array (Integer range <>) of Long_Float;
--   type Real_Matrix is array (Integer range <>, Integer range <>) of Long_Float;

    -- Declarations when using Ada 2005 and it is desired to invoke the numerics
    -- Annex G.3 or the user simply prefers to declare real vectors and matrices
    -- in a manner that is type-compatible with that annex. ALSO IN THIS CASE
    -- uncomment the line above: with Ada.Numerics.Long_Real_Arrays;.
    -- Using Annex G.3 requires linking to BLAS and LAPACK libraries or the
    -- PLplot build process will fail when attempting to link the Ada examples
    -- e.g. x01a.adb.
    subtype Real_Vector is Ada.Numerics.Long_Real_Arrays.Real_Vector;
    subtype Real_Matrix is Ada.Numerics.Long_Real_Arrays.Real_Matrix;

    ----------------------------------------------------------------------------
    -- Implementation note: The easy ability to switch to Ada 2005 Annex G.3
    -- capability (with only these simple edits to this file) is the only reason
    -- for requiring that this package be with-ed in the bindings. Only the
    -- examples use the utility procedures below--not the bindings themselves.
    -- If it were ever to be decided to abandon Ada 95 compatibility and to
    -- require all Ada-capable PLplot builds to link to BLAS and LAPACK, then
    -- the with-s to this package in the bindings could be removed.
    ----------------------------------------------------------------------------

--------------------------------------------------------------------------------
--            Utility procedures useful in compiling the examples             --
--------------------------------------------------------------------------------

    -- Mimic C conversion of float to integer; something similar works in e.g.
    -- plplot_thin.adb.
    -- C truncates towards 0. Ada rounds to nearest integer; midway rounded
    -- away from zero, e.g. Inteter(±3.5) is ±4. But any completely reliable
    -- conversion is probalby not possible; indeed, this one exactly emulates C
    -- when tested for values around ±2 to ±3. Both convert ±2.9999999999999997
    -- to ±2 and ±2.9999999999999998 to ±3.
    function Trunc(a : Long_Float) return Integer;

    -- Find minimum in a 1D array.
    function Vector_Min(x : Real_Vector) return Long_Float;

    -- Find minimum and its location in a 1D array.
    procedure Vector_Min(x               : Real_Vector;
                         The_Minimum     : out Long_Float;
                         Location_Of_Min : out Integer);

    -- Find maximum in a 1D array.
    function Vector_Max(x : Real_Vector) return Long_Float;

    -- Find maximum and its location in a 1D array.
    procedure Vector_Max(x               : Real_Vector;
                         The_Maximum     : out Long_Float;
                         Location_Of_Max : out Integer);

    -- Find minimum in a 2D array.
    function Matrix_Min(x : Real_Matrix) return Long_Float;

    -- Find maximum in a 2D array.
    function Matrix_Max(x : Real_Matrix) return Long_Float;

end PLplot_Auxiliary;

-- $Id$

-- Auxiliary types and subprograms to be with-ed and by all the Ada
-- bindings to PLplot

-- Copyright (C) 2006-2010 Jerry Bauck

-- This file is part of PLplot.

-- PLplot is free software; you can redistribute it and/or modify
-- it under the terms of the GNU Library General Public License as published
-- by the Free Software Foundation; either version 2 of the License, or
-- (at your option) any later version.

-- PLplot is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU Library General Public License for more details.

-- You should have received a copy of the GNU Library General Public License
-- along with PLplot; if not, write to the Free Software
-- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA

with
    Ada.Strings.Bounded, -- fixme Probable cruft.
    Ada.Strings.Unbounded;

use
    Ada.Strings.Bounded,
    Ada.Strings.Unbounded;

--    with Ada.Numerics.Long_Real_Arrays;

package PLplot_Auxiliary is

--------------------------------------------------------------------------------
--           Utility type declarations used by the bindings                   --
--------------------------------------------------------------------------------

    -- Declarations for Ada 95 and Ada 2005 when it is desired to _not_ invoke
    -- the numerical capability of Annex G.3.
   type Real_Vector is array (Integer range <>) of Long_Float;
   type Real_Matrix is array (Integer range <>, Integer range <>) of Long_Float;

    -- Declarations when using Ada 2005 and it is desired to invoke the numerics
    -- Annex G.3 or the user simply prefers to declare real vectors and matrices
    -- in a manner that is type-compatible with that annex. ALSO IN THIS CASE
    -- uncomment the line above: with Ada.Numerics.Long_Real_Arrays;.
    -- Using Annex G.3 requires linking to BLAS and LAPACK libraries or the
    -- PLplot build process will fail when attempting to link the Ada examples
    -- e.g. x01a.adb.
--    subtype Real_Vector is Ada.Numerics.Long_Real_Arrays.Real_Vector;
--    subtype Real_Matrix is Ada.Numerics.Long_Real_Arrays.Real_Matrix;

    ----------------------------------------------------------------------------
    -- Implementation note: The easy ability to switch to Ada 2005 Annex G.3
    -- capability (with only these simple edits to this file) is the only reason
    -- for requiring that this package be with-ed in the bindings. Only the
    -- examples use the utility procedures below--not the bindings themselves.
    -- If it were ever to be decided to abandon Ada 95 compatibility and to
    -- require all Ada-capable PLplot builds to link to BLAS and LAPACK, then
    -- the with-s to this package in the bindings could be removed.
    ----------------------------------------------------------------------------

--------------------------------------------------------------------------------
--            Utility procedures useful in compiling the examples             --
--------------------------------------------------------------------------------

    -- Mimic C conversion of float to integer; something similar works in e.g.
    -- plplot_thin.adb.
    -- C truncates towards 0. Ada rounds to nearest integer; midway rounded
    -- away from zero, e.g. Inteter(±3.5) is ±4. But any completely reliable
    -- conversion is probalby not possible; indeed, this one exactly emulates C
    -- when tested for values around ±2 to ±3. Both convert ±2.9999999999999997
    -- to ±2 and ±2.9999999999999998 to ±3.
    function Trunc(a : Long_Float) return Integer;

    -- Find minimum in a 1D array.
    function Vector_Min(x : Real_Vector) return Long_Float;

    -- Find minimum and its location in a 1D array.
    procedure Vector_Min(x               : Real_Vector;
                         The_Minimum     : out Long_Float;
                         Location_Of_Min : out Integer);

    -- Find maximum in a 1D array.
    function Vector_Max(x : Real_Vector) return Long_Float;

    -- Find maximum and its location in a 1D array.
    procedure Vector_Max(x               : Real_Vector;
                         The_Maximum     : out Long_Float;
                         Location_Of_Max : out Integer);

    -- Find minimum in a 2D array.
    function Matrix_Min(x : Real_Matrix) return Long_Float;

    -- Find maximum in a 2D array.
    function Matrix_Max(x : Real_Matrix) return Long_Float;

end PLplot_Auxiliary;

Correct type declarations to once again allow building Ada with an Ada 95 compiler.

svn path=/trunk/; revision=12890


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

   type Memory_Servant is new MAT.Readers.Reader_Base with record
      Data  : access MAT.Memory.Targets.Target_Memory;
--        Slots : Client_Memory_Ref;
--        Impl        : Client_Memory_Ref;
   end record;
   type Memory_Reader_Access is access all Memory_Servant'Class;
   --  The memory servant is a proxy for the generic communication
   --  channel to process incomming events (such as memory allocations).

   overriding
   procedure Dispatch (For_Servant : in out Memory_Servant;
                       Id          : in MAT.Events.Internal_Reference;
                       Params      : in MAT.Events.Const_Attribute_Table_Access;
                       Frame       : in MAT.Events.Frame_Info;
                       Msg         : in out MAT.Readers.Message);

   --  Register the reader to extract and analyze memory events.
   procedure Register (Into   : in out MAT.Readers.Manager_Base'Class;
                       Reader : in Memory_Reader_Access);

end MAT.Memory.Readers;

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

   type Memory_Servant is new MAT.Readers.Reader_Base with record
      Data  : access MAT.Memory.Targets.Target_Memory;
   end record;
   type Memory_Reader_Access is access all Memory_Servant'Class;
   --  The memory servant is a proxy for the generic communication
   --  channel to process incomming events (such as memory allocations).

   overriding
   procedure Dispatch (For_Servant : in out Memory_Servant;
                       Id          : in MAT.Events.Internal_Reference;
                       Params      : in MAT.Events.Const_Attribute_Table_Access;
                       Frame       : in MAT.Events.Frame_Info;
                       Msg         : in out MAT.Readers.Message);

   --  Register the reader to extract and analyze memory events.
   procedure Register (Into   : in out MAT.Readers.Manager_Base'Class;
                       Reader : in Memory_Reader_Access);

end MAT.Memory.Readers;

Fix compilation warnings

Fix compilation warnings


-----------------------------------------------------------------------
--  applications-main-configs -- Configuration support for ASF Applications
--  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 Util.Log.Loggers;

with ASF.Navigations;
with ASF.Navigations.Mappers;
with ASF.Servlets.Mappers;
with ASF.Beans.Mappers;

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 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 =>
            declare
               L : Util.Locales.Locale := Get_Locale (Value);
            begin
               N.App.Set_Default_Locale (L);
            end;

         when TAG_SUPPORTED_LOCALE =>
            null;

      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
      --  Get the navigation handler for the Navigation_Config instantiation
      --  GNAT crashes if the call is made in the instantation 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);
      pragma Warnings (Off, Bean_Config);
      pragma Warnings (Off, Navigation_Config);
      pragma Warnings (Off, Servlet_Config);

      Config : aliased Application_Config;

   begin
      --  Install the property context that gives access
      --  to the application configuration properties
      Prop_Context.Set_Properties (App.Conf);
      Context.Set_Resolver (Prop_Context'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;
      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 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 ASF.Navigations;
with ASF.Navigations.Mappers;
with ASF.Servlets.Mappers;
with ASF.Beans.Mappers;

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
      --  Get the navigation handler for the Navigation_Config instantiation
      --  GNAT crashes if the call is made in the instantation 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);
      pragma Warnings (Off, Bean_Config);
      pragma Warnings (Off, Navigation_Config);
      pragma Warnings (Off, Servlet_Config);

      Config : aliased Application_Config;

   begin
      --  Install the property context that gives access
      --  to the application configuration properties
      Prop_Context.Set_Properties (App.Conf);
      Context.Set_Resolver (Prop_Context'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;
      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;

Add the supported locales on the application


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


-----------------------------------------------------------------------
--  ADO Postgresql Database -- Postgresql Database connections
--  Copyright (C) 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.
-----------------------------------------------------------------------
private with PQ;
package ADO.Drivers.Connections.Postgresql is

   type Postgresql_Driver is limited private;

   --  Initialize the Postgresql driver.
   procedure Initialize;

private

   --  Create a new Postgresql connection using the configuration parameters.
   procedure Create_Connection (D      : in out Postgresql_Driver;
                                Config : in Configuration'Class;
                                Result : in out Ref.Ref'Class);

   type Postgresql_Driver is new ADO.Drivers.Connections.Driver with record
      Id : Natural := 0;
   end record;

   --  Deletes the Postgresql driver.
   overriding
   procedure Finalize (D : in out Postgresql_Driver);

   --  Database connection implementation
   type Database_Connection is new ADO.Drivers.Connections.Database_Connection with record
      Name        : Unbounded_String;
      Server_Name : Unbounded_String;
      Login_Name  : Unbounded_String;
      Password    : Unbounded_String;
      Server      : PQ.PGconn_Access := PQ.Null_PGconn;
      Connected   : Boolean      := False;
   end record;

   type Database_Connection_Access is access all Database_Connection'Class;

   --  Get the database driver which manages this connection.
   overriding
   function Get_Driver (Database : in Database_Connection)
                        return Driver_Access;

   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement_Access;

   overriding
   function Create_Statement (Database : in Database_Connection;
                              Query    : in String)
                              return Query_Statement_Access;

   --  Create a delete statement.
   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement_Access;

   --  Create an insert statement.
   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement_Access;

   --  Create an update statement.
   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement_Access;

   --  Start a transaction.
   overriding
   procedure Begin_Transaction (Database : in out Database_Connection);

   --  Commit the current transaction.
   overriding
   procedure Commit (Database : in out Database_Connection);

   --  Rollback the current transaction.
   overriding
   procedure Rollback (Database : in out Database_Connection);

   procedure Execute (Database : in out Database_Connection;
                      SQL      : in Query_String);

   --  Closes the database connection
   overriding
   procedure Close (Database : in out Database_Connection);

   overriding
   procedure Finalize (Database : in out Database_Connection);

   --  Load the database schema definition for the current database.
   overriding
   procedure Load_Schema (Database : in Database_Connection;
                          Schema   : out ADO.Schemas.Schema_Definition);

   --  Create the database and initialize it with the schema SQL file.
   overriding
   procedure Create_Database (Database    : in Database_Connection;
                              Config      : in Configs.Configuration'Class;
                              Schema_Path : in String;
                              Messages    : out Util.Strings.Vectors.Vector);

end ADO.Drivers.Connections.Postgresql;

-----------------------------------------------------------------------
--  ADO Postgresql Database -- Postgresql Database connections
--  Copyright (C) 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.
-----------------------------------------------------------------------
private with PQ;
package ADO.Drivers.Connections.Postgresql is

   type Postgresql_Driver is limited private;

   --  Initialize the Postgresql driver.
   procedure Initialize;

private

   --  Create a new Postgresql connection using the configuration parameters.
   procedure Create_Connection (D      : in out Postgresql_Driver;
                                Config : in Configuration'Class;
                                Result : in out Ref.Ref'Class);

   type Postgresql_Driver is new ADO.Drivers.Connections.Driver with record
      Id : Natural := 0;
   end record;

   --  Create the database and initialize it with the schema SQL file.
   --  The `Admin` parameter describes the database connection with administrator access.
   --  The `Config` parameter describes the target database connection.
   overriding
   procedure Create_Database (D           : in out Postgresql_Driver;
                              Admin       : in Configs.Configuration'Class;
                              Config      : in Configs.Configuration'Class;
                              Schema_Path : in String;
                              Messages    : out Util.Strings.Vectors.Vector);

   --  Deletes the Postgresql driver.
   overriding
   procedure Finalize (D : in out Postgresql_Driver);

   --  Database connection implementation
   type Database_Connection is new ADO.Drivers.Connections.Database_Connection with record
      Name        : Unbounded_String;
      Server_Name : Unbounded_String;
      Login_Name  : Unbounded_String;
      Password    : Unbounded_String;
      Server      : PQ.PGconn_Access := PQ.Null_PGconn;
      Connected   : Boolean      := False;
   end record;

   type Database_Connection_Access is access all Database_Connection'Class;

   --  Get the database driver which manages this connection.
   overriding
   function Get_Driver (Database : in Database_Connection)
                        return Driver_Access;

   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Query_Statement_Access;

   overriding
   function Create_Statement (Database : in Database_Connection;
                              Query    : in String)
                              return Query_Statement_Access;

   --  Create a delete statement.
   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Delete_Statement_Access;

   --  Create an insert statement.
   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Insert_Statement_Access;

   --  Create an update statement.
   overriding
   function Create_Statement (Database : in Database_Connection;
                              Table    : in ADO.Schemas.Class_Mapping_Access)
                              return Update_Statement_Access;

   --  Start a transaction.
   overriding
   procedure Begin_Transaction (Database : in out Database_Connection);

   --  Commit the current transaction.
   overriding
   procedure Commit (Database : in out Database_Connection);

   --  Rollback the current transaction.
   overriding
   procedure Rollback (Database : in out Database_Connection);

   procedure Execute (Database : in out Database_Connection;
                      SQL      : in Query_String);

   --  Closes the database connection
   overriding
   procedure Close (Database : in out Database_Connection);

   overriding
   procedure Finalize (Database : in out Database_Connection);

   --  Load the database schema definition for the current database.
   overriding
   procedure Load_Schema (Database : in Database_Connection;
                          Schema   : out ADO.Schemas.Schema_Definition);

end ADO.Drivers.Connections.Postgresql;

Move the Create_Database operation on the Driver instead of the database connection