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

with Ada.Finalization;
with Ada.Strings.Unbounded;

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

with Util.Log.Loggers;
with Util.Strings;
with Util.Refs;
with Util.Beans.Objects;
with Util.Beans.Objects.Vectors;
with Util.Serialize.IO.XML;

with GNAT.Regexp;

with Security.Permissions;

package body Security.Policies is

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

   --  Get the policy name.
   function Get_Name (From : in Policy) return String is
   begin
      return "";
   end Get_Name;

   --  ------------------------------
   --  Permission Manager
   --  ------------------------------

   --  ------------------------------
   --  Add the policy to the policy manager.  After a policy is added in the manager,
   --  it can participate in the security policy.
   --  Raises Policy_Error if the policy table is full.
   --  ------------------------------
   procedure Add_Policy (Manager : in out Policy_Manager;
                         Policy  : in Policy_Access) is
      Name : constant String := Policy.Get_Name;
   begin
      Log.Info ("Adding policy {0}", Name);

      for I in Manager.Policies'Range loop
         if Manager.Policies (I) = null then
            Manager.Policies (I) := Policy;
            return;
         end if;
      end loop;
      Log.Error ("Policy table is full, increase policy manager table to {0} to add policy {1}",
                 Positive'Image (Manager.Max_Policies + 1), Name);
      raise Policy_Error;
   end Add_Policy;

   --  ------------------------------
   --  Add a permission under the given permission name and associated with the controller.
   --  To verify the permission, the controller will be called.
   --  ------------------------------
   procedure Add_Permission (Manager    : in out Policy_Manager;
                             Name       : in String;
                             Permission : in Controller_Access) is
      use type Permissions.Permission_Index;

      Index : Permission_Index;
   begin
      Log.Info ("Adding permission {0}", Name);

      Permissions.Add_Permission (Name, Index);
      if Index >= Manager.Last_Index then
         declare
            Count : constant Permission_Index := Index + 32;
            Perms : constant Controller_Access_Array_Access
              := new Controller_Access_Array (0 .. Count);
         begin
            if Manager.Permissions /= null then
               Perms (Manager.Permissions'Range) := Manager.Permissions.all;
            end if;
            Manager.Permissions := Perms;
            Manager.Last_Index := Count;
         end;
      end if;
      Manager.Permissions (Index) := Permission;
   end Add_Permission;

   --  Get the security controller associated with the permission index <b>Index</b>.
   --  Returns null if there is no such controller.
   function Get_Controller (Manager : in Policy_Manager'Class;
                            Index   : in Permissions.Permission_Index) return Controller_Access is
      use type Permissions.Permission_Index;
   begin
      if Index >= Manager.Last_Index then
         return null;
      else
         return Manager.Permissions (Index);
      end if;
   end Get_Controller;

   --  Read the policy file
   procedure Read_Policy (Manager : in out Policy_Manager;
                          File    : in String) is

      use Util;

      Reader : Util.Serialize.IO.XML.Parser;

      package Policy_Config is
        new Reader_Config (Reader, Manager'Unchecked_Access);
--        package Role_Config is
--          new Security.Controllers.Roles.Reader_Config (Reader, Manager'Unchecked_Access);
      pragma Warnings (Off, Policy_Config);
--        pragma Warnings (Off, Role_Config);
   begin
      Log.Info ("Reading policy file {0}", File);

      --  Prepare the reader to parse the policy configuration.
      for I in Manager.Policies'Range loop
         exit when Manager.Policies (I) = null;
         Manager.Policies (I).Set_Reader_Config (Reader);
      end loop;

      --  Read the configuration file.
      Reader.Parse (File);

   end Read_Policy;

   --  Initialize the permission manager.
   overriding
   procedure Initialize (Manager : in out Policy_Manager) is
   begin
      null;
   end Initialize;

   --  Finalize the permission manager.
   overriding
   procedure Finalize (Manager : in out Policy_Manager) is
   begin
      null;
   end Finalize;

end Security.Policies;

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

with Ada.Finalization;
with Ada.Strings.Unbounded;

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

with Util.Log.Loggers;
with Util.Strings;
with Util.Refs;
with Util.Beans.Objects;
with Util.Beans.Objects.Vectors;
with Util.Serialize.IO.XML;

with GNAT.Regexp;

with Security.Permissions;

package body Security.Policies is

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

   --  Get the policy name.
   function Get_Name (From : in Policy) return String is
   begin
      return "";
   end Get_Name;

   --  ------------------------------
   --  Add a permission under the given permission name and associated with the controller.
   --  To verify the permission, the controller will be called.
   --  ------------------------------
   procedure Add_Permission (Manager    : in out Policy;
                             Name       : in String;
                             Permission : in Controller_Access) is
   begin
      Manager.Manager.Add_Permission (Name, Permission);
   end Add_Permission;

   --  ------------------------------
   --  Permission Manager
   --  ------------------------------

   --  ------------------------------
   --  Add the policy to the policy manager.  After a policy is added in the manager,
   --  it can participate in the security policy.
   --  Raises Policy_Error if the policy table is full.
   --  ------------------------------
   procedure Add_Policy (Manager : in out Policy_Manager;
                         Policy  : in Policy_Access) is
      Name : constant String := Policy.Get_Name;
   begin
      Log.Info ("Adding policy {0}", Name);

      for I in Manager.Policies'Range loop
         if Manager.Policies (I) = null then
            Manager.Policies (I) := Policy;
            Policy.Manager := Manager'Unchecked_Access;
            return;
         end if;
      end loop;
      Log.Error ("Policy table is full, increase policy manager table to {0} to add policy {1}",
                 Positive'Image (Manager.Max_Policies + 1), Name);
      raise Policy_Error;
   end Add_Policy;

   --  ------------------------------
   --  Add a permission under the given permission name and associated with the controller.
   --  To verify the permission, the controller will be called.
   --  ------------------------------
   procedure Add_Permission (Manager    : in out Policy_Manager;
                             Name       : in String;
                             Permission : in Controller_Access) is
      use type Permissions.Permission_Index;

      Index : Permission_Index;
   begin
      Log.Info ("Adding permission {0}", Name);

      Permissions.Add_Permission (Name, Index);
      if Index >= Manager.Last_Index then
         declare
            Count : constant Permission_Index := Index + 32;
            Perms : constant Controller_Access_Array_Access
              := new Controller_Access_Array (0 .. Count);
         begin
            if Manager.Permissions /= null then
               Perms (Manager.Permissions'Range) := Manager.Permissions.all;
            end if;
            Manager.Permissions := Perms;
            Manager.Last_Index := Count;
         end;
      end if;
      Manager.Permissions (Index) := Permission;
   end Add_Permission;

   --  Get the security controller associated with the permission index <b>Index</b>.
   --  Returns null if there is no such controller.
   function Get_Controller (Manager : in Policy_Manager'Class;
                            Index   : in Permissions.Permission_Index) return Controller_Access is
      use type Permissions.Permission_Index;
   begin
      if Index >= Manager.Last_Index then
         return null;
      else
         return Manager.Permissions (Index);
      end if;
   end Get_Controller;

   --  Read the policy file
   procedure Read_Policy (Manager : in out Policy_Manager;
                          File    : in String) is

      use Util;

      Reader : Util.Serialize.IO.XML.Parser;

      package Policy_Config is
        new Reader_Config (Reader, Manager'Unchecked_Access);
--        package Role_Config is
--          new Security.Controllers.Roles.Reader_Config (Reader, Manager'Unchecked_Access);
      pragma Warnings (Off, Policy_Config);
--        pragma Warnings (Off, Role_Config);
   begin
      Log.Info ("Reading policy file {0}", File);

      --  Prepare the reader to parse the policy configuration.
      for I in Manager.Policies'Range loop
         exit when Manager.Policies (I) = null;
         Manager.Policies (I).Set_Reader_Config (Reader);
      end loop;

      --  Read the configuration file.
      Reader.Parse (File);

   end Read_Policy;

   --  Initialize the permission manager.
   overriding
   procedure Initialize (Manager : in out Policy_Manager) is
   begin
      null;
   end Initialize;

   --  Finalize the permission manager.
   overriding
   procedure Finalize (Manager : in out Policy_Manager) is
   begin
      null;
   end Finalize;

end Security.Policies;

Implement the Add_Permission on Policy

Implement the Add_Permission on Policy


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

with Util.Test_Caller;
with Util.Strings;
with ASF.Tests;
with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with AWA.Tests.Helpers;
with AWA.Tests.Helpers.Users;
with AWA.Services.Contexts;
with Security.Contexts;

package body AWA.Wikis.Modules.Tests is

   use ASF.Tests;
   use Util.Tests;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Wikis.Modules.Create_Wiki_Space",
                       Test_Create_Wiki_Space'Access);
      Caller.Add_Test (Suite, "Test AWA.Wikis.Modules.Create_Wiki_Page",
                       Test_Create_Wiki_Page'Access);
      Caller.Add_Test (Suite, "Test AWA.Wikis.Modules.Create_Wiki_Content",
                       Test_Create_Wiki_Content'Access);
      Caller.Add_Test (Suite, "Test AWA.Wikis.Modules.Wiki_Page",
                       Test_Wiki_Page'Access);
      Caller.Add_Test (Suite, "Test AWA.Wikis.Beans.Save",
                       Test_Update_Page'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test creation of a wiki space.
   --  ------------------------------
   procedure Test_Create_Wiki_Space (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      W         : AWA.Wikis.Models.Wiki_Space_Ref;
      W2        : AWA.Wikis.Models.Wiki_Space_Ref;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-wiki@test.com");

      T.Manager := AWA.Wikis.Modules.Get_Wiki_Module;
      T.Assert (T.Manager /= null, "There is no wiki manager");

      W.Set_Name ("Test wiki space");
      T.Manager.Create_Wiki_Space (W);
      T.Assert (W.Is_Inserted, "The new wiki space was not created");

      W.Set_Name ("Test wiki space update");
      W.Set_Is_Public (True);
      T.Manager.Save_Wiki_Space (W);

      T.Manager.Load_Wiki_Space (Wiki => W2,
                                 Id   => W.Get_Id);
      Util.Tests.Assert_Equals (T, "Test wiki space update", String '(W2.Get_Name),
                                "Invalid wiki space name");
   end Test_Create_Wiki_Space;

   --  ------------------------------
   --  Test creation of a wiki page.
   --  ------------------------------
   procedure Test_Create_Wiki_Page (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      W         : AWA.Wikis.Models.Wiki_Space_Ref;
      P         : AWA.Wikis.Models.Wiki_Page_Ref;
      C         : AWA.Wikis.Models.Wiki_Content_Ref;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-wiki@test.com");

      W.Set_Name ("Test wiki space");
      T.Manager.Create_Wiki_Space (W);

      P.Set_Name ("Private");
      P.Set_Title ("The page title");
      T.Manager.Create_Wiki_Page (W, P, C);
      T.Assert (P.Is_Inserted, "The new wiki page was not created");

      C := AWA.Wikis.Models.Null_Wiki_Content;
      P := AWA.Wikis.Models.Null_Wiki_Page;
      P.Set_Name ("Public");
      P.Set_Title ("The page title (public)");
      P.Set_Is_Public (True);
      T.Manager.Create_Wiki_Page (W, P, C);
      T.Assert (P.Is_Inserted, "The new wiki page was not created");
      T.Assert (P.Get_Is_Public, "The new wiki page is not public");

   end Test_Create_Wiki_Page;

   --  ------------------------------
   --  Test creation of a wiki page content.
   --  ------------------------------
   procedure Test_Create_Wiki_Content (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      W         : AWA.Wikis.Models.Wiki_Space_Ref;
      P         : AWA.Wikis.Models.Wiki_Page_Ref;
      C         : AWA.Wikis.Models.Wiki_Content_Ref;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-wiki@test.com");

      W.Set_Name ("Test wiki space");
      T.Manager.Create_Wiki_Space (W);
      T.Wiki_Id := W.Get_Id;

      P.Set_Name ("PrivatePage");
      P.Set_Title ("The page title");
      P.Set_Is_Public (False);
      T.Manager.Create_Wiki_Page (W, P, C);
      T.Private_Id := P.Get_Id;

      C := AWA.Wikis.Models.Null_Wiki_Content;
      C.Set_Format (AWA.Wikis.Models.FORMAT_MARKDOWN);
      C.Set_Content ("-- Title" & ASCII.LF & "A paragraph");
      C.Set_Save_Comment ("A first version");
      T.Manager.Create_Wiki_Content (P, C);
      T.Assert (C.Is_Inserted, "The new wiki content was not created");
      T.Assert (not C.Get_Author.Is_Null, "The wiki content has an author");
      T.Assert (not C.Get_Page.Is_Null, "The wiki content is associated with the wiki page");

      P := AWA.Wikis.Models.Null_Wiki_Page;
      C := AWA.Wikis.Models.Null_Wiki_Content;
      P.Set_Name ("PublicPage");
      P.Set_Title ("The public page title");
      P.Set_Is_Public (True);
      T.Manager.Create_Wiki_Page (W, P, C);
      T.Public_Id := P.Get_Id;

      C.Set_Format (AWA.Wikis.Models.FORMAT_MARKDOWN);
      C.Set_Content ("-- Title" & ASCII.LF & "A paragraph" & ASCII.LF
                     & "[Link](http://mylink.com)" & ASCII.LF
                     & "[Image](my-image.png)");
      C.Set_Save_Comment ("A first version");
      T.Manager.Create_Wiki_Content (P, C);
      T.Assert (C.Is_Inserted, "The new wiki content was not created");
      T.Assert (not C.Get_Author.Is_Null, "The wiki content has an author");
      T.Assert (not C.Get_Page.Is_Null, "The wiki content is associated with the wiki page");

   end Test_Create_Wiki_Content;

   --  ------------------------------
   --  Test getting the wiki page as well as info, history pages.
   --  ------------------------------
   procedure Test_Wiki_Page (T : in out Test) is
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
      Ident     : constant String := Util.Strings.Image (Natural (T.Wiki_Id));
      Pub_Ident : constant String := Util.Strings.Image (Natural (T.Public_Id));
   begin
      ASF.Tests.Do_Get (Request, Reply, "/wikis/view/" & Ident & "/PublicPage",
                        "wiki-public-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status,
                     "Invalid response (PublicPage)");
      Assert_Matches (T, ".*The public page title.*", Reply,
                      "Invalid PublicPage page returned",
                      Status => ASF.Responses.SC_OK);

      ASF.Tests.Do_Get (Request, Reply, "/wikis/info/" & Ident & "/" & Pub_Ident,
                        "wiki-public-info-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status,
                     "Invalid response (PublicPage info)");
      Assert_Matches (T, ".*The public page title.*", Reply,
                      "Invalid PublicPage info page returned",
                      Status => ASF.Responses.SC_OK);

      ASF.Tests.Do_Get (Request, Reply, "/wikis/history/" & Ident & "/" & Pub_Ident,
                        "wiki-public-history-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status,
                     "Invalid response (PublicPage history)");
      Assert_Matches (T, ".*The public page title.*", Reply,
                      "Invalid PublicPage info page returned",
                      Status => ASF.Responses.SC_OK);

      Request.Remove_Attribute ("wikiView");
      ASF.Tests.Do_Get (Request, Reply, "/wikis/view/" & Ident & "/PrivatePage",
                        "wiki-private-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response (PrivatePage)");
      Assert_Matches (T, ".*Protected Wiki Page.*", Reply, "Invalid PrivatePage page returned",
                      Status => ASF.Responses.SC_OK);

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Ident & "/recent",
                        "wiki-list-recent-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status,
                     "Invalid response (list/recent)");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Ident & "/recent/grid",
                        "wiki-list-grid-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status,
                     "Invalid response (list/recent/grid)");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Ident & "/popular",
                        "wiki-list-popular-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status,
                     "Invalid response (list/popular)");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Ident & "/popular/grid",
                        "wiki-list-popular-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status,
                     "Invalid response (list/popular/grid)");
   end Test_Wiki_Page;

   --  ------------------------------
   --  Test updating the wiki page through a POST request.
   --  ------------------------------
   procedure Test_Update_Page (T : in out Test) is
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
      Ident     : constant String := Util.Strings.Image (Natural (T.Wiki_Id));
      Pub_Ident : constant String := Util.Strings.Image (Natural (T.Public_Id));
   begin
      AWA.Tests.Helpers.Users.Login ("test-wiki@test.com", Request);
      Request.Set_Parameter ("title", "The Blog Title");
      Request.Set_Parameter ("page-id", Pub_Ident);
      Request.Set_Parameter ("page-wiki-id", Ident);
      Request.Set_Parameter ("name", "NewPageName");
      Request.Set_Parameter ("page-title", "New Page Title");
      Request.Set_Parameter ("text", "== Title ==" & ASCII.LF & "A paragraph" & ASCII.LF
                             & "[[http://mylink.com|Link]]" & ASCII.LF
                             & "[[Image:my-image.png|My Picture]]" & ASCII.LF
                             & "== Last header ==" & ASCII.LF);
      Request.Set_Parameter ("comment", "Update through test post simulation");
      Request.Set_Parameter ("page-is-public", "TRUE");
      Request.Set_Parameter ("wiki-format", "FORMAT_MEDIAWIKI");
      Request.Set_Parameter ("qtags[1]", "Test-Tag");
      Request.Set_Parameter ("save", "1");
      Request.Set_Parameter ("post", "1");
      ASF.Tests.Do_Post (Request, Reply, "/wikis/edit/" & Ident & "/PublicPage",
                         "update-wiki.html");

      T.Assert (Reply.Get_Status = ASF.Responses.SC_MOVED_TEMPORARILY,
                "Invalid response after wiki update");
      declare
         Result : constant String
            := AWA.Tests.Helpers.Extract_Redirect (Reply, "/asfunit/wikis/view/");
      begin
         Util.Tests.Assert_Equals (T, Ident & "/NewPageName", Result,
                                   "The page name was not updated");

         ASF.Tests.Do_Get (Request, Reply, "/wikis/view/" & Result, "wiki-public-2.html");
         Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status,
                        "Invalid response (NewPageName)");
         Assert_Matches (T, ".*Last header.*", Reply,
                         "Last header is present in the response",
                         Status => ASF.Responses.SC_OK);

         ASF.Tests.Do_Get (Request, Reply, "/wikis/info/" & Ident & "/"
                           & Pub_Ident, "wiki-info-2.html");
         Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status,
                        "Invalid response (info NewPageName)");
         Assert_Matches (T, ".*wiki-image-name.*my-image.png.*", Reply,
                         "The info page must list the image",
                         Status => ASF.Responses.SC_OK);
      end;
   end Test_Update_Page;

end AWA.Wikis.Modules.Tests;

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

with Util.Test_Caller;
with Util.Strings;
with ASF.Tests;
with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with AWA.Tests.Helpers;
with AWA.Tests.Helpers.Users;
with AWA.Services.Contexts;
with Security.Contexts;

package body AWA.Wikis.Modules.Tests is

   use ASF.Tests;
   use Util.Tests;
   use type ADO.Identifier;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Wikis.Modules.Create_Wiki_Space",
                       Test_Create_Wiki_Space'Access);
      Caller.Add_Test (Suite, "Test AWA.Wikis.Modules.Create_Wiki_Page",
                       Test_Create_Wiki_Page'Access);
      Caller.Add_Test (Suite, "Test AWA.Wikis.Modules.Create_Wiki_Content",
                       Test_Create_Wiki_Content'Access);
      Caller.Add_Test (Suite, "Test AWA.Wikis.Modules.Wiki_Page",
                       Test_Wiki_Page'Access);
      Caller.Add_Test (Suite, "Test AWA.Wikis.Beans.Save",
                       Test_Update_Page'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test creation of a wiki space.
   --  ------------------------------
   procedure Test_Create_Wiki_Space (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      W         : AWA.Wikis.Models.Wiki_Space_Ref;
      W2        : AWA.Wikis.Models.Wiki_Space_Ref;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-wiki@test.com");

      T.Manager := AWA.Wikis.Modules.Get_Wiki_Module;
      T.Assert (T.Manager /= null, "There is no wiki manager");

      W.Set_Name ("Test wiki space");
      T.Manager.Create_Wiki_Space (W);
      T.Assert (W.Is_Inserted, "The new wiki space was not created");

      W.Set_Name ("Test wiki space update");
      W.Set_Is_Public (True);
      T.Manager.Save_Wiki_Space (W);

      T.Manager.Load_Wiki_Space (Wiki => W2,
                                 Id   => W.Get_Id);
      Util.Tests.Assert_Equals (T, "Test wiki space update", String '(W2.Get_Name),
                                "Invalid wiki space name");
   end Test_Create_Wiki_Space;

   --  ------------------------------
   --  Test creation of a wiki page.
   --  ------------------------------
   procedure Test_Create_Wiki_Page (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      W         : AWA.Wikis.Models.Wiki_Space_Ref;
      P         : AWA.Wikis.Models.Wiki_Page_Ref;
      C         : AWA.Wikis.Models.Wiki_Content_Ref;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-wiki@test.com");

      T.Manager := AWA.Wikis.Modules.Get_Wiki_Module;
      T.Assert (T.Manager /= null, "There is no wiki manager");

      W.Set_Name ("Test wiki space");
      T.Manager.Create_Wiki_Space (W);

      P.Set_Name ("Private");
      P.Set_Title ("The page title");
      C.Set_Content ("Something");
      T.Manager.Create_Wiki_Page (W, P, C);
      T.Assert (P.Is_Inserted, "The new wiki page was not created");

      P.Set_Content (AWA.Wikis.Models.Null_Wiki_Content);
      C := AWA.Wikis.Models.Null_Wiki_Content;
      P := AWA.Wikis.Models.Null_Wiki_Page;
      P.Set_Name ("Public");
      P.Set_Title ("The page title (public)");
      P.Set_Is_Public (True);
      T.Manager.Create_Wiki_Page (W, P, C);
      T.Assert (P.Is_Inserted, "The new wiki page was not created");
      T.Assert (P.Get_Is_Public, "The new wiki page is not public");

      P.Set_Content (AWA.Wikis.Models.Null_Wiki_Content);
   end Test_Create_Wiki_Page;

   --  ------------------------------
   --  Test creation of a wiki page content.
   --  ------------------------------
   procedure Test_Create_Wiki_Content (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      W         : AWA.Wikis.Models.Wiki_Space_Ref;
      P         : AWA.Wikis.Models.Wiki_Page_Ref;
      C         : AWA.Wikis.Models.Wiki_Content_Ref;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-wiki@test.com");

      T.Manager := AWA.Wikis.Modules.Get_Wiki_Module;
      T.Assert (T.Manager /= null, "There is no wiki manager");

      W.Set_Name ("Test wiki space");
      T.Manager.Create_Wiki_Space (W);
      T.Wiki_Id := W.Get_Id;

      P.Set_Name ("PrivatePage");
      P.Set_Title ("The page title");
      P.Set_Is_Public (False);
      T.Manager.Create_Wiki_Page (W, P, C);
      T.Private_Id := P.Get_Id;

      C := AWA.Wikis.Models.Null_Wiki_Content;
      C.Set_Format (AWA.Wikis.Models.FORMAT_MARKDOWN);
      C.Set_Content ("-- Title" & ASCII.LF & "A paragraph");
      C.Set_Save_Comment ("A first version");
      T.Manager.Create_Wiki_Content (P, C);
      T.Assert (C.Is_Inserted, "The new wiki content was not created");
      T.Assert (not C.Get_Author.Is_Null, "The wiki content has an author");
      T.Assert (C.Get_Page_Id /= ADO.NO_IDENTIFIER,
                "The wiki content is associated with the wiki page");

      P := AWA.Wikis.Models.Null_Wiki_Page;
      C := AWA.Wikis.Models.Null_Wiki_Content;
      P.Set_Name ("PublicPage");
      P.Set_Title ("The public page title");
      P.Set_Is_Public (True);
      T.Manager.Create_Wiki_Page (W, P, C);
      T.Public_Id := P.Get_Id;

      C.Set_Format (AWA.Wikis.Models.FORMAT_MARKDOWN);
      C.Set_Content ("-- Title" & ASCII.LF & "A paragraph" & ASCII.LF
                     & "[Link](http://mylink.com)" & ASCII.LF
                     & "[Image](my-image.png)");
      C.Set_Save_Comment ("A first version");
      T.Manager.Create_Wiki_Content (P, C);
      T.Assert (C.Is_Inserted, "The new wiki content was not created");
      T.Assert (not C.Get_Author.Is_Null, "The wiki content has an author");
      T.Assert (C.Get_Page_Id /= ADO.NO_IDENTIFIER,
                "The wiki content is associated with the wiki page");
   end Test_Create_Wiki_Content;

   --  ------------------------------
   --  Test getting the wiki page as well as info, history pages.
   --  ------------------------------
   procedure Test_Wiki_Page (T : in out Test) is
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
      Ident     : constant String := Util.Strings.Image (Natural (T.Wiki_Id));
      Pub_Ident : constant String := Util.Strings.Image (Natural (T.Public_Id));
   begin
      ASF.Tests.Do_Get (Request, Reply, "/wikis/view/" & Ident & "/PublicPage",
                        "wiki-public-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status,
                     "Invalid response (PublicPage)");
      Assert_Matches (T, ".*The public page title.*", Reply,
                      "Invalid PublicPage page returned",
                      Status => ASF.Responses.SC_OK);

      ASF.Tests.Do_Get (Request, Reply, "/wikis/info/" & Ident & "/" & Pub_Ident,
                        "wiki-public-info-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status,
                     "Invalid response (PublicPage info)");
      Assert_Matches (T, ".*The public page title.*", Reply,
                      "Invalid PublicPage info page returned",
                      Status => ASF.Responses.SC_OK);

      ASF.Tests.Do_Get (Request, Reply, "/wikis/history/" & Ident & "/" & Pub_Ident,
                        "wiki-public-history-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status,
                     "Invalid response (PublicPage history)");
      Assert_Matches (T, ".*The public page title.*", Reply,
                      "Invalid PublicPage info page returned",
                      Status => ASF.Responses.SC_OK);

      Request.Remove_Attribute ("wikiView");
      ASF.Tests.Do_Get (Request, Reply, "/wikis/view/" & Ident & "/PrivatePage",
                        "wiki-private-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status, "Invalid response (PrivatePage)");
      Assert_Matches (T, ".*Protected Wiki Page.*", Reply, "Invalid PrivatePage page returned",
                      Status => ASF.Responses.SC_OK);

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Ident & "/recent",
                        "wiki-list-recent-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status,
                     "Invalid response (list/recent)");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Ident & "/recent/grid",
                        "wiki-list-grid-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status,
                     "Invalid response (list/recent/grid)");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Ident & "/popular",
                        "wiki-list-popular-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status,
                     "Invalid response (list/popular)");

      ASF.Tests.Do_Get (Request, Reply, "/wikis/list/" & Ident & "/popular/grid",
                        "wiki-list-popular-1.html");
      Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status,
                     "Invalid response (list/popular/grid)");
   end Test_Wiki_Page;

   --  ------------------------------
   --  Test updating the wiki page through a POST request.
   --  ------------------------------
   procedure Test_Update_Page (T : in out Test) is
      Request   : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
      Ident     : constant String := Util.Strings.Image (Natural (T.Wiki_Id));
      Pub_Ident : constant String := Util.Strings.Image (Natural (T.Public_Id));
   begin
      AWA.Tests.Helpers.Users.Login ("test-wiki@test.com", Request);
      Request.Set_Parameter ("title", "The Blog Title");
      Request.Set_Parameter ("page-id", Pub_Ident);
      Request.Set_Parameter ("page-wiki-id", Ident);
      Request.Set_Parameter ("name", "NewPageName");
      Request.Set_Parameter ("page-title", "New Page Title");
      Request.Set_Parameter ("text", "== Title ==" & ASCII.LF & "A paragraph" & ASCII.LF
                             & "[[http://mylink.com|Link]]" & ASCII.LF
                             & "[[Image:my-image.png|My Picture]]" & ASCII.LF
                             & "== Last header ==" & ASCII.LF);
      Request.Set_Parameter ("comment", "Update through test post simulation");
      Request.Set_Parameter ("page-is-public", "TRUE");
      Request.Set_Parameter ("wiki-format", "FORMAT_MEDIAWIKI");
      Request.Set_Parameter ("qtags[1]", "Test-Tag");
      Request.Set_Parameter ("save", "1");
      Request.Set_Parameter ("post", "1");
      ASF.Tests.Do_Post (Request, Reply, "/wikis/edit/" & Ident & "/PublicPage",
                         "update-wiki.html");

      T.Assert (Reply.Get_Status = ASF.Responses.SC_MOVED_TEMPORARILY,
                "Invalid response after wiki update");
      declare
         Result : constant String
            := AWA.Tests.Helpers.Extract_Redirect (Reply, "/asfunit/wikis/view/");
      begin
         Util.Tests.Assert_Equals (T, Ident & "/NewPageName", Result,
                                   "The page name was not updated");

         ASF.Tests.Do_Get (Request, Reply, "/wikis/view/" & Result, "wiki-public-2.html");
         Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status,
                        "Invalid response (NewPageName)");
         Assert_Matches (T, ".*Last header.*", Reply,
                         "Last header is present in the response",
                         Status => ASF.Responses.SC_OK);

         ASF.Tests.Do_Get (Request, Reply, "/wikis/info/" & Ident & "/"
                           & Pub_Ident, "wiki-info-2.html");
         Assert_Equals (T, ASF.Responses.SC_OK, Reply.Get_Status,
                        "Invalid response (info NewPageName)");
         Assert_Matches (T, ".*wiki-image-name.*my-image.png.*", Reply,
                         "The info page must list the image",
                         Status => ASF.Responses.SC_OK);
      end;
   end Test_Update_Page;

end AWA.Wikis.Modules.Tests;

Update the unit tests for wiki page creation


-----------------------------------------------------------------------
--  mat-symbols-targets - Symbol files management
--  Copyright (C) 2014, 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Bfd.Sections;
with ELF;
with Util.Strings;
with Util.Files;
with Util.Log.Loggers;
with Ada.Directories;
with MAT.Formats;
package body MAT.Symbols.Targets is

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

   --  ------------------------------
   --  Open the binary and load the symbols from that file.
   --  ------------------------------
   procedure Open (Symbols : in out Target_Symbols;
                   Path    : in String) is
   begin
      Log.Info ("Loading symbols from {0}", Path);
--
--        Bfd.Files.Open (Symbols.File, Path, "");
--        if Bfd.Files.Check_Format (Symbols.File, Bfd.Files.OBJECT) then
--           Bfd.Symbols.Read_Symbols (Symbols.File, Symbols.Symbols);
--        end if;
   end Open;

   --  ------------------------------
   --  Load the symbol table for the associated region.
   --  ------------------------------
   procedure Open (Symbols     : in out Region_Symbols;
                   Path        : in String;
                   Search_Path : in String) is
      Pos : Natural;
   begin
      Log.Info ("Loading symbols from {0}", Path);

      if Ada.Directories.Exists (Path) then
         Bfd.Files.Open (Symbols.File, Path, "");
      else
         Pos := Util.Strings.Rindex (Path, '/');
         if Pos > 0 then
            Bfd.Files.Open (Symbols.File,
              Util.Files.Find_File_Path (Path (Pos + 1 .. Path'Last), Search_Path));
         end if;
      end if;
      if Bfd.Files.Check_Format (Symbols.File, Bfd.Files.OBJECT) then
         Bfd.Symbols.Read_Symbols (Symbols.File, Symbols.Symbols);
      end if;
   end Open;

   --  ------------------------------
   --  Load the symbols associated with a shared library described by the memory region.
   --  ------------------------------
   procedure Load_Symbols (Symbols     : in out Target_Symbols;
                           Region      : in MAT.Memory.Region_Info;
                           Offset_Addr : in MAT.Types.Target_Addr) is
      Pos  : constant Symbols_Cursor := Symbols.Libraries.Find (Region.Start_Addr);
      Syms : Region_Symbols_Ref;
   begin
      if not Symbols_Maps.Has_Element (Pos) then
         Syms := Region_Symbols_Refs.Create;
         Syms.Value.Region := Region;
         Syms.Value.Offset := Offset_Addr;
         Symbols.Libraries.Insert (Region.Start_Addr, Syms);
      else
         Syms := Symbols_Maps.Element (Pos);
      end if;
      if Ada.Strings.Unbounded.Length (Region.Path) > 0 then
         Open (Syms.Value.all, Ada.Strings.Unbounded.To_String (Region.Path),
               Ada.Strings.Unbounded.To_String (Symbols.Search_Path));
      end if;
   end Load_Symbols;

   --  ------------------------------
   --  Load the symbols associated with all the shared libraries described by
   --  the memory region map.
   --  ------------------------------
   procedure Load_Symbols (Symbols     : in out Target_Symbols;
                           Regions     : in MAT.Memory.Region_Info_Map) is
      use type ELF.Elf32_Word;

      Iter    : MAT.Memory.Region_Info_Cursor := Regions.First;
   begin
      while MAT.Memory.Region_Info_Maps.Has_Element (Iter) loop
         declare
            Region : MAT.Memory.Region_Info := MAT.Memory.Region_Info_Maps.Element (Iter);
            Offset : MAT.Types.Target_Addr;
         begin
            if (Region.Flags and ELF.PF_X) /= 0 then
               if Ada.Strings.Unbounded.Length (Region.Path) = 0 then
                  Region.Path := Symbols.Path;
                  Offset := 0;
               else
                  Offset := Region.Start_Addr;
               end if;
               MAT.Symbols.Targets.Load_Symbols (Symbols, Region, Offset);
            end if;

         exception
            when Bfd.OPEN_ERROR =>
               Symbols.Console.Error ("Cannot open symbol library file '"
                                      & Ada.Strings.Unbounded.To_String (Region.Path) & "'");
         end;
         MAT.Memory.Region_Info_Maps.Next (Iter);
      end loop;
   end Load_Symbols;

   --  ------------------------------
   --  Demangle the symbol.
   --  ------------------------------
   procedure Demangle (Symbols : in Target_Symbols;
                       Symbol  : in out Symbol_Info) is
      use type Bfd.Demangle_Flags;
      use Ada.Strings.Unbounded;

      Pos : constant Natural := Index (Symbol.File, ".", Ada.Strings.Backward);
   begin
      if Symbol.Line = 0 or else Pos = 0 or else Symbol.Symbols.Is_Null then
         return;
      end if;
      declare
         Mode : Bfd.Demangle_Flags := Symbols.Demangle;
         Len  : constant Positive := Length (Symbol.File);
         Ext  : constant String := Slice (Symbol.File, Pos, Len);
         Sym  : constant String := To_String (Symbol.Name);
      begin
         if Mode = Bfd.Constants.DMGL_AUTO and then Ext = ".adb" then
            Mode := Bfd.Constants.DMGL_GNAT;
         end if;
         declare
            Name : constant String := Bfd.Symbols.Demangle (Symbol.Symbols.Value.File, Sym, Mode);
         begin
            if Name'Length > 0 then
               Symbol.Name := To_Unbounded_String (Name);
            end if;
         end;
      end;
   end Demangle;

   procedure Find_Nearest_Line (Symbols : in Region_Symbols;
                                Addr    : in MAT.Types.Target_Addr;
                                Symbol  : out Symbol_Info) is
      use type Bfd.Vma_Type;

      Text_Section : Bfd.Sections.Section;
      Pc : constant Bfd.Vma_Type := Bfd.Vma_Type (Addr);
   begin
      if not Bfd.Files.Is_Open (Symbols.File) then
         Symbol.File := Symbols.Region.Path;
         return;
      end if;
      Text_Section := Bfd.Sections.Find_Section (Symbols.File, ".text");
      Bfd.Symbols.Find_Nearest_Line (File    => Symbols.File,
                                     Sec     => Text_Section,
                                     Symbols => Symbols.Symbols,
                                     Addr    => Pc,
                                     Name    => Symbol.File,
                                     Func    => Symbol.Name,
                                     Line    => Symbol.Line);
   end Find_Nearest_Line;

   --  ------------------------------
   --  Find the nearest source file and line for the given address.
   --  ------------------------------
   procedure Find_Nearest_Line (Symbols : in Target_Symbols;
                                Addr    : in MAT.Types.Target_Addr;
                                Symbol  : out Symbol_Info) is
      use Ada.Strings.Unbounded;

      Pos  : constant Symbols_Cursor := Symbols.Libraries.Floor (Addr);
   begin
      Symbol.Line := 0;
      if Symbols_Maps.Has_Element (Pos) then
         declare
            Syms : constant Region_Symbols_Ref := Symbols_Maps.Element (Pos);
         begin
            if Syms.Value.Region.End_Addr > Addr then
               Symbol.Symbols := Syms;
               Find_Nearest_Line (Symbols => Syms.Value.all,
                                  Addr    => Addr - Syms.Value.Offset,
                                  Symbol  => Symbol);
               Demangle (Symbols, Symbol);
               return;
            end if;
         end;
      end if;
      Symbol.Line := 0;
      Symbol.File := Ada.Strings.Unbounded.To_Unbounded_String ("");
      Symbol.Name := Ada.Strings.Unbounded.To_Unbounded_String (MAT.Formats.Addr (Addr));

   exception
      when Bfd.NOT_FOUND =>
         Symbol.Line := 0;
         Symbol.File := Ada.Strings.Unbounded.To_Unbounded_String ("");
         Symbol.Name := Ada.Strings.Unbounded.To_Unbounded_String (MAT.Formats.Addr (Addr));
   end Find_Nearest_Line;

   --  ------------------------------
   --  Find the symbol in the symbol table and return the start and end address.
   --  ------------------------------
   procedure Find_Symbol_Range (Symbols : in Target_Symbols;
                                Name    : in String;
                                From    : out MAT.Types.Target_Addr;
                                To      : out MAT.Types.Target_Addr) is
      use type Bfd.Symbols.Symbol;

      Iter  : Symbols_Cursor := Symbols.Libraries.First;
   begin
      while Symbols_Maps.Has_Element (Iter) loop
         declare
            Syms : constant Region_Symbols_Ref := Symbols_Maps.Element (Iter);
            Sym  : Bfd.Symbols.Symbol;
            Sec  : Bfd.Sections.Section;
         begin
            if not Syms.Is_Null and then Bfd.Files.Is_Open (Syms.Value.File) then
               Sym := Bfd.Symbols.Get_Symbol (Syms.Value.Symbols, Name);
               if Sym /= Bfd.Symbols.Null_Symbol then
                  Sec := Bfd.Symbols.Get_Section (Sym);
                  if not Bfd.Sections.Is_Undefined_Section (Sec) then
                     From := MAT.Types.Target_Addr (Bfd.Symbols.Get_Value (Sym));
                     From := From + Syms.Value.Offset;
                     To := From + MAT.Types.Target_Addr (Bfd.Symbols.Get_Symbol_Size (Sym));
                     return;
                  end if;
               end if;
            end if;
         end;
         Symbols_Maps.Next (Iter);
      end loop;
   end Find_Symbol_Range;

end MAT.Symbols.Targets;

-----------------------------------------------------------------------
--  mat-symbols-targets - Symbol files management
--  Copyright (C) 2014, 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Bfd.Sections;
with ELF;
with Util.Strings;
with Util.Files;
with Util.Log.Loggers;
with Ada.Directories;
with MAT.Formats;
package body MAT.Symbols.Targets is

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

   --  ------------------------------
   --  Open the binary and load the symbols from that file.
   --  ------------------------------
   procedure Open (Symbols : in out Target_Symbols;
                   Path    : in String) is
   begin
      Log.Info ("Loading symbols from {0}", Path);
--
--        Bfd.Files.Open (Symbols.File, Path, "");
--        if Bfd.Files.Check_Format (Symbols.File, Bfd.Files.OBJECT) then
--           Bfd.Symbols.Read_Symbols (Symbols.File, Symbols.Symbols);
--        end if;
   end Open;

   --  ------------------------------
   --  Load the symbol table for the associated region.
   --  ------------------------------
   procedure Open (Symbols     : in out Region_Symbols;
                   Path        : in String;
                   Search_Path : in String) is
      Pos : Natural;
   begin
      Log.Info ("Loading symbols from {0}", Path);

      if Ada.Directories.Exists (Path) then
         Bfd.Files.Open (Symbols.File, Path, "");
      else
         Pos := Util.Strings.Rindex (Path, '/');
         if Pos > 0 then
            Bfd.Files.Open (Symbols.File,
              Util.Files.Find_File_Path (Path (Pos + 1 .. Path'Last), Search_Path));
         end if;
      end if;
      if Bfd.Files.Check_Format (Symbols.File, Bfd.Files.OBJECT) then
         Bfd.Symbols.Read_Symbols (Symbols.File, Symbols.Symbols);
      end if;
   end Open;

   --  ------------------------------
   --  Load the symbols associated with a shared library described by the memory region.
   --  ------------------------------
   procedure Load_Symbols (Symbols     : in out Target_Symbols;
                           Region      : in MAT.Memory.Region_Info;
                           Offset_Addr : in MAT.Types.Target_Addr) is
      use type Bfd.File_Flags;

      Pos  : constant Symbols_Cursor := Symbols.Libraries.Find (Region.Start_Addr);
      Syms : Region_Symbols_Ref;
   begin
      if not Symbols_Maps.Has_Element (Pos) then
         Syms := Region_Symbols_Refs.Create;
         Syms.Value.Region := Region;
         Syms.Value.Offset := Offset_Addr;
         Symbols.Libraries.Insert (Region.Start_Addr, Syms);
      else
         Syms := Symbols_Maps.Element (Pos);
      end if;
      if Ada.Strings.Unbounded.Length (Region.Path) > 0 then
         Open (Syms.Value.all, Ada.Strings.Unbounded.To_String (Region.Path),
               Ada.Strings.Unbounded.To_String (Symbols.Search_Path));
         if (Bfd.Files.Get_File_Flags (Syms.Value.File) and Bfd.Files.EXEC_P) /= 0 then
            Syms.Value.Offset := 0;
         end if;
      end if;
   end Load_Symbols;

   --  ------------------------------
   --  Load the symbols associated with all the shared libraries described by
   --  the memory region map.
   --  ------------------------------
   procedure Load_Symbols (Symbols     : in out Target_Symbols;
                           Regions     : in MAT.Memory.Region_Info_Map) is
      use type ELF.Elf32_Word;

      Iter    : MAT.Memory.Region_Info_Cursor := Regions.First;
   begin
      while MAT.Memory.Region_Info_Maps.Has_Element (Iter) loop
         declare
            Region : MAT.Memory.Region_Info := MAT.Memory.Region_Info_Maps.Element (Iter);
            Offset : MAT.Types.Target_Addr;
         begin
            if (Region.Flags and ELF.PF_X) /= 0 then
               if Ada.Strings.Unbounded.Length (Region.Path) = 0 then
                  Region.Path := Symbols.Path;
                  Offset := 0;
               else
                  Offset := Region.Start_Addr;
               end if;
               MAT.Symbols.Targets.Load_Symbols (Symbols, Region, Offset);
            end if;

         exception
            when Bfd.OPEN_ERROR =>
               Symbols.Console.Error ("Cannot open symbol library file '"
                                      & Ada.Strings.Unbounded.To_String (Region.Path) & "'");
         end;
         MAT.Memory.Region_Info_Maps.Next (Iter);
      end loop;
   end Load_Symbols;

   --  ------------------------------
   --  Demangle the symbol.
   --  ------------------------------
   procedure Demangle (Symbols : in Target_Symbols;
                       Symbol  : in out Symbol_Info) is
      use type Bfd.Demangle_Flags;
      use Ada.Strings.Unbounded;

      Pos : constant Natural := Index (Symbol.File, ".", Ada.Strings.Backward);
   begin
      if Symbol.Line = 0 or else Pos = 0 or else Symbol.Symbols.Is_Null then
         return;
      end if;
      declare
         Mode : Bfd.Demangle_Flags := Symbols.Demangle;
         Len  : constant Positive := Length (Symbol.File);
         Ext  : constant String := Slice (Symbol.File, Pos, Len);
         Sym  : constant String := To_String (Symbol.Name);
      begin
         if Mode = Bfd.Constants.DMGL_AUTO and then Ext = ".adb" then
            Mode := Bfd.Constants.DMGL_GNAT;
         end if;
         declare
            Name : constant String := Bfd.Symbols.Demangle (Symbol.Symbols.Value.File, Sym, Mode);
         begin
            if Name'Length > 0 then
               Symbol.Name := To_Unbounded_String (Name);
            end if;
         end;
      end;
   end Demangle;

   procedure Find_Nearest_Line (Symbols : in Region_Symbols;
                                Addr    : in MAT.Types.Target_Addr;
                                Symbol  : out Symbol_Info) is
      use type Bfd.Vma_Type;

      Text_Section : Bfd.Sections.Section;
      Pc : constant Bfd.Vma_Type := Bfd.Vma_Type (Addr);
   begin
      if not Bfd.Files.Is_Open (Symbols.File) then
         Symbol.File := Symbols.Region.Path;
         return;
      end if;
      Text_Section := Bfd.Sections.Find_Section (Symbols.File, ".text");
      Bfd.Symbols.Find_Nearest_Line (File    => Symbols.File,
                                     Sec     => Text_Section,
                                     Symbols => Symbols.Symbols,
                                     Addr    => Pc,
                                     Name    => Symbol.File,
                                     Func    => Symbol.Name,
                                     Line    => Symbol.Line);
   end Find_Nearest_Line;

   --  ------------------------------
   --  Find the nearest source file and line for the given address.
   --  ------------------------------
   procedure Find_Nearest_Line (Symbols : in Target_Symbols;
                                Addr    : in MAT.Types.Target_Addr;
                                Symbol  : out Symbol_Info) is
      use Ada.Strings.Unbounded;

      Pos  : constant Symbols_Cursor := Symbols.Libraries.Floor (Addr);
   begin
      Symbol.Line := 0;
      if Symbols_Maps.Has_Element (Pos) then
         declare
            Syms : constant Region_Symbols_Ref := Symbols_Maps.Element (Pos);
         begin
            if Syms.Value.Region.End_Addr > Addr then
               Symbol.Symbols := Syms;
               Find_Nearest_Line (Symbols => Syms.Value.all,
                                  Addr    => Addr - Syms.Value.Offset,
                                  Symbol  => Symbol);
               Demangle (Symbols, Symbol);
               return;
            end if;
         end;
      end if;
      Symbol.Line := 0;
      Symbol.File := Ada.Strings.Unbounded.To_Unbounded_String ("");
      Symbol.Name := Ada.Strings.Unbounded.To_Unbounded_String (MAT.Formats.Addr (Addr));

   exception
      when Bfd.NOT_FOUND =>
         Symbol.Line := 0;
         Symbol.File := Ada.Strings.Unbounded.To_Unbounded_String ("");
         Symbol.Name := Ada.Strings.Unbounded.To_Unbounded_String (MAT.Formats.Addr (Addr));
   end Find_Nearest_Line;

   --  ------------------------------
   --  Find the symbol in the symbol table and return the start and end address.
   --  ------------------------------
   procedure Find_Symbol_Range (Symbols : in Target_Symbols;
                                Name    : in String;
                                From    : out MAT.Types.Target_Addr;
                                To      : out MAT.Types.Target_Addr) is
      use type Bfd.Symbols.Symbol;

      Iter  : Symbols_Cursor := Symbols.Libraries.First;
   begin
      while Symbols_Maps.Has_Element (Iter) loop
         declare
            Syms : constant Region_Symbols_Ref := Symbols_Maps.Element (Iter);
            Sym  : Bfd.Symbols.Symbol;
            Sec  : Bfd.Sections.Section;
         begin
            if not Syms.Is_Null and then Bfd.Files.Is_Open (Syms.Value.File) then
               Sym := Bfd.Symbols.Get_Symbol (Syms.Value.Symbols, Name);
               if Sym /= Bfd.Symbols.Null_Symbol then
                  Sec := Bfd.Symbols.Get_Section (Sym);
                  if not Bfd.Sections.Is_Undefined_Section (Sec) then
                     From := MAT.Types.Target_Addr (Bfd.Symbols.Get_Value (Sym));
                     From := From + Syms.Value.Offset;
                     To := From + MAT.Types.Target_Addr (Bfd.Symbols.Get_Symbol_Size (Sym));
                     return;
                  end if;
               end if;
            end if;
         end;
         Symbols_Maps.Next (Iter);
      end loop;
   end Find_Symbol_Range;

end MAT.Symbols.Targets;

Check for the BFD flags EXEC_P to decide whether an offset is necessary or not (this is more reliable than the previous method)


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

with Ada.Text_IO;
with Ada.Directories;

with Gen.Utils;
with Gen.Utils.GNAT;
with Gen.Model.Projects;

with Util.Strings.Sets;
with Util.Files;
package body Gen.Commands.Info is

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   overriding
   procedure Execute (Cmd       : in out Command;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Name, Args);

      procedure Collect_Directories (List   : in Gen.Utils.String_List.Vector;
                                     Result : out Gen.Utils.String_List.Vector);

      procedure Print_Model_File (Name : in String;
                                  File : in String;
                                  Done : out Boolean);

      procedure Print_GNAT_Projects (Project : in out Gen.Model.Projects.Project_Definition);

      procedure Print_Dynamo_Projects (Project : in out Model.Projects.Root_Project_Definition);

      procedure Print_Modules (Project : in out Gen.Model.Projects.Project_Definition'Class;
                               Indent  : in Ada.Text_IO.Positive_Count);

      procedure Print_Project (Project : in out Gen.Model.Projects.Root_Project_Definition);

      procedure Print_Project_List (Indent  : in Ada.Text_IO.Positive_Count;
                                    List    : in Gen.Model.Projects.Project_Vectors.Vector);

      List  : Gen.Utils.String_List.Vector;
      Names : Util.Strings.Sets.Set;

      procedure Collect_Directories (List : in Gen.Utils.String_List.Vector;
                                     Result : out Gen.Utils.String_List.Vector) is

         procedure Add_Model_Dir (Base_Dir : in String;
                                  Dir : in String);

         procedure Add_Model_Dir (Base_Dir : in String;
                                  Dir : in String) is
            Path : constant String := Util.Files.Compose (Base_Dir, Dir);
         begin
            if not Result.Contains (Path) and then Ada.Directories.Exists (Path) then
               Result.Append (Path);
            end if;
         end Add_Model_Dir;

         Iter : Gen.Utils.String_List.Cursor := List.First;
      begin
         while Gen.Utils.String_List.Has_Element (Iter) loop
            declare
               Path : constant String := Gen.Utils.String_List.Element (Iter);
               Dir  : constant String := Ada.Directories.Containing_Directory (Path);
            begin
               Add_Model_Dir (Dir, "db");
               Add_Model_Dir (Dir, "db/regtests");
               Add_Model_Dir (Dir, "db/samples");
            end;
            Gen.Utils.String_List.Next (Iter);
         end loop;
      end Collect_Directories;

      procedure Print_Model_File (Name : in String;
                                  File : in String;
                                  Done : out Boolean) is
         pragma Unreferenced (Name);
      begin
         Ada.Text_IO.Put ("    ");
         Ada.Text_IO.Put_Line (File);
         Done := False;
      end Print_Model_File;

      --  ------------------------------
      --  Print the list of GNAT projects used by the main project.
      --  ------------------------------
      procedure Print_GNAT_Projects (Project : in out Gen.Model.Projects.Project_Definition) is
         use Gen.Utils.GNAT;

         Iter : Project_Info_Vectors.Cursor := Project.Project_Files.First;
         Info : Project_Info;
      begin
         if Project_Info_Vectors.Has_Element (Iter) then
            Ada.Text_IO.Put_Line ("GNAT project files:");
            while Project_Info_Vectors.Has_Element (Iter) loop
               Ada.Text_IO.Put ("   ");
               Info := Project_Info_Vectors.Element (Iter);
               Ada.Text_IO.Put_Line (Ada.Strings.Unbounded.To_String (Info.Path));
               Project_Info_Vectors.Next (Iter);
            end loop;
         end if;
      end Print_GNAT_Projects;

      --  ------------------------------
      --  Print the list of Dynamo modules
      --  ------------------------------
      procedure Print_Project_List (Indent  : in Ada.Text_IO.Positive_Count;
                                    List    : in Gen.Model.Projects.Project_Vectors.Vector) is
         use Gen.Model.Projects;
         use type Ada.Text_IO.Positive_Count;

         Iter : Project_Vectors.Cursor := List.First;
         Ref  : Model.Projects.Project_Reference;
      begin
         while Project_Vectors.Has_Element (Iter) loop
            Ref := Project_Vectors.Element (Iter);
            Ada.Text_IO.Set_Col (Indent);
            Ada.Text_IO.Put ("   ");
            Ada.Text_IO.Put (Ada.Strings.Unbounded.To_String (Ref.Name));
            Ada.Text_IO.Set_Col (Indent + 30);
            if Ref.Project /= null then
               Ada.Text_IO.Put_Line (Ada.Strings.Unbounded.To_String (Ref.Project.Path));
            else
               Ada.Text_IO.Put_Line ("?");
            end if;
            Project_Vectors.Next (Iter);
         end loop;
      end Print_Project_List;

      --  ------------------------------
      --  Print the list of Dynamo modules
      --  ------------------------------
      procedure Print_Modules (Project : in out Gen.Model.Projects.Project_Definition'Class;
                               Indent  : in Ada.Text_IO.Positive_Count) is
         use Gen.Model.Projects;
         use type Ada.Text_IO.Positive_Count;

         Iter : Project_Vectors.Cursor := Project.Modules.First;
         Ref  : Model.Projects.Project_Reference;
      begin
         if not Project.Modules.Is_Empty then
            Ada.Text_IO.Set_Col (Indent);
            Ada.Text_IO.Put_Line ("Dynamo plugins:");
            Print_Project_List (Indent, Project.Modules);

            Print_Project_List (Indent, Project.Dependencies);
            Iter := Project.Modules.First;
            while Project_Vectors.Has_Element (Iter) loop
               Ref := Project_Vectors.Element (Iter);
               if Ref.Project /= null and then not Ref.Project.Modules.Is_Empty then
                  declare
                     Name : constant String := Ada.Strings.Unbounded.To_String (Ref.Name);
                  begin
                     Ada.Text_IO.Set_Col (Indent);
                     if Names.Contains (Name) then
                        Ada.Text_IO.Put_Line ("!! " & Name);
                     else
                        Names.Insert (Name);
                        Ada.Text_IO.Put_Line ("== " & Name);
                        Print_Modules (Ref.Project.all, Indent + 4);
                        Names.Delete (Name);
                     end if;
                  end;
               end if;
               Project_Vectors.Next (Iter);
            end loop;
         end if;
      end Print_Modules;

      --  ------------------------------
      --  Print the list of Dynamo projects used by the main project.
      --  ------------------------------
      procedure Print_Dynamo_Projects (Project : in out Model.Projects.Root_Project_Definition) is
         Iter : Gen.Utils.String_List.Cursor := Project.Dynamo_Files.First;
      begin
         if Gen.Utils.String_List.Has_Element (Iter) then
            Ada.Text_IO.Put_Line ("Dynamo project files:");
            while Gen.Utils.String_List.Has_Element (Iter) loop
               Ada.Text_IO.Put ("   ");
               Ada.Text_IO.Put_Line (Gen.Utils.String_List.Element (Iter));
               Gen.Utils.String_List.Next (Iter);
            end loop;
         end if;
      end Print_Dynamo_Projects;

      procedure Print_Project (Project : in out Gen.Model.Projects.Root_Project_Definition) is
      begin
         Print_GNAT_Projects (Gen.Model.Projects.Project_Definition (Project));
         Print_Dynamo_Projects (Project);

         Print_Modules (Project, 1);
         declare
            Model_Dirs : Gen.Utils.String_List.Vector;
         begin
            Collect_Directories (List, Model_Dirs);
            declare
               Iter : Gen.Utils.String_List.Cursor := Model_Dirs.First;
            begin
               Ada.Text_IO.Put_Line ("ADO model files:");
               while Gen.Utils.String_List.Has_Element (Iter) loop
                  Ada.Text_IO.Put ("   ");
                  Ada.Text_IO.Put_Line (Gen.Utils.String_List.Element (Iter));
                  Util.Files.Iterate_Files_Path (Pattern => "*.xml",
                                                 Path    => Gen.Utils.String_List.Element (Iter),
                                                 Process => Print_Model_File'Access);
                  Gen.Utils.String_List.Next (Iter);
               end loop;
            end;
         end;
      end Print_Project;

   begin
      Generator.Read_Project ("dynamo.xml", True);

      Generator.Update_Project (Print_Project'Access);
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Cmd       : in out Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Generator);
   begin
      Ada.Text_IO.Put_Line ("info: Print information about the current project");
      Ada.Text_IO.Put_Line ("Usage: info");
      Ada.Text_IO.New_Line;
   end Help;

end Gen.Commands.Info;

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

with Ada.Text_IO;
with Ada.Directories;

with Gen.Utils;
with Gen.Utils.GNAT;
with Gen.Model.Projects;

with Util.Strings.Sets;
with Util.Files;
package body Gen.Commands.Info is

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   overriding
   procedure Execute (Cmd       : in out Command;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Name, Args);

      procedure Collect_Directories (List   : in Gen.Utils.String_List.Vector;
                                     Result : out Gen.Utils.String_List.Vector);

      procedure Print_Model_File (Name : in String;
                                  File : in String;
                                  Done : out Boolean);

      procedure Print_GNAT_Projects (Project : in out Gen.Model.Projects.Project_Definition);

      procedure Print_Dynamo_Projects (Project : in out Model.Projects.Root_Project_Definition);

      procedure Print_Modules (Project : in out Gen.Model.Projects.Project_Definition'Class;
                               Indent  : in Ada.Text_IO.Positive_Count);

      procedure Print_Project (Project : in out Gen.Model.Projects.Root_Project_Definition);

      procedure Print_Project_List (Indent  : in Ada.Text_IO.Positive_Count;
                                    List    : in Gen.Model.Projects.Project_Vectors.Vector);

      List  : Gen.Utils.String_List.Vector;
      Names : Util.Strings.Sets.Set;

      procedure Collect_Directories (List : in Gen.Utils.String_List.Vector;
                                     Result : out Gen.Utils.String_List.Vector) is

         procedure Add_Model_Dir (Base_Dir : in String;
                                  Dir : in String);

         procedure Add_Model_Dir (Base_Dir : in String;
                                  Dir : in String) is
            Path : constant String := Util.Files.Compose (Base_Dir, Dir);
         begin
            if not Result.Contains (Path) and then Ada.Directories.Exists (Path) then
               Result.Append (Path);
            end if;
         end Add_Model_Dir;

         Iter : Gen.Utils.String_List.Cursor := List.First;
      begin
         while Gen.Utils.String_List.Has_Element (Iter) loop
            declare
               Path : constant String := Gen.Utils.String_List.Element (Iter);
               Dir  : constant String := Ada.Directories.Containing_Directory (Path);
            begin
               Add_Model_Dir (Dir, "db");
               Add_Model_Dir (Dir, "db/regtests");
               Add_Model_Dir (Dir, "db/samples");
            end;
            Gen.Utils.String_List.Next (Iter);
         end loop;
      end Collect_Directories;

      procedure Print_Model_File (Name : in String;
                                  File : in String;
                                  Done : out Boolean) is
         pragma Unreferenced (Name);
      begin
         Ada.Text_IO.Put ("    ");
         Ada.Text_IO.Put_Line (File);
         Done := False;
      end Print_Model_File;

      --  ------------------------------
      --  Print the list of GNAT projects used by the main project.
      --  ------------------------------
      procedure Print_GNAT_Projects (Project : in out Gen.Model.Projects.Project_Definition) is
         use Gen.Utils.GNAT;

         Iter : Project_Info_Vectors.Cursor := Project.Project_Files.First;
         Info : Project_Info;
      begin
         if Project_Info_Vectors.Has_Element (Iter) then
            Ada.Text_IO.Put_Line ("GNAT project files:");
            while Project_Info_Vectors.Has_Element (Iter) loop
               Ada.Text_IO.Put ("   ");
               Info := Project_Info_Vectors.Element (Iter);
               Ada.Text_IO.Put_Line (Ada.Strings.Unbounded.To_String (Info.Path));
               Project_Info_Vectors.Next (Iter);
            end loop;
         end if;
      end Print_GNAT_Projects;

      --  ------------------------------
      --  Print the list of Dynamo modules
      --  ------------------------------
      procedure Print_Project_List (Indent  : in Ada.Text_IO.Positive_Count;
                                    List    : in Gen.Model.Projects.Project_Vectors.Vector) is
         use Gen.Model.Projects;
         use type Ada.Text_IO.Positive_Count;

         Iter : Project_Vectors.Cursor := List.First;
         Ref  : Model.Projects.Project_Reference;
      begin
         while Project_Vectors.Has_Element (Iter) loop
            Ref := Project_Vectors.Element (Iter);
            Ada.Text_IO.Set_Col (Indent);
            Ada.Text_IO.Put ("   ");
            Ada.Text_IO.Put (Ada.Strings.Unbounded.To_String (Ref.Name));
            Ada.Text_IO.Set_Col (Indent + 30);
            if Ref.Project /= null then
               Ada.Text_IO.Put_Line (Ada.Strings.Unbounded.To_String (Ref.Project.Path));
            else
               Ada.Text_IO.Put_Line ("?");
            end if;
            Project_Vectors.Next (Iter);
         end loop;
      end Print_Project_List;

      --  ------------------------------
      --  Print the list of Dynamo modules
      --  ------------------------------
      procedure Print_Modules (Project : in out Gen.Model.Projects.Project_Definition'Class;
                               Indent  : in Ada.Text_IO.Positive_Count) is
         use Gen.Model.Projects;
         use type Ada.Text_IO.Positive_Count;

         Iter : Project_Vectors.Cursor := Project.Modules.First;
         Ref  : Model.Projects.Project_Reference;
      begin
         if not Project.Modules.Is_Empty then
            Ada.Text_IO.Set_Col (Indent);
            Ada.Text_IO.Put_Line ("Dynamo plugins:");
            Print_Project_List (Indent, Project.Modules);

            Print_Project_List (Indent, Project.Dependencies);
            Iter := Project.Modules.First;
            while Project_Vectors.Has_Element (Iter) loop
               Ref := Project_Vectors.Element (Iter);
               if Ref.Project /= null and then not Ref.Project.Modules.Is_Empty then
                  declare
                     Name : constant String := Ada.Strings.Unbounded.To_String (Ref.Name);
                  begin
                     Ada.Text_IO.Set_Col (Indent);
                     if Names.Contains (Name) then
                        Ada.Text_IO.Put_Line ("!! " & Name);
                     else
                        Names.Insert (Name);
                        Ada.Text_IO.Put_Line ("== " & Name);
                        Print_Modules (Ref.Project.all, Indent + 4);
                        Names.Delete (Name);
                     end if;
                  end;
               end if;
               Project_Vectors.Next (Iter);
            end loop;
         end if;
      end Print_Modules;

      --  ------------------------------
      --  Print the list of Dynamo projects used by the main project.
      --  ------------------------------
      procedure Print_Dynamo_Projects (Project : in out Model.Projects.Root_Project_Definition) is
         Iter : Gen.Utils.String_List.Cursor := Project.Dynamo_Files.First;
      begin
         if Gen.Utils.String_List.Has_Element (Iter) then
            Ada.Text_IO.Put_Line ("Dynamo project files:");
            while Gen.Utils.String_List.Has_Element (Iter) loop
               Ada.Text_IO.Put ("   ");
               Ada.Text_IO.Put_Line (Gen.Utils.String_List.Element (Iter));
               Gen.Utils.String_List.Next (Iter);
            end loop;
         end if;
      end Print_Dynamo_Projects;

      procedure Print_Project (Project : in out Gen.Model.Projects.Root_Project_Definition) is
      begin
         Print_GNAT_Projects (Gen.Model.Projects.Project_Definition (Project));
         Print_Dynamo_Projects (Project);

         Print_Modules (Project, 1);
         declare
            Model_Dirs : Gen.Utils.String_List.Vector;
         begin
            Collect_Directories (List, Model_Dirs);
            declare
               Iter : Gen.Utils.String_List.Cursor := Model_Dirs.First;
            begin
               Ada.Text_IO.Put_Line ("ADO model files:");
               while Gen.Utils.String_List.Has_Element (Iter) loop
                  Ada.Text_IO.Put ("   ");
                  Ada.Text_IO.Put_Line (Gen.Utils.String_List.Element (Iter));
                  Util.Files.Iterate_Files_Path (Pattern => "*.xml",
                                                 Path    => Gen.Utils.String_List.Element (Iter),
                                                 Process => Print_Model_File'Access);
                  Gen.Utils.String_List.Next (Iter);
               end loop;
            end;
         end;
      end Print_Project;

   begin
      Generator.Read_Project ("dynamo.xml", True);

      Generator.Update_Project (Print_Project'Access);
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Cmd       : in out Command;
                   Name      : in String;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Name, Generator);
   begin
      Ada.Text_IO.Put_Line ("info: Print information about the current project");
      Ada.Text_IO.Put_Line ("Usage: info");
      Ada.Text_IO.New_Line;
   end Help;

end Gen.Commands.Info;

Add Name parameter to the Help procedure


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

package body Gen.Model.Queries is

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : in Sort_Definition;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "name" then
         return Util.Beans.Objects.To_Object (From.Name);

      elsif Name = "sql" then
         return Util.Beans.Objects.To_Object (From.Sql);

      else
         return Definition (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : Query_Definition;
                       Name : String) return Util.Beans.Objects.Object is
   begin
      if Name = "sorts" then
         return From.Sorts_Bean;

      elsif Name = "isBean" then
         return Util.Beans.Objects.To_Object (True);

      else
         return Tables.Table_Definition (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Prepare the generation of the model.
   --  ------------------------------
   overriding
   procedure Prepare (O : in out Query_Definition) is
   begin
      Tables.Table_Definition (O).Prepare;
   end Prepare;

   --  ------------------------------
   --  Add a new sort mode for the query definition.
   --  ------------------------------
   procedure Add_Sort (Into : in out Query_Definition;
                       Name : in Unbounded_String;
                       Sql  : in Unbounded_String) is
      Item : constant Sort_Definition_Access := new Sort_Definition;
   begin
      Item.Name := Name;
      Item.Sql  := Sql;
      Into.Sorts.Append (Item);
   end Add_Sort;

   --  ------------------------------
   --  Initialize the table definition instance.
   --  ------------------------------
   overriding
   procedure Initialize (O : in out Query_Definition) is
   begin
      O.Sorts_Bean := Util.Beans.Objects.To_Object (O.Sorts'Unchecked_Access,
                                                    Util.Beans.Objects.STATIC);
      Tables.Table_Definition (O).Initialize;
   end Initialize;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : in Query_File_Definition;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "queries" then
         return From.Queries_Bean;

      elsif Name = "path" then
         return Util.Beans.Objects.To_Object (From.File_Name);

      elsif Name = "sha1" then
         return Util.Beans.Objects.To_Object (From.Sha1);

      else
         return Query_Definition (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  Prepare the generation of the model.
   overriding
   procedure Prepare (O : in out Query_File_Definition) is
   begin
      Tables.Table_Definition (O).Prepare;
   end Prepare;

   --  ------------------------------
   --  Add a new query to the definition.
   --  ------------------------------
   procedure Add_Query (Into   : in out Query_File_Definition;
                        Name   : in Unbounded_String;
                        Query  : out Query_Definition_Access) is
   begin
      Query := new Query_Definition;
      Query.Name := Name;
      Into.Queries.Append (Query.all'Access);
      --  Query.Number := Into.Queries.Get_Count;
   end Add_Query;

   --  ------------------------------
   --  Initialize the table definition instance.
   --  ------------------------------
   overriding
   procedure Initialize (O : in out Query_File_Definition) is
   begin
      O.Queries_Bean := Util.Beans.Objects.To_Object (O.Queries'Unchecked_Access,
                                                      Util.Beans.Objects.STATIC);
      Tables.Table_Definition (O).Initialize;
   end Initialize;

end Gen.Model.Queries;

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

package body Gen.Model.Queries is

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : in Sort_Definition;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "name" then
         return Util.Beans.Objects.To_Object (From.Name);

      elsif Name = "sql" then
         return Util.Beans.Objects.To_Object (From.Sql);

      else
         return Definition (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   overriding
   function Get_Value (From : Query_Definition;
                       Name : String) return Util.Beans.Objects.Object is
   begin
      if Name = "sorts" then
         return From.Sorts_Bean;

      elsif Name = "isBean" then
         return Util.Beans.Objects.To_Object (True);

      else
         return Tables.Table_Definition (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Prepare the generation of the model.
   --  ------------------------------
   overriding
   procedure Prepare (O : in out Query_Definition) is
   begin
      Tables.Table_Definition (O).Prepare;
   end Prepare;

   --  ------------------------------
   --  Add a new sort mode for the query definition.
   --  ------------------------------
   procedure Add_Sort (Into : in out Query_Definition;
                       Name : in Unbounded_String;
                       Sql  : in Unbounded_String) is
      Item : constant Sort_Definition_Access := new Sort_Definition;
   begin
      Item.Set_Name (Name);
      Item.Sql  := Sql;
      Into.Sorts.Append (Item);
   end Add_Sort;

   --  ------------------------------
   --  Initialize the table definition instance.
   --  ------------------------------
   overriding
   procedure Initialize (O : in out Query_Definition) is
   begin
      O.Sorts_Bean := Util.Beans.Objects.To_Object (O.Sorts'Unchecked_Access,
                                                    Util.Beans.Objects.STATIC);
      Tables.Table_Definition (O).Initialize;
   end Initialize;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : in Query_File_Definition;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "queries" then
         return From.Queries_Bean;

      elsif Name = "path" then
         return Util.Beans.Objects.To_Object (From.File_Name);

      elsif Name = "sha1" then
         return Util.Beans.Objects.To_Object (From.Sha1);

      else
         return Query_Definition (From).Get_Value (Name);
      end if;
   end Get_Value;

   --  Prepare the generation of the model.
   overriding
   procedure Prepare (O : in out Query_File_Definition) is
   begin
      Tables.Table_Definition (O).Prepare;
   end Prepare;

   --  ------------------------------
   --  Add a new query to the definition.
   --  ------------------------------
   procedure Add_Query (Into   : in out Query_File_Definition;
                        Name   : in Unbounded_String;
                        Query  : out Query_Definition_Access) is
   begin
      Query := new Query_Definition;
      Query.Set_Name (Name);
      Into.Queries.Append (Query.all'Access);
      --  Query.Number := Into.Queries.Get_Count;
   end Add_Query;

   --  ------------------------------
   --  Initialize the table definition instance.
   --  ------------------------------
   overriding
   procedure Initialize (O : in out Query_File_Definition) is
   begin
      O.Queries_Bean := Util.Beans.Objects.To_Object (O.Queries'Unchecked_Access,
                                                      Util.Beans.Objects.STATIC);
      Tables.Table_Definition (O).Initialize;
   end Initialize;

end Gen.Model.Queries;

Update to use Get_Location and Set_Name

Update to use Get_Location and Set_Name