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

--  The ASF.Views.Nodes.Facelets package defines some pre-defined
--  tags for composing a view.
--
--    xmlns:ui="http://java.sun.com/jsf/facelets"
--
--  The following Facelets core elements are defined:
--    <ui:include src="..."/>
--    <ui:decorate view="..."/>
--    <ui:define name="..."/>
--    <ui:insert name="..."/>
--    <ui:param name="..." value="..."/>
--    <ui:composition .../>
--
with Ada.Strings.Hash;
with ASF.Factory;
with Ada.Containers.Indefinite_Hashed_Maps;
package ASF.Views.Nodes.Facelets is

   --  Tag factory for nodes defined in this package.
   function Definition return ASF.Factory.Factory_Bindings_Access;

   --  ------------------------------
   --  Include Tag
   --  ------------------------------
   --  The <ui:include src="..."/>
   type Include_Tag_Node is new Tag_Node with private;
   type Include_Tag_Node_Access is access all Include_Tag_Node'Class;

   --  Create the Include Tag
   function Create_Include_Tag_Node (Binding    : in Binding_Access;
                                     Line       : in Line_Info;
                                     Parent     : in Tag_Node_Access;
                                     Attributes : in Tag_Attribute_Array_Access)
                                     return Tag_Node_Access;

   --  Build the component tree from the tag node and attach it as
   --  the last child of the given parent.  Calls recursively the
   --  method to create children.
   overriding
   procedure Build_Components (Node    : access Include_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Facelet_Context'Class);

   --  ------------------------------
   --  Composition Tag
   --  ------------------------------
   --  The <ui:composition template="..."/>
   type Composition_Tag_Node is new Tag_Node with private;
   type Composition_Tag_Node_Access is access all Composition_Tag_Node'Class;

   --  Create the Composition Tag
   function Create_Composition_Tag_Node (Binding    : in Binding_Access;
                                         Line       : in Line_Info;
                                         Parent     : in Tag_Node_Access;
                                         Attributes : in Tag_Attribute_Array_Access)
                                         return Tag_Node_Access;

   --  Build the component tree from the tag node and attach it as
   --  the last child of the given parent.  Calls recursively the
   --  method to create children.
   overriding
   procedure Build_Components (Node    : access Composition_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Facelet_Context'Class);

   --  Freeze the tag node tree and perform any initialization steps
   --  necessary to build the components efficiently.  After this call
   --  the tag node tree should not be modified and it represents a read-only
   --  tree.
   overriding
   procedure Freeze (Node : access Composition_Tag_Node);

   --  Include in the component tree the definition identified by the name.
   --  Upon completion, return in Found whether the definition was found
   --  within this composition context.
   procedure Include_Definition (Node    : access Composition_Tag_Node;
                                 Parent  : in UIComponent_Access;
                                 Context : in out Facelet_Context'Class;
                                 Name    : in Unbounded_String;
                                 Found   : out Boolean);

   --  ------------------------------
   --  Debug Tag
   --  ------------------------------
   --  The <ui:debug/>
   type Debug_Tag_Node is new Tag_Node with private;
   type Debug_Tag_Node_Access is access all Debug_Tag_Node'Class;

   --  Create the Debug Tag
   function Create_Debug_Tag_Node (Binding    : in Binding_Access;
                                   Line       : in Line_Info;
                                   Parent     : in Tag_Node_Access;
                                   Attributes : in Tag_Attribute_Array_Access)
                                   return Tag_Node_Access;

   --  Build the component tree from the tag node and attach it as
   --  the last child of the given parent.  Calls recursively the
   --  method to create children.
   overriding
   procedure Build_Components (Node    : access Debug_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Facelet_Context'Class);

   --  ------------------------------
   --  Decorate Tag
   --  ------------------------------
   --  The <ui:decorate template="...">...</ui:decorate>
   type Decorate_Tag_Node is new Composition_Tag_Node with private;
   type Decorate_Tag_Node_Access is access all Decorate_Tag_Node'Class;

   --  Create the Decorate Tag
   function Create_Decorate_Tag_Node (Binding    : in Binding_Access;
                                      Line       : in Line_Info;
                                      Parent     : in Tag_Node_Access;
                                      Attributes : in Tag_Attribute_Array_Access)
                                      return Tag_Node_Access;

   --  ------------------------------
   --  Define Tag
   --  ------------------------------
   --  The <ui:define name="...">...</ui:define>
   type Define_Tag_Node is new Tag_Node with private;
   type Define_Tag_Node_Access is access all Define_Tag_Node'Class;

   --  Create the Define Tag
   function Create_Define_Tag_Node (Binding    : in Binding_Access;
                                    Line       : in Line_Info;
                                    Parent     : in Tag_Node_Access;
                                    Attributes : in Tag_Attribute_Array_Access)
                                    return Tag_Node_Access;

   --  Build the component tree from the tag node and attach it as
   --  the last child of the given parent.  Calls recursively the
   --  method to create children.
   overriding
   procedure Build_Components (Node    : access Define_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Facelet_Context'Class);

   --  ------------------------------
   --  Insert Tag
   --  ------------------------------
   --  The <ui:insert name="...">...</ui:insert>
   type Insert_Tag_Node is new Tag_Node with private;
   type Insert_Tag_Node_Access is access all Insert_Tag_Node'Class;

   --  Create the Insert Tag
   function Create_Insert_Tag_Node (Binding    : in Binding_Access;
                                    Line       : in Line_Info;
                                    Parent     : in Tag_Node_Access;
                                    Attributes : in Tag_Attribute_Array_Access)
                                    return Tag_Node_Access;

   --  Build the component tree from the tag node and attach it as
   --  the last child of the given parent.  Calls recursively the
   --  method to create children.
   overriding
   procedure Build_Components (Node    : access Insert_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Facelet_Context'Class);

   --  ------------------------------
   --  Param Tag
   --  ------------------------------
   --  The <ui:param name="name" value="#{expr}"/> parameter creation.
   --  The parameter is created in the faces context.
   type Param_Tag_Node is new Tag_Node with private;
   type Param_Tag_Node_Access is access all Param_Tag_Node'Class;

   --  Create the Param Tag
   function Create_Param_Tag_Node (Binding    : in Binding_Access;
                                   Line       : in Line_Info;
                                   Parent     : in Tag_Node_Access;
                                   Attributes : in Tag_Attribute_Array_Access)
                                   return Tag_Node_Access;

   --  Build the component tree from the tag node and attach it as
   --  the last child of the given parent.  Calls recursively the
   --  method to create children.
   overriding
   procedure Build_Components (Node    : access Param_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Facelet_Context'Class);

   --  ------------------------------
   --  Comment Tag
   --  ------------------------------
   --  The <ui:comment condition="...">...</ui:comment>
   type Comment_Tag_Node is new Tag_Node with private;
   type Comment_Tag_Node_Access is access all Comment_Tag_Node'Class;

   --  Create the Comment Tag
   function Create_Comment_Tag_Node (Binding    : in Binding_Access;
                                     Line       : in Line_Info;
                                     Parent     : in Tag_Node_Access;
                                     Attributes : in Tag_Attribute_Array_Access)
                                     return Tag_Node_Access;

   --  Build the component tree from the tag node and attach it as
   --  the last child of the given parent.  Calls recursively the
   --  method to create children.
   overriding
   procedure Build_Components (Node    : access Comment_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Facelet_Context'Class);

private

   --  Tag library map indexed on the library namespace.
   package Define_Maps is new
     Ada.Containers.Indefinite_Hashed_Maps (Key_Type        => String,
                                            Element_Type    => Define_Tag_Node_Access,
                                            Hash            => Ada.Strings.Hash,
                                            Equivalent_Keys => "=");

   type Include_Tag_Node is new Tag_Node with record
      Source : Tag_Attribute_Access;
   end record;

   type Composition_Tag_Node is new Tag_Node with record
      Template : Tag_Attribute_Access;
      Defines  : Define_Maps.Map;
   end record;

   type Debug_Tag_Node is new Tag_Node with record
      Source : Tag_Attribute_Access;
   end record;

   type Decorate_Tag_Node is new Composition_Tag_Node with null record;

   type Define_Tag_Node is new Tag_Node with record
      Define_Name : Unbounded_String;
   end record;

   type Insert_Tag_Node is new Tag_Node with record
      Insert_Name : Tag_Attribute_Access;
   end record;

   type Param_Tag_Node is new Tag_Node with record
      Var   : Tag_Attribute_Access;
      Value : Tag_Attribute_Access;
   end record;

   type Comment_Tag_Node is new Tag_Node with record
      Condition : Tag_Attribute_Access;
   end record;

end ASF.Views.Nodes.Facelets;

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

--  The ASF.Views.Nodes.Facelets package defines some pre-defined
--  tags for composing a view.
--
--    xmlns:ui="http://java.sun.com/jsf/facelets"
--
--  The following Facelets core elements are defined:
--    <ui:include src="..."/>
--    <ui:decorate view="..."/>
--    <ui:define name="..."/>
--    <ui:insert name="..."/>
--    <ui:param name="..." value="..."/>
--    <ui:composition .../>
--
with Ada.Strings.Hash;
with ASF.Factory;
with Ada.Containers.Indefinite_Hashed_Maps;
package ASF.Views.Nodes.Facelets is

   --  Register the facelets component factory.
   procedure Register (Factory : in out ASF.Factory.Component_Factory);

   --  ------------------------------
   --  Include Tag
   --  ------------------------------
   --  The <ui:include src="..."/>
   type Include_Tag_Node is new Tag_Node with private;
   type Include_Tag_Node_Access is access all Include_Tag_Node'Class;

   --  Create the Include Tag
   function Create_Include_Tag_Node (Binding    : in Binding_Type;
                                     Line       : in Line_Info;
                                     Parent     : in Tag_Node_Access;
                                     Attributes : in Tag_Attribute_Array_Access)
                                     return Tag_Node_Access;

   --  Build the component tree from the tag node and attach it as
   --  the last child of the given parent.  Calls recursively the
   --  method to create children.
   overriding
   procedure Build_Components (Node    : access Include_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Facelet_Context'Class);

   --  ------------------------------
   --  Composition Tag
   --  ------------------------------
   --  The <ui:composition template="..."/>
   type Composition_Tag_Node is new Tag_Node with private;
   type Composition_Tag_Node_Access is access all Composition_Tag_Node'Class;

   --  Create the Composition Tag
   function Create_Composition_Tag_Node (Binding    : in Binding_Type;
                                         Line       : in Line_Info;
                                         Parent     : in Tag_Node_Access;
                                         Attributes : in Tag_Attribute_Array_Access)
                                         return Tag_Node_Access;

   --  Build the component tree from the tag node and attach it as
   --  the last child of the given parent.  Calls recursively the
   --  method to create children.
   overriding
   procedure Build_Components (Node    : access Composition_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Facelet_Context'Class);

   --  Freeze the tag node tree and perform any initialization steps
   --  necessary to build the components efficiently.  After this call
   --  the tag node tree should not be modified and it represents a read-only
   --  tree.
   overriding
   procedure Freeze (Node : access Composition_Tag_Node);

   --  Include in the component tree the definition identified by the name.
   --  Upon completion, return in Found whether the definition was found
   --  within this composition context.
   procedure Include_Definition (Node    : access Composition_Tag_Node;
                                 Parent  : in UIComponent_Access;
                                 Context : in out Facelet_Context'Class;
                                 Name    : in Unbounded_String;
                                 Found   : out Boolean);

   --  ------------------------------
   --  Debug Tag
   --  ------------------------------
   --  The <ui:debug/>
   type Debug_Tag_Node is new Tag_Node with private;
   type Debug_Tag_Node_Access is access all Debug_Tag_Node'Class;

   --  Create the Debug Tag
   function Create_Debug_Tag_Node (Binding    : in Binding_Type;
                                   Line       : in Line_Info;
                                   Parent     : in Tag_Node_Access;
                                   Attributes : in Tag_Attribute_Array_Access)
                                   return Tag_Node_Access;

   --  Build the component tree from the tag node and attach it as
   --  the last child of the given parent.  Calls recursively the
   --  method to create children.
   overriding
   procedure Build_Components (Node    : access Debug_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Facelet_Context'Class);

   --  ------------------------------
   --  Decorate Tag
   --  ------------------------------
   --  The <ui:decorate template="...">...</ui:decorate>
   type Decorate_Tag_Node is new Composition_Tag_Node with private;
   type Decorate_Tag_Node_Access is access all Decorate_Tag_Node'Class;

   --  Create the Decorate Tag
   function Create_Decorate_Tag_Node (Binding    : in Binding_Type;
                                      Line       : in Line_Info;
                                      Parent     : in Tag_Node_Access;
                                      Attributes : in Tag_Attribute_Array_Access)
                                      return Tag_Node_Access;

   --  ------------------------------
   --  Define Tag
   --  ------------------------------
   --  The <ui:define name="...">...</ui:define>
   type Define_Tag_Node is new Tag_Node with private;
   type Define_Tag_Node_Access is access all Define_Tag_Node'Class;

   --  Create the Define Tag
   function Create_Define_Tag_Node (Binding    : in Binding_Type;
                                    Line       : in Line_Info;
                                    Parent     : in Tag_Node_Access;
                                    Attributes : in Tag_Attribute_Array_Access)
                                    return Tag_Node_Access;

   --  Build the component tree from the tag node and attach it as
   --  the last child of the given parent.  Calls recursively the
   --  method to create children.
   overriding
   procedure Build_Components (Node    : access Define_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Facelet_Context'Class);

   --  ------------------------------
   --  Insert Tag
   --  ------------------------------
   --  The <ui:insert name="...">...</ui:insert>
   type Insert_Tag_Node is new Tag_Node with private;
   type Insert_Tag_Node_Access is access all Insert_Tag_Node'Class;

   --  Create the Insert Tag
   function Create_Insert_Tag_Node (Binding    : in Binding_Type;
                                    Line       : in Line_Info;
                                    Parent     : in Tag_Node_Access;
                                    Attributes : in Tag_Attribute_Array_Access)
                                    return Tag_Node_Access;

   --  Build the component tree from the tag node and attach it as
   --  the last child of the given parent.  Calls recursively the
   --  method to create children.
   overriding
   procedure Build_Components (Node    : access Insert_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Facelet_Context'Class);

   --  ------------------------------
   --  Param Tag
   --  ------------------------------
   --  The <ui:param name="name" value="#{expr}"/> parameter creation.
   --  The parameter is created in the faces context.
   type Param_Tag_Node is new Tag_Node with private;
   type Param_Tag_Node_Access is access all Param_Tag_Node'Class;

   --  Create the Param Tag
   function Create_Param_Tag_Node (Binding    : in Binding_Type;
                                   Line       : in Line_Info;
                                   Parent     : in Tag_Node_Access;
                                   Attributes : in Tag_Attribute_Array_Access)
                                   return Tag_Node_Access;

   --  Build the component tree from the tag node and attach it as
   --  the last child of the given parent.  Calls recursively the
   --  method to create children.
   overriding
   procedure Build_Components (Node    : access Param_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Facelet_Context'Class);

   --  ------------------------------
   --  Comment Tag
   --  ------------------------------
   --  The <ui:comment condition="...">...</ui:comment>
   type Comment_Tag_Node is new Tag_Node with private;
   type Comment_Tag_Node_Access is access all Comment_Tag_Node'Class;

   --  Create the Comment Tag
   function Create_Comment_Tag_Node (Binding    : in Binding_Type;
                                     Line       : in Line_Info;
                                     Parent     : in Tag_Node_Access;
                                     Attributes : in Tag_Attribute_Array_Access)
                                     return Tag_Node_Access;

   --  Build the component tree from the tag node and attach it as
   --  the last child of the given parent.  Calls recursively the
   --  method to create children.
   overriding
   procedure Build_Components (Node    : access Comment_Tag_Node;
                               Parent  : in UIComponent_Access;
                               Context : in out Facelet_Context'Class);

private

   --  Tag library map indexed on the library namespace.
   package Define_Maps is new
     Ada.Containers.Indefinite_Hashed_Maps (Key_Type        => String,
                                            Element_Type    => Define_Tag_Node_Access,
                                            Hash            => Ada.Strings.Hash,
                                            Equivalent_Keys => "=");

   type Include_Tag_Node is new Tag_Node with record
      Source : Tag_Attribute_Access;
   end record;

   type Composition_Tag_Node is new Tag_Node with record
      Template : Tag_Attribute_Access;
      Defines  : Define_Maps.Map;
   end record;

   type Debug_Tag_Node is new Tag_Node with record
      Source : Tag_Attribute_Access;
   end record;

   type Decorate_Tag_Node is new Composition_Tag_Node with null record;

   type Define_Tag_Node is new Tag_Node with record
      Define_Name : Unbounded_String;
   end record;

   type Insert_Tag_Node is new Tag_Node with record
      Insert_Name : Tag_Attribute_Access;
   end record;

   type Param_Tag_Node is new Tag_Node with record
      Var   : Tag_Attribute_Access;
      Value : Tag_Attribute_Access;
   end record;

   type Comment_Tag_Node is new Tag_Node with record
      Condition : Tag_Attribute_Access;
   end record;

end ASF.Views.Nodes.Facelets;

Use Binding_Type instead of Binding_Access and replace Definition function by a Register procedure


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

with System;
with Interfaces.C;
with Interfaces.C.Strings;
with Util.Systems.Types;

--  The <b>Util.Systems.Os</b> package defines various types and operations which are specific
--  to the OS (Windows).
package Util.Systems.Os is

   --  The directory separator.
   Directory_Separator : constant Character := '\';

   --  Defines several windows specific types.
   type BOOL is mod 8;

   type WORD is new Interfaces.C.short;

   type DWORD is new Interfaces.C.unsigned_long;

   type PDWORD is access all DWORD;
   for PDWORD'Size use Standard'Address_Size;

   function Get_Last_Error return Integer;
   pragma Import (Stdcall, Get_Last_Error, "GetLastError");

   --  Some useful error codes (See Windows document "System Error Codes (0-499)").
   ERROR_BROKEN_PIPE : constant Integer := 109;

   --  ------------------------------
   --  Handle
   --  ------------------------------

   --  The windows HANDLE is defined as a void* in the C API.
   subtype HANDLE is System.Address;

   type PHANDLE is access all HANDLE;
   for PHANDLE'Size use Standard'Address_Size;

   function Wait_For_Single_Object (H : in HANDLE;
                                    Time : in DWORD) return DWORD;
   pragma Import (Stdcall, Wait_For_Single_Object, "WaitForSingleObject");

   type Security_Attributes is record
      Length              : DWORD;
      Security_Descriptor : System.Address;
      Inherit             : Boolean;
   end record;
   type LPSECURITY_ATTRIBUTES is access all Security_Attributes;
   for LPSECURITY_ATTRIBUTES'Size use Standard'Address_Size;

   --  ------------------------------
   --  File operations
   --  ------------------------------
   subtype File_Type is HANDLE;

   NO_FILE : constant File_Type := System.Null_Address;

   STD_INPUT_HANDLE  : constant DWORD := -10;
   STD_OUTPUT_HANDLE : constant DWORD := -11;
   STD_ERROR_HANDLE  : constant DWORD := -12;

   function Get_Std_Handle (Kind : in DWORD) return File_Type;
   pragma Import (Stdcall, Get_Std_Handle, "GetStdHandle");

   function Close_Handle (Fd : in File_Type) return BOOL;
   pragma Import (Stdcall, Close_Handle, "CloseHandle");

   function Duplicate_Handle (SourceProcessHandle : in HANDLE;
                              SourceHandle        : in HANDLE;
                              TargetProcessHandle : in HANDLE;
                              TargetHandle        : in PHANDLE;
                              DesiredAccess       : in DWORD;
                              InheritHandle       : in BOOL;
                              Options             : in DWORD) return BOOL;
   pragma Import  (Stdcall, Duplicate_Handle, "DuplicateHandle");

   function Read_File (Fd      : in File_Type;
                       Buf     : in System.Address;
                       Size    : in DWORD;
                       Result  : in PDWORD;
                       Overlap : in System.Address) return BOOL;
   pragma Import (Stdcall, Read_File, "ReadFile");

   function Write_File (Fd      : in File_Type;
                        Buf     : in System.Address;
                        Size    : in DWORD;
                        Result  : in PDWORD;
                        Overlap : in System.Address) return BOOL;
   pragma Import (Stdcall, Write_File, "WriteFile");

   function Create_Pipe (Read_Handle :  in PHANDLE;
                         Write_Handle : in PHANDLE;
                         Attributes   : in LPSECURITY_ATTRIBUTES;
                         Buf_Size     : in DWORD) return BOOL;
   pragma Import (Stdcall, Create_Pipe, "CreatePipe");

--     type Size_T is mod 2 ** Standard'Address_Size;

   subtype LPWSTR is Interfaces.C.Strings.chars_ptr;
   subtype PBYTE is Interfaces.C.Strings.chars_ptr;
   subtype Ptr is Interfaces.C.Strings.chars_ptr;
   subtype LPCTSTR is System.Address;
   subtype LPTSTR is System.Address;
   type CommandPtr is access all Interfaces.C.wchar_array;

   NULL_STR : constant LPWSTR := Interfaces.C.Strings.Null_Ptr;

   type Startup_Info is record
      cb              : DWORD := 0;
      lpReserved      : LPWSTR := NULL_STR;
      lpDesktop       : LPWSTR := NULL_STR;
      lpTitle         : LPWSTR := NULL_STR;
      dwX             : DWORD := 0;
      dwY             : DWORD := 0;
      dwXsize         : DWORD := 0;
      dwYsize         : DWORD := 0;
      dwXCountChars   : DWORD := 0;
      dwYCountChars   : DWORD := 0;
      dwFillAttribute : DWORD := 0;
      dwFlags         : DWORD := 0;
      wShowWindow     : WORD := 0;
      cbReserved2     : WORD := 0;
      lpReserved2     : PBYTE := Interfaces.C.Strings.Null_Ptr;
      hStdInput       : HANDLE := System.Null_Address;
      hStdOutput      : HANDLE := System.Null_Address;
      hStdError       : HANDLE := System.Null_Address;
   end record;
   pragma Pack (Startup_Info);
   type Startup_Info_Access is access all Startup_Info;

   type PROCESS_INFORMATION is record
      hProcess    : HANDLE := NO_FILE;
      hThread     : HANDLE := NO_FILE;
      dwProcessId : DWORD;
      dwThreadId  : DWORD;
   end record;
   type Process_Information_Access is access all PROCESS_INFORMATION;

   function Get_Current_Process return HANDLE;
   pragma Import (Stdcall, Get_Current_Process, "GetCurrentProcess");

   function Get_Exit_Code_Process (Proc : in HANDLE;
                                   Code : in PDWORD) return BOOL;
   pragma Import (Stdcall, Get_Exit_Code_Process, "GetExitCodeProcess");

   function Create_Process (Name               : in LPCTSTR;
                            Command            : in System.Address;
                            Process_Attributes : in LPSECURITY_ATTRIBUTES;
                            Thread_Attributes  : in LPSECURITY_ATTRIBUTES;
                            Inherit_Handlers   : in Boolean;
                            Creation_Flags     : in DWORD;
                            Environment        : in LPTSTR;
                            Directory          : in LPCTSTR;
                            Startup_Info       : in Startup_Info_Access;
                            Process_Info       : in Process_Information_Access) return Integer;
   pragma Import (Stdcall, Create_Process, "CreateProcessW");

   --  Terminate the windows process and all its threads.
   function Terminate_Process (Proc : in HANDLE;
                               Code : in DWORD) return Integer;
   pragma Import (Stdcall, Terminate_Process, "TerminateProcess");

   function Sys_Stat (Path : in LPWSTR;
                      Stat : access Util.Systems.Types.Stat_Type) return Integer;
   pragma Import (C, Sys_Stat, "_stat64");

   function Sys_Fstat (Fs : in File_Type;
                       Stat : access Util.Systems.Types.Stat_Type) return Integer;
   pragma Import (C, Sys_Fstat, "_fstat64");

private

   --  kernel32 is used on Windows32 as well as Windows64.
   pragma Linker_Options ("-lkernel32");

end Util.Systems.Os;

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

with System;
with Interfaces.C;
with Interfaces.C.Strings;
with Util.Systems.Types;

--  The <b>Util.Systems.Os</b> package defines various types and operations which are specific
--  to the OS (Windows).
package Util.Systems.Os is

   --  The directory separator.
   Directory_Separator : constant Character := '\';

   --  The path separator.
   Path_Separator      : constant Character := ';';

   --  Defines several windows specific types.
   type BOOL is mod 8;

   type WORD is new Interfaces.C.short;

   type DWORD is new Interfaces.C.unsigned_long;

   type PDWORD is access all DWORD;
   for PDWORD'Size use Standard'Address_Size;

   function Get_Last_Error return Integer;
   pragma Import (Stdcall, Get_Last_Error, "GetLastError");

   --  Some useful error codes (See Windows document "System Error Codes (0-499)").
   ERROR_BROKEN_PIPE : constant Integer := 109;

   --  ------------------------------
   --  Handle
   --  ------------------------------

   --  The windows HANDLE is defined as a void* in the C API.
   subtype HANDLE is System.Address;

   type PHANDLE is access all HANDLE;
   for PHANDLE'Size use Standard'Address_Size;

   function Wait_For_Single_Object (H : in HANDLE;
                                    Time : in DWORD) return DWORD;
   pragma Import (Stdcall, Wait_For_Single_Object, "WaitForSingleObject");

   type Security_Attributes is record
      Length              : DWORD;
      Security_Descriptor : System.Address;
      Inherit             : Boolean;
   end record;
   type LPSECURITY_ATTRIBUTES is access all Security_Attributes;
   for LPSECURITY_ATTRIBUTES'Size use Standard'Address_Size;

   --  ------------------------------
   --  File operations
   --  ------------------------------
   subtype File_Type is HANDLE;

   NO_FILE : constant File_Type := System.Null_Address;

   STD_INPUT_HANDLE  : constant DWORD := -10;
   STD_OUTPUT_HANDLE : constant DWORD := -11;
   STD_ERROR_HANDLE  : constant DWORD := -12;

   function Get_Std_Handle (Kind : in DWORD) return File_Type;
   pragma Import (Stdcall, Get_Std_Handle, "GetStdHandle");

   function Close_Handle (Fd : in File_Type) return BOOL;
   pragma Import (Stdcall, Close_Handle, "CloseHandle");

   function Duplicate_Handle (SourceProcessHandle : in HANDLE;
                              SourceHandle        : in HANDLE;
                              TargetProcessHandle : in HANDLE;
                              TargetHandle        : in PHANDLE;
                              DesiredAccess       : in DWORD;
                              InheritHandle       : in BOOL;
                              Options             : in DWORD) return BOOL;
   pragma Import  (Stdcall, Duplicate_Handle, "DuplicateHandle");

   function Read_File (Fd      : in File_Type;
                       Buf     : in System.Address;
                       Size    : in DWORD;
                       Result  : in PDWORD;
                       Overlap : in System.Address) return BOOL;
   pragma Import (Stdcall, Read_File, "ReadFile");

   function Write_File (Fd      : in File_Type;
                        Buf     : in System.Address;
                        Size    : in DWORD;
                        Result  : in PDWORD;
                        Overlap : in System.Address) return BOOL;
   pragma Import (Stdcall, Write_File, "WriteFile");

   function Create_Pipe (Read_Handle :  in PHANDLE;
                         Write_Handle : in PHANDLE;
                         Attributes   : in LPSECURITY_ATTRIBUTES;
                         Buf_Size     : in DWORD) return BOOL;
   pragma Import (Stdcall, Create_Pipe, "CreatePipe");

--     type Size_T is mod 2 ** Standard'Address_Size;

   subtype LPWSTR is Interfaces.C.Strings.chars_ptr;
   subtype PBYTE is Interfaces.C.Strings.chars_ptr;
   subtype Ptr is Interfaces.C.Strings.chars_ptr;
   subtype LPCTSTR is System.Address;
   subtype LPTSTR is System.Address;
   type CommandPtr is access all Interfaces.C.wchar_array;

   NULL_STR : constant LPWSTR := Interfaces.C.Strings.Null_Ptr;

   type Startup_Info is record
      cb              : DWORD := 0;
      lpReserved      : LPWSTR := NULL_STR;
      lpDesktop       : LPWSTR := NULL_STR;
      lpTitle         : LPWSTR := NULL_STR;
      dwX             : DWORD := 0;
      dwY             : DWORD := 0;
      dwXsize         : DWORD := 0;
      dwYsize         : DWORD := 0;
      dwXCountChars   : DWORD := 0;
      dwYCountChars   : DWORD := 0;
      dwFillAttribute : DWORD := 0;
      dwFlags         : DWORD := 0;
      wShowWindow     : WORD := 0;
      cbReserved2     : WORD := 0;
      lpReserved2     : PBYTE := Interfaces.C.Strings.Null_Ptr;
      hStdInput       : HANDLE := System.Null_Address;
      hStdOutput      : HANDLE := System.Null_Address;
      hStdError       : HANDLE := System.Null_Address;
   end record;
   pragma Pack (Startup_Info);
   type Startup_Info_Access is access all Startup_Info;

   type PROCESS_INFORMATION is record
      hProcess    : HANDLE := NO_FILE;
      hThread     : HANDLE := NO_FILE;
      dwProcessId : DWORD;
      dwThreadId  : DWORD;
   end record;
   type Process_Information_Access is access all PROCESS_INFORMATION;

   function Get_Current_Process return HANDLE;
   pragma Import (Stdcall, Get_Current_Process, "GetCurrentProcess");

   function Get_Exit_Code_Process (Proc : in HANDLE;
                                   Code : in PDWORD) return BOOL;
   pragma Import (Stdcall, Get_Exit_Code_Process, "GetExitCodeProcess");

   function Create_Process (Name               : in LPCTSTR;
                            Command            : in System.Address;
                            Process_Attributes : in LPSECURITY_ATTRIBUTES;
                            Thread_Attributes  : in LPSECURITY_ATTRIBUTES;
                            Inherit_Handlers   : in Boolean;
                            Creation_Flags     : in DWORD;
                            Environment        : in LPTSTR;
                            Directory          : in LPCTSTR;
                            Startup_Info       : in Startup_Info_Access;
                            Process_Info       : in Process_Information_Access) return Integer;
   pragma Import (Stdcall, Create_Process, "CreateProcessW");

   --  Terminate the windows process and all its threads.
   function Terminate_Process (Proc : in HANDLE;
                               Code : in DWORD) return Integer;
   pragma Import (Stdcall, Terminate_Process, "TerminateProcess");

   function Sys_Stat (Path : in LPWSTR;
                      Stat : access Util.Systems.Types.Stat_Type) return Integer;
   pragma Import (C, Sys_Stat, "_stat64");

   function Sys_Fstat (Fs : in File_Type;
                       Stat : access Util.Systems.Types.Stat_Type) return Integer;
   pragma Import (C, Sys_Fstat, "_fstat64");

private

   --  kernel32 is used on Windows32 as well as Windows64.
   pragma Linker_Options ("-lkernel32");

end Util.Systems.Os;

Declare Path_Separator constant

Declare Path_Separator constant


--  SPDX-License-Identifier: Apache-2.0
--
--  Copyright (c) 2021 onox <denkpadje@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 Orka.Numerics.Tensors.SIMD_CPU;

with Orka.SIMD.SSE.Singles.Arithmetic;
with Orka.SIMD.SSE.Singles.Compare;
with Orka.SIMD.SSE.Singles.Logical;
with Orka.SIMD.SSE.Singles.Math;
with Orka.SIMD.SSE2.Integers.Arithmetic;
with Orka.SIMD.SSE2.Integers.Logical;
with Orka.SIMD.SSE2.Integers.Random;
with Orka.SIMD.SSE2.Integers.Shift;
with Orka.SIMD.SSE3.Singles.Arithmetic;
with Orka.SIMD.SSE4_1.Integers.Logical;
with Orka.SIMD.SSE4_1.Singles.Math;

package Orka.Numerics.Singles.Tensors.CPU is new Orka.Numerics.Singles.Tensors.SIMD_CPU
  (Index_Homogeneous,
   Integer_32,
   SIMD.SSE2.Integers.m128i,
   SIMD.SSE2.Integers.Arithmetic."+",
   SIMD.SSE2.Integers.Logical."and",
   SIMD.SSE2.Integers.Shift.Shift_Elements_Left_Zeros,
   SIMD.SSE2.Integers.Shift.Shift_Elements_Right_Zeros,
   SIMD.SSE4_1.Integers.Logical.Test_All_Ones,
   SIMD.SSE4_1.Integers.Logical.Test_All_Zero,
   SIMD.SSE.Singles.m128,
   SIMD.SSE.Singles.Arithmetic."*",
   SIMD.SSE.Singles.Arithmetic."/",
   SIMD.SSE.Singles.Arithmetic."+",
   SIMD.SSE.Singles.Arithmetic."-",
   SIMD.SSE.Singles.Arithmetic."-",
   SIMD.SSE.Singles.Arithmetic."abs",
   SIMD.SSE3.Singles.Arithmetic.Sum,
   SIMD.SSE.Singles.Arithmetic.Divide_Or_Zero,
   SIMD.SSE.Singles.Math.Sqrt,
   SIMD.SSE.Singles.Math.Min,
   SIMD.SSE.Singles.Math.Max,
   SIMD.SSE4_1.Singles.Math.Ceil,
   SIMD.SSE4_1.Singles.Math.Floor,
   SIMD.SSE4_1.Singles.Math.Round_Nearest_Integer,
   SIMD.SSE4_1.Singles.Math.Round_Truncate,
   SIMD.SSE.Singles.Logical.And_Not,
   SIMD.SSE.Singles.Logical."and",
   SIMD.SSE.Singles.Logical."or",
   SIMD.SSE.Singles.Logical."xor",
   SIMD.SSE.Singles.Compare."=",
   SIMD.SSE.Singles.Compare."/=",
   SIMD.SSE.Singles.Compare.">",
   SIMD.SSE.Singles.Compare."<",
   SIMD.SSE.Singles.Compare.">=",
   SIMD.SSE.Singles.Compare."<=",
   SIMD.SSE2.Integers.Random.State,
   SIMD.SSE2.Integers.Random.Next,
   SIMD.SSE2.Integers.Random.Reset);
pragma Preelaborate (Orka.Numerics.Singles.Tensors.CPU);

--  SPDX-License-Identifier: Apache-2.0
--
--  Copyright (c) 2021 onox <denkpadje@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 Orka.Numerics.Tensors.SIMD_CPU;

with Orka.SIMD.SSE.Singles.Arithmetic;
with Orka.SIMD.SSE.Singles.Compare;
with Orka.SIMD.SSE.Singles.Logical;
with Orka.SIMD.SSE.Singles.Math;
with Orka.SIMD.SSE2.Integers.Arithmetic;
with Orka.SIMD.SSE2.Integers.Logical;
with Orka.SIMD.SSE2.Integers.Random;
with Orka.SIMD.SSE2.Integers.Shift;
with Orka.SIMD.SSE3.Singles.Arithmetic;
with Orka.SIMD.SSE4_1.Integers.Logical;
with Orka.SIMD.SSE4_1.Singles.Math;

package Orka.Numerics.Singles.Tensors.CPU is new Orka.Numerics.Singles.Tensors.SIMD_CPU
  (Index_4D,
   Integer_32,
   SIMD.SSE2.Integers.m128i,
   SIMD.SSE2.Integers.Arithmetic."+",
   SIMD.SSE2.Integers.Logical."and",
   SIMD.SSE2.Integers.Shift.Shift_Elements_Left_Zeros,
   SIMD.SSE2.Integers.Shift.Shift_Elements_Right_Zeros,
   SIMD.SSE4_1.Integers.Logical.Test_All_Ones,
   SIMD.SSE4_1.Integers.Logical.Test_All_Zero,
   SIMD.SSE.Singles.m128,
   SIMD.SSE.Singles.Arithmetic."*",
   SIMD.SSE.Singles.Arithmetic."/",
   SIMD.SSE.Singles.Arithmetic."+",
   SIMD.SSE.Singles.Arithmetic."-",
   SIMD.SSE.Singles.Arithmetic."-",
   SIMD.SSE.Singles.Arithmetic."abs",
   SIMD.SSE3.Singles.Arithmetic.Sum,
   SIMD.SSE.Singles.Arithmetic.Divide_Or_Zero,
   SIMD.SSE.Singles.Math.Sqrt,
   SIMD.SSE.Singles.Math.Min,
   SIMD.SSE.Singles.Math.Max,
   SIMD.SSE4_1.Singles.Math.Ceil,
   SIMD.SSE4_1.Singles.Math.Floor,
   SIMD.SSE4_1.Singles.Math.Round_Nearest_Integer,
   SIMD.SSE4_1.Singles.Math.Round_Truncate,
   SIMD.SSE.Singles.Logical.And_Not,
   SIMD.SSE.Singles.Logical."and",
   SIMD.SSE.Singles.Logical."or",
   SIMD.SSE.Singles.Logical."xor",
   SIMD.SSE.Singles.Compare."=",
   SIMD.SSE.Singles.Compare."/=",
   SIMD.SSE.Singles.Compare.">",
   SIMD.SSE.Singles.Compare."<",
   SIMD.SSE.Singles.Compare.">=",
   SIMD.SSE.Singles.Compare."<=",
   SIMD.SSE2.Integers.Random.State,
   SIMD.SSE2.Integers.Random.Next,
   SIMD.SSE2.Integers.Random.Reset);
pragma Preelaborate (Orka.Numerics.Singles.Tensors.CPU);

numerics: Rename occurrences of Index_Homogeneous to Index_4D

Signed-off-by: onox <34c1d3d2d1347bea60a26f46574de21a7a79b6d5@gmail.com>


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

with Util.Log.Loggers;

with ASF.Contexts.Faces;
with ASF.Applications.Main.Configs;

with Security.Permissions;
with Security.Controllers.Roles;
with AWA.Permissions.Configs;
with AWA.Events.Configs;
with AWA.Services.Contexts;

package body AWA.Applications.Configs is

   use Util.Log;

   Log : constant Loggers.Logger := Loggers.Create ("AWA.Applications.Configs");

   --  ------------------------------
   --  XML reader configuration.  By instantiating this generic package, the XML parser
   --  gets initialized to read the configuration for servlets, filters, managed beans,
   --  permissions, events and other configuration elements.
   --  ------------------------------
   package body Reader_Config is
      App_Access : constant ASF.Contexts.Faces.Application_Access := App.all'Unchecked_Access;
      Sec        : constant Security.Permissions.Permission_Manager_Access
        := App.Get_Permission_Manager;

      package Bean_Config is
        new ASF.Applications.Main.Configs.Reader_Config (Reader, App_Access,
                                                         Context.all'Access);
      package Policy_Config is
        new Security.Permissions.Reader_Config (Reader, Sec);
      package Role_Config is
        new Security.Controllers.Roles.Reader_Config (Reader, Sec);
      package Entity_Config is
        new AWA.Permissions.Configs.Reader_Config (Reader, Sec);
      package Event_Config is
        new AWA.Events.Configs.Reader_Config (Reader  => Reader,
                                              Manager => App.Events'Unchecked_Access,
                                              Context => Context.all'Access);

      pragma Warnings (Off, Bean_Config);
      pragma Warnings (Off, Policy_Config);
      pragma Warnings (Off, Role_Config);
      pragma Warnings (Off, Entity_Config);
      pragma Warnings (Off, Event_Config);
   end Reader_Config;

   --  ------------------------------
   --  Read the application configuration file and configure the application
   --  ------------------------------
   procedure Read_Configuration (App     : in out Application'Class;
                                 File    : in String;
                                 Context : in EL.Contexts.Default.Default_Context_Access) is

      Reader : Util.Serialize.IO.XML.Parser;
      Ctx    : AWA.Services.Contexts.Service_Context;
   begin
      Log.Info ("Reading application configuration file {0}", File);
      Ctx.Set_Context (App'Unchecked_Access, null);

      declare
         package Config is new Reader_Config (Reader, App'Unchecked_Access, Context);
         pragma Warnings (Off, Config);
      begin
         --  Initialize the parser with the module configuration mappers (if any).
         Initialize_Parser (App, Reader);

         if Log.Get_Level >= Util.Log.DEBUG_LEVEL then
            Util.Serialize.IO.Dump (Reader, Log);
         end if;

         --  Read the configuration file and record managed beans, navigation rules.
         Reader.Parse (File);
      end;
   exception
      when others =>
         Log.Error ("Error while reading {0}", File);
         raise;
   end Read_Configuration;

end AWA.Applications.Configs;

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

with Util.Log.Loggers;

with ASF.Contexts.Faces;
with ASF.Applications.Main.Configs;

with Security.Policies;
with AWA.Events.Configs;
with AWA.Services.Contexts;

package body AWA.Applications.Configs is

   use Util.Log;

   Log : constant Loggers.Logger := Loggers.Create ("AWA.Applications.Configs");

   --  ------------------------------
   --  XML reader configuration.  By instantiating this generic package, the XML parser
   --  gets initialized to read the configuration for servlets, filters, managed beans,
   --  permissions, events and other configuration elements.
   --  ------------------------------
   package body Reader_Config is
      App_Access : constant ASF.Contexts.Faces.Application_Access := App.all'Unchecked_Access;
      Sec        : constant Security.Policies.Policy_Manager_Access
        := App.Get_Security_Manager;

      package Bean_Config is
        new ASF.Applications.Main.Configs.Reader_Config (Reader, App_Access,
                                                         Context.all'Access);
      package Policy_Config is
        new Security.Policies.Reader_Config (Reader, Sec);
      package Event_Config is
        new AWA.Events.Configs.Reader_Config (Reader  => Reader,
                                              Manager => App.Events'Unchecked_Access,
                                              Context => Context.all'Access);

      pragma Warnings (Off, Bean_Config);
      pragma Warnings (Off, Policy_Config);
      pragma Warnings (Off, Event_Config);
   end Reader_Config;

   --  ------------------------------
   --  Read the application configuration file and configure the application
   --  ------------------------------
   procedure Read_Configuration (App     : in out Application'Class;
                                 File    : in String;
                                 Context : in EL.Contexts.Default.Default_Context_Access) is

      Reader : Util.Serialize.IO.XML.Parser;
      Ctx    : AWA.Services.Contexts.Service_Context;
   begin
      Log.Info ("Reading application configuration file {0}", File);
      Ctx.Set_Context (App'Unchecked_Access, null);

      declare
         package Config is new Reader_Config (Reader, App'Unchecked_Access, Context);
         pragma Warnings (Off, Config);
      begin
         --  Initialize the parser with the module configuration mappers (if any).
         Initialize_Parser (App, Reader);

         if Log.Get_Level >= Util.Log.DEBUG_LEVEL then
            Util.Serialize.IO.Dump (Reader, Log);
         end if;

         --  Read the configuration file and record managed beans, navigation rules.
         Reader.Parse (File);
      end;
   exception
      when others =>
         Log.Error ("Error while reading {0}", File);
         raise;
   end Read_Configuration;

end AWA.Applications.Configs;

Use the Security.Policies to configure the security permissions


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

with Util.Concurrent.Counters;

with MAT.Frames;
package MAT.Events.Targets is

   Not_Found : exception;

   type Event_Type is mod 16;
   type Probe_Index_Type is (MSG_BEGIN,
                             MSG_END,
                             MSG_LIBRARY,
                             MSG_MALLOC,
                             MSG_FREE,
                             MSG_REALLOC
                             );

   type Event_Id_Type is new Natural;

   type Probe_Event_Type is record
      Id       : Event_Id_Type;
      Event    : MAT.Types.Uint16;
      Index    : Probe_Index_Type;
      Time     : MAT.Types.Target_Tick_Ref;
      Thread   : MAT.Types.Target_Thread_Ref;
      Frame    : MAT.Frames.Frame_Type;
      Addr     : MAT.Types.Target_Addr;
      Size     : MAT.Types.Target_Size;
      Old_Addr : MAT.Types.Target_Addr;
   end record;

   subtype Target_Event is Probe_Event_Type;

   package Target_Event_Vectors is
     new Ada.Containers.Vectors (Positive, Target_Event);

   subtype Target_Event_Vector is Target_Event_Vectors.Vector;
   subtype Target_Event_Cursor is Target_Event_Vectors.Cursor;

   --  Find in the list the first event with the given type.
   --  Raise <tt>Not_Found</tt> if the list does not contain such event.
   function Find (List : in Target_Event_Vector;
                  Kind : in Probe_Index_Type) return Probe_Event_Type;

   type Event_Info_Type is record
      First_Event : Target_Event;
      Last_Event  : Target_Event;
      Frame_Addr  : MAT.Types.Target_Addr;
      Count       : Natural;
   end record;

   package Size_Event_Info_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Size,
                                      Element_Type => Event_Info_Type);
   subtype Size_Event_Info_Map is Size_Event_Info_Maps.Map;
   subtype Size_Event_Info_Cursor is Size_Event_Info_Maps.Cursor;

   package Frame_Event_Info_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Addr,
                                      Element_Type => Event_Info_Type);
   subtype Frame_Event_Info_Map is Frame_Event_Info_Maps.Map;
   subtype Frame_Event_Info_Cursor is Frame_Event_Info_Maps.Cursor;

   package Event_Info_Vectors is
     new Ada.Containers.Vectors (Index_Type   => Positive,
                                 Element_Type => Event_Info_Type);
   subtype Event_Info_Vector is Event_Info_Vectors.Vector;
   subtype Event_Info_Cursor is Event_Info_Vectors.Cursor;

   --  Extract from the frame info map, the list of event info sorted on the count.
   procedure Build_Event_Info (Map : in Frame_Event_Info_Map;
                               List : in out Event_Info_Vector);

   type Target_Events is tagged limited private;
   type Target_Events_Access is access all Target_Events'Class;

   --  Add the event in the list of events and increment the event counter.
   procedure Insert (Target : in out Target_Events;
                     Event  : in Probe_Event_Type);

   procedure Get_Events (Target : in out Target_Events;
                         Start  : in MAT.Types.Target_Time;
                         Finish : in MAT.Types.Target_Time;
                         Into   : in out Target_Event_Vector);

   --  Get the start and finish time for the events that have been received.
   procedure Get_Time_Range (Target : in out Target_Events;
                             Start  : out MAT.Types.Target_Time;
                             Finish : out MAT.Types.Target_Time);

   --  Get the probe event with the given allocated unique id.
   function Get_Event (Target : in Target_Events;
                       Id     : in Event_Id_Type) return Probe_Event_Type;

   --  Get the first and last event that have been received.
   procedure Get_Limits (Target : in out Target_Events;
                         First  : out Probe_Event_Type;
                         Last   : out Probe_Event_Type);

   --  Get the current event counter.
   function Get_Event_Counter (Target : in Target_Events) return Integer;

   --  Iterate over the events starting from the <tt>Start</tt> event and until the
   --  <tt>Finish</tt> event is found (inclusive).  Execute the <tt>Process</tt> procedure
   --  with each event instance.
   procedure Iterate (Target  : in out Target_Events;
                      Start   : in Event_Id_Type;
                      Finish  : in Event_Id_Type;
                      Process : access procedure (Event : in Probe_Event_Type));

   --  Iterate over the events starting from first first event up to the last event collected.
   --  Execute the <tt>Process</tt> procedure with each event instance.
   procedure Iterate (Target  : in out Target_Events;
                      Process : access procedure (Event : in Target_Event));

private

   EVENT_BLOCK_SIZE : constant Event_Id_Type := 1024;

   type Probe_Event_Array is array (1 .. EVENT_BLOCK_SIZE) of Probe_Event_Type;

   type Event_Block is record
      Start  : MAT.Types.Target_Time;
      Finish : MAT.Types.Target_Time;
      Count  : Event_Id_Type := 0;
      Events : Probe_Event_Array;
   end record;
   type Event_Block_Access is access all Event_Block;

   use type MAT.Types.Target_Time;
   package Event_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Time,
                                      Element_Type => Event_Block_Access);

   subtype Event_Map is Event_Maps.Map;
   subtype Event_Cursor is Event_Maps.Cursor;

   package Event_Id_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => Event_Id_Type,
                                      Element_Type => Event_Block_Access);

   subtype Event_Id_Map is Event_Id_Maps.Map;
   subtype Event_Id_Cursor is Event_Id_Maps.Cursor;

   protected type Event_Collector is

      --  Add the event in the list of events.
      procedure Insert (Event  : in Probe_Event_Type);

      procedure Get_Events (Start  : in MAT.Types.Target_Time;
                            Finish : in MAT.Types.Target_Time;
                            Into   : in out Target_Event_Vector);

      --  Get the first and last event that have been received.
      procedure Get_Limits (First : out Probe_Event_Type;
                            Last  : out Probe_Event_Type);

      --  Get the start and finish time for the events that have been received.
      procedure Get_Time_Range (Start  : out MAT.Types.Target_Time;
                                Finish : out MAT.Types.Target_Time);

      --  Get the probe event with the given allocated unique id.
      function Get_Event (Id : in Event_Id_Type) return Probe_Event_Type;

      --  Iterate over the events starting from the <tt>Start</tt> event and until the
      --  <tt>Finish</tt> event is found (inclusive).  Execute the <tt>Process</tt> procedure
      --  with each event instance.
      procedure Iterate (Start   : in Event_Id_Type;
                         Finish  : in Event_Id_Type;
                         Process : access procedure (Event : in Probe_Event_Type));

      --  Clear the events.
      procedure Clear;

   private
      Current       : Event_Block_Access := null;
      Events        : Event_Map;
      Ids           : Event_Id_Map;
      Last_Id       : Event_Id_Type := 0;
   end Event_Collector;

   type Target_Events is new Ada.Finalization.Limited_Controlled with record
      Events      : Event_Collector;
      Event_Count : Util.Concurrent.Counters.Counter;
   end record;

   --  Release the storage allocated for the events.
   overriding
   procedure Finalize (Target : in out Target_Events);

end MAT.Events.Targets;

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

with Util.Concurrent.Counters;

with MAT.Frames;
package MAT.Events.Targets is

   Not_Found : exception;

   type Event_Type is mod 16;
   type Probe_Index_Type is (MSG_BEGIN,
                             MSG_END,
                             MSG_LIBRARY,
                             MSG_MALLOC,
                             MSG_FREE,
                             MSG_REALLOC
                             );

   type Event_Id_Type is new Natural;

   type Probe_Event_Type is record
      Id       : Event_Id_Type;
      Event    : MAT.Types.Uint16;
      Index    : Probe_Index_Type;
      Time     : MAT.Types.Target_Tick_Ref;
      Thread   : MAT.Types.Target_Thread_Ref;
      Frame    : MAT.Frames.Frame_Type;
      Addr     : MAT.Types.Target_Addr;
      Size     : MAT.Types.Target_Size;
      Old_Addr : MAT.Types.Target_Addr;
      Old_Size : MAT.Types.Target_Size;
   end record;

   subtype Target_Event is Probe_Event_Type;

   package Target_Event_Vectors is
     new Ada.Containers.Vectors (Positive, Target_Event);

   subtype Target_Event_Vector is Target_Event_Vectors.Vector;
   subtype Target_Event_Cursor is Target_Event_Vectors.Cursor;

   --  Find in the list the first event with the given type.
   --  Raise <tt>Not_Found</tt> if the list does not contain such event.
   function Find (List : in Target_Event_Vector;
                  Kind : in Probe_Index_Type) return Probe_Event_Type;

   type Event_Info_Type is record
      First_Event : Target_Event;
      Last_Event  : Target_Event;
      Frame_Addr  : MAT.Types.Target_Addr;
      Count       : Natural;
   end record;

   package Size_Event_Info_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Size,
                                      Element_Type => Event_Info_Type);
   subtype Size_Event_Info_Map is Size_Event_Info_Maps.Map;
   subtype Size_Event_Info_Cursor is Size_Event_Info_Maps.Cursor;

   package Frame_Event_Info_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Addr,
                                      Element_Type => Event_Info_Type);
   subtype Frame_Event_Info_Map is Frame_Event_Info_Maps.Map;
   subtype Frame_Event_Info_Cursor is Frame_Event_Info_Maps.Cursor;

   package Event_Info_Vectors is
     new Ada.Containers.Vectors (Index_Type   => Positive,
                                 Element_Type => Event_Info_Type);
   subtype Event_Info_Vector is Event_Info_Vectors.Vector;
   subtype Event_Info_Cursor is Event_Info_Vectors.Cursor;

   --  Extract from the frame info map, the list of event info sorted on the count.
   procedure Build_Event_Info (Map : in Frame_Event_Info_Map;
                               List : in out Event_Info_Vector);

   type Target_Events is tagged limited private;
   type Target_Events_Access is access all Target_Events'Class;

   --  Add the event in the list of events and increment the event counter.
   procedure Insert (Target : in out Target_Events;
                     Event  : in Probe_Event_Type);

   procedure Get_Events (Target : in out Target_Events;
                         Start  : in MAT.Types.Target_Time;
                         Finish : in MAT.Types.Target_Time;
                         Into   : in out Target_Event_Vector);

   --  Get the start and finish time for the events that have been received.
   procedure Get_Time_Range (Target : in out Target_Events;
                             Start  : out MAT.Types.Target_Time;
                             Finish : out MAT.Types.Target_Time);

   --  Get the probe event with the given allocated unique id.
   function Get_Event (Target : in Target_Events;
                       Id     : in Event_Id_Type) return Probe_Event_Type;

   --  Get the first and last event that have been received.
   procedure Get_Limits (Target : in out Target_Events;
                         First  : out Probe_Event_Type;
                         Last   : out Probe_Event_Type);

   --  Get the current event counter.
   function Get_Event_Counter (Target : in Target_Events) return Integer;

   --  Iterate over the events starting from the <tt>Start</tt> event and until the
   --  <tt>Finish</tt> event is found (inclusive).  Execute the <tt>Process</tt> procedure
   --  with each event instance.
   procedure Iterate (Target  : in out Target_Events;
                      Start   : in Event_Id_Type;
                      Finish  : in Event_Id_Type;
                      Process : access procedure (Event : in Probe_Event_Type));

   --  Iterate over the events starting from first first event up to the last event collected.
   --  Execute the <tt>Process</tt> procedure with each event instance.
   procedure Iterate (Target  : in out Target_Events;
                      Process : access procedure (Event : in Target_Event));

private

   EVENT_BLOCK_SIZE : constant Event_Id_Type := 1024;

   type Probe_Event_Array is array (1 .. EVENT_BLOCK_SIZE) of Probe_Event_Type;

   type Event_Block is record
      Start  : MAT.Types.Target_Time;
      Finish : MAT.Types.Target_Time;
      Count  : Event_Id_Type := 0;
      Events : Probe_Event_Array;
   end record;
   type Event_Block_Access is access all Event_Block;

   use type MAT.Types.Target_Time;
   package Event_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => MAT.Types.Target_Time,
                                      Element_Type => Event_Block_Access);

   subtype Event_Map is Event_Maps.Map;
   subtype Event_Cursor is Event_Maps.Cursor;

   package Event_Id_Maps is
     new Ada.Containers.Ordered_Maps (Key_Type     => Event_Id_Type,
                                      Element_Type => Event_Block_Access);

   subtype Event_Id_Map is Event_Id_Maps.Map;
   subtype Event_Id_Cursor is Event_Id_Maps.Cursor;

   protected type Event_Collector is

      --  Add the event in the list of events.
      procedure Insert (Event  : in Probe_Event_Type);

      procedure Get_Events (Start  : in MAT.Types.Target_Time;
                            Finish : in MAT.Types.Target_Time;
                            Into   : in out Target_Event_Vector);

      --  Get the first and last event that have been received.
      procedure Get_Limits (First : out Probe_Event_Type;
                            Last  : out Probe_Event_Type);

      --  Get the start and finish time for the events that have been received.
      procedure Get_Time_Range (Start  : out MAT.Types.Target_Time;
                                Finish : out MAT.Types.Target_Time);

      --  Get the probe event with the given allocated unique id.
      function Get_Event (Id : in Event_Id_Type) return Probe_Event_Type;

      --  Iterate over the events starting from the <tt>Start</tt> event and until the
      --  <tt>Finish</tt> event is found (inclusive).  Execute the <tt>Process</tt> procedure
      --  with each event instance.
      procedure Iterate (Start   : in Event_Id_Type;
                         Finish  : in Event_Id_Type;
                         Process : access procedure (Event : in Probe_Event_Type));

      --  Clear the events.
      procedure Clear;

   private
      Current       : Event_Block_Access := null;
      Events        : Event_Map;
      Ids           : Event_Id_Map;
      Last_Id       : Event_Id_Type := 0;
   end Event_Collector;

   type Target_Events is new Ada.Finalization.Limited_Controlled with record
      Events      : Event_Collector;
      Event_Count : Util.Concurrent.Counters.Counter;
   end record;

   --  Release the storage allocated for the events.
   overriding
   procedure Finalize (Target : in out Target_Events);

end MAT.Events.Targets;

Add the Old_Size in the Probe_Event_Type to track realloc information


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

with Util.Properties;

--  The <b>ADO.Drivers</b> package represents the database driver that will create
--  database connections and provide the database specific implementation.
package ADO.Drivers is

   use Ada.Strings.Unbounded;

   --  Raised when the connection URI is invalid.
   Connection_Error : exception;

   --  Raised for all errors reported by the database
   DB_Error : exception;

   type Driver_Index is new Natural range 0 .. 4;

   --  Initialize the drivers and the library by reading the property file
   --  and configure the runtime with it.
   procedure Initialize (Config : in String);

   --  Initialize the drivers and the library and configure the runtime with the given properties.
   procedure Initialize (Config : in Util.Properties.Manager'Class);

   --  Initialize the drivers which are available.
   procedure Initialize;

   --  Get the global configuration property identified by the name.
   --  If the configuration property does not exist, returns the default value.
   function Get_Config (Name    : in String;
                        Default : in String := "") return String;

end ADO.Drivers;

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

with Util.Properties;

--  The <b>ADO.Drivers</b> package represents the database driver that will create
--  database connections and provide the database specific implementation.
package ADO.Drivers is

   use Ada.Strings.Unbounded;

   --  Raised when the connection URI is invalid.
   Connection_Error : exception;

   --  Raised for all errors reported by the database
   DB_Error : exception;

   type Driver_Index is new Natural range 0 .. 4;

   --  Initialize the drivers and the library by reading the property file
   --  and configure the runtime with it.
   procedure Initialize (Config : in String);

   --  Initialize the drivers and the library and configure the runtime with the given properties.
   procedure Initialize (Config : in Util.Properties.Manager'Class);

   --  Get the global configuration property identified by the name.
   --  If the configuration property does not exist, returns the default value.
   function Get_Config (Name    : in String;
                        Default : in String := "") return String;

end ADO.Drivers;

Move the Initialize operation in a separate library


--  bkp-files -- File and directories
-----------------------------------------------------------------------
--  Copyright (C) 2014 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.Files;
with Util.Encoders.Base16;
package body Babel.Files is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Bkp.Files");

   Hex_Encoder : Util.Encoders.Base16.Encoder;

   --  ------------------------------
   --  Allocate a File_Type entry with the given name for the directory.
   --  ------------------------------
   function Allocate (Name : in String;
                      Dir  : in Directory_Type) return File_Type is
      Result : constant File_Type := new File '(Len    => Name'Length,
                                                Id     => NO_IDENTIFIER,
                                                Dir    => Dir,
                                                Name   => Name,
                                                others => <>);
   begin
      return Result;
   end Allocate;

   --  ------------------------------
   --  Allocate a Directory_Type entry with the given name for the directory.
   --  ------------------------------
   function Allocate (Name : in String;
                      Dir  : in Directory_Type) return Directory_Type is
      use Ada.Strings.Unbounded;

      Result : constant Directory_Type := new Directory '(Len    => Name'Length,
                                                          Id     => NO_IDENTIFIER,
                                                          Parent => Dir,
                                                          Name   => Name,
                                                          others => <>);
   begin
      if Dir /= null then
         Result.Path := To_Unbounded_String
           (Util.Files.Compose (To_String (Dir.Path), Name));
      end if;
      return Result;
   end Allocate;

   --  ------------------------------
   --  Return true if the file was modified and need a backup.
   --  ------------------------------
   function Is_Modified (Element : in File_Type) return Boolean is
      use type ADO.Identifier;
   begin
      if Element.Id = NO_IDENTIFIER then
         return True;
      elsif (Element.Status and FILE_MODIFIED) /= 0 then
         return True;
      else
         return False;
      end if;
   end Is_Modified;

   --  ------------------------------
   --  Set the file as modified.
   --  ------------------------------
   procedure Set_Modified (Element : in File_Type) is
   begin
      Element.Status := Element.Status or FILE_MODIFIED;
   end Set_Modified;

   --  ------------------------------
   --  Set the SHA1 signature that was computed for this file.
   --  If the computed signature is different from the current signature,
   --  the FILE_MODIFIED flag is set on the file.  The FILE_HAS_SHA1 flag
   --  is set on the file.
   --  ------------------------------
   procedure Set_Signature (Element   : in File_Type;
                            Signature : in Util.Encoders.SHA1.Hash_Array) is
      use type Util.Encoders.SHA1.Hash_Array;
   begin
      if (Element.Status and FILE_HAS_SHA1) /= 0 and then Element.SHA1 /= Signature then
         Element.Status := Element.Status or FILE_MODIFIED;
      end if;
      Element.Status := Element.Status or FILE_HAS_SHA1;
      Element.SHA1   := Signature;
   end Set_Signature;

   --  ------------------------------
   --  Set the file size.  If the new size is different, the FILE_MODIFIED
   --  flag is set on the file.
   --  ------------------------------
   procedure Set_Size (Element : in File_Type;
                       Size    : in File_Size) is
   begin
      if Element.Size /= Size then
         Element.Size := Size;
         Element.Status := Element.Status or FILE_MODIFIED;
      end if;
   end Set_Size;

   --  ------------------------------
   --  Return the path for the file.
   --  ------------------------------
   function Get_Path (Element : in File_Type) return String is
   begin
      if Element.Dir = null then
         return Element.Name;
      else
         return Util.Files.Compose (Get_Path (Element.Dir), Element.Name);
      end if;
   end Get_Path;

   --  ------------------------------
   --  Return the path for the directory.
   --  ------------------------------
   function Get_Path (Element : in Directory_Type) return String is
   begin
      return Ada.Strings.Unbounded.To_String (Element.Path);
   end Get_Path;

   --  ------------------------------
   --  Return the SHA1 signature computed for the file.
   --  ------------------------------
   function Get_SHA1 (Element : in File_Type) return String is
   begin
      return Hex_Encoder.Transform (Element.SHA1);
   end Get_SHA1;

end Babel.Files;

--  bkp-files -- File and directories
-----------------------------------------------------------------------
--  Copyright (C) 2014 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.Files;
with Util.Encoders.Base16;
package body Babel.Files is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Bkp.Files");

   Hex_Encoder : Util.Encoders.Base16.Encoder;

   --  ------------------------------
   --  Allocate a File_Type entry with the given name for the directory.
   --  ------------------------------
   function Allocate (Name : in String;
                      Dir  : in Directory_Type) return File_Type is
      Result : constant File_Type := new File '(Len    => Name'Length,
                                                Id     => NO_IDENTIFIER,
                                                Dir    => Dir,
                                                Name   => Name,
                                                others => <>);
   begin
      return Result;
   end Allocate;

   --  ------------------------------
   --  Allocate a Directory_Type entry with the given name for the directory.
   --  ------------------------------
   function Allocate (Name : in String;
                      Dir  : in Directory_Type) return Directory_Type is
      use Ada.Strings.Unbounded;

      Result : constant Directory_Type := new Directory '(Len    => Name'Length,
                                                          Id     => NO_IDENTIFIER,
                                                          Parent => Dir,
                                                          Name   => Name,
                                                          others => <>);
   begin
      if Dir /= null then
         Result.Path := To_Unbounded_String
           (Util.Files.Compose (To_String (Dir.Path), Name));
      end if;
      return Result;
   end Allocate;

   --  ------------------------------
   --  Return true if the file was modified and need a backup.
   --  ------------------------------
   function Is_Modified (Element : in File_Type) return Boolean is
      use type ADO.Identifier;
   begin
      if Element.Id = NO_IDENTIFIER then
         return True;
      elsif (Element.Status and FILE_MODIFIED) /= 0 then
         return True;
      else
         return False;
      end if;
   end Is_Modified;

   --  ------------------------------
   --  Set the file as modified.
   --  ------------------------------
   procedure Set_Modified (Element : in File_Type) is
   begin
      Element.Status := Element.Status or FILE_MODIFIED;
   end Set_Modified;

   --  ------------------------------
   --  Set the SHA1 signature that was computed for this file.
   --  If the computed signature is different from the current signature,
   --  the FILE_MODIFIED flag is set on the file.  The FILE_HAS_SHA1 flag
   --  is set on the file.
   --  ------------------------------
   procedure Set_Signature (Element   : in File_Type;
                            Signature : in Util.Encoders.SHA1.Hash_Array) is
      use type Util.Encoders.SHA1.Hash_Array;
   begin
      if (Element.Status and FILE_HAS_SHA1) /= 0 and then Element.SHA1 /= Signature then
         Element.Status := Element.Status or FILE_MODIFIED;
      end if;
      Element.Status := Element.Status or FILE_HAS_SHA1;
      Element.SHA1   := Signature;
   end Set_Signature;

   --  ------------------------------
   --  Set the file size.  If the new size is different, the FILE_MODIFIED
   --  flag is set on the file.
   --  ------------------------------
   procedure Set_Size (Element : in File_Type;
                       Size    : in File_Size) is
   begin
      if Element.Size /= Size then
         Element.Size := Size;
         Element.Status := Element.Status or FILE_MODIFIED;
      end if;
   end Set_Size;

   --  ------------------------------
   --  Return the path for the file.
   --  ------------------------------
   function Get_Path (Element : in File_Type) return String is
   begin
      if Element.Dir = null then
         return Element.Name;
      else
         return Util.Files.Compose (Get_Path (Element.Dir), Element.Name);
      end if;
   end Get_Path;

   --  ------------------------------
   --  Return the path for the directory.
   --  ------------------------------
   function Get_Path (Element : in Directory_Type) return String is
   begin
      return Ada.Strings.Unbounded.To_String (Element.Path);
   end Get_Path;

   --  ------------------------------
   --  Return the SHA1 signature computed for the file.
   --  ------------------------------
   function Get_SHA1 (Element : in File_Type) return String is
   begin
      return Hex_Encoder.Transform (Element.SHA1);
   end Get_SHA1;

   --  ------------------------------
   --  Add the file with the given name in the container.
   --  ------------------------------
   overriding
   procedure Add_File (Into    : in out Default_Container;
                       Element : in File_Type) is
   begin
      Into.Files.Append (Element);
   end Add_File;

   --  ------------------------------
   --  Add the directory with the given name in the container.
   --  ------------------------------
   overriding
   procedure Add_Directory (Into    : in out Default_Container;
                            Element : in Directory_Type) is
   begin
      Into.Dirs.Append (Element);
   end Add_Directory;

   --  ------------------------------
   --  Create a new file instance with the given name in the container.
   --  ------------------------------
   overriding
   function Create (Into : in Default_Container;
                    Name : in String) return File_Type is
   begin
      return Allocate (Name => Name,
                       Dir  => Into.Current);
   end Create;

   --  ------------------------------
   --  Create a new directory instance with the given name in the container.
   --  ------------------------------
   overriding
   function Create (Into : in Default_Container;
                    Name : in String) return Directory_Type is
   begin
      return Allocate (Name => Name,
                       Dir  => Into.Current);
   end Create;

   --  ------------------------------
   --  Find the file with the given name in this file container.
   --  Returns NO_FILE if the file was not found.
   --  ------------------------------
   overriding
   function Find (From : in Default_Container;
                  Name : in String) return File_Type is
   begin
      return NO_FILE;
   end Find;

   --  ------------------------------
   --  Find the directory with the given name in this file container.
   --  Returns NO_DIRECTORY if the directory was not found.
   --  ------------------------------
   overriding
   function Find (From : in Default_Container;
                  Name : in String) return Directory_Type is
   begin
      return NO_DIRECTORY;
   end Find;

end Babel.Files;

Implement the Default_Container operations


--  bkp-files -- File and directories
-----------------------------------------------------------------------
--  Copyright (C) 2014 Stephane.Carrez
--  Written by Stephane.Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Ada.Directories;
with Ada.Containers.Vectors;
with Ada.Text_IO;
with Ada.Exceptions;
with Ada.Streams.Stream_IO;
with Util.Log.Loggers;
with Util.Files;
with Interfaces.C;
package body Babel.Files is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Bkp.Files");

   --  ------------------------------
   --  Allocate a File_Type entry with the given name for the directory.
   --  ------------------------------
   function Allocate (Name : in String;
                      Dir  : in Directory_Type) return File_Type is
      Result : constant File_Type := new File '(Len    => Name'Length,
                                                Id     => NO_IDENTIFIER,
                                                Dir    => Dir,
                                                Name   => Name,
                                                others => <>);
   begin
      return Result;
   end Allocate;

   --  ------------------------------
   --  Return true if the file was modified and need a backup.
   --  ------------------------------
   function Is_Modified (Element : in File_Type) return Boolean is
      use type ADO.Identifier;
   begin
      if Element.Id = NO_IDENTIFIER then
         return True;
      elsif (Element.Status and FILE_MODIFIED) /= 0 then
         return True;
      else
         return False;
      end if;
   end Is_Modified;

   --  ------------------------------
   --  Set the file as modified.
   --  ------------------------------
   procedure Set_Modified (Element : in File_Type) is
   begin
      Element.Status := Element.Status or FILE_MODIFIED;
   end Set_Modified;

   --  ------------------------------
   --  Return the path for the file.
   --  ------------------------------
   function Get_Path (Element : in File) return String is
   begin
      return Util.Files.Compose (Ada.Strings.Unbounded.To_String (Element.Path),
                                 Ada.Strings.Unbounded.To_String (Element.Name));
   end Get_Path;

end Babel.Files;

--  bkp-files -- File and directories
-----------------------------------------------------------------------
--  Copyright (C) 2014 Stephane.Carrez
--  Written by Stephane.Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Ada.Directories;
with Ada.Containers.Vectors;
with Ada.Text_IO;
with Ada.Exceptions;
with Ada.Streams.Stream_IO;
with Util.Log.Loggers;
with Util.Files;
with Interfaces.C;
package body Babel.Files is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Bkp.Files");

   --  ------------------------------
   --  Allocate a File_Type entry with the given name for the directory.
   --  ------------------------------
   function Allocate (Name : in String;
                      Dir  : in Directory_Type) return File_Type is
      Result : constant File_Type := new File '(Len    => Name'Length,
                                                Id     => NO_IDENTIFIER,
                                                Dir    => Dir,
                                                Name   => Name,
                                                others => <>);
   begin
      return Result;
   end Allocate;

   --  ------------------------------
   --  Return true if the file was modified and need a backup.
   --  ------------------------------
   function Is_Modified (Element : in File_Type) return Boolean is
      use type ADO.Identifier;
   begin
      if Element.Id = NO_IDENTIFIER then
         return True;
      elsif (Element.Status and FILE_MODIFIED) /= 0 then
         return True;
      else
         return False;
      end if;
   end Is_Modified;

   --  ------------------------------
   --  Set the file as modified.
   --  ------------------------------
   procedure Set_Modified (Element : in File_Type) is
   begin
      Element.Status := Element.Status or FILE_MODIFIED;
   end Set_Modified;

   --  ------------------------------
   --  Return the path for the file.
   --  ------------------------------
   function Get_Path (Element : in File_Type) return String is
   begin
      if Element.Dir = null then
         return Element.Name;
      else
         return Util.Files.Compose (Get_Path (Element.Dir), Element.Name);
      end if;
   end Get_Path;

   --  ------------------------------
   --  Return the path for the directory.
   --  ------------------------------
   function Get_Path (Element : in Directory_Type) return String is
   begin
      return Ada.Strings.Unbounded.To_String (Element.Path);
   end Get_Path;

end Babel.Files;

Implement the Get_Path operations

Implement the Get_Path operations


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

package Definitions is

   pragma Pure;

   synth_version_major : constant String := "1";
   synth_version_minor : constant String := "33";
   copyright_years     : constant String := "2015-2016";
   host_localbase      : constant String := "/usr/local";
   host_pkg8           : constant String := host_localbase & "/sbin/pkg";
   jobs_per_cpu        : constant := 2;

   type cpu_range is range 1 .. 32;
   type scanners  is range cpu_range'First .. cpu_range'Last;
   type builders  is range cpu_range'First .. cpu_range'Last * jobs_per_cpu;

end Definitions;

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

package Definitions is

   pragma Pure;

   synth_version_major : constant String := "1";
   synth_version_minor : constant String := "34";
   copyright_years     : constant String := "2015-2016";
   host_localbase      : constant String := "/usr/local";
   host_pkg8           : constant String := host_localbase & "/sbin/pkg";
   jobs_per_cpu        : constant := 2;

   type cpu_range is range 1 .. 32;
   type scanners  is range cpu_range'First .. cpu_range'Last;
   type builders  is range cpu_range'First .. cpu_range'Last * jobs_per_cpu;

end Definitions;

Bump version to 1.34

Bump version to 1.34


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

package Definitions is

   pragma Pure;

   synth_version_major : constant String := "1";
   synth_version_minor : constant String := "70";
   copyright_years     : constant String := "2015-2017";
   host_localbase      : constant String := "/usr/local";
   host_make           : constant String := "/usr/bin/make";
   host_pkg8           : constant String := host_localbase & "/sbin/pkg";
   host_bmake          : constant String := host_localbase & "/bin/bmake";
   host_make_program   : constant String := host_make;
   chroot_make         : constant String := "/usr/bin/make";
   chroot_bmake        : constant String := "/usr/pkg/bin/bmake -m /usr/pkg/share/mk";
   chroot_make_program : constant String := chroot_make;
   jobs_per_cpu        : constant := 2;

   type cpu_range is range 1 .. 32;
   type scanners  is range cpu_range'First .. cpu_range'Last;
   type builders  is range cpu_range'First .. cpu_range'Last * jobs_per_cpu;
   type package_system is (ports_collection, pkgsrc);

   software_framework : constant package_system := ports_collection;

   --  Notes for tailoring Synth.  Use sed to:
   --  1. Modify host_localbase to value of LOCALBASE
   --  2. Change software_framework to "pkgsrc" for pkgsrc version
   --  3. Change host_make_program to "host_bmake" for Non-NetBSD pkgsrc platforms
   --  4. Change chroot_make_program to "chroot_bmake" for pkgsrc version
   --  5. On replicant.ads, change "/usr/local" to "/usr/pkg" on pkgsrc

end Definitions;

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

package Definitions is

   pragma Pure;

   synth_version_major : constant String := "1";
   synth_version_minor : constant String := "71";
   copyright_years     : constant String := "2015-2017";
   host_localbase      : constant String := "/usr/local";
   host_make           : constant String := "/usr/bin/make";
   host_pkg8           : constant String := host_localbase & "/sbin/pkg";
   host_bmake          : constant String := host_localbase & "/bin/bmake";
   host_make_program   : constant String := host_make;
   chroot_make         : constant String := "/usr/bin/make";
   chroot_bmake        : constant String := "/usr/pkg/bin/bmake -m /usr/pkg/share/mk";
   chroot_make_program : constant String := chroot_make;
   jobs_per_cpu        : constant := 2;

   type cpu_range is range 1 .. 32;
   type scanners  is range cpu_range'First .. cpu_range'Last;
   type builders  is range cpu_range'First .. cpu_range'Last * jobs_per_cpu;
   type package_system is (ports_collection, pkgsrc);

   software_framework : constant package_system := ports_collection;

   --  Notes for tailoring Synth.  Use sed to:
   --  1. Modify host_localbase to value of LOCALBASE
   --  2. Change software_framework to "pkgsrc" for pkgsrc version
   --  3. Change host_make_program to "host_bmake" for Non-NetBSD pkgsrc platforms
   --  4. Change chroot_make_program to "chroot_bmake" for pkgsrc version
   --  5. On replicant.ads, change "/usr/local" to "/usr/pkg" on pkgsrc

end Definitions;

Bump version to v1.71

Bump version to v1.71