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

with Util.Files;
with Util.Http.Mockups;
package body Util.Http.Clients.Mockups is

   use Ada.Strings.Unbounded;

   Manager : aliased File_Http_Manager;

   --  ------------------------------
   --  Register the Http manager.
   --  ------------------------------
   procedure Register is
   begin
      Default_Http_Manager := Manager'Access;
   end Register;

   --  ------------------------------
   --  Set the path of the file that contains the response for the next
   --  Do_Get and Do_Post calls.
   --  ------------------------------
   procedure Set_File (Path : in String) is
   begin
      Manager.File := To_Unbounded_String (Path);
   end Set_File;

   procedure Create (Manager  : in File_Http_Manager;
                     Http     : in out Client'Class) is
      pragma Unreferenced (Manager);
   begin
      Http.Delegate := new Util.Http.Mockups.Mockup_Request;
   end Create;

   overriding
   procedure Do_Get (Manager  : in File_Http_Manager;
                     Http     : in Client'Class;
                     URI      : in String;
                     Reply    : out Response'Class) is
      pragma Unreferenced (Http, URI);

      Rep : constant Util.Http.Mockups.Mockup_Response_Access
        := new Util.Http.Mockups.Mockup_Response;
      Content : Ada.Strings.Unbounded.Unbounded_String;
   begin
      Reply.Delegate := Rep.all'Access;
      Util.Files.Read_File (Path     => To_String (Manager.File),
                            Into     => Content,
                            Max_Size => 100000);
      Rep.Set_Body (To_String (Content));
      Rep.Set_Status (SC_OK);
   end Do_Get;

   overriding
   procedure Do_Post (Manager  : in File_Http_Manager;
                      Http     : in Client'Class;
                      URI      : in String;
                      Data     : in String;
                      Reply    : out Response'Class) is
      pragma Unreferenced (Data);
   begin
      Manager.Do_Get (Http, URI, Reply);
   end Do_Post;

   overriding
   procedure Do_Put (Manager  : in File_Http_Manager;
                     Http     : in Client'Class;
                     URI      : in String;
                     Data     : in String;
                     Reply    : out Response'Class) is
      pragma Unreferenced (Data);
   begin
      Manager.Do_Get (Http, URI, Reply);
   end Do_Put;

   --  ------------------------------
   --  Set the timeout for the connection.
   --  ------------------------------
   overriding
   procedure Set_Timeout (Manager : in File_Http_Manager;
                          Http    : in Client'Class;
                          Timeout : in Duration) is
      pragma Unreferenced (Manager, Http, Timeout);
   begin
      null;
   end Set_Timeout;

end Util.Http.Clients.Mockups;

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

with Util.Files;
with Util.Http.Mockups;
package body Util.Http.Clients.Mockups is

   use Ada.Strings.Unbounded;

   Manager : aliased File_Http_Manager;

   --  ------------------------------
   --  Register the Http manager.
   --  ------------------------------
   procedure Register is
   begin
      Default_Http_Manager := Manager'Access;
   end Register;

   --  ------------------------------
   --  Set the path of the file that contains the response for the next
   --  Do_Get and Do_Post calls.
   --  ------------------------------
   procedure Set_File (Path : in String) is
   begin
      Manager.File := To_Unbounded_String (Path);
   end Set_File;

   procedure Create (Manager  : in File_Http_Manager;
                     Http     : in out Client'Class) is
      pragma Unreferenced (Manager);
   begin
      Http.Delegate := new Util.Http.Mockups.Mockup_Request;
   end Create;

   overriding
   procedure Do_Get (Manager  : in File_Http_Manager;
                     Http     : in Client'Class;
                     URI      : in String;
                     Reply    : out Response'Class) is
      pragma Unreferenced (Http, URI);

      Rep : constant Util.Http.Mockups.Mockup_Response_Access
        := new Util.Http.Mockups.Mockup_Response;
      Content : Ada.Strings.Unbounded.Unbounded_String;
   begin
      Reply.Delegate := Rep.all'Access;
      Util.Files.Read_File (Path     => To_String (Manager.File),
                            Into     => Content,
                            Max_Size => 100000);
      Rep.Set_Body (To_String (Content));
      Rep.Set_Status (SC_OK);
   end Do_Get;

   overriding
   procedure Do_Post (Manager  : in File_Http_Manager;
                      Http     : in Client'Class;
                      URI      : in String;
                      Data     : in String;
                      Reply    : out Response'Class) is
      pragma Unreferenced (Data);
   begin
      Manager.Do_Get (Http, URI, Reply);
   end Do_Post;

   overriding
   procedure Do_Put (Manager  : in File_Http_Manager;
                     Http     : in Client'Class;
                     URI      : in String;
                     Data     : in String;
                     Reply    : out Response'Class) is
      pragma Unreferenced (Data);
   begin
      Manager.Do_Get (Http, URI, Reply);
   end Do_Put;

   overriding
   procedure Do_Delete (Manager  : in File_Http_Manager;
                        Http     : in Client'Class;
                        URI      : in String;
                        Reply    : out Response'Class) is
   begin
      Manager.Do_Get (Http, URI, Reply);
   end Do_Delete;

   --  ------------------------------
   --  Set the timeout for the connection.
   --  ------------------------------
   overriding
   procedure Set_Timeout (Manager : in File_Http_Manager;
                          Http    : in Client'Class;
                          Timeout : in Duration) is
      pragma Unreferenced (Manager, Http, Timeout);
   begin
      null;
   end Set_Timeout;

end Util.Http.Clients.Mockups;

Implement the Do_Delete procedure for the mockup


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

with Util.Test_Caller;

with AWA.Jobs.Modules;
with AWA.Jobs.Services.Tests;

package body AWA.Jobs.Modules.Tests is

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Jobs.Modules.Register",
                       Test_Register'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test the job factory.
   --  ------------------------------
   procedure Test_Register (T : in out Test) is
      M : AWA.Jobs.Modules.Job_Module;
   begin
      M.Register (Definition => Services.Tests.Test_Definition.Factory'Access);
      Util.Tests.Assert_Equals (T, 1, Integer (M.Factory.Length), "Invalid factory length");

      M.Register (Definition => Services.Tests.Work_1_Definition.Factory'Access);
      Util.Tests.Assert_Equals (T, 2, Integer (M.Factory.Length), "Invalid factory length");

      M.Register (Definition => Services.Tests.Work_2_Definition.Factory'Access);
      Util.Tests.Assert_Equals (T, 3, Integer (M.Factory.Length), "Invalid factory length");
   end Test_Register;

end AWA.Jobs.Modules.Tests;

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

with Util.Test_Caller;

with AWA.Jobs.Modules;
with AWA.Jobs.Services.Tests;

package body AWA.Jobs.Modules.Tests is

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Jobs.Modules.Register",
                       Test_Register'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test the job factory.
   --  ------------------------------
   procedure Test_Register (T : in out Test) is
      M : AWA.Jobs.Modules.Job_Module;
   begin
      M.Register (Definition => Services.Tests.Test_Definition.Factory);
      Util.Tests.Assert_Equals (T, 1, Integer (M.Factory.Length), "Invalid factory length");

      M.Register (Definition => Services.Tests.Work_1_Definition.Factory);
      Util.Tests.Assert_Equals (T, 2, Integer (M.Factory.Length), "Invalid factory length");

      M.Register (Definition => Services.Tests.Work_2_Definition.Factory);
      Util.Tests.Assert_Equals (T, 3, Integer (M.Factory.Length), "Invalid factory length");
   end Test_Register;

end AWA.Jobs.Modules.Tests;

Fix compilation

Fix compilation


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

with EL.Expressions.Nodes;
with EL.Expressions.Parser;
package body EL.Expressions is

   --  ------------------------------
   --  Get the value of the expression using the given expression context.
   --  ------------------------------
   function Get_Value (Expr    : Expression;
                       Context : ELContext'Class) return Object is
   begin
      if Expr.Node = null then
         return EL.Objects.Null_Object;
      end if;
      return EL.Expressions.Nodes.Get_Value (Expr.Node.all, Context);
   end Get_Value;

   --  ------------------------------
   --  Get the value of the expression using the given expression context.
   --  ------------------------------
   function Get_Value (Expr    : ValueExpression;
                       Context : ELContext'Class) return Object is
      pragma Unreferenced (Context);
   begin
      if Expr.Bean = null then
         return EL.Objects.Null_Object;
      end if;
      return To_Object (Expr.Bean);
   end Get_Value;

   procedure Set_Value (Expr    : in ValueExpression;
                        Context : in ELContext'Class;
                        Value   : in Object) is
   begin
      null;
   end Set_Value;

   function Is_Readonly (Expr : in ValueExpression) return Boolean is
   begin
      if Expr.Bean = null then
         return True;
      end if;
      return not (Expr.Bean.all in EL.Beans.Bean'Class);
   end Is_Readonly;

   --  ------------------------------
   --  Parse an expression and return its representation ready for evaluation.
   --  ------------------------------
   function Create_Expression (Expr    : String;
                               Context : ELContext'Class)
                               return Expression is
      use EL.Expressions.Nodes;
      Result : Expression;
      Node   : EL.Expressions.Nodes.ELNode_Access;
   begin
      EL.Expressions.Parser.Parse (Expr => Expr, Context => Context, Result => Node);
      if Node /= null then
         Result.Node := Node.all'Access;
      end if;
      return Result;
   end Create_Expression;

   function Create_ValueExpression (Bean : access EL.Beans.Readonly_Bean'Class)
                                    return ValueExpression is
      Result : ValueExpression;
   begin
      Result.Bean := Bean;
      return Result;
   end Create_ValueExpression;

   --  Parse an expression and return its representation ready for evaluation.
   function Create_Expression (Expr    : String;
                               Context : ELContext'Class)
                               return ValueExpression is
      Result : ValueExpression;
      Node   : EL.Expressions.Nodes.ELNode_Access;
   begin
      EL.Expressions.Parser.Parse (Expr => Expr, Context => Context, Result => Node);
      Result.Node := Node.all'Access;
      return Result;
   end Create_Expression;

   procedure Adjust (Object : in out Expression) is
   begin
      if Object.Node /= null then
         Object.Node.Ref_Counter := Object.Node.Ref_Counter + 1;
      end if;
   end Adjust;

   procedure Finalize (Object : in out Expression) is
      Node : EL.Expressions.Nodes.ELNode_Access;
   begin
      if Object.Node /= null then
         Node := Object.Node.all'Access;
         Node.Ref_Counter := Node.Ref_Counter - 1;
         if Node.Ref_Counter = 0 then
            EL.Expressions.Nodes.Delete (Node);
            Object.Node := null;
         end if;
      end if;
   end Finalize;

end EL.Expressions;

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

with EL.Expressions.Nodes;
with EL.Expressions.Parser;
package body EL.Expressions is

   --  ------------------------------
   --  Get the value of the expression using the given expression context.
   --  ------------------------------
   function Get_Value (Expr    : Expression;
                       Context : ELContext'Class) return Object is
   begin
      if Expr.Node = null then
         return EL.Objects.Null_Object;
      end if;
      return EL.Expressions.Nodes.Get_Value (Expr.Node.all, Context);
   end Get_Value;

   --  ------------------------------
   --  Get the value of the expression using the given expression context.
   --  ------------------------------
   function Get_Value (Expr    : ValueExpression;
                       Context : ELContext'Class) return Object is
      pragma Unreferenced (Context);
   begin
      if Expr.Bean = null then
         if Expr.Node = null then
            return EL.Objects.Null_Object;
         else
            return EL.Expressions.Nodes.Get_Value (Expr.Node.all, Context);
         end if;
      end if;
      return To_Object (Expr.Bean);
   end Get_Value;

   procedure Set_Value (Expr    : in ValueExpression;
                        Context : in ELContext'Class;
                        Value   : in Object) is
   begin
      null;
   end Set_Value;

   function Is_Readonly (Expr : in ValueExpression) return Boolean is
   begin
      if Expr.Bean = null then
         return True;
      end if;
      return not (Expr.Bean.all in EL.Beans.Bean'Class);
   end Is_Readonly;

   --  ------------------------------
   --  Parse an expression and return its representation ready for evaluation.
   --  ------------------------------
   function Create_Expression (Expr    : String;
                               Context : ELContext'Class)
                               return Expression is
      use EL.Expressions.Nodes;
      Result : Expression;
      Node   : EL.Expressions.Nodes.ELNode_Access;
   begin
      EL.Expressions.Parser.Parse (Expr => Expr, Context => Context, Result => Node);
      if Node /= null then
         Result.Node := Node.all'Access;
      end if;
      return Result;
   end Create_Expression;

   function Create_ValueExpression (Bean : access EL.Beans.Readonly_Bean'Class)
                                    return ValueExpression is
      Result : ValueExpression;
   begin
      Result.Bean := Bean;
      return Result;
   end Create_ValueExpression;

   --  Parse an expression and return its representation ready for evaluation.
   function Create_Expression (Expr    : String;
                               Context : ELContext'Class)
                               return ValueExpression is
      Result : ValueExpression;
      Node   : EL.Expressions.Nodes.ELNode_Access;
   begin
      EL.Expressions.Parser.Parse (Expr => Expr, Context => Context, Result => Node);
      Result.Node := Node.all'Access;
      return Result;
   end Create_Expression;

   procedure Adjust (Object : in out Expression) is
   begin
      if Object.Node /= null then
         Object.Node.Ref_Counter := Object.Node.Ref_Counter + 1;
      end if;
   end Adjust;

   procedure Finalize (Object : in out Expression) is
      Node : EL.Expressions.Nodes.ELNode_Access;
   begin
      if Object.Node /= null then
         Node := Object.Node.all'Access;
         Node.Ref_Counter := Node.Ref_Counter - 1;
         if Node.Ref_Counter = 0 then
            EL.Expressions.Nodes.Delete (Node);
            Object.Node := null;
         end if;
      end if;
   end Finalize;

end EL.Expressions;

Fix Get_Value for the Value_Expression

Fix Get_Value for the Value_Expression


with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
with Ada.Streams;
with Interfaces.C.Strings;
with Interfaces.C.Pointers;
with Nanomsg.Errors;
with System;

package body  Nanomsg.Socket is
   package C renames Interfaces.C;
   use type C.Int;

   function Is_Null (Obj : in Socket_T) return Boolean is (Obj.Fd = -1);

   procedure Init (Obj      :    out Socket_T;
                   Domain   : in     Nanomsg.Domains.Domain_T;
                   Protocol : in     Nanomsg.Protocols.Protocol_T
                  ) is

      function C_Nn_Socket (Domain : in C.Int; Protocol : in C.Int) return C.Int
      with Import, Convention => C, External_Name => "nn_socket";

   begin
      Obj.Fd := Integer (C_Nn_Socket (Nanomsg.Domains.To_C (Domain),
                                      Nanomsg.Protocols.To_C (Protocol)));
      if Obj.Fd < 0 then
         raise Socket_Exception with "Init: " & Nanomsg.Errors.Errno_Text;
      end if;
   end Init;

   procedure Close (Obj : in out Socket_T) is
      function C_Nn_Close (Socket : in C.Int) return C.Int
      with Import, Convention => C, External_Name => "nn_close";

   begin
      Obj.Delete_Endpoint;
      if C_Nn_Close (C.Int (Obj.Fd)) /= 0 then
         raise Socket_Exception with "Close: " & Nanomsg.Errors.Errno_Text;
      end if;
      Obj.Fd := -1;
   end Close;

   procedure Bind (Obj     : in Socket_T;
                   Address : in String) is

      function C_Bind (Socket : in C.Int; Address : in C.Strings.Chars_Ptr) return C.Int
      with Import, Convention => C, External_Name => "nn_bind";
      Endpoint : C.Int := -1;
      C_Address : C.Strings.Chars_Ptr := C.Strings.New_String (Address);
   begin
      Endpoint := C_Bind(C.Int (Obj.Fd), C_Address);
      C.Strings.Free (C_Address);
      if Endpoint < -1 then
         raise Socket_Exception with "Bind: "  & Nanomsg.Errors.Errno_Text;
      end if;
      -- FIXME
      -- Add endpoints container
   end Bind;

   procedure Connect (Obj     : in Socket_T;
                   Address : in String) is

      function C_Connect (Socket : in C.Int; Address : in C.Strings.Chars_Ptr) return C.Int
      with Import, Convention => C, External_Name => "nn_connect";
      Endpoint : C.Int := -1;
      C_Address : C.Strings.Chars_Ptr := C.Strings.New_String (Address);
   begin
      Endpoint := C_Connect(C.Int (Obj.Fd), C_Address) ;
      C.Strings.Free (C_Address);
      if Endpoint < 0 then
         raise Socket_Exception with "Connect: " & Nanomsg.Errors.Errno_Text;
      end if;
   end Connect;

   function Get_Fd (Obj : in Socket_T) return Integer is (Obj.Fd);

   procedure Receive (Obj : in out Socket_T;
                      Message : out Nanomsg.Messages.Message_T) is

      Payload : System.Address;
      use type System.Address;

      Received : Integer;
      use type C.Size_T;
      Flags : constant C.Int := 0;
      Nn_Msg : constant C.Size_T := C.Size_T'Last;

      function Nn_Recv (Socket     :     C.Int;
                        Buf_Access : out System.Address;
                        Size       :     C.Size_T;
                        Flags      :     C.Int
                       ) return C.Int with Import, Convention => C, External_Name => "nn_recv";

      function Free_Msg (Buf_Access :System.Address) return C.Int
          with Import, Convention => C, External_Name => "nn_freemsg";
   begin
      Received := Integer (Nn_Recv (C.Int (Obj.Fd), Payload, Nn_Msg, Flags));
      if Received < 0 then
         raise Socket_Exception with "Receive: " & Nanomsg.Errors.Errno_Text;
      end if;
      Message.Set_Length (Received);
      declare
         Data :  Ada.Streams.Stream_Element_Array (1 .. Ada.Streams.Stream_Element_Offset (Received));
         for Data'Address use Payload;
      begin
         Message.Set_Payload (Data);
      end;
      if Free_Msg (Payload) < 0 then
         raise Socket_Exception with "Deallocation failed";
      end if;
   end Receive;

   procedure Send (Obj : in Socket_T; Message : Nanomsg.Messages.Message_T) is
   Flags : C.Int := 0;
      function Nn_Send (Socket     : C.Int;
                        Buf_Access : Ada.Streams.Stream_Element_Array;
                        Size       : C.Size_T;
                        Flags      : C.Int
                       ) return C.Int with Import, Convention => C, External_Name => "nn_send";
      Sent : Integer;
   begin

      Sent := Integer (Nn_Send (C.Int (Obj.Fd),
                                Message.Get_Payload.all,
                                C.Size_T (Message.Get_Length),
                                Flags));
      if Sent < 0 then
         raise Socket_Exception with "Send: " & Nanomsg.Errors.Errno_Text;
      end if;
      if Sent /= Message.Get_Length then
         raise Socket_Exception with "Send/Receive count doesn't match";
      end if;
   end Send;

   procedure Delete_Endpoint (Obj : in out Socket_T) is
      function Nn_Shutdown (Socket : C.Int;
                            Endpoint : C.Int) return C.Int
      with Import, Convention => C, External_Name => "nn_shutodown";
   begin
      if Nn_Shutdown (Obj.Fd, Obj.Endpoint) < 0 then
         raise Socket_Exception with "Shutdown Error";
      end if;
      Obj.Endpoint := -1;
   end Delete_Endpoint;

end Nanomsg.Socket;

with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
with Ada.Streams;
with Interfaces.C.Strings;
with Interfaces.C.Pointers;
with Nanomsg.Errors;
with System;

package body  Nanomsg.Socket is
   package C renames Interfaces.C;
   use type C.Int;

   function Is_Null (Obj : in Socket_T) return Boolean is (Obj.Fd = -1);

   procedure Init (Obj      :    out Socket_T;
                   Domain   : in     Nanomsg.Domains.Domain_T;
                   Protocol : in     Nanomsg.Protocols.Protocol_T
                  ) is

      function C_Nn_Socket (Domain : in C.Int; Protocol : in C.Int) return C.Int
      with Import, Convention => C, External_Name => "nn_socket";

   begin
      Obj.Fd := Integer (C_Nn_Socket (Nanomsg.Domains.To_C (Domain),
                                      Nanomsg.Protocols.To_C (Protocol)));
      if Obj.Fd < 0 then
         raise Socket_Exception with "Init: " & Nanomsg.Errors.Errno_Text;
      end if;
   end Init;

   procedure Close (Obj : in out Socket_T) is
      function C_Nn_Close (Socket : in C.Int) return C.Int
      with Import, Convention => C, External_Name => "nn_close";

   begin
      Obj.Delete_Endpoint;
      if C_Nn_Close (C.Int (Obj.Fd)) /= 0 then
         raise Socket_Exception with "Close: " & Nanomsg.Errors.Errno_Text;
      end if;
      Obj.Fd := -1;
   end Close;

   procedure Bind (Obj     : in Socket_T;
                   Address : in String) is

      function C_Bind (Socket : in C.Int; Address : in C.Strings.Chars_Ptr) return C.Int
      with Import, Convention => C, External_Name => "nn_bind";
      Endpoint : C.Int := -1;
      C_Address : C.Strings.Chars_Ptr := C.Strings.New_String (Address);
   begin
      Endpoint := C_Bind(C.Int (Obj.Fd), C_Address);
      C.Strings.Free (C_Address);
      if Endpoint < -1 then
         raise Socket_Exception with "Bind: "  & Nanomsg.Errors.Errno_Text;
      end if;
      -- FIXME
      -- Add endpoints container
   end Bind;

   procedure Connect (Obj     : in Socket_T;
                   Address : in String) is

      function C_Connect (Socket : in C.Int; Address : in C.Strings.Chars_Ptr) return C.Int
      with Import, Convention => C, External_Name => "nn_connect";
      Endpoint : C.Int := -1;
      C_Address : C.Strings.Chars_Ptr := C.Strings.New_String (Address);
   begin
      Endpoint := C_Connect(C.Int (Obj.Fd), C_Address) ;
      C.Strings.Free (C_Address);
      if Endpoint < 0 then
         raise Socket_Exception with "Connect: " & Nanomsg.Errors.Errno_Text;
      end if;
   end Connect;

   function Get_Fd (Obj : in Socket_T) return Integer is (Obj.Fd);

   procedure Receive (Obj : in out Socket_T;
                      Message : out Nanomsg.Messages.Message_T) is

      Payload : System.Address;
      use type System.Address;

      Received : Integer;
      use type C.Size_T;
      Flags : constant C.Int := 0;
      Nn_Msg : constant C.Size_T := C.Size_T'Last;

      function Nn_Recv (Socket     :     C.Int;
                        Buf_Access : out System.Address;
                        Size       :     C.Size_T;
                        Flags      :     C.Int
                       ) return C.Int with Import, Convention => C, External_Name => "nn_recv";

      function Free_Msg (Buf_Access :System.Address) return C.Int
          with Import, Convention => C, External_Name => "nn_freemsg";
   begin
      Received := Integer (Nn_Recv (C.Int (Obj.Fd), Payload, Nn_Msg, Flags));
      if Received < 0 then
         raise Socket_Exception with "Receive: " & Nanomsg.Errors.Errno_Text;
      end if;
      Message.Set_Length (Received);
      declare
         Data :  Ada.Streams.Stream_Element_Array (1 .. Ada.Streams.Stream_Element_Offset (Received));
         for Data'Address use Payload;
      begin
         Message.Set_Payload (Data);
      end;
      if Free_Msg (Payload) < 0 then
         raise Socket_Exception with "Deallocation failed";
      end if;
   end Receive;

   procedure Send (Obj : in Socket_T; Message : Nanomsg.Messages.Message_T) is
   Flags : C.Int := 0;
      function Nn_Send (Socket     : C.Int;
                        Buf_Access : Ada.Streams.Stream_Element_Array;
                        Size       : C.Size_T;
                        Flags      : C.Int
                       ) return C.Int with Import, Convention => C, External_Name => "nn_send";
      Sent : Integer;
   begin

      Sent := Integer (Nn_Send (C.Int (Obj.Fd),
                                Message.Get_Payload.all,
                                C.Size_T (Message.Get_Length),
                                Flags));
      if Sent < 0 then
         raise Socket_Exception with "Send: " & Nanomsg.Errors.Errno_Text;
      end if;
      if Sent /= Message.Get_Length then
         raise Socket_Exception with "Send/Receive count doesn't match";
      end if;
   end Send;

   procedure Delete_Endpoint (Obj : in out Socket_T) is
      function Nn_Shutdown (Socket : C.Int;
                            Endpoint : C.Int) return C.Int
      with Import, Convention => C, External_Name => "nn_shutdown";
   begin
      if Nn_Shutdown (C.Int (Obj.Fd), C.Int (Obj.Endpoint)) < 0 then
         raise Socket_Exception with "Shutdown Error";
      end if;
      Obj.Endpoint := -1;
   end Delete_Endpoint;

end Nanomsg.Socket;

Fix typo in nn_shutdown

Fix typo in nn_shutdown


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

--  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, "@terminfo") 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;

exclude @terminfo keyword from check-plist