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

with Util.Log.Loggers;
with Util.Test_Caller;
with Util.Files;
with Util.Streams.Pipes;
with Util.Streams.Buffered;
with Util.Streams.Texts;
with Util.Systems.Os;
package body Util.Processes.Tests is

   use Util.Log;

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

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Processes.Is_Running",
                       Test_No_Process'Access);
      Caller.Add_Test (Suite, "Test Util.Processes.Spawn/Wait/Get_Exit_Status",
                       Test_Spawn'Access);
      Caller.Add_Test (Suite, "Test Util.Processes.Spawn(READ pipe)",
                       Test_Output_Pipe'Access);
      Caller.Add_Test (Suite, "Test Util.Processes.Spawn(WRITE pipe)",
                       Test_Input_Pipe'Access);
      Caller.Add_Test (Suite, "Test Util.Processes.Spawn/Shell(WRITE pipe)",
                       Test_Shell_Splitting_Pipe'Access);

      pragma Warnings (Off);
      if Util.Systems.Os.Directory_Separator /= '\' then
         Caller.Add_Test (Suite, "Test Util.Processes.Spawn(OUTPUT redirect)",
                          Test_Output_Redirect'Access);
      end if;
      pragma Warnings (On);

      Caller.Add_Test (Suite, "Test Util.Streams.Pipes.Open/Read/Close (Multi spawn)",
                       Test_Multi_Spawn'Access);

   end Add_Tests;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

   end Test_Output_Redirect;

end Util.Processes.Tests;

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

with Util.Log.Loggers;
with Util.Test_Caller;
with Util.Files;
with Util.Streams.Pipes;
with Util.Streams.Buffered;
with Util.Streams.Texts;
with Util.Systems.Os;
package body Util.Processes.Tests is

   use Util.Log;

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

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Processes.Is_Running",
                       Test_No_Process'Access);
      Caller.Add_Test (Suite, "Test Util.Processes.Spawn/Wait/Get_Exit_Status",
                       Test_Spawn'Access);
      Caller.Add_Test (Suite, "Test Util.Processes.Spawn(READ pipe)",
                       Test_Output_Pipe'Access);
      Caller.Add_Test (Suite, "Test Util.Processes.Spawn(WRITE pipe)",
                       Test_Input_Pipe'Access);
      Caller.Add_Test (Suite, "Test Util.Processes.Spawn/Shell(WRITE pipe)",
                       Test_Shell_Splitting_Pipe'Access);

      pragma Warnings (Off);
      if Util.Systems.Os.Directory_Separator /= '\' then
         Caller.Add_Test (Suite, "Test Util.Processes.Spawn(OUTPUT redirect)",
                          Test_Output_Redirect'Access);
      end if;
      pragma Warnings (On);

      Caller.Add_Test (Suite, "Test Util.Streams.Pipes.Open/Read/Close (Multi spawn)",
                       Test_Multi_Spawn'Access);

   end Add_Tests;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

   end Test_Output_Redirect;

end Util.Processes.Tests;

Use the Input_Buffer_Stream instead of Buffered_Stream


--  This file is covered by the Internet Software Consortium (ISC) License
--  Reference: ../License.txt

with File_Operations;
with PortScan.Log;
with Parameters;
with Unix;
with Ada.Characters.Latin_1;
with Ada.Directories;
with Ada.Exceptions;

package body PortScan.Tests is

   package FOP renames File_Operations;
   package LOG renames PortScan.Log;
   package PM  renames Parameters;
   package LAT renames Ada.Characters.Latin_1;
   package DIR renames Ada.Directories;
   package EX  renames Ada.Exceptions;

   --------------------------------------------------------------------------------------------
   --  exec_phase_check_plist
   --------------------------------------------------------------------------------------------
   function exec_check_plist
     (specification : PSP.Portspecs;
      log_handle    : TIO.File_Type;
      phase_name    : String;
      seq_id        : port_id;
      rootdir       : String) return Boolean
   is
      passed_check : Boolean := True;
      namebase     : constant String := specification.get_namebase;
      directory_list : entry_crate.Map;
      dossier_list   : entry_crate.Map;
   begin
      LOG.log_phase_begin (log_handle, phase_name);
      TIO.Put_Line (log_handle, "====> Checking for package manifest issues");

      if not ingest_manifests (specification  => specification,
                               log_handle     => log_handle,
                               directory_list => directory_list,
                               dossier_list   => dossier_list,
                               seq_id         => seq_id,
                               namebase       => namebase,
                               rootdir        => rootdir)
      then
         passed_check := False;
      end if;

      if orphaned_directories_detected (log_handle     => log_handle,
                                        directory_list => directory_list,
                                        namebase       => namebase,
                                        rootdir        => rootdir)
      then
         passed_check := False;
      end if;

      if missing_directories_detected (log_handle, directory_list) then
         passed_check := False;
      end if;

      if orphaned_files_detected (log_handle, dossier_list, namebase, rootdir) then
         passed_check := False;
      end if;

      if missing_files_detected (log_handle, dossier_list) then
         passed_check := False;
      end if;

      if passed_check then
         TIO.Put_Line (log_handle, "====> No manifest issues found");
      end if;

      LOG.log_phase_end (log_handle);
      return passed_check;
   end exec_check_plist;

   --------------------------------------------------------------------------------------------
   --  ingest_manifests
   --------------------------------------------------------------------------------------------
   function ingest_manifests
     (specification  : PSP.Portspecs;
      log_handle     : TIO.File_Type;
      directory_list : in out entry_crate.Map;
      dossier_list   : in out entry_crate.Map;
      seq_id         : port_id;
      namebase       : String;
      rootdir        : String) return Boolean
   is
      procedure eat_plist (position : subpackage_crate.Cursor);
      procedure insert_directory (directory : String; subpackage : HT.Text);

      result   : Boolean := True;

      procedure insert_directory (directory : String; subpackage : HT.Text)
      is
         numsep : Natural := HT.count_char (directory, LAT.Solidus);
         canvas : HT.Text := HT.SUS (directory);
      begin
         for x in 1 .. numsep + 1 loop
            declare
               paint      : String := HT.USS (canvas);
               my_new_rec : entry_record := (subpackage, False);
            begin
               if paint /= "" then
                  if not directory_list.Contains (canvas) then
                     directory_list.Insert (canvas, my_new_rec);
                  end if;
                  canvas := HT.SUS (HT.head (paint, "/"));
               end if;
            end;
         end loop;
      end insert_directory;

      procedure eat_plist (position : subpackage_crate.Cursor)
      is
         subpackage    : HT.Text := subpackage_crate.Element (position).subpackage;
         manifest_file : String := "/construction/" & namebase & "/.manifest." &
                         HT.USS (subpackage) & ".mktmp";
         contents      : String := FOP.get_file_contents (rootdir & manifest_file);
         identifier    : constant String := HT.USS (subpackage) & " manifest: ";

         markers : HT.Line_Markers;
      begin
         HT.initialize_markers (contents, markers);
         loop
            exit when not HT.next_line_present (contents, markers);
            declare
               line      : constant String := HT.extract_line (contents, markers);
               line_text : HT.Text := HT.SUS (line);
               new_rec   : entry_record := (subpackage, False);
            begin
               if HT.leads (line, "@comment ") then
                  null;
               elsif HT.leads (line, "@dir ") then
                  declare
                     dir      : String := line (line'First + 5 .. line'Last);
                     dir_text : HT.Text := HT.SUS (dir);
                  begin
                     if directory_list.Contains (dir_text) then
                        result := False;
                        declare
                           spkg : String := HT.USS (dossier_list.Element (line_text).subpackage);
                        begin
                           if spkg /= "" then
                              TIO.Put_Line
                                (log_handle,
                                 "Redundant @dir symbol, " & identifier & dir &
                                   " will already be created by the " & spkg & " manifest");
                           else
                              TIO.Put_Line
                                (log_handle,
                                 "Redundant @dir symbol, " & identifier & dir &
                                   " will already be created by another manifest");
                           end if;
                        end;
                     else
                        insert_directory (dir, subpackage);
                     end if;
                  end;
               else
                  declare
                     modline : String  := modify_file_if_necessary (line);
                     ml_text : HT.Text := HT.SUS (modline);
                  begin
                     if dossier_list.Contains (ml_text) then
                        result := False;
                        declare
                           spkg : String := HT.USS (dossier_list.Element (ml_text).subpackage);
                        begin
                           TIO.Put_Line
                             (log_handle,
                              "Duplicate file entry, " & identifier & modline &
                                " already present in " & spkg & " manifest");
                        end;
                     else
                        dossier_list.Insert (ml_text, new_rec);
                        declare
                           plistdir : String := DIR.Containing_Directory (modline);
                        begin
                           insert_directory (plistdir, subpackage);
                        end;
                     end if;
                  end;
               end if;
            end;
         end loop;
      exception
         when issue : others =>
            TIO.Put_Line (log_handle, "check-plist error: " & EX.Exception_Message (issue));
      end eat_plist;
   begin
      all_ports (seq_id).subpackages.Iterate (eat_plist'Access);
      return result;
   end ingest_manifests;

   --------------------------------------------------------------------------------------------
   --  directory_excluded
   --------------------------------------------------------------------------------------------
   function directory_excluded (candidate : String) return Boolean
   is
      --  mandatory candidate has ${STAGEDIR}/ stripped (no leading slash)
      rawlbase  : constant String  := HT.USS (PM.configuration.dir_localbase);
      localbase : constant String  := rawlbase (rawlbase'First + 1 .. rawlbase'Last);
      lblen     : constant Natural := localbase'Length;
   begin
      if candidate = localbase then
         return True;
      end if;
      if not HT.leads (candidate, localbase & "/") then
         --  This should never happen
         return False;
      end if;

      declare
         shortcan : String := candidate (candidate'First + lblen + 1 .. candidate'Last);
      begin
         if shortcan = "bin" or else
           shortcan = "etc" or else
           shortcan = "etc/rc.d" or else
           shortcan = "include" or else
           shortcan = "lib" or else
           shortcan = "lib/pkgconfig" or else
           shortcan = "libdata" or else
           shortcan = "libexec" or else
           shortcan = "sbin" or else
           shortcan = "share" or else
           shortcan = "www"
         then
            return True;
         end if;
         if not HT.leads (shortcan, "share/") then
            return False;
         end if;
      end;

      declare
         shortcan : String := candidate (candidate'First + lblen + 7 .. candidate'Last);
      begin
         if shortcan = "doc" or else
           shortcan = "examples" or else
           shortcan = "info" or else
           shortcan = "locale" or else
           shortcan = "man" or else
           shortcan = "nls"
         then
            return True;
         end if;
         if shortcan'Length /= 8 or else
           not HT.leads (shortcan, "man/man")
         then
            return False;
         end if;
         case shortcan (shortcan'Last) is
            when '1' .. '9' | 'l' | 'n' => return True;
            when others => return False;
         end case;
      end;
   end directory_excluded;

   --------------------------------------------------------------------------------------------
   --  orphaned_directories_detected
   --------------------------------------------------------------------------------------------
   function orphaned_directories_detected
     (log_handle     : TIO.File_Type;
      directory_list : in out entry_crate.Map;
      namebase       : String;
      rootdir        : String) return Boolean
   is
      rawlbase  : constant String  := HT.USS (PM.configuration.dir_localbase);
      localbase : constant String  := rawlbase (rawlbase'First + 1 .. rawlbase'Last);
      stagedir  : String := rootdir & "/construction/" & namebase & "/stage";
      command   : String := rootdir & "/usr/bin/find " & stagedir & " -type d -printf " &
                  LAT.Quotation & "%P\n" & LAT.Quotation;
      status    : Integer;
      comres    : String := HT.USS (Unix.piped_command (command, status));
      markers   : HT.Line_Markers;
      lblen     : constant Natural := localbase'Length;
      result    : Boolean := False;
      errprefix : constant String := "Orphaned directory detected: ";
   begin
      if status /= 0 then
         TIO.Put_Line ("orphaned_directories_detected: command error: " & comres);
         return True;
      end if;
      HT.initialize_markers (comres, markers);
      loop
         exit when not HT.next_line_present (comres, markers);
         declare
            line      : constant String := HT.extract_line (comres, markers);
            line_text : HT.Text := HT.SUS (line);
         begin
            if line /= "" then
               if HT.leads (line, localbase) then
                  declare
                     plist_dir : HT.Text := HT.SUS (line (line'First + lblen + 1 .. line'Last));
                  begin
                     if directory_list.Contains (plist_dir) then
                        directory_list.Update_Element (Position => directory_list.Find (plist_dir),
                                                       Process  => mark_verified'Access);
                     else
                        if not directory_excluded (line) then
                           TIO.Put_Line (log_handle, errprefix & line);
                           result := True;
                        end if;
                     end if;
                  end;
               else
                  if directory_list.Contains (line_text) then
                     directory_list.Update_Element (Position => directory_list.Find (line_text),
                                                    Process  => mark_verified'Access);
                  else
                     TIO.Put_Line (log_handle, errprefix & line);
                     result := True;
                  end if;
               end if;
            end if;
         end;
      end loop;
      return result;
   end orphaned_directories_detected;

   --------------------------------------------------------------------------------------------
   --  mark_verified
   --------------------------------------------------------------------------------------------
   procedure mark_verified (key : HT.Text; Element : in out entry_record) is
   begin
      Element.verified := True;
   end mark_verified;

   --------------------------------------------------------------------------------------------
   --  missing_directories_detected
   --------------------------------------------------------------------------------------------
   function missing_directories_detected
     (log_handle     : TIO.File_Type;
      directory_list : in out entry_crate.Map) return Boolean
   is
      procedure check (position : entry_crate.Cursor);

      result : Boolean := False;

      procedure check (position : entry_crate.Cursor)
      is
         rec       : entry_record renames entry_crate.Element (position);
         plist_dir : String := HT.USS (entry_crate.Key (position));
      begin
         if not rec.verified then
            TIO.Put_Line
              (log_handle,
               "Directory " & plist_dir & " listed on " & HT.USS (rec.subpackage) &
                 " manifest is not present in the stage directory.");
            result := True;
         end if;
      end check;
   begin
      directory_list.Iterate (check'Access);
      return result;
   end missing_directories_detected;

   --------------------------------------------------------------------------------------------
   --  missing_files_detected
   --------------------------------------------------------------------------------------------
   function missing_files_detected
     (log_handle   : TIO.File_Type;
      dossier_list : in out entry_crate.Map) return Boolean
   is
      procedure check (position : entry_crate.Cursor);

      result : Boolean := False;

      procedure check (position : entry_crate.Cursor)
      is
         rec        : entry_record renames entry_crate.Element (position);
         plist_file : String := HT.USS (entry_crate.Key (position));
      begin
         if not rec.verified then
            TIO.Put_Line
              (log_handle,
               "File " & plist_file & " listed on " & HT.USS (rec.subpackage) &
                 " manifest is not present in the stage directory.");
            result := True;
         end if;
      end check;
   begin
      dossier_list.Iterate (check'Access);
      return result;
   end missing_files_detected;

   --------------------------------------------------------------------------------------------
   --  orphaned_files_detected
   --------------------------------------------------------------------------------------------
   function orphaned_files_detected
     (log_handle     : TIO.File_Type;
      dossier_list   : in out entry_crate.Map;
      namebase       : String;
      rootdir        : String) return Boolean
   is
      rawlbase  : constant String  := HT.USS (PM.configuration.dir_localbase);
      localbase : constant String  := rawlbase (rawlbase'First + 1 .. rawlbase'Last);
      stagedir  : String := rootdir & "/construction/" & namebase & "/stage";
      command   : String := rootdir & "/usr/bin/find " & stagedir &
                  " \( -type f -o -type l \) -printf " &
                  LAT.Quotation & "%P\n" & LAT.Quotation;
      status    : Integer;
      comres    : String := HT.USS (Unix.piped_command (command, status));
      markers   : HT.Line_Markers;
      lblen     : constant Natural := localbase'Length;
      result    : Boolean := False;
      errprefix : constant String := "Orphaned file detected: ";
   begin
      if status /= 0 then
         TIO.Put_Line ("orphaned_files_detected: command error: " & comres);
         return True;
      end if;
      HT.initialize_markers (comres, markers);
      loop
         exit when not HT.next_line_present (comres, markers);
         declare
            line      : constant String := HT.extract_line (comres, markers);
            line_text : HT.Text := HT.SUS (line);
         begin
            if line /= "" then
               if HT.leads (line, localbase) then
                  declare
                     plist_file : HT.Text := HT.SUS (line (line'First + lblen + 1 .. line'Last));
                  begin
                     if dossier_list.Contains (plist_file) then
                        dossier_list.Update_Element (Position => dossier_list.Find (plist_file),
                                                     Process  => mark_verified'Access);
                     else
                        TIO.Put_Line (log_handle, errprefix & line);
                        result := True;
                     end if;
                  end;
               else
                  if dossier_list.Contains (line_text) then
                     dossier_list.Update_Element (Position => dossier_list.Find (line_text),
                                                  Process  => mark_verified'Access);
                  else
                     TIO.Put_Line (log_handle, errprefix & line);
                     result := True;
                  end if;
               end if;
            end if;
         end;
      end loop;
      return result;
   end orphaned_files_detected;

   --------------------------------------------------------------------------------------------
   --  modify_file_if_necessary
   --------------------------------------------------------------------------------------------
   function modify_file_if_necessary (original : String) return String
   is
      function strip_raw_localbase (wrkstr : String) return String;
      function strip_raw_localbase (wrkstr : String) return String
      is
         rawlbase : constant String  := HT.USS (PM.configuration.dir_localbase) & "/";
      begin
         if HT.leads (wrkstr, rawlbase) then
            return wrkstr (wrkstr'First + rawlbase'Length .. wrkstr'Last);
         else
            return wrkstr;
         end if;
      end strip_raw_localbase;
   begin
      if HT.leads (original, "@info ") then
         return strip_raw_localbase (original (original'First + 6 .. original 'Last));
      else
         return original;
      end if;
   end modify_file_if_necessary;

end PortScan.Tests;

--  This file is covered by the Internet Software Consortium (ISC) License
--  Reference: ../License.txt

with File_Operations;
with PortScan.Log;
with Parameters;
with Unix;
with Ada.Characters.Latin_1;
with Ada.Directories;
with Ada.Exceptions;

package body PortScan.Tests is

   package FOP renames File_Operations;
   package LOG renames PortScan.Log;
   package PM  renames Parameters;
   package LAT renames Ada.Characters.Latin_1;
   package DIR renames Ada.Directories;
   package EX  renames Ada.Exceptions;

   --------------------------------------------------------------------------------------------
   --  exec_phase_check_plist
   --------------------------------------------------------------------------------------------
   function exec_check_plist
     (specification : PSP.Portspecs;
      log_handle    : TIO.File_Type;
      phase_name    : String;
      seq_id        : port_id;
      rootdir       : String) return Boolean
   is
      passed_check : Boolean := True;
      namebase     : constant String := specification.get_namebase;
      directory_list : entry_crate.Map;
      dossier_list   : entry_crate.Map;
   begin
      LOG.log_phase_begin (log_handle, phase_name);
      TIO.Put_Line (log_handle, "====> Checking for package manifest issues");

      if not ingest_manifests (specification  => specification,
                               log_handle     => log_handle,
                               directory_list => directory_list,
                               dossier_list   => dossier_list,
                               seq_id         => seq_id,
                               namebase       => namebase,
                               rootdir        => rootdir)
      then
         passed_check := False;
      end if;

      if orphaned_directories_detected (log_handle     => log_handle,
                                        directory_list => directory_list,
                                        namebase       => namebase,
                                        rootdir        => rootdir)
      then
         passed_check := False;
      end if;

      if missing_directories_detected (log_handle, directory_list) then
         passed_check := False;
      end if;

      if orphaned_files_detected (log_handle, dossier_list, namebase, rootdir) then
         passed_check := False;
      end if;

      if missing_files_detected (log_handle, dossier_list) then
         passed_check := False;
      end if;

      if passed_check then
         TIO.Put_Line (log_handle, "====> No manifest issues found");
      end if;

      LOG.log_phase_end (log_handle);
      return passed_check;
   end exec_check_plist;

   --------------------------------------------------------------------------------------------
   --  ingest_manifests
   --------------------------------------------------------------------------------------------
   function ingest_manifests
     (specification  : PSP.Portspecs;
      log_handle     : TIO.File_Type;
      directory_list : in out entry_crate.Map;
      dossier_list   : in out entry_crate.Map;
      seq_id         : port_id;
      namebase       : String;
      rootdir        : String) return Boolean
   is
      procedure eat_plist (position : subpackage_crate.Cursor);
      procedure insert_directory (directory : String; subpackage : HT.Text);

      result   : Boolean := True;

      procedure insert_directory (directory : String; subpackage : HT.Text)
      is
         numsep : Natural := HT.count_char (directory, LAT.Solidus);
         canvas : HT.Text := HT.SUS (directory);
      begin
         for x in 1 .. numsep + 1 loop
            declare
               paint      : String := HT.USS (canvas);
               my_new_rec : entry_record := (subpackage, False);
            begin
               if paint /= "" then
                  if not directory_list.Contains (canvas) then
                     directory_list.Insert (canvas, my_new_rec);
                  end if;
                  canvas := HT.SUS (HT.head (paint, "/"));
               end if;
            end;
         end loop;
      end insert_directory;

      procedure eat_plist (position : subpackage_crate.Cursor)
      is
         subpackage    : HT.Text := subpackage_crate.Element (position).subpackage;
         manifest_file : String := "/construction/" & namebase & "/.manifest." &
                         HT.USS (subpackage) & ".mktmp";
         contents      : String := FOP.get_file_contents (rootdir & manifest_file);
         identifier    : constant String := HT.USS (subpackage) & " manifest: ";

         markers : HT.Line_Markers;
      begin
         HT.initialize_markers (contents, markers);
         loop
            exit when not HT.next_line_present (contents, markers);
            declare
               line      : constant String := HT.extract_line (contents, markers);
               line_text : HT.Text := HT.SUS (line);
               new_rec   : entry_record := (subpackage, False);
            begin
               if HT.leads (line, "@comment ") then
                  null;
               elsif HT.leads (line, "@dir ") then
                  declare
                     dir      : String := line (line'First + 5 .. line'Last);
                     dir_text : HT.Text := HT.SUS (dir);
                  begin
                     if directory_list.Contains (dir_text) then
                        result := False;
                        declare
                           spkg : String := HT.USS (directory_list.Element (dir_text).subpackage);
                        begin
                           if spkg /= "" then
                              TIO.Put_Line
                                (log_handle,
                                 "Redundant @dir symbol, " & identifier & dir &
                                   " will already be created by the " & spkg & " manifest");
                           else
                              TIO.Put_Line
                                (log_handle,
                                 "Redundant @dir symbol, " & identifier & dir &
                                   " will already be created by another manifest");
                           end if;
                        end;
                     else
                        insert_directory (dir, subpackage);
                     end if;
                  end;
               else
                  declare
                     modline : String  := modify_file_if_necessary (line);
                     ml_text : HT.Text := HT.SUS (modline);
                  begin
                     if dossier_list.Contains (ml_text) then
                        result := False;
                        declare
                           spkg : String := HT.USS (dossier_list.Element (ml_text).subpackage);
                        begin
                           TIO.Put_Line
                             (log_handle,
                              "Duplicate file entry, " & identifier & modline &
                                " already present in " & spkg & " manifest");
                        end;
                     else
                        dossier_list.Insert (ml_text, new_rec);
                        declare
                           plistdir : String := DIR.Containing_Directory (modline);
                        begin
                           insert_directory (plistdir, subpackage);
                        end;
                     end if;
                  end;
               end if;
            end;
         end loop;
      exception
         when issue : others =>
            TIO.Put_Line (log_handle, "check-plist error: " & EX.Exception_Message (issue));
      end eat_plist;
   begin
      all_ports (seq_id).subpackages.Iterate (eat_plist'Access);
      return result;
   end ingest_manifests;

   --------------------------------------------------------------------------------------------
   --  directory_excluded
   --------------------------------------------------------------------------------------------
   function directory_excluded (candidate : String) return Boolean
   is
      --  mandatory candidate has ${STAGEDIR}/ stripped (no leading slash)
      rawlbase  : constant String  := HT.USS (PM.configuration.dir_localbase);
      localbase : constant String  := rawlbase (rawlbase'First + 1 .. rawlbase'Last);
      lblen     : constant Natural := localbase'Length;
   begin
      if candidate = localbase then
         return True;
      end if;
      if not HT.leads (candidate, localbase & "/") then
         --  This should never happen
         return False;
      end if;

      declare
         shortcan : String := candidate (candidate'First + lblen + 1 .. candidate'Last);
      begin
         if shortcan = "bin" or else
           shortcan = "etc" or else
           shortcan = "etc/rc.d" or else
           shortcan = "include" or else
           shortcan = "lib" or else
           shortcan = "lib/pkgconfig" or else
           shortcan = "libdata" or else
           shortcan = "libexec" or else
           shortcan = "sbin" or else
           shortcan = "share" or else
           shortcan = "www"
         then
            return True;
         end if;
         if not HT.leads (shortcan, "share/") then
            return False;
         end if;
      end;

      declare
         shortcan : String := candidate (candidate'First + lblen + 7 .. candidate'Last);
      begin
         if shortcan = "doc" or else
           shortcan = "examples" or else
           shortcan = "info" or else
           shortcan = "locale" or else
           shortcan = "man" or else
           shortcan = "nls"
         then
            return True;
         end if;
         if shortcan'Length /= 8 or else
           not HT.leads (shortcan, "man/man")
         then
            return False;
         end if;
         case shortcan (shortcan'Last) is
            when '1' .. '9' | 'l' | 'n' => return True;
            when others => return False;
         end case;
      end;
   end directory_excluded;

   --------------------------------------------------------------------------------------------
   --  orphaned_directories_detected
   --------------------------------------------------------------------------------------------
   function orphaned_directories_detected
     (log_handle     : TIO.File_Type;
      directory_list : in out entry_crate.Map;
      namebase       : String;
      rootdir        : String) return Boolean
   is
      rawlbase  : constant String  := HT.USS (PM.configuration.dir_localbase);
      localbase : constant String  := rawlbase (rawlbase'First + 1 .. rawlbase'Last);
      stagedir  : String := rootdir & "/construction/" & namebase & "/stage";
      command   : String := rootdir & "/usr/bin/find " & stagedir & " -type d -printf " &
                  LAT.Quotation & "%P\n" & LAT.Quotation;
      status    : Integer;
      comres    : String := HT.USS (Unix.piped_command (command, status));
      markers   : HT.Line_Markers;
      lblen     : constant Natural := localbase'Length;
      result    : Boolean := False;
      errprefix : constant String := "Orphaned directory detected: ";
   begin
      if status /= 0 then
         TIO.Put_Line ("orphaned_directories_detected: command error: " & comres);
         return True;
      end if;
      HT.initialize_markers (comres, markers);
      loop
         exit when not HT.next_line_present (comres, markers);
         declare
            line      : constant String := HT.extract_line (comres, markers);
            line_text : HT.Text := HT.SUS (line);
         begin
            if line /= "" then
               if HT.leads (line, localbase) then
                  declare
                     plist_dir : HT.Text := HT.SUS (line (line'First + lblen + 1 .. line'Last));
                  begin
                     if directory_list.Contains (plist_dir) then
                        directory_list.Update_Element (Position => directory_list.Find (plist_dir),
                                                       Process  => mark_verified'Access);
                     else
                        if not directory_excluded (line) then
                           TIO.Put_Line (log_handle, errprefix & line);
                           result := True;
                        end if;
                     end if;
                  end;
               else
                  if directory_list.Contains (line_text) then
                     directory_list.Update_Element (Position => directory_list.Find (line_text),
                                                    Process  => mark_verified'Access);
                  else
                     TIO.Put_Line (log_handle, errprefix & line);
                     result := True;
                  end if;
               end if;
            end if;
         end;
      end loop;
      return result;
   end orphaned_directories_detected;

   --------------------------------------------------------------------------------------------
   --  mark_verified
   --------------------------------------------------------------------------------------------
   procedure mark_verified (key : HT.Text; Element : in out entry_record) is
   begin
      Element.verified := True;
   end mark_verified;

   --------------------------------------------------------------------------------------------
   --  missing_directories_detected
   --------------------------------------------------------------------------------------------
   function missing_directories_detected
     (log_handle     : TIO.File_Type;
      directory_list : in out entry_crate.Map) return Boolean
   is
      procedure check (position : entry_crate.Cursor);

      result : Boolean := False;

      procedure check (position : entry_crate.Cursor)
      is
         rec       : entry_record renames entry_crate.Element (position);
         plist_dir : String := HT.USS (entry_crate.Key (position));
      begin
         if not rec.verified then
            TIO.Put_Line
              (log_handle,
               "Directory " & plist_dir & " listed on " & HT.USS (rec.subpackage) &
                 " manifest is not present in the stage directory.");
            result := True;
         end if;
      end check;
   begin
      directory_list.Iterate (check'Access);
      return result;
   end missing_directories_detected;

   --------------------------------------------------------------------------------------------
   --  missing_files_detected
   --------------------------------------------------------------------------------------------
   function missing_files_detected
     (log_handle   : TIO.File_Type;
      dossier_list : in out entry_crate.Map) return Boolean
   is
      procedure check (position : entry_crate.Cursor);

      result : Boolean := False;

      procedure check (position : entry_crate.Cursor)
      is
         rec        : entry_record renames entry_crate.Element (position);
         plist_file : String := HT.USS (entry_crate.Key (position));
      begin
         if not rec.verified then
            TIO.Put_Line
              (log_handle,
               "File " & plist_file & " listed on " & HT.USS (rec.subpackage) &
                 " manifest is not present in the stage directory.");
            result := True;
         end if;
      end check;
   begin
      dossier_list.Iterate (check'Access);
      return result;
   end missing_files_detected;

   --------------------------------------------------------------------------------------------
   --  orphaned_files_detected
   --------------------------------------------------------------------------------------------
   function orphaned_files_detected
     (log_handle     : TIO.File_Type;
      dossier_list   : in out entry_crate.Map;
      namebase       : String;
      rootdir        : String) return Boolean
   is
      rawlbase  : constant String  := HT.USS (PM.configuration.dir_localbase);
      localbase : constant String  := rawlbase (rawlbase'First + 1 .. rawlbase'Last);
      stagedir  : String := rootdir & "/construction/" & namebase & "/stage";
      command   : String := rootdir & "/usr/bin/find " & stagedir &
                  " \( -type f -o -type l \) -printf " &
                  LAT.Quotation & "%P\n" & LAT.Quotation;
      status    : Integer;
      comres    : String := HT.USS (Unix.piped_command (command, status));
      markers   : HT.Line_Markers;
      lblen     : constant Natural := localbase'Length;
      result    : Boolean := False;
      errprefix : constant String := "Orphaned file detected: ";
   begin
      if status /= 0 then
         TIO.Put_Line ("orphaned_files_detected: command error: " & comres);
         return True;
      end if;
      HT.initialize_markers (comres, markers);
      loop
         exit when not HT.next_line_present (comres, markers);
         declare
            line      : constant String := HT.extract_line (comres, markers);
            line_text : HT.Text := HT.SUS (line);
         begin
            if line /= "" then
               if HT.leads (line, localbase) then
                  declare
                     plist_file : HT.Text := HT.SUS (line (line'First + lblen + 1 .. line'Last));
                  begin
                     if dossier_list.Contains (plist_file) then
                        dossier_list.Update_Element (Position => dossier_list.Find (plist_file),
                                                     Process  => mark_verified'Access);
                     else
                        TIO.Put_Line (log_handle, errprefix & line);
                        result := True;
                     end if;
                  end;
               else
                  if dossier_list.Contains (line_text) then
                     dossier_list.Update_Element (Position => dossier_list.Find (line_text),
                                                  Process  => mark_verified'Access);
                  else
                     TIO.Put_Line (log_handle, errprefix & line);
                     result := True;
                  end if;
               end if;
            end if;
         end;
      end loop;
      return result;
   end orphaned_files_detected;

   --------------------------------------------------------------------------------------------
   --  modify_file_if_necessary
   --------------------------------------------------------------------------------------------
   function modify_file_if_necessary (original : String) return String
   is
      function strip_raw_localbase (wrkstr : String) return String;
      function strip_raw_localbase (wrkstr : String) return String
      is
         rawlbase : constant String  := HT.USS (PM.configuration.dir_localbase) & "/";
      begin
         if HT.leads (wrkstr, rawlbase) then
            return wrkstr (wrkstr'First + rawlbase'Length .. wrkstr'Last);
         else
            return wrkstr;
         end if;
      end strip_raw_localbase;
   begin
      if HT.leads (original, "@info ") then
         return strip_raw_localbase (original (original'First + 6 .. original 'Last));
      else
         return original;
      end if;
   end modify_file_if_necessary;

end PortScan.Tests;

fix typo in redundant @dir detection algorithm


-----------------------------------------------------------------------
--  Util.Concurrent -- Concurrent Counters
--  Copyright (C) 2009, 2010, 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.
-----------------------------------------------------------------------

--  The Counters package defines the Counter type which provides
--  atomic increment and decrement operations.  It is intended to be used to
--  implement reference counting in a multi-threaded environment.
--
--    type Ref is record
--        Cnt  : Counter;
--        Data : ...;
--    end record;
--
--    Object  : access Ref;
--    Is_Last : Boolean;
--  begin
--    Decrement (Object.Cnt, Is_Last);  -- Multi-task safe operation
--    if Is_Last then
--        Free (Object);
--    end if;
--
--  Unlike the Ada portable implementation based on protected type, this implementation
--  does not require that Counter be a limited type.
private with Interfaces;
package Util.Concurrent.Counters is

   pragma Preelaborate;

   --  ------------------------------
   --  Atomic Counter
   --  ------------------------------
   --  The atomic Counter implements a simple counter that can be
   --  incremented or decremented atomically.
   type Counter is private;
   type Counter_Access is access all Counter;

   --  Increment the counter atomically.
   procedure Increment (C : in out Counter);
   pragma Inline_Always (Increment);

   --  Increment the counter atomically and return the value before increment.
   procedure Increment (C     : in out Counter;
                        Value : out Integer);
   pragma Inline_Always (Increment);

   --  Decrement the counter atomically.
   procedure Decrement (C : in out Counter);
   pragma Inline_Always (Decrement);

   --  Decrement the counter atomically and return a status.
   procedure Decrement (C : in out Counter;
                        Is_Zero : out Boolean);
   pragma Inline_Always (Decrement);

   --  Get the counter value
   function Value (C : in Counter) return Integer;
   pragma Inline_Always (Value);

   ONE : constant Counter;

private

   --  This implementation works without an Ada protected type:
   --  o The size of the target object is 10 times smaller.
   --  o Increment and Decrement operations are 5 times faster.
   --  o It works by using special instructions
   --  o The counter is Atomic to make sure the compiler will use atomic read/write instructions
   --    and it prevents optimization (Atomic implies Volatile).  The Atomic does not mean
   --    that atomic instructions are used.
   type Counter is record
      Value : aliased Interfaces.Unsigned_32 := 0;
      pragma Atomic (Value);
   end record;

   ONE : constant Counter := Counter '(Value => 1);

end Util.Concurrent.Counters;

-----------------------------------------------------------------------
--  util-concurrent -- Concurrent Counters
--  Copyright (C) 2009, 2010, 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.
-----------------------------------------------------------------------

--  The Counters package defines the Counter type which provides
--  atomic increment and decrement operations.  It is intended to be used to
--  implement reference counting in a multi-threaded environment.
--
--    type Ref is record
--        Cnt  : Counter;
--        Data : ...;
--    end record;
--
--    Object  : access Ref;
--    Is_Last : Boolean;
--  begin
--    Decrement (Object.Cnt, Is_Last);  -- Multi-task safe operation
--    if Is_Last then
--        Free (Object);
--    end if;
--
--  Unlike the Ada portable implementation based on protected type, this implementation
--  does not require that Counter be a limited type.
private with Interfaces;
package Util.Concurrent.Counters is

   pragma Preelaborate;

   --  ------------------------------
   --  Atomic Counter
   --  ------------------------------
   --  The atomic Counter implements a simple counter that can be
   --  incremented or decremented atomically.
   type Counter is private;
   type Counter_Access is access all Counter;

   --  Increment the counter atomically.
   procedure Increment (C : in out Counter);
   pragma Inline_Always (Increment);

   --  Increment the counter atomically and return the value before increment.
   procedure Increment (C     : in out Counter;
                        Value : out Integer);
   pragma Inline_Always (Increment);

   --  Decrement the counter atomically.
   procedure Decrement (C : in out Counter);
   pragma Inline_Always (Decrement);

   --  Decrement the counter atomically and return a status.
   procedure Decrement (C : in out Counter;
                        Is_Zero : out Boolean);
   pragma Inline_Always (Decrement);

   --  Get the counter value
   function Value (C : in Counter) return Integer;
   pragma Inline_Always (Value);

   ONE : constant Counter;

private

   --  This implementation works without an Ada protected type:
   --  o The size of the target object is 10 times smaller.
   --  o Increment and Decrement operations are 5 times faster.
   --  o It works by using special instructions
   --  o The counter is Atomic to make sure the compiler will use atomic read/write instructions
   --    and it prevents optimization (Atomic implies Volatile).  The Atomic does not mean
   --    that atomic instructions are used.
   type Counter is record
      Value : aliased Interfaces.Unsigned_32 := 0;
      pragma Atomic (Value);
   end record;

   ONE : constant Counter := Counter '(Value => 1);

end Util.Concurrent.Counters;

Update the header

Update the header


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

--  The <b>Security.OAuth</b> package defines and implements the OAuth 2.0 authorization
--  framework as defined by the IETF working group.
--  See http://tools.ietf.org/html/draft-ietf-oauth-v2-26
package Security.OAuth is

   --  OAuth 2.0: Section 10.2.2. Initial Registry Contents
   Client_Id         : constant String := "client_id";
   Client_Secret     : constant String := "client_secret";
   Response_Type     : constant String := "response_type";
   Redirect_Uri      : constant String := "redirect_uri";
   Scope             : constant String := "scope";
   State             : constant String := "state";
   Code              : constant String := "code";
   Error_Description : constant String := "error_description";
   Error_Uri         : constant String := "error_uri";
   Grant_Type        : constant String := "grant_type";
   Access_Token      : constant String := "access_token";
   Token_Type        : constant String := "token_type";
   Expires_In        : constant String := "expires_in";
   Username          : constant String := "username";
   Password          : constant String := "password";
   Refresh_Token     : constant String := "refresh_token";

end Security.OAuth;

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

--  == OAuth ==
--  The <b>Security.OAuth</b> package defines and implements the OAuth 2.0 authorization
--  framework as defined by the IETF working group.
--  See http://tools.ietf.org/html/draft-ietf-oauth-v2-26
package Security.OAuth is

   --  OAuth 2.0: Section 10.2.2. Initial Registry Contents
   Client_Id         : constant String := "client_id";
   Client_Secret     : constant String := "client_secret";
   Response_Type     : constant String := "response_type";
   Redirect_Uri      : constant String := "redirect_uri";
   Scope             : constant String := "scope";
   State             : constant String := "state";
   Code              : constant String := "code";
   Error_Description : constant String := "error_description";
   Error_Uri         : constant String := "error_uri";
   Grant_Type        : constant String := "grant_type";
   Access_Token      : constant String := "access_token";
   Token_Type        : constant String := "token_type";
   Expires_In        : constant String := "expires_in";
   Username          : constant String := "username";
   Password          : constant String := "password";
   Refresh_Token     : constant String := "refresh_token";

end Security.OAuth;

Include in generated documentation by Dynamo


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

with Wiki.Strings;
with Wiki.Attributes;
with Wiki.Nodes.Lists;

--  == Documents ==
--  The `Document` type is used to hold a Wiki document that was parsed by the parser
--  with one of the supported syntax.  The `Document` holds two distinct parts:
--
--  * A main document body that represents the Wiki content that was parsed.
--  * A table of contents part that was built while Wiki sections are collected.
--
--  Most of the operations provided by the `Wiki.Documents` package are intended to
--  be used by the wiki parser and filters to build the document.  The document is made of
--  nodes whose knowledge is required by the renderer.
--
--  A document instance must be declared before parsing a text:
--
--     Doc    : Wiki.Documents.Document;
--
--  After parsing some HTML or Wiki text, it will contain a representation of the
--  HTML or Wiki text.  It is possible to populate the document by using one of
--  the `Append`, `Add_Link`, `Add_Image` operation.
package Wiki.Documents is

   pragma Preelaborate;

   --  ------------------------------
   --  A Wiki Document
   --  ------------------------------
   type Document is tagged private;

   --  Append a simple node such as N_LINE_BREAK, N_HORIZONTAL_RULE or N_PARAGRAPH.
   procedure Append (Into : in out Document;
                     Kind : in Wiki.Nodes.Simple_Node_Kind);

   --  Append a HTML tag start node to the document.
   procedure Push_Node (Into       : in out Document;
                        Tag        : in Html_Tag;
                        Attributes : in Wiki.Attributes.Attribute_List);

   --  Pop the HTML tag.
   procedure Pop_Node (From : in out Document;
                       Tag  : in Html_Tag);

   --  Returns True if the current node is the root document node.
   function Is_Root_Node (Doc : in Document) return Boolean;

   --  Append the text with the given format at end of the document.
   procedure Append (Into   : in out Document;
                     Text   : in Wiki.Strings.WString;
                     Format : in Format_Map);

   --  Append a section header at end of the document.
   procedure Append (Into   : in out Document;
                     Header : in Wiki.Strings.WString;
                     Level  : in Positive);

   --  Add a link.
   procedure Add_Link (Into       : in out Document;
                       Name       : in Wiki.Strings.WString;
                       Attributes : in out Wiki.Attributes.Attribute_List);

   --  Add an image.
   procedure Add_Image (Into       : in out Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List);

   --  Add a quote.
   procedure Add_Quote (Into       : in out Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List);

   --  Add a list (<ul> or <ol>) starting at the given number.
   procedure Add_List (Into     : in out Document;
                       Level    : in Positive;
                       Ordered  : in Boolean);

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

   --  Add a text block that is pre-formatted.
   procedure Add_Preformatted (Into     : in out Document;
                               Text     : in Wiki.Strings.WString;
                               Format   : in Wiki.Strings.WString);

   --  Add a new row to the current table.
   procedure Add_Row (Into : in out Document);

   --  Add a column to the current table row.  The column is configured with the
   --  given attributes.  The column content is provided through calls to Append.
   procedure Add_Column (Into : in out Document;
                         Attributes : in out Wiki.Attributes.Attribute_List);

   --  Finish the creation of the table.
   procedure Finish_Table (Into : in out Document);

   --  Iterate over the nodes of the list and call the <tt>Process</tt> procedure with
   --  each node instance.
   procedure Iterate (Doc     : in Document;
                      Process : not null access procedure (Node : in Wiki.Nodes.Node_Type));

   --  Returns True if the document is empty.
   function Is_Empty (Doc : in Document) return Boolean;

   --  Returns True if the document displays the table of contents by itself.
   function Is_Using_TOC (Doc : in Document) return Boolean;

   --  Returns True if the table of contents is visible and must be rendered.
   function Is_Visible_TOC (Doc : in Document) return Boolean;

   --  Hide the table of contents.
   procedure Hide_TOC (Doc : in out Document);

   --  Get the table of content node associated with the document.
   procedure Get_TOC (Doc : in out Document;
                      TOC : out Wiki.Nodes.Lists.Node_List_Ref);

   --  Get the table of content node associated with the document.
   function Get_TOC (Doc : in Document) return Wiki.Nodes.Lists.Node_List_Ref;

private

   --  Append a node to the document.
   procedure Append (Into : in out Document;
                     Node : in Wiki.Nodes.Node_Type_Access);

   type Document is tagged record
      Nodes       : Wiki.Nodes.Lists.Node_List_Ref;
      TOC         : Wiki.Nodes.Lists.Node_List_Ref;
      Current     : Wiki.Nodes.Node_Type_Access;
      Using_TOC   : Boolean := False;
      Visible_TOC : Boolean := True;
   end record;

end Wiki.Documents;

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

with Wiki.Strings;
with Wiki.Attributes;
with Wiki.Nodes.Lists;

--  == Documents ==
--  The `Document` type is used to hold a Wiki document that was parsed by the parser
--  with one of the supported syntax.  The `Document` holds two distinct parts:
--
--  * A main document body that represents the Wiki content that was parsed.
--  * A table of contents part that was built while Wiki sections are collected.
--
--  Most of the operations provided by the `Wiki.Documents` package are intended to
--  be used by the wiki parser and filters to build the document.  The document is made of
--  nodes whose knowledge is required by the renderer.
--
--  A document instance must be declared before parsing a text:
--
--     Doc    : Wiki.Documents.Document;
--
--  After parsing some HTML or Wiki text, it will contain a representation of the
--  HTML or Wiki text.  It is possible to populate the document by using one of
--  the `Append`, `Add_Link`, `Add_Image` operation.
package Wiki.Documents is

   pragma Preelaborate;

   --  ------------------------------
   --  A Wiki Document
   --  ------------------------------
   type Document is tagged private;

   --  Append a simple node such as N_LINE_BREAK, N_HORIZONTAL_RULE or N_PARAGRAPH.
   procedure Append (Into : in out Document;
                     Kind : in Wiki.Nodes.Simple_Node_Kind);

   --  Append a HTML tag start node to the document.
   procedure Push_Node (Into       : in out Document;
                        Tag        : in Html_Tag;
                        Attributes : in Wiki.Attributes.Attribute_List);

   --  Pop the HTML tag.
   procedure Pop_Node (From : in out Document;
                       Tag  : in Html_Tag);

   --  Returns True if the current node is the root document node.
   function Is_Root_Node (Doc : in Document) return Boolean;

   --  Append the text with the given format at end of the document.
   procedure Append (Into   : in out Document;
                     Text   : in Wiki.Strings.WString;
                     Format : in Format_Map);

   --  Append a section header at end of the document.
   procedure Append (Into   : in out Document;
                     Header : in Wiki.Strings.WString;
                     Level  : in Positive);

   --  Add a definition item at end of the document.
   procedure Add_Definition (Into       : in out Document;
                             Definition : in Wiki.Strings.WString);

   --  Add a link.
   procedure Add_Link (Into       : in out Document;
                       Name       : in Wiki.Strings.WString;
                       Attributes : in out Wiki.Attributes.Attribute_List);

   --  Add an image.
   procedure Add_Image (Into       : in out Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List);

   --  Add a quote.
   procedure Add_Quote (Into       : in out Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List);

   --  Add a list (<ul> or <ol>) starting at the given number.
   procedure Add_List (Into     : in out Document;
                       Level    : in Positive;
                       Ordered  : in Boolean);

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

   --  Add a text block that is pre-formatted.
   procedure Add_Preformatted (Into     : in out Document;
                               Text     : in Wiki.Strings.WString;
                               Format   : in Wiki.Strings.WString);

   --  Add a new row to the current table.
   procedure Add_Row (Into : in out Document);

   --  Add a column to the current table row.  The column is configured with the
   --  given attributes.  The column content is provided through calls to Append.
   procedure Add_Column (Into : in out Document;
                         Attributes : in out Wiki.Attributes.Attribute_List);

   --  Finish the creation of the table.
   procedure Finish_Table (Into : in out Document);

   --  Iterate over the nodes of the list and call the <tt>Process</tt> procedure with
   --  each node instance.
   procedure Iterate (Doc     : in Document;
                      Process : not null access procedure (Node : in Wiki.Nodes.Node_Type));

   --  Returns True if the document is empty.
   function Is_Empty (Doc : in Document) return Boolean;

   --  Returns True if the document displays the table of contents by itself.
   function Is_Using_TOC (Doc : in Document) return Boolean;

   --  Returns True if the table of contents is visible and must be rendered.
   function Is_Visible_TOC (Doc : in Document) return Boolean;

   --  Hide the table of contents.
   procedure Hide_TOC (Doc : in out Document);

   --  Get the table of content node associated with the document.
   procedure Get_TOC (Doc : in out Document;
                      TOC : out Wiki.Nodes.Lists.Node_List_Ref);

   --  Get the table of content node associated with the document.
   function Get_TOC (Doc : in Document) return Wiki.Nodes.Lists.Node_List_Ref;

private

   --  Append a node to the document.
   procedure Append (Into : in out Document;
                     Node : in Wiki.Nodes.Node_Type_Access);

   type Document is tagged record
      Nodes       : Wiki.Nodes.Lists.Node_List_Ref;
      TOC         : Wiki.Nodes.Lists.Node_List_Ref;
      Current     : Wiki.Nodes.Node_Type_Access;
      Using_TOC   : Boolean := False;
      Visible_TOC : Boolean := True;
   end record;

end Wiki.Documents;

Declare the Add_Definition procedure

Declare the Add_Definition procedure


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

   subtype Format_Map is Wiki.Documents.Format_Map;
   subtype WString is Wide_Wide_String;

   type Node_Kind is (N_HEADER,
                      N_LINE_BREAK,
                      N_HORIZONTAL_RULE,
                      N_PARAGRAPH,
                      N_BLOCKQUOTE,
                      N_QUOTE,
                      N_TAG_START,
                      N_TAG_END,
                      N_INDENT,
                      N_TEXT,
                      N_LINK,
                      N_IMAGE);

   --  The possible HTML tags as described in HTML5 specification.
   type Html_Tag_Type is
     (
      --  Section 4.1 The root element
      HTML_TAG,

      --  Section 4.2 Document metadata
      HEAD_TAG, TITLE_TAG, BASE_TAG, LINK_TAG, META_TAG, STYLE_TAG,

      --  Section 4.3 Sections
      BODY_TAG, ARTICLE_TAG, SECTION_TAG, NAV_TAG, ASIDE_TAG,
      H1_TAG, H2_TAG, H3_TAG, H4_TAG, H5_TAG, H6_TAG,
      HEADER_TAG, FOOTER_TAG,
      ADDRESS_TAG,

      --  Section 4.4 Grouping content
      P_TAG, HR_TAG, PRE_TAG, BLOCKQUOTE_TAG,
      OL_TAG, UL_TAG, LI_TAG,
      DL_TAG, DT_TAG, DD_TAG,
      FIGURE_TAG, FIGCAPTION_TAG,
      DIV_TAG, MAIN_TAG,

      --  Section 4.5 Text-level semantics
      A_TAG, EM_TAG, STRONG_TAG, SMALL_TAG,
      S_TAG, CITE_TAG, Q_TAG, DFN_TAG, ABBR_TAG,
      DATA_TAG, TIME_TAG, CODE_TAG, VAR_TAG, SAMP_TAG,
      KBD_TAG, SUB_TAG, SUP_TAG,
      I_TAG, B_TAG, U_TAG,
      MARK_TAG, RUBY_TAG, RB_TAG, RT_TAG, RTC_TAG,
      RP_TAG, BDI_TAG, BDO_TAG, SPAN_TAG,
      BR_TAG, WBR_TAG,

      --  Section 4.6 Edits
      INS_TAG, DEL_TAG,

      --  Section 4.7 Embedded content
      IMG_TAG,
      IFRAME_TAG,
      EMBED_TAG,
      OBJECT_TAG,
      PARAM_TAG,
      VIDEO_TAG,
      AUDIO_TAG,
      SOURCE_TAG,
      TRACK_TAG,
      MAP_TAG,
      AREA_TAG,

      --  Section 4.9 Tabular data
      TABLE_TAG, CAPTION_TAG, COLGROUP_TAG, COL_TAG,
      TBODY_TAG, THEAD_TAG, TFOOT_TAG,
      TR_TAG, TD_TAG, TH_TAG,

      --  Section 4.10 Forms
      FORM_TAG, LABEL_TAG, INPUT_TAG,
      BUTTON_TAG, SELECT_TAG, DATALIST_TAG, OPTGROUP_TAG,
      OPTION_TAG, TEXTAREA_TAG, KEYGEN_TAG, OUTPUT_TAG,
      PROGRESS_TAG, METER_TAG, FIELDSET_TAG, LEGEND_TAG,

      --  Section 4.11 Scripting
      SCRIPT_TAG, NOSCRIPT_TAG,
      TEMPLATE_TAG, CANVAS_TAG,

      --  Unknown tags
      UNKNOWN_TAG
     );

   type Node_List is limited private;
   type Node_List_Access is access all Node_List;

   type Node_Type (Kind : Node_Kind; Len : Natural) is limited record
      case Kind is
         when N_HEADER | N_BLOCKQUOTE | N_INDENT =>
            Level  : Natural := 0;
            Header : WString (1 .. Len);

         when N_TEXT =>
            Format : Format_Map;
            Text   : WString (1 .. Len);

         when N_LINK | N_IMAGE =>
            Link       : Wiki.Attributes.Attribute_List_Type;

         when N_QUOTE =>
            Quote      : WString (1 .. Len);

         when N_TAG_START =>
            Tag_Start  : Html_Tag_Type;
            Attributes : Wiki.Attributes.Attribute_List_Type;
            Children   : Node_List_Access;

         when N_TAG_END =>
            Tag_End    : Html_Tag_Type;

         when others =>
            null;

      end case;
   end record;
   type Node_Type_Access is access all Node_Type;

   type Document_Node_Access is private;
   type Document is limited private;

   --  Create a text node.
   function Create_Text (Text : in WString) return Node_Type_Access;

   --     procedure Add_Text (Doc  : in out Document;
--                         Text : in WString);

--     type Renderer is limited interface;
--
--     procedure Render (Engine : in out Renderer;
--                       Doc    : in Document;
--                       Node   : in Node_Type) is abstract;
--
--     procedure Iterate (Doc     : in Document;
--                        Process : access procedure (Doc : in Document; Node : in Node_Type)) is
--        Node : Document_Node_Access := Doc.First;
--     begin
--        while Node /= null loop
--           Process (Doc, Node.Data);
--           Node := Node.Next;
--        end loop;
--     end Iterate;

private

   NODE_LIST_BLOCK_SIZE : constant Positive := 20;

   type Node_Array is array (Positive range <>) of Node_Type_Access;

   type Node_List_Block;
   type Node_List_Block_Access is access all Node_List_Block;

   type Node_List_Block (Max : Positive) is limited record
      Next  : Node_List_Block;
      Last  : Natural := 0;
      List  : Node_Array (1 .. Max);
   end record;

   type Node_List is limited record
      Current : Node_List_Block_Access;
      Length  : Natural := 0;
      First   : Node_List_Block (NODE_LIST_BLOCK_SIZE);
   end record;

   type Document_Node;

   type Document_Node_Access is access all Document_Node;

   type Document_Node (Kind : Node_Kind; Len : Natural) is limited record
      Next  : Document_Node_Access;
      Prev  : Document_Node_Access;
      Data  : Node_Type (Kind, Len);
   end record;

   type Document is limited record
      First : Document_Node_Access;
      Last  : Document_Node_Access;
   end record;

end Wiki.Nodes;

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

   subtype Format_Map is Wiki.Documents.Format_Map;
   subtype WString is Wide_Wide_String;

   type Node_Kind is (N_HEADER,
                      N_LINE_BREAK,
                      N_HORIZONTAL_RULE,
                      N_PARAGRAPH,
                      N_BLOCKQUOTE,
                      N_QUOTE,
                      N_TAG_START,
                      N_TAG_END,
                      N_INDENT,
                      N_TEXT,
                      N_LINK,
                      N_IMAGE);

   --  The possible HTML tags as described in HTML5 specification.
   type Html_Tag_Type is
     (
      --  Section 4.1 The root element
      HTML_TAG,

      --  Section 4.2 Document metadata
      HEAD_TAG, TITLE_TAG, BASE_TAG, LINK_TAG, META_TAG, STYLE_TAG,

      --  Section 4.3 Sections
      BODY_TAG, ARTICLE_TAG, SECTION_TAG, NAV_TAG, ASIDE_TAG,
      H1_TAG, H2_TAG, H3_TAG, H4_TAG, H5_TAG, H6_TAG,
      HEADER_TAG, FOOTER_TAG,
      ADDRESS_TAG,

      --  Section 4.4 Grouping content
      P_TAG, HR_TAG, PRE_TAG, BLOCKQUOTE_TAG,
      OL_TAG, UL_TAG, LI_TAG,
      DL_TAG, DT_TAG, DD_TAG,
      FIGURE_TAG, FIGCAPTION_TAG,
      DIV_TAG, MAIN_TAG,

      --  Section 4.5 Text-level semantics
      A_TAG, EM_TAG, STRONG_TAG, SMALL_TAG,
      S_TAG, CITE_TAG, Q_TAG, DFN_TAG, ABBR_TAG,
      DATA_TAG, TIME_TAG, CODE_TAG, VAR_TAG, SAMP_TAG,
      KBD_TAG, SUB_TAG, SUP_TAG,
      I_TAG, B_TAG, U_TAG,
      MARK_TAG, RUBY_TAG, RB_TAG, RT_TAG, RTC_TAG,
      RP_TAG, BDI_TAG, BDO_TAG, SPAN_TAG,
      BR_TAG, WBR_TAG,

      --  Section 4.6 Edits
      INS_TAG, DEL_TAG,

      --  Section 4.7 Embedded content
      IMG_TAG,
      IFRAME_TAG,
      EMBED_TAG,
      OBJECT_TAG,
      PARAM_TAG,
      VIDEO_TAG,
      AUDIO_TAG,
      SOURCE_TAG,
      TRACK_TAG,
      MAP_TAG,
      AREA_TAG,

      --  Section 4.9 Tabular data
      TABLE_TAG, CAPTION_TAG, COLGROUP_TAG, COL_TAG,
      TBODY_TAG, THEAD_TAG, TFOOT_TAG,
      TR_TAG, TD_TAG, TH_TAG,

      --  Section 4.10 Forms
      FORM_TAG, LABEL_TAG, INPUT_TAG,
      BUTTON_TAG, SELECT_TAG, DATALIST_TAG, OPTGROUP_TAG,
      OPTION_TAG, TEXTAREA_TAG, KEYGEN_TAG, OUTPUT_TAG,
      PROGRESS_TAG, METER_TAG, FIELDSET_TAG, LEGEND_TAG,

      --  Section 4.11 Scripting
      SCRIPT_TAG, NOSCRIPT_TAG,
      TEMPLATE_TAG, CANVAS_TAG,

      --  Unknown tags
      UNKNOWN_TAG
     );

   type Node_List is limited private;
   type Node_List_Access is access all Node_List;

   type Node_Type (Kind : Node_Kind; Len : Natural) is limited record
      case Kind is
         when N_HEADER | N_BLOCKQUOTE | N_INDENT =>
            Level  : Natural := 0;
            Header : WString (1 .. Len);

         when N_TEXT =>
            Format : Format_Map;
            Text   : WString (1 .. Len);

         when N_LINK | N_IMAGE =>
            Link       : Wiki.Attributes.Attribute_List_Type;

         when N_QUOTE =>
            Quote      : WString (1 .. Len);

         when N_TAG_START =>
            Tag_Start  : Html_Tag_Type;
            Attributes : Wiki.Attributes.Attribute_List_Type;
            Children   : Node_List_Access;

         when N_TAG_END =>
            Tag_End    : Html_Tag_Type;

         when others =>
            null;

      end case;
   end record;
   type Node_Type_Access is access all Node_Type;

   type Document_Node_Access is private;
   type Document is limited private;

   --  Create a text node.
   function Create_Text (Text : in WString) return Node_Type_Access;

   --     procedure Add_Text (Doc  : in out Document;
--                         Text : in WString);

--     type Renderer is limited interface;
--
--     procedure Render (Engine : in out Renderer;
--                       Doc    : in Document;
--                       Node   : in Node_Type) is abstract;
--
--     procedure Iterate (Doc     : in Document;
--                        Process : access procedure (Doc : in Document; Node : in Node_Type)) is
--        Node : Document_Node_Access := Doc.First;
--     begin
--        while Node /= null loop
--           Process (Doc, Node.Data);
--           Node := Node.Next;
--        end loop;
--     end Iterate;

private

   NODE_LIST_BLOCK_SIZE : constant Positive := 20;

   type Node_Array is array (Positive range <>) of Node_Type_Access;

   type Node_List_Block;
   type Node_List_Block_Access is access all Node_List_Block;

   type Node_List_Block (Max : Positive) is limited record
      Next  : Node_List_Block_Access;
      Last  : Natural := 0;
      List  : Node_Array (1 .. Max);
   end record;

   type Node_List is limited record
      Current : Node_List_Block_Access;
      Length  : Natural := 0;
      First   : Node_List_Block (NODE_LIST_BLOCK_SIZE);
   end record;

   --  Append a node to the node list.
   procedure Append (Into : in out Node_List;
                     Node : in Node_Type_Access);

   type Document_Node;

   type Document_Node_Access is access all Document_Node;

   type Document_Node (Kind : Node_Kind; Len : Natural) is limited record
      Next  : Document_Node_Access;
      Prev  : Document_Node_Access;
      Data  : Node_Type (Kind, Len);
   end record;

   type Document is limited record
      First : Document_Node_Access;
      Last  : Document_Node_Access;
   end record;

end Wiki.Nodes;

Declare the Append procedure

Declare the Append procedure