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

with Security.Permissions;
with Security.Policies;

with Util.Serialize.IO.XML;

with ADO;
with ADO.Objects;

--  == Introduction ==
--  The *AWA.Permissions* framework defines and controls the permissions used by an application
--  to verify and grant access to the data and application service.  The framework provides a
--  set of services and API that helps an application in enforcing its specific permissions.
--  Permissions are verified by a permission controller which uses the service context to
--  have information about the user and other context.  The framework allows to use different
--  kinds of permission controllers.  The `Entity_Controller` is the default permission
--  controller which uses the database and an XML configuration to verify a permission.
--
--  === Declaration ===
--  To be used in the application, the first step is to declare the permission.
--  This is a static definition of the permission that will be used to ask to verify the
--  permission.  The permission is given a unique name that will be used in configuration files:
--
--    package ACL_Create_Post is new Security.Permissions.Definition ("blog-create-post");
--
--  === Checking for a permission ===
--  A permission can be checked in Ada as well as in the presentation pages.
--  This is done by using the `Check` procedure and the permission definition.  This operation
--  acts as a barrier: it does not return anything but returns normally if the permission is
--  granted.  If the permission is denied, it raises the `NO_PERMISSION` exception.
--
--  Several `Check` operation exists.  Some require not argument and some others need a context
--  such as some entity identifier to perform the check.
--
--    AWA.Permissions.Check (Permission => ACL_Create_Post.Permission,
--                           Entity     => Blog_Id);
--
--  === Configuring a permission ===
--  The *AWA.Permissions* framework supports a simple permission model
--  The application configuration file must provide some information to help in checking the
--  permission.  The permission name is referenced by the `name` XML entity.  The `entity-type`
--  refers to the database entity (ie, the table) that the permission concerns.
--  The `sql` XML entity represents the SQL statement that must be used to verify the permission.
--
--    <entity-permission>
--      <name>blog-create-post</name>
--      <entity-type>blog</entity-type>
--      <description>Permission to create a new post.</description>
--      <sql>
--        SELECT acl.id FROM acl
--        WHERE acl.entity_type = :entity_type
--        AND acl.user_id = :user_id
--        AND acl.entity_id = :entity_id
--      </sql>
--    </entity-permission>
--
--  === Adding a permission ===
--  Adding a permission means to create an `ACL` database record that links a given database
--  entity to the user.  This is done easily with the `Add_Permission` procedure:
--
--    AWA.Permissions.Services.Add_Permission (Session => DB,
--                                             User    => User,
--                                             Entity  => Blog);
--
--  == Data Model ==
--  @include Permission.hbm.xml
--
--  == Queries ==
--  @include permissions.xml
--
package AWA.Permissions is

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

   --  Exception raised by the Check procedure if the user does not have
   --  the permission.
   NO_PERMISSION : exception;

   --  Maximum number of entity types that can be defined in the XML entity-permission.
   --  Most permission need only one entity type.  Keep that number small.
   MAX_ENTITY_TYPES : constant Positive := 5;

   type Entity_Type_Array is array (1 .. MAX_ENTITY_TYPES) of ADO.Entity_Type;

   type Permission_Type is (READ, WRITE);

   type Entity_Permission is new Security.Permissions.Permission with private;

   --  Verify that the permission represented by Permission is granted.
   --
   procedure Check (Permission : in Security.Permissions.Permission_Index);

   --  Verify that the permission represented by Permission is granted to access the
   --  database entity represented by Entity.
   procedure Check (Permission : in Security.Permissions.Permission_Index;
                    Entity     : in ADO.Identifier);

   --  Verify that the permission represented by Permission is granted to access the
   --  database entity represented by Entity.
   procedure Check (Permission : in Security.Permissions.Permission_Index;
                    Entity     : in ADO.Objects.Object_Ref'Class);

private

   type Entity_Permission is new Security.Permissions.Permission with record
      Entity : ADO.Identifier;
   end record;

   type Entity_Policy is new Security.Policies.Policy with null record;
   type Entity_Policy_Access is access all Entity_Policy'Class;

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

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

end AWA.Permissions;

-----------------------------------------------------------------------
--  awa-permissions -- Permissions 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 Security.Permissions;
with Security.Policies;

with Util.Serialize.IO.XML;

with ADO;
with ADO.Objects;

--  == Introduction ==
--  The *AWA.Permissions* framework defines and controls the permissions used by an application
--  to verify and grant access to the data and application service.  The framework provides a
--  set of services and API that helps an application in enforcing its specific permissions.
--  Permissions are verified by a permission controller which uses the service context to
--  have information about the user and other context.  The framework allows to use different
--  kinds of permission controllers.  The `Entity_Controller` is the default permission
--  controller which uses the database and an XML configuration to verify a permission.
--
--  === Declaration ===
--  To be used in the application, the first step is to declare the permission.
--  This is a static definition of the permission that will be used to ask to verify the
--  permission.  The permission is given a unique name that will be used in configuration files:
--
--    package ACL_Create_Post is new Security.Permissions.Definition ("blog-create-post");
--
--  === Checking for a permission ===
--  A permission can be checked in Ada as well as in the presentation pages.
--  This is done by using the `Check` procedure and the permission definition.  This operation
--  acts as a barrier: it does not return anything but returns normally if the permission is
--  granted.  If the permission is denied, it raises the `NO_PERMISSION` exception.
--
--  Several `Check` operation exists.  Some require no argument and some others need a context
--  such as some entity identifier to perform the check.
--
--    AWA.Permissions.Check (Permission => ACL_Create_Post.Permission,
--                           Entity     => Blog_Id);
--
--  === Configuring a permission ===
--  The *AWA.Permissions* framework supports a simple permission model
--  The application configuration file must provide some information to help in checking the
--  permission.  The permission name is referenced by the `name` XML entity.  The `entity-type`
--  refers to the database entity (ie, the table) that the permission concerns.
--  The `sql` XML entity represents the SQL statement that must be used to verify the permission.
--
--    <entity-permission>
--      <name>blog-create-post</name>
--      <entity-type>blog</entity-type>
--      <description>Permission to create a new post.</description>
--      <sql>
--        SELECT acl.id FROM acl
--        WHERE acl.entity_type = :entity_type
--        AND acl.user_id = :user_id
--        AND acl.entity_id = :entity_id
--      </sql>
--    </entity-permission>
--
--  === Adding a permission ===
--  Adding a permission means to create an `ACL` database record that links a given database
--  entity to the user.  This is done easily with the `Add_Permission` procedure:
--
--    AWA.Permissions.Services.Add_Permission (Session => DB,
--                                             User    => User,
--                                             Entity  => Blog);
--
--  == Data Model ==
--  @include Permission.hbm.xml
--
--  == Queries ==
--  @include permissions.xml
--
package AWA.Permissions is

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

   --  Exception raised by the Check procedure if the user does not have
   --  the permission.
   NO_PERMISSION : exception;

   --  Maximum number of entity types that can be defined in the XML entity-permission.
   --  Most permission need only one entity type.  Keep that number small.
   MAX_ENTITY_TYPES : constant Positive := 5;

   type Entity_Type_Array is array (1 .. MAX_ENTITY_TYPES) of ADO.Entity_Type;

   type Permission_Type is (READ, WRITE);

   type Entity_Permission is new Security.Permissions.Permission with private;

   --  Verify that the permission represented by Permission is granted.
   --
   procedure Check (Permission : in Security.Permissions.Permission_Index);

   --  Verify that the permission represented by Permission is granted to access the
   --  database entity represented by Entity.
   procedure Check (Permission : in Security.Permissions.Permission_Index;
                    Entity     : in ADO.Identifier);

   --  Verify that the permission represented by Permission is granted to access the
   --  database entity represented by Entity.
   procedure Check (Permission : in Security.Permissions.Permission_Index;
                    Entity     : in ADO.Objects.Object_Ref'Class);

private

   type Entity_Permission is new Security.Permissions.Permission with record
      Entity : ADO.Identifier;
   end record;

   type Entity_Policy is new Security.Policies.Policy with null record;
   type Entity_Policy_Access is access all Entity_Policy'Class;

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

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

end AWA.Permissions;

Fix typo in documentation

Fix typo in documentation


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

with AWS.Session;
with AWS.Messages;
with AWS.Templates;
with AWS.Services.Web_Block.Registry;

with Util.Log.Loggers;
package body Auth_CB is

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

   --  Name of the session attribute which holds information about the active authentication.
   OPENID_ASSOC_ATTRIBUTE : constant String := "openid-assoc";

   USER_INFO_ATTRIBUTE    : constant String := "user-info";

   Null_Association : Security.Auth.Association;
   Null_Auth        : Security.Auth.Authentication;

   package Auth_Session is
     new AWS.Session.Generic_Data (Security.Auth.Association, Null_Association);

   package User_Session is
     new AWS.Session.Generic_Data (Security.Auth.Authentication, Null_Auth);

   function Get_Auth_Name (Request : in AWS.Status.Data) return String;

   overriding
   function Get_Parameter (Params : in Auth_Config;
                           Name   : in String) return String is
   begin
      if Params.Exists (Name) then
         return Params.Get (Name);
      else
         return "";
      end if;
   end Get_Parameter;

   function Get_Auth_Name (Request : in AWS.Status.Data) return String is
      URI  : constant String := AWS.Status.URI (Request);
      Pos  : constant Natural := Ada.Strings.Fixed.Index (URI, "/", Ada.Strings.Backward);
   begin
      if Pos = 0 then
         return "";
      else
         Log.Info ("OpenID authentication with {0}", URI);
         return URI (Pos + 1 .. URI'Last);
      end if;
   end Get_Auth_Name;

   --  ------------------------------
   --  Implement the first step of authentication: discover the OpenID (if any) provider,
   --  create the authorization request and redirect the user to the authorization server.
   --  Some authorization data is saved in the session for the verify process.
   --  ------------------------------
   function Get_Authorization (Request : in AWS.Status.Data) return AWS.Response.Data is
      Name     : constant String := Get_Auth_Name (Request);
      URL      : constant String := Config.Get_Parameter ("auth.url." & Name);
      Mgr      : Security.Auth.Manager;
      OP       : Security.Auth.End_Point;
      Assoc    : Security.Auth.Association;
   begin
      if URL'Length = 0 or Name'Length = 0 then
         return AWS.Response.URL (Location => "/login.html");
      end if;

      Mgr.Initialize (Config, Name);

      --  Yadis discovery (get the XRDS file).  This step does nothing for OAuth.
      Mgr.Discover (URL, OP);

      --  Associate to the OpenID provider and get an end-point with a key.
      Mgr.Associate (OP, Assoc);

      --  Save the association in the HTTP session and
      --  redirect the user to the OpenID provider.
      declare
         Auth_URL : constant String := Mgr.Get_Authentication_URL (OP, Assoc);
         SID      : constant AWS.Session.Id := AWS.Status.Session (Request);
      begin
         Log.Info ("Redirect to auth URL: {0}", Auth_URL);

         Auth_Session.Set (SID, OPENID_ASSOC_ATTRIBUTE, Assoc);
         return AWS.Response.URL (Location => Auth_URL);
      end;
   end Get_Authorization;

   --  ------------------------------
   --  Second step of authentication: verify the authorization response.  The authorization
   --  data saved in the session is extracted and checked against the response.  If it matches
   --  the response is verified to check if the authentication succeeded or not.
   --  The user is then redirected to the success page.
   --  ------------------------------
   function Verify_Authorization (Request : in AWS.Status.Data) return AWS.Response.Data is

      use type Security.Auth.Auth_Result;

      --  Give access to the request parameters.
      type Auth_Params is limited new Security.Auth.Parameters with null record;

      overriding
      function Get_Parameter (Params : in Auth_Params;
                              Name   : in String) return String;

      overriding
      function Get_Parameter (Params : in Auth_Params;
                              Name   : in String) return String is
         pragma Unreferenced (Params);
      begin
         return AWS.Status.Parameter (Request, Name);
      end Get_Parameter;

      Mgr        : Security.Auth.Manager;
      Assoc      : Security.Auth.Association;
      Credential : Security.Auth.Authentication;
      Params     : Auth_Params;
      SID        : constant AWS.Session.Id := AWS.Status.Session (Request);
   begin
      Log.Info ("Verify openid authentication");

      if not AWS.Session.Exist (SID, OPENID_ASSOC_ATTRIBUTE) then
         Log.Warn ("Session has expired during OpenID authentication process");
         return AWS.Response.Build ("text/html", "Session has expired", AWS.Messages.S403);
      end if;

      Assoc := Auth_Session.Get (SID, OPENID_ASSOC_ATTRIBUTE);

      --  Cleanup the session and drop the association end point.
      AWS.Session.Remove (SID, OPENID_ASSOC_ATTRIBUTE);

      Mgr.Initialize (Name   => Security.Auth.Get_Provider (Assoc),
                      Params => Config);

      --  Verify that what we receive through the callback matches the association key.
      Mgr.Verify (Assoc, Params, Credential);
      if Security.Auth.Get_Status (Credential) /= Security.Auth.AUTHENTICATED then
         Log.Info ("Authentication has failed");
         return AWS.Response.Build ("text/html", "Authentication failed", AWS.Messages.S403);
      end if;

      Log.Info ("Authentication succeeded for {0}", Security.Auth.Get_Email (Credential));

      Log.Info ("Claimed id: {0}", Security.Auth.Get_Claimed_Id (Credential));
      Log.Info ("Email:      {0}", Security.Auth.Get_Email (Credential));
      Log.Info ("Name:       {0}", Security.Auth.Get_Full_Name (Credential));

      --  Save the user information in the session (for the purpose of this demo).
      User_Session.Set (SID, USER_INFO_ATTRIBUTE, Credential);

      declare
         URL  : constant String := Config.Get_Parameter ("openid.success_url");
      begin
         Log.Info ("Redirect user to success URL: {0}", URL);

         return AWS.Response.URL (Location => URL);
      end;
   end Verify_Authorization;

   function User_Info (Request : in AWS.Status.Data) return AWS.Response.Data is
      SID        : constant AWS.Session.Id := AWS.Status.Session (Request);
      Credential : Security.Auth.Authentication;
      Set        : AWS.Templates.Translate_Set;
   begin
      if AWS.Session.Exist (SID, USER_INFO_ATTRIBUTE) then
         Credential := User_Session.Get (SID, USER_INFO_ATTRIBUTE);
         AWS.Templates.Insert (Set,
           AWS.Templates.Assoc ("ID",
             Security.Auth.Get_Claimed_Id (Credential)));
         AWS.Templates.Insert (Set, AWS.Templates.Assoc ("EMAIL",
           Security.Auth.Get_Email (Credential)));
         AWS.Templates.Insert (Set, AWS.Templates.Assoc ("NAME",
           Security.Auth.Get_Full_Name (Credential)));
      end if;
      return AWS.Services.Web_Block.Registry.Build ("success", Request, Set);
   end User_Info;

end Auth_CB;

-----------------------------------------------------------------------
--  auth_cb -- Authentication callback examples
--  Copyright (C) 2013, 2020, 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.Strings.Fixed;

with AWS.Session;
with AWS.Messages;
with AWS.Templates;
with AWS.Services.Web_Block.Registry;

with Util.Log.Loggers;
package body Auth_CB is

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

   --  Name of the session attribute which holds information about the active authentication.
   OPENID_ASSOC_ATTRIBUTE : constant String := "openid-assoc";

   USER_INFO_ATTRIBUTE    : constant String := "user-info";

   Null_Association : Security.Auth.Association;
   Null_Auth        : Security.Auth.Authentication;

   package Auth_Session is
     new AWS.Session.Generic_Data (Security.Auth.Association, Null_Association);

   package User_Session is
     new AWS.Session.Generic_Data (Security.Auth.Authentication, Null_Auth);

   function Get_Auth_Name (Request : in AWS.Status.Data) return String;

   overriding
   function Get_Parameter (Params : in Auth_Config;
                           Name   : in String) return String is
   begin
      if Params.Exists (Name) then
         return Params.Get (Name);
      else
         return "";
      end if;
   end Get_Parameter;

   function Get_Auth_Name (Request : in AWS.Status.Data) return String is
      URI  : constant String := AWS.Status.URI (Request);
      Pos  : constant Natural := Ada.Strings.Fixed.Index (URI, "/", Ada.Strings.Backward);
   begin
      if Pos = 0 then
         return "";
      else
         Log.Info ("OpenID authentication with {0}", URI);
         return URI (Pos + 1 .. URI'Last);
      end if;
   end Get_Auth_Name;

   --  ------------------------------
   --  Implement the first step of authentication: discover the OpenID (if any) provider,
   --  create the authorization request and redirect the user to the authorization server.
   --  Some authorization data is saved in the session for the verify process.
   --  ------------------------------
   function Get_Authorization (Request : in AWS.Status.Data) return AWS.Response.Data is
      Name     : constant String := Get_Auth_Name (Request);
      URL      : constant String := Config.Get_Parameter ("auth.url." & Name);
      Mgr      : Security.Auth.Manager;
      OP       : Security.Auth.End_Point;
      Assoc    : Security.Auth.Association;
   begin
      if URL'Length = 0 or else Name'Length = 0 then
         return AWS.Response.URL (Location => "/login.html");
      end if;

      Mgr.Initialize (Config, Name);

      --  Yadis discovery (get the XRDS file).  This step does nothing for OAuth.
      Mgr.Discover (URL, OP);

      --  Associate to the OpenID provider and get an end-point with a key.
      Mgr.Associate (OP, Assoc);

      --  Save the association in the HTTP session and
      --  redirect the user to the OpenID provider.
      declare
         Auth_URL : constant String := Mgr.Get_Authentication_URL (OP, Assoc);
         SID      : constant AWS.Session.Id := AWS.Status.Session (Request);
      begin
         Log.Info ("Redirect to auth URL: {0}", Auth_URL);

         Auth_Session.Set (SID, OPENID_ASSOC_ATTRIBUTE, Assoc);
         return AWS.Response.URL (Location => Auth_URL);
      end;
   end Get_Authorization;

   --  ------------------------------
   --  Second step of authentication: verify the authorization response.  The authorization
   --  data saved in the session is extracted and checked against the response.  If it matches
   --  the response is verified to check if the authentication succeeded or not.
   --  The user is then redirected to the success page.
   --  ------------------------------
   function Verify_Authorization (Request : in AWS.Status.Data) return AWS.Response.Data is

      use type Security.Auth.Auth_Result;

      --  Give access to the request parameters.
      type Auth_Params is limited new Security.Auth.Parameters with null record;

      overriding
      function Get_Parameter (Params : in Auth_Params;
                              Name   : in String) return String;

      overriding
      function Get_Parameter (Params : in Auth_Params;
                              Name   : in String) return String is
         pragma Unreferenced (Params);
      begin
         return AWS.Status.Parameter (Request, Name);
      end Get_Parameter;

      Mgr        : Security.Auth.Manager;
      Assoc      : Security.Auth.Association;
      Credential : Security.Auth.Authentication;
      Params     : Auth_Params;
      SID        : constant AWS.Session.Id := AWS.Status.Session (Request);
   begin
      Log.Info ("Verify openid authentication");

      if not AWS.Session.Exist (SID, OPENID_ASSOC_ATTRIBUTE) then
         Log.Warn ("Session has expired during OpenID authentication process");
         return AWS.Response.Build ("text/html", "Session has expired", AWS.Messages.S403);
      end if;

      Assoc := Auth_Session.Get (SID, OPENID_ASSOC_ATTRIBUTE);

      --  Cleanup the session and drop the association end point.
      AWS.Session.Remove (SID, OPENID_ASSOC_ATTRIBUTE);

      Mgr.Initialize (Name   => Security.Auth.Get_Provider (Assoc),
                      Params => Config);

      --  Verify that what we receive through the callback matches the association key.
      Mgr.Verify (Assoc, Params, Credential);
      if Security.Auth.Get_Status (Credential) /= Security.Auth.AUTHENTICATED then
         Log.Info ("Authentication has failed");
         return AWS.Response.Build ("text/html", "Authentication failed", AWS.Messages.S403);
      end if;

      Log.Info ("Authentication succeeded for {0}", Security.Auth.Get_Email (Credential));

      Log.Info ("Claimed id: {0}", Security.Auth.Get_Claimed_Id (Credential));
      Log.Info ("Email:      {0}", Security.Auth.Get_Email (Credential));
      Log.Info ("Name:       {0}", Security.Auth.Get_Full_Name (Credential));

      --  Save the user information in the session (for the purpose of this demo).
      User_Session.Set (SID, USER_INFO_ATTRIBUTE, Credential);

      declare
         URL  : constant String := Config.Get_Parameter ("openid.success_url");
      begin
         Log.Info ("Redirect user to success URL: {0}", URL);

         return AWS.Response.URL (Location => URL);
      end;
   end Verify_Authorization;

   function User_Info (Request : in AWS.Status.Data) return AWS.Response.Data is
      SID        : constant AWS.Session.Id := AWS.Status.Session (Request);
      Credential : Security.Auth.Authentication;
      Set        : AWS.Templates.Translate_Set;
   begin
      if AWS.Session.Exist (SID, USER_INFO_ATTRIBUTE) then
         Credential := User_Session.Get (SID, USER_INFO_ATTRIBUTE);
         AWS.Templates.Insert (Set,
           AWS.Templates.Assoc ("ID",
             Security.Auth.Get_Claimed_Id (Credential)));
         AWS.Templates.Insert (Set, AWS.Templates.Assoc ("EMAIL",
           Security.Auth.Get_Email (Credential)));
         AWS.Templates.Insert (Set, AWS.Templates.Assoc ("NAME",
           Security.Auth.Get_Full_Name (Credential)));
      end if;
      return AWS.Services.Web_Block.Registry.Build ("success", Request, Set);
   end User_Info;

end Auth_CB;

Fix style warnings: add missing overriding and update and then/or else conditions


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

with ADO;
with AWA.Users.Models;
with ASF.Principals;
with Security.Permissions;
package AWA.Users.Principals is

   type Principal is new ASF.Principals.Principal with private;
   type Principal_Access is access all Principal'Class;

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

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

   --  Get the principal identifier (name)
   function Get_Id (From : in Principal) return String;

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

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

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

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

   --  Create a principal for the given user.
   function Create (User    : in AWA.Users.Models.User_Ref;
                    Session : in AWA.Users.Models.Session_Ref) return Principal_Access;

   --  Utility functions based on the security principal access type.

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

private

   type Principal is new ASF.Principals.Principal with record
      User        : AWA.Users.Models.User_Ref;
      Session     : AWA.Users.Models.Session_Ref;
      Roles       : Security.Permissions.Role_Map;
   end record;

end AWA.Users.Principals;

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

with ADO;
with AWA.Users.Models;
with ASF.Principals;
with Security.Permissions;
package AWA.Users.Principals is

   type Principal is new ASF.Principals.Principal with private;
   type Principal_Access is access all Principal'Class;

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

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

   --  Get the principal identifier (name)
   function Get_Id (From : in Principal) return String;

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

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

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

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

   --  Create a principal for the given user.
   function Create (User    : in AWA.Users.Models.User_Ref;
                    Session : in AWA.Users.Models.Session_Ref) return Principal_Access;

   --  Utility functions based on the security principal access type.

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

private

   type Principal is new ASF.Principals.Principal with record
      User        : AWA.Users.Models.User_Ref;
      Session     : AWA.Users.Models.Session_Ref;
--        Roles       : Security.Permissions.Role_Map;
   end record;

end AWA.Users.Principals;

Remove the Role_Map from the user principal


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

with Util.Log.Loggers;
with Util.Test_Caller;
with Util.Files;
with Util.Strings.Vectors;
with Util.Streams.Pipes;
with Util.Streams.Buffered;
with Util.Streams.Texts;
with Util.Processes.Tools;
package body Util.Processes.Tests is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Util.Processes.Tests");

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Processes.Is_Running",
                       Test_No_Process'Access);
      Caller.Add_Test (Suite, "Test Util.Processes.Spawn/Wait/Get_Exit_Status",
                       Test_Spawn'Access);
      Caller.Add_Test (Suite, "Test Util.Processes.Spawn(READ pipe)",
                       Test_Output_Pipe'Access);
      Caller.Add_Test (Suite, "Test Util.Processes.Spawn(WRITE pipe)",
                       Test_Input_Pipe'Access);
      Caller.Add_Test (Suite, "Test Util.Processes.Spawn/Shell(WRITE pipe)",
                       Test_Shell_Splitting_Pipe'Access);
      Caller.Add_Test (Suite, "Test Util.Processes.Spawn(OUTPUT redirect)",
                       Test_Output_Redirect'Access);
      Caller.Add_Test (Suite, "Test Util.Processes.Spawn(INPUT redirect)",
                       Test_Input_Redirect'Access);
      Caller.Add_Test (Suite, "Test Util.Streams.Pipes.Open/Read/Close (Multi spawn)",
                       Test_Multi_Spawn'Access);
      Caller.Add_Test (Suite, "Test Util.Processes.Tools.Execute",
                       Test_Tools_Execute'Access);

   end Add_Tests;

   --  ------------------------------
   --  Tests when the process is not launched
   --  ------------------------------
   procedure Test_No_Process (T : in out Test) is
      P : Process;
   begin
      T.Assert (not P.Is_Running, "Process should not be running");
      T.Assert (P.Get_Pid < 0, "Invalid process id");
   end Test_No_Process;

   --  ------------------------------
   --  Test executing a process
   --  ------------------------------
   procedure Test_Spawn (T : in out Test) is
      P : Process;
   begin
      --  Launch the test process => exit code 2
      P.Spawn ("bin/util_test_process");
      T.Assert (P.Is_Running, "Process is running");
      P.Wait;
      T.Assert (not P.Is_Running, "Process has stopped");
      T.Assert (P.Get_Pid > 0, "Invalid process id");
      Util.Tests.Assert_Equals (T, 2, P.Get_Exit_Status, "Invalid exit status");

      --  Launch the test process => exit code 0
      P.Spawn ("bin/util_test_process 0 write b c d e f");
      T.Assert (P.Is_Running, "Process is running");
      P.Wait;
      T.Assert (not P.Is_Running, "Process has stopped");
      T.Assert (P.Get_Pid > 0, "Invalid process id");
      Util.Tests.Assert_Equals (T, 0, P.Get_Exit_Status, "Invalid exit status");
   end Test_Spawn;

   --  ------------------------------
   --  Test output pipe redirection: read the process standard output
   --  ------------------------------
   procedure Test_Output_Pipe (T : in out Test) is
      P : aliased Util.Streams.Pipes.Pipe_Stream;
   begin
      P.Open ("bin/util_test_process 0 write b c d e f test_marker");
      declare
         Buffer  : Util.Streams.Buffered.Input_Buffer_Stream;
         Content : Ada.Strings.Unbounded.Unbounded_String;
      begin
         Buffer.Initialize (P'Unchecked_Access, 19);
         Buffer.Read (Content);
         P.Close;
         Util.Tests.Assert_Matches (T, "b\s+c\s+d\s+e\s+f\s+test_marker\s+", Content,
                                    "Invalid content");
      end;
      T.Assert (not P.Is_Running, "Process has stopped");
      Util.Tests.Assert_Equals (T, 0, P.Get_Exit_Status, "Invalid exit status");
   end Test_Output_Pipe;

   --  ------------------------------
   --  Test shell splitting.
   --  ------------------------------
   procedure Test_Shell_Splitting_Pipe (T : in out Test) is
      P : aliased Util.Streams.Pipes.Pipe_Stream;
   begin
      P.Open ("bin/util_test_process 0 write ""b c d e f"" test_marker");
      declare
         Buffer  : Util.Streams.Buffered.Input_Buffer_Stream;
         Content : Ada.Strings.Unbounded.Unbounded_String;
      begin
         Buffer.Initialize (P'Unchecked_Access, 19);
         Buffer.Read (Content);
         P.Close;
         Util.Tests.Assert_Matches (T, "b c d e f\s+test_marker\s+", Content,
                                    "Invalid content");
      end;
      T.Assert (not P.Is_Running, "Process has stopped");
      Util.Tests.Assert_Equals (T, 0, P.Get_Exit_Status, "Invalid exit status");
   end Test_Shell_Splitting_Pipe;

   --  ------------------------------
   --  Test input pipe redirection: write the process standard input
   --  At the same time, read the process standard output.
   --  ------------------------------
   procedure Test_Input_Pipe (T : in out Test) is
      P : aliased Util.Streams.Pipes.Pipe_Stream;
   begin
      P.Open ("bin/util_test_process 0 read -", READ_WRITE);
      declare
         Buffer  : Util.Streams.Buffered.Input_Buffer_Stream;
         Content : Ada.Strings.Unbounded.Unbounded_String;
         Print   : Util.Streams.Texts.Print_Stream;
      begin
         --  Write on the process input stream.
         Print.Initialize (P'Unchecked_Access);
         Print.Write ("Write test on the input pipe");
         Print.Close;

         --  Read the output.
         Buffer.Initialize (P'Unchecked_Access, 19);
         Buffer.Read (Content);

         --  Wait for the process to finish.
         P.Close;

         Util.Tests.Assert_Matches (T, "Write test on the input pipe-\s", Content,
                                    "Invalid content");
      end;
      T.Assert (not P.Is_Running, "Process has stopped");
      Util.Tests.Assert_Equals (T, 0, P.Get_Exit_Status, "Invalid exit status");
   end Test_Input_Pipe;

   --  ------------------------------
   --  Test launching several processes through pipes in several threads.
   --  ------------------------------
   procedure Test_Multi_Spawn (T : in out Test) is
      Task_Count    : constant Natural := 8;
      Count_By_Task : constant Natural := 10;

      type State_Array is array (1 .. Task_Count) of Boolean;

      States : State_Array;
   begin
      declare
         task type Worker is
            entry Start (Count : in Natural);
            entry Result (Status : out Boolean);
         end Worker;

         task body Worker is
            Cnt   : Natural;
            State : Boolean := True;
         begin
            accept Start (Count : in Natural) do
               Cnt := Count;
            end Start;
            declare
               type Pipe_Array is array (1 .. Cnt) of aliased Util.Streams.Pipes.Pipe_Stream;

               Pipes : Pipe_Array;
            begin
               --  Launch the processes.
               --  They will print their arguments on stdout, one by one on each line.
               --  The expected exit status is the first argument.
               for I in 1 .. Cnt loop
                  Pipes (I).Open ("bin/util_test_process 0 write b c d e f test_marker");
               end loop;

               --  Read their output
               for I in 1 .. Cnt loop
                  declare
                     Buffer  : Util.Streams.Buffered.Input_Buffer_Stream;
                     Content : Ada.Strings.Unbounded.Unbounded_String;
                  begin
                     Buffer.Initialize (Pipes (I)'Unchecked_Access, 19);
                     Buffer.Read (Content);
                     Pipes (I).Close;

                     --  Check status and output.
                     State := State and Pipes (I).Get_Exit_Status = 0;
                     State := State and Ada.Strings.Unbounded.Index (Content, "test_marker") > 0;
                  end;
               end loop;

            exception
               when E : others =>
                  Log.Error ("Exception raised", E);
                  State := False;
            end;

            accept Result (Status : out Boolean) do
               Status := State;
            end Result;
         end Worker;

         type Worker_Array is array (1 .. Task_Count) of Worker;

         Tasks : Worker_Array;
      begin
         for I in Tasks'Range loop
            Tasks (I).Start (Count_By_Task);
         end loop;

         --  Get the results (do not raise any assertion here because we have to call
         --  'Result' to ensure the thread terminates.
         for I in Tasks'Range loop
            Tasks (I).Result (States (I));
         end loop;

         --  Leaving the Worker task scope means we are waiting for our tasks to finish.
      end;

      for I in States'Range loop
         T.Assert (States (I), "Task " & Natural'Image (I) & " failed");
      end loop;
   end Test_Multi_Spawn;

   --  ------------------------------
   --  Test output file redirection.
   --  ------------------------------
   procedure Test_Output_Redirect (T : in out Test) is
      P       : Process;
      Path    : constant String := Util.Tests.Get_Test_Path ("proc-output.txt");
      Content : Ada.Strings.Unbounded.Unbounded_String;
   begin
      Util.Processes.Set_Output_Stream (P, Path);
      Util.Processes.Spawn (P, "bin/util_test_process 0 write b c d e f test_marker");
      Util.Processes.Wait (P);

      T.Assert (not P.Is_Running, "Process has stopped");
      Util.Tests.Assert_Equals (T, 0, P.Get_Exit_Status, "Process failed");

      Util.Files.Read_File (Path, Content);
      Util.Tests.Assert_Matches (T, ".*test_marker", Content,
                                 "Invalid content");

      Util.Processes.Set_Output_Stream (P, Path, True);
      Util.Processes.Spawn (P, "bin/util_test_process 0 write appended_text");
      Util.Processes.Wait (P);

      Content := Ada.Strings.Unbounded.Null_Unbounded_String;
      Util.Files.Read_File (Path, Content);
      Util.Tests.Assert_Matches (T, ".*appended_text", Content,
                                 "Invalid content");
      Util.Tests.Assert_Matches (T, ".*test_marker.*", Content,
                                 "Invalid content");

   end Test_Output_Redirect;

   --  ------------------------------
   --  Test input file redirection.
   --  ------------------------------
   procedure Test_Input_Redirect (T : in out Test) is
      P        : Process;
      In_Path  : constant String := Util.Tests.Get_Path ("regtests/files/proc-input.txt");
      Out_Path : constant String := Util.Tests.Get_Test_Path ("proc-inres.txt");
      Exp_Path : constant String := Util.Tests.Get_Path ("regtests/expect/proc-inres.txt");
   begin
      Util.Processes.Set_Input_Stream (P, In_Path);
      Util.Processes.Set_Output_Stream (P, Out_Path);
      Util.Processes.Spawn (P, "bin/util_test_process 0 read -");
      Util.Processes.Wait (P);

      T.Assert (not P.Is_Running, "Process has stopped");
      Util.Tests.Assert_Equals (T, 0, P.Get_Exit_Status, "Process failed");

      Util.Tests.Assert_Equal_Files (T       => T,
                                     Expect  => Exp_Path,
                                     Test    => Out_Path,
                                     Message => "Process input/output redirection");
   end Test_Input_Redirect;

   --  ------------------------------
   --  Test the Tools.Execute operation.
   --  ------------------------------
   procedure Test_Tools_Execute (T : in out Test) is
      List   : Util.Strings.Vectors.Vector;
      Status : Integer;
   begin
      Tools.Execute (Command => "bin/util_test_process 23 write ""b c d e f"" test_marker",
                     Output  => List,
                     Status  => Status);
      Util.Tests.Assert_Equals (T, 23, Status, "Invalid exit status");
      Util.Tests.Assert_Equals (T, 2, Integer (List.Length),
                                "Invalid output collected by Execute");
      Util.Tests.Assert_Equals (T, "b c d e f", List.Element (1), "");
      Util.Tests.Assert_Equals (T, "test_marker", List.Element (2), "");
   end Test_Tools_Execute;

end Util.Processes.Tests;

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

with Util.Log.Loggers;
with Util.Test_Caller;
with Util.Files;
with Util.Strings.Vectors;
with Util.Streams.Pipes;
with Util.Streams.Buffered;
with Util.Streams.Texts;
with Util.Processes.Tools;
package body Util.Processes.Tests is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Util.Processes.Tests");

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Processes.Is_Running",
                       Test_No_Process'Access);
      Caller.Add_Test (Suite, "Test Util.Processes.Spawn/Wait/Get_Exit_Status",
                       Test_Spawn'Access);
      Caller.Add_Test (Suite, "Test Util.Processes.Spawn(READ pipe)",
                       Test_Output_Pipe'Access);
      Caller.Add_Test (Suite, "Test Util.Processes.Spawn(WRITE pipe)",
                       Test_Input_Pipe'Access);
      Caller.Add_Test (Suite, "Test Util.Processes.Spawn/Shell(WRITE pipe)",
                       Test_Shell_Splitting_Pipe'Access);
      Caller.Add_Test (Suite, "Test Util.Processes.Spawn(OUTPUT redirect)",
                       Test_Output_Redirect'Access);
      Caller.Add_Test (Suite, "Test Util.Processes.Spawn(INPUT redirect)",
                       Test_Input_Redirect'Access);
      Caller.Add_Test (Suite, "Test Util.Processes.Spawn(CHDIR)",
                       Test_Set_Working_Directory'Access);
      Caller.Add_Test (Suite, "Test Util.Streams.Pipes.Open/Read/Close (Multi spawn)",
                       Test_Multi_Spawn'Access);
      Caller.Add_Test (Suite, "Test Util.Processes.Tools.Execute",
                       Test_Tools_Execute'Access);

   end Add_Tests;

   --  ------------------------------
   --  Tests when the process is not launched
   --  ------------------------------
   procedure Test_No_Process (T : in out Test) is
      P : Process;
   begin
      T.Assert (not P.Is_Running, "Process should not be running");
      T.Assert (P.Get_Pid < 0, "Invalid process id");
   end Test_No_Process;

   --  ------------------------------
   --  Test executing a process
   --  ------------------------------
   procedure Test_Spawn (T : in out Test) is
      P : Process;
   begin
      --  Launch the test process => exit code 2
      P.Spawn ("bin/util_test_process");
      T.Assert (P.Is_Running, "Process is running");
      P.Wait;
      T.Assert (not P.Is_Running, "Process has stopped");
      T.Assert (P.Get_Pid > 0, "Invalid process id");
      Util.Tests.Assert_Equals (T, 2, P.Get_Exit_Status, "Invalid exit status");

      --  Launch the test process => exit code 0
      P.Spawn ("bin/util_test_process 0 write b c d e f");
      T.Assert (P.Is_Running, "Process is running");
      P.Wait;
      T.Assert (not P.Is_Running, "Process has stopped");
      T.Assert (P.Get_Pid > 0, "Invalid process id");
      Util.Tests.Assert_Equals (T, 0, P.Get_Exit_Status, "Invalid exit status");
   end Test_Spawn;

   --  ------------------------------
   --  Test output pipe redirection: read the process standard output
   --  ------------------------------
   procedure Test_Output_Pipe (T : in out Test) is
      P : aliased Util.Streams.Pipes.Pipe_Stream;
   begin
      P.Open ("bin/util_test_process 0 write b c d e f test_marker");
      declare
         Buffer  : Util.Streams.Buffered.Input_Buffer_Stream;
         Content : Ada.Strings.Unbounded.Unbounded_String;
      begin
         Buffer.Initialize (P'Unchecked_Access, 19);
         Buffer.Read (Content);
         P.Close;
         Util.Tests.Assert_Matches (T, "b\s+c\s+d\s+e\s+f\s+test_marker\s+", Content,
                                    "Invalid content");
      end;
      T.Assert (not P.Is_Running, "Process has stopped");
      Util.Tests.Assert_Equals (T, 0, P.Get_Exit_Status, "Invalid exit status");
   end Test_Output_Pipe;

   --  ------------------------------
   --  Test shell splitting.
   --  ------------------------------
   procedure Test_Shell_Splitting_Pipe (T : in out Test) is
      P : aliased Util.Streams.Pipes.Pipe_Stream;
   begin
      P.Open ("bin/util_test_process 0 write ""b c d e f"" test_marker");
      declare
         Buffer  : Util.Streams.Buffered.Input_Buffer_Stream;
         Content : Ada.Strings.Unbounded.Unbounded_String;
      begin
         Buffer.Initialize (P'Unchecked_Access, 19);
         Buffer.Read (Content);
         P.Close;
         Util.Tests.Assert_Matches (T, "b c d e f\s+test_marker\s+", Content,
                                    "Invalid content");
      end;
      T.Assert (not P.Is_Running, "Process has stopped");
      Util.Tests.Assert_Equals (T, 0, P.Get_Exit_Status, "Invalid exit status");
   end Test_Shell_Splitting_Pipe;

   --  ------------------------------
   --  Test input pipe redirection: write the process standard input
   --  At the same time, read the process standard output.
   --  ------------------------------
   procedure Test_Input_Pipe (T : in out Test) is
      P : aliased Util.Streams.Pipes.Pipe_Stream;
   begin
      P.Open ("bin/util_test_process 0 read -", READ_WRITE);
      declare
         Buffer  : Util.Streams.Buffered.Input_Buffer_Stream;
         Content : Ada.Strings.Unbounded.Unbounded_String;
         Print   : Util.Streams.Texts.Print_Stream;
      begin
         --  Write on the process input stream.
         Print.Initialize (P'Unchecked_Access);
         Print.Write ("Write test on the input pipe");
         Print.Close;

         --  Read the output.
         Buffer.Initialize (P'Unchecked_Access, 19);
         Buffer.Read (Content);

         --  Wait for the process to finish.
         P.Close;

         Util.Tests.Assert_Matches (T, "Write test on the input pipe-\s", Content,
                                    "Invalid content");
      end;
      T.Assert (not P.Is_Running, "Process has stopped");
      Util.Tests.Assert_Equals (T, 0, P.Get_Exit_Status, "Invalid exit status");
   end Test_Input_Pipe;

   --  ------------------------------
   --  Test launching several processes through pipes in several threads.
   --  ------------------------------
   procedure Test_Multi_Spawn (T : in out Test) is
      Task_Count    : constant Natural := 8;
      Count_By_Task : constant Natural := 10;

      type State_Array is array (1 .. Task_Count) of Boolean;

      States : State_Array;
   begin
      declare
         task type Worker is
            entry Start (Count : in Natural);
            entry Result (Status : out Boolean);
         end Worker;

         task body Worker is
            Cnt   : Natural;
            State : Boolean := True;
         begin
            accept Start (Count : in Natural) do
               Cnt := Count;
            end Start;
            declare
               type Pipe_Array is array (1 .. Cnt) of aliased Util.Streams.Pipes.Pipe_Stream;

               Pipes : Pipe_Array;
            begin
               --  Launch the processes.
               --  They will print their arguments on stdout, one by one on each line.
               --  The expected exit status is the first argument.
               for I in 1 .. Cnt loop
                  Pipes (I).Open ("bin/util_test_process 0 write b c d e f test_marker");
               end loop;

               --  Read their output
               for I in 1 .. Cnt loop
                  declare
                     Buffer  : Util.Streams.Buffered.Input_Buffer_Stream;
                     Content : Ada.Strings.Unbounded.Unbounded_String;
                  begin
                     Buffer.Initialize (Pipes (I)'Unchecked_Access, 19);
                     Buffer.Read (Content);
                     Pipes (I).Close;

                     --  Check status and output.
                     State := State and Pipes (I).Get_Exit_Status = 0;
                     State := State and Ada.Strings.Unbounded.Index (Content, "test_marker") > 0;
                  end;
               end loop;

            exception
               when E : others =>
                  Log.Error ("Exception raised", E);
                  State := False;
            end;

            accept Result (Status : out Boolean) do
               Status := State;
            end Result;
         end Worker;

         type Worker_Array is array (1 .. Task_Count) of Worker;

         Tasks : Worker_Array;
      begin
         for I in Tasks'Range loop
            Tasks (I).Start (Count_By_Task);
         end loop;

         --  Get the results (do not raise any assertion here because we have to call
         --  'Result' to ensure the thread terminates.
         for I in Tasks'Range loop
            Tasks (I).Result (States (I));
         end loop;

         --  Leaving the Worker task scope means we are waiting for our tasks to finish.
      end;

      for I in States'Range loop
         T.Assert (States (I), "Task " & Natural'Image (I) & " failed");
      end loop;
   end Test_Multi_Spawn;

   --  ------------------------------
   --  Test output file redirection.
   --  ------------------------------
   procedure Test_Output_Redirect (T : in out Test) is
      P       : Process;
      Path    : constant String := Util.Tests.Get_Test_Path ("proc-output.txt");
      Content : Ada.Strings.Unbounded.Unbounded_String;
   begin
      Util.Processes.Set_Output_Stream (P, Path);
      Util.Processes.Spawn (P, "bin/util_test_process 0 write b c d e f test_marker");
      Util.Processes.Wait (P);

      T.Assert (not P.Is_Running, "Process has stopped");
      Util.Tests.Assert_Equals (T, 0, P.Get_Exit_Status, "Process failed");

      Util.Files.Read_File (Path, Content);
      Util.Tests.Assert_Matches (T, ".*test_marker", Content,
                                 "Invalid content");

      Util.Processes.Set_Output_Stream (P, Path, True);
      Util.Processes.Spawn (P, "bin/util_test_process 0 write appended_text");
      Util.Processes.Wait (P);

      Content := Ada.Strings.Unbounded.Null_Unbounded_String;
      Util.Files.Read_File (Path, Content);
      Util.Tests.Assert_Matches (T, ".*appended_text", Content,
                                 "Invalid content");
      Util.Tests.Assert_Matches (T, ".*test_marker.*", Content,
                                 "Invalid content");

   end Test_Output_Redirect;

   --  ------------------------------
   --  Test input file redirection.
   --  ------------------------------
   procedure Test_Input_Redirect (T : in out Test) is
      P        : Process;
      In_Path  : constant String := Util.Tests.Get_Path ("regtests/files/proc-input.txt");
      Exp_Path : constant String := Util.Tests.Get_Path ("regtests/expect/proc-inres.txt");
      Out_Path : constant String := Util.Tests.Get_Test_Path ("proc-inres.txt");
      Err_Path : constant String := Util.Tests.Get_Test_Path ("proc-errres.txt");
   begin
      Util.Processes.Set_Input_Stream (P, In_Path);
      Util.Processes.Set_Output_Stream (P, Out_Path);
      Util.Processes.Set_Error_Stream (P, Err_Path);
      Util.Processes.Spawn (P, "bin/util_test_process 0 read -");
      Util.Processes.Wait (P);

      T.Assert (not P.Is_Running, "Process has stopped");
      Util.Tests.Assert_Equals (T, 0, P.Get_Exit_Status, "Process failed");

      Util.Tests.Assert_Equal_Files (T       => T,
                                     Expect  => Exp_Path,
                                     Test    => Out_Path,
                                     Message => "Process input/output redirection");
   end Test_Input_Redirect;

   --  ------------------------------
   --  Test chaning working directory.
   --  ------------------------------
   procedure Test_Set_Working_Directory (T : in out Test) is
      P        : Process;
      Dir_Path : constant String := Util.Tests.Get_Path ("regtests/files");
      In_Path  : constant String := Util.Tests.Get_Path ("regtests/files/proc-empty.txt");
      Exp_Path : constant String := Util.Tests.Get_Path ("regtests/files/proc-input.txt");
      Out_Path : constant String := Util.Tests.Get_Test_Path ("proc-cat.txt");
      Err_Path : constant String := Util.Tests.Get_Test_Path ("proc-errres.txt");
   begin
      Util.Processes.Set_Working_Directory (P, Dir_Path);
      Util.Processes.Set_Input_Stream (P, In_Path);
      Util.Processes.Set_Output_Stream (P, Out_Path);
      Util.Processes.Set_Error_Stream (P, Err_Path);
      Util.Processes.Spawn (P, "cat proc-input.txt");
      Util.Processes.Wait (P);

      T.Assert (not P.Is_Running, "Process has stopped");
      Util.Tests.Assert_Equals (T, 0, P.Get_Exit_Status, "Process failed");

      Util.Tests.Assert_Equal_Files (T       => T,
                                     Expect  => Exp_Path,
                                     Test    => Out_Path,
                                     Message => "Process input/output redirection");
   end Test_Set_Working_Directory;

   --  ------------------------------
   --  Test the Tools.Execute operation.
   --  ------------------------------
   procedure Test_Tools_Execute (T : in out Test) is
      List   : Util.Strings.Vectors.Vector;
      Status : Integer;
   begin
      Tools.Execute (Command => "bin/util_test_process 23 write ""b c d e f"" test_marker",
                     Output  => List,
                     Status  => Status);
      Util.Tests.Assert_Equals (T, 23, Status, "Invalid exit status");
      Util.Tests.Assert_Equals (T, 2, Integer (List.Length),
                                "Invalid output collected by Execute");
      Util.Tests.Assert_Equals (T, "b c d e f", List.Element (1), "");
      Util.Tests.Assert_Equals (T, "test_marker", List.Element (2), "");
   end Test_Tools_Execute;

end Util.Processes.Tests;

Add the Test_Set_Working_Directory procedure and register it for execution (test launching a process with a specific working directory)


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

with GNAT.Command_Line;

with Util.Files;
with Util.Streams.Pipes;
with Util.Streams.Buffered;
with Util.Strings.Transforms;

with Wiki.Filters.Html;
with Wiki.Filters.TOC;
with Wiki.Streams.Builders;
with Wiki.Streams.Html.Builders;
with Wiki.Render.Html;
with Wiki.Render.Text;
with Wiki.Render.Wiki;
with Wiki.Documents;
with Wiki.Parsers;

procedure Import is

   use GNAT.Command_Line;
   use Ada.Strings.Unbounded;
   use Ada.Characters.Conversions;

   procedure Usage;
   function Is_Url (Name : in String) return Boolean;
   procedure Parse_Url (Url : in String);
   procedure Parse (Content : in String);

   Html_Filter : aliased Wiki.Filters.Html.Html_Filter_Type;
   TOC         : aliased Wiki.Filters.TOC.TOC_Filter;
   Count       : Natural := 0;
   Html_Mode   : Boolean := True;
   Wiki_Mode   : Boolean := False;
   Syntax      : Wiki.Wiki_Syntax := Wiki.SYNTAX_MARKDOWN;

   procedure Usage is
   begin
      Ada.Text_IO.Put_Line ("Import HTML into a target Wiki format");
      Ada.Text_IO.Put_Line ("Usage: import [-t] [-m] [-M] [-d] [-c] {URL | file}");
      Ada.Text_IO.Put_Line ("  -t      Convert to text only");
      Ada.Text_IO.Put_Line ("  -m      Convert to Markdown");
      Ada.Text_IO.Put_Line ("  -M      Convert to Mediawiki");
      Ada.Text_IO.Put_Line ("  -d      Convert to Dotclear");
      Ada.Text_IO.Put_Line ("  -c      Convert to Creole");
   end Usage;

   procedure Parse (Content : in String) is
      Doc    : Wiki.Documents.Document;
      Engine : Wiki.Parsers.Parser;
   begin
      Engine.Add_Filter (TOC'Unchecked_Access);
      Engine.Add_Filter (Html_Filter'Unchecked_Access);
      if Wiki_Mode then
         declare
            Stream   : aliased Wiki.Streams.Builders.Output_Builder_Stream;
            Renderer : aliased Wiki.Render.Wiki.Wiki_Renderer;
         begin
            Engine.Set_Syntax (Wiki.SYNTAX_HTML);
            Engine.Parse (To_Wide_Wide_String (Content), Doc);
            Renderer.Set_Output_Stream (Stream'Unchecked_Access, Syntax);
            Renderer.Render (Doc);
            Ada.Text_IO.Put_Line (Stream.To_String);
         end;
      elsif Html_Mode then
         declare
            Stream   : aliased Wiki.Streams.Html.Builders.Html_Output_Builder_Stream;
            Renderer : aliased Wiki.Render.Html.Html_Renderer;
         begin
            Engine.Set_Syntax (Syntax);
            Engine.Parse (To_Wide_Wide_String (Content), Doc);
            Renderer.Set_Output_Stream (Stream'Unchecked_Access);
            Renderer.Render (Doc);
            Ada.Text_IO.Put_Line (Stream.To_String);
         end;
      else
         declare
            Stream   : aliased Wiki.Streams.Builders.Output_Builder_Stream;
            Renderer : aliased Wiki.Render.Text.Text_Renderer;
         begin
            Engine.Set_Syntax (Syntax);
            Engine.Parse (To_Wide_Wide_String (Content), Doc);
            Renderer.Set_Output_Stream (Stream'Unchecked_Access);
            Renderer.Render (Doc);
            Ada.Text_IO.Put_Line (Stream.To_String);
         end;
      end if;
   end Parse;

   procedure Parse_Url (Url : in String) is
      Command : constant String := "wget -q -O - " & Url;
      Pipe    : aliased Util.Streams.Pipes.Pipe_Stream;
      Buffer  : Util.Streams.Buffered.Input_Buffer_Stream;
      Content : Ada.Strings.Unbounded.Unbounded_String;
   begin
      Pipe.Open (Command);
      Buffer.Initialize (Pipe'Unchecked_Access, 1024 * 1024);
      Buffer.Read (Content);
      Pipe.Close;
      if Pipe.Get_Exit_Status /= 0 then
         Ada.Text_IO.Put_Line (Command & " exited with status "
                               & Integer'Image (Pipe.Get_Exit_Status));
      else
         Parse (To_String (Content));
      end if;
   end Parse_Url;

   function Is_Url (Name : in String) return Boolean is
   begin
      if Name'Length <= 9 then
         return False;
      else
         return Name (Name'First .. Name'First + 6) = "http://"
           or Name (Name'First .. Name'First + 7) = "https://";
      end if;
   end Is_Url;

begin
   loop
      case Getopt ("m M d c t f:") is
         when 'm' =>
            Syntax := Wiki.SYNTAX_MARKDOWN;
            Wiki_Mode := True;

         when 'M' =>
            Syntax := Wiki.SYNTAX_MEDIA_WIKI;
            Wiki_Mode := True;

         when 'c' =>
            Syntax := Wiki.SYNTAX_CREOLE;
            Wiki_Mode := True;

         when 'd' =>
            Syntax := Wiki.SYNTAX_DOTCLEAR;
            Wiki_Mode := True;

         when 't' =>
            Html_Mode := False;

         when 'f' =>
            declare
               Value : constant String := Util.Strings.Transforms.To_Upper_Case (Parameter);
            begin
               Html_Filter.Hide (Wiki.Html_Tag'Value (Value & "_TAG"));
            exception
               when Constraint_Error =>
                  Ada.Text_IO.Put_Line ("Invalid tag " & Value);
            end;

         when others =>
            exit;
      end case;
   end loop;

   loop
      declare
         Name : constant String := GNAT.Command_Line.Get_Argument;
         Data : Unbounded_String;
      begin
         if Name = "" then
            if Count = 0 then
               Usage;
            end if;
            return;
         end if;
         Count := Count + 1;
         if Is_Url (Name) then
            Parse_Url (Name);
         else
            Util.Files.Read_File (Name, Data);
            Parse (To_String (Data));
         end if;

      exception
         when Ada.IO_Exceptions.Name_Error =>
            Ada.Text_IO.Put_Line ("Cannot read file '" & Name & "'");

      end;
   end loop;

exception
   when Invalid_Switch =>
      Ada.Text_IO.Put_Line ("Invalid option.");
      Usage;

end Import;

-----------------------------------------------------------------------
--  import -- Import some HTML content and generate Wiki text
--  Copyright (C) 2015, 2016, 2020 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Text_IO;
with Ada.Wide_Wide_Text_IO;
with Ada.IO_Exceptions;
with Ada.Strings.Unbounded;
with Ada.Characters.Conversions;
with Ada.Strings.UTF_Encoding.Wide_Wide_Strings;

with GNAT.Command_Line;

with Util.Files;
with Util.Streams.Pipes;
with Util.Streams.Buffered;
with Util.Strings.Transforms;

with Wiki.Strings;
with Wiki.Filters.Html;
with Wiki.Filters.TOC;
with Wiki.Streams.Builders;
with Wiki.Streams.Html.Builders;
with Wiki.Render.Html;
with Wiki.Render.Text;
with Wiki.Render.Wiki;
with Wiki.Documents;
with Wiki.Parsers;

procedure Import is

   use GNAT.Command_Line;
   use Ada.Strings.Unbounded;
   use Ada.Characters.Conversions;
   use Ada.Strings.UTF_Encoding;

   procedure Usage;
   function Is_Url (Name : in String) return Boolean;
   procedure Parse_Url (Url : in String);
   procedure Parse (Content : in String);
   procedure Print (Item : in Wiki.Strings.WString);

   Html_Filter : aliased Wiki.Filters.Html.Html_Filter_Type;
   TOC         : aliased Wiki.Filters.TOC.TOC_Filter;
   Count       : Natural := 0;
   Html_Mode   : Boolean := True;
   Wiki_Mode   : Boolean := False;
   Syntax      : Wiki.Wiki_Syntax := Wiki.SYNTAX_MARKDOWN;

   procedure Usage is
   begin
      Ada.Text_IO.Put_Line ("Import HTML into a target Wiki format");
      Ada.Text_IO.Put_Line ("Usage: import [-t] [-m] [-M] [-d] [-c] {URL | file}");
      Ada.Text_IO.Put_Line ("  -t      Convert to text only");
      Ada.Text_IO.Put_Line ("  -m      Convert to Markdown");
      Ada.Text_IO.Put_Line ("  -M      Convert to Mediawiki");
      Ada.Text_IO.Put_Line ("  -d      Convert to Dotclear");
      Ada.Text_IO.Put_Line ("  -c      Convert to Creole");
   end Usage;

   procedure Print (Item : in Wiki.Strings.WString) is
   begin
      Ada.Wide_Wide_Text_IO.Put (Item);
   end Print;

   procedure Parse (Content : in String) is
      Doc    : Wiki.Documents.Document;
      Engine : Wiki.Parsers.Parser;
   begin
      Engine.Add_Filter (TOC'Unchecked_Access);
      Engine.Add_Filter (Html_Filter'Unchecked_Access);
      if Wiki_Mode then
         declare
            Stream   : aliased Wiki.Streams.Builders.Output_Builder_Stream;
            Renderer : aliased Wiki.Render.Wiki.Wiki_Renderer;
         begin
            Engine.Set_Syntax (Wiki.SYNTAX_HTML);
            Engine.Parse (Wide_Wide_Strings.Decode (Content), Doc);
            Renderer.Set_Output_Stream (Stream'Unchecked_Access, Syntax);
            Renderer.Render (Doc);
            Stream.Iterate (Print'Access);
         end;
      elsif Html_Mode then
         declare
            Stream   : aliased Wiki.Streams.Html.Builders.Html_Output_Builder_Stream;
            Renderer : aliased Wiki.Render.Html.Html_Renderer;
         begin
            Engine.Set_Syntax (Syntax);
            Engine.Parse (Wide_Wide_Strings.Decode (Content), Doc);
            Renderer.Set_Output_Stream (Stream'Unchecked_Access);
            Renderer.Render (Doc);
            Stream.Iterate (Print'Access);
         end;
      else
         declare
            Stream   : aliased Wiki.Streams.Builders.Output_Builder_Stream;
            Renderer : aliased Wiki.Render.Text.Text_Renderer;
         begin
            Engine.Set_Syntax (Syntax);
            Engine.Parse (Wide_Wide_Strings.Decode (Content), Doc);
            Renderer.Set_Output_Stream (Stream'Unchecked_Access);
            Renderer.Render (Doc);
            Stream.Iterate (Print'Access);
         end;
      end if;
      Ada.Wide_Wide_Text_IO.New_Line;
   end Parse;

   procedure Parse_Url (Url : in String) is
      Command : constant String := "wget -q -O - " & Url;
      Pipe    : aliased Util.Streams.Pipes.Pipe_Stream;
      Buffer  : Util.Streams.Buffered.Input_Buffer_Stream;
      Content : Ada.Strings.Unbounded.Unbounded_String;
   begin
      Pipe.Open (Command);
      Buffer.Initialize (Pipe'Unchecked_Access, 1024 * 1024);
      Buffer.Read (Content);
      Pipe.Close;
      if Pipe.Get_Exit_Status /= 0 then
         Ada.Text_IO.Put_Line (Command & " exited with status "
                               & Integer'Image (Pipe.Get_Exit_Status));
      else
         Parse (To_String (Content));
      end if;
   end Parse_Url;

   function Is_Url (Name : in String) return Boolean is
   begin
      if Name'Length <= 9 then
         return False;
      else
         return Name (Name'First .. Name'First + 6) = "http://"
           or Name (Name'First .. Name'First + 7) = "https://";
      end if;
   end Is_Url;

begin
   loop
      case Getopt ("m M d c t f:") is
         when 'm' =>
            Syntax := Wiki.SYNTAX_MARKDOWN;
            Wiki_Mode := True;

         when 'M' =>
            Syntax := Wiki.SYNTAX_MEDIA_WIKI;
            Wiki_Mode := True;

         when 'c' =>
            Syntax := Wiki.SYNTAX_CREOLE;
            Wiki_Mode := True;

         when 'd' =>
            Syntax := Wiki.SYNTAX_DOTCLEAR;
            Wiki_Mode := True;

         when 't' =>
            Html_Mode := False;

         when 'f' =>
            declare
               Value : constant String := Util.Strings.Transforms.To_Upper_Case (Parameter);
            begin
               Html_Filter.Hide (Wiki.Html_Tag'Value (Value & "_TAG"));
            exception
               when Constraint_Error =>
                  Ada.Text_IO.Put_Line ("Invalid tag " & Value);
            end;

         when others =>
            exit;
      end case;
   end loop;

   loop
      declare
         Name : constant String := GNAT.Command_Line.Get_Argument;
         Data : Unbounded_String;
      begin
         if Name = "" then
            if Count = 0 then
               Usage;
            end if;
            return;
         end if;
         Count := Count + 1;
         if Is_Url (Name) then
            Parse_Url (Name);
         else
            Util.Files.Read_File (Name, Data);
            Parse (To_String (Data));
         end if;

      exception
         when Ada.IO_Exceptions.Name_Error =>
            Ada.Text_IO.Put_Line ("Cannot read file '" & Name & "'");

      end;
   end loop;

exception
   when Invalid_Switch =>
      Ada.Text_IO.Put_Line ("Invalid option.");
      Usage;

end Import;

Fix conversion of String to Wide_Wide_String so that we recognized UTF-8 sequences


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

package body Wiki.Filters is

   --  ------------------------------
   --  Add a simple node such as N_LINE_BREAK, N_HORIZONTAL_RULE or N_PARAGRAPH to the document.
   --  ------------------------------
   procedure Add_Node (Filter    : in out Filter_Type;
                       Document  : in out Wiki.Nodes.Document;
                       Kind      : in Wiki.Nodes.Simple_Node_Kind) is
   begin
      if Filter.Next /= null then
         Filter.Add_Node (Document, Kind);
      else
         Wiki.Nodes.Append (Document, Kind);
      end if;
   end Add_Node;

   --  ------------------------------
   --  Add a text content with the given format to the document.
   --  ------------------------------
   procedure Add_Text (Filter    : in out Filter_Type;
                       Document  : in out Wiki.Nodes.Document;
                       Text      : in Wiki.Strings.WString;
                       Format    : in Wiki.Nodes.Format_Map) is
   begin
      if Filter.Next /= null then
         Filter.Add_Text (Document, Text, Format);
      else
         Wiki.Nodes.Append (Document, Text, Format);
      end if;
   end Add_Text;

   --  ------------------------------
   --  Add a section header with the given level in the document.
   --  ------------------------------
   procedure Add_Header (Filter    : in out Filter_Type;
                         Document  : in out Wiki.Nodes.Document;
                         Header    : in Wiki.Strings.WString;
                         Level     : in Natural) is
   begin
      if Filter.Next /= null then
         Filter.Add_Header (Document, Header, Level);
      else
         Wiki.Nodes.Append (Document, Header, Level);
      end if;
   end Add_Header;

   --  ------------------------------
   --  Push a HTML node with the given tag to the document.
   --  ------------------------------
   procedure Push_Node (Filter     : in out Filter_Type;
                        Document   : in out Wiki.Nodes.Document;
                        Tag        : in Wiki.Nodes.Html_Tag_Type;
                        Attributes : in out Wiki.Attributes.Attribute_List_Type) is
   begin
      if Filter.Next /= null then
         Filter.Push_Node (Document, Tag, Attributes);
      else
         Wiki.Nodes.Push_Node (Document, Tag, Attributes);
      end if;
   end Push_Node;

   --  ------------------------------
   --  Pop a HTML node with the given tag.
   --  ------------------------------
   procedure Pop_Node (Filter   : in out Filter_Type;
                       Document : in out Wiki.Nodes.Document;
                       Tag     : in Wiki.Nodes.Html_Tag_Type) is
   begin
      if Filter.Next /= null then
         Filter.Pop_Node (Document, Tag);
      else
         Wiki.Nodes.Pop_Node (Document, Tag);
      end if;
   end Pop_Node;

   --  ------------------------------
   --  Add a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   --  ------------------------------
   overriding
   procedure Add_Blockquote (Document : in out Filter_Type;
                             Level    : in Natural) is
   begin
      Document.Document.Add_Blockquote (Level);
   end Add_Blockquote;

   --  ------------------------------
   --  Add a list item (<li>).  Close the previous paragraph and list item if any.
   --  The list item will be closed at the next list item, next paragraph or next header.
   --  ------------------------------
   overriding
   procedure Add_List_Item (Document : in out Filter_Type;
                            Level    : in Positive;
                            Ordered  : in Boolean) is
   begin
      Document.Document.Add_List_Item (Level, Ordered);
   end Add_List_Item;

   --  ------------------------------
   --  Add a link.
   --  ------------------------------
   procedure Add_Link (Filter     : in out Filter_Type;
                       Document   : in out Wiki.Nodes.Document;
                       Name       : in Wiki.Strings.WString;
                       Attributes : in out Wiki.Attributes.Attribute_List_Type) is
   begin
      if Filter.Next /= null then
         Filter.Add_Link (Document, Name, Attributes);
      else
         Wiki.Nodes.Add_Link (Document, Name, Attributes);
      end if;
   end Add_Link;

   --  ------------------------------
   --  Add an image.
   --  ------------------------------
   procedure Add_Image (Filter     : in out Filter_Type;
                        Document   : in out Wiki.Nodes.Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List_Type) is
   begin
      if Filter.Next /= null then
         Filter.Add_Image (Document, Name, Attributes);
      else
         Wiki.Nodes.Add_Image (Document, Name, Attributes);
      end if;
   end Add_Image;

   --  ------------------------------
   --  Add a quote.
   --  ------------------------------
   procedure Add_Quote (Filter     : in out Filter_Type;
                        Document   : in out Wiki.Nodes.Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List_Type) is
   begin
      if Filter.Next /= null then
         Filter.Add_Quote (Document, Name, Attributes);
      else
         Wiki.Nodes.Add_Quote (Document, Name, Attributes);
      end if;
   end Add_Quote;

   --  ------------------------------
   --  Add a text block that is pre-formatted.
   --  ------------------------------
   procedure Add_Preformatted (Filter   : in out Filter_Type;
                               Document : in out Wiki.Nodes.Document;
                               Text     : in Wiki.Strings.WString;
                               Format   : in Unbounded_Wide_Wide_String) is
   begin
      if Filter.Next /= null then
         Filter.Add_Preformatted (Document, Text, Format);
      else
         Wiki.Nodes.Add_Preformatted (Document, Text, Format);
      end if;
   end Add_Preformatted;

   --  ------------------------------
   --  Finish the document after complete wiki text has been parsed.
   --  ------------------------------
   overriding
   procedure Finish (Document : in out Filter_Type) is
   begin
      Document.Document.Finish;
   end Finish;

end Wiki.Filters;

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

package body Wiki.Filters is

   --  ------------------------------
   --  Add a simple node such as N_LINE_BREAK, N_HORIZONTAL_RULE or N_PARAGRAPH to the document.
   --  ------------------------------
   procedure Add_Node (Filter    : in out Filter_Type;
                       Document  : in out Wiki.Nodes.Document;
                       Kind      : in Wiki.Nodes.Simple_Node_Kind) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Node (Document, Kind);
      else
         Wiki.Nodes.Append (Document, Kind);
      end if;
   end Add_Node;

   --  ------------------------------
   --  Add a text content with the given format to the document.
   --  ------------------------------
   procedure Add_Text (Filter    : in out Filter_Type;
                       Document  : in out Wiki.Nodes.Document;
                       Text      : in Wiki.Strings.WString;
                       Format    : in Wiki.Nodes.Format_Map) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Text (Document, Text, Format);
      else
         Wiki.Nodes.Append (Document, Text, Format);
      end if;
   end Add_Text;

   --  ------------------------------
   --  Add a section header with the given level in the document.
   --  ------------------------------
   procedure Add_Header (Filter    : in out Filter_Type;
                         Document  : in out Wiki.Nodes.Document;
                         Header    : in Wiki.Strings.WString;
                         Level     : in Natural) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Header (Document, Header, Level);
      else
         Wiki.Nodes.Append (Document, Header, Level);
      end if;
   end Add_Header;

   --  ------------------------------
   --  Push a HTML node with the given tag to the document.
   --  ------------------------------
   procedure Push_Node (Filter     : in out Filter_Type;
                        Document   : in out Wiki.Nodes.Document;
                        Tag        : in Wiki.Nodes.Html_Tag_Type;
                        Attributes : in out Wiki.Attributes.Attribute_List_Type) is
   begin
      if Filter.Next /= null then
         Filter.Next.Push_Node (Document, Tag, Attributes);
      else
         Wiki.Nodes.Push_Node (Document, Tag, Attributes);
      end if;
   end Push_Node;

   --  ------------------------------
   --  Pop a HTML node with the given tag.
   --  ------------------------------
   procedure Pop_Node (Filter   : in out Filter_Type;
                       Document : in out Wiki.Nodes.Document;
                       Tag     : in Wiki.Nodes.Html_Tag_Type) is
   begin
      if Filter.Next /= null then
         Filter.Next.Pop_Node (Document, Tag);
      else
         Wiki.Nodes.Pop_Node (Document, Tag);
      end if;
   end Pop_Node;

   --  ------------------------------
   --  Add a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   --  ------------------------------
   procedure Add_Blockquote (Document : in out Filter_Type;
                             Level    : in Natural) is
   begin
      Document.Document.Add_Blockquote (Level);
   end Add_Blockquote;

   --  ------------------------------
   --  Add a list item (<li>).  Close the previous paragraph and list item if any.
   --  The list item will be closed at the next list item, next paragraph or next header.
   --  ------------------------------
   procedure Add_List_Item (Document : in out Filter_Type;
                            Level    : in Positive;
                            Ordered  : in Boolean) is
   begin
      Document.Document.Add_List_Item (Level, Ordered);
   end Add_List_Item;

   --  ------------------------------
   --  Add a link.
   --  ------------------------------
   procedure Add_Link (Filter     : in out Filter_Type;
                       Document   : in out Wiki.Nodes.Document;
                       Name       : in Wiki.Strings.WString;
                       Attributes : in out Wiki.Attributes.Attribute_List_Type) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Link (Document, Name, Attributes);
      else
         Wiki.Nodes.Add_Link (Document, Name, Attributes);
      end if;
   end Add_Link;

   --  ------------------------------
   --  Add an image.
   --  ------------------------------
   procedure Add_Image (Filter     : in out Filter_Type;
                        Document   : in out Wiki.Nodes.Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List_Type) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Image (Document, Name, Attributes);
      else
         Wiki.Nodes.Add_Image (Document, Name, Attributes);
      end if;
   end Add_Image;

   --  ------------------------------
   --  Add a quote.
   --  ------------------------------
   procedure Add_Quote (Filter     : in out Filter_Type;
                        Document   : in out Wiki.Nodes.Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List_Type) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Quote (Document, Name, Attributes);
      else
         Wiki.Nodes.Add_Quote (Document, Name, Attributes);
      end if;
   end Add_Quote;

   --  ------------------------------
   --  Add a text block that is pre-formatted.
   --  ------------------------------
   procedure Add_Preformatted (Filter   : in out Filter_Type;
                               Document : in out Wiki.Nodes.Document;
                               Text     : in Wiki.Strings.WString;
                               Format   : in Unbounded_Wide_Wide_String) is
   begin
      if Filter.Next /= null then
         Filter.Next.Add_Preformatted (Document, Text, Format);
      else
         Wiki.Nodes.Add_Preformatted (Document, Text, Format);
      end if;
   end Add_Preformatted;

   --  ------------------------------
   --  Finish the document after complete wiki text has been parsed.
   --  ------------------------------
   procedure Finish (Filter : in out Filter_Type) is
   begin
      if Filter.Next /= null then
         Filter.Next.Finish;
      end if;
   end Finish;

end Wiki.Filters;

Fix the filter chain execution

Fix the filter chain execution


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

with Ada.Finalization;

--  The Util.Concurrent.Pools generic defines a pool of objects which
--  can be shared by multiple threads.  First, the pool is configured to have
--  a number of objects by using the Set_Size procedure.  Then, a thread
--  that needs an object uses the Get_Instance to get an object.
--  The object is removed from the pool.  As soon as the thread has finished,
--  it puts back the object in the pool using the Release procedure.
--
--  The Get_Instance entry will block until an object is available.
generic
   type Element_Type is private;
package Util.Concurrent.Pools is

   pragma Preelaborate;

   --  Pool of objects
   type Pool is new Ada.Finalization.Limited_Controlled with private;

   --  Get an element instance from the pool.
   --  Wait until one instance gets available.
   procedure Get_Instance (From : in out Pool;
                           Item : out Element_Type);

   --  Put the element back to the pool.
   procedure Release (Into : in out Pool;
                      Item : in Element_Type);

   --  Set the pool size.
   procedure Set_Size (Into : in out Pool;
                       Capacity : in Positive);

   --  Release the pool elements.
   overriding
   procedure Finalize (Object : in out Pool);

private

   --  To store the pool elements, we use an array which is allocated dynamically
   --  by the Set_Size protected operation.  The generated code is smaller
   --  compared to the use of Ada vectors container.
   type Element_Array is array (Positive range <>) of Element_Type;
   type Element_Array_Access is access all Element_Array;

   Null_Element_Array : constant Element_Array_Access := null;

   --  Pool of objects
   protected type Protected_Pool is

      --  Get an element instance from the pool.
      --  Wait until one instance gets available.
      entry Get_Instance (Item : out Element_Type);

      --  Put the element back to the pool.
      procedure Release (Item : in Element_Type);

      --  Set the pool size.
      procedure Set_Size (Capacity : in Natural);

   private
      Available     : Natural := 0;
      Elements      : Element_Array_Access := Null_Element_Array;
   end Protected_Pool;

   type Pool is new Ada.Finalization.Limited_Controlled with record
      List : Protected_Pool;
   end record;

end Util.Concurrent.Pools;

-----------------------------------------------------------------------
--  Util.Concurrent.Pools -- Concurrent Pools
--  Copyright (C) 2011, 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.Finalization;

--  The Util.Concurrent.Pools generic defines a pool of objects which
--  can be shared by multiple threads.  First, the pool is configured to have
--  a number of objects by using the Set_Size procedure.  Then, a thread
--  that needs an object uses the Get_Instance to get an object.
--  The object is removed from the pool.  As soon as the thread has finished,
--  it puts back the object in the pool using the Release procedure.
--
--  The Get_Instance entry will block until an object is available.
generic
   type Element_Type is private;
package Util.Concurrent.Pools is

   pragma Preelaborate;

   FOREVER : constant Duration := -1.0;

   --  Exception raised if the Get_Instance timeout exceeded.
   Timeout : exception;

   --  Pool of objects
   type Pool is limited new Ada.Finalization.Limited_Controlled with private;

   --  Get an element instance from the pool.
   --  Wait until one instance gets available.
   procedure Get_Instance (From : in out Pool;
                           Item : out Element_Type;
                           Wait : in Duration := FOREVER);

   --  Put the element back to the pool.
   procedure Release (Into : in out Pool;
                      Item : in Element_Type);

   --  Set the pool size.
   procedure Set_Size (Into     : in out Pool;
                       Capacity : in Positive);

   --  Release the pool elements.
   overriding
   procedure Finalize (Object : in out Pool);

private

   --  To store the pool elements, we use an array which is allocated dynamically
   --  by the Set_Size protected operation.  The generated code is smaller
   --  compared to the use of Ada vectors container.
   type Element_Array is array (Positive range <>) of Element_Type;
   type Element_Array_Access is access all Element_Array;

   Null_Element_Array : constant Element_Array_Access := null;

   --  Pool of objects
   protected type Protected_Pool is

      --  Get an element instance from the pool.
      --  Wait until one instance gets available.
      entry Get_Instance (Item : out Element_Type);

      --  Put the element back to the pool.
      procedure Release (Item : in Element_Type);

      --  Set the pool size.
      procedure Set_Size (Capacity : in Natural);

   private
      Available     : Natural := 0;
      Elements      : Element_Array_Access := Null_Element_Array;
   end Protected_Pool;

   type Pool is limited new Ada.Finalization.Limited_Controlled with record
      List : Protected_Pool;
   end record;

end Util.Concurrent.Pools;

Add a timeout for the Get_Instance operation to raise the timeout exception if the delay is expired and no item from the pool was available