-----------------------------------------------------------------------
--  gen-commands-plugins -- Plugin creation and management commands for dynamo
--  Copyright (C) 2012, 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Directories;
with Ada.Text_IO;
with Gen.Artifacts;
with Gen.Model.Projects;
with GNAT.Command_Line;

with Util.Files;
with Util.Log.Loggers;
with Util.Strings.Transforms;
package body Gen.Commands.Plugins is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Gen.Commands.Project");

   --  ------------------------------
   --  Generator Command
   --  ------------------------------

   --  Execute the command with the arguments.
   procedure Execute (Cmd       : in Command;
                      Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd);
      use GNAT.Command_Line;

      function Get_Directory_Name (Name     : in String;
                                   Name_Dir : in Ada.Strings.Unbounded.Unbounded_String)
        return String;

      function Get_Directory_Name (Name     : in String;
                                   Name_Dir : in Ada.Strings.Unbounded.Unbounded_String)
                                   return String is
      begin
         if Ada.Strings.Unbounded.Length (Name_Dir) = 0 then
            return Name;
         else
            return Ada.Strings.Unbounded.To_String (Name_Dir);
         end if;
      end Get_Directory_Name;

      Result_Dir : constant String := Generator.Get_Result_Directory;
      Name_Dir   : Ada.Strings.Unbounded.Unbounded_String;
   begin
      --  If a dynamo.xml file exists, read it.
      if Ada.Directories.Exists ("dynamo.xml") then
         Generator.Read_Project ("dynamo.xml");
      else
         Generator.Set_Project_Property ("license", "apache");
         Generator.Set_Project_Property ("author", "unknown");
         Generator.Set_Project_Property ("author_email", "unknown@company.com");
      end if;
      --  Parse the command line
      loop
         case Getopt ("l: d:") is
         when ASCII.NUL => exit;

         when 'd' =>
            Name_Dir := Ada.Strings.Unbounded.To_Unbounded_String (Parameter);

         when 'l' =>
            declare
               L : constant String := Util.Strings.Transforms.To_Lower_Case (Parameter);
            begin
               Log.Info ("License {0}", L);

               if L = "apache" then
                  Generator.Set_Project_Property ("license", "apache");
               elsif L = "gpl" then
                  Generator.Set_Project_Property ("license", "gpl");
               elsif L = "gpl3" then
                  Generator.Set_Project_Property ("license", "gpl3");
               elsif L = "mit" then
                  Generator.Set_Project_Property ("license", "mit");
               elsif L = "bsd3" then
                  Generator.Set_Project_Property ("license", "bsd3");
               elsif L = "proprietary" then
                  Generator.Set_Project_Property ("license", "proprietary");
               else
                  Generator.Error ("Invalid license: {0}", L);
                  Generator.Error ("Valid licenses: apache, gpl, gpl3, mit, bsd3, proprietary");
                  return;
               end if;
            end;

         when others =>
            null;
         end case;
      end loop;
      declare
         Name  : constant String := Get_Argument;
         Kind  : constant String := Get_Argument;
         Dir   : constant String := Generator.Get_Plugin_Directory;
         Path  : constant String := Util.Files.Compose (Dir, Get_Directory_Name (Name, Name_Dir));
      begin
         if Name'Length = 0 then
            Generator.Error ("Missing plugin name");
            Gen.Commands.Usage;
            return;
         end if;
         if Kind /= "ada" and Kind /= "web" then
            Generator.Error ("Invalid plugin type (must be 'ada' or 'web')");
            return;
         end if;

         if Ada.Directories.Exists (Path) then
            Generator.Error ("Plugin {0} exists already", Name);
            return;
         end if;
         if not Ada.Directories.Exists (Dir) then
            Ada.Directories.Create_Directory (Dir);
         end if;
         Ada.Directories.Create_Directory (Path);

         Generator.Set_Result_Directory (Path);

         --  Create the plugin project instance and generate its dynamo.xml file.
         --  The new plugin is added to the current project so that it will be referenced.
         declare
            procedure Create_Plugin (Project : in out Model.Projects.Root_Project_Definition);

            procedure Create_Plugin (Project : in out Model.Projects.Root_Project_Definition) is
               Plugin : Gen.Model.Projects.Project_Definition_Access;
               File   : constant String := Util.Files.Compose (Path, "dynamo.xml");
            begin
               Project.Create_Project (Name    => Name,
                                       Path    => File,
                                       Project => Plugin);
               Project.Add_Module (Plugin);

               Plugin.Props.Set ("license", Project.Props.Get ("license", "none"));
               Plugin.Props.Set ("author", Project.Props.Get ("author", ""));
               Plugin.Props.Set ("author_email", Project.Props.Get ("author_email", ""));
               Plugin.Save (File);
            end Create_Plugin;

         begin
            Generator.Update_Project (Create_Plugin'Access);
         end;

         --  Generate the new plugin content.
         Generator.Set_Force_Save (False);
         Generator.Set_Global ("pluginName", Name);
         Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE,
                                     "create-plugin-" & Kind);

         --  And save the project dynamo.xml file which now refers to the new plugin.
         Generator.Set_Result_Directory (Result_Dir);
         Generator.Save_Project;

      exception
         when Ada.Directories.Name_Error | Ada.Directories.Use_Error =>
            Generator.Error ("Cannot create directory {0}", Path);
      end;
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   procedure Help (Cmd       : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Generator);
      use Ada.Text_IO;
   begin
      Put_Line ("create-plugin: Create a new plugin for the current project");
      Put_Line ("Usage: create-plugin [-l apache|gpl|gpl3|mit|bsd3|proprietary] "
                & "[-d DIR] NAME [ada | web]");
      New_Line;
      Put_Line ("  Creates a new AWA plugin for the application with the name passed in NAME.");
      Put_Line ("  The plugin license is controlled by the -l option.");
      Put_Line ("  The plugin type is specified as the last argument which can be one of:");
      New_Line;
      Put_Line ("    ada  the plugin contains Ada code and a GNAT project is created");
      Put_Line ("    web  the plugin contains XHTML, CSS, Javascript files only");
      New_Line;
      Put_Line ("  The -d option allows to control the plugin directory name.  The plugin NAME");
      Put_Line ("  is used by default.  The plugin is created in the directory:");
      Put_Line ("    plugins/NAME or plugins/DIR");
      New_Line;
      Put_Line ("  For the Ada plugin, the command generates the following files"
                & " in the plugin directory:");
      Put_Line ("    src/<project>-<plugin>.ads");
      Put_Line ("    src/<project>-<plugin>-<module>.ads");
      Put_Line ("    src/<project>-<plugin>-<module>.adb");
   end Help;

end Gen.Commands.Plugins;

-----------------------------------------------------------------------
--  gen-commands-plugins -- Plugin creation and management commands for dynamo
--  Copyright (C) 2012, 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 Ada.Directories;
with Ada.Text_IO;
with Gen.Artifacts;
with Gen.Model.Projects;
with GNAT.Command_Line;

