-----------------------------------------------------------------------
--  security-oauth -- OAuth Security
--  Copyright (C) 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.Numerics.Discrete_Random;
with Interfaces;
with Ada.Streams;

with Util.Log.Loggers;
with Util.Strings;
with Util.Http.Clients;
with Util.Encoders.HMAC.SHA1;

--  The Security.OAuth.Clients package implements the client OAuth 2.0 authorization.
--
--  Note: OAuth 1.0 could be implemented but since it's being deprecated it's not worth doing it.
package body Security.OAuth.Clients is

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

   --  ------------------------------
   --  Access Token
   --  ------------------------------

   package Id_Random is new Ada.Numerics.Discrete_Random (Interfaces.Unsigned_32);

   protected type Random is

      procedure Generate (Into : out Ada.Streams.Stream_Element_Array);

   private
      --  Random number generator used for ID generation.
      Random       : Id_Random.Generator;

      --  Number of 32-bit random numbers used for the ID generation.
      Id_Size      : Ada.Streams.Stream_Element_Offset := 8;
   end Random;

   protected body Random is

      procedure Generate (Into : out Ada.Streams.Stream_Element_Array) is
         use Ada.Streams;
         use Interfaces;
      begin
         --  Generate the random sequence.
         for I in 0 .. Id_Size - 1 loop
            declare
               Value : constant Unsigned_32 := Id_Random.Random (Random);
            begin
               Into (4 * I)     := Stream_Element (Value and 16#0FF#);
               Into (4 * I + 1) := Stream_Element (Shift_Right (Value, 8) and 16#0FF#);
               Into (4 * I + 2) := Stream_Element (Shift_Right (Value, 16) and 16#0FF#);
               Into (4 * I + 3) := Stream_Element (Shift_Right (Value, 24) and 16#0FF#);
            end;
         end loop;
      end Generate;

   end Random;

   --  ------------------------------
   --  Returns true if the given role is stored in the user principal.
   --  ------------------------------
   function Has_Role (User : in Access_Token;
                      Role : in Permissions.Role_Type) return Boolean is
      pragma Unreferenced (User, Role);
   begin
      return False;
   end Has_Role;

   --  ------------------------------
   --  Get the principal name.  This is the OAuth access token.
   --  ------------------------------
   function Get_Name (From : in Access_Token) return String is
   begin
      return From.Access_Id;
   end Get_Name;

   --  ------------------------------
   --  Set the application identifier used by the OAuth authorization server
   --  to identify the application (for example, the App ID in Facebook).
   --  ------------------------------
   procedure Set_Application_Identifier (App    : in out Application;
                                         Client : in String) is
      use Ada.Strings.Unbounded;
   begin
      App.Client_Id := To_Unbounded_String (Client);
      App.Protect   := App.Client_Id & App.Callback;
   end Set_Application_Identifier;

   --  ------------------------------
   --  Set the application secret defined in the OAuth authorization server
   --  for the application (for example, the App Secret in Facebook).
   --  ------------------------------
   procedure Set_Application_Secret (App    : in out Application;
                                     Secret : in String) is
   begin
      App.Secret := Ada.Strings.Unbounded.To_Unbounded_String (Secret);
      App.Key    := App.Secret;
   end Set_Application_Secret;

   --  ------------------------------
   --  Set the redirection callback that will be used to redirect the user
   --  back to the application after the OAuth authorization is finished.
   --  ------------------------------
   procedure Set_Application_Callback (App : in out Application;
                                       URI : in String) is
      use Ada.Strings.Unbounded;
   begin
      App.Callback := To_Unbounded_String (URI);
      App.Protect  := App.Client_Id & App.Callback;
   end Set_Application_Callback;

   --  ------------------------------
   --  Set the OAuth authorization server URI that the application must use
   --  to exchange the OAuth code into an access token.
   --  ------------------------------
   procedure Set_Provider_URI (App : in out Application;
                               URI : in String) is
   begin
      App.Request_URI := Ada.Strings.Unbounded.To_Unbounded_String (URI);
   end Set_Provider_URI;

   --  ------------------------------
   --  Build a unique opaque value used to prevent cross-site request forgery.
   --  The Nonce parameters is an optional but recommended unique value
   --  used only once.  The state value will be returned back by the OAuth provider.
   --  This protects the <tt>client_id</tt> and <tt>redirect_uri</tt> parameters.
   --  ------------------------------
   function Get_State (App   : in Application;
                       Nonce : in String) return String is
      use Ada.Strings.Unbounded;

      Data : constant String := Nonce & To_String (App.Protect);
      Hmac : String := Util.Encoders.HMAC.SHA1.Sign_Base64 (Key  => To_String (App.Key),
                                                            Data => Data,
                                                            URL  => True);
   begin
      --  Avoid the '=' at end of HMAC since it could be replaced by %C20 which is annoying...
      Hmac (Hmac'Last) := '.';
      return Hmac;
   end Get_State;

   --  ------------------------------
   --  Get the authenticate parameters to build the URI to redirect the user to
   --  the OAuth authorization form.
   --  ------------------------------
   function Get_Auth_Params (App : in Application;
                             State : in String;
                             Scope : in String := "") return String is
   begin
      return Security.OAuth.Client_Id
        & "=" & Ada.Strings.Unbounded.To_String (App.Client_Id)
        & "&"
        & Security.OAuth.Redirect_Uri
        & "=" & Ada.Strings.Unbounded.To_String (App.Callback)
        & "&"
        & Security.OAuth.Scope
        & "=" & Scope
        & "&"
        & Security.OAuth.State
        & "=" & State;
   end Get_Auth_Params;

   --  ------------------------------
   --  Verify that the State opaque value was created by the Get_State
   --  operation with the given client and redirect URL.
   --  ------------------------------
   function Is_Valid_State (App   : in Application;
                            Nonce : in String;
                            State : in String) return Boolean is
      Hmac : constant String := Application'Class (App).Get_State (Nonce);
   begin
      return Hmac = State;
   end Is_Valid_State;

   --  ------------------------------
   --  Exchange the OAuth code into an access token.
   --  ------------------------------
   function Request_Access_Token (App  : in Application;
                                  Code : in String) return Access_Token_Access is
      Client   : Util.Http.Clients.Client;
      Response : Util.Http.Clients.Response;

      Data : constant String
        := Security.OAuth.Grant_Type & "=authorization_code"
          & "&"
        & Security.OAuth.Code & "=" & Code
        & "&"
        & Security.OAuth.Redirect_Uri & "=" & Ada.Strings.Unbounded.To_String (App.Callback)
        & "&"
        & Security.OAuth.Client_Id & "=" & Ada.Strings.Unbounded.To_String (App.Client_Id)
        & "&"
        & Security.OAuth.Client_Secret & "=" & Ada.Strings.Unbounded.To_String (App.Secret);
      URI : constant String := Ada.Strings.Unbounded.To_String (App.Request_URI);
   begin
      Log.Info ("Getting access token from {0}", URI);
      Client.Post (URL   => URI,
                   Data  => Data,
                   Reply => Response);
      if Response.Get_Status /= Util.Http.SC_OK then
         Log.Warn ("Cannot get access token from {0}: status is {1}",
                   URI, Natural'Image (Response.Get_Status));
         return null;
      end if;

      --  Decode the response.
      declare
         Content      : constant String := Response.Get_Body;
         Content_Type : constant String := Response.Get_Header ("Content-Type");
         Pos          : Natural := Util.Strings.Index (Content_Type, ';');
         Last         : Natural;
         Expires      : Natural;
      begin
         if Pos = 0 then
            Pos := Content_Type'Last;
         end if;
         Log.Debug ("Content type: {0}", Content_Type);
         Log.Debug ("Data: {0}", Content);

         --  Facebook sends the access token as a 'text/plain' content.
         if Content_Type (Content_Type'First .. Pos) = "text/plain;" then
            Pos := Util.Strings.Index (Content, '=');
            if Pos = 0 then
               Log.Error ("Invalid access token response: '{0}'", Content);
               return null;
            end if;
            if Content (Content'First .. Pos) /= "access_token=" then
               Log.Error ("The 'access_token' parameter is missing in response: '{0}'", Content);
               return null;
            end if;
            Last := Util.Strings.Index (Content, '&', Pos + 1);
            if Last = 0 then
               Log.Error ("Invalid 'access_token' parameter: '{0}'", Content);
               return null;
            end if;
            if Content (Last .. Last + 8) /= "&expires=" then
               Log.Error ("Invalid 'expires' parameter: '{0}'", Content);
               return null;
            end if;
            Expires := Natural'Value (Content (Last + 9 .. Content'Last));
            return Application'Class (App).Create_Access_Token (Content (Pos + 1 .. Last - 1),
                                                                Expires);

         else
            Log.Error ("Content type {0} not supported for access token response", Content_Type);
            Log.Error ("Response: {0}", Content);
            return null;
         end if;
      end;
   end Request_Access_Token;

   --  ------------------------------
   --  Create the access token
   --  ------------------------------
   function Create_Access_Token (App     : in Application;
                                 Token   : in String;
                                 Expires : in Natural) return Access_Token_Access is
      pragma Unreferenced (App, Expires);

   begin
      return new Access_Token '(Len => Token'Length,
                                Access_Id => Token);
   end Create_Access_Token;

end Security.OAuth.Clients;

-----------------------------------------------------------------------
--  security-oauth -- OAuth Security
--  Copyright (C) 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.Numerics.Discrete_Random;
with Interfaces;
with Ada.Streams;

with Util.Log.Loggers;
with Util.Strings;
with Util.Http.Clients;
with Util.Encoders.HMAC.SHA1;

--  The Security.OAuth.Clients package implements the client OAuth 2.0 authorization.
--
--  Note: OAuth 1.0 could be implemented but since it's being deprecated it's not worth doing it.
package body Security.OAuth.Clients is

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

   --  ------------------------------
   --  Access Token
   --  ------------------------------

   package Id_Random is new Ada.Numerics.Discrete_Random (Interfaces.Unsigned_32);

   protected type Random is

      procedure Generate (Into : out Ada.Streams.Stream_Element_Array);

   private
      --  Random number generator used for ID generation.
      Random       : Id_Random.Generator;

      --  Number of 32-bit random numbers used for the ID generation.
      Id_Size      : Ada.Streams.Stream_Element_Offset := 8;
   end Random;

   protected body Random is

      procedure Generate (Into : out Ada.Streams.Stream_Element_Array) is
         use Ada.Streams;
         use Interfaces;
      begin
         --  Generate the random sequence.
         for I in 0 .. Id_Size - 1 loop
            declare
               Value : constant Unsigned_32 := Id_Random.Random (Random);
            begin
               Into (4 * I)     := Stream_Element (Value and 16#0FF#);
               Into (4 * I + 1) := Stream_Element (Shift_Right (Value, 8) and 16#0FF#);
               Into (4 * I + 2) := Stream_Element (Shift_Right (Value, 16) and 16#0FF#);
               Into (4 * I + 3) := Stream_Element (Shift_Right (Value, 24) and 16#0FF#);
            end;
         end loop;
      end Generate;

   end Random;

   --  ------------------------------
   --  Get the principal name.  This is the OAuth access token.
   --  ------------------------------
   function Get_Name (From : in Access_Token) return String is
   begin
      return From.Access_Id;
   end Get_Name;

   --  ------------------------------
   --  Set the application identifier used by the OAuth authorization server
   --  to identify the application (for example, the App ID in Facebook).
   --  ------------------------------
   procedure Set_Application_Identifier (App    : in out Application;
                                         Client : in String) is
      use Ada.Strings.Unbounded;
   begin
      App.Client_Id := To_Unbounded_String (Client);
      App.Protect   := App.Client_Id & App.Callback;
   end Set_Application_Identifier;

   --  ------------------------------
   --  Set the application secret defined in the OAuth authorization server
   --  for the application (for example, the App Secret in Facebook).
   --  ------------------------------
   procedure Set_Application_Secret (App    : in out Application;
                                     Secret : in String) is
   begin
      App.Secret := Ada.Strings.Unbounded.To_Unbounded_String (Secret);
      App.Key    := App.Secret;
   end Set_Application_Secret;

   --  ------------------------------
   --  Set the redirection callback that will be used to redirect the user
   --  back to the application after the OAuth authorization is finished.
   --  ------------------------------
   procedure Set_Application_Callback (App : in out Application;
                                       URI : in String) is
      use Ada.Strings.Unbounded;
   begin
      App.Callback := To_Unbounded_String (URI);
      App.Protect  := App.Client_Id & App.Callback;
   end Set_Application_Callback;

   --  ------------------------------
   --  Set the OAuth authorization server URI that the application must use
   --  to exchange the OAuth code into an access token.
   --  ------------------------------
   procedure Set_Provider_URI (App : in out Application;
                               URI : in String) is
   begin
      App.Request_URI := Ada.Strings.Unbounded.To_Unbounded_String (URI);
   end Set_Provider_URI;

   --  ------------------------------
   --  Build a unique opaque value used to prevent cross-site request forgery.
   --  The Nonce parameters is an optional but recommended unique value
   --  used only once.  The state value will be returned back by the OAuth provider.
   --  This protects the <tt>client_id</tt> and <tt>redirect_uri</tt> parameters.
   --  ------------------------------
   function Get_State (App   : in Application;
                       Nonce : in String) return String is
      use Ada.Strings.Unbounded;

      Data : constant String := Nonce & To_String (App.Protect);
      Hmac : String := Util.Encoders.HMAC.SHA1.Sign_Base64 (Key  => To_String (App.Key),
                                                            Data => Data,
                                                            URL  => True);
   begin
      --  Avoid the '=' at end of HMAC since it could be replaced by %C20 which is annoying...
      Hmac (Hmac'Last) := '.';
      return Hmac;
   end Get_State;

   --  ------------------------------
   --  Get the authenticate parameters to build the URI to redirect the user to
   --  the OAuth authorization form.
   --  ------------------------------
   function Get_Auth_Params (App : in Application;
                             State : in String;
                             Scope : in String := "") return String is
   begin
      return Security.OAuth.Client_Id
        & "=" & Ada.Strings.Unbounded.To_String (App.Client_Id)
        & "&"
        & Security.OAuth.Redirect_Uri
        & "=" & Ada.Strings.Unbounded.To_String (App.Callback)
        & "&"
        & Security.OAuth.Scope
        & "=" & Scope
        & "&"
        & Security.OAuth.State
        & "=" & State;
   end Get_Auth_Params;

   --  ------------------------------
   --  Verify that the State opaque value was created by the Get_State
   --  operation with the given client and redirect URL.
   --  ------------------------------
   function Is_Valid_State (App   : in Application;
                            Nonce : in String;
                            State : in String) return Boolean is
      Hmac : constant String := Application'Class (App).Get_State (Nonce);
   begin
      return Hmac = State;
   end Is_Valid_State;

   --  ------------------------------
   --  Exchange the OAuth code into an access token.
   --  ------------------------------
   function Request_Access_Token (App  : in Application;
                                  Code : in String) return Access_Token_Access is
      Client   : Util.Http.Clients.Client;
      Response : Util.Http.Clients.Response;

      Data : constant String
        := Security.OAuth.Grant_Type & "=authorization_code"
          & "&"
        & Security.OAuth.Code & "=" & Code
        & "&"
        & Security.OAuth.Redirect_Uri & "=" & Ada.Strings.Unbounded.To_String (App.Callback)
        & "&"
        & Security.OAuth.Client_Id & "=" & Ada.Strings.Unbounded.To_String (App.Client_Id)
        & "&"
        & Security.OAuth.Client_Secret & "=" & Ada.Strings.Unbounded.To_String (App.Secret);
      URI : constant String := Ada.Strings.Unbounded.To_String (App.Request_URI);
   begin
      Log.Info ("Getting access token from {0}", URI);
      Client.Post (URL   => URI,
                   Data  => Data,
                   Reply => Response);
      if Response.Get_Status /= Util.Http.SC_OK then
         Log.Warn ("Cannot get access token from {0}: status is {1}",
                   URI, Natural'Image (Response.Get_Status));
         return null;
      end if;

      --  Decode the response.
      declare
         Content      : constant String := Response.Get_Body;
         Content_Type : constant String := Response.Get_Header ("Content-Type");
         Pos          : Natural := Util.Strings.Index (Content_Type, ';');
         Last         : Natural;
         Expires      : Natural;
      begin
         if Pos = 0 then
            Pos := Content_Type'Last;
         end if;
         Log.Debug ("Content type: {0}", Content_Type);
         Log.Debug ("Data: {0}", Content);

         --  Facebook sends the access token as a 'text/plain' content.
         if Content_Type (Content_Type'First .. Pos) = "text/plain;" then
            Pos := Util.Strings.Index (Content, '=');
            if Pos = 0 then
               Log.Error ("Invalid access token response: '{0}'", Content);
               return null;
            end if;
            if Content (Content'First .. Pos) /= "access_token=" then
               Log.Error ("The 'access_token' parameter is missing in response: '{0}'", Content);
               return null;
            end if;
            Last := Util.Strings.Index (Content, '&', Pos + 1);
            if Last = 0 then
               Log.Error ("Invalid 'access_token' parameter: '{0}'", Content);
               return null;
            end if;
            if Content (Last .. Last + 8) /= "&expires=" then
               Log.Error ("Invalid 'expires' parameter: '{0}'", Content);
               return null;
            end if;
            Expires := Natural'Value (Content (Last + 9 .. Content'Last));
            return Application'Class (App).Create_Access_Token (Content (Pos + 1 .. Last - 1),
                                                                Expires);

         else
            Log.Error ("Content type {0} not supported for access token response", Content_Type);
            Log.Error ("Response: {0}", Content);
            return null;
         end if;
      end;
   end Request_Access_Token;

   --  ------------------------------
   --  Create the access token
   --  ------------------------------
   function Create_Access_Token (App     : in Application;
                                 Token   : in String;
                                 Expires : in Natural) return Access_Token_Access is
      pragma Unreferenced (App, Expires);

   begin
      return new Access_Token '(Len => Token'Length,
                                Access_Id => Token);
   end Create_Access_Token;

end Security.OAuth.Clients;

Remove the Has_Role operation

Remove the Has_Role operation


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

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

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

with GNAT.Regexp;

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

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

   --  ------------------------------
   --  URI Permission
   --  ------------------------------
   --  Represents a permission to access a given URI.
   type URI_Permission (Id  : Permissions.Permission_Index;
                        Len : Natural) is new Permissions.Permission (Id) with record
      URI : String (1 .. Len);
   end record;

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

   Invalid_Name : exception;

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

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

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

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

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

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

   --  Finish reading the XML policy configuration.  The security policy implementation can use
   --  this procedure to perform any configuration setup after the configuration is parsed.
   overriding
   procedure Finish_Config (Into    : in out URL_Policy;
                            Reader  : in out Util.Serialize.IO.XML.Parser);

private

   use Util.Strings;

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

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

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

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

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

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

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

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

   type Rules_Ref_Access is access Rules_Ref.Atomic_Ref;

   type Controller_Access_Array_Access is access all Controller_Access_Array;

   type URL_Policy is new Security.Policies.Policy with record
      Cache        : Rules_Ref_Access;
      Policies     : Policy_Vector.Vector;
   end record;

end Security.Policies.Urls;

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

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

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

with GNAT.Regexp;

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

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

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

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

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

   Invalid_Name : exception;

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

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

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

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

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

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

   --  Finish reading the XML policy configuration.  The security policy implementation can use
   --  this procedure to perform any configuration setup after the configuration is parsed.
   overriding
   procedure Finish_Config (Into    : in out URL_Policy;
                            Reader  : in out Util.Serialize.IO.XML.Parser);

private

   use Util.Strings;

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

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

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

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

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

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

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

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

   type Rules_Ref_Access is access Rules_Ref.Atomic_Ref;

   type Controller_Access_Array_Access is access all Controller_Access_Array;

   type URL_Policy is new Security.Policies.Policy with record
      Cache        : Rules_Ref_Access;
      Policies     : Policy_Vector.Vector;
   end record;

end Security.Policies.Urls;

Define and use the URL permission for the URL_Permission type


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

   --  ------------------------------
   --  Get the console instance.
   --  ------------------------------
   function Console (Target : in Target_Type) return MAT.Consoles.Console_Access is
   begin
      return Target.Console;
   end Console;

   --  ------------------------------
   --  Initialize the target object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory and other events.
   --  ------------------------------
   procedure Initialize (Target : in out Target_Type;
                         Reader : in out MAT.Readers.Manager_Base'Class) is
   begin
      MAT.Memory.Targets.Initialize (Memory => Target.Memory,
                                     Reader => Reader);
   end Initialize;

   --  ------------------------------
   --  Create a process instance to hold and keep track of memory and other information about
   --  the given process ID.
   --  ------------------------------
   procedure Create_Process (Target  : in out Target_Type;
                             Pid     : in MAT.Types.Target_Process_Ref;
                             Process : out Target_Process_Type_Access) is
   begin
      Process := Target.Find_Process (Pid);
      if Process = null then
         Process := new Target_Process_Type;
         Process.Pid := Pid;
         Target.Processes.Insert (Pid, Process);
      end if;
   end Create_Process;

   --  ------------------------------
   --  Find the process instance from the process ID.
   --  ------------------------------
   function Find_Process (Target : in Target_Type;
                          Pid    : in MAT.Types.Target_Process_Ref)
                          return Target_Process_Type_Access is
      Pos : constant Process_Cursor := Target.Processes.Find (Pid);
   begin
      if Process_Maps.Has_Element (Pos) then
         return Process_Maps.Element (Pos);
      else
         return null;
      end if;
   end Find_Process;

end MAT.Targets;

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

   --  ------------------------------
   --  Get the console instance.
   --  ------------------------------
   function Console (Target : in Target_Type) return MAT.Consoles.Console_Access is
   begin
      return Target.Console;
   end Console;

   --  ------------------------------
   --  Get the current process instance.
   --  ------------------------------
   function Process (Target : in Target_Type) return Target_Process_Type_Access is
   begin
      return Target.Process;
   end Process;

   --  ------------------------------
   --  Initialize the target object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory and other events.
   --  ------------------------------
   procedure Initialize (Target : in out Target_Type;
                         Reader : in out MAT.Readers.Manager_Base'Class) is
   begin
      MAT.Memory.Targets.Initialize (Memory => Target.Memory,
                                     Reader => Reader);
   end Initialize;

   --  ------------------------------
   --  Create a process instance to hold and keep track of memory and other information about
   --  the given process ID.
   --  ------------------------------
   procedure Create_Process (Target  : in out Target_Type;
                             Pid     : in MAT.Types.Target_Process_Ref;
                             Process : out Target_Process_Type_Access) is
   begin
      Process := Target.Find_Process (Pid);
      if Process = null then
         Process := new Target_Process_Type;
         Process.Pid := Pid;
         Target.Processes.Insert (Pid, Process);
      end if;
   end Create_Process;

   --  ------------------------------
   --  Find the process instance from the process ID.
   --  ------------------------------
   function Find_Process (Target : in Target_Type;
                          Pid    : in MAT.Types.Target_Process_Ref)
                          return Target_Process_Type_Access is
      Pos : constant Process_Cursor := Target.Processes.Find (Pid);
   begin
      if Process_Maps.Has_Element (Pos) then
         return Process_Maps.Element (Pos);
      else
         return null;
      end if;
   end Find_Process;

end MAT.Targets;

Implement the Process function

Implement the Process function


-----------------------------------------------------------------------
--  Util-strings-maps --  Map of strings
--  Copyright (C) 2010 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.Hash;
with Ada.Containers.Indefinite_Hashed_Maps;

--  The <b>Util.Strings.Maps</b> package provides an instantiation
--  of a hashed map with Strings.
package Util.Strings.Maps is new Ada.Containers.Indefinite_Hashed_Maps
     (Key_Type        => String,
      Element_Type    => String,
      Hash            => Ada.Strings.Hash,
      Equivalent_Keys => "=");

-----------------------------------------------------------------------
--  util-strings-maps --  Map of strings
--  Copyright (C) 2010, 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.Hash;
with Ada.Containers.Indefinite_Hashed_Maps;

--  The <b>Util.Strings.Maps</b> package provides an instantiation
--  of a hashed map with Strings.
package Util.Strings.Maps is new Ada.Containers.Indefinite_Hashed_Maps
     (Key_Type        => String,
      Element_Type    => String,
      Hash            => Ada.Strings.Hash,
      Equivalent_Keys => "=");

Update the header

Update the header


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

package body ASF.Routes.Servlets is

   use type ASF.Filters.Filter_Access;
   use type ASF.Filters.Filter_List_Access;

   procedure Free is
     new Ada.Unchecked_Deallocation (Object => ASF.Filters.Filter_List,
                                     Name   => ASF.Filters.Filter_List_Access);

   --  Get the servlet to call for the route.
   function Get_Servlet (Route : in Servlet_Route_Type) return ASF.Servlets.Servlet_Access is
   begin
      return Route.Servlet;
   end Get_Servlet;

   --  ------------------------------
   --  Append the filter to the filter list defined by the mapping node.
   --  ------------------------------
   procedure Append_Filter (Route  : in out Servlet_Route_Type;
                            Filter : in ASF.Filters.Filter_Access) is
      List : ASF.Filters.Filter_List_Access;
   begin
      --  Filters are executed through the <b>Filter_Chain.Do_Filter</b> method
      --  starting from the last position to the first.  To append a filter,
      --  it must be inserted as first position of the list.
      if Route.Filters = null then
         List := new ASF.Filters.Filter_List (1 .. 1);
      else
         --  Check that the filter is not already executed.
         for I in Route.Filters'Range loop
            if Route.Filters (I) = Filter then
               return;
            end if;
         end loop;
         List := new ASF.Filters.Filter_List (1 .. Route.Filters'Last + 1);
         List (2 .. List'Last) := Route.Filters.all;
         Free (Route.Filters);
      end if;
      List (List'First) := Filter;
      Route.Filters := List;
   end Append_Filter;

   --  Release the storage held by the route.
   overriding
   procedure Finalize (Route : in out Servlet_Route_Type) is
   begin
      Free (Route.Filters);
   end Finalize;

end ASF.Routes.Servlets;

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

package body ASF.Routes.Servlets is

   use type ASF.Filters.Filter_Access;
   use type ASF.Filters.Filter_List_Access;

   procedure Free is
     new Ada.Unchecked_Deallocation (Object => ASF.Filters.Filter_List,
                                     Name   => ASF.Filters.Filter_List_Access);

   --  ------------------------------
   --  Get the servlet to call for the route.
   --  ------------------------------
   function Get_Servlet (Route : in Servlet_Route_Type) return ASF.Servlets.Servlet_Access is
   begin
      return Route.Servlet;
   end Get_Servlet;

   --  ------------------------------
   --  Append the filter to the filter list defined by the mapping node.
   --  ------------------------------
   procedure Append_Filter (Route  : in out Servlet_Route_Type;
                            Filter : in ASF.Filters.Filter_Access) is
      List : ASF.Filters.Filter_List_Access;
   begin
      --  Filters are executed through the <b>Filter_Chain.Do_Filter</b> method
      --  starting from the last position to the first.  To append a filter,
      --  it must be inserted as first position of the list.
      if Route.Filters = null then
         List := new ASF.Filters.Filter_List (1 .. 1);
      else
         --  Check that the filter is not already executed.
         for I in Route.Filters'Range loop
            if Route.Filters (I) = Filter then
               return;
            end if;
         end loop;
         List := new ASF.Filters.Filter_List (1 .. Route.Filters'Last + 1);
         List (2 .. List'Last) := Route.Filters.all;
         Free (Route.Filters);
      end if;
      List (List'First) := Filter;
      Route.Filters := List;
   end Append_Filter;

   --  ------------------------------
   --  Release the storage held by the route.
   --  ------------------------------
   overriding
   procedure Finalize (Route : in out Servlet_Route_Type) is
   begin
      Free (Route.Filters);
   end Finalize;

end ASF.Routes.Servlets;

Update style

Update style


-----------------------------------------------------------------------
--  util-commands-drivers -- Support to make command line tools
--  Copyright (C) 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;
private with Ada.Strings.Unbounded;
private with Ada.Containers.Indefinite_Ordered_Maps;

--  == Command line driver ==
--  The <tt>Util.Commands.Drivers</tt> generic package provides a support to build command line
--  tools that have different commands identified by a name.
generic
   --  The command execution context.
   type Context_Type (<>) is limited private;
   Driver_Name : String := "Drivers";
package Util.Commands.Drivers is

   --  A simple command handler executed when the command with the given name is executed.
   type Command_Handler is not null access procedure (Name    : in String;
                                                      Args    : in Argument_List'Class;
                                                      Context : in out Context_Type);

   --  A more complex command handler that has a command instance as context.
   type Command_Type is abstract tagged limited private;
   type Command_Access is access all Command_Type'Class;

   --  Execute the command with the arguments.  The command name is passed with the command
   --  arguments.
   procedure Execute (Command   : in Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is abstract;

   --  Write the help associated with the command.
   procedure Help (Command   : in Command_Type;
                   Context   : in out Context_Type) is abstract;

   --  Write the command usage.
   procedure Usage (Command : in Command_Type);

   --  Print a message for the command.  The level indicates whether the message is an error,
   --  warning or informational.  The command name can be used to known the originator.
   --  The <tt>Log</tt> operation is redirected to the driver's <tt>Log</tt> procedure.
   procedure Log (Command : in Command_Type;
                  Level   : in Util.Log.Level_Type;
                  Name    : in String;
                  Message : in String);

   type Help_Command_Type is new Command_Type with private;

   --  Execute the help command with the arguments.
   --  Print the help for every registered command.
   overriding
   procedure Execute (Command   : in Help_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type);

   --  Write the help associated with the command.
   procedure Help (Command   : in Help_Command_Type;
                   Context   : in out Context_Type);

   type Driver_Type is tagged limited private;

   --  Set the driver description printed in the usage.
   procedure Set_Description (Driver      : in out Driver_Type;
                              Description : in String);

   --  Register the command under the given name.
   procedure Add_Command (Driver  : in out Driver_Type;
                          Name    : in String;
                          Command : in Command_Access);

   --  Register the command under the given name.
   procedure Add_Command (Driver  : in out Driver_Type;
                          Name    : in String;
                          Handler : in Command_Handler);

   --  Find the command having the given name.
   --  Returns null if the command was not found.
   function Find_Command (Driver : in Driver_Type;
                          Name   : in String) return Command_Access;

   --  Execute the command registered under the given name.
   procedure Execute (Driver  : in Driver_Type;
                      Name    : in String;
                      Args    : in Argument_List'Class;
                      Context : in out Context_Type);

   --  Print a message for the command.  The level indicates whether the message is an error,
   --  warning or informational.  The command name can be used to known the originator.
   procedure Log (Driver  : in Driver_Type;
                  Level   : in Util.Log.Level_Type;
                  Name    : in String;
                  Message : in String);

private

   package Command_Maps is
     new Ada.Containers.Indefinite_Ordered_Maps (Key_Type     => String,
                                                 Element_Type => Command_Access,
                                                 "<"          => "<");

   type Command_Type is abstract tagged limited record
      Driver : access Driver_Type'Class;
   end record;

   type Help_Command_Type is new Command_Type with null record;

   type Handler_Command_Type is new Command_Type with record
      Handler : Command_Handler;
   end record;

   --  Execute the command with the arguments.
   overriding
   procedure Execute (Command   : in Handler_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type);

   --  Write the help associated with the command.
   overriding
   procedure Help (Command   : in Handler_Command_Type;
                   Context   : in out Context_Type);

   type Driver_Type is tagged limited record
      List : Command_Maps.Map;
      Desc : Ada.Strings.Unbounded.Unbounded_String;
   end record;

end Util.Commands.Drivers;

-----------------------------------------------------------------------
--  util-commands-drivers -- Support to make command line tools
--  Copyright (C) 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;
private with Ada.Strings.Unbounded;
private with Ada.Containers.Indefinite_Ordered_Maps;

--  == Command line driver ==
--  The <tt>Util.Commands.Drivers</tt> generic package provides a support to build command line
--  tools that have different commands identified by a name.
generic
   --  The command execution context.
   type Context_Type (<>) is limited private;
   Driver_Name : String := "Drivers";
package Util.Commands.Drivers is

   --  A simple command handler executed when the command with the given name is executed.
   type Command_Handler is not null access procedure (Name    : in String;
                                                      Args    : in Argument_List'Class;
                                                      Context : in out Context_Type);

   --  A more complex command handler that has a command instance as context.
   type Command_Type is abstract tagged limited private;
   type Command_Access is access all Command_Type'Class;

   --  Execute the command with the arguments.  The command name is passed with the command
   --  arguments.
   procedure Execute (Command   : in Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is abstract;

   --  Write the help associated with the command.
   procedure Help (Command   : in Command_Type;
                   Context   : in out Context_Type) is abstract;

   --  Write the command usage.
   procedure Usage (Command : in Command_Type);

   --  Print a message for the command.  The level indicates whether the message is an error,
   --  warning or informational.  The command name can be used to known the originator.
   --  The <tt>Log</tt> operation is redirected to the driver's <tt>Log</tt> procedure.
   procedure Log (Command : in Command_Type;
                  Level   : in Util.Log.Level_Type;
                  Name    : in String;
                  Message : in String);

   type Help_Command_Type is new Command_Type with private;

   --  Execute the help command with the arguments.
   --  Print the help for every registered command.
   overriding
   procedure Execute (Command   : in Help_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type);

   --  Write the help associated with the command.
   procedure Help (Command   : in Help_Command_Type;
                   Context   : in out Context_Type);

   type Driver_Type is tagged limited private;

   --  Set the driver description printed in the usage.
   procedure Set_Description (Driver      : in out Driver_Type;
                              Description : in String);

   --  Set the driver usage printed in the usage.
   procedure Set_Usage (Driver  : in out Driver_Type;
                        Usage   : in String);

   --  Register the command under the given name.
   procedure Add_Command (Driver  : in out Driver_Type;
                          Name    : in String;
                          Command : in Command_Access);

   --  Register the command under the given name.
   procedure Add_Command (Driver  : in out Driver_Type;
                          Name    : in String;
                          Handler : in Command_Handler);

   --  Find the command having the given name.
   --  Returns null if the command was not found.
   function Find_Command (Driver : in Driver_Type;
                          Name   : in String) return Command_Access;

   --  Execute the command registered under the given name.
   procedure Execute (Driver  : in Driver_Type;
                      Name    : in String;
                      Args    : in Argument_List'Class;
                      Context : in out Context_Type);

   --  Print a message for the command.  The level indicates whether the message is an error,
   --  warning or informational.  The command name can be used to known the originator.
   procedure Log (Driver  : in Driver_Type;
                  Level   : in Util.Log.Level_Type;
                  Name    : in String;
                  Message : in String);

private

   package Command_Maps is
     new Ada.Containers.Indefinite_Ordered_Maps (Key_Type     => String,
                                                 Element_Type => Command_Access,
                                                 "<"          => "<");

   type Command_Type is abstract tagged limited record
      Driver : access Driver_Type'Class;
   end record;

   type Help_Command_Type is new Command_Type with null record;

   type Handler_Command_Type is new Command_Type with record
      Handler : Command_Handler;
   end record;

   --  Execute the command with the arguments.
   overriding
   procedure Execute (Command   : in Handler_Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type);

   --  Write the help associated with the command.
   overriding
   procedure Help (Command   : in Handler_Command_Type;
                   Context   : in out Context_Type);

   type Driver_Type is tagged limited record
      List  : Command_Maps.Map;
      Desc  : Ada.Strings.Unbounded.Unbounded_String;
      Usage : Ada.Strings.Unbounded.Unbounded_String;
   end record;

end Util.Commands.Drivers;

Declare the Set_Usage procedure

Declare the Set_Usage procedure


-----------------------------------------------------------------------
--  util-beans-objects-iterators -- Iterators for objects
--  Copyright (C) 2022 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.Finalization;
with Ada.Iterator_Interfaces;

--  == Object iterator ==
--  Iterators are provided by the `Util.Beans.Objects.Iterators` package.
--  The iterator instance is created by using either the `First` or `Last`
--  function on the object to iterate.
--
--    with Util.Beans.Objects.Iterators;
--    ...
--       Iter : Util.Beans.Objects.Iterators.Iterator
--          := Util.Beans.Objects.Iterators.First (Object);
--
--  The iterator is used in conjunction with its `Has_Element` function
--  and either its `Next` or `Previous` procedure.  The current element
--  is obtained by using the `Element` function.  When the object being
--  iterated is a map, a key can be associated with the element and
--  is obtained by the `Key` function.
--
--    while Util.Beans.Objects.Iterators.Has_Element (Iter) loop
--       declare
--          Item : Object := Util.Beans.Objects.Iterators.Element (Iter);
--          Key  : String := Util.Beans.Objects.Iterators.Key (Iter);
--       begin
--          ...
--          Util.Beans.Objects.Iterators.Next (Iter);
--       end;
--    end loop;
--
package Util.Beans.Objects.Iterators is

   type Iterator is tagged private;

   --  Returns True if the iterator provides a key for each element.
   function Has_Key (Iter : in Iterator) return Boolean;

   --  Returns True if the iterator has an element.
   function Has_Element (Iter : in Iterator) return Boolean;

   --  Returns the current iterator element or Null_Object if it is empty.
   function Element (Iter : in Iterator) return Object;

   --  Returns the key associated with the current element.
   function Key (Iter : in Iterator) return String;

   --  Move the iterator to the next element.
   procedure Next (Iter : in out Iterator);

   --  Move the iterator to the previous element.
   procedure Previous (Iter : in out Iterator);

   --  Create an iterator to iterate from the first element.
   function First (Item : in Object) return Iterator;

   --  Create an iterator to iterate from the last element.
   function Last (Item : in Object) return Iterator;

   package Object_Iterator_Interfaces is
      new Ada.Iterator_Interfaces (Iterator, Has_Element);

   function Iterate (Item : in Object) return
            Object_Iterator_Interfaces.Forward_Iterator'Class;

   --  ------------------------------
   --  Proxy_Iterator
   --  ------------------------------
   --  The `Proxy_Iterator` is the base type for the implementation of an iterator.
   --  An instance is created by the `Iterator_Bean` interface.
   --  The `Porxy_Map_Iterator` extends the iterator to provide access to
   --  the key when the iterator gives access to the elements of a map.
   type Proxy_Iterator is abstract new Ada.Finalization.Limited_Controlled with private;
   type Proxy_Iterator_Access is access all Proxy_Iterator'Class;

   overriding
   procedure Finalize (Proxy : in out Proxy_Iterator);

   function Has_Element (Iter : in Proxy_Iterator) return Boolean is abstract;

   procedure Next (Iter : in out Proxy_Iterator) is abstract;

   procedure Previous (Iter : in out Proxy_Iterator) is abstract;

   function Element (Iter : in Proxy_Iterator) return Object is abstract;

   type Proxy_Map_Iterator is abstract new Proxy_Iterator with private;
   type Proxy_Map_Iterator_Access is access all Proxy_Map_Iterator'Class;

   function Key (Iter : in Proxy_Map_Iterator) return String is abstract;

   generic
      type T is limited new Util.Beans.Basic.Readonly_Bean with private;
      type T_Access is access all T'Class;
   function Get_Bean (Iter : in Proxy_Iterator'Class) return T_Access;

   --  ------------------------------
   --  Iterator
   --  ------------------------------
   --  The `Iterator_Bean` interface allows to create an iterator on the bean object
   --  to iterate over its internal values.  The `First` and `Last` function must
   --  create an instance of a `Proxy_Iterator` interface which provides the
   --  operations to iterate.
   type Iterator_Bean is limited interface;
   type Iterator_Bean_Access is access all Iterator_Bean'Class;

   --  Get an iterator to iterate starting with the first element.
   function First (From : in Iterator_Bean) return Proxy_Iterator_Access is abstract;

   --  Get an iterator to iterate starting with the last element.
   function Last (From : in Iterator_Bean) return Proxy_Iterator_Access is abstract;

private

   type Iterator is new Controlled with record
      Iter : Proxy_Iterator_Access;
   end record;

   overriding
   procedure Adjust (Iter : in out Iterator);

   overriding
   procedure Finalize (Iter : in out Iterator);

   type Proxy_Iterator is abstract new Ada.Finalization.Limited_Controlled with record
      Ref_Counter : Util.Concurrent.Counters.Counter;
      Proxy       : Bean_Proxy_Access;
   end record;

   type Proxy_Map_Iterator is abstract new Proxy_Iterator with null record;

   package Iter is

      type Forward_Iterator is limited new Object_Iterator_Interfaces.Forward_Iterator with record
         Iter : Iterator;
      end record;

      overriding
      function First (Object : in Forward_Iterator) return Iterator;

      overriding
      function Next (Object : in Forward_Iterator;
                     Pos    : in Iterator) return Iterator;

   end Iter;

end Util.Beans.Objects.Iterators;

-----------------------------------------------------------------------
--  util-beans-objects-iterators -- Iterators for objects
--  Copyright (C) 2022 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.Finalization;
with Ada.Iterator_Interfaces;
with Util.Beans.Basic;

--  == Object iterator ==
--  Iterators are provided by the `Util.Beans.Objects.Iterators` package.
--  The iterator instance is created by using either the `First` or `Last`
--  function on the object to iterate.
--
--    with Util.Beans.Objects.Iterators;
--    ...
--       Iter : Util.Beans.Objects.Iterators.Iterator
--          := Util.Beans.Objects.Iterators.First (Object);
--
--  The iterator is used in conjunction with its `Has_Element` function
--  and either its `Next` or `Previous` procedure.  The current element
--  is obtained by using the `Element` function.  When the object being
--  iterated is a map, a key can be associated with the element and
--  is obtained by the `Key` function.
--
--    while Util.Beans.Objects.Iterators.Has_Element (Iter) loop
--       declare
--          Item : Object := Util.Beans.Objects.Iterators.Element (Iter);
--          Key  : String := Util.Beans.Objects.Iterators.Key (Iter);
--       begin
--          ...
--          Util.Beans.Objects.Iterators.Next (Iter);
--       end;
--    end loop;
--
package Util.Beans.Objects.Iterators is

   type Iterator is tagged private;

   --  Returns True if the iterator provides a key for each element.
   function Has_Key (Iter : in Iterator) return Boolean;

   --  Returns True if the iterator has an element.
   function Has_Element (Iter : in Iterator) return Boolean;

   --  Returns the current iterator element or Null_Object if it is empty.
   function Element (Iter : in Iterator) return Object;

   --  Returns the key associated with the current element.
   function Key (Iter : in Iterator) return String;

   --  Move the iterator to the next element.
   procedure Next (Iter : in out Iterator);

   --  Move the iterator to the previous element.
   procedure Previous (Iter : in out Iterator);

   --  Create an iterator to iterate from the first element.
   function First (Item : in Object) return Iterator;

   --  Create an iterator to iterate from the last element.
   function Last (Item : in Object) return Iterator;

   package Object_Iterator_Interfaces is
      new Ada.Iterator_Interfaces (Iterator, Has_Element);

   function Iterate (Item : in Object) return
            Object_Iterator_Interfaces.Forward_Iterator'Class;

   --  ------------------------------
   --  Proxy_Iterator
   --  ------------------------------
   --  The `Proxy_Iterator` is the base type for the implementation of an iterator.
   --  An instance is created by the `Iterator_Bean` interface.
   --  The `Porxy_Map_Iterator` extends the iterator to provide access to
   --  the key when the iterator gives access to the elements of a map.
   type Proxy_Iterator is abstract new Ada.Finalization.Limited_Controlled with private;
   type Proxy_Iterator_Access is access all Proxy_Iterator'Class;

   overriding
   procedure Finalize (Proxy : in out Proxy_Iterator);

   function Has_Element (Iter : in Proxy_Iterator) return Boolean is abstract;

   procedure Next (Iter : in out Proxy_Iterator) is abstract;

   procedure Previous (Iter : in out Proxy_Iterator) is abstract;

   function Element (Iter : in Proxy_Iterator) return Object is abstract;

   type Proxy_Map_Iterator is abstract new Proxy_Iterator with private;
   type Proxy_Map_Iterator_Access is access all Proxy_Map_Iterator'Class;

   function Key (Iter : in Proxy_Map_Iterator) return String is abstract;

   generic
      type T is limited new Util.Beans.Basic.Readonly_Bean with private;
      type T_Access is access all T'Class;
   function Get_Bean (Iter : in Proxy_Iterator'Class) return T_Access;

   --  ------------------------------
   --  Iterator
   --  ------------------------------
   --  The `Iterator_Bean` interface allows to create an iterator on the bean object
   --  to iterate over its internal values.  The `First` and `Last` function must
   --  create an instance of a `Proxy_Iterator` interface which provides the
   --  operations to iterate.
   type Iterator_Bean is limited interface;
   type Iterator_Bean_Access is access all Iterator_Bean'Class;

   --  Get an iterator to iterate starting with the first element.
   function First (From : in Iterator_Bean) return Proxy_Iterator_Access is abstract;

   --  Get an iterator to iterate starting with the last element.
   function Last (From : in Iterator_Bean) return Proxy_Iterator_Access is abstract;

private

   type Iterator is new Controlled with record
      Iter : Proxy_Iterator_Access;
   end record;

   overriding
   procedure Adjust (Iter : in out Iterator);

   overriding
   procedure Finalize (Iter : in out Iterator);

   type Proxy_Iterator is abstract new Ada.Finalization.Limited_Controlled with record
      Ref_Counter : Util.Concurrent.Counters.Counter;
      Proxy       : Bean_Proxy_Access;
   end record;

   type Proxy_Map_Iterator is abstract new Proxy_Iterator with null record;

   package Iter is

      type Forward_Iterator is limited new Object_Iterator_Interfaces.Forward_Iterator with record
         Iter : Iterator;
      end record;

      overriding
      function First (Object : in Forward_Iterator) return Iterator;

      overriding
      function Next (Object : in Forward_Iterator;
                     Pos    : in Iterator) return Iterator;

   end Iter;

end Util.Beans.Objects.Iterators;

Add missing with Util.Beans.Basic (problem not detected by GNAT 2021...)


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

with ASF.Server.Tests;
with ASF.Server.Web;

with ASF.Tests;

--  with AWA.Applications;
with AWA.Applications.Factory;
with AWA.Services.Filters;
with AWA.Services.Contexts;
package body AWA.Tests is

   protected Shutdown is
      procedure Termination (Cause : in Ada.Task_Termination.Cause_Of_Termination;
                             Id    : in Ada.Task_Identification.Task_Id;
                             Ex    : in Ada.Exceptions.Exception_Occurrence);
   end Shutdown;

   Application_Created : Boolean := False;
   Application    : AWA.Applications.Application_Access := null;

   Factory        : AWA.Applications.Factory.Application_Factory;

   Service_Filter : aliased AWA.Services.Filters.Service_Filter;

   protected body Shutdown is
      procedure Termination (Cause : in Ada.Task_Termination.Cause_Of_Termination;
                             Id    : in Ada.Task_Identification.Task_Id;
                             Ex    : in Ada.Exceptions.Exception_Occurrence) is
         pragma Unreferenced (Cause, Id, Ex);

         procedure Free is
            new Ada.Unchecked_Deallocation (Object => AWA.Applications.Application'Class,
                                            Name   => AWA.Applications.Application_Access);
      begin
         Free (Application);
      end Termination;
   end Shutdown;

   --  ------------------------------
   --  Setup the service context before executing the test.
   --  ------------------------------
   overriding
   procedure Set_Up (T : in out Test) is
      pragma Unreferenced (T);
   begin
      ASF.Server.Tests.Set_Context (Application.all'Access);
   end Set_Up;

   procedure Initialize (Props : in Util.Properties.Manager) is
   begin
      Initialize (null, Props, True);
   end Initialize;

   --  ------------------------------
   --  Called when the testsuite execution has finished.
   --  ------------------------------
   procedure Finish (Status : in Util.XUnit.Status) is
      pragma Unreferenced (Status);

      procedure Free is
        new Ada.Unchecked_Deallocation (Object => AWA.Applications.Application'Class,
                                        Name   => AWA.Applications.Application_Access);

   begin
      if Application_Created then
         Free (Application);
      end if;
   end Finish;

   --  ------------------------------
   --  Initialize the AWA test framework mockup.
   --  ------------------------------
   procedure Initialize (App         : in AWA.Applications.Application_Access;
                         Props       : in Util.Properties.Manager;
                         Add_Modules : in Boolean) is
      use AWA.Applications;
   begin
      --  Create the application unless it is specified as argument.
      --  Install a shutdown hook to delete the application when the primary task exits.
      --  This allows to stop the event threads if any.
      if App = null then
         Application_Created := True;
         Application := new AWA.Applications.Application;
         Ada.Task_Termination.Set_Specific_Handler (Ada.Task_Identification.Current_Task,
                                                    Shutdown.Termination'Access);
      else
         Application := App;
      end if;

      ASF.Tests.Initialize (Props, Application.all'Access, Factory);
      Application.Add_Filter ("service", Service_Filter'Access);
      Application.Add_Filter_Mapping (Name => "service", Pattern => "*.html");
   end Initialize;

   --  ------------------------------
   --  Get the test application.
   --  ------------------------------
   function Get_Application return AWA.Applications.Application_Access is
   begin
      return Application;
   end Get_Application;

   --  ------------------------------
   --  Set the application context to simulate a web request context.
   --  ------------------------------
   procedure Set_Application_Context is
   begin
      ASF.Server.Tests.Set_Context (Application.all'Access);
   end Set_Application_Context;

end AWA.Tests;

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

with ASF.Server.Tests;
with ASF.Server.Web;

with Util.Log.Loggers;

with ASF.Tests;

--  with AWA.Applications;
with AWA.Applications.Factory;
with AWA.Services.Filters;
with AWA.Services.Contexts;
package body AWA.Tests is

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

   protected Shutdown is
      procedure Termination (Cause : in Ada.Task_Termination.Cause_Of_Termination;
                             Id    : in Ada.Task_Identification.Task_Id;
                             Ex    : in Ada.Exceptions.Exception_Occurrence);
   end Shutdown;

   Application_Created : Boolean := False;
   Application    : AWA.Applications.Application_Access := null;

   Factory        : AWA.Applications.Factory.Application_Factory;

   Service_Filter : aliased AWA.Services.Filters.Service_Filter;

   protected body Shutdown is
      procedure Termination (Cause : in Ada.Task_Termination.Cause_Of_Termination;
                             Id    : in Ada.Task_Identification.Task_Id;
                             Ex    : in Ada.Exceptions.Exception_Occurrence) is
         pragma Unreferenced (Cause, Id, Ex);

         procedure Free is
            new Ada.Unchecked_Deallocation (Object => AWA.Applications.Application'Class,
                                            Name   => AWA.Applications.Application_Access);
      begin
         Free (Application);
      end Termination;
   end Shutdown;

   --  ------------------------------
   --  Setup the service context before executing the test.
   --  ------------------------------
   overriding
   procedure Set_Up (T : in out Test) is
   begin
      Log.Info ("Setup test {0}", T.Get_Name);

      ASF.Server.Tests.Set_Context (Application.all'Access);
   end Set_Up;

   procedure Initialize (Props : in Util.Properties.Manager) is
   begin
      Initialize (null, Props, True);
   end Initialize;

   --  ------------------------------
   --  Called when the testsuite execution has finished.
   --  ------------------------------
   procedure Finish (Status : in Util.XUnit.Status) is
      pragma Unreferenced (Status);

      procedure Free is
        new Ada.Unchecked_Deallocation (Object => AWA.Applications.Application'Class,
                                        Name   => AWA.Applications.Application_Access);

   begin
      if Application_Created then
         Free (Application);
      end if;
   end Finish;

   --  ------------------------------
   --  Initialize the AWA test framework mockup.
   --  ------------------------------
   procedure Initialize (App         : in AWA.Applications.Application_Access;
                         Props       : in Util.Properties.Manager;
                         Add_Modules : in Boolean) is
      use AWA.Applications;
   begin
      --  Create the application unless it is specified as argument.
      --  Install a shutdown hook to delete the application when the primary task exits.
      --  This allows to stop the event threads if any.
      if App = null then
         Application_Created := True;
         Application := new AWA.Applications.Application;
         Ada.Task_Termination.Set_Specific_Handler (Ada.Task_Identification.Current_Task,
                                                    Shutdown.Termination'Access);
      else
         Application := App;
      end if;

      ASF.Tests.Initialize (Props, Application.all'Access, Factory);
      Application.Add_Filter ("service", Service_Filter'Access);
      Application.Add_Filter_Mapping (Name => "service", Pattern => "*.html");
   end Initialize;

   --  ------------------------------
   --  Get the test application.
   --  ------------------------------
   function Get_Application return AWA.Applications.Application_Access is
   begin
      return Application;
   end Get_Application;

   --  ------------------------------
   --  Set the application context to simulate a web request context.
   --  ------------------------------
   procedure Set_Application_Context is
   begin
      ASF.Server.Tests.Set_Context (Application.all'Access);
   end Set_Application_Context;

end AWA.Tests;

Add a log message to help in trouble shotting unit tests


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

package Druss.Commands.Wifi is

   type Command_Type is new Druss.Commands.Drivers.Command_Type with null record;

   --  Enable or disable with wifi radio.
   procedure Do_Enable (Command   : in Command_Type;
                        Args      : in Argument_List'Class;
                        Context   : in out Context_Type);

   --  Execute the wifi 'status' command to print the Wifi current status.
   procedure Do_Status (Command   : in Command_Type;
                        Args      : in Argument_List'Class;
                        Context   : in out Context_Type);

   --  Execute a command to control or get status about the Wifi.
   overriding
   procedure Execute (Command   : in out Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type);

   --  Write the help associated with the command.
   overriding
   procedure Help (Command   : in Command_Type;
                   Context   : in out Context_Type);

end Druss.Commands.Wifi;

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

package Druss.Commands.Wifi is

   type Command_Type is new Druss.Commands.Drivers.Command_Type with null record;

   --  Enable or disable with wifi radio.
   procedure Do_Enable (Command   : in Command_Type;
                        Args      : in Argument_List'Class;
                        Context   : in out Context_Type);

   --  Execute the wifi 'status' command to print the Wifi current status.
   procedure Do_Status (Command   : in Command_Type;
                        Args      : in Argument_List'Class;
                        Context   : in out Context_Type);

   --  Execute a command to control or get status about the Wifi.
   overriding
   procedure Execute (Command   : in out Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type);

   --  Write the help associated with the command.
   overriding
   procedure Help (Command   : in out Command_Type;
                   Context   : in out Context_Type);

end Druss.Commands.Wifi;

Change Help command to accept in out command


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

with ASF.Applications;

with ADO;
with AWA.Modules;
with AWA.Blogs.Models;
with AWA.Counters.Definition;

with Security.Permissions;

--  == Integration ==
--  The <tt>Blog_Module</tt> manages the creation, update, removal of blog posts in an application.
--  It provides operations that are used by the blog beans or other services to create and update
--  posts.  An instance of the <tt>Blog_Module</tt> must be declared and registered in the
--  AWA application.  The module instance can be defined as follows:
--
--    type Application is new AWA.Applications.Application with record
--       Blog_Module : aliased AWA.Blogs.Modules.Blog_Module;
--    end record;
--
--  And registered in the `Initialize_Modules` procedure by using:
--
--    Register (App    => App.Self.all'Access,
--              Name   => AWA.Blogs.Modules.NAME,
--              URI    => "blogs",
--              Module => App.Blog_Module'Access);
--
package AWA.Blogs.Modules is

   NAME : constant String := "blogs";

   --  Define the permissions.
   package ACL_Create_Blog is new Security.Permissions.Definition ("blog-create");
   package ACL_Delete_Blog is new Security.Permissions.Definition ("blog-delete");
   package ACL_Create_Post is new Security.Permissions.Definition ("blog-create-post");
   package ACL_Delete_Post is new Security.Permissions.Definition ("blog-delete-post");
   package ACL_Update_Post is new Security.Permissions.Definition ("blog-update-post");

   --  Define the read post counter.
   package Read_Counter is new AWA.Counters.Definition (Models.POST_TABLE, "read_count");

   Not_Found : exception;

   type Blog_Module is new AWA.Modules.Module with private;
   type Blog_Module_Access is access all Blog_Module'Class;

   --  Initialize the blog module.
   overriding
   procedure Initialize (Plugin : in out Blog_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config);

   --  Get the blog module instance associated with the current application.
   function Get_Blog_Module return Blog_Module_Access;

   --  Create a new blog for the user workspace.
   procedure Create_Blog (Model        : in Blog_Module;
                          Workspace_Id : in ADO.Identifier;
                          Title        : in String;
                          Result       : out ADO.Identifier);

   --  Create a new post associated with the given blog identifier.
   procedure Create_Post (Model   : in Blog_Module;
                          Blog_Id : in ADO.Identifier;
                          Title   : in String;
                          URI     : in String;
                          Text    : in String;
                          Comment : in Boolean;
                          Status  : in AWA.Blogs.Models.Post_Status_Type;
                          Result  : out ADO.Identifier);

   --  Update the post title and text associated with the blog post identified by <b>Post</b>.
   procedure Update_Post (Model   : in Blog_Module;
                          Post_Id : in ADO.Identifier;
                          Title   : in String;
                          URI     : in String;
                          Text    : in String;
                          Comment : in Boolean;
                          Status  : in AWA.Blogs.Models.Post_Status_Type);

   --  Delete the post identified by the given identifier.
   procedure Delete_Post (Model   : in Blog_Module;
                          Post_Id : in ADO.Identifier);

private

   type Blog_Module is new AWA.Modules.Module with null record;

end AWA.Blogs.Modules;

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

with ASF.Applications;

with ADO;
with AWA.Modules;
with AWA.Blogs.Models;
with AWA.Counters.Definition;

with Security.Permissions;

--  == Integration ==
--  The <tt>Blog_Module</tt> manages the creation, update, removal of blog posts in an application.
--  It provides operations that are used by the blog beans or other services to create and update
--  posts.  An instance of the <tt>Blog_Module</tt> must be declared and registered in the
--  AWA application.  The module instance can be defined as follows:
--
--    type Application is new AWA.Applications.Application with record
--       Blog_Module : aliased AWA.Blogs.Modules.Blog_Module;
--    end record;
--
--  And registered in the `Initialize_Modules` procedure by using:
--
--    Register (App    => App.Self.all'Access,
--              Name   => AWA.Blogs.Modules.NAME,
--              URI    => "blogs",
--              Module => App.Blog_Module'Access);
--
package AWA.Blogs.Modules is

   NAME : constant String := "blogs";

   --  Define the permissions.
   package ACL_Create_Blog is new Security.Permissions.Definition ("blog-create");
   package ACL_Delete_Blog is new Security.Permissions.Definition ("blog-delete");
   package ACL_Create_Post is new Security.Permissions.Definition ("blog-create-post");
   package ACL_Delete_Post is new Security.Permissions.Definition ("blog-delete-post");
   package ACL_Update_Post is new Security.Permissions.Definition ("blog-update-post");

   --  Define the read post counter.
   package Read_Counter is new AWA.Counters.Definition (Models.POST_TABLE, "read_count");

   Not_Found : exception;

   type Blog_Module is new AWA.Modules.Module with private;
   type Blog_Module_Access is access all Blog_Module'Class;

   --  Initialize the blog module.
   overriding
   procedure Initialize (Plugin : in out Blog_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config);

   --  Get the blog module instance associated with the current application.
   function Get_Blog_Module return Blog_Module_Access;

   --  Create a new blog for the user workspace.
   procedure Create_Blog (Model        : in Blog_Module;
                          Title        : in String;
                          Result       : out ADO.Identifier);

   --  Create a new post associated with the given blog identifier.
   procedure Create_Post (Model   : in Blog_Module;
                          Blog_Id : in ADO.Identifier;
                          Title   : in String;
                          URI     : in String;
                          Text    : in String;
                          Comment : in Boolean;
                          Status  : in AWA.Blogs.Models.Post_Status_Type;
                          Result  : out ADO.Identifier);

   --  Update the post title and text associated with the blog post identified by <b>Post</b>.
   procedure Update_Post (Model   : in Blog_Module;
                          Post_Id : in ADO.Identifier;
                          Title   : in String;
                          URI     : in String;
                          Text    : in String;
                          Comment : in Boolean;
                          Status  : in AWA.Blogs.Models.Post_Status_Type);

   --  Delete the post identified by the given identifier.
   procedure Delete_Post (Model   : in Blog_Module;
                          Post_Id : in ADO.Identifier);

private

   type Blog_Module is new AWA.Modules.Module with null record;

end AWA.Blogs.Modules;

Remove the Workspace_Id parameter for the Create_Blog procedure because we don't use it