-----------------------------------------------------------------------
--  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.Calendar;
with Ada.Strings.Unbounded;
with Ada.Containers.Vectors;

with Util.Systems.Types;
with Util.Encoders.SHA1;
with ADO;
package Babel.Files is

   NO_IDENTIFIER : constant ADO.Identifier := ADO.NO_IDENTIFIER;

   subtype File_Identifier is ADO.Identifier;
   subtype Directory_Identifier is ADO.Identifier;
   subtype File_Size is Long_Long_Integer;
   subtype File_Mode is Util.Systems.Types.mode_t;
--   type File_Mode is mod 2**16;

   type File_Type is private;
   type File_Type_Array is array (Positive range <>) of File_Type;
   type File_Type_Array_Access is access all File_Type_Array;

   type Directory_Type is private;
   type Directory_Type_Array is array (Positive range <>) of Directory_Type;
   type Directory_Type_Array_Access is access all Directory_Type_Array;

   NO_DIRECTORY : constant Directory_Type;
   NO_FILE      : constant File_Type;

   type Status_Type is mod 2**16;

   --  The file was modified.
   FILE_MODIFIED : constant Status_Type := 16#0001#;

   --  There was some error while processing this file.
   FILE_ERROR    : constant Status_Type := 16#8000#;

   --  The SHA1 signature for the file is known and valid.
   FILE_HAS_SHA1 : constant Status_Type := 16#0002#;

   --  Allocate a File_Type entry with the given name for the directory.
   function Allocate (Name : in String;
                      Dir  : in Directory_Type) return File_Type;

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

   type File (Len : Positive) is record
      Id     : File_Identifier := NO_IDENTIFIER;
      Size   : File_Size       := 0;
      Dir    : Directory_Type  := NO_DIRECTORY;
      Mode   : File_Mode       := 8#644#;
      User   : Uid_Type        := 0;
      Group  : Gid_Type        := 0;
      Status : Status_Type     := 0;
      Date   : Ada.Calendar.Time;
      SHA1   : Util.Encoders.SHA1.Hash_Array;
      Name   : aliased String (1 .. Len);
   end record;

   --  Compare two files on their name and directory.
   function "<" (Left, Right : in File_Type) return Boolean;

   --  Return true if the file was modified and need a backup.
   function Is_Modified (Element : in File_Type) return Boolean;

   --  Return true if the file is a new file.
   function Is_New (Element : in File_Type) return Boolean;

   --  Set the file as modified.
   procedure Set_Modified (Element : in File_Type);

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

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

   --  Set the owner and group of the file.
   procedure Set_Owner (Element : in File_Type;
                        User    : in Uid_Type;
                        Group   : in Gid_Type);

   --  Set the file modification date.
   procedure Set_Date (Element : in File_Type;
                       Date    : in Util.Systems.Types.Timespec);

   --  Return the path for the file.
   function Get_Path (Element : in File_Type) return String;

   --  Return the path for the directory.
   function Get_Path (Element : in Directory_Type) return String;

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

   --  Return the file size.
   function Get_Size (Element : in File_Type) return File_Size;

   --  Return the file modification date.
   function Get_Date (Element : in File_Type) return Ada.Calendar.Time;

   --  Return the user uid.
   function Get_User (Element : in File_Type) return Uid_Type;

   --  Return the group gid.
   function Get_Group (Element : in File_Type) return Gid_Type;

   --  Return the file unix mode.
   function Get_Mode (Element : in File_Type) return File_Mode;

   type File_Container is limited interface;

   --  Add the file with the given name in the container.
   procedure Add_File (Into    : in out File_Container;
                       Element : in File_Type) is abstract;

   --  Add the directory with the given name in the container.
   procedure Add_Directory (Into    : in out File_Container;
                            Element : in Directory_Type) is abstract;

   --  Create a new file instance with the given name in the container.
   function Create (Into : in File_Container;
                    Name : in String) return File_Type is abstract;

   --  Create a new directory instance with the given name in the container.
   function Create (Into : in File_Container;
                    Name : in String) return Directory_Type is abstract;

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

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

   --  Set the directory object associated with the container.
   procedure Set_Directory (Into      : in out File_Container;
                            Directory : in Directory_Type) is abstract;

   --  Execute the Process procedure on each directory found in the container.
   procedure Each_Directory (Container : in File_Container;
                             Process   : not null access
                               procedure (Dir : in Directory_Type)) is abstract;

   --  Execute the Process procedure on each file found in the container.
   procedure Each_File (Container : in File_Container;
                        Process   : not null access
                          procedure (F : in File_Type)) is abstract;

   type Default_Container is new File_Container with private;

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

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

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

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

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

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

   --  Set the directory object associated with the container.
   overriding
   procedure Set_Directory (Into      : in out Default_Container;
                            Directory : in Directory_Type);

   --  Execute the Process procedure on each directory found in the container.
   overriding
   procedure Each_Directory (Container : in Default_Container;
                             Process   : not null access
                               procedure (Dir : in Directory_Type));

   --  Execute the Process procedure on each file found in the container.
   overriding
   procedure Each_File (Container : in Default_Container;
                        Process   : not null access
                          procedure (F : in File_Type));

private

   type File_Type is access all File;

   type Directory (Len : Positive) is record
      Id       : Directory_Identifier := NO_IDENTIFIER;
      Parent   : Directory_Type;
      Mode     : File_Mode := 8#755#;
      User     : Uid_Type  := 0;
      Group    : Gid_Type  := 0;
      Files    : File_Type_Array_Access;
      Children : Directory_Type_Array_Access;
      Path     : Ada.Strings.Unbounded.Unbounded_String;
      Name     : aliased String (1 .. Len);
   end record;

   type Directory_Type is access all Directory;

   package File_Vectors is new
     Ada.Containers.Vectors (Index_Type   => Positive,
                             Element_Type => File_Type,
                             "="          => "=");

   package Directory_Vectors is new
     Ada.Containers.Vectors (Index_Type   => Positive,
                             Element_Type => Directory_Type,
                             "="          => "=");

   subtype Directory_Vector is Directory_Vectors.Vector;

   type Default_Container is new Babel.Files.File_Container with record
      Current : Directory_Type;
      Files   : File_Vectors.Vector;
      Dirs    : Directory_Vectors.Vector;
   end record;

   NO_DIRECTORY : constant Directory_Type := null;
   NO_FILE      : constant File_Type := null;

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.Calendar;
with Ada.Strings.Unbounded;
with Ada.Containers.Vectors;

with Util.Systems.Types;
with Util.Encoders.SHA1;
with ADO;
package Babel.Files is

   NO_IDENTIFIER : constant ADO.Identifier := ADO.NO_IDENTIFIER;

   subtype File_Identifier is ADO.Identifier;
   subtype Directory_Identifier is ADO.Identifier;
   subtype File_Size is Long_Long_Integer;
   subtype File_Mode is Util.Systems.Types.mode_t;
