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

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

with Security.Contexts;

with AWA.Users.Models;
with AWA.Services.Contexts;
with AWA.Tests.Helpers.Users;
with AWA.Tags.Beans;
package body AWA.Tags.Modules.Tests is

   use Util.Tests;
   use ADO;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Tags.Modules.Add_Tag",
                       Test_Add_Tag'Access);
      Caller.Add_Test (Suite, "Test AWA.Tags.Modules.Remove_Tag",
                       Test_Remove_Tag'Access);
   end Add_Tests;

   function Create_Tag_List_Bean (Module : in Tag_Module_Access)
                                  return AWA.Tags.Beans.Tag_List_Bean_Access is
      Bean : Util.Beans.Basic.Readonly_Bean_Access := AWA.Tags.Beans.Create_Tag_List_Bean (Module);
   begin
      return AWA.Tags.Beans.Tag_List_Bean'Class (Bean.all)'Access;
   end Create_Tag_List_Bean;

   --  ------------------------------
   --  Test tag creation.
   --  ------------------------------
   procedure Test_Add_Tag (T : in out Test) is
      Sec_Ctx      : Security.Contexts.Security_Context;
      Context      : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-add-tag@test.com");

      declare
         Tag_Manager  : constant Tag_Module_Access := Get_Tag_Module;
         User         : constant AWA.Users.Models.User_Ref := Context.Get_User;
         List         : AWA.Tags.Beans.Tag_List_Bean_Access;
         Cleanup      : Util.Beans.Objects.Object;
      begin
         T.Assert (Tag_Manager /= null, "There is no tag module");

         List := Create_Tag_List_Bean (Tag_Manager);
         Cleanup := Util.Beans.Objects.To_Object (List.all'Access);
         List.Set_Value ("entity_type", Util.Beans.Objects.To_Object (String '("awa_user")));

         --  Create a tag.
         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag");
         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag");

         --  Load the list.
         List.Load_Tags (User.Get_Id);

         Util.Tests.Assert_Equals (T, 1, Integer (List.Get_Count), "Invalid number of tags");
      end;
   end Test_Add_Tag;

   --  ------------------------------
   --  Test tag removal.
   --  ------------------------------
   procedure Test_Remove_Tag (T : in out Test) is
      Sec_Ctx      : Security.Contexts.Security_Context;
      Context      : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-tag@test.com");

      declare
         Tag_Manager  : constant Tag_Module_Access := Get_Tag_Module;
         User         : constant AWA.Users.Models.User_Ref := Context.Get_User;
         List         : AWA.Tags.Beans.Tag_List_Bean_Access;
         Cleanup      : Util.Beans.Objects.Object;
      begin
         T.Assert (Tag_Manager /= null, "There is no tag module");

         List := Create_Tag_List_Bean (Tag_Manager);
         Cleanup := Util.Beans.Objects.To_Object (List.all'Access);
         List.Set_Value ("entity_type", Util.Beans.Objects.To_Object (String '("awa_user")));

         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-1");
         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-2");
         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-3");

         Tag_Manager.Remove_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-2");
         Tag_Manager.Remove_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-1");

         --  Load the list.
         List.Load_Tags (User.Get_Id);
         Util.Tests.Assert_Equals (T, 2, Integer (List.Get_Count), "Invalid number of tags");
      end;
   end Test_Remove_Tag;

end AWA.Tags.Modules.Tests;

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

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

with Security.Contexts;

with AWA.Users.Models;
with AWA.Services.Contexts;
with AWA.Tests.Helpers.Users;
with AWA.Tags.Beans;
package body AWA.Tags.Modules.Tests is

   use Util.Tests;
   use ADO;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Tags.Modules.Add_Tag",
                       Test_Add_Tag'Access);
      Caller.Add_Test (Suite, "Test AWA.Tags.Modules.Remove_Tag",
                       Test_Remove_Tag'Access);
   end Add_Tests;

   function Create_Tag_List_Bean (Module : in Tag_Module_Access)
                                  return AWA.Tags.Beans.Tag_List_Bean_Access is
      Bean : Util.Beans.Basic.Readonly_Bean_Access := AWA.Tags.Beans.Create_Tag_List_Bean (Module);
   begin
      return AWA.Tags.Beans.Tag_List_Bean'Class (Bean.all)'Access;
   end Create_Tag_List_Bean;

   --  ------------------------------
   --  Test tag creation.
   --  ------------------------------
   procedure Test_Add_Tag (T : in out Test) is
      Sec_Ctx      : Security.Contexts.Security_Context;
      Context      : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-add-tag@test.com");

      declare
         Tag_Manager  : constant Tag_Module_Access := Get_Tag_Module;
         User         : constant AWA.Users.Models.User_Ref := Context.Get_User;
         List         : AWA.Tags.Beans.Tag_List_Bean_Access;
         Cleanup      : Util.Beans.Objects.Object;
      begin
         T.Assert (Tag_Manager /= null, "There is no tag module");

         List := Create_Tag_List_Bean (Tag_Manager);
         Cleanup := Util.Beans.Objects.To_Object (List.all'Access);
         List.Set_Value ("entity_type", Util.Beans.Objects.To_Object (String '("awa_user")));

         --  Create a tag.
         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag");
         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag");

         --  Load the list.
         List.Load_Tags (Tag_Manager.Get_Session, User.Get_Id);

         Util.Tests.Assert_Equals (T, 1, Integer (List.Get_Count), "Invalid number of tags");
      end;
   end Test_Add_Tag;

   --  ------------------------------
   --  Test tag removal.
   --  ------------------------------
   procedure Test_Remove_Tag (T : in out Test) is
      Sec_Ctx      : Security.Contexts.Security_Context;
      Context      : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-tag@test.com");

      declare
         Tag_Manager  : constant Tag_Module_Access := Get_Tag_Module;
         User         : constant AWA.Users.Models.User_Ref := Context.Get_User;
         List         : AWA.Tags.Beans.Tag_List_Bean_Access;
         Cleanup      : Util.Beans.Objects.Object;
      begin
         T.Assert (Tag_Manager /= null, "There is no tag module");

         List := Create_Tag_List_Bean (Tag_Manager);
         Cleanup := Util.Beans.Objects.To_Object (List.all'Access);
         List.Set_Value ("entity_type", Util.Beans.Objects.To_Object (String '("awa_user")));

         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-1");
         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-2");
         Tag_Manager.Add_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-3");

         Tag_Manager.Remove_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-2");
         Tag_Manager.Remove_Tag (User.Get_Id, "awa_user", "workspaces-create", "user-tag-1");

         --  Load the list.
         List.Load_Tags (Tag_Manager.Get_Session, User.Get_Id);
         Util.Tests.Assert_Equals (T, 2, Integer (List.Get_Count), "Invalid number of tags");
      end;
   end Test_Remove_Tag;

end AWA.Tags.Modules.Tests;

Update the unit test

Update the unit test


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

with Util.Files;
with Util.Test_Caller;
with Util.Measures;

with Security.Contexts;
with Security.Policies.Roles;
with Security.Permissions.Tests;
package body Security.Policies.Tests is

   use Util.Tests;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin

      Caller.Add_Test (Suite, "Test Security.Permissions.Create_Role",
                       Test_Create_Role'Access);
      Caller.Add_Test (Suite, "Test Security.Permissions.Has_Permission",
                       Test_Has_Permission'Access);
      Caller.Add_Test (Suite, "Test Security.Permissions.Read_Policy (empty)",
                       Test_Read_Empty_Policy'Access);

      Caller.Add_Test (Suite, "Test Security.Policies.Add_Policy",
                       Test_Get_Role_Policy'Access);
      Caller.Add_Test (Suite, "Test Security.Policies.Get_Policy",
                       Test_Get_Role_Policy'Access);
      Caller.Add_Test (Suite, "Test Security.Policies.Roles.Get_Role_Policy",
                       Test_Get_Role_Policy'Access);

      Caller.Add_Test (Suite, "Test Security.Policies.Read_Policy",
                       Test_Read_Policy'Access);
      Caller.Add_Test (Suite, "Test Security.Policies.Roles.Set_Roles",
                       Test_Set_Roles'Access);
      Caller.Add_Test (Suite, "Test Security.Policies.Roles.Set_Roles (invalid)",
                       Test_Set_Invalid_Roles'Access);

      --  These tests are identical but registered under different names
      --  for the test documentation.
      Caller.Add_Test (Suite, "Test Security.Contexts.Has_Permission",
                       Test_Role_Policy'Access);
      Caller.Add_Test (Suite, "Test Security.Controllers.Roles.Has_Permission",
                       Test_Role_Policy'Access);
      Caller.Add_Test (Suite, "Test Security.Permissions.Role_Policy",
                       Test_Role_Policy'Access);
   end Add_Tests;

   --  ------------------------------
   --  Get the roles assigned to the user.
   --  ------------------------------
   function Get_Roles (User : in Test_Principal) return Roles.Role_Map is
   begin
      return User.Roles;
   end Get_Roles;

   --  ------------------------------
   --  Get the principal name.
   --  ------------------------------
   function Get_Name (From : in Test_Principal) return String is
   begin
      return Util.Strings.To_String (From.Name);
   end Get_Name;

   --  ------------------------------
   --  Test Create_Role and Get_Role_Name
   --  ------------------------------
   procedure Test_Create_Role (T : in out Test) is
      use Security.Policies.Roles;

      M     : Security.Policies.Roles.Role_Policy;
      Role  : Role_Type;
   begin
      M.Create_Role (Name => "admin",
                     Role => Role);
      Assert_Equals (T, "admin", M.Get_Role_Name (Role), "Invalid name");

      for I in Role + 1 .. Role_Type'Last loop
         declare
            Name : constant String := "admin-" & Role_Type'Image (I);
            Role2 : Role_Type;
         begin
            Role2 := M.Find_Role ("admin");
            T.Assert (Role2 = Role, "Find_Role returned an invalid role");

            M.Create_Role (Name => Name,
                           Role => Role2);
            Assert_Equals (T, Name, M.Get_Role_Name (Role2), "Invalid name");
         end;
      end loop;
   end Test_Create_Role;

   --  ------------------------------
   --  Test Set_Roles
   --  ------------------------------
   procedure Test_Set_Roles (T : in out Test) is
      use Security.Policies.Roles;

      M       : Security.Policies.Roles.Role_Policy;
      Admin   : Role_Type;
      Manager : Role_Type;
      Map     : Role_Map := (others => False);
   begin
      M.Create_Role (Name => "manager",
                     Role => Manager);
      M.Create_Role (Name => "admin",
                     Role => Admin);
      Assert_Equals (T, "admin", M.Get_Role_Name (Admin), "Invalid name");

      T.Assert (not Map (Admin), "The admin role must not set in the map");
      M.Set_Roles ("admin", Map);
      T.Assert (Map (Admin), "The admin role is not set in the map");
      T.Assert (not Map (Manager), "The manager role must not be set in the map");

      Map := (others => False);
      M.Set_Roles ("manager,admin", Map);
      T.Assert (Map (Admin), "The admin role is not set in the map");
      T.Assert (Map (Manager), "The manager role is not set in the map");

   end Test_Set_Roles;

   --  ------------------------------
   --  Test Set_Roles on an invalid role name
   --  ------------------------------
   procedure Test_Set_Invalid_Roles (T : in out Test) is
      use Security.Policies.Roles;

      M       : Security.Policies.Roles.Role_Policy;
      Map     : Role_Map := (others => False);
   begin
      M.Set_Roles ("manager,admin", Map);
      T.Assert (False, "No exception was raised");

   exception
      when E : Security.Policies.Roles.Invalid_Name =>
         null;
   end Test_Set_Invalid_Roles;

   --  ------------------------------
   --  Test Has_Permission
   --  ------------------------------
   procedure Test_Has_Permission (T : in out Test) is
      M    : Security.Policies.Policy_Manager (1);
--        Perm : Permissions.Permission_Type;
      User : Test_Principal;
   begin
      --        T.Assert (not M.Has_Permission (User, 1), "User has a non-existing permission");
      null;
   end Test_Has_Permission;

   procedure Configure_Policy (Manager : in out Security.Policies.Policy_Manager;
                               Name    : in String) is
      Dir         : constant String := "regtests/files/permissions/";
      Path        : constant String := Util.Tests.Get_Path (Dir);
      R           : Security.Policies.Roles.Role_Policy_Access := new Roles.Role_Policy;
      U           : Security.Policies.URLs.URL_Policy_Access := new URLs.URL_Policy;
   begin
      Manager.Add_Policy (R.all'Access);
      Manager.Add_Policy (U.all'Access);
      Manager.Read_Policy (Util.Files.Compose (Path, Name));
   end Configure_Policy;

   --  ------------------------------
   --  Test the Get_Policy, Get_Role_Policy and Add_Policy operations.
   --  ------------------------------
   procedure Test_Get_Role_Policy (T : in out Test) is
      use type Roles.Role_Policy_Access;

      M           : aliased Security.Policies.Policy_Manager (Max_Policies => 2);
      P           : Security.Policies.Policy_Access;
      R           : Security.Policies.Roles.Role_Policy_Access;
   begin
      P := M.Get_Policy (Security.Policies.Roles.NAME);
      T.Assert (P = null, "Get_Policy succeeded");

      R := Security.Policies.Roles.Get_Role_Policy (M);
      T.Assert (R = null, "Get_Role_Policy succeeded");

      R := new Roles.Role_Policy;
      M.Add_Policy (R.all'Access);

      P := M.Get_Policy (Security.Policies.Roles.NAME);
      T.Assert (P /= null, "Role policy not found");
      T.Assert (P.all in Roles.Role_Policy'Class, "Invalid role policy");

      R := Security.Policies.Roles.Get_Role_Policy (M);
      T.Assert (R /= null, "Get_Role_Policy should not return null");
   end Test_Get_Role_Policy;

   --  ------------------------------
   --  Test reading an empty policy file
   --  ------------------------------
   procedure Test_Read_Empty_Policy (T : in out Test) is
      M           : aliased Security.Policies.Policy_Manager (Max_Policies => 2);
      User        : aliased Test_Principal;
      Context     : aliased Security.Contexts.Security_Context;
      P           : Security.Policies.Policy_Access;
      R           : Security.Policies.Roles.Role_Policy_Access;
   begin
      Configure_Policy (M, "empty.xml");
      Context.Set_Context (Manager   => M'Unchecked_Access,
                           Principal => User'Unchecked_Access);

      R := Security.Policies.Roles.Get_Role_Policy (M);
      declare
         Admin : Policies.Roles.Role_Type;
      begin
         Admin := R.Find_Role ("admin");
         T.Fail ("'admin' role was returned");

      exception
         when Security.Policies.Roles.Invalid_Name =>
            null;
      end;

      T.Assert (not Contexts.Has_Permission (Permissions.Tests.P_Admin.Permission),
                "Has_Permission (admin) failed for empty policy");

      T.Assert (not Contexts.Has_Permission (Permissions.Tests.P_Create.Permission),
                "Has_Permission (create) failed for empty policy");

      T.Assert (not Contexts.Has_Permission (Permissions.Tests.P_Update.Permission),
                "Has_Permission (update) failed for empty policy");

      T.Assert (not Contexts.Has_Permission (Permissions.Tests.P_Delete.Permission),
                "Has_Permission (delete) failed for empty policy");

   end Test_Read_Empty_Policy;

   --  ------------------------------
   --  Test reading policy files
   --  ------------------------------
   procedure Test_Read_Policy (T : in out Test) is
      use Security.Permissions.Tests;

      M            : aliased Security.Policies.Policy_Manager (Max_Policies => 2);
      User         : aliased Test_Principal;
      Admin        : Policies.Roles.Role_Type;
      Manager_Perm : Policies.Roles.Role_Type;
      Context      : aliased Security.Contexts.Security_Context;
      R            : Security.Policies.Roles.Role_Policy_Access := new Roles.Role_Policy;
   begin
      Configure_Policy (M, "simple-policy.xml");
      Context.Set_Context (Manager   => M'Unchecked_Access,
                           Principal => User'Unchecked_Access);

      R := Security.Policies.Roles.Get_Role_Policy (M);
      Admin := R.Find_Role ("admin");

      T.Assert (not Contexts.Has_Permission (Permission => P_Admin.Permission),
                "Permission was granted but user has no role");

      User.Roles (Admin) := True;

      T.Assert (Contexts.Has_Permission (Permission => P_Admin.Permission),
                "Permission was not granted and user has admin role");

      declare
         S : Util.Measures.Stamp;
         Result : Boolean;
      begin
         for I in 1 .. 1_000 loop
            Result := Contexts.Has_Permission (Permission => P_Admin.Permission);
         end loop;
         Util.Measures.Report (S, "Has_Permission role based (1000 calls)");

         T.Assert (Result, "Permission not granted");
      end;
      declare
         use Security.Permissions.Tests;

         S : Util.Measures.Stamp;
      begin
         for I in 1 .. 1_000 loop
            declare
               URI : constant String := "/admin/home/list.html";
               P   : constant URLs.URI_Permission (URI'Length)
                 := URLs.URI_Permission '(Len => URI'Length, URI => URI);
            begin
               T.Assert (Contexts.Has_Permission (Permission => P_Admin.Permission),
                         "Permission not granted");
            end;
         end loop;
         Util.Measures.Report (S, "Has_Permission (1000 calls, cache hit)");
      end;

   end Test_Read_Policy;

   --  ------------------------------
   --  Read the policy file <b>File</b> and perform a test on the given URI
   --  with a user having the given role.
   --  ------------------------------
   procedure Check_Policy (T     : in out Test;
                           File  : in String;
                           Role  : in String;
                           URI : in String) is
      M           : aliased Security.Policies.Policy_Manager (2);
      User        : aliased Test_Principal;
      Admin       : Roles.Role_Type;
      Context     : aliased Security.Contexts.Security_Context;
      P           : Security.Policies.Policy_Access;
      R           : Security.Policies.Roles.Role_Policy_Access;
      U           : Security.Policies.URLs.URL_Policy_Access;
   begin
      Configure_Policy (M, File);

      Context.Set_Context (Manager   => M'Unchecked_Access,
                           Principal => User'Unchecked_Access);

      R := Security.Policies.Roles.Get_Role_Policy (M);
      U := Security.Policies.URLs.Get_URL_Policy (M);
      Admin := R.Find_Role (Role);

      declare
         P   : constant URLs.URI_Permission (URI'Length)
           := URLs.URI_Permission '(Len => URI'Length, URI => URI);
      begin
         --  A user without the role should not have the permission.
         T.Assert (not U.Has_Permission (Context    => Context'Unchecked_Access,
                                         Permission => P),
           "Permission was granted for user without role.  URI=" & URI);

         --  Set the role.
         User.Roles (Admin) := True;
         T.Assert (U.Has_Permission (Context    => Context'Unchecked_Access,
                                     Permission => P),
           "Permission was not granted for user with role.  URI=" & URI);
      end;
   end Check_Policy;

   --  ------------------------------
   --  Test reading policy files and using the <role-permission> controller
   --  ------------------------------
   procedure Test_Role_Policy (T : in out Test) is
   begin
      T.Check_Policy (File => "policy-with-role.xml",
                      Role => "developer",
                      URI  => "/developer/user-should-have-developer-role");
      T.Check_Policy (File => "policy-with-role.xml",
                      Role => "manager",
                      URI  => "/developer/user-should-have-manager-role");
      T.Check_Policy (File => "policy-with-role.xml",
                      Role => "manager",
                      URI  => "/manager/user-should-have-manager-role");
      T.Check_Policy (File => "policy-with-role.xml",
                      Role => "admin",
                      URI  => "/manager/user-should-have-admin-role");
      T.Check_Policy (File => "policy-with-role.xml",
                      Role => "admin",
                      URI  => "/admin/user-should-have-admin-role");
   end Test_Role_Policy;

end Security.Policies.Tests;

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

with Util.Files;
with Util.Test_Caller;
with Util.Measures;

with Security.Contexts;
with Security.Policies.Roles;
with Security.Permissions.Tests;
package body Security.Policies.Tests is

   use Util.Tests;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin

      Caller.Add_Test (Suite, "Test Security.Permissions.Create_Role",
                       Test_Create_Role'Access);
      Caller.Add_Test (Suite, "Test Security.Permissions.Has_Permission",
                       Test_Has_Permission'Access);
      Caller.Add_Test (Suite, "Test Security.Permissions.Read_Policy (empty)",
                       Test_Read_Empty_Policy'Access);

      Caller.Add_Test (Suite, "Test Security.Policies.Add_Policy",
                       Test_Get_Role_Policy'Access);
      Caller.Add_Test (Suite, "Test Security.Policies.Get_Policy",
                       Test_Get_Role_Policy'Access);
      Caller.Add_Test (Suite, "Test Security.Policies.Roles.Get_Role_Policy",
                       Test_Get_Role_Policy'Access);

      Caller.Add_Test (Suite, "Test Security.Policies.Read_Policy",
                       Test_Read_Policy'Access);
      Caller.Add_Test (Suite, "Test Security.Policies.Roles.Set_Roles",
                       Test_Set_Roles'Access);
      Caller.Add_Test (Suite, "Test Security.Policies.Roles.Set_Roles (invalid)",
                       Test_Set_Invalid_Roles'Access);

      --  These tests are identical but registered under different names
      --  for the test documentation.
      Caller.Add_Test (Suite, "Test Security.Contexts.Has_Permission",
                       Test_Role_Policy'Access);
      Caller.Add_Test (Suite, "Test Security.Controllers.Roles.Has_Permission",
                       Test_Role_Policy'Access);
      Caller.Add_Test (Suite, "Test Security.Permissions.Role_Policy",
                       Test_Role_Policy'Access);
   end Add_Tests;

   --  ------------------------------
   --  Get the roles assigned to the user.
   --  ------------------------------
   function Get_Roles (User : in Test_Principal) return Roles.Role_Map is
   begin
      return User.Roles;
   end Get_Roles;

   --  ------------------------------
   --  Get the principal name.
   --  ------------------------------
   function Get_Name (From : in Test_Principal) return String is
   begin
      return Util.Strings.To_String (From.Name);
   end Get_Name;

   --  ------------------------------
   --  Test Create_Role and Get_Role_Name
   --  ------------------------------
   procedure Test_Create_Role (T : in out Test) is
      use Security.Policies.Roles;

      M     : Security.Policies.Roles.Role_Policy;
      Role  : Role_Type;
   begin
      M.Create_Role (Name => "admin",
                     Role => Role);
      Assert_Equals (T, "admin", M.Get_Role_Name (Role), "Invalid name");

      for I in Role + 1 .. Role_Type'Last loop
         declare
            Name : constant String := "admin-" & Role_Type'Image (I);
            Role2 : Role_Type;
         begin
            Role2 := M.Find_Role ("admin");
            T.Assert (Role2 = Role, "Find_Role returned an invalid role");

            M.Create_Role (Name => Name,
                           Role => Role2);
            Assert_Equals (T, Name, M.Get_Role_Name (Role2), "Invalid name");
         end;
      end loop;
   end Test_Create_Role;

   --  ------------------------------
   --  Test Set_Roles
   --  ------------------------------
   procedure Test_Set_Roles (T : in out Test) is
      use Security.Policies.Roles;

      M       : Security.Policies.Roles.Role_Policy;
      Admin   : Role_Type;
      Manager : Role_Type;
      Map     : Role_Map := (others => False);
   begin
      M.Create_Role (Name => "manager",
                     Role => Manager);
      M.Create_Role (Name => "admin",
                     Role => Admin);
      Assert_Equals (T, "admin", M.Get_Role_Name (Admin), "Invalid name");

      T.Assert (not Map (Admin), "The admin role must not set in the map");
      M.Set_Roles ("admin", Map);
      T.Assert (Map (Admin), "The admin role is not set in the map");
      T.Assert (not Map (Manager), "The manager role must not be set in the map");

      Map := (others => False);
      M.Set_Roles ("manager,admin", Map);
      T.Assert (Map (Admin), "The admin role is not set in the map");
      T.Assert (Map (Manager), "The manager role is not set in the map");

   end Test_Set_Roles;

   --  ------------------------------
   --  Test Set_Roles on an invalid role name
   --  ------------------------------
   procedure Test_Set_Invalid_Roles (T : in out Test) is
      use Security.Policies.Roles;

      M       : Security.Policies.Roles.Role_Policy;
      Map     : Role_Map := (others => False);
   begin
      M.Set_Roles ("manager,admin", Map);
      T.Assert (False, "No exception was raised");

   exception
      when E : Security.Policies.Roles.Invalid_Name =>
         null;
   end Test_Set_Invalid_Roles;

   --  ------------------------------
   --  Test Has_Permission
   --  ------------------------------
   procedure Test_Has_Permission (T : in out Test) is
      M    : Security.Policies.Policy_Manager (1);
--        Perm : Permissions.Permission_Type;
      User : Test_Principal;
   begin
      --        T.Assert (not M.Has_Permission (User, 1), "User has a non-existing permission");
      null;
   end Test_Has_Permission;

   procedure Configure_Policy (Manager : in out Security.Policies.Policy_Manager;
                               Name    : in String) is
      Dir         : constant String := "regtests/files/permissions/";
      Path        : constant String := Util.Tests.Get_Path (Dir);
      R           : Security.Policies.Roles.Role_Policy_Access := new Roles.Role_Policy;
      U           : Security.Policies.URLs.URL_Policy_Access := new URLs.URL_Policy;
   begin
      Manager.Add_Policy (R.all'Access);
      Manager.Add_Policy (U.all'Access);
      Manager.Read_Policy (Util.Files.Compose (Path, Name));
   end Configure_Policy;

   --  ------------------------------
   --  Test the Get_Policy, Get_Role_Policy and Add_Policy operations.
   --  ------------------------------
   procedure Test_Get_Role_Policy (T : in out Test) is
      use type Roles.Role_Policy_Access;

      M           : aliased Security.Policies.Policy_Manager (Max_Policies => 2);
      P           : Security.Policies.Policy_Access;
      R           : Security.Policies.Roles.Role_Policy_Access;
   begin
      P := M.Get_Policy (Security.Policies.Roles.NAME);
      T.Assert (P = null, "Get_Policy succeeded");

      R := Security.Policies.Roles.Get_Role_Policy (M);
      T.Assert (R = null, "Get_Role_Policy succeeded");

      R := new Roles.Role_Policy;
      M.Add_Policy (R.all'Access);

      P := M.Get_Policy (Security.Policies.Roles.NAME);
      T.Assert (P /= null, "Role policy not found");
      T.Assert (P.all in Roles.Role_Policy'Class, "Invalid role policy");

      R := Security.Policies.Roles.Get_Role_Policy (M);
      T.Assert (R /= null, "Get_Role_Policy should not return null");
   end Test_Get_Role_Policy;

   --  ------------------------------
   --  Test reading an empty policy file
   --  ------------------------------
   procedure Test_Read_Empty_Policy (T : in out Test) is
      M           : aliased Security.Policies.Policy_Manager (Max_Policies => 2);
      User        : aliased Test_Principal;
      Context     : aliased Security.Contexts.Security_Context;
      P           : Security.Policies.Policy_Access;
      R           : Security.Policies.Roles.Role_Policy_Access;
   begin
      Configure_Policy (M, "empty.xml");
      Context.Set_Context (Manager   => M'Unchecked_Access,
                           Principal => User'Unchecked_Access);

      R := Security.Policies.Roles.Get_Role_Policy (M);
      declare
         Admin : Policies.Roles.Role_Type;
      begin
         Admin := R.Find_Role ("admin");
         T.Fail ("'admin' role was returned");

      exception
         when Security.Policies.Roles.Invalid_Name =>
            null;
      end;

      T.Assert (not Contexts.Has_Permission (Permissions.Tests.P_Admin.Permission),
                "Has_Permission (admin) failed for empty policy");

      T.Assert (not Contexts.Has_Permission (Permissions.Tests.P_Create.Permission),
                "Has_Permission (create) failed for empty policy");

      T.Assert (not Contexts.Has_Permission (Permissions.Tests.P_Update.Permission),
                "Has_Permission (update) failed for empty policy");

      T.Assert (not Contexts.Has_Permission (Permissions.Tests.P_Delete.Permission),
                "Has_Permission (delete) failed for empty policy");

   end Test_Read_Empty_Policy;

   --  ------------------------------
   --  Test reading policy files
   --  ------------------------------
   procedure Test_Read_Policy (T : in out Test) is
      use Security.Permissions.Tests;

      M            : aliased Security.Policies.Policy_Manager (Max_Policies => 2);
      User         : aliased Test_Principal;
      Admin        : Policies.Roles.Role_Type;
      Manager_Perm : Policies.Roles.Role_Type;
      Context      : aliased Security.Contexts.Security_Context;
      R            : Security.Policies.Roles.Role_Policy_Access;
   begin
      Configure_Policy (M, "simple-policy.xml");
      Context.Set_Context (Manager   => M'Unchecked_Access,
                           Principal => User'Unchecked_Access);

      R := Security.Policies.Roles.Get_Role_Policy (M);
      Admin := R.Find_Role ("admin");

      T.Assert (not Contexts.Has_Permission (Permission => P_Admin.Permission),
                "Permission was granted but user has no role");

      User.Roles (Admin) := True;

      T.Assert (Contexts.Has_Permission (Permission => P_Admin.Permission),
                "Permission was not granted and user has admin role");

      declare
         S : Util.Measures.Stamp;
         Result : Boolean;
      begin
         for I in 1 .. 1_000 loop
            Result := Contexts.Has_Permission (Permission => P_Admin.Permission);
         end loop;
         Util.Measures.Report (S, "Has_Permission role based (1000 calls)");

         T.Assert (Result, "Permission not granted");
      end;
      declare
         use Security.Permissions.Tests;

         S : Util.Measures.Stamp;
      begin
         for I in 1 .. 1_000 loop
            declare
               URI : constant String := "/admin/home/list.html";
               P   : constant URLs.URI_Permission (URI'Length)
                 := URLs.URI_Permission '(Len => URI'Length, URI => URI);
            begin
               T.Assert (Contexts.Has_Permission (Permission => P_Admin.Permission),
                         "Permission not granted");
            end;
         end loop;
         Util.Measures.Report (S, "Has_Permission (1000 calls, cache hit)");
      end;

   end Test_Read_Policy;

   --  ------------------------------
   --  Read the policy file <b>File</b> and perform a test on the given URI
   --  with a user having the given role.
   --  ------------------------------
   procedure Check_Policy (T     : in out Test;
                           File  : in String;
                           Role  : in String;
                           URI : in String) is
      M           : aliased Security.Policies.Policy_Manager (2);
      User        : aliased Test_Principal;
      Admin       : Roles.Role_Type;
      Context     : aliased Security.Contexts.Security_Context;
      P           : Security.Policies.Policy_Access;
      R           : Security.Policies.Roles.Role_Policy_Access;
      U           : Security.Policies.URLs.URL_Policy_Access;
   begin
      Configure_Policy (M, File);

      Context.Set_Context (Manager   => M'Unchecked_Access,
                           Principal => User'Unchecked_Access);

      R := Security.Policies.Roles.Get_Role_Policy (M);
      U := Security.Policies.URLs.Get_URL_Policy (M);
      Admin := R.Find_Role (Role);

      declare
         P   : constant URLs.URI_Permission (URI'Length)
           := URLs.URI_Permission '(Len => URI'Length, URI => URI);
      begin
         --  A user without the role should not have the permission.
         T.Assert (not U.Has_Permission (Context    => Context'Unchecked_Access,
                                         Permission => P),
           "Permission was granted for user without role.  URI=" & URI);

         --  Set the role.
         User.Roles (Admin) := True;
         T.Assert (U.Has_Permission (Context    => Context'Unchecked_Access,
                                     Permission => P),
           "Permission was not granted for user with role.  URI=" & URI);
      end;
   end Check_Policy;

   --  ------------------------------
   --  Test reading policy files and using the <role-permission> controller
   --  ------------------------------
   procedure Test_Role_Policy (T : in out Test) is
   begin
      T.Check_Policy (File => "policy-with-role.xml",
                      Role => "developer",
                      URI  => "/developer/user-should-have-developer-role");
      T.Check_Policy (File => "policy-with-role.xml",
                      Role => "manager",
                      URI  => "/developer/user-should-have-manager-role");
      T.Check_Policy (File => "policy-with-role.xml",
                      Role => "manager",
                      URI  => "/manager/user-should-have-manager-role");
      T.Check_Policy (File => "policy-with-role.xml",
                      Role => "admin",
                      URI  => "/manager/user-should-have-admin-role");
      T.Check_Policy (File => "policy-with-role.xml",
                      Role => "admin",
                      URI  => "/admin/user-should-have-admin-role");
   end Test_Role_Policy;

end Security.Policies.Tests;

Fix memory leak in unit test

Fix memory leak in unit test


-----------------------------------------------------------------------
--  render -- Wiki rendering example
--  Copyright (C) 2015, 2016, 2020, 2021, 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.Text_IO;
with Ada.IO_Exceptions;
with Ada.Strings.Unbounded;
with Ada.Directories;
with Ada.Command_Line;

with Wiki.Documents;
with Wiki.Parsers;
with Wiki.Strings;
with Wiki.Filters.TOC;
with Wiki.Filters.Html;
with Wiki.Filters.Autolink;
with Wiki.Plugins.Templates;
with Wiki.Render.Html;
with Wiki.Render.Text;
with Wiki.Streams.Text_IO;
with Wiki.Streams.Html.Text_IO;
with Wiki.Nodes.Dump;

procedure Render is

   use Ada.Strings.Unbounded;

   procedure Usage;
   procedure Render_Html (Doc   : in out Wiki.Documents.Document;
                          Style : in Unbounded_String);
   procedure Render_Text (Doc : in out Wiki.Documents.Document);

   Arg_Count : constant Natural := Ada.Command_Line.Argument_Count;
   Count     : Natural := 0;
   Html_Mode : Boolean := True;
   Html_Toc  : Boolean := False;
   Syntax    : Wiki.Wiki_Syntax := Wiki.SYNTAX_MARKDOWN;
   Style     : Unbounded_String;
   Indent    : Natural := 3;
   Dump_Tree : Boolean := False;

   procedure Usage is
   begin
      Ada.Text_IO.Put_Line ("Render a wiki text file into HTML (default) or text");
      Ada.Text_IO.Put_Line ("Usage: render [-t] [-m] [-M] [-H] [-d] [-c] [-s style] {wiki-file}");
      Ada.Text_IO.Put_Line ("  -t        Render to text only");
      Ada.Text_IO.Put_Line ("  -m        Render a Markdown wiki content");
      Ada.Text_IO.Put_Line ("  -M        Render a Mediawiki wiki content");
      Ada.Text_IO.Put_Line ("  -T        Render a Textile wiki content");
      Ada.Text_IO.Put_Line ("  -H        Render a HTML wiki content");
      Ada.Text_IO.Put_Line ("  -d        Render a Dotclear wiki content");
      Ada.Text_IO.Put_Line ("  -g        Render a Google wiki content");
      Ada.Text_IO.Put_Line ("  -c        Render a Creole wiki content");
      Ada.Text_IO.Put_Line ("  -s style  Use the CSS style file");
      Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
   end Usage;

   procedure Render_Html (Doc   : in out Wiki.Documents.Document;
                          Style : in Unbounded_String) is
      Output   : aliased Wiki.Streams.Html.Text_IO.Html_Output_Stream;
      Renderer : aliased Wiki.Render.Html.Html_Renderer;
   begin
      Output.Set_Indent_Level (Indent);
      if Length (Style) > 0 then
         Output.Start_Element ("html");
         Output.Start_Element ("head");
         Output.Start_Element ("link");
         Output.Write_Attribute ("type", "text/css");
         Output.Write_Attribute ("rel", "stylesheet");
         Output.Write_Attribute ("href", To_String (Style));
         Output.End_Element ("link");
         Output.End_Element ("head");
         Output.Start_Element ("body");
      end if;
      Renderer.Set_Output_Stream (Output'Unchecked_Access);
      Renderer.Set_Render_TOC (Html_Toc);
      Renderer.Render (Doc);
      if Length (Style) > 0 then
         Output.End_Element ("body");
         Output.End_Element ("html");
      end if;
   end Render_Html;

   procedure Render_Text (Doc : in out Wiki.Documents.Document) is
      Output   : aliased Wiki.Streams.Text_IO.File_Output_Stream;
      Renderer : aliased Wiki.Render.Text.Text_Renderer;
   begin
      Renderer.Set_Output_Stream (Output'Unchecked_Access);
      Renderer.Render (Doc);
   end Render_Text;

   procedure Dump (Doc : in Wiki.Documents.Document) is
      procedure Write (Indent : in Positive;
                       Line   : in Wiki.Strings.WString) is
         S : constant String := Wiki.Strings.To_String (Line);
      begin
         Ada.Text_IO.Set_Col (Ada.Text_Io.Count (Indent));
         Ada.Text_IO.Put_Line (S);
      end Write;

      procedure Dump is
         new Wiki.Nodes.Dump (Write);
   begin
      Doc.Iterate (Dump'Access);
   end Dump;

   procedure Render_File (Name : in String) is
      Input    : aliased Wiki.Streams.Text_IO.File_Input_Stream;
      Filter   : aliased Wiki.Filters.Html.Html_Filter_Type;
      Autolink : aliased Wiki.Filters.Autolink.Autolink_Filter;
      Template : aliased Wiki.Plugins.Templates.File_Template_Plugin;
      TOC      : aliased Wiki.Filters.TOC.TOC_Filter;
      Doc      : Wiki.Documents.Document;
      Engine   : Wiki.Parsers.Parser;
   begin
      Count := Count + 1;

      Template.Set_Template_Path (Ada.Directories.Containing_Directory (Name));

      --  Open the file and parse it (assume UTF-8).
      if Name /= "--" then
         Input.Open (Name, "WCEM=8");
      end if;
      Engine.Set_Plugin_Factory (Template'Unchecked_Access);
      Engine.Add_Filter (TOC'Unchecked_Access);
      Engine.Add_Filter (Autolink'Unchecked_Access);
      Engine.Add_Filter (Filter'Unchecked_Access);
      Engine.Set_Syntax (Syntax);
      Engine.Parse (Input'Unchecked_Access, Doc);

      --  Render the document in text or HTML.
      if Dump_Tree then
         Dump (Doc);
      elsif Html_Mode then
         Render_Html (Doc, Style);
      else
         Render_Text (Doc);
      end if;

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

   end Render_File;

begin
   for I in 1 .. Arg_Count loop
      declare
         Param : constant String := Ada.Command_Line.Argument (I);
      begin
         if Param = "-m" then
            Syntax := Wiki.SYNTAX_MARKDOWN;
         elsif Param = "-M" then
            Syntax := Wiki.SYNTAX_MEDIA_WIKI;
         elsif Param = "-c" then
            Syntax := Wiki.SYNTAX_CREOLE;
         elsif Param = "-d" then
            Syntax := Wiki.SYNTAX_DOTCLEAR;
         elsif Param = "-H" then
            Syntax := Wiki.SYNTAX_HTML;
         elsif Param = "-T" then
            Syntax := Wiki.SYNTAX_TEXTILE;
         elsif Param = "-g" then
            Syntax := Wiki.SYNTAX_GOOGLE;
         elsif Param = "-t" then
            Html_Mode := False;
         elsif Param = "-z" then
            Html_Toc := True;
         elsif Param = "-s" then
            Style := To_Unbounded_String (Param);
         elsif Param = "--" then
            Render_File (Param);
         elsif Param = "-0" then
            Indent := 0;
         elsif Param = "-1" then
            Indent := 1;
         elsif Param = "-2" then
            Indent := 2;
         elsif Param = "-dump" then
            Dump_Tree := True;
         elsif Param (Param'First) = '-' then
            Usage;
            return;
         else
            Render_File (Param);
         end if;
      end;
   end loop;

   if Count = 0 then
      Usage;
   end if;

end Render;

-----------------------------------------------------------------------
--  render -- Wiki rendering example
--  Copyright (C) 2015, 2016, 2020, 2021, 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.Text_IO;
with Ada.IO_Exceptions;
with Ada.Strings.Unbounded;
with Ada.Directories;
with Ada.Command_Line;

with Wiki.Documents;
with Wiki.Parsers;
with Wiki.Strings;
with Wiki.Filters.TOC;
with Wiki.Filters.Html;
with Wiki.Filters.Autolink;
with Wiki.Plugins.Templates;
with Wiki.Render.Html;
with Wiki.Render.Text;
with Wiki.Streams.Text_IO;
with Wiki.Streams.Html.Text_IO;
with Wiki.Nodes.Dump;

procedure Render is

   use Ada.Strings.Unbounded;

   procedure Usage;
   procedure Render_Html (Doc   : in out Wiki.Documents.Document;
                          Style : in Unbounded_String);
   procedure Render_Text (Doc : in out Wiki.Documents.Document);
   procedure Dump (Doc : in Wiki.Documents.Document);
   procedure Render_File (Name : in String);

   Arg_Count : constant Natural := Ada.Command_Line.Argument_Count;
   Count     : Natural := 0;
   Html_Mode : Boolean := True;
   Html_Toc  : Boolean := False;
   Syntax    : Wiki.Wiki_Syntax := Wiki.SYNTAX_MARKDOWN;
   Style     : Unbounded_String;
   Indent    : Natural := 3;
   Dump_Tree : Boolean := False;

   procedure Usage is
   begin
      Ada.Text_IO.Put_Line ("Render a wiki text file into HTML (default) or text");
      Ada.Text_IO.Put_Line ("Usage: render [options] {wiki-file}");
      Ada.Text_IO.Put_Line ("  -0, -1, -2  Controls the indentation level");
      Ada.Text_IO.Put_Line ("  -t          Render to text only");
      Ada.Text_IO.Put_Line ("  -m          Render a Markdown wiki content");
      Ada.Text_IO.Put_Line ("  -M          Render a Mediawiki wiki content");
      Ada.Text_IO.Put_Line ("  -T          Render a Textile wiki content");
      Ada.Text_IO.Put_Line ("  -H          Render a HTML wiki content");
      Ada.Text_IO.Put_Line ("  -d          Render a Dotclear wiki content");
      Ada.Text_IO.Put_Line ("  -g          Render a Google wiki content");
      Ada.Text_IO.Put_Line ("  -c          Render a Creole wiki content");
      Ada.Text_IO.Put_Line ("  -s style    Use the CSS style file");
      Ada.Text_IO.Put_Line ("  -dump       Dump the document tree");
      Ada.Command_Line.Set_Exit_Status (Ada.Command_Line.Failure);
   end Usage;

   procedure Render_Html (Doc   : in out Wiki.Documents.Document;
                          Style : in Unbounded_String) is
      Output   : aliased Wiki.Streams.Html.Text_IO.Html_Output_Stream;
      Renderer : aliased Wiki.Render.Html.Html_Renderer;
   begin
      Output.Set_Indent_Level (Indent);
      if Length (Style) > 0 then
         Output.Start_Element ("html");
         Output.Start_Element ("head");
         Output.Start_Element ("link");
         Output.Write_Attribute ("type", "text/css");
         Output.Write_Attribute ("rel", "stylesheet");
         Output.Write_Attribute ("href", To_String (Style));
         Output.End_Element ("link");
         Output.End_Element ("head");
         Output.Start_Element ("body");
      end if;
      Renderer.Set_Output_Stream (Output'Unchecked_Access);
      Renderer.Set_Render_TOC (Html_Toc);
      Renderer.Render (Doc);
      if Length (Style) > 0 then
         Output.End_Element ("body");
         Output.End_Element ("html");
      end if;
   end Render_Html;

   procedure Render_Text (Doc : in out Wiki.Documents.Document) is
      Output   : aliased Wiki.Streams.Text_IO.File_Output_Stream;
      Renderer : aliased Wiki.Render.Text.Text_Renderer;
   begin
      Renderer.Set_Output_Stream (Output'Unchecked_Access);
      Renderer.Render (Doc);
   end Render_Text;

   procedure Dump (Doc : in Wiki.Documents.Document) is
      procedure Write (Indent : in Positive;
                       Line   : in Wiki.Strings.WString);

      procedure Write (Indent : in Positive;
                       Line   : in Wiki.Strings.WString) is
         S : constant String := Wiki.Strings.To_String (Line);
      begin
         Ada.Text_IO.Set_Col (Ada.Text_IO.Count (Indent));
         Ada.Text_IO.Put_Line (S);
      end Write;

      procedure Dump is
         new Wiki.Nodes.Dump (Write);
   begin
      Doc.Iterate (Dump'Access);
   end Dump;

   procedure Render_File (Name : in String) is
      Input    : aliased Wiki.Streams.Text_IO.File_Input_Stream;
      Filter   : aliased Wiki.Filters.Html.Html_Filter_Type;
      Autolink : aliased Wiki.Filters.Autolink.Autolink_Filter;
      Template : aliased Wiki.Plugins.Templates.File_Template_Plugin;
      TOC      : aliased Wiki.Filters.TOC.TOC_Filter;
      Doc      : Wiki.Documents.Document;
      Engine   : Wiki.Parsers.Parser;
   begin
      Count := Count + 1;

      Template.Set_Template_Path (Ada.Directories.Containing_Directory (Name));

      --  Open the file and parse it (assume UTF-8).
      if Name /= "--" then
         Input.Open (Name, "WCEM=8");
      end if;
      Engine.Set_Plugin_Factory (Template'Unchecked_Access);
      Engine.Add_Filter (TOC'Unchecked_Access);
      Engine.Add_Filter (Autolink'Unchecked_Access);
      Engine.Add_Filter (Filter'Unchecked_Access);
      Engine.Set_Syntax (Syntax);
      Engine.Parse (Input'Unchecked_Access, Doc);

      --  Render the document in text or HTML.
      if Dump_Tree then
         Dump (Doc);
      elsif Html_Mode then
         Render_Html (Doc, Style);
      else
         Render_Text (Doc);
      end if;

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

   end Render_File;

begin
   for I in 1 .. Arg_Count loop
      declare
         Param : constant String := Ada.Command_Line.Argument (I);
      begin
         if Param = "-m" then
            Syntax := Wiki.SYNTAX_MARKDOWN;
         elsif Param = "-M" then
            Syntax := Wiki.SYNTAX_MEDIA_WIKI;
         elsif Param = "-c" then
            Syntax := Wiki.SYNTAX_CREOLE;
         elsif Param = "-d" then
            Syntax := Wiki.SYNTAX_DOTCLEAR;
         elsif Param = "-H" then
            Syntax := Wiki.SYNTAX_HTML;
         elsif Param = "-T" then
            Syntax := Wiki.SYNTAX_TEXTILE;
         elsif Param = "-g" then
            Syntax := Wiki.SYNTAX_GOOGLE;
         elsif Param = "-t" then
            Html_Mode := False;
         elsif Param = "-z" then
            Html_Toc := True;
         elsif Param = "-s" then
            Style := To_Unbounded_String (Param);
         elsif Param = "--" then
            Render_File (Param);
         elsif Param = "-0" then
            Indent := 0;
         elsif Param = "-1" then
            Indent := 1;
         elsif Param = "-2" then
            Indent := 2;
         elsif Param = "-dump" then
            Dump_Tree := True;
         elsif Param (Param'First) = '-' then
            Usage;
            return;
         else
            Render_File (Param);
         end if;
      end;
   end loop;

   if Count = 0 then
      Usage;
   end if;

end Render;

Update the program usage

Update the program usage


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

with AWA.Users.Services.Tests;
with AWA.Users.Tests;
with AWA.Blogs.Services.Tests;
with AWA.Wikis.Parsers.Tests;
with AWA.Wikis.Writers.Tests;
with AWA.Helpers.Selectors.Tests;
with AWA.Storages.Services.Tests;
with AWA.Events.Services.Tests;
with AWA.Mail.Clients.Tests;
with AWA.Mail.Modules.Tests;
with AWA.Images.Services.Tests;
with AWA.Votes.Modules.Tests;
with AWA.Questions.Services.Tests;
with AWA.Modules.Tests;

with ASF.Converters.Dates;

with AWA.Users.Modules;
with AWA.Mail.Modules;
with AWA.Blogs.Modules;
with AWA.Workspaces.Modules;
with AWA.Storages.Modules;
with AWA.Images.Modules;
with AWA.Questions.Modules;
with AWA.Votes.Modules;

with AWA.Converters.Dates;
with AWA.Tests;
with AWA.Services.Contexts;
with AWA.Jobs.Services.Tests;
with AWA.Jobs.Modules.Tests;

with ASF.Server.Web;
with ASF.Server.Tests;
package body AWA.Testsuite is
   Users          : aliased AWA.Users.Modules.User_Module;

   Workspaces     : aliased AWA.Workspaces.Modules.Workspace_Module;

   Mail           : aliased AWA.Mail.Modules.Mail_Module;

   Jobs           : aliased AWA.Jobs.Modules.Job_Module;

   Blogs          : aliased AWA.Blogs.Modules.Blog_Module;

   Storages       : aliased AWA.Storages.Modules.Storage_Module;

   Images         : aliased AWA.Images.Modules.Image_Module;

   Questions      : aliased AWA.Questions.Modules.Question_Module;

   Votes          : aliased AWA.Votes.Modules.Vote_Module;

   Date_Converter : aliased ASF.Converters.Dates.Date_Converter;

   Rel_Date_Converter : aliased AWA.Converters.Dates.Relative_Date_Converter;

   Tests : aliased Util.Tests.Test_Suite;

   function Suite return Util.Tests.Access_Test_Suite is
      Ret : constant Util.Tests.Access_Test_Suite := Tests'Access;
   begin
      AWA.Modules.Tests.Add_Tests (Ret);
      AWA.Events.Services.Tests.Add_Tests (Ret);
      AWA.Mail.Clients.Tests.Add_Tests (Ret);
      AWA.Mail.Modules.Tests.Add_Tests (Ret);
      AWA.Users.Services.Tests.Add_Tests (Ret);
      AWA.Users.Tests.Add_Tests (Ret);
      AWA.Wikis.Parsers.Tests.Add_Tests (Ret);
      AWA.Wikis.Writers.Tests.Add_Tests (Ret);
      AWA.Helpers.Selectors.Tests.Add_Tests (Ret);
      AWA.Jobs.Modules.Tests.Add_Tests (Ret);
      AWA.Jobs.Services.Tests.Add_Tests (Ret);
      AWA.Blogs.Services.Tests.Add_Tests (Ret);
      AWA.Storages.Services.Tests.Add_Tests (Ret);
      AWA.Images.Services.Tests.Add_Tests (Ret);
      AWA.Votes.Modules.Tests.Add_Tests (Ret);
      AWA.Questions.Services.Tests.Add_Tests (Ret);
      return Ret;
   end Suite;

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

   --  ------------------------------
   --  Initialize the AWA test framework mockup.
   --  ------------------------------
   procedure Initialize (App         : in AWA.Applications.Application_Access;
                         Props       : in Util.Properties.Manager;
                         Add_Modules : in Boolean) is
      use AWA.Applications;
   begin
      AWA.Tests.Initialize (App, Props, Add_Modules);

      if Add_Modules then
         declare
            Application : constant Applications.Application_Access := AWA.Tests.Get_Application;
            Ctx         : AWA.Services.Contexts.Service_Context;
            Users  : constant AWA.Users.Modules.User_Module_Access := AWA.Testsuite.Users'Access;
         begin
            Ctx.Set_Context (Application, null);
            Register (App    => Application.all'Access,
                      Name   => AWA.Users.Modules.NAME,
                      URI    => "user",
                      Module => Users.all'Access);

            Register (App    => Application.all'Access,
                      Name   => "mail",
                      URI    => "mail",
                      Module => Mail'Access);

            Register (App    => Application.all'Access,
                      Name   => "workspaces",
                      URI    => "workspaces",
                      Module => Workspaces'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Storages.Modules.NAME,
                      URI    => "storages",
                      Module => Storages'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Images.Modules.NAME,
                      URI    => "images",
                      Module => Images'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Jobs.Modules.NAME,
                      URI    => "jobs",
                      Module => Jobs'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Votes.Modules.NAME,
                      URI    => "votes",
                      Module => Votes'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Blogs.Modules.NAME,
                      URI    => "blogs",
                      Module => Blogs'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Questions.Modules.NAME,
                      URI    => "questions",
                      Module => Questions'Access);

            Application.Start;
            if Props.Exists ("test.server") then
               declare
                  WS : ASF.Server.Web.AWS_Container;
               begin
                  Application.Add_Converter (Name      => "dateConverter",
                                             Converter => Date_Converter'Access);
                  Application.Add_Converter (Name      => "smartDateConverter",
                                             Converter => Rel_Date_Converter'Access);

                  WS.Register_Application ("/asfunit", Application.all'Access);

                  WS.Start;
                  delay 6000.0;
               end;
            end if;
            ASF.Server.Tests.Set_Context (Application.all'Access);
         end;
      end if;
   end Initialize;

end AWA.Testsuite;

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

with AWA.Users.Services.Tests;
with AWA.Users.Tests;
with AWA.Blogs.Services.Tests;
with AWA.Wikis.Parsers.Tests;
with AWA.Wikis.Writers.Tests;
with AWA.Helpers.Selectors.Tests;
with AWA.Storages.Services.Tests;
with AWA.Events.Services.Tests;
with AWA.Mail.Clients.Tests;
with AWA.Mail.Modules.Tests;
with AWA.Images.Services.Tests;
with AWA.Votes.Modules.Tests;
with AWA.Questions.Modules.Tests;
with AWA.Modules.Tests;

with ASF.Converters.Dates;

with AWA.Users.Modules;
with AWA.Mail.Modules;
with AWA.Blogs.Modules;
with AWA.Workspaces.Modules;
with AWA.Storages.Modules;
with AWA.Images.Modules;
with AWA.Questions.Modules;
with AWA.Votes.Modules;

with AWA.Converters.Dates;
with AWA.Tests;
with AWA.Services.Contexts;
with AWA.Jobs.Services.Tests;
with AWA.Jobs.Modules.Tests;

with ASF.Server.Web;
with ASF.Server.Tests;
package body AWA.Testsuite is
   Users          : aliased AWA.Users.Modules.User_Module;

   Workspaces     : aliased AWA.Workspaces.Modules.Workspace_Module;

   Mail           : aliased AWA.Mail.Modules.Mail_Module;

   Jobs           : aliased AWA.Jobs.Modules.Job_Module;

   Blogs          : aliased AWA.Blogs.Modules.Blog_Module;

   Storages       : aliased AWA.Storages.Modules.Storage_Module;

   Images         : aliased AWA.Images.Modules.Image_Module;

   Questions      : aliased AWA.Questions.Modules.Question_Module;

   Votes          : aliased AWA.Votes.Modules.Vote_Module;

   Date_Converter : aliased ASF.Converters.Dates.Date_Converter;

   Rel_Date_Converter : aliased AWA.Converters.Dates.Relative_Date_Converter;

   Tests : aliased Util.Tests.Test_Suite;

   function Suite return Util.Tests.Access_Test_Suite is
      Ret : constant Util.Tests.Access_Test_Suite := Tests'Access;
   begin
      AWA.Modules.Tests.Add_Tests (Ret);
      AWA.Events.Services.Tests.Add_Tests (Ret);
      AWA.Mail.Clients.Tests.Add_Tests (Ret);
      AWA.Mail.Modules.Tests.Add_Tests (Ret);
      AWA.Users.Services.Tests.Add_Tests (Ret);
      AWA.Users.Tests.Add_Tests (Ret);
      AWA.Wikis.Parsers.Tests.Add_Tests (Ret);
      AWA.Wikis.Writers.Tests.Add_Tests (Ret);
      AWA.Helpers.Selectors.Tests.Add_Tests (Ret);
      AWA.Jobs.Modules.Tests.Add_Tests (Ret);
      AWA.Jobs.Services.Tests.Add_Tests (Ret);
      AWA.Blogs.Services.Tests.Add_Tests (Ret);
      AWA.Storages.Services.Tests.Add_Tests (Ret);
      AWA.Images.Services.Tests.Add_Tests (Ret);
      AWA.Votes.Modules.Tests.Add_Tests (Ret);
      AWA.Questions.Modules.Tests.Add_Tests (Ret);
      return Ret;
   end Suite;

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

   --  ------------------------------
   --  Initialize the AWA test framework mockup.
   --  ------------------------------
   procedure Initialize (App         : in AWA.Applications.Application_Access;
                         Props       : in Util.Properties.Manager;
                         Add_Modules : in Boolean) is
      use AWA.Applications;
   begin
      AWA.Tests.Initialize (App, Props, Add_Modules);

      if Add_Modules then
         declare
            Application : constant Applications.Application_Access := AWA.Tests.Get_Application;
            Ctx         : AWA.Services.Contexts.Service_Context;
            Users  : constant AWA.Users.Modules.User_Module_Access := AWA.Testsuite.Users'Access;
         begin
            Ctx.Set_Context (Application, null);
            Register (App    => Application.all'Access,
                      Name   => AWA.Users.Modules.NAME,
                      URI    => "user",
                      Module => Users.all'Access);

            Register (App    => Application.all'Access,
                      Name   => "mail",
                      URI    => "mail",
                      Module => Mail'Access);

            Register (App    => Application.all'Access,
                      Name   => "workspaces",
                      URI    => "workspaces",
                      Module => Workspaces'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Storages.Modules.NAME,
                      URI    => "storages",
                      Module => Storages'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Images.Modules.NAME,
                      URI    => "images",
                      Module => Images'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Jobs.Modules.NAME,
                      URI    => "jobs",
                      Module => Jobs'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Votes.Modules.NAME,
                      URI    => "votes",
                      Module => Votes'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Blogs.Modules.NAME,
                      URI    => "blogs",
                      Module => Blogs'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Questions.Modules.NAME,
                      URI    => "questions",
                      Module => Questions'Access);

            Application.Start;
            if Props.Exists ("test.server") then
               declare
                  WS : ASF.Server.Web.AWS_Container;
               begin
                  Application.Add_Converter (Name      => "dateConverter",
                                             Converter => Date_Converter'Access);
                  Application.Add_Converter (Name      => "smartDateConverter",
                                             Converter => Rel_Date_Converter'Access);

                  WS.Register_Application ("/asfunit", Application.all'Access);

                  WS.Start;
                  delay 6000.0;
               end;
            end if;
            ASF.Server.Tests.Set_Context (Application.all'Access);
         end;
      end if;
   end Initialize;

end AWA.Testsuite;

Update the testsuite

Update the testsuite


-----------------------------------------------------------------------
--  wiki-render-html -- Wiki HTML renderer
--  Copyright (C) 2011, 2012, 2013, 2014, 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.Characters.Conversions;
with Util.Strings;

package body Wiki.Render.Html is

   package ACC renames Ada.Characters.Conversions;

   --  ------------------------------
   --  Set the output writer.
   --  ------------------------------
   procedure Set_Writer (Document : in out Html_Renderer;
                         Writer   : in Wiki.Writers.Html_Writer_Type_Access) is
   begin
      Document.Writer := Writer;
   end Set_Writer;

   --  ------------------------------
   --  Set the link renderer.
   --  ------------------------------
   procedure Set_Link_Renderer (Document : in out Html_Renderer;
                                Links    : in Link_Renderer_Access) is
   begin
      Document.Links := Links;
   end Set_Link_Renderer;

   --  ------------------------------
   --  Add a section header in the document.
   --  ------------------------------
   overriding
   procedure Add_Header (Document : in out Html_Renderer;
                         Header   : in Unbounded_Wide_Wide_String;
                         Level    : in Positive) is
   begin
      Document.Close_Paragraph;
      Document.Add_Blockquote (0);
      case Level is
         when 1 =>
            Document.Writer.Write_Wide_Element ("h1", Header);

         when 2 =>
            Document.Writer.Write_Wide_Element ("h2", Header);

         when 3 =>
            Document.Writer.Write_Wide_Element ("h3", Header);

         when 4 =>
            Document.Writer.Write_Wide_Element ("h4", Header);

         when 5 =>
            Document.Writer.Write_Wide_Element ("h5", Header);

         when 6 =>
            Document.Writer.Write_Wide_Element ("h6", Header);

         when others =>
            Document.Writer.Write_Wide_Element ("h3", Header);
      end case;
   end Add_Header;

   --  ------------------------------
   --  Add a line break (
).
   --  ------------------------------
   overriding
   procedure Add_Line_Break (Document : in out Html_Renderer) is
   begin
      Document.Writer.Write ("
");
   end Add_Line_Break;

   --  ------------------------------
   --  Add a paragraph (
).  Close the previous paragraph if any.
   --  The paragraph must be closed at the next paragraph or next header.
   --  ------------------------------
   overriding
   procedure Add_Paragraph (Document : in out Html_Renderer) is
   begin
      Document.Close_Paragraph;
      Document.Need_Paragraph := True;
   end Add_Paragraph;

   --  ------------------------------
   --  Add a blockquote (
).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   --  ------------------------------
   overriding
   procedure Add_Blockquote (Document : in out Html_Renderer;
                             Level    : in Natural) is
   begin
      if Document.Quote_Level /= Level then
         Document.Close_Paragraph;
         Document.Need_Paragraph := True;
      end if;
      while Document.Quote_Level < Level loop
         Document.Writer.Start_Element ("blockquote");
         Document.Quote_Level := Document.Quote_Level + 1;
      end loop;
      while Document.Quote_Level > Level loop
         Document.Writer.End_Element ("blockquote");
         Document.Quote_Level := Document.Quote_Level - 1;
      end loop;
   end Add_Blockquote;

   --  ------------------------------
   --  Add a list item (
).  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 Html_Renderer;
                            Level    : in Positive;
                            Ordered  : in Boolean) is
   begin
      if Document.Has_Paragraph then
         Document.Writer.End_Element ("p");
         Document.Has_Paragraph := False;
      end if;
      if Document.Has_Item then
         Document.Writer.End_Element ("li");
         Document.Has_Item := False;
      end if;
      Document.Need_Paragraph := False;
      Document.Open_Paragraph;
      while Document.Current_Level < Level loop
         if Ordered then
            Document.Writer.Start_Element ("ol");
         else
            Document.Writer.Start_Element ("ul");
         end if;
         Document.Current_Level := Document.Current_Level + 1;
         Document.List_Styles (Document.Current_Level) := Ordered;
      end loop;
   end Add_List_Item;

   procedure Close_Paragraph (Document : in out Html_Renderer) is
   begin
      if Document.Html_Level > 0 then
         return;
      end if;
      if Document.Has_Paragraph then
         Document.Writer.End_Element ("p");
      end if;
      if Document.Has_Item then
         Document.Writer.End_Element ("li");
      end if;
      while Document.Current_Level > 0 loop
         if Document.List_Styles (Document.Current_Level) then
            Document.Writer.End_Element ("ol");
         else
            Document.Writer.End_Element ("ul");
         end if;
         Document.Current_Level := Document.Current_Level - 1;
      end loop;
      Document.Has_Paragraph := False;
      Document.Has_Item := False;
   end Close_Paragraph;

   procedure Open_Paragraph (Document : in out Html_Renderer) is
   begin
      if Document.Html_Level > 0 then
         return;
      end if;
      if Document.Need_Paragraph then
         Document.Writer.Start_Element ("p");
         Document.Has_Paragraph  := True;
         Document.Need_Paragraph := False;
      end if;
      if Document.Current_Level > 0 and not Document.Has_Item then
         Document.Writer.Start_Element ("li");
         Document.Has_Item := True;
      end if;
   end Open_Paragraph;

   --  ------------------------------
   --  Add an horizontal rule (
).
   --  ------------------------------
   overriding
   procedure Add_Horizontal_Rule (Document : in out Html_Renderer) is
   begin
      Document.Close_Paragraph;
      Document.Add_Blockquote (0);
      Document.Writer.Start_Element ("hr");
      Document.Writer.End_Element ("hr");
   end Add_Horizontal_Rule;

   --  ------------------------------
   --  Add a link.
   --  ------------------------------
   overriding
   procedure Add_Link (Document : in out Html_Renderer;
                       Name     : in Unbounded_Wide_Wide_String;
                       Link     : in Unbounded_Wide_Wide_String;
                       Language : in Unbounded_Wide_Wide_String;
                       Title    : in Unbounded_Wide_Wide_String) is
      Exists : Boolean;
      URI    : Unbounded_Wide_Wide_String;
   begin
      Document.Open_Paragraph;
      Document.Writer.Start_Element ("a");
      if Length (Title) > 0 then
         Document.Writer.Write_Wide_Attribute ("title", Title);
      end if;
      if Length (Language) > 0 then
         Document.Writer.Write_Wide_Attribute ("lang", Language);
      end if;
      Document.Links.Make_Page_Link (Link, URI, Exists);
      Document.Writer.Write_Wide_Attribute ("href", URI);
      Document.Writer.Write_Wide_Text (Name);
      Document.Writer.End_Element ("a");
   end Add_Link;

   --  ------------------------------
   --  Add an image.
   --  ------------------------------
   overriding
   procedure Add_Image (Document    : in out Html_Renderer;
                        Link        : in Unbounded_Wide_Wide_String;
                        Alt         : in Unbounded_Wide_Wide_String;
                        Position    : in Unbounded_Wide_Wide_String;
                        Description : in Unbounded_Wide_Wide_String) is
      pragma Unreferenced (Position);

      URI    : Unbounded_Wide_Wide_String;
      Width  : Natural;
      Height : Natural;
   begin
      Document.Open_Paragraph;
      Document.Writer.Start_Element ("img");
      if Length (Alt) > 0 then
         Document.Writer.Write_Wide_Attribute ("alt", Alt);
      end if;
      if Length (Description) > 0 then
         Document.Writer.Write_Wide_Attribute ("longdesc", Description);
      end if;
      Document.Links.Make_Image_Link (Link, URI, Width, Height);
      Document.Writer.Write_Wide_Attribute ("src", URI);
      if Width > 0 then
         Document.Writer.Write_Attribute ("width", Natural'Image (Width));
      end if;
      if Height > 0 then
         Document.Writer.Write_Attribute ("height", Natural'Image (Height));
      end if;
      Document.Writer.End_Element ("img");
   end Add_Image;

   --  ------------------------------
   --  Add a quote.
   --  ------------------------------
   overriding
   procedure Add_Quote (Document : in out Html_Renderer;
                        Quote    : in Unbounded_Wide_Wide_String;
                        Link     : in Unbounded_Wide_Wide_String;
                        Language : in Unbounded_Wide_Wide_String) is
   begin
      Document.Open_Paragraph;
      Document.Writer.Start_Element ("q");
      if Length (Language) > 0 then
         Document.Writer.Write_Wide_Attribute ("lang", Language);
      end if;
      if Length (Link) > 0 then
         Document.Writer.Write_Wide_Attribute ("cite", Link);
      end if;
      Document.Writer.Write_Wide_Text (Quote);
      Document.Writer.End_Element ("q");
   end Add_Quote;

   HTML_BOLD        : aliased constant String := "b";
   HTML_ITALIC      : aliased constant String := "i";
   HTML_CODE        : aliased constant String := "tt";
   HTML_SUPERSCRIPT : aliased constant String := "sup";
   HTML_SUBSCRIPT   : aliased constant String := "sub";
   HTML_STRIKEOUT   : aliased constant String := "del";
   --  HTML_UNDERLINE   : aliased constant String := "ins";
   HTML_PREFORMAT   : aliased constant String := "pre";

   type String_Array_Access is array (Documents.Format_Type) of Util.Strings.Name_Access;

   HTML_ELEMENT     : constant String_Array_Access :=
     (Documents.BOLD        => HTML_BOLD'Access,
      Documents.ITALIC      => HTML_ITALIC'Access,
      Documents.CODE        => HTML_CODE'Access,
      Documents.SUPERSCRIPT => HTML_SUPERSCRIPT'Access,
      Documents.SUBSCRIPT   => HTML_SUBSCRIPT'Access,
      Documents.STRIKEOUT   => HTML_STRIKEOUT'Access,
      Documents.PREFORMAT   => HTML_PREFORMAT'Access);

   --  ------------------------------
   --  Add a text block with the given format.
   --  ------------------------------
   overriding
   procedure Add_Text (Document : in out Html_Renderer;
                       Text     : in Unbounded_Wide_Wide_String;
                       Format   : in Wiki.Documents.Format_Map) is
   begin
      Document.Open_Paragraph;
      for I in Format'Range loop
         if Format (I) then
            Document.Writer.Start_Element (HTML_ELEMENT (I).all);
         end if;
      end loop;
      Document.Writer.Write_Wide_Text (Text);
      for I in reverse Format'Range loop
         if Format (I) then
            Document.Writer.End_Element (HTML_ELEMENT (I).all);
         end if;
      end loop;
   end Add_Text;

   --  ------------------------------
   --  Add a text block that is pre-formatted.
   --  ------------------------------
   procedure Add_Preformatted (Document : in out Html_Renderer;
                               Text     : in Unbounded_Wide_Wide_String;
                               Format   : in Unbounded_Wide_Wide_String) is
   begin
      Document.Close_Paragraph;
      if Format = "html" then
         Document.Writer.Write (Text);
      else
         Document.Writer.Start_Element ("pre");
         Document.Writer.Write_Wide_Text (Text);
         Document.Writer.End_Element ("pre");
      end if;
   end Add_Preformatted;

   overriding
   procedure Start_Element (Document   : in out Html_Renderer;
                            Name       : in Unbounded_Wide_Wide_String;
                            Attributes : in Wiki.Attributes.Attribute_List_Type) is
      Iter : Wiki.Attributes.Cursor := Wiki.Attributes.First (Attributes);
   begin
      Document.Html_Level := Document.Html_Level + 1;
      if Name = "p" then
         Document.Has_Paragraph := True;
         Document.Need_Paragraph := False;
      end if;
      Document.Writer.Start_Element (ACC.To_String (To_Wide_Wide_String (Name)));
      while Wiki.Attributes.Has_Element (Iter) loop
         Document.Writer.Write_Wide_Attribute (Name    => Wiki.Attributes.Get_Name (Iter),
                                               Content => Wiki.Attributes.Get_Wide_Value (Iter));
         Wiki.Attributes.Next (Iter);
      end loop;
   end Start_Element;

   overriding
   procedure End_Element (Document : in out Html_Renderer;
                          Name     : in Unbounded_Wide_Wide_String) is
   begin
      Document.Html_Level := Document.Html_Level - 1;
      if Name = "p" then
         Document.Has_Paragraph := False;
         Document.Need_Paragraph := True;
      end if;
      Document.Writer.End_Element (ACC.To_String (To_Wide_Wide_String (Name)));
   end End_Element;

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

end Wiki.Render.Html;

-----------------------------------------------------------------------
--  wiki-render-html -- Wiki HTML renderer
--  Copyright (C) 2011, 2012, 2013, 2014, 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.Characters.Conversions;
with Util.Strings;

package body Wiki.Render.Html is

   package ACC renames Ada.Characters.Conversions;

   --  ------------------------------
   --  Set the output stream.
   --  ------------------------------
   procedure Set_Output_Stream (Engine : in out Html_Renderer;
                                Stream : in Wiki.Streams.Html.Html_Output_Stream_Access) is
   begin
      Engine.Output := Stream;
   end Set_Output_Stream;

   --  ------------------------------
   --  Set the link renderer.
   --  ------------------------------
   procedure Set_Link_Renderer (Document : in out Html_Renderer;
                                Links    : in Link_Renderer_Access) is
   begin
      Document.Links := Links;
   end Set_Link_Renderer;

   --  ------------------------------
   --  Add a section header in the document.
   --  ------------------------------
   overriding
   procedure Add_Header (Document : in out Html_Renderer;
                         Header   : in Unbounded_Wide_Wide_String;
                         Level    : in Positive) is
   begin
      Document.Close_Paragraph;
      Document.Add_Blockquote (0);
      case Level is
         when 1 =>
            Document.Writer.Write_Wide_Element ("h1", Header);

         when 2 =>
            Document.Writer.Write_Wide_Element ("h2", Header);

         when 3 =>
            Document.Writer.Write_Wide_Element ("h3", Header);

         when 4 =>
            Document.Writer.Write_Wide_Element ("h4", Header);

         when 5 =>
            Document.Writer.Write_Wide_Element ("h5", Header);

         when 6 =>
            Document.Writer.Write_Wide_Element ("h6", Header);

         when others =>
            Document.Writer.Write_Wide_Element ("h3", Header);
      end case;
   end Add_Header;

   --  ------------------------------
   --  Add a line break (
).
   --  ------------------------------
   overriding
   procedure Add_Line_Break (Document : in out Html_Renderer) is
   begin
      Document.Writer.Write ("
");
   end Add_Line_Break;

   --  ------------------------------
   --  Add a paragraph (
).  Close the previous paragraph if any.
   --  The paragraph must be closed at the next paragraph or next header.
   --  ------------------------------
   overriding
   procedure Add_Paragraph (Document : in out Html_Renderer) is
   begin
      Document.Close_Paragraph;
      Document.Need_Paragraph := True;
   end Add_Paragraph;

   --  ------------------------------
   --  Add a blockquote (
).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   --  ------------------------------
   overriding
   procedure Add_Blockquote (Document : in out Html_Renderer;
                             Level    : in Natural) is
   begin
      if Document.Quote_Level /= Level then
         Document.Close_Paragraph;
         Document.Need_Paragraph := True;
      end if;
      while Document.Quote_Level < Level loop
         Document.Writer.Start_Element ("blockquote");
         Document.Quote_Level := Document.Quote_Level + 1;
      end loop;
      while Document.Quote_Level > Level loop
         Document.Writer.End_Element ("blockquote");
         Document.Quote_Level := Document.Quote_Level - 1;
      end loop;
   end Add_Blockquote;

   --  ------------------------------
   --  Add a list item (
).  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 Html_Renderer;
                            Level    : in Positive;
                            Ordered  : in Boolean) is
   begin
      if Document.Has_Paragraph then
         Document.Writer.End_Element ("p");
         Document.Has_Paragraph := False;
      end if;
      if Document.Has_Item then
         Document.Writer.End_Element ("li");
         Document.Has_Item := False;
      end if;
      Document.Need_Paragraph := False;
      Document.Open_Paragraph;
      while Document.Current_Level < Level loop
         if Ordered then
            Document.Writer.Start_Element ("ol");
         else
            Document.Writer.Start_Element ("ul");
         end if;
         Document.Current_Level := Document.Current_Level + 1;
         Document.List_Styles (Document.Current_Level) := Ordered;
      end loop;
   end Add_List_Item;

   procedure Close_Paragraph (Document : in out Html_Renderer) is
   begin
      if Document.Html_Level > 0 then
         return;
      end if;
      if Document.Has_Paragraph then
         Document.Writer.End_Element ("p");
      end if;
      if Document.Has_Item then
         Document.Writer.End_Element ("li");
      end if;
      while Document.Current_Level > 0 loop
         if Document.List_Styles (Document.Current_Level) then
            Document.Writer.End_Element ("ol");
         else
            Document.Writer.End_Element ("ul");
         end if;
         Document.Current_Level := Document.Current_Level - 1;
      end loop;
      Document.Has_Paragraph := False;
      Document.Has_Item := False;
   end Close_Paragraph;

   procedure Open_Paragraph (Document : in out Html_Renderer) is
   begin
      if Document.Html_Level > 0 then
         return;
      end if;
      if Document.Need_Paragraph then
         Document.Writer.Start_Element ("p");
         Document.Has_Paragraph  := True;
         Document.Need_Paragraph := False;
      end if;
      if Document.Current_Level > 0 and not Document.Has_Item then
         Document.Writer.Start_Element ("li");
         Document.Has_Item := True;
      end if;
   end Open_Paragraph;

   --  ------------------------------
   --  Add an horizontal rule (
).
   --  ------------------------------
   overriding
   procedure Add_Horizontal_Rule (Document : in out Html_Renderer) is
   begin
      Document.Close_Paragraph;
      Document.Add_Blockquote (0);
      Document.Writer.Start_Element ("hr");
      Document.Writer.End_Element ("hr");
   end Add_Horizontal_Rule;

   --  ------------------------------
   --  Add a link.
   --  ------------------------------
   overriding
   procedure Add_Link (Document : in out Html_Renderer;
                       Name     : in Unbounded_Wide_Wide_String;
                       Link     : in Unbounded_Wide_Wide_String;
                       Language : in Unbounded_Wide_Wide_String;
                       Title    : in Unbounded_Wide_Wide_String) is
      Exists : Boolean;
      URI    : Unbounded_Wide_Wide_String;
   begin
      Document.Open_Paragraph;
      Document.Writer.Start_Element ("a");
      if Length (Title) > 0 then
         Document.Writer.Write_Wide_Attribute ("title", Title);
      end if;
      if Length (Language) > 0 then
         Document.Writer.Write_Wide_Attribute ("lang", Language);
      end if;
      Document.Links.Make_Page_Link (Link, URI, Exists);
      Document.Writer.Write_Wide_Attribute ("href", URI);
      Document.Writer.Write_Wide_Text (Name);
      Document.Writer.End_Element ("a");
   end Add_Link;

   --  ------------------------------
   --  Add an image.
   --  ------------------------------
   overriding
   procedure Add_Image (Document    : in out Html_Renderer;
                        Link        : in Unbounded_Wide_Wide_String;
                        Alt         : in Unbounded_Wide_Wide_String;
                        Position    : in Unbounded_Wide_Wide_String;
                        Description : in Unbounded_Wide_Wide_String) is
      pragma Unreferenced (Position);

      URI    : Unbounded_Wide_Wide_String;
      Width  : Natural;
      Height : Natural;
   begin
      Document.Open_Paragraph;
      Document.Writer.Start_Element ("img");
      if Length (Alt) > 0 then
         Document.Writer.Write_Wide_Attribute ("alt", Alt);
      end if;
      if Length (Description) > 0 then
         Document.Writer.Write_Wide_Attribute ("longdesc", Description);
      end if;
      Document.Links.Make_Image_Link (Link, URI, Width, Height);
      Document.Writer.Write_Wide_Attribute ("src", URI);
      if Width > 0 then
         Document.Writer.Write_Attribute ("width", Natural'Image (Width));
      end if;
      if Height > 0 then
         Document.Writer.Write_Attribute ("height", Natural'Image (Height));
      end if;
      Document.Writer.End_Element ("img");
   end Add_Image;

   --  ------------------------------
   --  Add a quote.
   --  ------------------------------
   overriding
   procedure Add_Quote (Document : in out Html_Renderer;
                        Quote    : in Unbounded_Wide_Wide_String;
                        Link     : in Unbounded_Wide_Wide_String;
                        Language : in Unbounded_Wide_Wide_String) is
   begin
      Document.Open_Paragraph;
      Document.Writer.Start_Element ("q");
      if Length (Language) > 0 then
         Document.Writer.Write_Wide_Attribute ("lang", Language);
      end if;
      if Length (Link) > 0 then
         Document.Writer.Write_Wide_Attribute ("cite", Link);
      end if;
      Document.Writer.Write_Wide_Text (Quote);
      Document.Writer.End_Element ("q");
   end Add_Quote;

   HTML_BOLD        : aliased constant String := "b";
   HTML_ITALIC      : aliased constant String := "i";
   HTML_CODE        : aliased constant String := "tt";
   HTML_SUPERSCRIPT : aliased constant String := "sup";
   HTML_SUBSCRIPT   : aliased constant String := "sub";
   HTML_STRIKEOUT   : aliased constant String := "del";
   --  HTML_UNDERLINE   : aliased constant String := "ins";
   HTML_PREFORMAT   : aliased constant String := "pre";

   type String_Array_Access is array (Documents.Format_Type) of Util.Strings.Name_Access;

   HTML_ELEMENT     : constant String_Array_Access :=
     (Documents.BOLD        => HTML_BOLD'Access,
      Documents.ITALIC      => HTML_ITALIC'Access,
      Documents.CODE        => HTML_CODE'Access,
      Documents.SUPERSCRIPT => HTML_SUPERSCRIPT'Access,
      Documents.SUBSCRIPT   => HTML_SUBSCRIPT'Access,
      Documents.STRIKEOUT   => HTML_STRIKEOUT'Access,
      Documents.PREFORMAT   => HTML_PREFORMAT'Access);

   --  ------------------------------
   --  Add a text block with the given format.
   --  ------------------------------
   overriding
   procedure Add_Text (Document : in out Html_Renderer;
                       Text     : in Unbounded_Wide_Wide_String;
                       Format   : in Wiki.Documents.Format_Map) is
   begin
      Document.Open_Paragraph;
      for I in Format'Range loop
         if Format (I) then
            Document.Writer.Start_Element (HTML_ELEMENT (I).all);
         end if;
      end loop;
      Document.Writer.Write_Wide_Text (Text);
      for I in reverse Format'Range loop
         if Format (I) then
            Document.Writer.End_Element (HTML_ELEMENT (I).all);
         end if;
      end loop;
   end Add_Text;

   --  ------------------------------
   --  Add a text block that is pre-formatted.
   --  ------------------------------
   procedure Add_Preformatted (Document : in out Html_Renderer;
                               Text     : in Unbounded_Wide_Wide_String;
                               Format   : in Unbounded_Wide_Wide_String) is
   begin
      Document.Close_Paragraph;
      if Format = "html" then
         Document.Writer.Write (Text);
      else
         Document.Writer.Start_Element ("pre");
         Document.Writer.Write_Wide_Text (Text);
         Document.Writer.End_Element ("pre");
      end if;
   end Add_Preformatted;

   overriding
   procedure Start_Element (Document   : in out Html_Renderer;
                            Name       : in Unbounded_Wide_Wide_String;
                            Attributes : in Wiki.Attributes.Attribute_List_Type) is
      Iter : Wiki.Attributes.Cursor := Wiki.Attributes.First (Attributes);
   begin
      Document.Html_Level := Document.Html_Level + 1;
      if Name = "p" then
         Document.Has_Paragraph := True;
         Document.Need_Paragraph := False;
      end if;
      Document.Writer.Start_Element (ACC.To_String (To_Wide_Wide_String (Name)));
      while Wiki.Attributes.Has_Element (Iter) loop
         Document.Writer.Write_Wide_Attribute (Name    => Wiki.Attributes.Get_Name (Iter),
                                               Content => Wiki.Attributes.Get_Wide_Value (Iter));
         Wiki.Attributes.Next (Iter);
      end loop;
   end Start_Element;

   overriding
   procedure End_Element (Document : in out Html_Renderer;
                          Name     : in Unbounded_Wide_Wide_String) is
   begin
      Document.Html_Level := Document.Html_Level - 1;
      if Name = "p" then
         Document.Has_Paragraph := False;
         Document.Need_Paragraph := True;
      end if;
      Document.Writer.End_Element (ACC.To_String (To_Wide_Wide_String (Name)));
   end End_Element;

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

end Wiki.Render.Html;

Rename Set_Writer into Set_Output_Stream