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

with Util.Test_Caller;
with Util.Strings.Transforms;

with ADO.Sessions;
with ADO.Schemas.Entities;

with Regtests;
with Regtests.Simple.Model;
package body ADO.Schemas.Tests is

   use Util.Tests;

   function To_Lower_Case (S : in String) return String
     renames Util.Strings.Transforms.To_Lower_Case;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test ADO.Schemas.Entities.Find_Entity_Type",
                       Test_Find_Entity_Type'Access);
      Caller.Add_Test (Suite, "Test ADO.Schemas.Entities.Find_Entity_Type (error)",
                       Test_Find_Entity_Type_Error'Access);
      Caller.Add_Test (Suite, "Test ADO.Sessions.Load_Schema",
                       Test_Load_Schema'Access);
      Caller.Add_Test (Suite, "Test ADO.Schemas.Get_Table",
                       Test_Table_Iterator'Access);
      Caller.Add_Test (Suite, "Test ADO.Schemas.Get_Table (Empty schema)",
                       Test_Empty_Schema'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test reading the entity cache and the Find_Entity_Type operation
   --  ------------------------------
   procedure Test_Find_Entity_Type (T : in out Test) is
      S   : ADO.Sessions.Session := Regtests.Get_Database;
      C   : ADO.Schemas.Entities.Entity_Cache;
   begin
      ADO.Schemas.Entities.Initialize (Cache   => C,
                                       Session => S);

      declare
--           T1 : constant ADO.Model.Entity_Type_Ref
--             := Entities.Find_Entity_Type (Cache => C,
--                                           Table => Regtests.Simple.Model.USER_TABLE'Access);
--           T2 : constant ADO.Model.Entity_Type_Ref
--             := Entities.Find_Entity_Type (Cache => C,
--                                           Table => Regtests.Simple.Model.ALLOCATE_TABLE'Access);

         T4 : constant ADO.Entity_Type
           := Entities.Find_Entity_Type (Cache => C,
                                         Table => Regtests.Simple.Model.ALLOCATE_TABLE);
         T5 : constant ADO.Entity_Type
           := Entities.Find_Entity_Type (Cache => C,
                                         Table => Regtests.Simple.Model.USER_TABLE);
      begin
--           T.Assert (not ADO.Objects.Is_Null (T1), "Find_Entity_Type returned a null value");
--           T.Assert (not ADO.Objects.Is_Null (T2), "Find_Entity_Type returned a null value");

         T.Assert (T4 /= T5, "Two distinct tables have different entity types");
         T.Assert (T4 > 0, "T1.Id must be positive");
         T.Assert (T5 > 0, "T2.Id must be positive");
--           T.Assert (T1.Get_Id /= T2.Get_Id, "Two distinct tables have different ids");
--
--           Assert_Equals (T, Integer (T2.Get_Id), Integer (T4),
--                          "Invalid entity type for allocate_table");
--           Assert_Equals (T, Integer (T1.Get_Id), Integer (T5),
--                          "Invalid entity type for user_table");
      end;
   end Test_Find_Entity_Type;

   --  ------------------------------
   --  Test calling Find_Entity_Type with an invalid table.
   --  ------------------------------
   procedure Test_Find_Entity_Type_Error (T : in out Test) is
      C   : ADO.Schemas.Entities.Entity_Cache;
   begin
      declare
         R : ADO.Entity_Type;
         pragma Unreferenced (R);
      begin
         R := Entities.Find_Entity_Type (Cache => C,
                                         Table => Regtests.Simple.Model.USER_TABLE);
         T.Assert (False, "Find_Entity_Type did not raise the No_Entity_Type exception");

      exception
         when ADO.Schemas.Entities.No_Entity_Type =>
            null;
      end;
   end Test_Find_Entity_Type_Error;

   --  ------------------------------
   --  Test the Load_Schema operation and check the result schema.
   --  ------------------------------
   procedure Test_Load_Schema (T : in out Test) is
      S      : constant ADO.Sessions.Session := Regtests.Get_Database;
      Schema : Schema_Definition;
      Table  : Table_Definition;
   begin
      S.Load_Schema (Schema);

      Table := ADO.Schemas.Find_Table (Schema, "allocate");
      T.Assert (Table /= null, "Table schema for test_allocate not found");

      Assert_Equals (T, "allocate", Get_Name (Table));

      declare
         C : Column_Cursor := Get_Columns (Table);
         Nb_Columns : Integer := 0;
      begin
         while Has_Element (C) loop
            Nb_Columns := Nb_Columns + 1;
            Next (C);
         end loop;
         Assert_Equals (T, 3, Nb_Columns, "Invalid number of columns");
      end;

      declare
         C : constant Column_Definition := Find_Column (Table, "ID");
      begin
         T.Assert (C /= null, "Cannot find column 'id' in table schema");
         Assert_Equals (T, "id", To_Lower_Case (Get_Name (C)), "Invalid column name");
         T.Assert (Get_Type (C) = T_LONG_INTEGER, "Invalid column type");
         T.Assert (not Is_Null (C), "Column is null");
      end;

      declare
         C : constant Column_Definition := Find_Column (Table, "NAME");
      begin
         T.Assert (C /= null, "Cannot find column 'NAME' in table schema");
         Assert_Equals (T, "name", To_Lower_Case (Get_Name (C)), "Invalid column name");
         T.Assert (Get_Type (C) = T_VARCHAR, "Invalid column type");
         T.Assert (Is_Null (C), "Column is null");
      end;

      declare
         C : constant Column_Definition := Find_Column (Table, "version");
      begin
         T.Assert (C /= null, "Cannot find column 'version' in table schema");
         Assert_Equals (T, "version", To_Lower_Case (Get_Name (C)), "Invalid column name");
         T.Assert (Get_Type (C) = T_INTEGER, "Invalid column type");
         T.Assert (not Is_Null (C), "Column is null");
      end;

      declare
         C : constant Column_Definition := Find_Column (Table, "this_column_does_not_exist");
      begin
         T.Assert (C = null, "Find_Column must return null for an unknown column");
      end;
   end Test_Load_Schema;

   --  ------------------------------
   --  Test the Table_Cursor operations and check the result schema.
   --  ------------------------------
   procedure Test_Table_Iterator (T : in out Test) is
      S      : constant ADO.Sessions.Session := Regtests.Get_Database;
      Schema : Schema_Definition;
      Table  : Table_Definition;
      Driver : constant String := S.Get_Driver.Get_Driver_Name;
   begin
      S.Load_Schema (Schema);

      declare
         Iter  : Table_Cursor := Schema.Get_Tables;
         Count : Natural := 0;
      begin
         T.Assert (Has_Element (Iter), "The Get_Tables returns an empty iterator");
         while Has_Element (Iter) loop
            Table := Element (Iter);
            T.Assert (Table /= null, "Element function must not return null");
            declare
               Col_Iter : Column_Cursor := Get_Columns (Table);
            begin
               --  T.Assert (Has_Element (Col_Iter), "Table has a column");
               while Has_Element (Col_Iter) loop
                  T.Assert (Element (Col_Iter) /= null, "Element function must not return null");
                  Next (Col_Iter);
               end loop;
            end;
            Count := Count + 1;
            Next (Iter);
         end loop;
         if Driver = "sqlite" then
            Util.Tests.Assert_Equals (T, 15, Count,
                                      "Invalid number of tables found in the schema");
         elsif Driver = "mysql" then
            Util.Tests.Assert_Equals (T, 8, Count,
                                      "Invalid number of tables found in the schema");
         elsif Driver = "postgresql" then
            Util.Tests.Assert_Equals (T, 8, Count,
                                      "Invalid number of tables found in the schema");
         end if;
      end;
   end Test_Table_Iterator;

   --  ------------------------------
   --  Test the Table_Cursor operations on an empty schema.
   --  ------------------------------
   procedure Test_Empty_Schema (T : in out Test) is
      Schema : Schema_Definition;
      Iter   : constant Table_Cursor := Schema.Get_Tables;
   begin
      T.Assert (not Has_Element (Iter), "The Get_Tables must return an empty iterator");
      T.Assert (Schema.Find_Table ("test") = null, "The Find_Table must return null");
   end Test_Empty_Schema;

end ADO.Schemas.Tests;

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

with Util.Test_Caller;
with Util.Strings.Vectors;
with Util.Strings.Transforms;

with ADO.Configs;
with ADO.Schemas.Databases;
with ADO.Sessions;
with ADO.Schemas.Entities;

with Regtests;
with Regtests.Simple.Model;
package body ADO.Schemas.Tests is

   use Util.Tests;

   function To_Lower_Case (S : in String) return String
     renames Util.Strings.Transforms.To_Lower_Case;

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

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test ADO.Schemas.Entities.Find_Entity_Type",
                       Test_Find_Entity_Type'Access);
      Caller.Add_Test (Suite, "Test ADO.Schemas.Entities.Find_Entity_Type (error)",
                       Test_Find_Entity_Type_Error'Access);
      Caller.Add_Test (Suite, "Test ADO.Sessions.Load_Schema",
                       Test_Load_Schema'Access);
      Caller.Add_Test (Suite, "Test ADO.Schemas.Get_Table",
                       Test_Table_Iterator'Access);
      Caller.Add_Test (Suite, "Test ADO.Schemas.Get_Table (Empty schema)",
                       Test_Empty_Schema'Access);
      Caller.Add_Test (Suite, "Test ADO.Schemas.Databases.Create_Database",
                       Test_Create_Schema'Access);
   end Add_Tests;

   --  ------------------------------
   --  Test reading the entity cache and the Find_Entity_Type operation
   --  ------------------------------
   procedure Test_Find_Entity_Type (T : in out Test) is
      S   : ADO.Sessions.Session := Regtests.Get_Database;
      C   : ADO.Schemas.Entities.Entity_Cache;
   begin
      ADO.Schemas.Entities.Initialize (Cache   => C,
                                       Session => S);

      declare
--           T1 : constant ADO.Model.Entity_Type_Ref
--             := Entities.Find_Entity_Type (Cache => C,
--                                           Table => Regtests.Simple.Model.USER_TABLE'Access);
--           T2 : constant ADO.Model.Entity_Type_Ref
--             := Entities.Find_Entity_Type (Cache => C,
--                                           Table => Regtests.Simple.Model.ALLOCATE_TABLE'Access);

         T4 : constant ADO.Entity_Type
           := Entities.Find_Entity_Type (Cache => C,
                                         Table => Regtests.Simple.Model.ALLOCATE_TABLE);
         T5 : constant ADO.Entity_Type
           := Entities.Find_Entity_Type (Cache => C,
                                         Table => Regtests.Simple.Model.USER_TABLE);
      begin
--           T.Assert (not ADO.Objects.Is_Null (T1), "Find_Entity_Type returned a null value");
--           T.Assert (not ADO.Objects.Is_Null (T2), "Find_Entity_Type returned a null value");

         T.Assert (T4 /= T5, "Two distinct tables have different entity types");
         T.Assert (T4 > 0, "T1.Id must be positive");
         T.Assert (T5 > 0, "T2.Id must be positive");
--           T.Assert (T1.Get_Id /= T2.Get_Id, "Two distinct tables have different ids");
--
--           Assert_Equals (T, Integer (T2.Get_Id), Integer (T4),
--                          "Invalid entity type for allocate_table");
--           Assert_Equals (T, Integer (T1.Get_Id), Integer (T5),
--                          "Invalid entity type for user_table");
      end;
   end Test_Find_Entity_Type;

   --  ------------------------------
   --  Test calling Find_Entity_Type with an invalid table.
   --  ------------------------------
   procedure Test_Find_Entity_Type_Error (T : in out Test) is
      C   : ADO.Schemas.Entities.Entity_Cache;
   begin
      declare
         R : ADO.Entity_Type;
         pragma Unreferenced (R);
      begin
         R := Entities.Find_Entity_Type (Cache => C,
                                         Table => Regtests.Simple.Model.USER_TABLE);
         T.Assert (False, "Find_Entity_Type did not raise the No_Entity_Type exception");

      exception
         when ADO.Schemas.Entities.No_Entity_Type =>
            null;
      end;
   end Test_Find_Entity_Type_Error;

   --  ------------------------------
   --  Test the Load_Schema operation and check the result schema.
   --  ------------------------------
   procedure Test_Load_Schema (T : in out Test) is
      S      : constant ADO.Sessions.Session := Regtests.Get_Database;
      Schema : Schema_Definition;
      Table  : Table_Definition;
   begin
      S.Load_Schema (Schema);

      Table := ADO.Schemas.Find_Table (Schema, "allocate");
      T.Assert (Table /= null, "Table schema for test_allocate not found");

      Assert_Equals (T, "allocate", Get_Name (Table));

      declare
         C : Column_Cursor := Get_Columns (Table);
         Nb_Columns : Integer := 0;
      begin
         while Has_Element (C) loop
            Nb_Columns := Nb_Columns + 1;
            Next (C);
         end loop;
         Assert_Equals (T, 3, Nb_Columns, "Invalid number of columns");
      end;

      declare
         C : constant Column_Definition := Find_Column (Table, "ID");
      begin
         T.Assert (C /= null, "Cannot find column 'id' in table schema");
         Assert_Equals (T, "id", To_Lower_Case (Get_Name (C)), "Invalid column name");
         T.Assert (Get_Type (C) = T_LONG_INTEGER, "Invalid column type");
         T.Assert (not Is_Null (C), "Column is null");
      end;

      declare
         C : constant Column_Definition := Find_Column (Table, "NAME");
      begin
         T.Assert (C /= null, "Cannot find column 'NAME' in table schema");
         Assert_Equals (T, "name", To_Lower_Case (Get_Name (C)), "Invalid column name");
         T.Assert (Get_Type (C) = T_VARCHAR, "Invalid column type");
         T.Assert (Is_Null (C), "Column is null");
      end;

      declare
         C : constant Column_Definition := Find_Column (Table, "version");
      begin
         T.Assert (C /= null, "Cannot find column 'version' in table schema");
         Assert_Equals (T, "version", To_Lower_Case (Get_Name (C)), "Invalid column name");
         T.Assert (Get_Type (C) = T_INTEGER, "Invalid column type");
         T.Assert (not Is_Null (C), "Column is null");
      end;

      declare
         C : constant Column_Definition := Find_Column (Table, "this_column_does_not_exist");
      begin
         T.Assert (C = null, "Find_Column must return null for an unknown column");
      end;
   end Test_Load_Schema;

   --  ------------------------------
   --  Test the Table_Cursor operations and check the result schema.
   --  ------------------------------
   procedure Test_Table_Iterator (T : in out Test) is
      S      : constant ADO.Sessions.Session := Regtests.Get_Database;
      Schema : Schema_Definition;
      Table  : Table_Definition;
      Driver : constant String := S.Get_Driver.Get_Driver_Name;
   begin
      S.Load_Schema (Schema);

      declare
         Iter  : Table_Cursor := Schema.Get_Tables;
         Count : Natural := 0;
      begin
         T.Assert (Has_Element (Iter), "The Get_Tables returns an empty iterator");
         while Has_Element (Iter) loop
            Table := Element (Iter);
            T.Assert (Table /= null, "Element function must not return null");
            declare
               Col_Iter : Column_Cursor := Get_Columns (Table);
            begin
               --  T.Assert (Has_Element (Col_Iter), "Table has a column");
               while Has_Element (Col_Iter) loop
                  T.Assert (Element (Col_Iter) /= null, "Element function must not return null");
                  Next (Col_Iter);
               end loop;
            end;
            Count := Count + 1;
            Next (Iter);
         end loop;
         if Driver = "sqlite" then
            Util.Tests.Assert_Equals (T, 15, Count,
                                      "Invalid number of tables found in the schema");
         elsif Driver = "mysql" then
            Util.Tests.Assert_Equals (T, 8, Count,
                                      "Invalid number of tables found in the schema");
         elsif Driver = "postgresql" then
            Util.Tests.Assert_Equals (T, 8, Count,
                                      "Invalid number of tables found in the schema");
         end if;
      end;
   end Test_Table_Iterator;

   --  ------------------------------
   --  Test the Table_Cursor operations on an empty schema.
   --  ------------------------------
   procedure Test_Empty_Schema (T : in out Test) is
      Schema : Schema_Definition;
      Iter   : constant Table_Cursor := Schema.Get_Tables;
   begin
      T.Assert (not Has_Element (Iter), "The Get_Tables must return an empty iterator");
      T.Assert (Schema.Find_Table ("test") = null, "The Find_Table must return null");
   end Test_Empty_Schema;

   --  ------------------------------
   --  Test the creation of database.
   --  ------------------------------
   procedure Test_Create_Schema (T : in out Test) is
      S      : ADO.Sessions.Master_Session := Regtests.Get_Master_Database;
      Msg    : Util.Strings.Vectors.Vector;
      Cfg    : constant Configs.Configuration := Configs.Configuration (Regtests.Get_Controller);
      Path   : constant String :=
        "db/regtests/" & Cfg.Get_Driver & "/create-ado-" & Cfg.Get_Driver & ".sql";
   begin
      ADO.Schemas.Databases.Create_Database (Session     => S,
                                             Config      => Cfg,
                                             Schema_Path => Path,
                                             Messages    => Msg);

   end Test_Create_Schema;

end ADO.Schemas.Tests;

Implement Test_Create_Schema procedure and register the new test to check the Create_Database operation


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

with Util.Tests;
package EL.Contexts.Tests is

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite);

   type Test is new Util.Tests.Test with null record;

   procedure Test_Context_Properties (T : in out Test);

end EL.Contexts.Tests;

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

with Util.Tests;
package EL.Contexts.Tests is

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite);

   type Test is new Util.Tests.Test with null record;

   procedure Test_Context_Properties (T : in out Test);

   --  Test the thread local EL context.
   procedure Test_Context_TLS (T : in out Test);

end EL.Contexts.Tests;

Declare the Test_Context_TLS procedure

Declare the Test_Context_TLS procedure


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

   --  ------------------------------
   --  Compute the SHA1 signature of the data stored in the buffer.
   --  ------------------------------
   procedure Sha1 (Buffer : in Babel.Files.Buffers.Buffer;
                   Result : out Util.Encoders.SHA1.Hash_Array) is
      Ctx  : Util.Encoders.SHA1.Context;
   begin
      Util.Encoders.SHA1.Update (Ctx, Buffer.Data (Buffer.Data'First .. Buffer.Last));
      Util.Encoders.SHA1.Finish (Ctx, Result);
   end Sha1;

   --  ------------------------------
   --  Write the SHA1 checksum for the files stored in the map.
   --  ------------------------------
   procedure Save_Checksum (Path  : in String;
                            Files : in Babel.Files.Maps.File_Map) is
      Checksum : Ada.Text_IO.File_Type;

      procedure Write_Checksum (Position : in Babel.Files.Maps.File_Cursor) is
         File : constant Babel.Files.File_Type := Babel.Files.Maps.File_Maps.Element (Position);
         SHA1 : constant String := Babel.Files.Get_SHA1 (File);
         Path : constant String := Babel.Files.Get_Path (File);
      begin
         Ada.Text_IO.Put (Checksum, Path);
         Ada.Text_IO.Put (Checksum, ": ");
         Ada.Text_IO.Put_Line (Checksum, SHA1);
      end Write_Checksum;

   begin
      Ada.Text_IO.Create (File => Checksum, Name => Path);
      Files.Iterate (Write_Checksum'Access);
      Ada.Text_IO.Close (File => Checksum);
   end Save_Checksum;

end Babel.Files.Signatures;

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

   --  ------------------------------
   --  Compute the SHA1 signature of the data stored in the buffer.
   --  ------------------------------
   procedure Sha1 (Buffer : in Babel.Files.Buffers.Buffer;
                   Result : out Util.Encoders.SHA1.Hash_Array) is
      Ctx  : Util.Encoders.SHA1.Context;
   begin
      Util.Encoders.SHA1.Update (Ctx, Buffer.Data (Buffer.Data'First .. Buffer.Last));
      Util.Encoders.SHA1.Finish (Ctx, Result);
   end Sha1;

   --  ------------------------------
   --  Compute the SHA1 signature of the file stream.
   --  ------------------------------
   procedure Sha1 (Stream : in Babel.Streams.Refs.Stream_Ref;
                   Result : out Util.Encoders.SHA1.Hash_Array) is
      use type Babel.Files.Buffers.Buffer_Access;

      From_Stream : constant Babel.Streams.Stream_Access := Stream.Value;
      Buffer      : Babel.Files.Buffers.Buffer_Access;
      Ctx         : Util.Encoders.SHA1.Context;
   begin
      From_Stream.Rewind;
      loop
         From_Stream.Read (Buffer);
         exit when Buffer = null;
         Util.Encoders.SHA1.Update (Ctx, Buffer.Data (Buffer.Data'First .. Buffer.Last));
      end loop;
      Util.Encoders.SHA1.Finish (Ctx, Result);
   end Sha1;

   --  ------------------------------
   --  Write the SHA1 checksum for the files stored in the map.
   --  ------------------------------
   procedure Save_Checksum (Path  : in String;
                            Files : in Babel.Files.Maps.File_Map) is
      Checksum : Ada.Text_IO.File_Type;

      procedure Write_Checksum (Position : in Babel.Files.Maps.File_Cursor) is
         File : constant Babel.Files.File_Type := Babel.Files.Maps.File_Maps.Element (Position);
         SHA1 : constant String := Babel.Files.Get_SHA1 (File);
         Path : constant String := Babel.Files.Get_Path (File);
      begin
         Ada.Text_IO.Put (Checksum, Path);
         Ada.Text_IO.Put (Checksum, ": ");
         Ada.Text_IO.Put_Line (Checksum, SHA1);
      end Write_Checksum;

   begin
      Ada.Text_IO.Create (File => Checksum, Name => Path);
      Files.Iterate (Write_Checksum'Access);
      Ada.Text_IO.Close (File => Checksum);
   end Save_Checksum;

end Babel.Files.Signatures;

Implement the Sha1 procedure with a stream


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

--  The ASF.Filters package defines the servlet filter
--  interface described in Java Servlet Specification, JSR 315, 6. Filtering.
--
package ASF.Filters is

   --  ------------------------------
   --  Filter interface
   --  ------------------------------
   --  The Filter interface defines one mandatory procedure through
   --  which the request/response pair are passed.
   --
   --  The Filter instance must be registered in the Servlet_Registry
   --  by using the Add_Filter procedure.  The same filter instance is used
   --  to process multiple requests possibly at the same time.
   type Filter is limited interface;
   type Filter_Access is access all Filter'Class;
   type Filter_List is array (Natural range <>) of Filter_Access;
   type Filter_List_Access is access all Filter_List;

   --  The Do_Filter method of the Filter is called by the container each time
   --  a request/response pair is passed through the chain due to a client request
   --  for a resource at the end of the chain.  The Filter_Chain passed in to this
   --  method allows the Filter to pass on the request and response to the next
   --  entity in the chain.
   --
   --  A typical implementation of this method would follow the following pattern:
   --  1. Examine the request
   --  2. Optionally wrap the request object with a custom implementation to
   --     filter content or headers for input filtering
   --  3. Optionally wrap the response object with a custom implementation to
   --     filter content or headers for output filtering
   --  4. Either invoke the next entity in the chain using the FilterChain
   --     object (chain.Do_Filter()),
   --     or, not pass on the request/response pair to the next entity in the
   --     filter chain to block the request processing
   --  5. Directly set headers on the response after invocation of the next
   --     entity in the filter chain.
   procedure Do_Filter (F        : in Filter;
                        Request  : in out Requests.Request'Class;
                        Response : in out Responses.Response'Class;
                        Chain    : in out ASF.Servlets.Filter_Chain) is abstract;

   --  Called by the servlet container to indicate to a filter that the filter
   --  instance is being placed into service.
   procedure Initialize (Server  : in out Filter;
                         Context : in ASF.Servlets.Servlet_Registry'Class) is null;

end ASF.Filters;

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

--  The ASF.Filters package defines the servlet filter
--  interface described in Java Servlet Specification, JSR 315, 6. Filtering.
--
package ASF.Filters is

   --  ------------------------------
   --  Filter interface
   --  ------------------------------
   --  The Filter interface defines one mandatory procedure through
   --  which the request/response pair are passed.
   --
   --  The Filter instance must be registered in the Servlet_Registry
   --  by using the Add_Filter procedure.  The same filter instance is used
   --  to process multiple requests possibly at the same time.
   type Filter is limited interface;
   type Filter_Access is access all Filter'Class;
   type Filter_List is array (Natural range <>) of Filter_Access;
   type Filter_List_Access is access all Filter_List;

   --  The Do_Filter method of the Filter is called by the container each time
   --  a request/response pair is passed through the chain due to a client request
   --  for a resource at the end of the chain.  The Filter_Chain passed in to this
   --  method allows the Filter to pass on the request and response to the next
   --  entity in the chain.
   --
   --  A typical implementation of this method would follow the following pattern:
   --  1. Examine the request
   --  2. Optionally wrap the request object with a custom implementation to
   --     filter content or headers for input filtering
   --  3. Optionally wrap the response object with a custom implementation to
   --     filter content or headers for output filtering
   --  4. Either invoke the next entity in the chain using the FilterChain
   --     object (chain.Do_Filter()),
   --     or, not pass on the request/response pair to the next entity in the
   --     filter chain to block the request processing
   --  5. Directly set headers on the response after invocation of the next
   --     entity in the filter chain.
   procedure Do_Filter (F        : in Filter;
                        Request  : in out Requests.Request'Class;
                        Response : in out Responses.Response'Class;
                        Chain    : in out ASF.Servlets.Filter_Chain) is abstract;

   --  Called by the servlet container to indicate to a filter that the filter
   --  instance is being placed into service.
   procedure Initialize (Server  : in out Filter;
                         Config  : in ASF.Servlets.Filter_Config) is null;

end ASF.Filters;

Change the Initialize procedure to use a Filter_Config parameter type (this is much conform to the Java Servlet Specification, JSR 315, 6. Filtering)


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

with Ada.IO_Exceptions;

with ADO.Drivers;
with ADO.Sessions.Sources;

with EL.Contexts.Default;
with Util.Files;
with Util.Log.Loggers;

with Security.Policies;

with ASF.Server;
with ASF.Servlets;

with AWA.Services.Contexts;
with AWA.Components.Factory;
with AWA.Applications.Factory;
with AWA.Applications.Configs;
with AWA.Helpers.Selectors;
with AWA.Permissions.Services;
with AWA.Permissions.Beans;
package body AWA.Applications is

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

   --  ------------------------------
   --  Initialize the application
   --  ------------------------------
   overriding
   procedure Initialize (App     : in out Application;
                         Conf    : in ASF.Applications.Config;
                         Factory : in out ASF.Applications.Main.Application_Factory'Class) is
      Ctx    : AWA.Services.Contexts.Service_Context;
   begin
      Log.Info ("Initializing application");

      Ctx.Set_Context (App'Unchecked_Access, null);
      AWA.Applications.Factory.Set_Application (Factory, App'Unchecked_Access);
      ASF.Applications.Main.Application (App).Initialize (Conf, Factory);

      --  Load the application configuration before any module.
      Application'Class (App).Load_Configuration (App.Get_Config (P_Config_File.P));

      --  Register the application modules and load their configuration.
      Application'Class (App).Initialize_Modules;

      --  Load the plugin application configuration after the module are configured.
      Application'Class (App).Load_Configuration (App.Get_Config (P_Plugin_Config_File.P));
   end Initialize;

   --  ------------------------------
   --  Initialize the application configuration properties.  Properties defined in Conf
   --  are expanded by using the EL expression resolver.
   --  ------------------------------
   overriding
   procedure Initialize_Config (App  : in out Application;
                                Conf : in out ASF.Applications.Config) is
      Connection : ADO.Sessions.Sources.Data_Source;
   begin
      Log.Info ("Initializing configuration");

      if Conf.Get ("app.modules.dir", "") = "" then
         Conf.Set ("app.modules.dir", "#{fn:composePath(app_search_dirs,'config')}");
      end if;
      if Conf.Get ("bundle.dir", "") = "" then
         Conf.Set ("bundle.dir", "#{fn:composePath(app_search_dirs,'bundles')}");
      end if;
      if Conf.Get ("ado.queries.paths", "") = "" then
         Conf.Set ("ado.queries.paths", "#{fn:composePath(app_search_dirs,'db')}");
      end if;
      ASF.Applications.Main.Application (App).Initialize_Config (Conf);
      ADO.Drivers.Initialize (Conf);
      Connection.Set_Connection (Conf.Get (P_Database.P));
      Connection.Set_Property ("ado.queries.paths", Conf.Get ("ado.queries.paths", ""));
      Connection.Set_Property ("ado.queries.load", Conf.Get ("ado.queries.load", ""));
      App.DB_Factory.Create (Connection);
      App.DB_Factory.Set_Audit_Manager (App.Audits'Unchecked_Access);
      App.Events.Initialize (App'Unchecked_Access);
      AWA.Modules.Initialize (App.Modules, Conf);

      App.Register_Class ("AWA.Helpers.Selectors.Select_List_Bean",
                          AWA.Helpers.Selectors.Create_Select_List_Bean'Access);

      App.Register_Class ("AWA.Permissions.Beans.Permission_Bean",
                          AWA.Permissions.Beans.Create_Permission_Bean'Access);
   end Initialize_Config;

   --  ------------------------------
   --  Initialize the servlets provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the application servlets.
   --  ------------------------------
   overriding
   procedure Initialize_Servlets (App : in out Application) is
   begin
      Log.Info ("Initializing application servlets");

      ASF.Applications.Main.Application (App).Initialize_Servlets;
   end Initialize_Servlets;

   --  ------------------------------
   --  Initialize the filters provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the application filters.
   --  ------------------------------
   overriding
   procedure Initialize_Filters (App : in out Application) is
   begin
      Log.Info ("Initializing application filters");

      ASF.Applications.Main.Application (App).Initialize_Filters;
   end Initialize_Filters;

   --  ------------------------------
   --  Initialize the ASF components provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the component factories used by the application.
   --  ------------------------------
   overriding
   procedure Initialize_Components (App : in out Application) is
      procedure Register_Functions is
         new ASF.Applications.Main.Register_Functions (AWA.Permissions.Services.Set_Functions);
   begin
      Log.Info ("Initializing application components");

      ASF.Applications.Main.Application (App).Initialize_Components;
      App.Add_Components (AWA.Components.Factory.Definition);
      Register_Functions (App);
   end Initialize_Components;

   --  ------------------------------
   --  Read the application configuration file awa.xml.  This is called after the servlets
   --  and filters have been registered in the application but before the module registration.
   --  ------------------------------
   procedure Load_Configuration (App   : in out Application;
                                 Files : in String) is
      procedure Load_Config (File : in String;
                             Done : out Boolean);

      Paths     : constant String := App.Get_Config (P_Module_Dir.P);
      Ctx       : aliased EL.Contexts.Default.Default_Context;

      procedure Load_Config (File : in String;
                             Done : out Boolean) is
         Path  : constant String := Util.Files.Find_File_Path (File, Paths);
      begin
         Done := False;
         AWA.Applications.Configs.Read_Configuration (App, Path, Ctx'Unchecked_Access, True);

      exception
         when Ada.IO_Exceptions.Name_Error =>
            Log.Warn ("Application configuration file '{0}' does not exist", Path);

      end Load_Config;

   begin
      Util.Files.Iterate_Path (Files, Load_Config'Access);
   end Load_Configuration;

   --  ------------------------------
   --  Initialize the AWA modules provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the modules used by the application.
   --  ------------------------------
   procedure Initialize_Modules (App : in out Application) is
   begin
      null;
   end Initialize_Modules;

   --  ------------------------------
   --  Start the application.  This is called by the server container when the server is started.
   --  ------------------------------
   overriding
   procedure Start (App : in out Application) is
      Manager : constant Security.Policies.Policy_Manager_Access
        := App.Get_Security_Manager;
   begin
      --  Start the security manager.
      AWA.Permissions.Services.Permission_Manager'Class (Manager.all).Start;

      --  Start the event service.
      App.Events.Start;

      --  Start the application.
      ASF.Applications.Main.Application (App).Start;

      --  Dump the route and filters to help in configuration issues.
      App.Dump_Routes (Util.Log.INFO_LEVEL);
   end Start;

   --  ------------------------------
   --  Close the application.
   --  ------------------------------
   overriding
   procedure Close (App : in out Application) is
   begin
      App.Events.Stop;
      ASF.Applications.Main.Application (App).Close;
   end Close;

   --  ------------------------------
   --  Register the module in the application
   --  ------------------------------
   procedure Register (App     : in Application_Access;
                       Module  : access AWA.Modules.Module'Class;
                       Name    : in String;
                       URI     : in String := "") is
   begin
      App.Register (Module.all'Unchecked_Access, Name, URI);
   end Register;

   --  ------------------------------
   --  Get the database connection for reading
   --  ------------------------------
   function Get_Session (App : Application)
                         return ADO.Sessions.Session is
   begin
      return App.DB_Factory.Get_Session;
   end Get_Session;

   --  ------------------------------
   --  Get the database connection for writing
   --  ------------------------------
   function Get_Master_Session (App : Application)
                                return ADO.Sessions.Master_Session is
   begin
      return App.DB_Factory.Get_Master_Session;
   end Get_Master_Session;

   --  ------------------------------
   --  Find the module with the given name
   --  ------------------------------
   function Find_Module (App : in Application;
                         Name : in String) return AWA.Modules.Module_Access is
   begin
      return AWA.Modules.Find_By_Name (App.Modules, Name);
   end Find_Module;

   --  ------------------------------
   --  Register the module in the application
   --  ------------------------------
   procedure Register (App     : in out Application;
                       Module  : in AWA.Modules.Module_Access;
                       Name    : in String;
                       URI     : in String := "") is
   begin
      AWA.Modules.Register (App.Modules'Unchecked_Access, App'Unchecked_Access, Module, Name, URI);
   end Register;

   --  ------------------------------
   --  Send the event in the application event queues.
   --  ------------------------------
   procedure Send_Event (App   : in Application;
                         Event : in AWA.Events.Module_Event'Class) is
   begin
      App.Events.Send (Event);
   end Send_Event;

   --  ------------------------------
   --  Execute the <tt>Process</tt> procedure with the event manager used by the application.
   --  ------------------------------
   procedure Do_Event_Manager (App : in out Application;
                               Process : access procedure
                                 (Events : in out AWA.Events.Services.Event_Manager)) is
   begin
      Process (App.Events);
   end Do_Event_Manager;

   --  ------------------------------
   --  Initialize the parser represented by Parser to recognize the configuration
   --  that are specific to the plugins that have been registered so far.
   --  ------------------------------
   procedure Initialize_Parser (App : in out Application'Class;
                                Parser : in out Util.Serialize.IO.Parser'Class) is
      procedure Process (Module : in out AWA.Modules.Module'Class);

      procedure Process (Module : in out AWA.Modules.Module'Class) is
      begin
         Module.Initialize_Parser (Parser);
      end Process;
   begin
      AWA.Modules.Iterate (App.Modules, Process'Access);
   end Initialize_Parser;

   --  ------------------------------
   --  Get the current application from the servlet context or service context.
   --  ------------------------------
   function Current return Application_Access is
      use type AWA.Services.Contexts.Service_Context_Access;

      Ctx : constant AWA.Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
   begin
      if Ctx /= null then
         return Ctx.Get_Application;
      end if;

      --  If there is no service context, look in the servlet current context.
      declare
         use type ASF.Servlets.Servlet_Registry_Access;

         Ctx : constant ASF.Servlets.Servlet_Registry_Access := ASF.Server.Current;
      begin
         if Ctx = null then
            Log.Warn ("There is no service context");
            return null;
         end if;
         if not (Ctx.all in AWA.Applications.Application'Class) then
            Log.Warn ("The servlet context is not an application");
            return null;
         end if;
         return AWA.Applications.Application'Class (Ctx.all)'Access;
      end;
   end Current;

end AWA.Applications;

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

with Ada.IO_Exceptions;

with ADO.Drivers;
with ADO.Sessions.Sources;

with EL.Contexts.Default;
with Util.Files;
with Util.Log.Loggers;

with Security.Policies;

with ASF.Server;
with ASF.Servlets;

with AWA.Services.Contexts;
with AWA.Components.Factory;
with AWA.Applications.Factory;
with AWA.Applications.Configs;
with AWA.Helpers.Selectors;
with AWA.Permissions.Services;
with AWA.Permissions.Beans;
package body AWA.Applications is

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

   --  ------------------------------
   --  Initialize the application
   --  ------------------------------
   overriding
   procedure Initialize (App     : in out Application;
                         Conf    : in ASF.Applications.Config;
                         Factory : in out ASF.Applications.Main.Application_Factory'Class) is
      Ctx    : AWA.Services.Contexts.Service_Context;
   begin
      Log.Info ("Initializing application");

      Ctx.Set_Context (App'Unchecked_Access, null);
      AWA.Applications.Factory.Set_Application (Factory, App'Unchecked_Access);
      ASF.Applications.Main.Application (App).Initialize (Conf, Factory);

      --  Load the application configuration before any module.
      Application'Class (App).Load_Configuration (App.Get_Config (P_Config_File.P));

      --  Register the application modules and load their configuration.
      Application'Class (App).Initialize_Modules;

      --  Load the plugin application configuration after the module are configured.
      Application'Class (App).Load_Configuration (App.Get_Config (P_Plugin_Config_File.P));
   end Initialize;

   --  ------------------------------
   --  Initialize the application configuration properties.  Properties defined in Conf
   --  are expanded by using the EL expression resolver.
   --  ------------------------------
   overriding
   procedure Initialize_Config (App  : in out Application;
                                Conf : in out ASF.Applications.Config) is
      Connection : ADO.Sessions.Sources.Data_Source;
   begin
      Log.Info ("Initializing configuration");

      if Conf.Get ("app.modules.dir", "") = "" then
         Conf.Set ("app.modules.dir", "#{fn:composePath(app_search_dirs,'config')}");
      end if;
      if Conf.Get ("bundle.dir", "") = "" then
         Conf.Set ("bundle.dir", "#{fn:composePath(app_search_dirs,'bundles')}");
      end if;
      if Conf.Get ("ado.queries.paths", "") = "" then
         Conf.Set ("ado.queries.paths", "#{fn:composePath(app_search_dirs,'db')}");
      end if;
      ASF.Applications.Main.Application (App).Initialize_Config (Conf);
      ADO.Drivers.Initialize (Conf);
      Connection.Set_Connection (Conf.Get (P_Database.P));
      Connection.Set_Property ("ado.queries.paths", Conf.Get ("ado.queries.paths", ""));
      Connection.Set_Property ("ado.queries.load", Conf.Get ("ado.queries.load", ""));
      App.DB_Factory.Create (Connection);
      App.DB_Factory.Set_Audit_Manager (App.Audits'Unchecked_Access);
      App.Audits.Initialize (App'Unchecked_Access);
      App.Events.Initialize (App'Unchecked_Access);
      AWA.Modules.Initialize (App.Modules, Conf);

      App.Register_Class ("AWA.Helpers.Selectors.Select_List_Bean",
                          AWA.Helpers.Selectors.Create_Select_List_Bean'Access);

      App.Register_Class ("AWA.Permissions.Beans.Permission_Bean",
                          AWA.Permissions.Beans.Create_Permission_Bean'Access);
   end Initialize_Config;

   --  ------------------------------
   --  Initialize the servlets provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the application servlets.
   --  ------------------------------
   overriding
   procedure Initialize_Servlets (App : in out Application) is
   begin
      Log.Info ("Initializing application servlets");

      ASF.Applications.Main.Application (App).Initialize_Servlets;
   end Initialize_Servlets;

   --  ------------------------------
   --  Initialize the filters provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the application filters.
   --  ------------------------------
   overriding
   procedure Initialize_Filters (App : in out Application) is
   begin
      Log.Info ("Initializing application filters");

      ASF.Applications.Main.Application (App).Initialize_Filters;
   end Initialize_Filters;

   --  ------------------------------
   --  Initialize the ASF components provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the component factories used by the application.
   --  ------------------------------
   overriding
   procedure Initialize_Components (App : in out Application) is
      procedure Register_Functions is
         new ASF.Applications.Main.Register_Functions (AWA.Permissions.Services.Set_Functions);
   begin
      Log.Info ("Initializing application components");

      ASF.Applications.Main.Application (App).Initialize_Components;
      App.Add_Components (AWA.Components.Factory.Definition);
      Register_Functions (App);
   end Initialize_Components;

   --  ------------------------------
   --  Read the application configuration file awa.xml.  This is called after the servlets
   --  and filters have been registered in the application but before the module registration.
   --  ------------------------------
   procedure Load_Configuration (App   : in out Application;
                                 Files : in String) is
      procedure Load_Config (File : in String;
                             Done : out Boolean);

      Paths     : constant String := App.Get_Config (P_Module_Dir.P);
      Ctx       : aliased EL.Contexts.Default.Default_Context;

      procedure Load_Config (File : in String;
                             Done : out Boolean) is
         Path  : constant String := Util.Files.Find_File_Path (File, Paths);
      begin
         Done := False;
         AWA.Applications.Configs.Read_Configuration (App, Path, Ctx'Unchecked_Access, True);

      exception
         when Ada.IO_Exceptions.Name_Error =>
            Log.Warn ("Application configuration file '{0}' does not exist", Path);

      end Load_Config;

   begin
      Util.Files.Iterate_Path (Files, Load_Config'Access);
   end Load_Configuration;

   --  ------------------------------
   --  Initialize the AWA modules provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the modules used by the application.
   --  ------------------------------
   procedure Initialize_Modules (App : in out Application) is
   begin
      null;
   end Initialize_Modules;

   --  ------------------------------
   --  Start the application.  This is called by the server container when the server is started.
   --  ------------------------------
   overriding
   procedure Start (App : in out Application) is
      Manager : constant Security.Policies.Policy_Manager_Access
        := App.Get_Security_Manager;
   begin
      --  Start the security manager.
      AWA.Permissions.Services.Permission_Manager'Class (Manager.all).Start;

      --  Start the event service.
      App.Events.Start;

      --  Start the application.
      ASF.Applications.Main.Application (App).Start;

      --  Dump the route and filters to help in configuration issues.
      App.Dump_Routes (Util.Log.INFO_LEVEL);
   end Start;

   --  ------------------------------
   --  Close the application.
   --  ------------------------------
   overriding
   procedure Close (App : in out Application) is
   begin
      App.Events.Stop;
      ASF.Applications.Main.Application (App).Close;
   end Close;

   --  ------------------------------
   --  Register the module in the application
   --  ------------------------------
   procedure Register (App     : in Application_Access;
                       Module  : access AWA.Modules.Module'Class;
                       Name    : in String;
                       URI     : in String := "") is
   begin
      App.Register (Module.all'Unchecked_Access, Name, URI);
   end Register;

   --  ------------------------------
   --  Get the database connection for reading
   --  ------------------------------
   function Get_Session (App : Application)
                         return ADO.Sessions.Session is
   begin
      return App.DB_Factory.Get_Session;
   end Get_Session;

   --  ------------------------------
   --  Get the database connection for writing
   --  ------------------------------
   function Get_Master_Session (App : Application)
                                return ADO.Sessions.Master_Session is
   begin
      return App.DB_Factory.Get_Master_Session;
   end Get_Master_Session;

   --  ------------------------------
   --  Find the module with the given name
   --  ------------------------------
   function Find_Module (App : in Application;
                         Name : in String) return AWA.Modules.Module_Access is
   begin
      return AWA.Modules.Find_By_Name (App.Modules, Name);
   end Find_Module;

   --  ------------------------------
   --  Register the module in the application
   --  ------------------------------
   procedure Register (App     : in out Application;
                       Module  : in AWA.Modules.Module_Access;
                       Name    : in String;
                       URI     : in String := "") is
   begin
      AWA.Modules.Register (App.Modules'Unchecked_Access, App'Unchecked_Access, Module, Name, URI);
   end Register;

   --  ------------------------------
   --  Send the event in the application event queues.
   --  ------------------------------
   procedure Send_Event (App   : in Application;
                         Event : in AWA.Events.Module_Event'Class) is
   begin
      App.Events.Send (Event);
   end Send_Event;

   --  ------------------------------
   --  Execute the <tt>Process</tt> procedure with the event manager used by the application.
   --  ------------------------------
   procedure Do_Event_Manager (App : in out Application;
                               Process : access procedure
                                 (Events : in out AWA.Events.Services.Event_Manager)) is
   begin
      Process (App.Events);
   end Do_Event_Manager;

   --  ------------------------------
   --  Initialize the parser represented by Parser to recognize the configuration
   --  that are specific to the plugins that have been registered so far.
   --  ------------------------------
   procedure Initialize_Parser (App : in out Application'Class;
                                Parser : in out Util.Serialize.IO.Parser'Class) is
      procedure Process (Module : in out AWA.Modules.Module'Class);

      procedure Process (Module : in out AWA.Modules.Module'Class) is
      begin
         Module.Initialize_Parser (Parser);
      end Process;
   begin
      AWA.Modules.Iterate (App.Modules, Process'Access);
   end Initialize_Parser;

   --  ------------------------------
   --  Get the current application from the servlet context or service context.
   --  ------------------------------
   function Current return Application_Access is
      use type AWA.Services.Contexts.Service_Context_Access;

      Ctx : constant AWA.Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
   begin
      if Ctx /= null then
         return Ctx.Get_Application;
      end if;

      --  If there is no service context, look in the servlet current context.
      declare
         use type ASF.Servlets.Servlet_Registry_Access;

         Ctx : constant ASF.Servlets.Servlet_Registry_Access := ASF.Server.Current;
      begin
         if Ctx = null then
            Log.Warn ("There is no service context");
            return null;
         end if;
         if not (Ctx.all in AWA.Applications.Application'Class) then
            Log.Warn ("The servlet context is not an application");
            return null;
         end if;
         return AWA.Applications.Application'Class (Ctx.all)'Access;
      end;
   end Current;

end AWA.Applications;

Initialize the audit manager

Initialize the audit manager


------------------------------------------------------------------------------
-- Copyright (c) 2016, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

package body Natools.Smaz_Implementations.Base_64 is

   package Tools renames Natools.Smaz_Implementations.Base_64_Tools;

   use type Ada.Streams.Stream_Element_Offset;
   use type Tools.Base_64_Digit;

   ----------------------
   -- Public Interface --
   ----------------------

   procedure Read_Code
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Code : out Natools.Smaz_Implementations.Base_64_Tools.Base_64_Digit;
      Verbatim_Length : out Natural;
      Last_Code : in Natools.Smaz_Implementations.Base_64_Tools.Base_64_Digit;
      Variable_Length_Verbatim : in Boolean)
   is
      Ignored : String (1 .. 2);
      Offset_Backup : Ada.Streams.Stream_Element_Offset;
   begin
      Tools.Next_Digit (Input, Offset, Code);

      if Code <= Last_Code then
         Verbatim_Length := 0;

      elsif Variable_Length_Verbatim then
         Verbatim_Length := 64 - Natural (Code);
         Code := 0;

      elsif Code = 63 then
         Tools.Next_Digit (Input, Offset, Code);
         Verbatim_Length := Natural (Code) * 3 + 3;
         Code := 0;

      elsif Code = 62 then
         Offset_Backup := Offset;
         Tools.Decode_Single (Input, Offset, Ignored (1), Code);
         Verbatim_Length := Natural (Code) * 3 + 1;
         Offset := Offset_Backup;
         Code := 0;

      else
         Offset_Backup := Offset;
         Verbatim_Length := (61 - Natural (Code)) * 4;
         Tools.Decode_Double (Input, Offset, Ignored, Code);
         Verbatim_Length := (Verbatim_Length + Natural (Code)) * 3 + 2;
         Offset := Offset_Backup;
         Code := 0;
      end if;
   end Read_Code;

   procedure Read_Verbatim
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Output : out String)
   is
      Ignored : Tools.Base_64_Digit;
      Output_Index : Natural := Output'First - 1;
   begin
      if Output'Length mod 3 = 1 then
         Tools.Decode_Single
           (Input, Offset, Output (Output_Index + 1), Ignored);
         Output_Index := Output_Index + 1;
      elsif Output'Length mod 3 = 2 then
         Tools.Decode_Double
           (Input, Offset,
            Output (Output_Index + 1 .. Output_Index + 2), Ignored);
         Output_Index := Output_Index + 2;
      end if;

      if Output_Index < Output'Last then
         Tools.Decode
           (Input, Offset, Output (Output_Index + 1 .. Output'Last));
      end if;
   end Read_Verbatim;

   procedure Skip_Verbatim
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Verbatim_Length : in Positive)
   is
      Code : Tools.Base_64_Digit;
   begin
      for I in 1 .. Tools.Image_Length (Verbatim_Length) loop
         Tools.Next_Digit (Input, Offset, Code);
      end loop;
   end Skip_Verbatim;

   function Verbatim_Size
     (Input_Length : in Positive;
      Last_Code : in Natools.Smaz_Implementations.Base_64_Tools.Base_64_Digit;
      Variable_Length_Verbatim : in Boolean)
     return Ada.Streams.Stream_Element_Count is
   begin
      if Variable_Length_Verbatim then
         declare
            Largest_Run : constant Positive := 63 - Natural (Last_Code);
            Run_Count : constant Positive
              := (Input_Length + Largest_Run - 1) / Largest_Run;
            Last_Run_Size : constant Positive
              := Input_Length - (Run_Count - 1) * Largest_Run;
         begin
            return Ada.Streams.Stream_Element_Count (Run_Count - 1)
                    * (Tools.Image_Length (Largest_Run) + 1)
                 + Tools.Image_Length (Last_Run_Size) + 1;
         end;
      elsif Input_Length mod 3 = 0 then
         declare
            Largest_Run : constant Positive := 64 * 3;
            Run_Count : constant Positive
              := (Input_Length + Largest_Run - 1) / Largest_Run;
            Last_Run_Size : constant Positive
              := Input_Length - (Run_Count - 1) * Largest_Run;
         begin
            return Ada.Streams.Stream_Element_Count (Run_Count - 1)
                    * (Tools.Image_Length (Largest_Run) + 2)
                 + Tools.Image_Length (Last_Run_Size) + 2;
         end;
      elsif Input_Length mod 3 = 1 then
         declare
            Largest_Final_Run : constant Positive := 15 * 3 + 1;
            Largest_Prefix_Run : constant Positive := 64 * 3;
            Prefix_Run_Count : constant Natural
              := (Input_Length + Largest_Prefix_Run - Largest_Final_Run)
               / Largest_Prefix_Run;
            Last_Run_Size : constant Positive
              := Input_Length - Prefix_Run_Count * Largest_Prefix_Run;
         begin
            return Ada.Streams.Stream_Element_Count (Prefix_Run_Count)
                    * (Tools.Image_Length (Largest_Prefix_Run) + 2)
                 + Tools.Image_Length (Last_Run_Size) + 1;
         end;
      elsif Input_Length mod 3 = 2 then
         declare
            Largest_Final_Run : constant Positive
              := ((62 - Natural (Last_Code)) * 4 - 1) * 3 + 2;
            Largest_Prefix_Run : constant Positive := 64 * 3;
            Prefix_Run_Count : constant Natural
              := (Input_Length + Largest_Prefix_Run - Largest_Final_Run)
               / Largest_Prefix_Run;
            Last_Run_Size : constant Positive
              := Input_Length - Prefix_Run_Count * Largest_Prefix_Run;
         begin
            return Ada.Streams.Stream_Element_Count (Prefix_Run_Count)
                    * (Tools.Image_Length (Largest_Prefix_Run) + 2)
                 + Tools.Image_Length (Last_Run_Size) + 1;
         end;
      else
         raise Program_Error with "Condition unreachable";
      end if;
   end Verbatim_Size;

   procedure Write_Code
     (Output : in out Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Code : in Natools.Smaz_Implementations.Base_64_Tools.Base_64_Digit) is
   begin
      Output (Offset) := Tools.Image (Code);
      Offset := Offset + 1;
   end Write_Code;

   procedure Write_Verbatim
     (Output : in out Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Input : in String;
      Last_Code : in Natools.Smaz_Implementations.Base_64_Tools.Base_64_Digit;
      Variable_Length_Verbatim : in Boolean)
   is
      Index : Positive := Input'First;
   begin
      if Variable_Length_Verbatim then
         declare
            Largest_Run : constant Positive := 63 - Natural (Last_Code);
            Length, Last : Positive;
         begin
            while Index in Input'Range loop
               Length := Positive'Min (Largest_Run, Input'Last + 1 - Index);
               Last := Index + Length - 1;
               Output (Offset)
                 := Tools.Image (63 - Tools.Base_64_Digit (Length - 1));
               Offset := Offset + 1;
               Tools.Encode (Input (Index .. Last), Output, Offset);
               Index := Last + 1;
            end loop;
         end;
      else
         if Input'Length mod 3 = 1 then
            declare
               Extra_Blocks : constant Natural
                 := Natural'Min (15, Input'Length / 3);
            begin
               Output (Offset) := Tools.Image (62);
               Offset := Offset + 1;

               Tools.Encode_Single
                 (Input (Index), Tools.Single_Byte_Padding (Extra_Blocks),
                  Output, Offset);
               Index := Index + 1;

               if Extra_Blocks > 0 then
                  Tools.Encode
                    (Input (Index .. Index + Extra_Blocks * 3 - 1),
                     Output, Offset);
                  Index := Index + Extra_Blocks * 3;
               end if;
            end;
         elsif Input'Length mod 3 = 2 then
            declare
               Extra_Blocks : constant Natural := Natural'Min
                 (Input'Length / 3,
                  (62 - Natural (Last_Code)) * 4 - 1);
            begin
               Output (Offset)
                 := Tools.Image (61 - Tools.Base_64_Digit (Extra_Blocks / 4));
               Offset := Offset + 1;

               Tools.Encode_Double
                 (Input (Index .. Index + 1),
                  Tools.Double_Byte_Padding (Extra_Blocks mod 4),
                  Output, Offset);
               Index := Index + 1;

               if Extra_Blocks > 0 then
                  Tools.Encode
                    (Input (Index .. Index + Extra_Blocks * 3 - 1),
                     Output, Offset);
                  Index := Index + Extra_Blocks * 3;
               end if;
            end;
         end if;

         pragma Assert ((Input'Last + 1 - Index) mod 3 = 0);

         while Index <= Input'Last loop
            declare
               Block_Count : constant Natural
                 := Natural'Min (64, (Input'Last + 1 - Index) / 3);
            begin
               Output (Offset) := Tools.Image (63);
               Output (Offset + 1)
                 := Tools.Image (Tools.Base_64_Digit (Block_Count - 1));
               Offset := Offset + 2;

               Tools.Encode
                 (Input (Index .. Index + Block_Count * 3 - 1),
                  Output, Offset);
               Index := Index + Block_Count * 3;
            end;
         end loop;
      end if;
   end Write_Verbatim;

end Natools.Smaz_Implementations.Base_64;

------------------------------------------------------------------------------
-- Copyright (c) 2016, Natacha Porté                                        --
--                                                                          --
-- Permission to use, copy, modify, and distribute this software for any    --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES --
-- WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF         --
-- MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR  --
-- ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES   --
-- WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN    --
-- ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF  --
-- OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.           --
------------------------------------------------------------------------------

package body Natools.Smaz_Implementations.Base_64 is

   package Tools renames Natools.Smaz_Implementations.Base_64_Tools;

   use type Ada.Streams.Stream_Element_Offset;
   use type Tools.Base_64_Digit;

   ----------------------
   -- Public Interface --
   ----------------------

   procedure Read_Code
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Code : out Natools.Smaz_Implementations.Base_64_Tools.Base_64_Digit;
      Verbatim_Length : out Natural;
      Last_Code : in Natools.Smaz_Implementations.Base_64_Tools.Base_64_Digit;
      Variable_Length_Verbatim : in Boolean)
   is
      Ignored : String (1 .. 2);
      Offset_Backup : Ada.Streams.Stream_Element_Offset;
   begin
      Tools.Next_Digit (Input, Offset, Code);

      if Code <= Last_Code then
         Verbatim_Length := 0;

      elsif Variable_Length_Verbatim then
         Verbatim_Length := 64 - Natural (Code);
         Code := 0;

      elsif Code = 63 then
         Tools.Next_Digit (Input, Offset, Code);
         Verbatim_Length := Natural (Code) * 3 + 3;
         Code := 0;

      elsif Code = 62 then
         Offset_Backup := Offset;
         Tools.Decode_Single (Input, Offset, Ignored (1), Code);
         Verbatim_Length := Natural (Code) * 3 + 1;
         Offset := Offset_Backup;
         Code := 0;

      else
         Offset_Backup := Offset;
         Verbatim_Length := (61 - Natural (Code)) * 4;
         Tools.Decode_Double (Input, Offset, Ignored, Code);
         Verbatim_Length := (Verbatim_Length + Natural (Code)) * 3 + 2;
         Offset := Offset_Backup;
         Code := 0;
      end if;
   end Read_Code;

   procedure Read_Verbatim
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Output : out String)
   is
      Ignored : Tools.Base_64_Digit;
      Output_Index : Natural := Output'First - 1;
   begin
      if Output'Length mod 3 = 1 then
         Tools.Decode_Single
           (Input, Offset, Output (Output_Index + 1), Ignored);
         Output_Index := Output_Index + 1;
      elsif Output'Length mod 3 = 2 then
         Tools.Decode_Double
           (Input, Offset,
            Output (Output_Index + 1 .. Output_Index + 2), Ignored);
         Output_Index := Output_Index + 2;
      end if;

      if Output_Index < Output'Last then
         Tools.Decode
           (Input, Offset, Output (Output_Index + 1 .. Output'Last));
      end if;
   end Read_Verbatim;

   procedure Skip_Verbatim
     (Input : in Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Verbatim_Length : in Positive)
   is
      Code : Tools.Base_64_Digit;
   begin
      for I in 1 .. Tools.Image_Length (Verbatim_Length) loop
         Tools.Next_Digit (Input, Offset, Code);
      end loop;
   end Skip_Verbatim;

   function Verbatim_Size
     (Input_Length : in Positive;
      Last_Code : in Natools.Smaz_Implementations.Base_64_Tools.Base_64_Digit;
      Variable_Length_Verbatim : in Boolean)
     return Ada.Streams.Stream_Element_Count is
   begin
      if Variable_Length_Verbatim then
         declare
            Largest_Run : constant Positive := 63 - Natural (Last_Code);
            Run_Count : constant Positive
              := (Input_Length + Largest_Run - 1) / Largest_Run;
            Last_Run_Size : constant Positive
              := Input_Length - (Run_Count - 1) * Largest_Run;
         begin
            return Ada.Streams.Stream_Element_Count (Run_Count - 1)
                    * (Tools.Image_Length (Largest_Run) + 1)
                 + Tools.Image_Length (Last_Run_Size) + 1;
         end;
      elsif Input_Length mod 3 = 0 then
         declare
            Largest_Run : constant Positive := 64 * 3;
            Run_Count : constant Positive
              := (Input_Length + Largest_Run - 1) / Largest_Run;
            Last_Run_Size : constant Positive
              := Input_Length - (Run_Count - 1) * Largest_Run;
         begin
            return Ada.Streams.Stream_Element_Count (Run_Count - 1)
                    * (Tools.Image_Length (Largest_Run) + 2)
                 + Tools.Image_Length (Last_Run_Size) + 2;
         end;
      elsif Input_Length mod 3 = 1 then
         declare
            Largest_Final_Run : constant Positive := 15 * 3 + 1;
            Largest_Prefix_Run : constant Positive := 64 * 3;
            Prefix_Run_Count : constant Natural
              := (Input_Length + Largest_Prefix_Run - Largest_Final_Run)
               / Largest_Prefix_Run;
            Last_Run_Size : constant Positive
              := Input_Length - Prefix_Run_Count * Largest_Prefix_Run;
         begin
            return Ada.Streams.Stream_Element_Count (Prefix_Run_Count)
                    * (Tools.Image_Length (Largest_Prefix_Run) + 2)
                 + Tools.Image_Length (Last_Run_Size) + 1;
         end;
      elsif Input_Length mod 3 = 2 then
         declare
            Largest_Final_Run : constant Positive
              := ((62 - Natural (Last_Code)) * 4 - 1) * 3 + 2;
            Largest_Prefix_Run : constant Positive := 64 * 3;
            Prefix_Run_Count : constant Natural
              := (Input_Length + Largest_Prefix_Run - Largest_Final_Run)
               / Largest_Prefix_Run;
            Last_Run_Size : constant Positive
              := Input_Length - Prefix_Run_Count * Largest_Prefix_Run;
         begin
            return Ada.Streams.Stream_Element_Count (Prefix_Run_Count)
                    * (Tools.Image_Length (Largest_Prefix_Run) + 2)
                 + Tools.Image_Length (Last_Run_Size) + 1;
         end;
      else
         raise Program_Error with "Condition unreachable";
      end if;
   end Verbatim_Size;

   procedure Write_Code
     (Output : in out Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Code : in Natools.Smaz_Implementations.Base_64_Tools.Base_64_Digit) is
   begin
      Output (Offset) := Tools.Image (Code);
      Offset := Offset + 1;
   end Write_Code;

   procedure Write_Verbatim
     (Output : in out Ada.Streams.Stream_Element_Array;
      Offset : in out Ada.Streams.Stream_Element_Offset;
      Input : in String;
      Last_Code : in Natools.Smaz_Implementations.Base_64_Tools.Base_64_Digit;
      Variable_Length_Verbatim : in Boolean)
   is
      Index : Positive := Input'First;
   begin
      if Variable_Length_Verbatim then
         declare
            Largest_Run : constant Positive := 63 - Natural (Last_Code);
            Length, Last : Positive;
         begin
            while Index in Input'Range loop
               Length := Positive'Min (Largest_Run, Input'Last + 1 - Index);
               Last := Index + Length - 1;
               Output (Offset)
                 := Tools.Image (63 - Tools.Base_64_Digit (Length - 1));
               Offset := Offset + 1;
               Tools.Encode (Input (Index .. Last), Output, Offset);
               Index := Last + 1;
            end loop;
         end;
      else
         if Input'Length mod 3 = 1 then
            declare
               Extra_Blocks : constant Natural
                 := Natural'Min (15, Input'Length / 3);
            begin
               Output (Offset) := Tools.Image (62);
               Offset := Offset + 1;

               Tools.Encode_Single
                 (Input (Index), Tools.Single_Byte_Padding (Extra_Blocks),
                  Output, Offset);
               Index := Index + 1;

               if Extra_Blocks > 0 then
                  Tools.Encode
                    (Input (Index .. Index + Extra_Blocks * 3 - 1),
                     Output, Offset);
                  Index := Index + Extra_Blocks * 3;
               end if;
            end;
         elsif Input'Length mod 3 = 2 then
            declare
               Extra_Blocks : constant Natural := Natural'Min
                 (Input'Length / 3,
                  (62 - Natural (Last_Code)) * 4 - 1);
            begin
               Output (Offset)
                 := Tools.Image (61 - Tools.Base_64_Digit (Extra_Blocks / 4));
               Offset := Offset + 1;

               Tools.Encode_Double
                 (Input (Index .. Index + 1),
                  Tools.Double_Byte_Padding (Extra_Blocks mod 4),
                  Output, Offset);
               Index := Index + 2;

               if Extra_Blocks > 0 then
                  Tools.Encode
                    (Input (Index .. Index + Extra_Blocks * 3 - 1),
                     Output, Offset);
                  Index := Index + Extra_Blocks * 3;
               end if;
            end;
         end if;

         pragma Assert ((Input'Last + 1 - Index) mod 3 = 0);

         while Index <= Input'Last loop
            declare
               Block_Count : constant Natural
                 := Natural'Min (64, (Input'Last + 1 - Index) / 3);
            begin
               Output (Offset) := Tools.Image (63);
               Output (Offset + 1)
                 := Tools.Image (Tools.Base_64_Digit (Block_Count - 1));
               Offset := Offset + 2;

               Tools.Encode
                 (Input (Index .. Index + Block_Count * 3 - 1),
                  Output, Offset);
               Index := Index + Block_Count * 3;
            end;
         end loop;
      end if;
   end Write_Verbatim;

end Natools.Smaz_Implementations.Base_64;

smaz_implementations-base_64: fix index update in encoding 3n+2 vrbtim


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

with Util.Locales;
with Util.Strings;
with Util.Properties.Bundles;

with ASF.Locales;
with ASF.Utils;
with ASF.Applications.Main;

package body ASF.Converters.Sizes is

   ONE_KB  : constant Long_Long_Integer := 1_024;
   ONE_MB  : constant Long_Long_Integer := ONE_KB * 1_024;
   ONE_GB  : constant Long_Long_Integer := ONE_MB * 1_024;

   UNIT_GB : aliased constant String := "size_giga_bytes";
   UNIT_MB : aliased constant String := "size_mega_bytes";
   UNIT_KB : aliased constant String := "size_kilo_bytes";
   UNIT_B  : aliased constant String := "size_bytes";

   --  ------------------------------
   --  Convert the object value into a string.  The object value is associated
   --  with the specified component.
   --  If the string cannot be converted, the Invalid_Conversion exception should be raised.
   --  ------------------------------
   function To_String (Convert   : in Size_Converter;
                       Context   : in ASF.Contexts.Faces.Faces_Context'Class;
                       Component : in ASF.Components.Base.UIComponent'Class;
                       Value     : in Util.Beans.Objects.Object) return String is
      pragma Unreferenced (Convert);

      Bundle  : ASF.Locales.Bundle;
      Locale  : constant Util.Locales.Locale := Context.Get_Locale;
   begin
      begin
         Context.Get_Application.Load_Bundle (Name   => "sizes",
                                              Locale => Util.Locales.To_String (Locale),
                                              Bundle => Bundle);

      exception
         when E : Util.Properties.Bundles.NO_BUNDLE =>
            Component.Log_Error ("Cannot localize sizes: {0}",
                                 Ada.Exceptions.Exception_Message (E));
      end;

      --  Convert the value as an integer here so that we can raise
      --  the Invalid_Conversion exception.
      declare
         Size    : constant Long_Long_Integer := Util.Beans.Objects.To_Long_Long_Integer (Value);
         Val     : Integer;
         Values  : ASF.Utils.Object_Array (1 .. 1);
         Result  : Ada.Strings.Unbounded.Unbounded_String;
         Unit    : Util.Strings.Name_Access;
      begin
         if Size >= ONE_GB then
            Val  := Integer ((Size + ONE_GB / 2) / ONE_GB);
            Unit := UNIT_GB'Access;

         elsif Size >= ONE_MB then
            Val  := Integer ((Size + ONE_MB / 2) / ONE_MB);
            Unit := UNIT_MB'Access;

         elsif Size >= ONE_KB then
            Val  := Integer ((Size + ONE_KB / 2) / ONE_KB);
            Unit := UNIT_KB'Access;

         else
            Val  := Integer (Size);
            Unit := UNIT_B'Access;
         end if;
         Values (1) := Util.Beans.Objects.To_Object (Val);
         ASF.Utils.Formats.Format (Bundle.Get (Unit.all), Values, Result);
         return Ada.Strings.Unbounded.To_String (Result);
      end;

   exception
      when E : others =>
         raise ASF.Converters.Invalid_Conversion with Ada.Exceptions.Exception_Message (E);
   end To_String;

   --  ------------------------------
   --  Convert the date string into an object for the specified component.
   --  If the string cannot be converted, the Invalid_Conversion exception should be raised.
   --  ------------------------------
   function To_Object (Convert   : in Size_Converter;
                       Context   : in ASF.Contexts.Faces.Faces_Context'Class;
                       Component : in ASF.Components.Base.UIComponent'Class;
                       Value     : in String) return Util.Beans.Objects.Object is
      pragma Unreferenced (Convert, Context, Value);
   begin
      Component.Log_Error ("Conversion of string to a size is not implemented");
      raise ASF.Converters.Invalid_Conversion with "Not implemented";
      return Util.Beans.Objects.Null_Object;
   end To_Object;

end ASF.Converters.Sizes;

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

with Util.Locales;
with Util.Strings;
with Util.Properties.Bundles;

with ASF.Locales;
with ASF.Utils;
with ASF.Applications.Main;

package body ASF.Converters.Sizes is

   ONE_KB  : constant Long_Long_Integer := 1_024;
   ONE_MB  : constant Long_Long_Integer := ONE_KB * 1_024;
   ONE_GB  : constant Long_Long_Integer := ONE_MB * 1_024;

   UNIT_GB : aliased constant String := "size_giga_bytes";
   UNIT_MB : aliased constant String := "size_mega_bytes";
   UNIT_KB : aliased constant String := "size_kilo_bytes";
   UNIT_B  : aliased constant String := "size_bytes";

   --  ------------------------------
   --  Convert the object value into a string.  The object value is associated
   --  with the specified component.
   --  If the string cannot be converted, the Invalid_Conversion exception should be raised.
   --  ------------------------------
   function To_String (Convert   : in Size_Converter;
                       Context   : in ASF.Contexts.Faces.Faces_Context'Class;
                       Component : in ASF.Components.Base.UIComponent'Class;
                       Value     : in Util.Beans.Objects.Object) return String is
      pragma Unreferenced (Convert);

      Bundle  : ASF.Locales.Bundle;
      Locale  : constant Util.Locales.Locale := Context.Get_Locale;
   begin
      begin
         ASF.Applications.Main.Load_Bundle (Context.Get_Application.all,
                                            Name   => "sizes",
                                            Locale => Util.Locales.To_String (Locale),
                                            Bundle => Bundle);

      exception
         when E : Util.Properties.Bundles.NO_BUNDLE =>
            Component.Log_Error ("Cannot localize sizes: {0}",
                                 Ada.Exceptions.Exception_Message (E));
      end;

      --  Convert the value as an integer here so that we can raise
      --  the Invalid_Conversion exception.
      declare
         Size    : constant Long_Long_Integer := Util.Beans.Objects.To_Long_Long_Integer (Value);
         Val     : Integer;
         Values  : ASF.Utils.Object_Array (1 .. 1);
         Result  : Ada.Strings.Unbounded.Unbounded_String;
         Unit    : Util.Strings.Name_Access;
      begin
         if Size >= ONE_GB then
            Val  := Integer ((Size + ONE_GB / 2) / ONE_GB);
            Unit := UNIT_GB'Access;

         elsif Size >= ONE_MB then
            Val  := Integer ((Size + ONE_MB / 2) / ONE_MB);
            Unit := UNIT_MB'Access;

         elsif Size >= ONE_KB then
            Val  := Integer ((Size + ONE_KB / 2) / ONE_KB);
            Unit := UNIT_KB'Access;

         else
            Val  := Integer (Size);
            Unit := UNIT_B'Access;
         end if;
         Values (1) := Util.Beans.Objects.To_Object (Val);
         ASF.Utils.Formats.Format (Bundle.Get (Unit.all), Values, Result);
         return Ada.Strings.Unbounded.To_String (Result);
      end;

   exception
      when E : others =>
         raise ASF.Converters.Invalid_Conversion with Ada.Exceptions.Exception_Message (E);
   end To_String;

   --  ------------------------------
   --  Convert the date string into an object for the specified component.
   --  If the string cannot be converted, the Invalid_Conversion exception should be raised.
   --  ------------------------------
   function To_Object (Convert   : in Size_Converter;
                       Context   : in ASF.Contexts.Faces.Faces_Context'Class;
                       Component : in ASF.Components.Base.UIComponent'Class;
                       Value     : in String) return Util.Beans.Objects.Object is
      pragma Unreferenced (Convert, Context, Value);
   begin
      Component.Log_Error ("Conversion of string to a size is not implemented");
      raise ASF.Converters.Invalid_Conversion with "Not implemented";
      return Util.Beans.Objects.Null_Object;
   end To_Object;

end ASF.Converters.Sizes;

Fix compilation warning

Fix compilation warning