with Util.Files;
with Util.Log.Loggers;
with Util.Strings.Transforms;
package body Gen.Commands.Plugins is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Gen.Commands.Project");

   --  ------------------------------
   --  Generator Command
   --  ------------------------------

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

      function Get_Directory_Name (Name     : in String;
                                   Name_Dir : in Ada.Strings.Unbounded.Unbounded_String)
        return String;

      function Get_Directory_Name (Name     : in String;
                                   Name_Dir : in Ada.Strings.Unbounded.Unbounded_String)
                                   return String is
      begin
         if Ada.Strings.Unbounded.Length (Name_Dir) = 0 then
            return Name;
         else
            return Ada.Strings.Unbounded.To_String (Name_Dir);
         end if;
      end Get_Directory_Name;

      Result_Dir : constant String := Generator.Get_Result_Directory;
      Name_Dir   : Ada.Strings.Unbounded.Unbounded_String;
   begin
      --  If a dynamo.xml file exists, read it.
      if Ada.Directories.Exists ("dynamo.xml") then
         Generator.Read_Project ("dynamo.xml");
      else
         Generator.Set_Project_Property ("license", "apache");
         Generator.Set_Project_Property ("author", "unknown");
         Generator.Set_Project_Property ("author_email", "unknown@company.com");
      end if;
      --  Parse the command line
      loop
         case Getopt ("l: d:") is
         when ASCII.NUL => exit;

         when 'd' =>
            Name_Dir := Ada.Strings.Unbounded.To_Unbounded_String (Parameter);

         when 'l' =>
            declare
               L : constant String := Util.Strings.Transforms.To_Lower_Case (Parameter);
            begin
               Log.Info ("License {0}", L);

               if L = "apache" then
                  Generator.Set_Project_Property ("license", "apache");
               elsif L = "gpl" then
                  Generator.Set_Project_Property ("license", "gpl");
               elsif L = "gpl3" then
                  Generator.Set_Project_Property ("license", "gpl3");
               elsif L = "mit" then
                  Generator.Set_Project_Property ("license", "mit");
               elsif L = "bsd3" then
                  Generator.Set_Project_Property ("license", "bsd3");
               elsif L = "proprietary" then
                  Generator.Set_Project_Property ("license", "proprietary");
               else
                  Generator.Error ("Invalid license: {0}", L);
                  Generator.Error ("Valid licenses: apache, gpl, gpl3, mit, bsd3, proprietary");
                  return;
               end if;
            end;

         when others =>
            null;
         end case;
      end loop;
      declare
         Name  : constant String := Get_Argument;
         Kind  : constant String := Get_Argument;
         Dir   : constant String := Generator.Get_Plugin_Directory;
         Path  : constant String := Util.Files.Compose (Dir, Get_Directory_Name (Name, Name_Dir));
      begin
         if Name'Length = 0 then
            Generator.Error ("Missing plugin name");
            Gen.Commands.Usage;
            return;
         end if;
         if Kind /= "ada" and Kind /= "web" then
            Generator.Error ("Invalid plugin type (must be 'ada' or 'web')");
            return;
         end if;

         if Ada.Directories.Exists (Path) then
            Generator.Error ("Plugin {0} exists already", Name);
            return;
         end if;
         if not Ada.Directories.Exists (Dir) then
            Ada.Directories.Create_Directory (Dir);
         end if;
         Ada.Directories.Create_Directory (Path);

         Generator.Set_Result_Directory (Path);

         --  Create the plugin project instance and generate its dynamo.xml file.
         --  The new plugin is added to the current project so that it will be referenced.
         declare
            procedure Create_Plugin (Project : in out Model.Projects.Root_Project_Definition);

            procedure Create_Plugin (Project : in out Model.Projects.Root_Project_Definition) is
               Plugin : Gen.Model.Projects.Project_Definition_Access;
               File   : constant String := Util.Files.Compose (Path, "dynamo.xml");
            begin
               Project.Create_Project (Name    => Name,
                                       Path    => File,
                                       Project => Plugin);
               Project.Add_Module (Plugin);

               Plugin.Props.Set ("license", Project.Props.Get ("license", "none"));
               Plugin.Props.Set ("author", Project.Props.Get ("author", ""));
               Plugin.Props.Set ("author_email", Project.Props.Get ("author_email", ""));
               Plugin.Save (File);
            end Create_Plugin;

         begin
            Generator.Update_Project (Create_Plugin'Access);
         end;

         --  Generate the new plugin content.
         Generator.Set_Force_Save (False);
         Generator.Set_Global ("pluginName", Name);
         Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE,
                                     "create-plugin-" & Kind);

         --  And save the project dynamo.xml file which now refers to the new plugin.
         Generator.Set_Result_Directory (Result_Dir);
         Generator.Save_Project;

      exception
         when Ada.Directories.Name_Error | Ada.Directories.Use_Error =>
            Generator.Error ("Cannot create directory {0}", Path);
      end;
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Cmd       : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Generator);
      use Ada.Text_IO;
   begin
      Put_Line ("create-plugin: Create a new plugin for the current project");
      Put_Line ("Usage: create-plugin [-l apache|gpl|gpl3|mit|bsd3|proprietary] "
                & "[-d DIR] NAME [ada | web]");
      New_Line;
      Put_Line ("  Creates a new AWA plugin for the application with the name passed in NAME.");
      Put_Line ("  The plugin license is controlled by the -l option.");
      Put_Line ("  The plugin type is specified as the last argument which can be one of:");
      New_Line;
      Put_Line ("    ada  the plugin contains Ada code and a GNAT project is created");
      Put_Line ("    web  the plugin contains XHTML, CSS, Javascript files only");
      New_Line;
      Put_Line ("  The -d option allows to control the plugin directory name.  The plugin NAME");
      Put_Line ("  is used by default.  The plugin is created in the directory:");
      Put_Line ("    plugins/NAME or plugins/DIR");
      New_Line;
      Put_Line ("  For the Ada plugin, the command generates the following files"
                & " in the plugin directory:");
      Put_Line ("    src/<project>-<plugin>.ads");
      Put_Line ("    src/<project>-<plugin>-<module>.ads");
      Put_Line ("    src/<project>-<plugin>-<module>.adb");
   end Help;

end Gen.Commands.Plugins;


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

--  The default function mapper allows to register
--  The expression context provides information to resolve runtime
--  information when evaluating an expression.  The context provides
--  a resolver whose role is to find variables given their name.

