-----------------------------------------------------------------------
--  gen-artifacts-docs-googlecode -- Artifact for Googlecode documentation format
--  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.
-----------------------------------------------------------------------

package body Gen.Artifacts.Docs.Googlecode is

   --  ------------------------------
   --  Get the document name from the file document (ex: <name>.wiki or <name>.md).
   --  ------------------------------
   overriding
   function Get_Document_Name (Formatter : in Document_Formatter;
                               Document  : in File_Document) return String is
   begin
      return Ada.Strings.Unbounded.To_String (Document.Name) & ".wiki";
   end Get_Document_Name;

   --  ------------------------------
   --  Start a new document.
   --  ------------------------------
   overriding
   procedure Start_Document (Formatter : in out Document_Formatter;
                             Document  : in File_Document;
                             File      : in Ada.Text_IO.File_Type) is
   begin
      Ada.Text_IO.Put_Line (File, "#summary " & Ada.Strings.Unbounded.To_String (Document.Title));
      Ada.Text_IO.New_Line (File);
   end Start_Document;

   --  ------------------------------
   --  Write a line in the target document formatting the line if necessary.
   --  ------------------------------
   overriding
   procedure Write_Line (Formatter : in out Document_Formatter;
                         File      : in Ada.Text_IO.File_Type;
                         Line      : in Line_Type) is
   begin
      if Line.Kind = L_LIST then
         Ada.Text_IO.New_Line (File);
         Ada.Text_IO.Put (File, Line.Content);
         Formatter.Need_Newline := True;

      elsif Line.Kind = L_LIST_ITEM then
         Ada.Text_IO.Put (File, Line.Content);
         Formatter.Need_Newline := True;

      else
         if Formatter.Need_Newline then
            Ada.Text_IO.New_Line (File);
            Formatter.Need_Newline := False;
         end if;
         Ada.Text_IO.Put_Line (File, Line.Content);
      end if;
   end Write_Line;

   --  ------------------------------
   --  Finish the document.
   --  ------------------------------
   overriding
   procedure Finish_Document (Formatter : in out Document_Formatter;
                              Document  : in File_Document;
                              File      : in Ada.Text_IO.File_Type;
                              Source    : in String) is
   begin
      Ada.Text_IO.New_Line (File);
      Ada.Text_IO.Put_Line (File, "----");
      Ada.Text_IO.Put_Line (File,
                            "[https://github.com/stcarrez/dynamo Generated by Dynamo] from _"
                            & Source & "_");
   end Finish_Document;

end Gen.Artifacts.Docs.Googlecode;

-----------------------------------------------------------------------
--  gen-artifacts-docs-googlecode -- Artifact for Googlecode documentation format
--  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.
-----------------------------------------------------------------------

package body Gen.Artifacts.Docs.Googlecode is

   --  ------------------------------
   --  Get the document name from the file document (ex: <name>.wiki or <name>.md).
   --  ------------------------------
   overriding
   function Get_Document_Name (Formatter : in Document_Formatter;
                               Document  : in File_Document) return String is
   begin
      return Ada.Strings.Unbounded.To_String (Document.Name) & ".wiki";
   end Get_Document_Name;

   --  ------------------------------
   --  Start a new document.
   --  ------------------------------
   overriding
   procedure Start_Document (Formatter : in out Document_Formatter;
                             Document  : in File_Document;
                             File      : in Ada.Text_IO.File_Type) is
   begin
      Ada.Text_IO.Put_Line (File, "#summary " & Ada.Strings.Unbounded.To_String (Document.Title));
      Ada.Text_IO.New_Line (File);
   end Start_Document;

   --  ------------------------------
   --  Write a line in the target document formatting the line if necessary.
   --  ------------------------------
   overriding
   procedure Write_Line (Formatter : in out Document_Formatter;
                         File      : in Ada.Text_IO.File_Type;
                         Line      : in Line_Type) is
   begin
      if Line.Kind = L_LIST then
         Ada.Text_IO.New_Line (File);
         Ada.Text_IO.Put (File, Line.Content);
         Formatter.Need_Newline := True;

      elsif Line.Kind = L_LIST_ITEM then
         Ada.Text_IO.Put (File, Line.Content);
         Formatter.Need_Newline := True;

      elsif Line.Kind = L_START_CODE then
         if Formatter.Need_NewLine then
            Ada.Text_IO.New_Line (File);
            Formatter.Need_Newline := False;
         end if;
         Ada.Text_IO.Put_Line (File, "{{{");

      elsif Line.Kind = L_END_CODE then
         if Formatter.Need_NewLine then
            Ada.Text_IO.New_Line (File);
            Formatter.Need_Newline := False;
         end if;
         Ada.Text_IO.Put_Line (File, "}}}");

      else
         if Formatter.Need_Newline then
            Ada.Text_IO.New_Line (File);
            Formatter.Need_Newline := False;
         end if;
         Ada.Text_IO.Put_Line (File, Line.Content);
      end if;
   end Write_Line;

   --  ------------------------------
   --  Finish the document.
   --  ------------------------------
   overriding
   procedure Finish_Document (Formatter : in out Document_Formatter;
                              Document  : in File_Document;
                              File      : in Ada.Text_IO.File_Type;
                              Source    : in String) is
   begin
      Ada.Text_IO.New_Line (File);
      Ada.Text_IO.Put_Line (File, "----");
      Ada.Text_IO.Put_Line (File,
                            "[https://github.com/stcarrez/dynamo Generated by Dynamo] from _"
                            & Source & "_");
   end Finish_Document;

end Gen.Artifacts.Docs.Googlecode;

Format code according to L_START_CODE and L_END_CODE boundaries


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

with Util.Strings.Transforms;
with GNAT.MD5;