--   type File_Mode is mod 2**16;

   type File_Type is private;
   type File_Type_Array is array (Positive range <>) of File_Type;
   type File_Type_Array_Access is access all File_Type_Array;

   type Directory_Type is private;
   type Directory_Type_Array is array (Positive range <>) of Directory_Type;
   type Directory_Type_Array_Access is access all Directory_Type_Array;

   NO_DIRECTORY : constant Directory_Type;
   NO_FILE      : constant File_Type;

   type Status_Type is mod 2**16;

   --  The file was modified.
   FILE_MODIFIED : constant Status_Type := 16#0001#;

   --  There was some error while processing this file.
   FILE_ERROR    : constant Status_Type := 16#8000#;

   --  The SHA1 signature for the file is known and valid.
   FILE_HAS_SHA1 : constant Status_Type := 16#0002#;

   --  Allocate a File_Type entry with the given name for the directory.
   function Allocate (Name : in String;
                      Dir  : in Directory_Type) return File_Type;

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

   type File (Len : Positive) is record
      Id     : File_Identifier := NO_IDENTIFIER;
      Size   : File_Size       := 0;
      Dir    : Directory_Type  := NO_DIRECTORY;
      Mode   : File_Mode       := 8#644#;
      User   : Uid_Type        := 0;
      Group  : Gid_Type        := 0;
      Status : Status_Type     := 0;
      Date   : Ada.Calendar.Time;
      SHA1   : Util.Encoders.SHA1.Hash_Array;
      Name   : aliased String (1 .. Len);
   end record;

   --  Compare two files on their name and directory.
   function "<" (Left, Right : in File_Type) return Boolean;

   --  Return true if the file was modified and need a backup.
   function Is_Modified (Element : in File_Type) return Boolean;

   --  Return true if the file is a new file.
   function Is_New (Element : in File_Type) return Boolean;

   --  Set the file as modified.
   procedure Set_Modified (Element : in File_Type);

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

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

   --  Set the owner and group of the file.
   procedure Set_Owner (Element : in File_Type;
                        User    : in Uid_Type;
                        Group   : in Gid_Type);

   --  Set the file modification date.
   procedure Set_Date (Element : in File_Type;
                       Date    : in Util.Systems.Types.Timespec);
   procedure Set_Date (Element : in File_Type;
                       Date    : in Ada.Calendar.Time);

   --  Return the path for the file.
   function Get_Path (Element : in File_Type) return String;

   --  Return the path for the directory.
   function Get_Path (Element : in Directory_Type) return String;

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

   --  Return the file size.
   function Get_Size (Element : in File_Type) return File_Size;

   --  Return the file modification date.
   function Get_Date (Element : in File_Type) return Ada.Calendar.Time;

   --  Return the user uid.
   function Get_User (Element : in File_Type) return Uid_Type;

   --  Return the group gid.
   function Get_Group (Element : in File_Type) return Gid_Type;

   --  Return the file unix mode.
   function Get_Mode (Element : in File_Type) return File_Mode;

   type File_Container is limited interface;

   --  Add the file with the given name in the container.
   procedure Add_File (Into    : in out File_Container;
                       Element : in File_Type) is abstract;

   --  Add the directory with the given name in the container.
   procedure Add_Directory (Into    : in out File_Container;
                            Element : in Directory_Type) is abstract;

   --  Create a new file instance with the given name in the container.
   function Create (Into : in File_Container;
                    Name : in String) return File_Type is abstract;

   --  Create a new directory instance with the given name in the container.
   function Create (Into : in File_Container;
                    Name : in String) return Directory_Type is abstract;

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

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

   --  Set the directory object associated with the container.
   procedure Set_Directory (Into      : in out File_Container;
                            Directory : in Directory_Type) is abstract;

   --  Execute the Process procedure on each directory found in the container.
   procedure Each_Directory (Container : in File_Container;
                             Process   : not null access
                               procedure (Dir : in Directory_Type)) is abstract;

   --  Execute the Process procedure on each file found in the container.
   procedure Each_File (Container : in File_Container;
                        Process   : not null access
                          procedure (F : in File_Type)) is abstract;

   type Default_Container is new File_Container with private;

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

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

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

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

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

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

   --  Set the directory object associated with the container.
   overriding
   procedure Set_Directory (Into      : in out Default_Container;
                            Directory : in Directory_Type);

   --  Execute the Process procedure on each directory found in the container.
   overriding
   procedure Each_Directory (Container : in Default_Container;
                             Process   : not null access
                               procedure (Dir : in Directory_Type));

   --  Execute the Process procedure on each file found in the container.
   overriding
   procedure Each_File (Container : in Default_Container;
                        Process   : not null access
                          procedure (F : in File_Type));

private

   type String_Access is access all String;
   type File_Type is access all File;

   type Directory is record
      Id       : Directory_Identifier := NO_IDENTIFIER;
      Parent   : Directory_Type;
      Mode     : File_Mode := 8#755#;
      User     : Uid_Type  := 0;
      Group    : Gid_Type  := 0;
      Files    : File_Type_Array_Access;
      Children : Directory_Type_Array_Access;
      Path     : Ada.Strings.Unbounded.Unbounded_String;
      --        Name     : aliased String (1 .. Len);
      Name_Pos : Natural := 0;
      Name     : String_Access;
   end record;

   type Directory_Type is access all Directory;

   package File_Vectors is new
     Ada.Containers.Vectors (Index_Type   => Positive,
                             Element_Type => File_Type,
                             "="          => "=");

   package Directory_Vectors is new
     Ada.Containers.Vectors (Index_Type   => Positive,
                             Element_Type => Directory_Type,
                             "="          => "=");

   subtype Directory_Vector is Directory_Vectors.Vector;

   type Default_Container is new Babel.Files.File_Container with record
      Current : Directory_Type;
      Files   : File_Vectors.Vector;
      Dirs    : Directory_Vectors.Vector;
   end record;

   NO_DIRECTORY : constant Directory_Type := null;
   NO_FILE      : constant File_Type := null;

end Babel.Files;

Declare the Set_Date procedure Declare the String_Access Use a String_Access to store the directory's path


-----------------------------------------------------------------------
--  EL.Contexts -- Contexts for evaluating an expression
--  Copyright (C) 2009, 2010, 2011 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 expression context provides information to resolve runtime
--  information when evaluating an expression.  The context provides
--  a resolver whose role is to find variables given their name.