package body EL.Functions.Default is

   --  ------------------------------
   --  Default Function mapper
   --  ------------------------------
   --

   use Function_Maps;

   --  ------------------------------
   --  Find the function knowing its name.
   --  ------------------------------
   function Get_Function (Mapper    : Default_Function_Mapper;
                          Namespace : String;
                          Name      : String) return Function_Access is
      Full_Name : constant String := Namespace & ":" & Name;
      C : constant Cursor := Mapper.Map.Find (Key => To_Unbounded_String (Full_Name));
   begin
      if Has_Element (C) then
         return Element (C);
      end if;
      raise No_Function;
   end Get_Function;

   --  ------------------------------
   --  Bind a name to a function.
   --  ------------------------------
   procedure Set_Function (Mapper    : in out Default_Function_Mapper;
                           Namespace : in String;
                           Name      : in String;
                           Func      : in Function_Access) is
      Full_Name : constant String := Namespace & ":" & Name;
   begin
      Mapper.Map.Include (Key => To_Unbounded_String (Full_Name), New_Item => Func);
   end Set_Function;

   --  ------------------------------
   --  Truncate the string representation represented by Value to
   --  the length specified by Size.
   --  ------------------------------
   function Truncate (Value : EL.Objects.Object;
                      Size  : EL.Objects.Object) return EL.Objects.Object is
      Cnt : constant Integer := To_Integer (Size);
   begin
      if Cnt <= 0 then
         return To_Object (String '(""));
      end if;
      if Get_Type (Value) = TYPE_WIDE_STRING then
         declare
            S : constant Wide_Wide_String := To_Wide_Wide_String (Value);
         begin
            return To_Object (S (1 .. Cnt));
         end;
      else
         --  Optimized case: use a String if we can.
         declare
            S : constant String := To_String (Value);
         begin
            return To_Object (S (1 .. Cnt));
         end;
      end if;
   end Truncate;

end EL.Functions.Default;

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

--  The default function mapper allows to register
--  The expression context provides information to resolve runtime
--  information when evaluating an expression.  The context provides
--  a resolver whose role is to find variables given their name.

package body EL.Functions.Default is

   --  ------------------------------
   --  Default Function mapper
   --  ------------------------------
   --

   use Function_Maps;

   --  ------------------------------
   --  Find the function knowing its name.
   --  ------------------------------
   function Get_Function (Mapper    : Default_Function_Mapper;
                          Namespace : String;
                          Name      : String) return Function_Access is
      Full_Name : constant String := Namespace & ":" & Name;
      C : constant Cursor := Mapper.Map.Find (Key => To_Unbounded_String (Full_Name));
   begin
      if Has_Element (C) then
         return Element (C);
      end if;
      raise No_Function with "Function '" & Full_Name & "' not found";
   end Get_Function;

   --  ------------------------------
   --  Bind a name to a function.
   --  ------------------------------
   procedure Set_Function (Mapper    : in out Default_Function_Mapper;
                           Namespace : in String;
                           Name      : in String;
                           Func      : in Function_Access) is
      Full_Name : constant String := Namespace & ":" & Name;
   begin
      Mapper.Map.Include (Key => To_Unbounded_String (Full_Name), New_Item => Func);
   end Set_Function;

   --  ------------------------------
   --  Truncate the string representation represented by Value to
   --  the length specified by Size.
   --  ------------------------------
   function Truncate (Value : EL.Objects.Object;
                      Size  : EL.Objects.Object) return EL.Objects.Object is
      Cnt : constant Integer := To_Integer (Size);
   begin
      if Cnt <= 0 then
         return To_Object (String '(""));
      end if;
      if Get_Type (Value) = TYPE_WIDE_STRING then
         declare
            S : constant Wide_Wide_String := To_Wide_Wide_String (Value);
         begin
            return To_Object (S (1 .. Cnt));
         end;
      else
         --  Optimized case: use a String if we can.
         declare
            S : constant String := To_String (Value);
         begin
            return To_Object (S (1 .. Cnt));
         end;
      end if;
   end Truncate;

end EL.Functions.Default;

Add a message in the Not_Found exception


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

with GNAT.Command_Line;

with Ada.Text_IO;
package body Gen.Commands.Docs is

   use GNAT.Command_Line;

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   procedure Execute (Cmd       : in Command;
                      Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd);
   begin
      Generator.Read_Project ("dynamo.xml", True);

      --  Setup the target directory where the distribution is created.
      declare
         Target_Dir : constant String := Get_Argument;
      begin
         if Target_Dir'Length = 0 then
            Generator.Error ("Missing target directory");
            return;
         end if;
         Generator.Set_Result_Directory (Target_Dir);
      end;

      --  Read the package description.
      declare
         Package_File : constant String := Get_Argument;
      begin
         if Package_File'Length > 0 then
            Gen.Generator.Read_Package (Generator, Package_File);
         else
            Gen.Generator.Read_Package (Generator, "package.xml");
         end if;
      end;

      --  Run the generation.
      Gen.Generator.Prepare (Generator);
      Gen.Generator.Generate_All (Generator);
      Gen.Generator.Finish (Generator);
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   procedure Help (Cmd       : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Generator);
      use Ada.Text_IO;
   begin
      Put_Line ("build-doc: Extract and generate the project documentation");
      Put_Line ("Usage: build-doc");
      New_Line;
      Put_Line ("  Extract the documentation from the project source files and generate the");
      Put_Line ("  project documentation.  The following files are scanned:");
      Put_Line ("    - Ada specifications (src/*.ads)");
      Put_Line ("    - XML configuration files (config/*.xml)");
      Put_Line ("    - XML database model files (db/*.xml)");
   end Help;

end Gen.Commands.Docs;

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

with GNAT.Command_Line;

with Ada.Text_IO;

with Gen.Artifacts.Docs;
with Gen.Model.Packages;
package body Gen.Commands.Docs is

   use GNAT.Command_Line;

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   procedure Execute (Cmd       : in Command;
                      Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd);

      Doc : Gen.Artifacts.Docs.Artifact;
      M   : Gen.Model.Packages.Model_Definition;
   begin
      Generator.Read_Project ("dynamo.xml", False);

      --  Setup the target directory where the distribution is created.
      declare
         Target_Dir : constant String := Get_Argument;
      begin
         if Target_Dir'Length = 0 then
            Generator.Error ("Missing target directory");
            return;
         end if;
         Generator.Set_Result_Directory (Target_Dir);
      end;
--
--        --  Read the package description.
--        declare
--           Package_File : constant String := Get_Argument;
--        begin
--           if Package_File'Length > 0 then
--              Gen.Generator.Read_Package (Generator, Package_File);
--           else
--              Gen.Generator.Read_Package (Generator, "package.xml");
--           end if;
--        end;

      Doc.Prepare (M, Generator);
--        --  Run the generation.
--        Gen.Generator.Prepare (Generator);
--        Gen.Generator.Generate_All (Generator);
--        Gen.Generator.Finish (Generator);
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   procedure Help (Cmd       : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Generator);
      use Ada.Text_IO;
   begin
      Put_Line ("build-doc: Extract and generate the project documentation");
      Put_Line ("Usage: build-doc");
      New_Line;
      Put_Line ("  Extract the documentation from the project source files and generate the");
      Put_Line ("  project documentation.  The following files are scanned:");
      Put_Line ("    - Ada specifications (src/*.ads)");
      Put_Line ("    - XML configuration files (config/*.xml)");
      Put_Line ("    - XML database model files (db/*.xml)");
   end Help;

end Gen.Commands.Docs;

Create the documentation artifact and invoke it for the build-doc command


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

with Ada.Unchecked_Deallocation;
with Ada.Strings.Unbounded;

with Util.Refs;
with Util.Beans.Objects;
with Util.Beans.Objects.Vectors;
with Util.Serialize.Mappers;
with Util.Serialize.Mappers.Record_Mapper;

with GNAT.Regexp;
with Security.Controllers;

package body Security.Policies.Urls is

   --  ------------------------------
   --  URL policy
   --  ------------------------------

   --  ------------------------------
   --  Get the policy name.
   --  ------------------------------
   overriding
   function Get_Name (From : in URL_Policy) return String is
      pragma Unreferenced (From);
   begin
      return NAME;
   end Get_Name;

   --  Returns True if the user has the permission to access the given URI permission.
   function Has_Permission (Manager    : in URL_Policy;
                            Context    : in Security_Context_Access;
                            Permission : in URI_Permission'Class) return Boolean is
      Name  : constant String_Ref := To_String_Ref (Permission.URI);
      Ref   : constant Rules_Ref.Ref := Manager.Cache.Get;
      Rules : constant Rules_Access := Ref.Value;
      Pos   : constant Rules_Maps.Cursor := Rules.Map.Find (Name);
      Rule  : Access_Rule_Ref;
   begin
      --  If the rule is not in the cache, search for the access rule that
      --  matches our URI.  Update the cache.  This cache update is thread-safe
      --  as the cache map is never modified: a new cache map is installed.
      if not Rules_Maps.Has_Element (Pos) then
         declare
            New_Ref : constant Rules_Ref.Ref := Rules_Ref.Create;
         begin
            Rule := Manager.Find_Access_Rule (Permission.URI);
            New_Ref.Value.all.Map := Rules.Map;
            New_Ref.Value.all.Map.Insert (Name, Rule);
            Manager.Cache.Set (New_Ref);
         end;
      else
         Rule := Rules_Maps.Element (Pos);
      end if;

      --  Check if the user has one of the required permission.
      declare
         P       : constant Access_Rule_Access := Rule.Value;
         Granted : Boolean;
      begin
         if P /= null then
            for I in P.Permissions'Range loop
--                 Context.Has_Permission (P.Permissions (I), Granted);
               if Granted then
                  return True;
               end if;
            end loop;
         end if;
      end;
      return False;
   end Has_Permission;

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

   --  ------------------------------
   --  Policy Configuration
   --  ------------------------------
   type Policy_Config is record
      Id          : Natural := 0;
      Permissions : Util.Beans.Objects.Vectors.Vector;
      Patterns    : Util.Beans.Objects.Vectors.Vector;
      Manager     : URL_Policy_Access;
   end record;
   type Policy_Config_Access is access all Policy_Config;

   --  Setup the XML parser to read the policy description.  For example:

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

      Matched : Boolean := False;
      Result  : Access_Rule_Ref;

      procedure Match (P : in Policy);

      procedure Match (P : in Policy) is
      begin
         if GNAT.Regexp.Match (URI, P.Pattern) then
            Matched := True;
            Result  := P.Rule;
         end if;
      end Match;

      Last : constant Natural := Manager.Policies.Last_Index;
   begin
      for I in 1 .. Last loop
         Manager.Policies.Query_Element (I, Match'Access);
         if Matched then
            return Result;
         end if;
      end loop;
      return Result;
   end Find_Access_Rule;

   --  ------------------------------
   --  Initialize the permission manager.
   --  ------------------------------
   overriding
   procedure Initialize (Manager : in out URL_Policy) is
   begin
      Manager.Cache := new Rules_Ref.Atomic_Ref;
      Manager.Cache.Set (Rules_Ref.Create);
   end Initialize;

   --  ------------------------------
   --  Finalize the permission manager.
   --  ------------------------------
   overriding
   procedure Finalize (Manager : in out URL_Policy) is
      use Ada.Strings.Unbounded;
      use Security.Controllers;

      procedure Free is
        new Ada.Unchecked_Deallocation (Rules_Ref.Atomic_Ref,
                                        Rules_Ref_Access);
      procedure Free is
        new Ada.Unchecked_Deallocation (Security.Controllers.Controller'Class,
                                        Security.Controllers.Controller_Access);
      procedure Free is
        new Ada.Unchecked_Deallocation (Controller_Access_Array,
                                        Controller_Access_Array_Access);

   begin
      Free (Manager.Cache);
--        for I in Manager.Names'Range loop
--           exit when Manager.Names (I) = null;
--           Ada.Strings.Unbounded.Free (Manager.Names (I));
--        end loop;

   end Finalize;

   type Policy_Fields is (FIELD_ID, FIELD_PERMISSION, FIELD_URL_PATTERN, FIELD_POLICY);

   procedure Set_Member (P     : in out Policy_Config;
                         Field : in Policy_Fields;
                         Value : in Util.Beans.Objects.Object);

   procedure Process (Policy : in Policy_Config);

   procedure Set_Member (P     : in out Policy_Config;
                         Field : in Policy_Fields;
                         Value : in Util.Beans.Objects.Object) is
   begin
      case Field is
         when FIELD_ID =>
            P.Id := Util.Beans.Objects.To_Integer (Value);

         when FIELD_PERMISSION =>
            P.Permissions.Append (Value);

         when FIELD_URL_PATTERN =>
            P.Patterns.Append (Value);

         when FIELD_POLICY =>
            Process (P);
            P.Id := 0;
            P.Permissions.Clear;
            P.Patterns.Clear;

      end case;
   end Set_Member;

   procedure Process (Policy : in Policy_Config) is
      Pol    : Security.Policies.URLs.Policy;
      Count  : constant Natural := Natural (Policy.Permissions.Length);
      Rule   : constant Access_Rule_Ref := Access_Rule_Refs.Create (new Access_Rule (Count));
      Iter   : Util.Beans.Objects.Vectors.Cursor := Policy.Permissions.First;
      Pos    : Positive := 1;
   begin
      Pol.Rule := Rule;

      --  Step 1: Initialize the list of permission index in Access_Rule from the permission names.
      while Util.Beans.Objects.Vectors.Has_Element (Iter) loop
         declare
            Perm : constant Util.Beans.Objects.Object := Util.Beans.Objects.Vectors.Element (Iter);
            Name : constant String := Util.Beans.Objects.To_String (Perm);
         begin
            Rule.Value.all.Permissions (Pos) := Permissions.Get_Permission_Index (Name);
            Pos := Pos + 1;

         exception
            when Invalid_Name =>
               raise Util.Serialize.Mappers.Field_Error with "Invalid permission: " & Name;
         end;
         Util.Beans.Objects.Vectors.Next (Iter);
      end loop;

      --  Step 2: Create one policy for each URL pattern
      Iter := Policy.Patterns.First;
      while Util.Beans.Objects.Vectors.Has_Element (Iter) loop
         declare
            Pattern : constant Util.Beans.Objects.Object
              := Util.Beans.Objects.Vectors.Element (Iter);
         begin
            Pol.Id   := Policy.Id;
            Pol.Pattern := GNAT.Regexp.Compile (Util.Beans.Objects.To_String (Pattern));
            Policy.Manager.Policies.Append (Pol);
         end;
         Util.Beans.Objects.Vectors.Next (Iter);
      end loop;
   end Process;

   package Policy_Mapper is
     new Util.Serialize.Mappers.Record_Mapper (Element_Type        => Policy_Config,
                                               Element_Type_Access => Policy_Config_Access,
                                               Fields              => Policy_Fields,
                                               Set_Member          => Set_Member);

   Policy_Mapping        : aliased Policy_Mapper.Mapper;

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

--        Policy_Mapping        : aliased Policy_Mapper.Mapper;
      Config : Policy_Config_Access := new Policy_Config;
   begin
      Reader.Add_Mapping ("policy-rules", Policy_Mapping'Access);
      Reader.Add_Mapping ("module", Policy_Mapping'Access);
      Config.Manager := Policy'Unchecked_Access;
      Policy_Mapper.Set_Context (Reader, Config);
   end Set_Reader_Config;

begin
   Policy_Mapping.Add_Mapping ("policy", FIELD_POLICY);
   Policy_Mapping.Add_Mapping ("policy/@id", FIELD_ID);
   Policy_Mapping.Add_Mapping ("policy/permission", FIELD_PERMISSION);
   Policy_Mapping.Add_Mapping ("policy/url-pattern", FIELD_URL_PATTERN);
end Security.Policies.Urls;

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

with Ada.Unchecked_Deallocation;
with Ada.Strings.Unbounded;

with Util.Refs;
with Util.Beans.Objects;
with Util.Beans.Objects.Vectors;
with Util.Serialize.Mappers;
with Util.Serialize.Mappers.Record_Mapper;

with GNAT.Regexp;
with Security.Controllers;

package body Security.Policies.Urls is

   --  ------------------------------
   --  URL policy
   --  ------------------------------

   --  ------------------------------
   --  Get the policy name.
   --  ------------------------------
   overriding
   function Get_Name (From : in URL_Policy) return String is
      pragma Unreferenced (From);
   begin
      return NAME;
   end Get_Name;

   --  Returns True if the user has the permission to access the given URI permission.
   function Has_Permission (Manager    : in URL_Policy;
                            Context    : in Security_Context_Access;
                            Permission : in URI_Permission'Class) return Boolean is
      Name  : constant String_Ref := To_String_Ref (Permission.URI);
      Ref   : constant Rules_Ref.Ref := Manager.Cache.Get;
      Rules : constant Rules_Access := Ref.Value;
      Pos   : constant Rules_Maps.Cursor := Rules.Map.Find (Name);
      Rule  : Access_Rule_Ref;
   begin
      --  If the rule is not in the cache, search for the access rule that
      --  matches our URI.  Update the cache.  This cache update is thread-safe
      --  as the cache map is never modified: a new cache map is installed.
      if not Rules_Maps.Has_Element (Pos) then
         declare
            New_Ref : constant Rules_Ref.Ref := Rules_Ref.Create;
         begin
            Rule := Manager.Find_Access_Rule (Permission.URI);
            New_Ref.Value.all.Map := Rules.Map;
            New_Ref.Value.all.Map.Insert (Name, Rule);
            Manager.Cache.Set (New_Ref);
         end;
      else
         Rule := Rules_Maps.Element (Pos);
      end if;

      --  Check if the user has one of the required permission.
      declare
         P       : constant Access_Rule_Access := Rule.Value;
         Granted : Boolean;
      begin
         if P /= null then
            for I in P.Permissions'Range loop
--                 Context.Has_Permission (P.Permissions (I), Granted);
               if Granted then
                  return True;
               end if;
            end loop;
         end if;
      end;
      return False;
   end Has_Permission;

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

   --  ------------------------------
   --  Policy Configuration
   --  ------------------------------
   type Policy_Config is record
      Id          : Natural := 0;
      Permissions : Util.Beans.Objects.Vectors.Vector;
      Patterns    : Util.Beans.Objects.Vectors.Vector;
      Manager     : URL_Policy_Access;
   end record;
   type Policy_Config_Access is access all Policy_Config;

   --  Setup the XML parser to read the policy description.  For example:

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

      Matched : Boolean := False;
      Result  : Access_Rule_Ref;

      procedure Match (P : in Policy);

      procedure Match (P : in Policy) is
      begin
         if GNAT.Regexp.Match (URI, P.Pattern) then
            Matched := True;
            Result  := P.Rule;
         end if;
      end Match;

      Last : constant Natural := Manager.Policies.Last_Index;
   begin
      for I in 1 .. Last loop
         Manager.Policies.Query_Element (I, Match'Access);
         if Matched then
            return Result;
         end if;
      end loop;
      return Result;
   end Find_Access_Rule;

   --  ------------------------------
   --  Initialize the permission manager.
   --  ------------------------------
   overriding
   procedure Initialize (Manager : in out URL_Policy) is
   begin
      Manager.Cache := new Rules_Ref.Atomic_Ref;
      Manager.Cache.Set (Rules_Ref.Create);
   end Initialize;

   --  ------------------------------
   --  Finalize the permission manager.
   --  ------------------------------
   overriding
   procedure Finalize (Manager : in out URL_Policy) is
      use Ada.Strings.Unbounded;
      use Security.Controllers;

      procedure Free is
        new Ada.Unchecked_Deallocation (Rules_Ref.Atomic_Ref,
                                        Rules_Ref_Access);
      procedure Free is
        new Ada.Unchecked_Deallocation (Security.Controllers.Controller'Class,
                                        Security.Controllers.Controller_Access);
      procedure Free is
        new Ada.Unchecked_Deallocation (Controller_Access_Array,
                                        Controller_Access_Array_Access);

   begin
      Free (Manager.Cache);
--        for I in Manager.Names'Range loop
--           exit when Manager.Names (I) = null;
--           Ada.Strings.Unbounded.Free (Manager.Names (I));
--        end loop;

   end Finalize;

   type Policy_Fields is (FIELD_ID, FIELD_PERMISSION, FIELD_URL_PATTERN, FIELD_POLICY);

   procedure Set_Member (P     : in out Policy_Config;
                         Field : in Policy_Fields;
                         Value : in Util.Beans.Objects.Object);

   procedure Process (Policy : in Policy_Config);

   procedure Set_Member (P     : in out Policy_Config;
                         Field : in Policy_Fields;
                         Value : in Util.Beans.Objects.Object) is
   begin
      case Field is
         when FIELD_ID =>
            P.Id := Util.Beans.Objects.To_Integer (Value);

         when FIELD_PERMISSION =>
            P.Permissions.Append (Value);

         when FIELD_URL_PATTERN =>
            P.Patterns.Append (Value);

         when FIELD_POLICY =>
            Process (P);
            P.Id := 0;
            P.Permissions.Clear;
            P.Patterns.Clear;

      end case;
   end Set_Member;

   procedure Process (Policy : in Policy_Config) is
      Pol    : Security.Policies.URLs.Policy;
      Count  : constant Natural := Natural (Policy.Permissions.Length);
      Rule   : constant Access_Rule_Ref := Access_Rule_Refs.Create (new Access_Rule (Count));
      Iter   : Util.Beans.Objects.Vectors.Cursor := Policy.Permissions.First;
      Pos    : Positive := 1;
   begin
      Pol.Rule := Rule;

      --  Step 1: Initialize the list of permission index in Access_Rule from the permission names.
      while Util.Beans.Objects.Vectors.Has_Element (Iter) loop
         declare
            Perm : constant Util.Beans.Objects.Object := Util.Beans.Objects.Vectors.Element (Iter);
            Name : constant String := Util.Beans.Objects.To_String (Perm);
         begin
            Rule.Value.all.Permissions (Pos) := Permissions.Get_Permission_Index (Name);
            Pos := Pos + 1;

         exception
            when Invalid_Name =>
               raise Util.Serialize.Mappers.Field_Error with "Invalid permission: " & Name;
         end;
         Util.Beans.Objects.Vectors.Next (Iter);
      end loop;

      --  Step 2: Create one policy for each URL pattern
      Iter := Policy.Patterns.First;
      while Util.Beans.Objects.Vectors.Has_Element (Iter) loop
         declare
            Pattern : constant Util.Beans.Objects.Object
              := Util.Beans.Objects.Vectors.Element (Iter);
         begin
            Pol.Id   := Policy.Id;
            Pol.Pattern := GNAT.Regexp.Compile (Util.Beans.Objects.To_String (Pattern));
            Policy.Manager.Policies.Append (Pol);
         end;
         Util.Beans.Objects.Vectors.Next (Iter);
      end loop;
   end Process;

   package Policy_Mapper is
     new Util.Serialize.Mappers.Record_Mapper (Element_Type        => Policy_Config,
                                               Element_Type_Access => Policy_Config_Access,
                                               Fields              => Policy_Fields,
                                               Set_Member          => Set_Member);

   Policy_Mapping        : aliased Policy_Mapper.Mapper;

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

      Config : Policy_Config_Access := new Policy_Config;
   begin
      Reader.Add_Mapping ("policy-rules", Policy_Mapping'Access);
      Reader.Add_Mapping ("module", Policy_Mapping'Access);
      Config.Manager := Policy'Unchecked_Access;
      Policy_Mapper.Set_Context (Reader, Config);
   end Prepare_Config;

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

begin
   Policy_Mapping.Add_Mapping ("policy", FIELD_POLICY);
   Policy_Mapping.Add_Mapping ("policy/@id", FIELD_ID);
   Policy_Mapping.Add_Mapping ("policy/permission", FIELD_PERMISSION);
   Policy_Mapping.Add_Mapping ("policy/url-pattern", FIELD_URL_PATTERN);
end Security.Policies.Urls;

Implement the Finish_Config operation

Implement the Finish_Config operation


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

   use Ada.Strings.Unbounded;

   subtype Direction is Ada.Strings.Direction;

   --  Read a complete file into a string.
   --  The Max_Size parameter indicates the maximum size that is read.
   procedure Read_File (Path     : in String;
                        Into     : out Unbounded_String;
                        Max_Size : in Natural := 0);

   --  Read the file with the given path, one line at a time and execute the Process
   --  procedure with each line as argument.
   procedure Read_File (Path     : in String;
                        Process  : not null access procedure (Line : in String));

   --  Read the file with the given path, one line at a time and append each line to
   --  the Into vector.
   procedure Read_File (Path  : in String;
                        Into  : in out Util.Strings.Vectors.Vector);

   --  Save the string into a file creating the file if necessary
   procedure Write_File (Path    : in String;
                         Content : in String);

   --  Save the string into a file creating the file if necessary
   procedure Write_File (Path    : in String;
                         Content : in Unbounded_String);

   --  Iterate over the search directories defined in Path and execute
   --  Process with each directory until it returns True in Done
   --  or the last search directory is found.  Each search directory
   --  is separated by ';' (yes, even on Unix).  When Going is set to Backward, the
   --  directories are searched in reverse order.
   procedure Iterate_Path (Path     : in String;
                           Process  : not null access procedure (Dir  : in String;
                                                                 Done : out Boolean);
                           Going    : in Direction := Ada.Strings.Forward);

   --  Iterate over the search directories defined in Path and search
   --  for files matching the pattern defined by Pattern.  For each file,
   --  execute Process with the file basename and the full file path.
   --  Stop iterating when the Process procedure returns True.
   --  Each search directory is separated by ';'.  When Going is set to Backward, the
   --  directories are searched in reverse order.
   procedure Iterate_Files_Path (Pattern  : in String;
                                 Path     : in String;
                                 Process  : not null access procedure (Name : in String;
                                                                       File : in String;
                                                                       Done : out Boolean);
                                 Going    : in Direction := Ada.Strings.Forward);

   --  Find the file in one of the search directories.  Each search directory
   --  is separated by ';' (yes, even on Unix).
   --  Returns the path to be used for reading the file.
   function Find_File_Path (Name  : String;
                            Paths : String) return String;

   --  Find the files which match the pattern in the directories specified in the
   --  search path Path.  Each search directory is separated by ';'.
   --  File names are added to the string set in Into.
   procedure Find_Files_Path (Pattern : in String;
                              Path    : in String;
                              Into    : in out Util.Strings.Maps.Map);

   --  Returns the name of the external file with the specified directory
   --  and the name.  Unlike the Ada.Directories.Compose, the name can represent
   --  a relative path and thus include directory separators.
   function Compose (Directory : in String;
                     Name      : in String) return String;

   --  Compose an existing path by adding the specified name to each path component
   --  and return a new paths having only existing directories.  Each directory is
   --  separated by ';'.
   --  If the composed path exists, it is added to the result path.
   --  Example:
   --    paths = 'web;regtests'  name = 'info'
   --    result = 'web/info;regtests/info'
   --  Returns the composed path.
   function Compose_Path (Paths : in String;
                          Name  : in String) return String;

   --  Returns a relative path whose origin is defined by From and which refers
   --  to the absolute path referenced by To.  Both From and To are
   --  assumed to be absolute pathes.  Returns the absolute path To if the relative
   --  path could not be found.  Both paths must have at least one root component in common.
   function Get_Relative_Path (From : in String;
                               To   : in String) return String;

end Util.Files;

-----------------------------------------------------------------------
--  util-files -- Various File Utility Packages
--  Copyright (C) 2001, 2002, 2003, 2009, 2010, 2011, 2012, 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.Strings.Unbounded;
with Util.Strings.Maps;
with Util.Strings.Vectors;
package Util.Files is

   use Ada.Strings.Unbounded;

   subtype Direction is Ada.Strings.Direction;

   --  Read a complete file into a string.
   --  The Max_Size parameter indicates the maximum size that is read.
   procedure Read_File (Path     : in String;
                        Into     : out Unbounded_String;
                        Max_Size : in Natural := 0);

   --  Read the file with the given path, one line at a time and execute the Process
   --  procedure with each line as argument.
   procedure Read_File (Path     : in String;
                        Process  : not null access procedure (Line : in String));

   --  Read the file with the given path, one line at a time and append each line to
   --  the Into vector.
   procedure Read_File (Path  : in String;
                        Into  : in out Util.Strings.Vectors.Vector);

   --  Save the string into a file creating the file if necessary
   procedure Write_File (Path    : in String;
                         Content : in String);

   --  Save the string into a file creating the file if necessary
   procedure Write_File (Path    : in String;
                         Content : in Unbounded_String);

   --  Iterate over the search directories defined in Path and execute
   --  Process with each directory until it returns True in Done
   --  or the last search directory is found.  Each search directory
   --  is separated by ';' (yes, even on Unix).  When Going is set to Backward, the
   --  directories are searched in reverse order.
   procedure Iterate_Path (Path     : in String;
                           Process  : not null access procedure (Dir  : in String;
                                                                 Done : out Boolean);
                           Going    : in Direction := Ada.Strings.Forward);

   --  Iterate over the search directories defined in Path and search
   --  for files matching the pattern defined by Pattern.  For each file,
   --  execute Process with the file basename and the full file path.
   --  Stop iterating when the Process procedure returns True.
   --  Each search directory is separated by ';'.  When Going is set to Backward, the
   --  directories are searched in reverse order.
   procedure Iterate_Files_Path (Pattern  : in String;
                                 Path     : in String;
                                 Process  : not null access procedure (Name : in String;
                                                                       File : in String;
                                                                       Done : out Boolean);
                                 Going    : in Direction := Ada.Strings.Forward);

   --  Find the file in one of the search directories.  Each search directory
   --  is separated by ';' (yes, even on Unix).
   --  Returns the path to be used for reading the file.
   function Find_File_Path (Name  : String;
                            Paths : String) return String;

   --  Find the files which match the pattern in the directories specified in the
   --  search path Path.  Each search directory is separated by ';'.
   --  File names are added to the string set in Into.
   procedure Find_Files_Path (Pattern : in String;
                              Path    : in String;
                              Into    : in out Util.Strings.Maps.Map);

   --  Returns the name of the external file with the specified directory
   --  and the name.  Unlike the Ada.Directories.Compose, the name can represent
   --  a relative path and thus include directory separators.
   function Compose (Directory : in String;
                     Name      : in String) return String;

   --  Compose an existing path by adding the specified name to each path component
   --  and return a new paths having only existing directories.  Each directory is
   --  separated by ';'.
   --  If the composed path exists, it is added to the result path.
   --  Example:
   --    paths = 'web;regtests'  name = 'info'
   --    result = 'web/info;regtests/info'
   --  Returns the composed path.
   function Compose_Path (Paths : in String;
                          Name  : in String) return String;

   --  Returns a relative path whose origin is defined by From and which refers
   --  to the absolute path referenced by To.  Both From and To are
   --  assumed to be absolute pathes.  Returns the absolute path To if the relative
   --  path could not be found.  Both paths must have at least one root component in common.
   function Get_Relative_Path (From : in String;
                               To   : in String) return String;

   --  Rename the old name into a new name.
   procedure Rename (Old_Name, New_Name : in String);

end Util.Files;

Declare new procedure Rename to rename a file using rename(2)


-----------------------------------------------------------------------
--  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.Unchecked_Deallocation;

with Util.Log.Loggers;

with Security.Controllers;
with Security.Contexts;

package body Security.Policies is

   use type Permissions.Permission_Index;

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

   procedure Free is
     new Ada.Unchecked_Deallocation (Security.Controllers.Controller'Class,
                                     Security.Controllers.Controller_Access);

   --  ------------------------------
   --  Get the policy index.
   --  ------------------------------
   function Get_Policy_Index (From : in Policy'Class) return Policy_Index is
   begin
      return From.Index;
   end Get_Policy_Index;

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

   --  ------------------------------
   --  Get the policy with the name Name registered in the policy manager.
   --  Returns null if there is no such policy.
   --  ------------------------------
   function Get_Policy (Manager : in Policy_Manager;
                        Name    : in String) return Policy_Access is
   begin
      for I in Manager.Policies'Range loop
         if Manager.Policies (I) = null then
            return null;
         elsif Manager.Policies (I).Get_Name = Name then
            return Manager.Policies (I);
         end if;
      end loop;
      return null;
   end Get_Policy;

   --  ------------------------------
   --  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;
            Policy.Index   := I;
            return;
         end if;
      end loop;
      Log.Error ("Policy table is full, increase policy manager table to {0} to add policy {1}",
                 Policy_Index'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
      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;

      --  If the permission has a controller, release it.
      if Manager.Permissions (Index) /= null then
         Log.Warn ("Permission {0} is redefined", Name);

         --  SCz 2011-12-03: GNAT 2011 reports a compilation error:
         --  'missing "with" clause on package "Security.Controllers"'
         --  if we use the 'Security.Controller_Access' type, even if this "with"
         --  clause exist.
         --  gcc 4.4.3 under Ubuntu does not have this issue.
         --  We use the 'Security.Controllers.Controller_Access' type to avoid the compiler
         --  bug but we have to use a temporary variable and do some type conversion...
         declare
            P : Security.Controllers.Controller_Access := Manager.Permissions (Index).all'Access;
         begin
            Free (P);
         end;
      end if;

      Manager.Permissions (Index) := Permission;
   end Add_Permission;

   --  ------------------------------
   --  Checks whether the permission defined by the Permission is granted
   --  for the security context passed in Context.
   --  Returns true if such permission is granted.
   --  ------------------------------
   function Has_Permission (Manager    : in Policy_Manager;
                            Context    : in Security.Contexts.Security_Context'Class;
                            Permission : in Security.Permissions.Permission'Class)
                            return Boolean is
   begin
      if Permission.Id >= Manager.Last_Index then
         return False;
      end if;
      declare
         C : constant Controller_Access := Manager.Permissions (Permission.Id);
      begin
         if C = null then
            return False;
         else
            return C.Has_Permission (Context, Permission);
         end if;
      end;
   end Has_Permission;

   --  ------------------------------
   --  Returns True if the security controller is defined for the given permission index.
   --  ------------------------------
   function Has_Controller (Manager : in Policy_Manager;
                            Index   : in Permissions.Permission_Index) return Boolean is
   begin
      return Index < Manager.Last_Index and then Manager.Permissions (Index) /= null;
   end Has_Controller;

   --  ------------------------------
   --  Create the policy contexts to be associated with the security context.
   --  ------------------------------
   function Create_Policy_Contexts (Manager : in Policy_Manager)
                                    return Policy_Context_Array_Access is
   begin
      return new Policy_Context_Array (1 .. Manager.Max_Policies);
   end Create_Policy_Contexts;

   --  ------------------------------
   --  Prepare the XML parser to read the policy configuration.
   --  ------------------------------
   procedure Prepare_Config (Manager : in out Policy_Manager;
                             Reader  : in out Util.Serialize.IO.XML.Parser) is
   begin
      --  Prepare the reader to parse the policy configuration.
      for I in Manager.Policies'Range loop
         exit when Manager.Policies (I) = null;
         Manager.Policies (I).Prepare_Config (Reader);
      end loop;
   end Prepare_Config;

   --  ------------------------------
   --  Finish reading the XML policy configuration.  The security policy implementation can use
   --  this procedure to perform any configuration setup after the configuration is parsed.
   --  ------------------------------
   procedure Finish_Config (Manager : in out Policy_Manager;
                            Reader  : in out Util.Serialize.IO.XML.Parser) is
   begin
      --  Finish the policy configuration.
      for I in Manager.Policies'Range loop
         exit when Manager.Policies (I) = null;
         Manager.Policies (I).Finish_Config (Reader);
      end loop;
   end Finish_Config;

   --  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);
      pragma Warnings (Off, Policy_Config);
   begin
      Log.Info ("Reading policy file {0}", File);

      Manager.Prepare_Config (Reader);

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

      Manager.Finish_Config (Reader);
   end Read_Policy;

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

   --  ------------------------------
   --  Finalize the policy manager.
   --  ------------------------------
   overriding
   procedure Finalize (Manager : in out Policy_Manager) is
      procedure Free is
        new Ada.Unchecked_Deallocation (Controller_Access_Array,
                                        Controller_Access_Array_Access);
      procedure Free is
        new Ada.Unchecked_Deallocation (Policy'Class,
                                        Policy_Access);

   begin
      --  Release the security controllers.
      if Manager.Permissions /= null then
         for I in Manager.Permissions.all'Range loop
            if Manager.Permissions (I) /= null then
               --  SCz 2011-12-03: GNAT 2011 reports a compilation error:
               --  'missing "with" clause on package "Security.Controllers"'
               --  if we use the 'Security.Controller_Access' type, even if this "with"
               --  clause exist.
               --  gcc 4.4.3 under Ubuntu does not have this issue.
               --  We use the 'Security.Controllers.Controller_Access' type to avoid the compiler
               --  bug but we have to use a temporary variable and do some type conversion...
               declare
                  P : Security.Controllers.Controller_Access := Manager.Permissions (I).all'Access;
               begin
                  Free (P);
                  Manager.Permissions (I) := null;
               end;
            end if;
         end loop;
         Free (Manager.Permissions);
      end if;

      --  Release the policy instances.
      for I in Manager.Policies'Range loop
         exit when Manager.Policies (I) = null;
         Free (Manager.Policies (I));
      end loop;

   end Finalize;

end Security.Policies;

-----------------------------------------------------------------------
--  security-policies -- Security Policies
--  Copyright (C) 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 Ada.Unchecked_Deallocation;

with Util.Log.Loggers;
with Util.Serialize.Mappers;
with Util.Serialize.Mappers.Record_Mapper;

with Security.Controllers;
with Security.Contexts;

package body Security.Policies is

   use type Permissions.Permission_Index;

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

   procedure Free is
     new Ada.Unchecked_Deallocation (Security.Controllers.Controller'Class,
                                     Security.Controllers.Controller_Access);

   --  ------------------------------
   --  Default Security Controllers
   --  ------------------------------
   --  The Auth_Controller grants the permission if there is a principal.
   type Auth_Controller is limited new Security.Controllers.Controller with null record;

   --  Returns true if the user associated with the security context Context was
   --  authentified (ie, it has a principal).
   overriding
   function Has_Permission (Handler    : in Auth_Controller;
                            Context    : in Security.Contexts.Security_Context'Class;
                            Permission : in Security.Permissions.Permission'Class)
                            return Boolean;

   --  The Pass_Through_Controller grants access to anybody.
   type Pass_Through_Controller is limited new Security.Controllers.Controller with null record;

   --  Returns true if the user associated with the security context Context has
   --  the permission to access the URL defined in Permission.
   overriding
   function Has_Permission (Handler    : in Pass_Through_Controller;
                            Context    : in Security.Contexts.Security_Context'Class;
                            Permission : in Security.Permissions.Permission'Class)
                            return Boolean;

   --  ------------------------------
   --  Returns true if the user associated with the security context Context was
   --  authentified (ie, it has a principal).
   --  ------------------------------
   overriding
   function Has_Permission (Handler    : in Auth_Controller;
                            Context    : in Security.Contexts.Security_Context'Class;
                            Permission : in Security.Permissions.Permission'Class)
                            return Boolean is
      pragma Unreferenced (Handler, Permission);
      use type Security.Principal_Access;

      P : constant Security.Principal_Access := Context.Get_User_Principal;
   begin
      if P /= null then
         Log.Debug ("Grant permission because a principal exists");
         return True;
      else
         return False;
      end if;
   end Has_Permission;

   --  ------------------------------
   --  Returns true if the user associated with the security context Context has
   --  the permission to access the URL defined in Permission.
   --  ------------------------------
   overriding
   function Has_Permission (Handler    : in Pass_Through_Controller;
                            Context    : in Security.Contexts.Security_Context'Class;
                            Permission : in Security.Permissions.Permission'Class)
                            return Boolean is
      pragma Unreferenced (Handler, Context, Permission);
   begin
      Log.Debug ("Pass through controller grants the permission");
      return True;
   end Has_Permission;

   --  ------------------------------
   --  Get the policy index.
   --  ------------------------------
   function Get_Policy_Index (From : in Policy'Class) return Policy_Index is
   begin
      return From.Index;
   end Get_Policy_Index;

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

   --  ------------------------------
   --  Get the policy with the name Name registered in the policy manager.
   --  Returns null if there is no such policy.
   --  ------------------------------
   function Get_Policy (Manager : in Policy_Manager;
                        Name    : in String) return Policy_Access is
   begin
      for I in Manager.Policies'Range loop
         if Manager.Policies (I) = null then
            return null;
         elsif Manager.Policies (I).Get_Name = Name then
            return Manager.Policies (I);
         end if;
      end loop;
      return null;
   end Get_Policy;

   --  ------------------------------
   --  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;
            Policy.Index   := I;
            return;
         end if;
      end loop;
      Log.Error ("Policy table is full, increase policy manager table to {0} to add policy {1}",
                 Policy_Index'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
      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;

      --  If the permission has a controller, release it.
      if Manager.Permissions (Index) /= null then
         Log.Warn ("Permission {0} is redefined", Name);

         --  SCz 2011-12-03: GNAT 2011 reports a compilation error:
         --  'missing "with" clause on package "Security.Controllers"'
         --  if we use the 'Security.Controller_Access' type, even if this "with"
         --  clause exist.
         --  gcc 4.4.3 under Ubuntu does not have this issue.
         --  We use the 'Security.Controllers.Controller_Access' type to avoid the compiler
         --  bug but we have to use a temporary variable and do some type conversion...
         declare
            P : Security.Controllers.Controller_Access := Manager.Permissions (Index).all'Access;
         begin
            Free (P);
         end;
      end if;

      Manager.Permissions (Index) := Permission;
   end Add_Permission;

   --  ------------------------------
   --  Checks whether the permission defined by the Permission is granted
   --  for the security context passed in Context.
   --  Returns true if such permission is granted.
   --  ------------------------------
   function Has_Permission (Manager    : in Policy_Manager;
                            Context    : in Security.Contexts.Security_Context'Class;
                            Permission : in Security.Permissions.Permission'Class)
                            return Boolean is
   begin
      if Permission.Id >= Manager.Last_Index then
         return False;
      end if;
      declare
         C : constant Controller_Access := Manager.Permissions (Permission.Id);
      begin
         if C = null then
            return False;
         else
            return C.Has_Permission (Context, Permission);
         end if;
      end;
   end Has_Permission;

   --  ------------------------------
   --  Returns True if the security controller is defined for the given permission index.
   --  ------------------------------
   function Has_Controller (Manager : in Policy_Manager;
                            Index   : in Permissions.Permission_Index) return Boolean is
   begin
      return Index < Manager.Last_Index and then Manager.Permissions (Index) /= null;
   end Has_Controller;

   --  ------------------------------
   --  Create the policy contexts to be associated with the security context.
   --  ------------------------------
   function Create_Policy_Contexts (Manager : in Policy_Manager)
                                    return Policy_Context_Array_Access is
   begin
      return new Policy_Context_Array (1 .. Manager.Max_Policies);
   end Create_Policy_Contexts;

   --  ------------------------------
   --  Prepare the XML parser to read the policy configuration.
   --  ------------------------------
   procedure Prepare_Config (Manager : in out Policy_Manager;
                             Reader  : in out Util.Serialize.IO.XML.Parser) is
   begin
      --  Prepare the reader to parse the policy configuration.
      for I in Manager.Policies'Range loop
         exit when Manager.Policies (I) = null;
         Manager.Policies (I).Prepare_Config (Reader);
      end loop;
   end Prepare_Config;

   --  ------------------------------
   --  Finish reading the XML policy configuration.  The security policy implementation can use
   --  this procedure to perform any configuration setup after the configuration is parsed.
   --  ------------------------------
   procedure Finish_Config (Manager : in out Policy_Manager;
                            Reader  : in out Util.Serialize.IO.XML.Parser) is
   begin
      --  Finish the policy configuration.
      for I in Manager.Policies'Range loop
         exit when Manager.Policies (I) = null;
         Manager.Policies (I).Finish_Config (Reader);
      end loop;
   end Finish_Config;

   type Policy_Fields is (FIELD_ALL_PERMISSION, FIELD_AUTH_PERMISSION);

   procedure Set_Member (P     : in out Policy_Manager'Class;
                         Field : in Policy_Fields;
                         Value : in Util.Beans.Objects.Object);

   procedure Set_Member (P     : in out Policy_Manager'Class;
                         Field : in Policy_Fields;
                         Value : in Util.Beans.Objects.Object) is
      Name : constant String := Util.Beans.Objects.To_String (Value);
   begin
      case Field is
         when FIELD_ALL_PERMISSION =>
            P.Add_Permission (Name, new Pass_Through_Controller);

         when FIELD_AUTH_PERMISSION =>
            P.Add_Permission (Name, new Auth_Controller);

      end case;
   end Set_Member;

   package Policy_Mapper is
     new Util.Serialize.Mappers.Record_Mapper (Element_Type        => Policy_Manager'Class,
                                               Element_Type_Access => Policy_Manager_Access,
                                               Fields              => Policy_Fields,
                                               Set_Member          => Set_Member);

   Policy_Mapping        : aliased Policy_Mapper.Mapper;

   --  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);
      pragma Warnings (Off, Policy_Config);
   begin
      Log.Info ("Reading policy file {0}", File);

      Reader.Add_Mapping ("policy-rules", Policy_Mapping'Access);
      Policy_Mapper.Set_Context (Reader, Manager'Unchecked_Access);
      Manager.Prepare_Config (Reader);

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

      Manager.Finish_Config (Reader);
   end Read_Policy;

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

   --  ------------------------------
   --  Finalize the policy manager.
   --  ------------------------------
   overriding
   procedure Finalize (Manager : in out Policy_Manager) is
      procedure Free is
        new Ada.Unchecked_Deallocation (Controller_Access_Array,
                                        Controller_Access_Array_Access);
      procedure Free is
        new Ada.Unchecked_Deallocation (Policy'Class,
                                        Policy_Access);

   begin
      --  Release the security controllers.
      if Manager.Permissions /= null then
         for I in Manager.Permissions.all'Range loop
            if Manager.Permissions (I) /= null then
               --  SCz 2011-12-03: GNAT 2011 reports a compilation error:
               --  'missing "with" clause on package "Security.Controllers"'
               --  if we use the 'Security.Controller_Access' type, even if this "with"
               --  clause exist.
               --  gcc 4.4.3 under Ubuntu does not have this issue.
               --  We use the 'Security.Controllers.Controller_Access' type to avoid the compiler
               --  bug but we have to use a temporary variable and do some type conversion...
               declare
                  P : Security.Controllers.Controller_Access := Manager.Permissions (I).all'Access;
               begin
                  Free (P);
                  Manager.Permissions (I) := null;
               end;
            end if;
         end loop;
         Free (Manager.Permissions);
      end if;

      --  Release the policy instances.
      for I in Manager.Policies'Range loop
         exit when Manager.Policies (I) = null;
         Free (Manager.Policies (I));
      end loop;

   end Finalize;

begin
   Policy_Mapping.Add_Mapping ("all-permission/name", FIELD_ALL_PERMISSION);
   Policy_Mapping.Add_Mapping ("auth-permission/name", FIELD_AUTH_PERMISSION);
end Security.Policies;

Add two default security controllers that can be installed to - grant the permission if the security context has a user principal - always grant the permission


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

   pragma Preelaborate;

   --  Parse a textile wiki heading in the form 'h<N>.'.
   --  Example:
   --    h1. Level 1
   --    h2. Level 2
   procedure Parse_Header (P     : in out Parser;
                           Token : in Wiki.Strings.WChar);

   --  Parse a textile image.
   --  Example:
   --    !image-link!
   --    !image-link(title)!
   --    !image-path|:http-link
   procedure Parse_Image (P     : in out Parser;
                          Token : in Wiki.Strings.WChar);

   --  Parse an external link:
   --  Example:
   --    "title":http-link
   procedure Parse_Link (P     : in out Parser;
                         Token : in Wiki.Strings.WChar);

   --  Parse an italic or bold sequence or a list.
   --  Example:
   --    *name*         (italic)
   --    **name**       (bold)
   --    * item         (list)
   procedure Parse_Bold_Or_List (P     : in out Parser;
                                 Token : in Wiki.Strings.WChar);

   --  Parse a markdown table/column.
   --  Example:
   --    | col1 | col2 | ... | colN |
   procedure Parse_Table (P     : in out Parser;
                          Token : in Wiki.Strings.WChar);

   procedure Parse_Deleted_Or_Horizontal_Rule (P     : in out Parser;
                                               Token : in Wiki.Strings.WChar);

   Wiki_Table : aliased constant Parser_Table
     := (
         16#0A# => Parse_End_Line'Access,
         16#0D# => Parse_End_Line'Access,
         Character'Pos (' ') => Parse_Space'Access,
         Character'Pos ('[') => Common.Parse_Link'Access,
         Character'Pos ('#') => Common.Parse_List'Access,
         Character'Pos ('*') => Parse_Bold_Or_List'Access,
         Character'Pos ('<') => Parse_Maybe_Html'Access,
         Character'Pos ('&') => Html.Parse_Entity'Access,
         Character'Pos ('-') => Parse_Deleted_Or_Horizontal_Rule'Access,
         Character'Pos ('!') => Parse_Image'Access,
         Character'Pos ('"') => Parse_Link'Access,
         Character'Pos ('@') => Common.Parse_Single_Code'Access,
         Character'Pos ('_') => Common.Parse_Single_Italic'Access,
         Character'Pos ('|') => Parse_Table'Access,
         Character'Pos ('h') => Parse_Header'Access,
         others => Parse_Text'Access
        );

end Wiki.Parsers.Textile;

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

   pragma Preelaborate;

   --  Parse a textile wiki heading in the form 'h<N>.'.
   --  Example:
   --    h1. Level 1
   --    h2. Level 2
   procedure Parse_Header (P     : in out Parser;
                           Token : in Wiki.Strings.WChar);

   --  Parse a textile image.
   --  Example:
   --    !image-link!
   --    !image-link(title)!
   --    !image-path!:http-link
   procedure Parse_Image (P     : in out Parser;
                          Token : in Wiki.Strings.WChar);

   --  Parse an external link:
   --  Example:
   --    "title":http-link
   procedure Parse_Link (P     : in out Parser;
                         Token : in Wiki.Strings.WChar);

   --  Parse a bold sequence or a list.
   --  Example:
   --    *name*         (bold)
   --    * item         (list)
   procedure Parse_Bold_Or_List (P     : in out Parser;
                                 Token : in Wiki.Strings.WChar);

   --  Parse a markdown table/column.
   --  Example:
   --    | col1 | col2 | ... | colN |
   procedure Parse_Table (P     : in out Parser;
                          Token : in Wiki.Strings.WChar);

   procedure Parse_Deleted_Or_Horizontal_Rule (P     : in out Parser;
                                               Token : in Wiki.Strings.WChar);

   Wiki_Table : aliased constant Parser_Table
     := (
         16#0A# => Parse_End_Line'Access,
         16#0D# => Parse_End_Line'Access,
         Character'Pos (' ') => Parse_Space'Access,
         Character'Pos ('[') => Common.Parse_Link'Access,
         Character'Pos ('#') => Common.Parse_List'Access,
         Character'Pos ('*') => Parse_Bold_Or_List'Access,
         Character'Pos ('<') => Parse_Maybe_Html'Access,
         Character'Pos ('&') => Html.Parse_Entity'Access,
         Character'Pos ('-') => Parse_Deleted_Or_Horizontal_Rule'Access,
         Character'Pos ('!') => Parse_Image'Access,
         Character'Pos ('"') => Parse_Link'Access,
         Character'Pos ('@') => Common.Parse_Single_Code'Access,
         Character'Pos ('_') => Common.Parse_Single_Italic'Access,
         Character'Pos ('|') => Parse_Table'Access,
         Character'Pos ('h') => Parse_Header'Access,
         others => Parse_Text'Access
        );

end Wiki.Parsers.Textile;

Update the comments

Update the comments