with ASF.Utils;
with ASF.Contexts.Writer;
package body ASF.Components.Widgets.Gravatars is

   IMAGE_ATTRIBUTE_NAMES : Util.Strings.String_Set.Set;

   --  ------------------------------
   --  Given an Email address, return the Gravatar link to the user image.
   --  (See http://en.gravatar.com/site/implement/hash/ and
   --  http://en.gravatar.com/site/implement/images/)
   --  ------------------------------
   function Get_Link (Email  : in String;
                      Secure : in Boolean := False) return String is
      E : constant String := Util.Strings.Transforms.To_Lower_Case (Email);
      C : constant GNAT.MD5.Message_Digest := GNAT.MD5.Digest (E);
   begin
      if Secure then
         return "https://secure.gravatar.com/avatar/" & C;
      else
         return "http://www.gravatar.com/avatar/" & C;
      end if;
   end Get_Link;

   --  ------------------------------
   --  Render an image with the source link created from an email address to the Gravatars service.
   --  ------------------------------
   overriding
   procedure Encode_Begin (UI      : in UIGravatar;
                           Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
      Writer   : constant Contexts.Writer.Response_Writer_Access := Context.Get_Response_Writer;
   begin
      if UI.Is_Rendered (Context) then
         Writer.Start_Element ("img");
         UI.Render_Attributes (Context, IMAGE_ATTRIBUTE_NAMES, Writer);
         declare
            Email   : constant String := UI.Get_Attribute ("email", Context, "");
            Size    : Natural := UI.Get_Attribute ("size", Context, 80);
            Default : constant String := UI.Get_Attribute ("default", Context, "identicon");
            Secure  : constant Boolean := UI.Get_Attribute ("secure", Context, False);
            D       : constant String := Util.Strings.Image (Size);
            Alt     : constant String := UI.Get_Attribute ("alt", Context, "");
         begin
            if Size < 0 or Size > 2048 then
               Size := 80;
            end if;
            Writer.Write_Attribute ("width", D);
            Writer.Write_Attribute ("height", D);
            if Alt'Length > 0 then
               Writer.Write_Attribute ("alt", Alt);
            else
               Writer.Write_Attribute ("alt", Email);
            end if;
            Writer.Write_Attribute ("src", Get_Link (Email, Secure)
                                    & "?d=" & Default & "&s=" & D);
         end;
         Writer.End_Element ("img");
      end if;
   end Encode_Begin;

begin
   Utils.Set_Text_Attributes (IMAGE_ATTRIBUTE_NAMES);
end ASF.Components.Widgets.Gravatars;

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

with Util.Strings.Transforms;
with GNAT.MD5;

with ASF.Utils;
with ASF.Contexts.Writer;
package body ASF.Components.Widgets.Gravatars is

   IMAGE_ATTRIBUTE_NAMES : Util.Strings.String_Set.Set;

   --  ------------------------------
   --  Given an Email address, return the Gravatar link to the user image.
   --  (See http://en.gravatar.com/site/implement/hash/ and
   --  http://en.gravatar.com/site/implement/images/)
   --  ------------------------------
   function Get_Link (Email  : in String;
                      Secure : in Boolean := False) return String is
      E : constant String := Util.Strings.Transforms.To_Lower_Case (Email);
      C : constant GNAT.MD5.Message_Digest := GNAT.MD5.Digest (E);
   begin
      if Secure then
         return "https://secure.gravatar.com/avatar/" & C;
      else
         return "http://www.gravatar.com/avatar/" & C;
      end if;
   end Get_Link;

   --  ------------------------------
   --  Render an image with the source link created from an email address to the Gravatars service.
   --  ------------------------------
   overriding
   procedure Encode_Begin (UI      : in UIGravatar;
                           Context : in out ASF.Contexts.Faces.Faces_Context'Class) is
      Writer   : constant Contexts.Writer.Response_Writer_Access := Context.Get_Response_Writer;
   begin
      if UI.Is_Rendered (Context) then
         Writer.Start_Element ("img");
         UI.Render_Attributes (Context, IMAGE_ATTRIBUTE_NAMES, Writer);
         declare
            Email   : constant String := UI.Get_Attribute ("email", Context, "");
            Size    : Integer := UI.Get_Attribute ("size", Context, 80);
            Default : constant String := UI.Get_Attribute ("default", Context, "identicon");
            Secure  : constant Boolean := UI.Get_Attribute ("secure", Context, False);
            D       : constant String := Util.Strings.Image (Size);
            Alt     : constant String := UI.Get_Attribute ("alt", Context, "");
         begin
            if Size <= 0 or Size > 2048 then
               Size := 80;
            end if;
            Writer.Write_Attribute ("width", D);
            Writer.Write_Attribute ("height", D);
            if Alt'Length > 0 then
               Writer.Write_Attribute ("alt", Alt);
            else
               Writer.Write_Attribute ("alt", Email);
            end if;
            Writer.Write_Attribute ("src", Get_Link (Email, Secure)
                                    & "?d=" & Default & "&s=" & D);
         end;
         Writer.End_Element ("img");
      end if;
   end Encode_Begin;

begin
   Utils.Set_Text_Attributes (IMAGE_ATTRIBUTE_NAMES);
end ASF.Components.Widgets.Gravatars;

Fix compilation warning

Fix compilation warning


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

package Definitions is

   pragma Pure;

   raven_version_major : constant String := "1";
   raven_version_minor : constant String := "47";
   copyright_years     : constant String := "2015-2020";

   raven_tool        : constant String := "ravenadm";
   variant_standard  : constant String := "standard";
   contact_nobody    : constant String := "nobody";
   contact_automaton : constant String := "automaton";
   dlgroup_main      : constant String := "main";
   dlgroup_none      : constant String := "none";
   options_none      : constant String := "none";
   options_all       : constant String := "all";
   broken_all        : constant String := "all";
   boolean_yes       : constant String := "yes";
   homepage_none     : constant String := "none";
   spkg_complete     : constant String := "complete";
   spkg_docs         : constant String := "docs";
   spkg_examples     : constant String := "examples";
   spkg_nls          : constant String := "nls";
   ports_default     : constant String := "floating";
   default_ssl       : constant String := "libressl";
   default_mysql     : constant String := "oracle-8.0";
   default_lua       : constant String := "5.3";
   default_perl      : constant String := "5.30";
   default_pgsql     : constant String := "12";
   default_php       : constant String := "7.4";
   default_python3   : constant String := "3.8";
   default_ruby      : constant String := "2.7";
   default_tcltk     : constant String := "8.6";
   default_firebird  : constant String := "2.5";
   default_binutils  : constant String := "binutils:ravensys";
   default_compiler  : constant String := "gcc9";
   previous_default  : constant String := "gcc8";
   compiler_version  : constant String := "9.3.0";
   previous_compiler : constant String := "9.2.0";
   binutils_version  : constant String := "2.34";
   previous_binutils : constant String := "2.33.1";
   arc_ext           : constant String := ".tzst";
   jobs_per_cpu      : constant := 2;
   task_stack_limit  : constant := 10_000_000;

   type supported_opsys is (dragonfly, freebsd, netbsd, openbsd, sunos, linux, macos);
   type supported_arch  is (x86_64, i386, aarch64);

   type cpu_range is range 1 .. 64;
   type scanners  is range cpu_range'First .. cpu_range'Last;
   type builders  is range cpu_range'First .. cpu_range'Last * jobs_per_cpu;
   type count_type is (total, success, failure, ignored, skipped);

   --  Modify following with post-patch sed accordingly
   platform_type  : constant supported_opsys := dragonfly;
   host_localbase : constant String := "/raven";
   raven_var      : constant String := "/var/ravenports";
   host_pkg8      : constant String := host_localbase & "/sbin/ravensw";
   ravenexec      : constant String := host_localbase & "/libexec/ravenexec";

end Definitions;

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

package Definitions is

   pragma Pure;

   raven_version_major : constant String := "1";
   raven_version_minor : constant String := "47";
   copyright_years     : constant String := "2015-2020";

   raven_tool        : constant String := "ravenadm";
   variant_standard  : constant String := "standard";
   contact_nobody    : constant String := "nobody";
   contact_automaton : constant String := "automaton";
   dlgroup_main      : constant String := "main";
   dlgroup_none      : constant String := "none";
   options_none      : constant String := "none";
   options_all       : constant String := "all";
   broken_all        : constant String := "all";
   boolean_yes       : constant String := "yes";
   homepage_none     : constant String := "none";
   spkg_complete     : constant String := "complete";
   spkg_docs         : constant String := "docs";
   spkg_examples     : constant String := "examples";
   spkg_nls          : constant String := "nls";
   ports_default     : constant String := "floating";
   default_ssl       : constant String := "libressl";
   default_mysql     : constant String := "oracle-8.0";
   default_lua       : constant String := "5.3";
   default_perl      : constant String := "5.30";
   default_pgsql     : constant String := "12";
   default_php       : constant String := "7.4";
   default_python3   : constant String := "3.8";
   default_ruby      : constant String := "2.7";
   default_tcltk     : constant String := "8.6";
   default_firebird  : constant String := "2.5";
   default_binutils  : constant String := "binutils:ravensys";
   default_compiler  : constant String := "gcc9";
   previous_default  : constant String := "gcc9";
   compiler_version  : constant String := "9.3.0";
   previous_compiler : constant String := "9.2.0";
   binutils_version  : constant String := "2.34";
   previous_binutils : constant String := "2.33.1";
   arc_ext           : constant String := ".tzst";
   jobs_per_cpu      : constant := 2;
   task_stack_limit  : constant := 10_000_000;

   type supported_opsys is (dragonfly, freebsd, netbsd, openbsd, sunos, linux, macos);
   type supported_arch  is (x86_64, i386, aarch64);

   type cpu_range is range 1 .. 64;
   type scanners  is range cpu_range'First .. cpu_range'Last;
   type builders  is range cpu_range'First .. cpu_range'Last * jobs_per_cpu;
   type count_type is (total, success, failure, ignored, skipped);

   --  Modify following with post-patch sed accordingly
   platform_type  : constant supported_opsys := dragonfly;
   host_localbase : constant String := "/raven";
   raven_var      : constant String := "/var/ravenports";
   host_pkg8      : constant String := host_localbase & "/sbin/ravensw";
   ravenexec      : constant String := host_localbase & "/libexec/ravenexec";

end Definitions;

Fix previous compiler

Fix previous compiler


-----------------------------------------------------------------------
--  awa-permissions-services -- Permissions controller
--  Copyright (C) 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.
-----------------------------------------------------------------------

with ADO.Queries;
with ADO.Sessions.Entities;
with ADO.Statements;
with Util.Log.Loggers;

with Security.Policies.Roles;
with Security.Policies.URLs;

with AWA.Permissions.Models;
with AWA.Services.Contexts;
package body AWA.Permissions.Services is

   use ADO.Sessions;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Permissions.Services");

   --  ------------------------------
   --  Check if the permission with the name <tt>Name</tt> is granted for the current user.
   --  If the <tt>Entity</tt> is defined, an <tt>Entity_Permission</tt> is created and verified.
   --  Returns True if the user is granted the given permission.
   --  ------------------------------
   function Has_Permission (Name   : in Util.Beans.Objects.Object;
                            Entity : in Util.Beans.Objects.Object)
                            return Util.Beans.Objects.Object is
      use type Security.Contexts.Security_Context_Access;

      Context : constant Security.Contexts.Security_Context_Access := Security.Contexts.Current;
      Perm    : constant String := Util.Beans.Objects.To_String (Name);
      Result  : Boolean;
   begin
      if Util.Beans.Objects.Is_Empty (Name) or Context = null then
         Result := False;

      elsif Util.Beans.Objects.Is_Empty (Entity) then
         Result := Context.Has_Permission (Perm);

      else
         declare
            P : Entity_Permission (Security.Permissions.Get_Permission_Index (Perm));
         begin
            P.Entity := ADO.Identifier (Util.Beans.Objects.To_Long_Long_Integer (Entity));
            Result := Context.Has_Permission (P);
         end;
      end if;
      return Util.Beans.Objects.To_Object (Result);

   exception
      when Security.Permissions.Invalid_Name =>
         Log.Error ("Invalid permission {0}", Perm);
         raise;
   end Has_Permission;

   URI        : aliased constant String := "http://code.google.com/p/ada-awa/auth";

   --  ------------------------------
   --  Register the security EL functions in the EL mapper.
   --  ------------------------------
   procedure Set_Functions (Mapper : in out EL.Functions.Function_Mapper'Class) is
   begin
      Mapper.Set_Function (Name      => "hasPermission",
                           Namespace => URI,
                           Func      => Has_Permission'Access,
                           Optimize  => False);
   end Set_Functions;

   --  ------------------------------
   --  Get the permission manager associated with the security context.
   --  Returns null if there is none.
   --  ------------------------------
   function Get_Permission_Manager (Context : in Security.Contexts.Security_Context'Class)
                                    return Permission_Manager_Access is
      use type Security.Policies.Policy_Manager_Access;

      M : constant Security.Policies.Policy_Manager_Access
        := Context.Get_Permission_Manager;
   begin
      if M = null then
         Log.Info ("There is no permission manager");
         return null;

      elsif not (M.all in Permission_Manager'Class) then
         Log.Info ("Permission manager is not a AWA permission manager");
         return null;

      else
         return Permission_Manager'Class (M.all)'Access;
      end if;
   end Get_Permission_Manager;

   --  ------------------------------
   --  Get the application instance.
   --  ------------------------------
   function Get_Application (Manager : in Permission_Manager)
                             return AWA.Applications.Application_Access is
   begin
      return Manager.App;
   end Get_Application;

   --  ------------------------------
   --  Set the application instance.
   --  ------------------------------
   procedure Set_Application (Manager : in out Permission_Manager;
                              App : in AWA.Applications.Application_Access) is
   begin
      Manager.App := App;
   end Set_Application;

   --  ------------------------------
   --  Add a permission for the current user to access the entity identified by
   --  Entity and Kind.
   --  ------------------------------
   procedure Add_Permission (Manager    : in Permission_Manager;
                             Entity     : in ADO.Identifier;
                             Kind       : in ADO.Entity_Type;
                             Workspace  : in ADO.Identifier;
                             Permission : in Permission_Type) is
      pragma Unreferenced (Manager);

      Ctx  : constant AWA.Services.Contexts.Service_Context_Access
        := AWA.Services.Contexts.Current;
      DB   : Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Perm : AWA.Permissions.Models.ACL_Ref;
   begin
      Log.Info ("Adding permission");

      Ctx.Start;
      Perm.Set_Entity_Type (Kind);
      Perm.Set_User_Id (Ctx.Get_User_Identifier);
      Perm.Set_Entity_Id (Entity);
      Perm.Set_Writeable (Permission = AWA.Permissions.WRITE);
      Perm.Set_Workspace_Id (Workspace);
      Perm.Save (DB);
      Ctx.Commit;
   end Add_Permission;

   --  ------------------------------
   --  Check that the current user has the specified permission.
   --  Raise NO_PERMISSION exception if the user does not have the permission.
   --  ------------------------------
   procedure Check_Permission (Manager    : in Permission_Manager;
                               Entity     : in ADO.Identifier;
                               Kind       : in ADO.Entity_Type;
                               Permission : in Permission_Type) is
      pragma Unreferenced (Manager, Permission);
      use AWA.Services;

      Ctx   : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB    : constant Session := AWA.Services.Contexts.Get_Session (Ctx);
      Query : ADO.Queries.Context;
   begin
      Query.Set_Query (AWA.Permissions.Models.Query_Check_Entity_Permission);
      Query.Bind_Param ("user_id", User);
      Query.Bind_Param ("entity_id", Entity);
      Query.Bind_Param ("entity_type", Integer (Kind));
      declare
         Stmt : ADO.Statements.Query_Statement := DB.Create_Statement (Query);
      begin
         Stmt.Execute;
         if not Stmt.Has_Elements then
            Log.Info ("User {0} does not have permission to access entity {1}/{2}",
                      ADO.Identifier'Image (User), ADO.Identifier'Image (Entity),
                      ADO.Entity_Type'Image (Kind));
            raise NO_PERMISSION;
         end if;
      end;
   end Check_Permission;

   --  ------------------------------
   --  Add a permission for the user User to access the entity identified by
   --  Entity which is of type Kind.
   --  ------------------------------
   procedure Add_Permission (Session    : in out ADO.Sessions.Master_Session;
                             User       : in ADO.Identifier;
                             Entity     : in ADO.Identifier;
                             Kind       : in ADO.Entity_Type;
                             Workspace  : in ADO.Identifier;
                             Permission : in Permission_Type := READ) is
      Acl : AWA.Permissions.Models.ACL_Ref;
   begin
      Acl.Set_User_Id (User);
      Acl.Set_Entity_Type (Kind);
      Acl.Set_Entity_Id (Entity);
      Acl.Set_Writeable (Permission = WRITE);
      Acl.Set_Workspace_Id (Workspace);
      Acl.Save (Session);

      Log.Info ("Permission created for {0} to access {1}, entity type {2}",
                ADO.Identifier'Image (User),
                ADO.Identifier'Image (Entity),
                ADO.Entity_Type'Image (Kind));
   end Add_Permission;

   --  ------------------------------
   --  Add a permission for the user User to access the entity identified by
   --  Entity.
   --  ------------------------------
   procedure Add_Permission (Session    : in out ADO.Sessions.Master_Session;
                             User       : in ADO.Identifier;
                             Entity     : in ADO.Objects.Object_Ref'Class;
                             Workspace  : in ADO.Identifier;
                             Permission : in Permission_Type := READ) is
      Key  : constant ADO.Objects.Object_Key := Entity.Get_Key;
      Kind : constant ADO.Entity_Type
        := ADO.Sessions.Entities.Find_Entity_Type (Session => Session,
                                                   Object  => Key);
   begin
      Add_Permission (Session, User, ADO.Objects.Get_Value (Key), Kind, Workspace, Permission);
   end Add_Permission;

   --  ------------------------------
   --  Create a permission manager for the given application.
   --  ------------------------------
   function Create_Permission_Manager (App : in AWA.Applications.Application_Access)
                                       return Security.Policies.Policy_Manager_Access is
      Result : constant AWA.Permissions.Services.Permission_Manager_Access
        := new AWA.Permissions.Services.Permission_Manager (10);
      RP : constant Security.Policies.Roles.Role_Policy_Access
        := new Security.Policies.Roles.Role_Policy;
      RU : constant Security.Policies.URLs.URL_Policy_Access
        := new Security.Policies.URLs.URL_Policy;
      RE : constant Entity_Policy_Access
        := new Entity_Policy;
   begin
      Result.Add_Policy (RP.all'Access);
      Result.Add_Policy (RU.all'Access);
      Result.Add_Policy (RE.all'Access);
      Result.Set_Application (App);

      Log.Info ("Creation of the AWA Permissions manager");
      return Result.all'Access;
   end Create_Permission_Manager;

   --  ------------------------------
   --  Delete all the permissions for a user and on the given workspace.
   --  ------------------------------
   procedure Delete_Permissions (Session   : in out ADO.Sessions.Master_Session;
                                 User      : in ADO.Identifier;
                                 Workspace : in ADO.Identifier) is
      Stmt   : ADO.Statements.Delete_Statement
        := Session.Create_Statement (Models.ACL_TABLE);
      Result : Natural;
   begin
      Stmt.Set_Filter (Filter => "workspace_id = ? AND user_id = ?");
      Stmt.Add_Param (Value => Workspace);
      Stmt.Add_Param (Value => User);
      Stmt.Execute (Result);
      Log.Info ("Deleted {0} permissions for user {1} in workspace {2}",
                Natural'Image (Result), ADO.Identifier'Image (User),
                ADO.Identifier'Image (Workspace));
   end Delete_Permissions;

end AWA.Permissions.Services;

-----------------------------------------------------------------------
--  awa-permissions-services -- Permissions controller
--  Copyright (C) 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.
-----------------------------------------------------------------------

with ADO.Queries;
with ADO.Sessions.Entities;
with ADO.Statements;
with Util.Log.Loggers;

with Security.Policies.URLs;

with AWA.Permissions.Models;
with AWA.Services.Contexts;
package body AWA.Permissions.Services is

   use ADO.Sessions;

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Permissions.Services");

   --  ------------------------------
   --  Check if the permission with the name <tt>Name</tt> is granted for the current user.
   --  If the <tt>Entity</tt> is defined, an <tt>Entity_Permission</tt> is created and verified.
   --  Returns True if the user is granted the given permission.
   --  ------------------------------
   function Has_Permission (Name   : in Util.Beans.Objects.Object;
                            Entity : in Util.Beans.Objects.Object)
                            return Util.Beans.Objects.Object is
      use type Security.Contexts.Security_Context_Access;

      Context : constant Security.Contexts.Security_Context_Access := Security.Contexts.Current;
      Perm    : constant String := Util.Beans.Objects.To_String (Name);
      Result  : Boolean;
   begin
      if Util.Beans.Objects.Is_Empty (Name) or Context = null then
         Result := False;

      elsif Util.Beans.Objects.Is_Empty (Entity) then
         Result := Context.Has_Permission (Perm);

      else
         declare
            P : Entity_Permission (Security.Permissions.Get_Permission_Index (Perm));
         begin
            P.Entity := ADO.Identifier (Util.Beans.Objects.To_Long_Long_Integer (Entity));
            Result := Context.Has_Permission (P);
         end;
      end if;
      return Util.Beans.Objects.To_Object (Result);

   exception
      when Security.Permissions.Invalid_Name =>
         Log.Error ("Invalid permission {0}", Perm);
         raise;
   end Has_Permission;

   URI        : aliased constant String := "http://code.google.com/p/ada-awa/auth";

   --  ------------------------------
   --  Register the security EL functions in the EL mapper.
   --  ------------------------------
   procedure Set_Functions (Mapper : in out EL.Functions.Function_Mapper'Class) is
   begin
      Mapper.Set_Function (Name      => "hasPermission",
                           Namespace => URI,
                           Func      => Has_Permission'Access,
                           Optimize  => False);
   end Set_Functions;

   --  ------------------------------
   --  Get the permission manager associated with the security context.
   --  Returns null if there is none.
   --  ------------------------------
   function Get_Permission_Manager (Context : in Security.Contexts.Security_Context'Class)
                                    return Permission_Manager_Access is
      use type Security.Policies.Policy_Manager_Access;

      M : constant Security.Policies.Policy_Manager_Access
        := Context.Get_Permission_Manager;
   begin
      if M = null then
         Log.Info ("There is no permission manager");
         return null;

      elsif not (M.all in Permission_Manager'Class) then
         Log.Info ("Permission manager is not a AWA permission manager");
         return null;

      else
         return Permission_Manager'Class (M.all)'Access;
      end if;
   end Get_Permission_Manager;

   --  ------------------------------
   --  Get the application instance.
   --  ------------------------------
   function Get_Application (Manager : in Permission_Manager)
                             return AWA.Applications.Application_Access is
   begin
      return Manager.App;
   end Get_Application;

   --  ------------------------------
   --  Set the application instance.
   --  ------------------------------
   procedure Set_Application (Manager : in out Permission_Manager;
                              App : in AWA.Applications.Application_Access) is
   begin
      Manager.App := App;
   end Set_Application;

   --  ------------------------------
   --  Add a permission for the current user to access the entity identified by
   --  Entity and Kind.
   --  ------------------------------
   procedure Add_Permission (Manager    : in Permission_Manager;
                             Entity     : in ADO.Identifier;
                             Kind       : in ADO.Entity_Type;
                             Workspace  : in ADO.Identifier;
                             Permission : in Permission_Type) is
      pragma Unreferenced (Manager);

      Ctx  : constant AWA.Services.Contexts.Service_Context_Access
        := AWA.Services.Contexts.Current;
      DB   : Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Perm : AWA.Permissions.Models.ACL_Ref;
   begin
      Log.Info ("Adding permission");

      Ctx.Start;
      Perm.Set_Entity_Type (Kind);
      Perm.Set_User_Id (Ctx.Get_User_Identifier);
      Perm.Set_Entity_Id (Entity);
      Perm.Set_Writeable (Permission = AWA.Permissions.WRITE);
      Perm.Set_Workspace_Id (Workspace);
      Perm.Save (DB);
      Ctx.Commit;
   end Add_Permission;

   --  ------------------------------
   --  Check that the current user has the specified permission.
   --  Raise NO_PERMISSION exception if the user does not have the permission.
   --  ------------------------------
   procedure Check_Permission (Manager    : in Permission_Manager;
                               Entity     : in ADO.Identifier;
                               Kind       : in ADO.Entity_Type;
                               Permission : in Permission_Type) is
      pragma Unreferenced (Manager, Permission);
      use AWA.Services;

      Ctx   : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB    : constant Session := AWA.Services.Contexts.Get_Session (Ctx);
      Query : ADO.Queries.Context;
   begin
      Query.Set_Query (AWA.Permissions.Models.Query_Check_Entity_Permission);
      Query.Bind_Param ("user_id", User);
      Query.Bind_Param ("entity_id", Entity);
      Query.Bind_Param ("entity_type", Integer (Kind));
      declare
         Stmt : ADO.Statements.Query_Statement := DB.Create_Statement (Query);
      begin
         Stmt.Execute;
         if not Stmt.Has_Elements then
            Log.Info ("User {0} does not have permission to access entity {1}/{2}",
                      ADO.Identifier'Image (User), ADO.Identifier'Image (Entity),
                      ADO.Entity_Type'Image (Kind));
            raise NO_PERMISSION;
         end if;
      end;
   end Check_Permission;

   --  ------------------------------
   --  Get the role names that grant the given permission.
   --  ------------------------------
   function Get_Role_Names (Manager : in Permission_Manager;
                            Permission : in Security.Permissions.Permission_Index)
                            return Security.Policies.Roles.Role_Name_Array is
   begin
      return Manager.Roles.Get_Role_Names (Manager.Roles.Get_Grants (Permission));
   end Get_Role_Names;

   --  ------------------------------
   --  Add a permission for the user User to access the entity identified by
   --  Entity which is of type Kind.
   --  ------------------------------
   procedure Add_Permission (Session    : in out ADO.Sessions.Master_Session;
                             User       : in ADO.Identifier;
                             Entity     : in ADO.Identifier;
                             Kind       : in ADO.Entity_Type;
                             Workspace  : in ADO.Identifier;
                             Permission : in Permission_Type := READ) is
      Acl : AWA.Permissions.Models.ACL_Ref;
   begin
      Acl.Set_User_Id (User);
      Acl.Set_Entity_Type (Kind);
      Acl.Set_Entity_Id (Entity);
      Acl.Set_Writeable (Permission = WRITE);
      Acl.Set_Workspace_Id (Workspace);
      Acl.Save (Session);

      Log.Info ("Permission created for {0} to access {1}, entity type {2}",
                ADO.Identifier'Image (User),
                ADO.Identifier'Image (Entity),
                ADO.Entity_Type'Image (Kind));
   end Add_Permission;

   --  ------------------------------
   --  Add a permission for the user User to access the entity identified by
   --  Entity.
   --  ------------------------------
   procedure Add_Permission (Session    : in out ADO.Sessions.Master_Session;
                             User       : in ADO.Identifier;
                             Entity     : in ADO.Objects.Object_Ref'Class;
                             Workspace  : in ADO.Identifier;
                             Permission : in Permission_Type := READ) is
      Key  : constant ADO.Objects.Object_Key := Entity.Get_Key;
      Kind : constant ADO.Entity_Type
        := ADO.Sessions.Entities.Find_Entity_Type (Session => Session,
                                                   Object  => Key);
   begin
      Add_Permission (Session, User, ADO.Objects.Get_Value (Key), Kind, Workspace, Permission);
   end Add_Permission;

   --  ------------------------------
   --  Create a permission manager for the given application.
   --  ------------------------------
   function Create_Permission_Manager (App : in AWA.Applications.Application_Access)
                                       return Security.Policies.Policy_Manager_Access is
      Result : constant AWA.Permissions.Services.Permission_Manager_Access
        := new AWA.Permissions.Services.Permission_Manager (10);
      RP : constant Security.Policies.Roles.Role_Policy_Access
        := new Security.Policies.Roles.Role_Policy;
      RU : constant Security.Policies.URLs.URL_Policy_Access
        := new Security.Policies.URLs.URL_Policy;
      RE : constant Entity_Policy_Access
        := new Entity_Policy;
   begin
      Result.Add_Policy (RP.all'Access);
      Result.Add_Policy (RU.all'Access);
      Result.Add_Policy (RE.all'Access);
      Result.Set_Application (App);

      Log.Info ("Creation of the AWA Permissions manager");
      return Result.all'Access;
   end Create_Permission_Manager;

   --  ------------------------------
   --  Delete all the permissions for a user and on the given workspace.
   --  ------------------------------
   procedure Delete_Permissions (Session   : in out ADO.Sessions.Master_Session;
                                 User      : in ADO.Identifier;
                                 Workspace : in ADO.Identifier) is
      Stmt   : ADO.Statements.Delete_Statement
        := Session.Create_Statement (Models.ACL_TABLE);
      Result : Natural;
   begin
      Stmt.Set_Filter (Filter => "workspace_id = ? AND user_id = ?");
      Stmt.Add_Param (Value => Workspace);
      Stmt.Add_Param (Value => User);
      Stmt.Execute (Result);
      Log.Info ("Deleted {0} permissions for user {1} in workspace {2}",
                Natural'Image (Result), ADO.Identifier'Image (User),
                ADO.Identifier'Image (Workspace));
   end Delete_Permissions;

end AWA.Permissions.Services;

Implement the Get_Role_Names function

Implement the Get_Role_Names function


-----------------------------------------------------------------------
--  awa -- Ada Web Application
--  Copyright (C) 2009 - 2020 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.
-----------------------------------------------------------------------

--  = AWA Core ==
--
--  @include awa-applications.ads
--  @include awa-modules.ads
--  @include awa-permissions.ads
--  @include awa-events.ads
--  @include awa.xml
package AWA is

   pragma Pure;

end AWA;

-----------------------------------------------------------------------
--  awa -- Ada Web Application
--  Copyright (C) 2009 - 2020 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.
-----------------------------------------------------------------------

--  = AWA Core ==
--
--  @include awa-applications.ads
--  @include awa-modules.ads
--  @include awa-permissions.ads
--  @include awa-events.ads
--  @include awa-commands.ads
--  @include awa.xml
package AWA is

   pragma Pure;

end AWA;

Include the AWA commands documentation

Include the AWA commands documentation


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

with Input_Sources.File;
with DOM.Core.Documents;
with DOM.Readers;
with Sax.Readers;

with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with ASF.Components.Core;
with ASF.Contexts.Faces;
with ASF.Applications.Views;
with ASF.Contexts.Writer.String;

with EL.Objects;
with EL.Contexts;
with EL.Contexts.Default;
with EL.Functions;
with EL.Variables;
with EL.Variables.Default;

with Gen.Model;
with Gen.Utils;

with Util.Files;
with Util.Log.Loggers;
package body Gen.Generator is

   use ASF;
   use Ada.Strings.Unbounded;
   use Util.Log;

   Log : constant Loggers.Logger := Loggers.Create ("Gen.Generator");

   RESULT_DIR : constant String := "generator.output.dir";

   function To_Ada_Type (Name : EL.Objects.Object) return EL.Objects.Object;
   function Indent (Value : EL.Objects.Object) return EL.Objects.Object;

   --  EL Function to translate a model type to the key enum value
   function To_Key_Enum (Name : EL.Objects.Object) return EL.Objects.Object;

   --  ------------------------------
   --  EL Function to translate a model type to an Ada implementation type
   --  ------------------------------
   function To_Ada_Type (Name : EL.Objects.Object) return EL.Objects.Object is
      Value : constant String := EL.Objects.To_String (Name);
   begin
      if Value = "String" then
         return EL.Objects.To_Object (String '("Unbounded_String"));
      elsif Value = "Integer" or Value = "int" then
         return EL.Objects.To_Object (String '("Integer"));
      else
         return Name;
      end if;
   end To_Ada_Type;

   --  ------------------------------
   --  EL Function to check whether a type is an integer type
   --  ------------------------------
   function Is_Integer_Type (Name : EL.Objects.Object) return EL.Objects.Object is
      Value : constant String := EL.Objects.To_String (Name);
   begin
      if Value = "Integer" or Value = "int" then
         return EL.Objects.To_Object (True);
      else
         return EL.Objects.To_Object (False);
      end if;
   end Is_Integer_Type;

   KEY_INTEGER_LABEL : constant String := "KEY_INTEGER";
   KEY_STRING_LABEL  : constant String := "KEY_STRING";

   --  ------------------------------
   --  EL Function to translate a model type to the key enum value
   --  ------------------------------
   function To_Key_Enum (Name : EL.Objects.Object) return EL.Objects.Object is
      Value : constant String := EL.Objects.To_String (Name);
   begin
      if Value = "Integer" or Value = "int" or Value = "Identifier"
         or Value = "ADO.Identifier" then
         return EL.Objects.To_Object (KEY_INTEGER_LABEL);
      else
         return EL.Objects.To_Object (KEY_STRING_LABEL);
      end if;
   end To_Key_Enum;

   --  ------------------------------
   --  EL function to indent the code
   --  ------------------------------
   function Indent (Value : EL.Objects.Object) return EL.Objects.Object is
      S      : constant String := EL.Objects.To_String (Value);
      Result : constant String (S'Range) := (others => ' ');
   begin
      return EL.Objects.To_Object (Result);
   end Indent;

   --  ------------------------------
   --  EL function to indent the code
   --  ------------------------------
   function To_Sql_Type (Value : EL.Objects.Object) return EL.Objects.Object is
      Name   : constant String := EL.Objects.To_String (Value);
      Result : Unbounded_String;
   begin
      if Name = "Identifier" then
         Append (Result, "BIGINT NOT NULL");
      elsif Name = "Integer" then
         Append (Result, "INTEGER");
      elsif Name = "String" then
         Append (Result, "VARCHAR(255)");
      elsif Name = "Date" then
         Append (Result, "DATE");
      else
         Append (Result, "VARCHAR(255)");
      end if;
      return EL.Objects.To_Object (Result);
   end To_Sql_Type;

   --  ------------------------------
   --  Register the generator EL functions
   --  ------------------------------
   procedure Set_Functions (Mapper : in out EL.Functions.Function_Mapper'Class) is
      URI : constant String := "http://code.google.com/p/ada-ado/generator";
   begin
      Mapper.Set_Function (Name      => "adaType",
                           Namespace => URI,
                           Func      => To_Ada_Type'Access);
      Mapper.Set_Function (Name      => "indent",
                           Namespace => URI,
                           Func      => Indent'Access);
      Mapper.Set_Function (Name      => "isInteger",
                           Namespace => URI,
                           Func      => Is_Integer_Type'Access);
      Mapper.Set_Function (Name      => "sqlType",
                           Namespace => URI,
                           Func      => To_Sql_Type'Access);
      Mapper.Set_Function (Name      => "keyEnum",
                           Namespace => URI,
                           Func      => To_Key_Enum'Access);
   end Set_Functions;

   --  ------------------------------
   --  Initialize the generator
   --  ------------------------------
   procedure Initialize (H : in out Handler) is
      procedure Register_Funcs is
        new ASF.Applications.Main.Register_Functions (Set_Functions);
   begin
      H.Conf.Set (ASF.Applications.VIEW_IGNORE_WHITE_SPACES, "false");
      H.Conf.Set (ASF.Applications.VIEW_ESCAPE_UNKNOWN_TAGS, "false");
      H.Conf.Set (ASF.Applications.VIEW_IGNORE_EMPTY_LINES, "true");
      H.Conf.Set (ASF.Applications.VIEW_FILE_EXT, "");
      if not H.Conf.Exists (ASF.Applications.VIEW_DIR) then
         H.Set_Template_Directory ("templates/");
      end if;
      H.Initialize (H.Conf);

      Register_Funcs (H);
   end Initialize;

   --  ------------------------------
   --  Set the directory where template files are stored.
   --  ------------------------------
   procedure Set_Template_Directory (H    : in out Handler;
                                     Path : in String) is
   begin
      H.Conf.Set (ASF.Applications.VIEW_DIR, Path);
   end Set_Template_Directory;

   --  ------------------------------
   --  Set the directory where results files are generated.
   --  ------------------------------
   procedure Set_Result_Directory (H    : in out Handler;
                                   Path : in String) is
   begin
      H.Conf.Set (RESULT_DIR, Path);
   end Set_Result_Directory;

   --  ------------------------------
   --  Register a model mapping
   --  ------------------------------
   procedure Register_Mapping (H    : in out Handler;
                               Node : in DOM.Core.Node) is
   begin
      H.Model.Initialize (Node);
   end Register_Mapping;

   --  ------------------------------
   --  Get the exit status
   --  Returns 0 if the generation was successful
   --  Returns 1 if there was a generation error
   --  ------------------------------
   function Get_Status (H : in Handler) return Ada.Command_Line.Exit_Status is
   begin
      return H.Status;
   end Get_Status;

   --  ------------------------------
   --  Report an error and set the exit status accordingly
   --  ------------------------------
   procedure Error (H : in out Handler;
                    Message : in String;
                    Arg1    : in String := "";
                    Arg2    : in String := "") is
   begin
      Log.Error (Message, Arg1, Arg2);
      H.Status := 1;
   end Error;

   --  ------------------------------
   --  Read the XML model file
   --  ------------------------------
   procedure Read_Model (H    : in out Handler;
                         File : in String) is
      Read           : Input_Sources.File.File_Input;
      My_Tree_Reader : DOM.Readers.Tree_Reader;
      Name_Start     : Natural;

      procedure Iterate is new Gen.Utils.Iterate_Nodes (T       => Handler,
                                                        Process => Register_Mapping);

   begin
      Log.Info ("Reading model file {0}", File);

      --  Base file name should be used as the public Id
      Name_Start := File'Last;
      while Name_Start >= File'First  and then File (Name_Start) /= '/' loop
         Name_Start := Name_Start - 1;
      end loop;
      Input_Sources.File.Open (File, Read);

      --  Full name is used as the system id
      Input_Sources.File.Set_System_Id (Read, File);
      Input_Sources.File.Set_Public_Id (Read, File (Name_Start + 1 .. File'Last));

      DOM.Readers.Set_Feature (My_Tree_Reader, Sax.Readers.Validation_Feature, False);

      DOM.Readers.Parse (My_Tree_Reader, Read);
      Input_Sources.File.Close (Read);

      H.Doc := DOM.Readers.Get_Tree (My_Tree_Reader);
      H.Root := DOM.Core.Documents.Get_Element (H.Doc);

      Iterate (H, H.Root, "hibernate-mapping");

   exception
      when Ada.IO_Exceptions.Name_Error =>
         H.Error ("Model file {0} does not exist", File);

   end Read_Model;

   --  ------------------------------
   --  Generate the code using the template file
   --  ------------------------------
   procedure Generate (H     : in out Handler;
                       File  : in String;
                       Model : in Gen.Model.Definition_Access) is
      Context   : aliased Contexts.Faces.Faces_Context;
      View      : Components.Core.UIViewRoot;
      Resolver  : aliased EL.Contexts.Default.Default_ELResolver;
      Req       : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
   begin
      Log.Info ("Generating {0}", File);

      --  Model.Initialize (H.Model);
      Resolver.Register (To_Unbounded_String ("model"), Model.all'Unchecked_Access);
--        Context.Set_Response_Writer (Writer'Unchecked_Access);
--        Context.Set_ELContext (ELContext'Unchecked_Access);
--        ELContext.Set_Variable_Mapper (Variables'Unchecked_Access);
--        ELContext.Set_Resolver (Resolver'Unchecked_Access);
--        Writer.Initialize ("text/plain", "UTF-8", 8192);

--        H.Set_Context (Context'Unchecked_Access);
--        H.Restore_View (File, Context, View);

      H.Dispatch (Page     => File,
                  Request  => Req,
                  Response => Reply);

      declare
         Dir     : constant String := H.Conf.Get (RESULT_DIR, "./");
         Result  : constant EL.Objects.Object := View.Get_Root.Get_Attribute (Context, "file");
         Path    : constant String := Dir & EL.Objects.To_String (Result);
         Content : Unbounded_String;
      begin
         Log.Info ("Writing result file {0}", Path);

         Reply.Read_Content (Content);
         Util.Files.Write_File (Path => Path, Content => Content);
      end;

   end Generate;

   --  ------------------------------
   --  Generate the code using the template file
   --  ------------------------------
   procedure Generate (H     : in out Handler;
                       Mode  : in Iteration_Mode;
                       File  : in String) is
   begin
      case Mode is
         when ITERATION_PACKAGE =>
            declare
               Pos : Gen.Model.Tables.Package_Cursor := H.Model.First;
            begin
               while Gen.Model.Tables.Has_Element (Pos) loop
                  H.Generate (File, Gen.Model.Tables.Element (Pos).all'Access);
                  Gen.Model.Tables.Next (Pos);
               end loop;
            end;

         when ITERATION_TABLE =>
            H.Generate (File, H.Model'Unchecked_Access);

      end case;
   end Generate;

   --  Generate all the code generation files stored in the directory
   procedure Generate_All (H    : in out Handler;
                           Mode : in Iteration_Mode;
                           Name : in String) is
      use Ada.Directories;

      Search  : Search_Type;
      Filter  : constant Filter_Type := (others => True);
      Ent     : Directory_Entry_Type;
      Dir     : constant String := H.Conf.Get (ASF.Applications.VIEW_DIR);
      Path    : constant String := Dir & Name;
   begin
      if Kind (Path) /= Directory then
         Ada.Text_IO.Put_Line ("Cannot read model directory: " & Path);
      end if;

      Start_Search (Search, Directory => Path, Pattern => "*.xhtml", Filter => Filter);
      while More_Entries (Search) loop
         Get_Next_Entry (Search, Ent);
         declare
            File_Path : constant String := Full_Name (Ent);
         begin
            H.Generate (Mode, File_Path);
         end;
      end loop;

   exception
      when Ada.IO_Exceptions.Name_Error =>
         H.Error ("Template directory {0} does not exist", Path);
   end Generate_All;

end Gen.Generator;

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

with Input_Sources.File;
with DOM.Core.Documents;
with DOM.Readers;
with Sax.Readers;

with ASF.Requests.Mockup;
with ASF.Responses.Mockup;
with ASF.Components.Core;
with ASF.Contexts.Faces;
with ASF.Applications.Views;

with EL.Objects;
with EL.Contexts;
with EL.Contexts.Default;
with EL.Functions;

with Gen.Model;
with Gen.Utils;

with Util.Files;
with Util.Log.Loggers;
package body Gen.Generator is

   use ASF;
   use Ada.Strings.Unbounded;
   use Util.Log;

   Log : constant Loggers.Logger := Loggers.Create ("Gen.Generator");

   RESULT_DIR : constant String := "generator.output.dir";

   function To_Ada_Type (Name : EL.Objects.Object) return EL.Objects.Object;
   function Indent (Value : EL.Objects.Object) return EL.Objects.Object;

   --  EL Function to translate a model type to the key enum value
   function To_Key_Enum (Name : EL.Objects.Object) return EL.Objects.Object;

   --  ------------------------------
   --  EL Function to translate a model type to an Ada implementation type
   --  ------------------------------
   function To_Ada_Type (Name : EL.Objects.Object) return EL.Objects.Object is
      Value : constant String := EL.Objects.To_String (Name);
   begin
      if Value = "String" then
         return EL.Objects.To_Object (String '("Unbounded_String"));
      elsif Value = "Integer" or Value = "int" then
         return EL.Objects.To_Object (String '("Integer"));
      else
         return Name;
      end if;
   end To_Ada_Type;

   --  ------------------------------
   --  EL Function to check whether a type is an integer type
   --  ------------------------------
   function Is_Integer_Type (Name : EL.Objects.Object) return EL.Objects.Object is
      Value : constant String := EL.Objects.To_String (Name);
   begin
      if Value = "Integer" or Value = "int" then
         return EL.Objects.To_Object (True);
      else
         return EL.Objects.To_Object (False);
      end if;
   end Is_Integer_Type;

   KEY_INTEGER_LABEL : constant String := "KEY_INTEGER";
   KEY_STRING_LABEL  : constant String := "KEY_STRING";

   --  ------------------------------
   --  EL Function to translate a model type to the key enum value
   --  ------------------------------
   function To_Key_Enum (Name : EL.Objects.Object) return EL.Objects.Object is
      Value : constant String := EL.Objects.To_String (Name);
   begin
      if Value = "Integer" or Value = "int" or Value = "Identifier"
         or Value = "ADO.Identifier" then
         return EL.Objects.To_Object (KEY_INTEGER_LABEL);
      else
         return EL.Objects.To_Object (KEY_STRING_LABEL);
      end if;
   end To_Key_Enum;

   --  ------------------------------
   --  EL function to indent the code
   --  ------------------------------
   function Indent (Value : EL.Objects.Object) return EL.Objects.Object is
      S      : constant String := EL.Objects.To_String (Value);
      Result : constant String (S'Range) := (others => ' ');
   begin
      return EL.Objects.To_Object (Result);
   end Indent;

   --  ------------------------------
   --  EL function to indent the code
   --  ------------------------------
   function To_Sql_Type (Value : EL.Objects.Object) return EL.Objects.Object is
      Name   : constant String := EL.Objects.To_String (Value);
      Result : Unbounded_String;
   begin
      if Name = "Identifier" then
         Append (Result, "BIGINT NOT NULL");
      elsif Name = "Integer" then
         Append (Result, "INTEGER");
      elsif Name = "String" then
         Append (Result, "VARCHAR(255)");
      elsif Name = "Date" then
         Append (Result, "DATE");
      else
         Append (Result, "VARCHAR(255)");
      end if;
      return EL.Objects.To_Object (Result);
   end To_Sql_Type;

   --  ------------------------------
   --  Register the generator EL functions
   --  ------------------------------
   procedure Set_Functions (Mapper : in out EL.Functions.Function_Mapper'Class) is
      URI : constant String := "http://code.google.com/p/ada-ado/generator";
   begin
      Mapper.Set_Function (Name      => "adaType",
                           Namespace => URI,
                           Func      => To_Ada_Type'Access);
      Mapper.Set_Function (Name      => "indent",
                           Namespace => URI,
                           Func      => Indent'Access);
      Mapper.Set_Function (Name      => "isInteger",
                           Namespace => URI,
                           Func      => Is_Integer_Type'Access);
      Mapper.Set_Function (Name      => "sqlType",
                           Namespace => URI,
                           Func      => To_Sql_Type'Access);
      Mapper.Set_Function (Name      => "keyEnum",
                           Namespace => URI,
                           Func      => To_Key_Enum'Access);
   end Set_Functions;

   --  ------------------------------
   --  Initialize the generator
   --  ------------------------------
   procedure Initialize (H : in out Handler) is
      procedure Register_Funcs is
        new ASF.Applications.Main.Register_Functions (Set_Functions);
   begin
      H.Conf.Set (ASF.Applications.VIEW_IGNORE_WHITE_SPACES, "false");
      H.Conf.Set (ASF.Applications.VIEW_ESCAPE_UNKNOWN_TAGS, "false");
      H.Conf.Set (ASF.Applications.VIEW_IGNORE_EMPTY_LINES, "true");
      H.Conf.Set (ASF.Applications.VIEW_FILE_EXT, "");
      if not H.Conf.Exists (ASF.Applications.VIEW_DIR) then
         H.Set_Template_Directory ("templates/");
      end if;
      H.Initialize (H.Conf);

      Register_Funcs (H);
   end Initialize;

   --  ------------------------------
   --  Set the directory where template files are stored.
   --  ------------------------------
   procedure Set_Template_Directory (H    : in out Handler;
                                     Path : in String) is
   begin
      H.Conf.Set (ASF.Applications.VIEW_DIR, Path);
   end Set_Template_Directory;

   --  ------------------------------
   --  Set the directory where results files are generated.
   --  ------------------------------
   procedure Set_Result_Directory (H    : in out Handler;
                                   Path : in String) is
   begin
      H.Conf.Set (RESULT_DIR, Path);
   end Set_Result_Directory;

   --  ------------------------------
   --  Register a model mapping
   --  ------------------------------
   procedure Register_Mapping (H    : in out Handler;
                               Node : in DOM.Core.Node) is
   begin
      H.Model.Initialize (Node);
   end Register_Mapping;

   --  ------------------------------
   --  Get the exit status
   --  Returns 0 if the generation was successful
   --  Returns 1 if there was a generation error
   --  ------------------------------
   function Get_Status (H : in Handler) return Ada.Command_Line.Exit_Status is
   begin
      return H.Status;
   end Get_Status;

   --  ------------------------------
   --  Report an error and set the exit status accordingly
   --  ------------------------------
   procedure Error (H : in out Handler;
                    Message : in String;
                    Arg1    : in String := "";
                    Arg2    : in String := "") is
   begin
      Log.Error (Message, Arg1, Arg2);
      H.Status := 1;
   end Error;

   --  ------------------------------
   --  Read the XML model file
   --  ------------------------------
   procedure Read_Model (H    : in out Handler;
                         File : in String) is
      Read           : Input_Sources.File.File_Input;
      My_Tree_Reader : DOM.Readers.Tree_Reader;
      Name_Start     : Natural;

      procedure Iterate is new Gen.Utils.Iterate_Nodes (T       => Handler,
                                                        Process => Register_Mapping);

   begin
      Log.Info ("Reading model file {0}", File);

      --  Base file name should be used as the public Id
      Name_Start := File'Last;
      while Name_Start >= File'First  and then File (Name_Start) /= '/' loop
         Name_Start := Name_Start - 1;
      end loop;
      Input_Sources.File.Open (File, Read);

      --  Full name is used as the system id
      Input_Sources.File.Set_System_Id (Read, File);
      Input_Sources.File.Set_Public_Id (Read, File (Name_Start + 1 .. File'Last));

      DOM.Readers.Set_Feature (My_Tree_Reader, Sax.Readers.Validation_Feature, False);

      DOM.Readers.Parse (My_Tree_Reader, Read);
      Input_Sources.File.Close (Read);

      H.Doc := DOM.Readers.Get_Tree (My_Tree_Reader);
      H.Root := DOM.Core.Documents.Get_Element (H.Doc);

      Iterate (H, H.Root, "hibernate-mapping");

   exception
      when Ada.IO_Exceptions.Name_Error =>
         H.Error ("Model file {0} does not exist", File);

   end Read_Model;

   --  ------------------------------
   --  Generate the code using the template file
   --  ------------------------------
   procedure Generate (H     : in out Handler;
                       File  : in String;
                       Model : in Gen.Model.Definition_Access) is
      Context   : aliased Contexts.Faces.Faces_Context;
      View      : Components.Core.UIViewRoot;
      Resolver  : aliased EL.Contexts.Default.Default_ELResolver;
      Req       : ASF.Requests.Mockup.Request;
      Reply     : ASF.Responses.Mockup.Response;
      Bean      : constant EL.Objects.Object := EL.Objects.To_Object (Model.all'Unchecked_Access);
   begin
      Log.Info ("Generating {0}", File);

      Req.Set_Attribute (Name => "model", Value => Bean);
      Resolver.Register (To_Unbounded_String ("model"), Model.all'Unchecked_Access);

      H.Dispatch (Page     => File,
                  Request  => Req,
                  Response => Reply);

      declare
         Dir     : constant String := H.Conf.Get (RESULT_DIR, "./");
         Result  : constant EL.Objects.Object := View.Get_Root.Get_Attribute (Context, "file");
         Path    : constant String := Dir & EL.Objects.To_String (Result);
         Content : Unbounded_String;
      begin
         Log.Info ("Writing result file {0}", Path);

         Reply.Read_Content (Content);
         Util.Files.Write_File (Path => Path, Content => Content);
      end;

   end Generate;

   --  ------------------------------
   --  Generate the code using the template file
   --  ------------------------------
   procedure Generate (H     : in out Handler;
                       Mode  : in Iteration_Mode;
                       File  : in String) is
   begin
      case Mode is
         when ITERATION_PACKAGE =>
            declare
               Pos : Gen.Model.Tables.Package_Cursor := H.Model.First;
            begin
               while Gen.Model.Tables.Has_Element (Pos) loop
                  H.Generate (File, Gen.Model.Tables.Element (Pos).all'Access);
                  Gen.Model.Tables.Next (Pos);
               end loop;
            end;

         when ITERATION_TABLE =>
            H.Generate (File, H.Model'Unchecked_Access);

      end case;
   end Generate;

   --  Generate all the code generation files stored in the directory
   procedure Generate_All (H    : in out Handler;
                           Mode : in Iteration_Mode;
                           Name : in String) is
      use Ada.Directories;

      Search  : Search_Type;
      Filter  : constant Filter_Type := (others => True);
      Ent     : Directory_Entry_Type;
      Dir     : constant String := H.Conf.Get (ASF.Applications.VIEW_DIR);
      Path    : constant String := Dir & Name;
   begin
      if Kind (Path) /= Directory then
         Ada.Text_IO.Put_Line ("Cannot read model directory: " & Path);
      end if;

      Start_Search (Search, Directory => Path, Pattern => "*.xhtml", Filter => Filter);
      while More_Entries (Search) loop
         Get_Next_Entry (Search, Ent);
         declare
            File_Path : constant String := Full_Name (Ent);
         begin
            H.Generate (Mode, File_Path);
         end;
      end loop;

   exception
      when Ada.IO_Exceptions.Name_Error =>
         H.Error ("Template directory {0} does not exist", Path);
   end Generate_All;

end Gen.Generator;

Store the model bean in a request mockup object


-----------------------------------------------------------------------
--  awa-questions-beans -- Beans for module questions
--  Copyright (C) 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 AWA.Questions.Services;
package body AWA.Questions.Beans is

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Question_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "count" then
         return Util.Beans.Objects.To_Object (From.Count);
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Question_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "count" then
         From.Count := Util.Beans.Objects.To_Integer (Value);
      end if;
   end Set_Value;

   procedure Save (Bean : in out Question_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      Manager : constant Services.Question_Service_Access := Bean.Module.Get_Question_Manager;
   begin
      Manager.Save_Question (Bean);
   end Save;

   procedure Delete (Bean : in out Question_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      null;
   end Delete;

   --  ------------------------------
   --  Create the Question_Bean bean instance.
   --  ------------------------------
   function Create_Question_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
      return Util.Beans.Basic.Readonly_Bean_Access is
      Object : constant Question_Bean_Access := new Question_Bean;
   begin
      Object.Module := Module;
      return Object.all'Access;
   end Create_Question_Bean;

end AWA.Questions.Beans;

-----------------------------------------------------------------------
--  awa-questions-beans -- Beans for module questions
--  Copyright (C) 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 ADO.Queries;
with ADO.Sessions;

with AWA.Services.Contexts;
with AWA.Questions.Services;
package body AWA.Questions.Beans is

   --  ------------------------------
   --  Get the value identified by the name.
   --  ------------------------------
   overriding
   function Get_Value (From : in Question_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "count" then
         return Util.Beans.Objects.To_Object (From.Count);
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  ------------------------------
   --  Set the value identified by the name.
   --  ------------------------------
   overriding
   procedure Set_Value (From  : in out Question_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "count" then
         From.Count := Util.Beans.Objects.To_Integer (Value);
      end if;
   end Set_Value;

   procedure Save (Bean : in out Question_Bean;
                   Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      Manager : constant Services.Question_Service_Access := Bean.Module.Get_Question_Manager;
   begin
      Manager.Save_Question (Bean);
   end Save;

   procedure Delete (Bean : in out Question_Bean;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
   begin
      null;
   end Delete;

   --  ------------------------------
   --  Create the Question_Bean bean instance.
   --  ------------------------------
   function Create_Question_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
      return Util.Beans.Basic.Readonly_Bean_Access is
      Object : constant Question_Bean_Access := new Question_Bean;
   begin
      Object.Module := Module;
      return Object.all'Access;
   end Create_Question_Bean;

   --  ------------------------------
   --  Create the Question_Info_List_Bean bean instance.
   --  ------------------------------
   function Create_Question_List_Bean (Module : in AWA.Questions.Modules.Question_Module_Access)
                                       return Util.Beans.Basic.Readonly_Bean_Access is
      use AWA.Questions.Models;
      use AWA.Services;

      Ctx     : constant Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      Object  : constant Question_Info_List_Bean_Access := new Question_Info_List_Bean;
      Session : ADO.Sessions.Session := Module.Get_Session;
      Query   : ADO.Queries.Context;
   begin
      Query.Set_Query (AWA.Questions.Models.Query_Question_List);
      AWA.Questions.Models.List (Object.all, Session, Query);
      return Object.all'Access;
   end Create_Question_List_Bean;

end AWA.Questions.Beans;

Implement Create_Question_List_Bean

Implement Create_Question_List_Bean


-----------------------------------------------------------------------
--  util-streams-buffered-lzma-tests -- Unit tests for encoding buffered streams
--  Copyright (C) 2018, 2019, 2021 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Util.Test_Caller;
with Util.Streams.Files;
with Util.Streams.Texts;
with Util.Streams.AES;
with Util.Encoders.AES;
with Ada.Streams.Stream_IO;
package body Util.Streams.Buffered.Lzma.Tests is

   use Util.Streams.Files;
   use Ada.Streams.Stream_IO;

   procedure Test_Stream_File (T       : in out Test;
                               Item    : in String;
                               Count   : in Positive;
                               Encrypt : in Boolean;
                               Mode    : in Util.Encoders.AES.AES_Mode;
                               Label   : in String);

   package Caller is new Util.Test_Caller (Test, "Streams.Buffered.Lzma");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Streams.Buffered.Lzma.Write",
                       Test_Compress_Stream'Access);
      Caller.Add_Test (Suite, "Test Util.Streams.Buffered.Lzma.Write (2)",
                       Test_Compress_File_Stream'Access);
      Caller.Add_Test (Suite, "Test Util.Streams.Buffered.Lzma.Read+Write",
                       Test_Compress_Decompress_Stream'Access);
   end Add_Tests;

   procedure Test_Compress_Stream (T : in out Test) is
      Stream  : aliased File_Stream;
      Buffer  : aliased Util.Streams.Buffered.Lzma.Compress_Stream;
      Print   : Util.Streams.Texts.Print_Stream;
      Path    : constant String := Util.Tests.Get_Test_Path ("test-stream.lzma");
      Expect  : constant String := Util.Tests.Get_Path ("regtests/expect/test-stream.lzma");
   begin
      Stream.Create (Mode => Out_File, Name => Path);
      Buffer.Initialize (Output => Stream'Access,
                         Size   => 1024);
      Print.Initialize (Output => Buffer'Access, Size => 5);
      for I in 1 .. 32 loop
         Print.Write ("abcd");
         Print.Write (" fghij");
         Print.Write (ASCII.LF);
      end loop;
      Print.Flush;
      Stream.Close;

      Util.Tests.Assert_Equal_Files (T       => T,
                                     Expect  => Expect,
                                     Test    => Path,
                                     Message => "LZMA stream");
   end Test_Compress_Stream;

   procedure Test_Compress_File_Stream (T : in out Test) is
      Stream    : aliased File_Stream;
      In_Stream : aliased File_Stream;
      Buffer    : aliased Util.Streams.Buffered.Lzma.Compress_Stream;
      Path      : constant String
        := Util.Tests.Get_Test_Path ("test-big-stream.lzma");
      Expect    : constant String
        := Util.Tests.Get_Path ("regtests/expect/test-big-stream.lzma");
   begin
      In_Stream.Open (Ada.Streams.Stream_IO.In_File,
                      Util.Tests.Get_Path ("regtests/files/test-big-stream.bin"));
      Stream.Create (Mode => Out_File, Name => Path);
      Buffer.Initialize (Output => Stream'Access,
                         Size   => 32768);
      Util.Streams.Copy (From => In_Stream, Into => Buffer);
      Buffer.Flush;
      Buffer.Close;
      Util.Tests.Assert_Equal_Files (T       => T,
                                     Expect  => Expect,
                                     Test    => Path,
                                     Message => "LZMA stream");
   end Test_Compress_File_Stream;

   procedure Test_Stream_File (T       : in out Test;
                               Item    : in String;
                               Count   : in Positive;
                               Encrypt : in Boolean;
                               Mode    : in Util.Encoders.AES.AES_Mode;
                               Label   : in String) is
      use Ada.Strings.Unbounded;

      Path       : constant String
        := Util.Tests.Get_Test_Path ("stream-lzma-aes-" & Label & ".aes");
      Key        : constant Util.Encoders.Secret_Key
        := Util.Encoders.Create ("0123456789abcdef0123456789abcdef");
      File       : aliased File_Stream;
      Decipher   : aliased Util.Streams.AES.Decoding_Stream;
      Cipher     : aliased Util.Streams.AES.Encoding_Stream;
      Compress   : aliased Util.Streams.Buffered.Lzma.Compress_Stream;
      Decompress : aliased Util.Streams.Buffered.Lzma.Decompress_Stream;
      Print      : Util.Streams.Texts.Print_Stream;
      Reader     : Util.Streams.Texts.Reader_Stream;
   begin
      --  Print -> Compress -> Cipher -> File
      File.Create (Mode => Out_File, Name => Path);
      if Encrypt then
         Cipher.Produces (File'Access, 64);
         Cipher.Set_Key (Key, Mode);
         Compress.Initialize (Cipher'Access, 1024);
      else
         Compress.Initialize (File'Access, 1024);
      end if;
      Print.Initialize (Compress'Access);
      for I in 1 .. Count loop
         Print.Write (Item & ASCII.LF);
      end loop;
      Print.Close;

      --  File -> Decipher -> Decompress -> Reader
      File.Open (Mode => In_File, Name => Path);
      if Encrypt then
         Decipher.Consumes (File'Access, 128);
         Decipher.Set_Key (Key, Mode);
         Decompress.Initialize (Decipher'Access, 1024);
      else
         Decompress.Initialize (File'Access, 1024);
      end if;
      Reader.Initialize (From => Decompress'Access);
      declare
         Line_Count : Natural := 0;
      begin
         while not Reader.Is_Eof loop
            declare
               Line : Unbounded_String;
            begin
               Reader.Read_Line (Line);
               exit when Length (Line) = 0;
               if Item & ASCII.LF /= Line then
                  Util.Tests.Assert_Equals (T, Item & ASCII.LF, To_String (Line));
               end if;
               Line_Count := Line_Count + 1;
            end;
         end loop;
         File.Close;
         Util.Tests.Assert_Equals (T, Count, Line_Count);
      end;
   end Test_Stream_File;

   procedure Test_Compress_Decompress_Stream (T : in out Test) is
   begin
      Test_Stream_File (T, "abcdefgh", 1000, False, Util.Encoders.AES.CBC, "AES-CBC");
   end Test_Compress_Decompress_Stream;

end Util.Streams.Buffered.Lzma.Tests;

-----------------------------------------------------------------------
--  util-streams-buffered-lzma-tests -- Unit tests for encoding buffered streams
--  Copyright (C) 2018, 2019, 2021 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Util.Test_Caller;
with Util.Streams.Files;
with Util.Streams.Texts;
with Util.Streams.AES;
with Util.Encoders.AES;
with Ada.Streams.Stream_IO;
package body Util.Streams.Buffered.Lzma.Tests is

   use Util.Streams.Files;
   use Ada.Streams.Stream_IO;

   procedure Test_Stream_File (T       : in out Test;
                               Item    : in String;
                               Count   : in Positive;
                               Encrypt : in Boolean;
                               Mode    : in Util.Encoders.AES.AES_Mode;
                               Label   : in String);

   package Caller is new Util.Test_Caller (Test, "Streams.Buffered.Lzma");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test Util.Streams.Buffered.Lzma.Write",
                       Test_Compress_Stream'Access);
      Caller.Add_Test (Suite, "Test Util.Streams.Buffered.Lzma.Write (2)",
                       Test_Compress_File_Stream'Access);
      Caller.Add_Test (Suite, "Test Util.Streams.Buffered.Lzma.Read+Write",
                       Test_Compress_Decompress_Stream'Access);
      Caller.Add_Test (Suite, "Test Util.Streams.Buffered.Lzma.Read+Write+AES-CBC",
                       Test_Compress_Encrypt_Decompress_Decrypt_Stream'Access);
   end Add_Tests;

   procedure Test_Compress_Stream (T : in out Test) is
      Stream  : aliased File_Stream;
      Buffer  : aliased Util.Streams.Buffered.Lzma.Compress_Stream;
      Print   : Util.Streams.Texts.Print_Stream;
      Path    : constant String := Util.Tests.Get_Test_Path ("test-stream.lzma");
      Expect  : constant String := Util.Tests.Get_Path ("regtests/expect/test-stream.lzma");
   begin
      Stream.Create (Mode => Out_File, Name => Path);
      Buffer.Initialize (Output => Stream'Access,
                         Size   => 1024);
      Print.Initialize (Output => Buffer'Access, Size => 5);
      for I in 1 .. 32 loop
         Print.Write ("abcd");
         Print.Write (" fghij");
         Print.Write (ASCII.LF);
      end loop;
      Print.Flush;
      Stream.Close;

      Util.Tests.Assert_Equal_Files (T       => T,
                                     Expect  => Expect,
                                     Test    => Path,
                                     Message => "LZMA stream");
   end Test_Compress_Stream;

   procedure Test_Compress_File_Stream (T : in out Test) is
      Stream    : aliased File_Stream;
      In_Stream : aliased File_Stream;
      Buffer    : aliased Util.Streams.Buffered.Lzma.Compress_Stream;
      Path      : constant String
        := Util.Tests.Get_Test_Path ("test-big-stream.lzma");
      Expect    : constant String
        := Util.Tests.Get_Path ("regtests/expect/test-big-stream.lzma");
   begin
      In_Stream.Open (Ada.Streams.Stream_IO.In_File,
                      Util.Tests.Get_Path ("regtests/files/test-big-stream.bin"));
      Stream.Create (Mode => Out_File, Name => Path);
      Buffer.Initialize (Output => Stream'Access,
                         Size   => 32768);
      Util.Streams.Copy (From => In_Stream, Into => Buffer);
      Buffer.Flush;
      Buffer.Close;
      Util.Tests.Assert_Equal_Files (T       => T,
                                     Expect  => Expect,
                                     Test    => Path,
                                     Message => "LZMA stream");
   end Test_Compress_File_Stream;

   procedure Test_Stream_File (T       : in out Test;
                               Item    : in String;
                               Count   : in Positive;
                               Encrypt : in Boolean;
                               Mode    : in Util.Encoders.AES.AES_Mode;
                               Label   : in String) is
      use Ada.Strings.Unbounded;

      Path       : constant String
        := Util.Tests.Get_Test_Path ("stream-lzma-aes-" & Label & ".aes");
      Key        : constant Util.Encoders.Secret_Key
        := Util.Encoders.Create ("0123456789abcdef0123456789abcdef");
      File       : aliased File_Stream;
      Decipher   : aliased Util.Streams.AES.Decoding_Stream;
      Cipher     : aliased Util.Streams.AES.Encoding_Stream;
      Compress   : aliased Util.Streams.Buffered.Lzma.Compress_Stream;
      Decompress : aliased Util.Streams.Buffered.Lzma.Decompress_Stream;
      Print      : Util.Streams.Texts.Print_Stream;
      Reader     : Util.Streams.Texts.Reader_Stream;
   begin
      --  Print -> Compress -> Cipher -> File
      File.Create (Mode => Out_File, Name => Path);
      if Encrypt then
         Cipher.Produces (File'Access, 64);
         Cipher.Set_Key (Key, Mode);
         Compress.Initialize (Cipher'Access, 1024);
      else
         Compress.Initialize (File'Access, 1024);
      end if;
      Print.Initialize (Compress'Access);
      for I in 1 .. Count loop
         Print.Write (Item & ASCII.LF);
      end loop;
      Print.Close;

      --  File -> Decipher -> Decompress -> Reader
      File.Open (Mode => In_File, Name => Path);
      if Encrypt then
         Decipher.Consumes (File'Access, 128);
         Decipher.Set_Key (Key, Mode);
         Decompress.Initialize (Decipher'Access, 1024);
      else
         Decompress.Initialize (File'Access, 1024);
      end if;
      Reader.Initialize (From => Decompress'Access);
      declare
         Line_Count : Natural := 0;
      begin
         while not Reader.Is_Eof loop
            declare
               Line : Unbounded_String;
            begin
               Reader.Read_Line (Line);
               exit when Length (Line) = 0;
               if Item & ASCII.LF /= Line then
                  Util.Tests.Assert_Equals (T, Item & ASCII.LF, To_String (Line));
               end if;
               Line_Count := Line_Count + 1;
            end;
         end loop;
         File.Close;
         Util.Tests.Assert_Equals (T, Count, Line_Count);
      end;
   end Test_Stream_File;

   procedure Test_Compress_Decompress_Stream (T : in out Test) is
   begin
      Test_Stream_File (T, "abcdefgh", 1000, False, Util.Encoders.AES.CBC, "NONE");
   end Test_Compress_Decompress_Stream;

   procedure Test_Compress_Encrypt_Decompress_Decrypt_Stream (T : in out Test) is
   begin
      Test_Stream_File (T, "abcdefgh", 1000, True, Util.Encoders.AES.CBC, "AES-CBC");
   end Test_Compress_Encrypt_Decompress_Decrypt_Stream;

end Util.Streams.Buffered.Lzma.Tests;

Add Test_Compress_Encrypt_Decompress_Decrypt_Stream and register it for execution