with EL.Objects;
with Util.Beans.Basic;
with Ada.Strings.Unbounded;
with Ada.Exceptions;
with EL.Functions;
limited with EL.Variables;
package EL.Contexts is

   pragma Preelaborate;

   use EL.Objects;
   use Ada.Strings.Unbounded;

   type ELContext;

   --  ------------------------------
   --  Expression Resolver
   --  ------------------------------
   --  Enables customization of variable and property resolution
   --  behavior for EL expression evaluation.
   type ELResolver is interface;
   type ELResolver_Access is access all ELResolver'Class;

   --  Get the value associated with a base object and a given property.
   function Get_Value (Resolver : ELResolver;
                       Context  : ELContext'Class;
                       Base     : access Util.Beans.Basic.Readonly_Bean'Class;
                       Name     : Unbounded_String) return EL.Objects.Object is abstract;

   --  Set the value associated with a base object and a given property.
   procedure Set_Value (Resolver : in out ELResolver;
                        Context  : in ELContext'Class;
                        Base     : access Util.Beans.Basic.Bean'Class;
                        Name     : in Unbounded_String;
                        Value    : in EL.Objects.Object) is abstract;

   --  ------------------------------
   --  Expression Context
   --  ------------------------------
   --  Context information for expression evaluation.
   type ELContext is limited interface;
   type ELContext_Access is access all ELContext'Class;

   --  Retrieves the ELResolver associated with this ELcontext.
   function Get_Resolver (Context : ELContext) return ELResolver_Access is abstract;

   --  Retrieves the VariableMapper associated with this ELContext.
   function Get_Variable_Mapper (Context : ELContext)
                            return access EL.Variables.Variable_Mapper'Class is abstract;

   --  Set the variable mapper associated with this ELContext.
   procedure Set_Variable_Mapper (Context : in out ELContext;
                                  Mapper  : access EL.Variables.Variable_Mapper'Class)
     is abstract;

   --  Retrieves the FunctionMapper associated with this ELContext.
   --  The FunctionMapper is only used when parsing an expression.
   function Get_Function_Mapper (Context : ELContext)
                                 return EL.Functions.Function_Mapper_Access is abstract;

   --  Set the function mapper associated with this ELContext.
   procedure Set_Function_Mapper (Context : in out ELContext;
                                  Mapper  : access EL.Functions.Function_Mapper'Class)
     is abstract;

   --  Handle the exception during expression evaluation.  The handler can ignore the
   --  exception or raise it.
   procedure Handle_Exception (Context : in ELContext;
                               Ex      : in Ada.Exceptions.Exception_Occurrence) is abstract;

end EL.Contexts;

-----------------------------------------------------------------------
--  EL.Contexts -- Contexts for evaluating an expression
--  Copyright (C) 2009, 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.
-----------------------------------------------------------------------

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

with EL.Objects;
with Util.Beans.Basic;
with Ada.Strings.Unbounded;
with Ada.Exceptions;
with EL.Functions;
limited with EL.Variables;
package EL.Contexts is

   pragma Preelaborate;

   use EL.Objects;
   use Ada.Strings.Unbounded;

   type ELContext;

   --  ------------------------------
   --  Expression Resolver
   --  ------------------------------
   --  Enables customization of variable and property resolution
   --  behavior for EL expression evaluation.
   type ELResolver is limited interface;
   type ELResolver_Access is access all ELResolver'Class;

   --  Get the value associated with a base object and a given property.
   function Get_Value (Resolver : ELResolver;
                       Context  : ELContext'Class;
                       Base     : access Util.Beans.Basic.Readonly_Bean'Class;
                       Name     : Unbounded_String) return EL.Objects.Object is abstract;

   --  Set the value associated with a base object and a given property.
   procedure Set_Value (Resolver : in out ELResolver;
                        Context  : in ELContext'Class;
                        Base     : access Util.Beans.Basic.Bean'Class;
                        Name     : in Unbounded_String;
                        Value    : in EL.Objects.Object) is abstract;

   --  ------------------------------
   --  Expression Context
   --  ------------------------------
   --  Context information for expression evaluation.
   type ELContext is limited interface;
   type ELContext_Access is access all ELContext'Class;

   --  Retrieves the ELResolver associated with this ELcontext.
   function Get_Resolver (Context : ELContext) return ELResolver_Access is abstract;

   --  Retrieves the VariableMapper associated with this ELContext.
   function Get_Variable_Mapper (Context : ELContext)
                            return access EL.Variables.Variable_Mapper'Class is abstract;

   --  Set the variable mapper associated with this ELContext.
   procedure Set_Variable_Mapper (Context : in out ELContext;
                                  Mapper  : access EL.Variables.Variable_Mapper'Class)
     is abstract;

   --  Retrieves the FunctionMapper associated with this ELContext.
   --  The FunctionMapper is only used when parsing an expression.
   function Get_Function_Mapper (Context : ELContext)
                                 return EL.Functions.Function_Mapper_Access is abstract;

   --  Set the function mapper associated with this ELContext.
   procedure Set_Function_Mapper (Context : in out ELContext;
                                  Mapper  : access EL.Functions.Function_Mapper'Class)
     is abstract;

   --  Handle the exception during expression evaluation.  The handler can ignore the
   --  exception or raise it.
   procedure Handle_Exception (Context : in ELContext;
                               Ex      : in Ada.Exceptions.Exception_Occurrence) is abstract;

end EL.Contexts;

Change the ELResolver to a limited interface


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

package Util.Log.Locations is

   --  ------------------------------
   --  Source line information
   --  ------------------------------
   type File_Info (<>) is limited private;
   type File_Info_Access is access all File_Info;

   --  Create a File_Info record to identify the file whose path is Path
   --  and whose relative path portion starts at Relative_Position.
   function Create_File_Info (Path              : in String;
                              Relative_Position : in Natural) return File_Info_Access;

   --  Get the relative path name
   function Relative_Path (File : in File_Info) return String;

   type Line_Info is private;

   --  Get the line number
   function Line (Info : in Line_Info) return Natural;

   --  Get the column number
   function Column (Info : in Line_Info) return Natural;

   --  Get the source file
   function File (Info : in Line_Info) return String;

   --  Create a source line information.
   function Create_Line_Info (File   : in File_Info_Access;
                              Line   : in Natural;
                              Column : in Natural := 0) return Line_Info;

   --  Get a printable representation of the line information using
   --  the format:
   --    <path>:<line>[:<column>]
   --  The path can be reported as relative or absolute path.
   --  The column is optional and reported by default.
   function To_String (Info     : in Line_Info;
                       Relative : in Boolean := True;
                       Column   : in Boolean := True) return String;

private
   pragma Inline (Line);
   pragma Inline (File);

   type File_Info (Length : Natural) is limited record
      Relative_Pos : Natural;
      Path         : String (1 .. Length);
   end record;

   NO_FILE : aliased File_Info := File_Info '(Length => 0, Path => "", Relative_Pos => 0);

   type Line_Info is record
      Line   : Natural := 0;
      Column : Natural := 0;
      File   : File_Info_Access := NO_FILE'Access;
   end record;

end Util.Log.Locations;

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

package Util.Log.Locations is

   --  ------------------------------
   --  Source line information
   --  ------------------------------
   type File_Info (<>) is limited private;
   type File_Info_Access is access all File_Info;

   --  Create a File_Info record to identify the file whose path is Path
   --  and whose relative path portion starts at Relative_Position.
   function Create_File_Info (Path              : in String;
                              Relative_Position : in Natural) return File_Info_Access;

   --  Get the relative path name
   function Relative_Path (File : in File_Info) return String;

   type Line_Info is private;

   --  Get the line number
   function Line (Info : in Line_Info) return Natural;

   --  Get the column number
   function Column (Info : in Line_Info) return Natural;

   --  Get the source file
   function File (Info : in Line_Info) return String;

   --  Compare the two source location.  The comparison is made on:
   --  o the source file,
   --  o the line number,
   --  o the column.
   function "<" (Left, Right : in Line_Info) return Boolean;

   --  Create a source line information.
   function Create_Line_Info (File   : in File_Info_Access;
                              Line   : in Natural;
                              Column : in Natural := 0) return Line_Info;

   --  Get a printable representation of the line information using
   --  the format:
   --    <path>:<line>[:<column>]
   --  The path can be reported as relative or absolute path.
   --  The column is optional and reported by default.
   function To_String (Info     : in Line_Info;
                       Relative : in Boolean := True;
                       Column   : in Boolean := True) return String;

private
   pragma Inline (Line);
   pragma Inline (File);

   type File_Info (Length : Natural) is limited record
      Relative_Pos : Natural;
      Path         : String (1 .. Length);
   end record;

   NO_FILE : aliased File_Info := File_Info '(Length => 0, Path => "", Relative_Pos => 0);

   type Line_Info is record
      Line   : Natural := 0;
      Column : Natural := 0;
      File   : File_Info_Access := NO_FILE'Access;
   end record;

end Util.Log.Locations;

Declare the "<" function to compare two source locations


-----------------------------------------------------------------------
--  mat-types -- Global types
--  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.IO_Exceptions;

with MAT.Commands;
with MAT.Targets;
with MAT.Consoles.Text;
with MAT.Readers.Streams.Sockets;
procedure Matp is
   Target  : MAT.Targets.Target_Type;
   Options : MAT.Commands.Options_Type;
   Console : aliased MAT.Consoles.Text.Console_Type;
   Server  : MAT.Readers.Streams.Sockets.Socket_Listener_Type;
begin
   Target.Console (Console'Unchecked_Access);
   MAT.Commands.Initialize_Options (Target, Options);
   Server.Start (Options.Address);
   MAT.Commands.Interactive (Target);
   Server.Stop;

exception
   when Ada.IO_Exceptions.End_Error | MAT.Commands.Usage_Error =>
      Server.Stop;
end Matp;

-----------------------------------------------------------------------
--  mat-types -- Global types
--  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.IO_Exceptions;

with MAT.Commands;
with MAT.Targets;
with MAT.Consoles.Text;
with MAT.Readers.Streams.Sockets;
procedure Matp is
   Target  : MAT.Targets.Target_Type;
   Options : MAT.Commands.Options_Type;
   Console : aliased MAT.Consoles.Text.Console_Type;
   Server  : MAT.Readers.Streams.Sockets.Socket_Listener_Type;
begin
   Target.Console (Console'Unchecked_Access);
   MAT.Commands.Initialize_Options (Target, Options);
   MAT.Commands.Initialize_Files (Target);
   Server.Start (Options.Address);
   MAT.Commands.Interactive (Target);
   Server.Stop;

exception
   when Ada.IO_Exceptions.End_Error | MAT.Commands.Usage_Error =>
      Server.Stop;
end Matp;

Load the MAT files passed in the command line argument


-----------------------------------------------------------------------
--  wiki-render -- Wiki renderer
--  Copyright (C) 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.Strings.Wide_Wide_Unbounded;
with Wiki.Nodes;
package Wiki.Render is

   pragma Preelaborate;

   use Ada.Strings.Wide_Wide_Unbounded;

   type Link_Renderer is limited interface;
   type Link_Renderer_Access is access all Link_Renderer'Class;

   --  Get the image link that must be rendered from the wiki image link.
   procedure Make_Image_Link (Renderer : in Link_Renderer;
                              Link     : in Unbounded_Wide_Wide_String;
                              URI      : out Unbounded_Wide_Wide_String;
                              Width    : out Natural;
                              Height   : out Natural) is abstract;

   --  Get the page link that must be rendered from the wiki page link.
   procedure Make_Page_Link (Renderer : in Link_Renderer;
                             Link     : in Wide_Wide_String;
                             URI      : out Unbounded_Wide_Wide_String;
                             Exists   : out Boolean) is abstract;

   type Default_Link_Renderer is new Link_Renderer with null record;

   --  Get the image link that must be rendered from the wiki image link.
   overriding
   procedure Make_Image_Link (Renderer : in Default_Link_Renderer;
                              Link     : in Unbounded_Wide_Wide_String;
                              URI      : out Unbounded_Wide_Wide_String;
                              Width    : out Natural;
                              Height   : out Natural);

   --  Get the page link that must be rendered from the wiki page link.
   overriding
   procedure Make_Page_Link (Renderer : in Default_Link_Renderer;
                             Link     : in Wide_Wide_String;
                             URI      : out Unbounded_Wide_Wide_String;
                             Exists   : out Boolean);

   --  ------------------------------
   --  Document renderer
   --  ------------------------------
   type Renderer is limited interface;
   type Renderer_Access is access all Renderer'Class;

   --  Render the node instance from the document.
   procedure Render (Engine : in out Renderer;
                     Doc    : in Wiki.Nodes.Document;
                     Node   : in Wiki.Nodes.Node_Type) is abstract;

   --  Finish the rendering after complete wiki document nodes are rendered.
   procedure Finish (Document : in out Renderer) is abstract;

   --  Render the list of nodes from the document.
   procedure Render (Engine : in out Renderer'Class;
                     Doc    : in Wiki.Nodes.Document;
                     List   : in Wiki.Nodes.Node_List_Access);

   --  Render the document.
   procedure Render (Engine : in out Renderer'Class;
                     Doc    : in Wiki.Nodes.Document);

end Wiki.Render;

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

   pragma Preelaborate;

   use Ada.Strings.Wide_Wide_Unbounded;

   type Link_Renderer is limited interface;
   type Link_Renderer_Access is access all Link_Renderer'Class;

   --  Get the image link that must be rendered from the wiki image link.
   procedure Make_Image_Link (Renderer : in Link_Renderer;
                              Link     : in Wide_Wide_String;
                              URI      : out Unbounded_Wide_Wide_String;
                              Width    : out Natural;
                              Height   : out Natural) is abstract;

   --  Get the page link that must be rendered from the wiki page link.
   procedure Make_Page_Link (Renderer : in Link_Renderer;
                             Link     : in Wide_Wide_String;
                             URI      : out Unbounded_Wide_Wide_String;
                             Exists   : out Boolean) is abstract;

   type Default_Link_Renderer is new Link_Renderer with null record;

   --  Get the image link that must be rendered from the wiki image link.
   overriding
   procedure Make_Image_Link (Renderer : in Default_Link_Renderer;
                              Link     : in Wide_Wide_String;
                              URI      : out Unbounded_Wide_Wide_String;
                              Width    : out Natural;
                              Height   : out Natural);

   --  Get the page link that must be rendered from the wiki page link.
   overriding
   procedure Make_Page_Link (Renderer : in Default_Link_Renderer;
                             Link     : in Wide_Wide_String;
                             URI      : out Unbounded_Wide_Wide_String;
                             Exists   : out Boolean);

   --  ------------------------------
   --  Document renderer
   --  ------------------------------
   type Renderer is limited interface;
   type Renderer_Access is access all Renderer'Class;

   --  Render the node instance from the document.
   procedure Render (Engine : in out Renderer;
                     Doc    : in Wiki.Nodes.Document;
                     Node   : in Wiki.Nodes.Node_Type) is abstract;

   --  Finish the rendering after complete wiki document nodes are rendered.
   procedure Finish (Document : in out Renderer) is abstract;

   --  Render the list of nodes from the document.
   procedure Render (Engine : in out Renderer'Class;
                     Doc    : in Wiki.Nodes.Document;
                     List   : in Wiki.Nodes.Node_List_Access);

   --  Render the document.
   procedure Render (Engine : in out Renderer'Class;
                     Doc    : in Wiki.Nodes.Document);

end Wiki.Render;

Change the Link_Renderer interface to use a Wide_Wide_String for the link


with HAL;           use HAL;
with Virtual_File_System; use Virtual_File_System;
with HAL.Filesystem; use HAL.Filesystem;
with Semihosting;
with Semihosting.Filesystem; use Semihosting.Filesystem;
with File_Block_Drivers; use File_Block_Drivers;
with Partitions; use Partitions;

procedure Main is

   procedure List_Dir (FS : in out FS_Driver'Class;
                       Path : Pathname);
   --  List files in directory

   procedure List_Partitions (FS : in out FS_Driver'Class;
                              Path_To_Disk_Image : Pathname);
   --  List partition in a disk file

   --------------
   -- List_Dir --
   --------------

   procedure List_Dir (FS : in out FS_Driver'Class; Path : Pathname) is
      Status : Status_Kind;
      DH : Directory_Handle_Ref;
   begin
      Status := FS.Open_Directory (Path, DH);
      if Status /= Status_Ok then
         Semihosting.Log_Line ("Open Directory '" & Path & "' Error: " & Status'Img);
      else
         declare
            Ent : Directory_Entry;
            Index : Positive := 1;
         begin

            Semihosting.Log_Line ("Listing '" & Path & "' content:");
            loop
               Status := DH.Read_Entry (Index, Ent);
               if Status = Status_Ok then
                  Semihosting.Log_Line (" - '" & DH.Entry_Name (Index) & "'");
                  Semihosting.Log_Line ("   Kind: " & Ent.Entry_Type'Img);
               else
                  exit;
               end if;
               Index := Index + 1;
            end loop;
         end;
      end if;
   end List_Dir;

   ---------------------
   -- List_Partitions --
   ---------------------

   procedure List_Partitions (FS : in out FS_Driver'Class;
                              Path_To_Disk_Image : Pathname)
   is
      File : File_Handle_Ref;
   begin
      if FS.Open (Path_To_Disk_Image, Read_Only, File) /= Status_Ok then
         Semihosting.Log_Line ("Cannot open disk image '" &
                                 Path_To_Disk_Image & "'");
         return;
      end if;

      declare
         Disk    : aliased File_Block_Driver (File);
         Nbr     : Natural;
         P_Entry : Partition_Entry;
      begin
         Nbr := Number_Of_Partitions (Disk'Unchecked_Access);
         Semihosting.Log_Line ("Disk '" & Path_To_Disk_Image & "' has " &
                                 Nbr'Img & " parition(s)");

         for Id in 1 .. Nbr loop
            if Get_Partition_Entry (Disk'Unchecked_Access,
                                    Id,
                                    P_Entry) /= Status_Ok
            then
               Semihosting.Log_Line ("Cannot read partition :" & Id'Img);
            else
               Semihosting.Log_Line (" - partition :" & Id'Img);
               Semihosting.Log_Line ("      Status:" & P_Entry.Status'Img);
               Semihosting.Log_Line ("      Kind: " & P_Entry.Kind'Img);
               Semihosting.Log_Line ("      LBA: " & P_Entry.First_Sector_LBA'Img);
               Semihosting.Log_Line ("      Number of sectors: " & P_Entry.Number_Of_Sectors'Img);
            end if;
         end loop;
      end;
   end List_Partitions;

   My_VFS : VFS;
   My_VFS2 : aliased VFS;
   My_VFS3 : aliased VFS;
   My_SHFS : aliased SHFS;
   Status : Status_Kind;
   FH : File_Handle_Ref;
   Data : Byte_Array (1 .. 10);

begin

   --  Mount My_VFS2 in My_VFS1
   Status := My_VFS.Mount (Path       => "vfs2",
                           Filesystem => My_VFS2'Unchecked_Access);
   if Status /= Status_Ok then
      Semihosting.Log_Line ("Mount Error: " & Status'Img);
   end if;

      --  Mount My_VFS3 in My_VFS2
   Status := My_VFS2.Mount (Path       => "vfs3",
                            Filesystem => My_VFS3'Unchecked_Access);
   if Status /= Status_Ok then
      Semihosting.Log_Line ("Mount Error: " & Status'Img);
   end if;

   --  Mount semi-hosting filesystem in My_VFS1
   Status := My_VFS.Mount (Path       => "host",
                            Filesystem => My_SHFS'Unchecked_Access);
   if Status /= Status_Ok then
      Semihosting.Log_Line ("Mount Error: " & Status'Img);
   end if;

   --  List all partitions of a disk image on the host
   List_Partitions (My_VFS, "/host/tmp/disk_8_partitions.img");

   --  Try to unlink a file that doesn't exist in My_VFS2
   Status := My_VFS.Unlink ("/vfs2/no_file");
   if Status /= Status_Ok then
      Semihosting.Log_Line ("Unlink Error: " & Status'Img);
   end if;

   --  Try to unlink a file that doesn't exist in My_VFS3
   Status := My_VFS.Unlink ("/vfs2/vfs3/no_file");
   if Status /= Status_Ok then
      Semihosting.Log_Line ("Unlink Error: " & Status'Img);
   end if;

   --  Open a file on the host
   Status := My_VFS.Open ("/host/tmp/test.shfs", Read_Only, FH);
   if Status /= Status_Ok then
      Semihosting.Log_Line ("Open Error: " & Status'Img);
   end if;

   --  Read the first 10 characters
   Status := FH.Read (Data);
   if Status /= Status_Ok then
      Semihosting.Log_Line ("Read Error: " & Status'Img);
   end if;

   for C of Data loop
      Semihosting.Log (Character'Val (Integer (C)));
   end loop;
   Semihosting.Log_New_Line;

   --  Move file cursor
   Status := FH.Seek (10);
   if Status /= Status_Ok then
      Semihosting.Log_Line ("Seek Error: " & Status'Img);
   end if;

   --  Read 10 characters again
   Status := FH.Read (Data);
   if Status /= Status_Ok then
      Semihosting.Log_Line ("Read Error: " & Status'Img);
   end if;

   for C of Data loop
      Semihosting.Log (Character'Val (Integer (C)));
   end loop;
   Semihosting.Log_New_Line;

   Status := FH.Close;
   if Status /= Status_Ok then
      Semihosting.Log_Line ("Close Error: " & Status'Img);
   end if;

   --  Test directory listing
   List_Dir (My_VFS, "/");
   List_Dir (My_VFS, "/vfs2");
   List_Dir (My_VFS, "/vfs2/");
end Main;

with HAL;           use HAL;
with Virtual_File_System; use Virtual_File_System;
with HAL.Filesystem; use HAL.Filesystem;
with Semihosting;
with Semihosting.Filesystem; use Semihosting.Filesystem;
with File_Block_Drivers; use File_Block_Drivers;
with Partitions; use Partitions;

procedure Main is

   procedure List_Dir (FS : in out FS_Driver'Class;
                       Path : Pathname);
   --  List files in directory

   procedure List_Partitions (FS : in out FS_Driver'Class;
                              Path_To_Disk_Image : Pathname);
   --  List partition in a disk file

   --------------
   -- List_Dir --
   --------------

   procedure List_Dir (FS : in out FS_Driver'Class; Path : Pathname) is
      Status : Status_Kind;
      DH : Directory_Handle_Ref;
   begin
      Status := FS.Open_Directory (Path, DH);
      if Status /= Status_Ok then
         Semihosting.Log_Line ("Open Directory '" & Path & "' Error: " & Status'Img);
      else
         declare
            Ent : Directory_Entry;
            Index : Positive := 1;
         begin

            Semihosting.Log_Line ("Listing '" & Path & "' content:");
            loop
               Status := DH.Read_Entry (Index, Ent);
               if Status = Status_Ok then
                  Semihosting.Log_Line (" - '" & DH.Entry_Name (Index) & "'");
                  Semihosting.Log_Line ("   Kind: " & Ent.Entry_Type'Img);
               else
                  exit;
               end if;
               Index := Index + 1;
            end loop;
         end;
      end if;
   end List_Dir;

   ---------------------
   -- List_Partitions --
   ---------------------

   procedure List_Partitions (FS : in out FS_Driver'Class;
                              Path_To_Disk_Image : Pathname)
   is
      File : File_Handle_Ref;
   begin
      if FS.Open (Path_To_Disk_Image, Read_Only, File) /= Status_Ok then
         Semihosting.Log_Line ("Cannot open disk image '" &
                                 Path_To_Disk_Image & "'");
         return;
      end if;

      declare
         Disk    : aliased File_Block_Driver (File);
         Nbr     : Natural;
         P_Entry : Partition_Entry;
      begin
         Nbr := Number_Of_Partitions (Disk'Unchecked_Access);
         Semihosting.Log_Line ("Disk '" & Path_To_Disk_Image & "' has " &
                                 Nbr'Img & " parition(s)");

         for Id in 1 .. Nbr loop
            if Get_Partition_Entry (Disk'Unchecked_Access,
                                    Id,
                                    P_Entry) /= Status_Ok
            then
               Semihosting.Log_Line ("Cannot read partition :" & Id'Img);
            else
               Semihosting.Log_Line (" - partition :" & Id'Img);
               Semihosting.Log_Line ("      Status:" & P_Entry.Status'Img);
               Semihosting.Log_Line ("      Kind: " & P_Entry.Kind'Img);
               Semihosting.Log_Line ("      LBA: " & P_Entry.First_Sector_LBA'Img);
               Semihosting.Log_Line ("      Number of sectors: " & P_Entry.Number_Of_Sectors'Img);
            end if;
         end loop;
      end;
   end List_Partitions;

   My_VFS : VFS;
   My_VFS2 : aliased VFS;
   My_VFS3 : aliased VFS;
   My_SHFS : aliased SHFS;
   Status : Status_Kind;
   FH : File_Handle_Ref;
   Data : Byte_Array (1 .. 10);

begin

   --  Mount My_VFS2 in My_VFS
   Status := My_VFS.Mount (Path       => "vfs2",
                           Filesystem => My_VFS2'Unchecked_Access);
   if Status /= Status_Ok then
      Semihosting.Log_Line ("Mount Error: " & Status'Img);
   end if;

      --  Mount My_VFS3 in My_VFS2
   Status := My_VFS2.Mount (Path       => "vfs3",
                            Filesystem => My_VFS3'Unchecked_Access);
   if Status /= Status_Ok then
      Semihosting.Log_Line ("Mount Error: " & Status'Img);
   end if;

   --  Mount semi-hosting filesystem in My_VFS
   Status := My_VFS.Mount (Path       => "host",
                            Filesystem => My_SHFS'Unchecked_Access);
   if Status /= Status_Ok then
      Semihosting.Log_Line ("Mount Error: " & Status'Img);
   end if;

   --  List all partitions of a disk image on the host
   List_Partitions (My_VFS, "/host/tmp/disk_8_partitions.img");

   --  Try to unlink a file that doesn't exist in My_VFS2
   Status := My_VFS.Unlink ("/vfs2/no_file");
   if Status /= Status_Ok then
      Semihosting.Log_Line ("Unlink Error: " & Status'Img);
   end if;

   --  Try to unlink a file that doesn't exist in My_VFS3
   Status := My_VFS.Unlink ("/vfs2/vfs3/no_file");
   if Status /= Status_Ok then
      Semihosting.Log_Line ("Unlink Error: " & Status'Img);
   end if;

   --  Open a file on the host
   Status := My_VFS.Open ("/host/tmp/test.shfs", Read_Only, FH);
   if Status /= Status_Ok then
      Semihosting.Log_Line ("Open Error: " & Status'Img);
   end if;

   --  Read the first 10 characters
   Status := FH.Read (Data);
   if Status /= Status_Ok then
      Semihosting.Log_Line ("Read Error: " & Status'Img);
   end if;

   for C of Data loop
      Semihosting.Log (Character'Val (Integer (C)));
   end loop;
   Semihosting.Log_New_Line;

   --  Move file cursor
   Status := FH.Seek (10);
   if Status /= Status_Ok then
      Semihosting.Log_Line ("Seek Error: " & Status'Img);
   end if;

   --  Read 10 characters again
   Status := FH.Read (Data);
   if Status /= Status_Ok then
      Semihosting.Log_Line ("Read Error: " & Status'Img);
   end if;

   for C of Data loop
      Semihosting.Log (Character'Val (Integer (C)));
   end loop;
   Semihosting.Log_New_Line;

   Status := FH.Close;
   if Status /= Status_Ok then
      Semihosting.Log_Line ("Close Error: " & Status'Img);
   end if;

   --  Test directory listing
   List_Dir (My_VFS, "/");
   List_Dir (My_VFS, "/vfs2");
   List_Dir (My_VFS, "/vfs2/");
end Main;

Fix typos

examples/filesystem: Fix typos


-----------------------------------------------------------------------
--  gen-model-enums -- Enum definitions
--  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 Ada.Strings.Unbounded;

with Util.Beans.Objects;

with Gen.Model.List;
with Gen.Model.Mappings;
with Gen.Model.Packages;
package Gen.Model.Enums is

   use Ada.Strings.Unbounded;

   type Enum_Definition;
   type Enum_Definition_Access is access all Enum_Definition'Class;

   --  ------------------------------
   --  Enum value definition
   --  ------------------------------
   type Value_Definition is new Definition with record
      Number : Natural := 0;
      Enum   : Enum_Definition_Access;
   end record;
   type Value_Definition_Access is access all Value_Definition'Class;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : Value_Definition;
                       Name : String) return Util.Beans.Objects.Object;

   package Value_List is new Gen.Model.List (T         => Value_Definition,
                                             T_Access  => Value_Definition_Access);

   --  ------------------------------
   --  Table Definition
   --  ------------------------------
   type Enum_Definition is new Mappings.Mapping_Definition with record
      Values         : aliased Value_List.List_Definition;
      Values_Bean    : Util.Beans.Objects.Object;
      Package_Def    : Gen.Model.Packages.Package_Definition_Access;
      Type_Name      : Unbounded_String;
      Pkg_Name       : Unbounded_String;
   end record;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : Enum_Definition;
                       Name : String) return Util.Beans.Objects.Object;

   --  Prepare the generation of the model.
   overriding
   procedure Prepare (O : in out Enum_Definition);

   --  Initialize the table definition instance.
   overriding
   procedure Initialize (O : in out Enum_Definition);

   --  Add an enum value to this enum definition and return the new value.
   procedure Add_Value (Enum  : in out Enum_Definition;
                        Name  : in String;
                        Value : out Value_Definition_Access);

   --  Create an enum with the given name.
   function Create_Enum (Name : in Unbounded_String) return Enum_Definition_Access;

end Gen.Model.Enums;

-----------------------------------------------------------------------
--  gen-model-enums -- Enum definitions
--  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 Ada.Strings.Unbounded;

with Util.Beans.Objects;

with Gen.Model.List;
with Gen.Model.Mappings;
with Gen.Model.Packages;
package Gen.Model.Enums is

   use Ada.Strings.Unbounded;

   type Enum_Definition;
   type Enum_Definition_Access is access all Enum_Definition'Class;

   --  ------------------------------
   --  Enum value definition
   --  ------------------------------
   type Value_Definition is new Definition with record
      Number : Natural := 0;
      Enum   : Enum_Definition_Access;
   end record;
   type Value_Definition_Access is access all Value_Definition'Class;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : Value_Definition;
                       Name : String) return Util.Beans.Objects.Object;

   package Value_List is new Gen.Model.List (T         => Value_Definition,
                                             T_Access  => Value_Definition_Access);

   --  ------------------------------
   --  Table Definition
   --  ------------------------------
   type Enum_Definition is new Mappings.Mapping_Definition with record
      Values         : aliased Value_List.List_Definition;
      Values_Bean    : Util.Beans.Objects.Object;
      Package_Def    : Gen.Model.Packages.Package_Definition_Access;
      Type_Name      : Unbounded_String;
      Pkg_Name       : Unbounded_String;
      Sql_Type       : Unbounded_String;
   end record;

   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   overriding
   function Get_Value (From : Enum_Definition;
                       Name : String) return Util.Beans.Objects.Object;

   --  Prepare the generation of the model.
   overriding
   procedure Prepare (O : in out Enum_Definition);

   --  Initialize the table definition instance.
   overriding
   procedure Initialize (O : in out Enum_Definition);

   --  Add an enum value to this enum definition and return the new value.
   procedure Add_Value (Enum  : in out Enum_Definition;
                        Name  : in String;
                        Value : out Value_Definition_Access);

   --  Create an enum with the given name.
   function Create_Enum (Name : in Unbounded_String) return Enum_Definition_Access;

end Gen.Model.Enums;

Add an sql type mapping for the enum

Add an sql type mapping for the enum


-----------------------------------------------------------------------
--  security-random -- Random numbers for nonce, secret keys, token generation
--  Copyright (C) 2017 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Streams;
with Ada.Finalization;
with Ada.Strings.Unbounded;
private with Ada.Numerics.Discrete_Random;
private with Interfaces;

package Security.Random is

   type Generator is limited new Ada.Finalization.Limited_Controlled with private;

   --  Initialize the random generator.
   overriding
   procedure Initialize (Gen : in out Generator);

   --  Fill the array with pseudo-random numbers.
   procedure Generate (Gen  : in out Generator;
                       Into : out Ada.Streams.Stream_Element_Array);

   --  Generate a random sequence of bits and convert the result
   --  into a string in base64url.
   function Generate (Gen  : in out Generator'Class;
                      Bits : in Positive) return String;

   --  Generate a random sequence of bits, convert the result
   --  into a string in base64url and append it to the buffer.
   procedure Generate (Gen  : in out Generator'Class;
                       Bits : in Positive;
                       Into : in out Ada.Strings.Unbounded.Unbounded_String);

private

   package Id_Random is new Ada.Numerics.Discrete_Random (Interfaces.Unsigned_32);

   --  Protected type to allow using the random generator by several tasks.
   protected type Raw_Generator is

      procedure Generate (Into : out Ada.Streams.Stream_Element_Array);

      procedure Reset;
   private
      --  Random number generator used for ID generation.
      Rand  : Id_Random.Generator;
   end Raw_Generator;

   type Generator is limited new Ada.Finalization.Limited_Controlled with record
      Rand : Raw_Generator;
   end record;

end Security.Random;

-----------------------------------------------------------------------
--  security-random -- Random numbers for nonce, secret keys, token generation
--  Copyright (C) 2017 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Streams;
with Ada.Finalization;
with Ada.Strings.Unbounded;
private with Ada.Numerics.Discrete_Random;
private with Interfaces;

--  == Random Generator ==
--  The <tt>Security.Random</tt> package defines the <tt>Generator</tt> tagged type
--  which provides operations to generate random tokens intended to be used for
--  a nonce, access token, salt or other purposes.  The generator is intended to be
--  used in multi-task environments as it implements the low level random generation
--  within a protected type.  The generator defines a <tt>Generate</tt> operation
--  that returns either a binary random array or the base64url encoding of the
--  binary array.
package Security.Random is

   type Generator is limited new Ada.Finalization.Limited_Controlled with private;

   --  Initialize the random generator.
   overriding
   procedure Initialize (Gen : in out Generator);

   --  Fill the array with pseudo-random numbers.
   procedure Generate (Gen  : in out Generator;
                       Into : out Ada.Streams.Stream_Element_Array);

   --  Generate a random sequence of bits and convert the result
   --  into a string in base64url.
   function Generate (Gen  : in out Generator'Class;
                      Bits : in Positive) return String;

   --  Generate a random sequence of bits, convert the result
   --  into a string in base64url and append it to the buffer.
   procedure Generate (Gen  : in out Generator'Class;
                       Bits : in Positive;
                       Into : in out Ada.Strings.Unbounded.Unbounded_String);

private

   package Id_Random is new Ada.Numerics.Discrete_Random (Interfaces.Unsigned_32);

   --  Protected type to allow using the random generator by several tasks.
   protected type Raw_Generator is

      procedure Generate (Into : out Ada.Streams.Stream_Element_Array);

      procedure Reset;
   private
      --  Random number generator used for ID generation.
      Rand  : Id_Random.Generator;
   end Raw_Generator;

   type Generator is limited new Ada.Finalization.Limited_Controlled with record
      Rand : Raw_Generator;
   end record;

end Security.Random;

Add some documentation

Add some documentation


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

with Util.Streams.Texts;
with Util.Streams.Buffered;
with Util.Serialize.Mappers.Record_Mapper;
package body Util.Serialize.Tools is

   type Object_Field is (FIELD_NAME, FIELD_VALUE);
   type Object_Map_Access is access all Util.Beans.Objects.Maps.Map'Class;

   type Object_Mapper_Context is record
      Map  : Object_Map_Access;
      Name : Util.Beans.Objects.Object;
   end record;
   type Object_Mapper_Context_Access is access all Object_Mapper_Context;

   procedure Set_Member (Into  : in out Object_Mapper_Context;
                         Field : in Object_Field;
                         Value : in Util.Beans.Objects.Object);

   procedure Set_Member (Into  : in out Object_Mapper_Context;
                         Field : in Object_Field;
                         Value : in Util.Beans.Objects.Object) is
   begin
      case Field is
         when FIELD_NAME =>
            Into.Name := Value;

         when FIELD_VALUE =>
            Into.Map.Include (Util.Beans.Objects.To_String (Into.Name), Value);
            Into.Name := Util.Beans.Objects.Null_Object;

      end case;
   end Set_Member;

   package Object_Mapper is new
     Util.Serialize.Mappers.Record_Mapper (Element_Type        => Object_Mapper_Context,
                                           Element_Type_Access => Object_Mapper_Context_Access,
                                           Fields              => Object_Field,
                                           Set_Member          => Set_Member);

   JSON_Mapping : aliased Object_Mapper.Mapper;

   --  -----------------------
   --  Serialize the objects defined in the object map Map into the Output
   --  JSON stream.  Use the Name as the name of the JSON object.
   --  -----------------------
   procedure To_JSON (Output : in out Util.Serialize.IO.JSON.Output_Stream'Class;
                      Name   : in String;
                      Map    : in Util.Beans.Objects.Maps.Map) is
      use type Ada.Containers.Count_Type;

      procedure Write (Name  : in String;
                       Value : in Util.Beans.Objects.Object);

      procedure Write (Name  : in String;
                       Value : in Util.Beans.Objects.Object) is
      begin
         Output.Start_Entity (Name => "");
         Output.Write_Attribute (Name  => "name",
                                 Value => Util.Beans.Objects.To_Object (Name));
         Output.Write_Attribute (Name  => "value",
                                 Value => Value);
         Output.End_Entity (Name => "");
      end Write;

   begin
      if Map.Length > 0 then
         declare
            Iter : Util.Beans.Objects.Maps.Cursor := Map.First;
         begin
            Output.Start_Array (Name => Name);
            while Util.Beans.Objects.Maps.Has_Element (Iter) loop
               Util.Beans.Objects.Maps.Query_Element (Iter, Write'Access);
               Util.Beans.Objects.Maps.Next (Iter);
            end loop;
            Output.End_Array (Name => Name);
         end;
      end if;
   end To_JSON;

   --  -----------------------
   --  Serialize the objects defined in the object map Map into an XML stream.
   --  Returns the JSON string that contains a serialization of the object maps.
   --  -----------------------
   function To_JSON (Map : in Util.Beans.Objects.Maps.Map) return String is
      use type Ada.Containers.Count_Type;
   begin
      if Map.Length = 0 then
         return "";
      end if;
      declare
         Buffer : aliased Util.Streams.Texts.Print_Stream;
         Output : Util.Serialize.IO.JSON.Output_Stream;
      begin
         Buffer.Initialize (Size => 10000);
         Output.Initialize (Buffer'Unchecked_Access);
         Output.Start_Document;
         To_JSON (Output, "params", Map);
         Output.End_Document;
         return Util.Streams.Texts.To_String (Util.Streams.Buffered.Buffered_Stream (Buffer));
      end;
   end To_JSON;

   --  -----------------------
   --  Deserializes the JSON content passed in Content and restore the object map
   --  with their values.  The object map passed in Map can contain existing values.
   --  They will be overriden by the JSON values.
   --  -----------------------
   procedure From_JSON (Content : in String;
                        Map     : in out Util.Beans.Objects.Maps.Map) is
      Parser  : Util.Serialize.IO.JSON.Parser;
      Mapper  : Util.Serialize.Mappers.Processing;
      Context : aliased Object_Mapper_Context;
   begin
      if Content'Length > 0 then
         Context.Map := Map'Unchecked_Access;
         Mapper.Add_Mapping ("**", JSON_Mapping'Access);
         Object_Mapper.Set_Context (Mapper, Context'Unchecked_Access);
         Parser.Parse_String (Content, Mapper);
      end if;
   end From_JSON;

   --  -----------------------
   --  Deserializes the JSON content passed in Content and restore the object map
   --  with their values.
   --  Returns the object map that was restored.
   --  -----------------------
   function From_JSON (Content : in String) return Util.Beans.Objects.Maps.Map is
      Result  : Util.Beans.Objects.Maps.Map;
   begin
      From_JSON (Content, Result);
      return Result;
   end From_JSON;

begin
   JSON_Mapping.Add_Mapping ("name", FIELD_NAME);
   JSON_Mapping.Add_Mapping ("value", FIELD_VALUE);
end Util.Serialize.Tools;

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

with Util.Streams.Texts;
with Util.Serialize.Mappers.Record_Mapper;
package body Util.Serialize.Tools is

   type Object_Field is (FIELD_NAME, FIELD_VALUE);
   type Object_Map_Access is access all Util.Beans.Objects.Maps.Map'Class;

   type Object_Mapper_Context is record
      Map  : Object_Map_Access;
      Name : Util.Beans.Objects.Object;
   end record;
   type Object_Mapper_Context_Access is access all Object_Mapper_Context;

   procedure Set_Member (Into  : in out Object_Mapper_Context;
                         Field : in Object_Field;
                         Value : in Util.Beans.Objects.Object);

   procedure Set_Member (Into  : in out Object_Mapper_Context;
                         Field : in Object_Field;
                         Value : in Util.Beans.Objects.Object) is
   begin
      case Field is
         when FIELD_NAME =>
            Into.Name := Value;

         when FIELD_VALUE =>
            Into.Map.Include (Util.Beans.Objects.To_String (Into.Name), Value);
            Into.Name := Util.Beans.Objects.Null_Object;

      end case;
   end Set_Member;

   package Object_Mapper is new
     Util.Serialize.Mappers.Record_Mapper (Element_Type        => Object_Mapper_Context,
                                           Element_Type_Access => Object_Mapper_Context_Access,
                                           Fields              => Object_Field,
                                           Set_Member          => Set_Member);

   JSON_Mapping : aliased Object_Mapper.Mapper;

   --  -----------------------
   --  Serialize the objects defined in the object map Map into the Output
   --  JSON stream.  Use the Name as the name of the JSON object.
   --  -----------------------
   procedure To_JSON (Output : in out Util.Serialize.IO.JSON.Output_Stream'Class;
                      Name   : in String;
                      Map    : in Util.Beans.Objects.Maps.Map) is
      use type Ada.Containers.Count_Type;

      procedure Write (Name  : in String;
                       Value : in Util.Beans.Objects.Object);

      procedure Write (Name  : in String;
                       Value : in Util.Beans.Objects.Object) is
      begin
         Output.Start_Entity (Name => "");
         Output.Write_Attribute (Name  => "name",
                                 Value => Util.Beans.Objects.To_Object (Name));
         Output.Write_Attribute (Name  => "value",
                                 Value => Value);
         Output.End_Entity (Name => "");
      end Write;

   begin
      if Map.Length > 0 then
         declare
            Iter : Util.Beans.Objects.Maps.Cursor := Map.First;
         begin
            Output.Start_Array (Name => Name);
            while Util.Beans.Objects.Maps.Has_Element (Iter) loop
               Util.Beans.Objects.Maps.Query_Element (Iter, Write'Access);
               Util.Beans.Objects.Maps.Next (Iter);
            end loop;
            Output.End_Array (Name => Name);
         end;
      end if;
   end To_JSON;

   --  -----------------------
   --  Serialize the objects defined in the object map Map into an XML stream.
   --  Returns the JSON string that contains a serialization of the object maps.
   --  -----------------------
   function To_JSON (Map : in Util.Beans.Objects.Maps.Map) return String is
      use type Ada.Containers.Count_Type;
   begin
      if Map.Length = 0 then
         return "";
      end if;
      declare
         Buffer : aliased Util.Streams.Texts.Print_Stream;
         Output : Util.Serialize.IO.JSON.Output_Stream;
      begin
         Buffer.Initialize (Size => 10000);
         Output.Initialize (Buffer'Unchecked_Access);
         Output.Start_Document;
         To_JSON (Output, "params", Map);
         Output.End_Document;
         return Util.Streams.Texts.To_String (Buffer);
      end;
   end To_JSON;

   --  -----------------------
   --  Deserializes the JSON content passed in Content and restore the object map
   --  with their values.  The object map passed in Map can contain existing values.
   --  They will be overriden by the JSON values.
   --  -----------------------
   procedure From_JSON (Content : in String;
                        Map     : in out Util.Beans.Objects.Maps.Map) is
      Parser  : Util.Serialize.IO.JSON.Parser;
      Mapper  : Util.Serialize.Mappers.Processing;
      Context : aliased Object_Mapper_Context;
   begin
      if Content'Length > 0 then
         Context.Map := Map'Unchecked_Access;
         Mapper.Add_Mapping ("**", JSON_Mapping'Access);
         Object_Mapper.Set_Context (Mapper, Context'Unchecked_Access);
         Parser.Parse_String (Content, Mapper);
      end if;
   end From_JSON;

   --  -----------------------
   --  Deserializes the JSON content passed in Content and restore the object map
   --  with their values.
   --  Returns the object map that was restored.
   --  -----------------------
   function From_JSON (Content : in String) return Util.Beans.Objects.Maps.Map is
      Result  : Util.Beans.Objects.Maps.Map;
   begin
      From_JSON (Content, Result);
      return Result;
   end From_JSON;

begin
   JSON_Mapping.Add_Mapping ("name", FIELD_NAME);
   JSON_Mapping.Add_Mapping ("value", FIELD_VALUE);
end Util.Serialize.Tools;

Remove conversion to Buffered_Stream (not necessary anymore)


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

with Ada.IO_Exceptions;
with ASF.Server.Web;
with ASF.Servlets;
with ASF.Servlets.Faces;
with ASF.Servlets.Files;
with ASF.Servlets.Measures;
with ASF.Filters.Dump;
with ASF.Beans;
with ASF.Applications;
with ASF.Applications.Main;
with ASF.Applications.Main.Configs;
with ASF.Security.Servlets;

with Util.Beans.Objects;
with Util.Log.Loggers;

with AWS.Net.SSL;

with Upload_Servlet;
with Countries;
with Volume;
with Messages;
with Facebook;
--  with Images;
with Users;
procedure Demo_Server is

   CONTEXT_PATH : constant String := "/demo";
   CONFIG_PATH  : constant String := "samples.properties";

   Log          : Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Openid");

   Factory      : ASF.Applications.Main.Application_Factory;
   C            : ASF.Applications.Config;

   --  Application servlets.
   App          : aliased ASF.Applications.Main.Application;
   Faces        : aliased ASF.Servlets.Faces.Faces_Servlet;
   Files        : aliased ASF.Servlets.Files.File_Servlet;
   Auth         : aliased ASF.Security.Servlets.Request_Auth_Servlet;
   Verify_Auth  : aliased ASF.Security.Servlets.Verify_Auth_Servlet;
   Perf         : aliased ASF.Servlets.Measures.Measure_Servlet;
   Upload       : aliased Upload_Servlet.Servlet;

   --  Debug filters.
   Dump         : aliased ASF.Filters.Dump.Dump_Filter;

   FB_Auth      : aliased Facebook.Facebook_Auth;
   Bean         : aliased Volume.Compute_Bean;
   Conv         : aliased Volume.Float_Converter;
   None         : ASF.Beans.Parameter_Bean_Ref.Ref;

   --  Web application server
   WS           : ASF.Server.Web.AWS_Container;
begin
   if not AWS.Net.SSL.Is_Supported then
      Log.Error ("SSL is not supported by AWS.");
      Log.Error ("SSL is required for the OpenID connector to connect to OpenID providers.");
      Log.Error ("Please, rebuild AWS with SSL support.");
      return;
   end if;
   C.Set (ASF.Applications.VIEW_EXT, ".html");
   C.Set (ASF.Applications.VIEW_DIR, "samples/web");
   C.Set ("web.dir", "samples/web");
   begin
      C.Load_Properties (CONFIG_PATH);
      Util.Log.Loggers.Initialize (CONFIG_PATH);

   exception
      when Ada.IO_Exceptions.Name_Error =>
         Log.Error ("Cannot read application configuration file {0}", CONFIG_PATH);

   end;
   C.Set ("contextPath", CONTEXT_PATH);
   App.Initialize (C, Factory);
   App.Set_Global ("contextPath", CONTEXT_PATH);
   App.Set_Global ("compute",
                   Util.Beans.Objects.To_Object (Bean'Unchecked_Access,
                                                 Util.Beans.Objects.STATIC));

   FB_Auth.Set_Application_Identifier (C.Get ("facebook.client_id"));
   FB_Auth.Set_Application_Secret (C.Get ("facebook.secret"));
   FB_Auth.Set_Application_Callback (C.Get ("facebook.callback"));
   FB_Auth.Set_Provider_URI ("https://graph.facebook.com/oauth/access_token");

   App.Set_Global ("facebook",
                   Util.Beans.Objects.To_Object (FB_Auth'Unchecked_Access,
                                                 Util.Beans.Objects.STATIC));

   App.Set_Global ("countries", Util.Beans.Objects.To_Object (Countries.Create_Country_List));
   App.Set_Global ("user",
                   Util.Beans.Objects.To_Object (Users.User'Access, Util.Beans.Objects.STATIC));

   --  Declare a global bean to identify this sample from within the XHTML files.
   App.Set_Global ("sampleName", "volume");

   --  Register the servlets and filters
   App.Add_Servlet (Name => "faces", Server => Faces'Unchecked_Access);
   App.Add_Servlet (Name => "files", Server => Files'Unchecked_Access);
   App.Add_Filter (Name => "dump", Filter => Dump'Unchecked_Access);
   App.Add_Servlet (Name => "perf", Server => Perf'Unchecked_Access);
   App.Add_Filter (Name => "perf", Filter => Perf'Unchecked_Access);
   App.Add_Servlet (Name => "auth", Server => Auth'Unchecked_Access);
   App.Add_Servlet (Name => "upload", Server => Upload'Unchecked_Access);
   App.Add_Servlet (Name => "verify-auth", Server => Verify_Auth'Unchecked_Access);

   --  Define servlet mappings
   App.Add_Mapping (Name => "faces", Pattern => "*.html");
   App.Add_Mapping (Name => "files", Pattern => "*.css");
   App.Add_Mapping (Name => "files", Pattern => "*.js");
   App.Add_Mapping (Name => "files", Pattern => "*.png");
   App.Add_Mapping (Name => "verify-auth", Pattern => "/auth/verify");
   App.Add_Mapping (Name => "auth", Pattern => "/auth/auth/*");
   App.Add_Mapping (Name => "perf", Pattern => "/statistics.xml");
   App.Add_Mapping (Name => "upload", Pattern => "upload.html");
   App.Add_Filter_Mapping (Name => "dump", Pattern => "*.html");
   App.Add_Filter_Mapping (Name => "dump", Pattern => "*.js");

   App.Add_Filter_Mapping (Name => "perf", Pattern => "/auth/verify");
   App.Add_Filter_Mapping (Name => "dump", Pattern => "/auth/verify");

   App.Add_Filter_Mapping (Name => "perf", Pattern => "/auth/auth/*");
   App.Add_Filter_Mapping (Name => "dump", Pattern => "/auth/auth/*");

   App.Add_Converter (Name => "float", Converter => Conv'Unchecked_Access);

   --  App.Register_Class (Name => "Image_Bean", Handler => Images.Create_Image_Bean'Access);
   App.Register_Class (Name => "Message_Bean", Handler => Messages.Create_Message_Bean'Access);
   App.Register_Class (Name => "Message_List", Handler => Messages.Create_Message_List'Access);
   App.Register_Class (Name => "Friends_Bean", Handler => Facebook.Create_Friends_Bean'Access);
   App.Register_Class (Name => "Feeds_Bean", Handler => Facebook.Create_Feed_List_Bean'Access);

   App.Register (Name => "message", Class => "Message_Bean", Params => None);
   App.Register (Name => "messages", Class => "Message_List", Params => None);
   App.Register (Name => "image", Class => "Image_Bean", Params => None);

   ASF.Applications.Main.Configs.Read_Configuration (App, "samples/web/WEB-INF/web.xml");
   WS.Register_Application (CONTEXT_PATH, App'Unchecked_Access);

   Log.Info ("Connect you browser to: http://localhost:8080/demo/compute.html");
   WS.Start;

   delay 6000.0;

end Demo_Server;

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

with Ada.IO_Exceptions;
with ASF.Server.Web;
with ASF.Servlets;
with ASF.Servlets.Faces;
with ASF.Servlets.Files;
with ASF.Servlets.Measures;
with ASF.Filters.Dump;
with ASF.Beans;
with ASF.Applications;
with ASF.Applications.Main;
with ASF.Applications.Main.Configs;
with ASF.Security.Servlets;

with Util.Beans.Objects;
with Util.Log.Loggers;

with AWS.Net.SSL;

with Upload_Servlet;
with Countries;
with Volume;
with Messages;
with Facebook;
--  with Images;
with Users;
procedure Demo_Server is

   CONTEXT_PATH : constant String := "/demo";
   CONFIG_PATH  : constant String := "samples.properties";

   Log          : Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Openid");

   Factory      : ASF.Applications.Main.Application_Factory;
   C            : ASF.Applications.Config;

   --  Application servlets.
   App          : aliased ASF.Applications.Main.Application;
   Faces        : aliased ASF.Servlets.Faces.Faces_Servlet;
   Files        : aliased ASF.Servlets.Files.File_Servlet;
   Auth         : aliased ASF.Security.Servlets.Request_Auth_Servlet;
   Verify_Auth  : aliased ASF.Security.Servlets.Verify_Auth_Servlet;
   Perf         : aliased ASF.Servlets.Measures.Measure_Servlet;
   Upload       : aliased Upload_Servlet.Servlet;

   --  Debug filters.
   Dump         : aliased ASF.Filters.Dump.Dump_Filter;

   FB_Auth      : aliased Facebook.Facebook_Auth;
   Bean         : aliased Volume.Compute_Bean;
   Conv         : aliased Volume.Float_Converter;
   None         : ASF.Beans.Parameter_Bean_Ref.Ref;

   --  Web application server
   WS           : ASF.Server.Web.AWS_Container;
begin
   if not AWS.Net.SSL.Is_Supported then
      Log.Error ("SSL is not supported by AWS.");
      Log.Error ("SSL is required for the OpenID connector to connect to OpenID providers.");
      Log.Error ("Please, rebuild AWS with SSL support.");
      return;
   end if;
   C.Set (ASF.Applications.VIEW_EXT, ".html");
   C.Set (ASF.Applications.VIEW_DIR, "samples/web");
   C.Set ("web.dir", "samples/web");
   begin
      C.Load_Properties (CONFIG_PATH);
      Util.Log.Loggers.Initialize (CONFIG_PATH);

   exception
      when Ada.IO_Exceptions.Name_Error =>
         Log.Error ("Cannot read application configuration file {0}", CONFIG_PATH);

   end;
   C.Set ("contextPath", CONTEXT_PATH);
   App.Initialize (C, Factory);
   App.Set_Global ("contextPath", CONTEXT_PATH);
   App.Set_Global ("compute",
                   Util.Beans.Objects.To_Object (Bean'Unchecked_Access,
                                                 Util.Beans.Objects.STATIC));

   FB_Auth.Set_Application_Identifier (C.Get ("facebook.client_id"));
   FB_Auth.Set_Application_Secret (C.Get ("facebook.secret"));
   FB_Auth.Set_Application_Callback (C.Get ("facebook.callback"));
   FB_Auth.Set_Provider_URI ("https://graph.facebook.com/oauth/access_token");

   App.Set_Global ("facebook",
                   Util.Beans.Objects.To_Object (FB_Auth'Unchecked_Access,
                                                 Util.Beans.Objects.STATIC));

   App.Set_Global ("countries", Util.Beans.Objects.To_Object (Countries.Create_Country_List));
   App.Set_Global ("user",
                   Util.Beans.Objects.To_Object (Users.User'Access, Util.Beans.Objects.STATIC));

   --  Declare a global bean to identify this sample from within the XHTML files.
   App.Set_Global ("sampleName", "volume");

   --  Register the servlets and filters
   App.Add_Servlet (Name => "faces", Server => Faces'Unchecked_Access);
   App.Add_Servlet (Name => "files", Server => Files'Unchecked_Access);
   App.Add_Filter (Name => "dump", Filter => Dump'Unchecked_Access);
   App.Add_Servlet (Name => "perf", Server => Perf'Unchecked_Access);
   App.Add_Filter (Name => "perf", Filter => Perf'Unchecked_Access);
   App.Add_Servlet (Name => "auth", Server => Auth'Unchecked_Access);
   App.Add_Servlet (Name => "upload", Server => Upload'Unchecked_Access);
   App.Add_Servlet (Name => "verify-auth", Server => Verify_Auth'Unchecked_Access);

   --  Define servlet mappings
   App.Add_Mapping (Name => "faces", Pattern => "*.html");
   App.Add_Mapping (Name => "files", Pattern => "*.css");
   App.Add_Mapping (Name => "files", Pattern => "*.js");
   App.Add_Mapping (Name => "files", Pattern => "*.png");
   App.Add_Mapping (Name => "verify-auth", Pattern => "/auth/verify");
   App.Add_Mapping (Name => "auth", Pattern => "/auth/auth/*");
   App.Add_Mapping (Name => "perf", Pattern => "/statistics.xml");
   App.Add_Mapping (Name => "upload", Pattern => "upload.html");
   App.Add_Filter_Mapping (Name => "dump", Pattern => "*.html");
   App.Add_Filter_Mapping (Name => "dump", Pattern => "*.js");

   App.Add_Filter_Mapping (Name => "perf", Pattern => "/auth/verify");
   App.Add_Filter_Mapping (Name => "dump", Pattern => "/auth/verify");

   App.Add_Filter_Mapping (Name => "perf", Pattern => "/auth/auth/*");
   App.Add_Filter_Mapping (Name => "dump", Pattern => "/auth/auth/*");

   App.Add_Converter (Name => "float", Converter => Conv'Unchecked_Access);

   --  App.Register_Class (Name => "Image_Bean", Handler => Images.Create_Image_Bean'Access);
   App.Register_Class (Name => "Message_Bean", Handler => Messages.Create_Message_Bean'Access);
   App.Register_Class (Name => "Message_List", Handler => Messages.Create_Message_List'Access);
   App.Register_Class (Name => "Friends_Bean", Handler => Facebook.Create_Friends_Bean'Access);
   App.Register_Class (Name => "Feeds_Bean", Handler => Facebook.Create_Feed_List_Bean'Access);

   App.Register (Name => "message", Class => "Message_Bean", Params => None);
   App.Register (Name => "messages", Class => "Message_List", Params => None);

   ASF.Applications.Main.Configs.Read_Configuration (App, "samples/web/WEB-INF/web.xml");
   WS.Register_Application (CONTEXT_PATH, App'Unchecked_Access);

   Log.Info ("Connect you browser to: http://localhost:8080/demo/compute.html");
   WS.Start;

   delay 6000.0;

end Demo_Server;

Fix error when the demo is started

Fix error when the demo is started