-----------------------------------------------------------------------
--  security-filters -- Security filter
--  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 ASF.Filters;
with ASF.Requests;
with ASF.Responses;
with ASF.Servlets;
with ASF.Sessions;
with ASF.Principals;
with Security.Permissions;  use Security;

--  The Security.Filters package defines a servlet filter that can be activated
--  on requests to authenticate users and verify they have the permission to view
--  a page.
package ASF.Security.Filters is

   SID_COOKIE : constant String := "SID";

   AID_COOKIE : constant String := "AID";

   type Auth_Filter is new ASF.Filters.Filter with private;

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

   --  Set the permission manager that must be used to verify the permission.
   procedure Set_Permission_Manager (Filter  : in out Auth_Filter;
                                     Manager : in Permissions.Permission_Manager_Access);

   --  Filter the request to make sure the user is authenticated.
   --  Invokes the Do_Login procedure if there is no user.
   --  If a permission manager is defined, check that the user has the permission
   --  to view the page.  Invokes the Do_Deny procedure if the permission
   --  is denied.
   procedure Do_Filter (F        : in Auth_Filter;
                        Request  : in out ASF.Requests.Request'Class;
                        Response : in out ASF.Responses.Response'Class;
                        Chain    : in out ASF.Servlets.Filter_Chain);

   --  Display or redirects the user to the login page.  This procedure is called when
   --  the user is not authenticated.
   procedure Do_Login (F        : in Auth_Filter;
                       Request  : in out ASF.Requests.Request'Class;
                       Response : in out ASF.Responses.Response'Class);

   --  Display the forbidden access page.  This procedure is called when the user is not
   --  authorized to see the page.  The default implementation returns the SC_FORBIDDEN error.
   procedure Do_Deny (F        : in Auth_Filter;
                      Request  : in out ASF.Requests.Request'Class;
                      Response : in out ASF.Responses.Response'Class);

   --  Authenticate a user by using the auto-login cookie.  This procedure is called if the
   --  current session does not have any principal.  Based on the request and the optional
   --  auto-login cookie passed in Auth_Id, it should identify the user and return
   --  a principal object.  The principal object will be freed when the session is closed.
   --  If the user cannot be authenticated, the returned principal should be null.
   --
   --  The default implementation returns a null principal.
   procedure Authenticate (F        : in Auth_Filter;
                           Request  : in out ASF.Requests.Request'Class;
                           Response : in out ASF.Responses.Response'Class;
                           Session  : in ASF.Sessions.Session;
                           Auth_Id  : in String;
                           Principal : out ASF.Principals.Principal_Access);

private

   type Auth_Filter is new ASF.Filters.Filter with record
      Manager : Permissions.Permission_Manager_Access := null;
   end record;

end ASF.Security.Filters;

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

with ASF.Filters;
with ASF.Requests;
with ASF.Responses;
with ASF.Servlets;
with ASF.Sessions;
with ASF.Principals;
with Security.Policies;  use Security;

--  The Security.Filters package defines a servlet filter that can be activated
--  on requests to authenticate users and verify they have the permission to view
--  a page.
package ASF.Security.Filters is

   SID_COOKIE : constant String := "SID";

   AID_COOKIE : constant String := "AID";

   type Auth_Filter is new ASF.Filters.Filter with private;

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

   --  Set the permission manager that must be used to verify the permission.
   procedure Set_Permission_Manager (Filter  : in out Auth_Filter;
                                     Manager : in Policies.Policy_Manager_Access);

   --  Filter the request to make sure the user is authenticated.
   --  Invokes the Do_Login procedure if there is no user.
   --  If a permission manager is defined, check that the user has the permission
   --  to view the page.  Invokes the Do_Deny procedure if the permission
   --  is denied.
   procedure Do_Filter (F        : in Auth_Filter;
                        Request  : in out ASF.Requests.Request'Class;
                        Response : in out ASF.Responses.Response'Class;
                        Chain    : in out ASF.Servlets.Filter_Chain);

   --  Display or redirects the user to the login page.  This procedure is called when
   --  the user is not authenticated.
   procedure Do_Login (F        : in Auth_Filter;
                       Request  : in out ASF.Requests.Request'Class;
                       Response : in out ASF.Responses.Response'Class);

   --  Display the forbidden access page.  This procedure is called when the user is not
   --  authorized to see the page.  The default implementation returns the SC_FORBIDDEN error.
   procedure Do_Deny (F        : in Auth_Filter;
                      Request  : in out ASF.Requests.Request'Class;
                      Response : in out ASF.Responses.Response'Class);

   --  Authenticate a user by using the auto-login cookie.  This procedure is called if the
   --  current session does not have any principal.  Based on the request and the optional
   --  auto-login cookie passed in Auth_Id, it should identify the user and return
   --  a principal object.  The principal object will be freed when the session is closed.
   --  If the user cannot be authenticated, the returned principal should be null.
   --
   --  The default implementation returns a null principal.
   procedure Authenticate (F        : in Auth_Filter;
                           Request  : in out ASF.Requests.Request'Class;
                           Response : in out ASF.Responses.Response'Class;
                           Session  : in ASF.Sessions.Session;
                           Auth_Id  : in String;
                           Principal : out ASF.Principals.Principal_Access);

private

   type Auth_Filter is new ASF.Filters.Filter with record
      Manager : Policies.Policy_Manager_Access := null;
   end record;

end ASF.Security.Filters;

Update after Security package refactorisation


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

with ADO.Tests;
with ADO.Schemas.Tests;
with ADO.Objects.Tests;
with ADO.Queries.Tests;
with ADO.Parameters.Tests;
package body ADO.Testsuite is

   use ADO.Tests;

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

   procedure Drivers (Suite : in Util.Tests.Access_Test_Suite) is separate;

   Tests : aliased Util.Tests.Test_Suite;

   function Suite return Util.Tests.Access_Test_Suite is
      Ret : constant Util.Tests.Access_Test_Suite := Tests'Access;
   begin
      ADO.Parameters.Tests.Add_Tests (Ret);
      ADO.Objects.Tests.Add_Tests (Ret);
      ADO.Tests.Add_Tests (Ret);
      ADO.Schemas.Tests.Add_Tests (Ret);
      Drivers (Ret);
      ADO.Queries.Tests.Add_Tests (Ret);
      return Ret;
   end Suite;

end ADO.Testsuite;

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

with ADO.Tests;
with ADO.Sequences.Tests;
with ADO.Schemas.Tests;
with ADO.Objects.Tests;
with ADO.Queries.Tests;
with ADO.Parameters.Tests;
package body ADO.Testsuite is

   use ADO.Tests;

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

   procedure Drivers (Suite : in Util.Tests.Access_Test_Suite) is separate;

   Tests : aliased Util.Tests.Test_Suite;

   function Suite return Util.Tests.Access_Test_Suite is
      Ret : constant Util.Tests.Access_Test_Suite := Tests'Access;
   begin
      ADO.Parameters.Tests.Add_Tests (Ret);
      ADO.Sequences.Tests.Add_Tests (Ret);
      ADO.Objects.Tests.Add_Tests (Ret);
      ADO.Tests.Add_Tests (Ret);
      ADO.Schemas.Tests.Add_Tests (Ret);
      Drivers (Ret);
      ADO.Queries.Tests.Add_Tests (Ret);
      return Ret;
   end Suite;

end ADO.Testsuite;

Add the sequence factory test

Add the sequence factory test


-----------------------------------------------------------------------
--  Atlas-server -- Application server
--  Copyright (C) 2011 unknown
--  Written by unknown (unknown@company.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 Util.Log.loggers;

with ASF.Server.Web;

with Atlas.Applications;
procedure Atlas.Server is

   Log     : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Atlas.Server");
   App     : constant Atlas.Applications.Application_Access := new Atlas.Applications.Application;
   WS      : ASF.Server.Web.AWS_Container;
begin
   Atlas.Applications.Initialize (App);
   WS.Register_Application (Atlas.Applications.CONTEXT_PATH, App.all'Access);
   Log.Info ("Connect you browser to: http://localhost:8080/atlas/index.html");
   WS.Start;
   delay 365.0 * 24.0 * 3600.0;
   App.Close;
exception
   when E: others =>
      Log.Error ("Exception in server: " &
                 Ada.Exceptions.Exception_Name (E) & ": " &
                 Ada.Exceptions.Exception_Message (E));
end Atlas.Server;

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

with Util.Log.Loggers;

with ASF.Server.Web;

with Atlas.Applications;
procedure Atlas.Server is

   Log     : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Atlas.Server");
   App     : constant Atlas.Applications.Application_Access := new Atlas.Applications.Application;
   WS      : ASF.Server.Web.AWS_Container;
begin
   Atlas.Applications.Initialize (App);
   WS.Register_Application (Atlas.Applications.CONTEXT_PATH, App.all'Access);
   Log.Info ("Connect you browser to: http://localhost:8080/atlas/index.html");
   WS.Start;
   delay 365.0 * 24.0 * 3600.0;
   App.Close;
exception
   when E : others =>
      Log.Error ("Exception in server: " &
                 Ada.Exceptions.Exception_Name (E) & ": " &
                 Ada.Exceptions.Exception_Message (E));
end Atlas.Server;

Fix compilation warnings

Fix compilation warnings


with C_String;
with Interfaces.C;
with POSIX.Path;

package body POSIX.Symlink is

  procedure C_Readlink_Boundary
    (File_Name       : in String;
     Modified_Buffer : out File.File_Name_t;
     Modified_Size   : out C_Types.Signed_Size_t)
    --# derives Modified_Buffer, Modified_Size from File_Name;
  is
    --# hide C_Readlink_Boundary
    function C_Readlink
      (Path        : in C_String.String_Not_Null_Ptr_t;
       Buffer      : in C_String.Char_Array_Not_Null_Ptr_t;
       Buffer_Size : in C_Types.Size_t) return C_Types.Signed_Size_t;
    pragma Import (C, C_Readlink, "readlink");
  begin
    declare
      C_Buffer           : aliased Interfaces.C.char_array :=
        (Interfaces.C.size_t (File.File_Name_Index_t'First) ..
         Interfaces.C.size_t (File.File_Name_Index_t'Last) => Interfaces.C.nul);
      C_File_Name_Buffer : aliased Interfaces.C.char_array :=
        Interfaces.C.To_C (File_Name, Append_Nul => True);
      C_Size             : C_Types.Signed_Size_t;
    begin
      C_Size := C_Readlink
        (Path        => C_String.To_C_String (C_File_Name_Buffer'Unchecked_Access),
         Buffer      => C_String.To_C_Char_Array (C_Buffer'Unchecked_Access),
         Buffer_Size => C_Buffer'Length);
      if C_Size > 0 then
        Modified_Buffer (File.File_Name_Index_t'First .. Positive (C_Size)) := C_String.To_String
          (Item => C_String.To_C_Char_Array (C_Buffer'Unchecked_Access),
           Size => Interfaces.C.size_t (C_Size));
        Modified_Size := C_Size;
      else
        Modified_Size := -1;
      end if;
    end;
  exception
    -- Do not propagate exceptions.
    when Storage_Error =>
      Error.Set_Error (Error.Error_Out_Of_Memory);
      Modified_Size := -1;
    when others =>
      Error.Set_Error (Error.Error_Unknown);
      Modified_Size := -1;
  end C_Readlink_Boundary;

  procedure Read_Link
    (File_Name   : in String;
     Buffer      : out File.File_Name_t;
     Buffer_Size : out File.File_Name_Size_t;
     Error_Value : out Error.Error_t)
  is
    Returned_Buffer : File.File_Name_t;
    Returned_Size   : C_Types.Signed_Size_t;
  begin
    if File_Name'Last > Path.Max_Length then
      Error_Value := Error.Error_Name_Too_Long;
      Buffer      := File.File_Name_t'(File.File_Name_Index_t => Character'Val (0));
      Buffer_Size := 0;
    else
      -- Call system readlink().
      C_Readlink_Boundary
        (File_Name       => File_Name,
         Modified_Buffer => Returned_Buffer,
         Modified_Size   => Returned_Size);
      if Returned_Size = -1 then
        Error_Value := Error.Get_Error;
        Buffer      := File.File_Name_t'(File.File_Name_Index_t => Character'Val (0));
        Buffer_Size := 0;
      else
        Error_Value := Error.Error_None;
        Buffer      := Returned_Buffer;
        Buffer_Size := File.File_Name_Size_t (Returned_Size);
      end if;
    end if;
  end Read_Link;

  function C_Create_Boundary
    (File_Name : in String;
     Target    : in String) return Error.Return_Value_t is
    --# hide C_Create_Boundary
    function C_Symlink
      (File_Name : in C_String.String_Not_Null_Ptr_t;
       Target    : in C_String.String_Not_Null_Ptr_t) return Error.Return_Value_t;
    pragma Import (C, C_Symlink, "symlink");
  begin
    declare
      C_File_Name_Buffer : aliased Interfaces.C.char_array :=
        Interfaces.C.To_C (File_Name, Append_Nul => True);
      C_Target_Buffer    : aliased Interfaces.C.char_array :=
        Interfaces.C.To_C (Target, Append_Nul => True);
    begin
      return C_Symlink
        (Target    => C_String.To_C_String (C_File_Name_Buffer'Unchecked_Access),
         File_Name => C_String.To_C_String (C_Target_Buffer'Unchecked_Access));
    end;
  exception
    -- Do not propagate exceptions.
    when Storage_Error =>
      Error.Set_Error (Error.Error_Out_Of_Memory);
      return -1;
    when others =>
      Error.Set_Error (Error.Error_Unknown);
      return -1;
  end C_Create_Boundary;

  procedure Create
    (File_Name   : in String;
     Target      : in String;
     Error_Value : out Error.Error_t)
  is
    Names_OK     : Boolean;
    Return_Value : Error.Return_Value_t;
  begin
    Error_Value := Error.Error_None;
    Names_OK    := True;

    if File_Name'Last > Path.Max_Length then
      Error_Value := Error.Error_Name_Too_Long;
      Names_OK    := False;
    end if;

    if Target'Last > Path.Max_Length then
      Error_Value := Error.Error_Name_Too_Long;
      Names_OK    := False;
    end if;

    if Names_OK then
      Return_Value := C_Create_Boundary
        (File_Name => File_Name,
         Target    => Target);
      case Return_Value is
        when  0 => Error_Value := Error.Error_None;
        when -1 => Error_Value := Error.Get_Error;
      end case;
    end if;
  end Create;

end POSIX.Symlink;

with C_String;
with Interfaces.C;
with POSIX.Path;

package body POSIX.Symlink is

  procedure C_Readlink_Boundary
    (File_Name       : in String;
     Modified_Buffer : out File.File_Name_t;
     Modified_Size   : out File.File_Name_Size_t;
     Read_Error      : out Boolean)
    --# derives Modified_Buffer, Modified_Size, Read_Error from File_Name;
  is
    --# hide C_Readlink_Boundary
    function C_Readlink
      (Path        : in C_String.String_Not_Null_Ptr_t;
       Buffer      : in C_String.Char_Array_Not_Null_Ptr_t;
       Buffer_Size : in C_Types.Size_t) return C_Types.Signed_Size_t;
    pragma Import (C, C_Readlink, "readlink");
  begin
    declare
      C_Buffer           : aliased Interfaces.C.char_array :=
        (Interfaces.C.size_t (File.File_Name_Index_t'First) ..
         Interfaces.C.size_t (File.File_Name_Index_t'Last) => Interfaces.C.nul);
      C_File_Name_Buffer : aliased Interfaces.C.char_array :=
        Interfaces.C.To_C (File_Name, Append_Nul => True);
      C_Size             : C_Types.Signed_Size_t;
    begin
      C_Size := C_Readlink
        (Path        => C_String.To_C_String (C_File_Name_Buffer'Unchecked_Access),
         Buffer      => C_String.To_C_Char_Array (C_Buffer'Unchecked_Access),
         Buffer_Size => C_Buffer'Length);
      case C_Size is
        when -1 =>
          Modified_Size := 0;
          Read_Error    := True;
        when C_Types.Signed_Size_t (File.File_Name_Index_t'First) ..
             C_Types.Signed_Size_t (File.File_Name_Index_t'Last) =>
          Modified_Buffer (File.File_Name_Index_t'First .. Positive (C_Size)) :=
            C_String.To_String
              (Item => C_String.To_C_Char_Array (C_Buffer'Unchecked_Access),
               Size => Interfaces.C.size_t (C_Size));
          Modified_Size := File.File_Name_Size_t (C_Size);
          Read_Error    := False;
        when others =>
          Error.Set_Error (Error.Error_Out_Of_Range);
          Modified_Size := 0;
          Read_Error    := False;
      end case;
    end;
  exception
    -- Do not propagate exceptions.
    when Storage_Error =>
      Error.Set_Error (Error.Error_Out_Of_Memory);
      Modified_Size := 0;
      Read_Error    := True;
    when others =>
      Error.Set_Error (Error.Error_Unknown);
      Modified_Size := 0;
      Read_Error    := True;
  end C_Readlink_Boundary;

  procedure Read_Link
    (File_Name   : in String;
     Buffer      : out File.File_Name_t;
     Buffer_Size : out File.File_Name_Size_t;
     Error_Value : out Error.Error_t)
  is
    Returned_Buffer : File.File_Name_t;
    Returned_Size   : File.File_Name_Size_t;
    Read_Error      : Boolean;
  begin
    if File_Name'Last > Path.Max_Length then
      Error_Value := Error.Error_Name_Too_Long;
      Buffer      := File.File_Name_t'(File.File_Name_Index_t => Character'Val (0));
      Buffer_Size := 0;
    else
      -- Call system readlink().
      C_Readlink_Boundary
        (File_Name       => File_Name,
         Modified_Buffer => Returned_Buffer,
         Modified_Size   => Returned_Size,
         Read_Error      => Read_Error);
      if Read_Error then
        Error_Value := Error.Get_Error;
        Buffer      := File.File_Name_t'(File.File_Name_Index_t => Character'Val (0));
        Buffer_Size := 0;
      else
        Error_Value := Error.Error_None;
        Buffer      := Returned_Buffer;
        Buffer_Size := Returned_Size;
      end if;
    end if;
  end Read_Link;

  function C_Create_Boundary
    (File_Name : in String;
     Target    : in String) return Error.Return_Value_t is
    --# hide C_Create_Boundary
    function C_Symlink
      (File_Name : in C_String.String_Not_Null_Ptr_t;
       Target    : in C_String.String_Not_Null_Ptr_t) return Error.Return_Value_t;
    pragma Import (C, C_Symlink, "symlink");
  begin
    declare
      C_File_Name_Buffer : aliased Interfaces.C.char_array :=
        Interfaces.C.To_C (File_Name, Append_Nul => True);
      C_Target_Buffer    : aliased Interfaces.C.char_array :=
        Interfaces.C.To_C (Target, Append_Nul => True);
    begin
      return C_Symlink
        (Target    => C_String.To_C_String (C_File_Name_Buffer'Unchecked_Access),
         File_Name => C_String.To_C_String (C_Target_Buffer'Unchecked_Access));
    end;
  exception
    -- Do not propagate exceptions.
    when Storage_Error =>
      Error.Set_Error (Error.Error_Out_Of_Memory);
      return -1;
    when others =>
      Error.Set_Error (Error.Error_Unknown);
      return -1;
  end C_Create_Boundary;

  procedure Create
    (File_Name   : in String;
     Target      : in String;
     Error_Value : out Error.Error_t)
  is
    Names_OK     : Boolean;
    Return_Value : Error.Return_Value_t;
  begin
    Error_Value := Error.Error_None;
    Names_OK    := True;

    if File_Name'Last > Path.Max_Length then
      Error_Value := Error.Error_Name_Too_Long;
      Names_OK    := False;
    end if;

    if Target'Last > Path.Max_Length then
      Error_Value := Error.Error_Name_Too_Long;
      Names_OK    := False;
    end if;

    if Names_OK then
      Return_Value := C_Create_Boundary
        (File_Name => File_Name,
         Target    => Target);
      case Return_Value is
        when  0 => Error_Value := Error.Error_None;
        when -1 => Error_Value := Error.Get_Error;
      end case;
    end if;
  end Create;

end POSIX.Symlink;

Improve interface for SPARK checking.

Improve interface for SPARK checking.


-----------------------------------------------------------------------
--  awa-users -- Users module
--  Copyright (C) 2009, 2010, 2011, 2015, 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.
-----------------------------------------------------------------------

--  = Users Module =
--  The Users.Module manages the creation, update, removal and authentication of users
--  in an application.  The module provides the foundations for user management in
--  a web application.
--
--  A user can register himself by using a subscription form.  In that case, a verification mail
--  is sent and the user has to follow the verification link defined in the mail to finish
--  the registration process.  The user will authenticate using a password.
--
--  A user can also use an OpenID account and be automatically registered.
--
--  A user can have one or several permissions that allow to protect the application data.
--  User permissions are managed by the Permissions.Module.
--
--  @include awa-users-modules.ads
package AWA.Users is

   pragma Preelaborate;

end AWA.Users;

-----------------------------------------------------------------------
--  awa-users -- Users module
--  Copyright (C) 2009, 2010, 2011, 2015, 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.
-----------------------------------------------------------------------

--  = Users Module =
--  The `Users.Module` manages the creation, update, removal and authentication of users
--  in an application.  The module provides the foundations for user management in
--  a web application.
--
--  A user can register himself by using a subscription form.  In that case, a verification mail
--  is sent and the user has to follow the verification link defined in the mail to finish
--  the registration process.  The user will authenticate using a password.
--
--  A user can also use an OpenID account and be automatically registered.
--
--  A user can have one or several permissions that allow to protect the application data.
--  User permissions are managed by the `Permissions.Module`.
--
--  @include awa-users-modules.ads
package AWA.Users is

   pragma Preelaborate;

end AWA.Users;

Fix user guide presentation

Fix user guide presentation


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

-----------------------------------------------------------------------
--  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
package AWA is

   pragma Pure;

end AWA;

Fix documentation

Fix documentation


-----------------------------------------------------------------------
--  wiki-nodes -- Wiki Document Internal representation
--  Copyright (C) 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.
-----------------------------------------------------------------------

package body Wiki.Documents is

   use Wiki.Nodes;

   --  ------------------------------
   --  Append a HTML tag start node to the document.
   --  ------------------------------
   procedure Push_Node (Into       : in out Document;
                        Tag        : in Html_Tag;
                        Attributes : in Wiki.Attributes.Attribute_List) is

      Node : constant Node_Type_Access := new Node_Type '(Kind       => N_TAG_START,
                                                          Len        => 0,
                                                          Tag_Start  => Tag,
                                                          Attributes => Attributes,
                                                          Children   => null,
                                                          Parent     => Into.Current);
   begin
      Append (Into, Node);
      Into.Current := Node;
   end Push_Node;

   --  ------------------------------
   --  Pop the HTML tag.
   --  ------------------------------
   procedure Pop_Node (From : in out Document;
                       Tag  : in Html_Tag) is
   begin
      if From.Current /= null then
         From.Current := From.Current.Parent;
      end if;
   end Pop_Node;

   --  ------------------------------
   --  Append a section header at end of the document.
   --  ------------------------------
   procedure Append (Into   : in out Document;
                     Header : in Wiki.Strings.WString;
                     Level  : in Positive) is
   begin
      Append (Into, new Node_Type '(Kind   => N_HEADER,
                                    Len    => Header'Length,
                                    Header => Header,
                                    Level  => Level));
   end Append;

   --  ------------------------------
   --  Append a node to the document.
   --  ------------------------------
   procedure Append (Into : in out Document;
                     Node : in Wiki.Nodes.Node_Type_Access) is
   begin
      if Into.Current = null then
         Append (Into.Nodes, Node);
      else
         Append (Into.Current, Node);
      end if;
   end Append;

   --  ------------------------------
   --  Append a simple node such as N_LINE_BREAK, N_HORIZONTAL_RULE or N_PARAGRAPH.
   --  ------------------------------
   procedure Append (Into : in out Document;
                     Kind : in Simple_Node_Kind) is
   begin
      case Kind is
         when N_LINE_BREAK =>
            Append (Into, new Node_Type '(Kind => N_LINE_BREAK, Len => 0));

         when N_HORIZONTAL_RULE =>
            Append (Into, new Node_Type '(Kind => N_HORIZONTAL_RULE, Len => 0));

         when N_PARAGRAPH =>
            Append (Into, new Node_Type '(Kind => N_PARAGRAPH, Len => 0));

         when N_TOC_DISPLAY =>
            Append (Into, new Node_Type '(Kind => N_TOC_DISPLAY, Len => 0));
            Into.Using_TOC := True;

      end  case;
   end Append;

   --  ------------------------------
   --  Append the text with the given format at end of the document.
   --  ------------------------------
   procedure Append (Into   : in out Document;
                     Text   : in Wiki.Strings.WString;
                     Format : in Format_Map) is
   begin
      Append (Into, new Node_Type '(Kind => N_TEXT, Len => Text'Length,
                                    Text => Text, Format => Format));
   end Append;

   --  ------------------------------
   --  Add a link.
   --  ------------------------------
   procedure Add_Link (Into       : in out Document;
                       Name       : in Wiki.Strings.WString;
                       Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      Append (Into, new Node_Type '(Kind => N_LINK, Len => Name'Length,
                                    Title => Name, Link_Attr => Attributes));
   end Add_Link;

   --  ------------------------------
   --  Add an image.
   --  ------------------------------
   procedure Add_Image (Into       : in out Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      Append (Into, new Node_Type '(Kind => N_IMAGE, Len => Name'Length,
                                    Title => Name, Link_Attr => Attributes));
   end Add_Image;

   --  ------------------------------
   --  Add a quote.
   --  ------------------------------
   procedure Add_Quote (Into       : in out Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      Append (Into, new Node_Type '(Kind => N_QUOTE, Len => Name'Length,
                                    Title => Name, Link_Attr => Attributes));
   end Add_Quote;

   --  ------------------------------
   --  Add a list item (<li>).  Close the previous paragraph and list item if any.
   --  The list item will be closed at the next list item, next paragraph or next header.
   --  ------------------------------
   procedure Add_List_Item (Into     : in out Document;
                            Level    : in Positive;
                            Ordered  : in Boolean) is
   begin
      if Ordered then
         Append (Into, new Node_Type '(Kind => N_NUM_LIST, Len => 0,
                                       Level => Level, others => <>));
      else
         Append (Into, new Node_Type '(Kind => N_LIST, Len => 0,
                                       Level => Level, others => <>));
      end if;
   end Add_List_Item;

   --  ------------------------------
   --  Add a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   --  ------------------------------
   procedure Add_Blockquote (Into     : in out Document;
                             Level    : in Natural) is
   begin
      Append (Into, new Node_Type '(Kind => N_BLOCKQUOTE, Len => 0,
                                    Level => Level, others => <>));
   end Add_Blockquote;

   --  Add a text block that is pre-formatted.
   procedure Add_Preformatted (Into     : in out Document;
                               Text     : in Wiki.Strings.WString;
                               Format   : in Wiki.Strings.WString) is
   begin
      Append (Into, new Node_Type '(Kind => N_PREFORMAT, Len => Text'Length,
                                    Preformatted => Text, others => <>));
   end Add_Preformatted;

   --  ------------------------------
   --  Iterate over the nodes of the list and call the <tt>Process</tt> procedure with
   --  each node instance.
   --  ------------------------------
   procedure Iterate (Doc     : in Document;
                      Process : not null access procedure (Node : in Node_Type)) is
   begin
      Iterate (Doc.Nodes, Process);
   end Iterate;

   --  ------------------------------
   --  Returns True if the document is empty.
   --  ------------------------------
   function Is_Empty (Doc : in Document) return Boolean is
   begin
      return Wiki.Nodes.Is_Empty (Doc.Nodes);
   end Is_Empty;

   --  ------------------------------
   --  Returns True if the document displays the table of contents by itself.
   --  ------------------------------
   function Is_Using_TOC (Doc : in Document) return Boolean is
   begin
      return Doc.Using_TOC;
   end Is_Using_TOC;

   --  ------------------------------
   --  Get the table of content node associated with the document.
   --  ------------------------------
   procedure Get_TOC (Doc : in out Document;
                      TOC : out Wiki.Nodes.Node_List_Ref) is
   begin
      if Wiki.Nodes.Is_Empty (Doc.TOC) then
         Append (Doc.TOC, new Node_Type '(Kind => N_TOC, Len => 0, others => <>));
      end if;
      TOC := Doc.TOC;
   end Get_TOC;

   --  ------------------------------
   --  Get the table of content node associated with the document.
   --  ------------------------------
   function Get_TOC (Doc : in Document) return Wiki.Nodes.Node_List_Ref is
   begin
      return Doc.TOC;
   end Get_TOC;

end Wiki.Documents;

-----------------------------------------------------------------------
--  wiki-nodes -- Wiki Document Internal representation
--  Copyright (C) 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.
-----------------------------------------------------------------------

package body Wiki.Documents is

   use Wiki.Nodes;

   --  ------------------------------
   --  Append a HTML tag start node to the document.
   --  ------------------------------
   procedure Push_Node (Into       : in out Document;
                        Tag        : in Html_Tag;
                        Attributes : in Wiki.Attributes.Attribute_List) is

      Node : constant Node_Type_Access := new Node_Type '(Kind       => N_TAG_START,
                                                          Len        => 0,
                                                          Tag_Start  => Tag,
                                                          Attributes => Attributes,
                                                          Children   => null,
                                                          Parent     => Into.Current);
   begin
      Append (Into, Node);
      Into.Current := Node;
   end Push_Node;

   --  ------------------------------
   --  Pop the HTML tag.
   --  ------------------------------
   procedure Pop_Node (From : in out Document;
                       Tag  : in Html_Tag) is
      pragma Unreferenced (Tag);
   begin
      if From.Current /= null then
         From.Current := From.Current.Parent;
      end if;
   end Pop_Node;

   --  ------------------------------
   --  Append a section header at end of the document.
   --  ------------------------------
   procedure Append (Into   : in out Document;
                     Header : in Wiki.Strings.WString;
                     Level  : in Positive) is
   begin
      Append (Into, new Node_Type '(Kind   => N_HEADER,
                                    Len    => Header'Length,
                                    Header => Header,
                                    Level  => Level));
   end Append;

   --  ------------------------------
   --  Append a node to the document.
   --  ------------------------------
   procedure Append (Into : in out Document;
                     Node : in Wiki.Nodes.Node_Type_Access) is
   begin
      if Into.Current = null then
         Append (Into.Nodes, Node);
      else
         Append (Into.Current, Node);
      end if;
   end Append;

   --  ------------------------------
   --  Append a simple node such as N_LINE_BREAK, N_HORIZONTAL_RULE or N_PARAGRAPH.
   --  ------------------------------
   procedure Append (Into : in out Document;
                     Kind : in Simple_Node_Kind) is
   begin
      case Kind is
         when N_LINE_BREAK =>
            Append (Into, new Node_Type '(Kind => N_LINE_BREAK, Len => 0));

         when N_HORIZONTAL_RULE =>
            Append (Into, new Node_Type '(Kind => N_HORIZONTAL_RULE, Len => 0));

         when N_PARAGRAPH =>
            Append (Into, new Node_Type '(Kind => N_PARAGRAPH, Len => 0));

         when N_TOC_DISPLAY =>
            Append (Into, new Node_Type '(Kind => N_TOC_DISPLAY, Len => 0));
            Into.Using_TOC := True;

      end  case;
   end Append;

   --  ------------------------------
   --  Append the text with the given format at end of the document.
   --  ------------------------------
   procedure Append (Into   : in out Document;
                     Text   : in Wiki.Strings.WString;
                     Format : in Format_Map) is
   begin
      Append (Into, new Node_Type '(Kind => N_TEXT, Len => Text'Length,
                                    Text => Text, Format => Format));
   end Append;

   --  ------------------------------
   --  Add a link.
   --  ------------------------------
   procedure Add_Link (Into       : in out Document;
                       Name       : in Wiki.Strings.WString;
                       Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      Append (Into, new Node_Type '(Kind => N_LINK, Len => Name'Length,
                                    Title => Name, Link_Attr => Attributes));
   end Add_Link;

   --  ------------------------------
   --  Add an image.
   --  ------------------------------
   procedure Add_Image (Into       : in out Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      Append (Into, new Node_Type '(Kind => N_IMAGE, Len => Name'Length,
                                    Title => Name, Link_Attr => Attributes));
   end Add_Image;

   --  ------------------------------
   --  Add a quote.
   --  ------------------------------
   procedure Add_Quote (Into       : in out Document;
                        Name       : in Wiki.Strings.WString;
                        Attributes : in out Wiki.Attributes.Attribute_List) is
   begin
      Append (Into, new Node_Type '(Kind => N_QUOTE, Len => Name'Length,
                                    Title => Name, Link_Attr => Attributes));
   end Add_Quote;

   --  ------------------------------
   --  Add a list item (<li>).  Close the previous paragraph and list item if any.
   --  The list item will be closed at the next list item, next paragraph or next header.
   --  ------------------------------
   procedure Add_List_Item (Into     : in out Document;
                            Level    : in Positive;
                            Ordered  : in Boolean) is
   begin
      if Ordered then
         Append (Into, new Node_Type '(Kind => N_NUM_LIST, Len => 0,
                                       Level => Level, others => <>));
      else
         Append (Into, new Node_Type '(Kind => N_LIST, Len => 0,
                                       Level => Level, others => <>));
      end if;
   end Add_List_Item;

   --  ------------------------------
   --  Add a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   --  ------------------------------
   procedure Add_Blockquote (Into     : in out Document;
                             Level    : in Natural) is
   begin
      Append (Into, new Node_Type '(Kind => N_BLOCKQUOTE, Len => 0,
                                    Level => Level, others => <>));
   end Add_Blockquote;

   --  Add a text block that is pre-formatted.
   procedure Add_Preformatted (Into     : in out Document;
                               Text     : in Wiki.Strings.WString;
                               Format   : in Wiki.Strings.WString) is
   begin
      Append (Into, new Node_Type '(Kind => N_PREFORMAT, Len => Text'Length,
                                    Preformatted => Text, others => <>));
   end Add_Preformatted;

   --  ------------------------------
   --  Iterate over the nodes of the list and call the <tt>Process</tt> procedure with
   --  each node instance.
   --  ------------------------------
   procedure Iterate (Doc     : in Document;
                      Process : not null access procedure (Node : in Node_Type)) is
   begin
      Iterate (Doc.Nodes, Process);
   end Iterate;

   --  ------------------------------
   --  Returns True if the document is empty.
   --  ------------------------------
   function Is_Empty (Doc : in Document) return Boolean is
   begin
      return Wiki.Nodes.Is_Empty (Doc.Nodes);
   end Is_Empty;

   --  ------------------------------
   --  Returns True if the document displays the table of contents by itself.
   --  ------------------------------
   function Is_Using_TOC (Doc : in Document) return Boolean is
   begin
      return Doc.Using_TOC;
   end Is_Using_TOC;

   --  ------------------------------
   --  Get the table of content node associated with the document.
   --  ------------------------------
   procedure Get_TOC (Doc : in out Document;
                      TOC : out Wiki.Nodes.Node_List_Ref) is
   begin
      if Wiki.Nodes.Is_Empty (Doc.TOC) then
         Append (Doc.TOC, new Node_Type '(Kind => N_TOC, Len => 0, others => <>));
      end if;
      TOC := Doc.TOC;
   end Get_TOC;

   --  ------------------------------
   --  Get the table of content node associated with the document.
   --  ------------------------------
   function Get_TOC (Doc : in Document) return Wiki.Nodes.Node_List_Ref is
   begin
      return Doc.TOC;
   end Get_TOC;

end Wiki.Documents;

Fix compilation warning

Fix compilation warning


pragma License (Modified_GPL);
------------------------------------------------------------------------------
-- EMAIL: <darkestkhan@gmail.com>                                           --
-- License: Modified GNU GPLv3 or any later as published by Free Software   --
--  Foundation (GMGPL).                                                     --
--                                                                          --
--                    Copyright © 2014 darkestkhan                          --
------------------------------------------------------------------------------
--  This Program is Free Software: You can redistribute it and/or modify    --
--  it under the terms of The GNU General Public License as published by    --
--    the Free Software Foundation: either version 3 of the license, or     --
--                 (at your option) any later version.                      --
--                                                                          --
--      This Program is distributed in the hope that it will be useful,     --
--      but WITHOUT ANY WARRANTY; without even the implied warranty of      --
--      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the        --
--              GNU General Public License for more details.                --
--                                                                          --
--    You should have received a copy of the GNU General Public License     --
--   along with this program.  If not, see <http://www.gnu.org/licenses/>.  --
--                                                                          --
-- As a special exception,  if other files  instantiate  generics from this --
-- unit, or you link  this unit with other files  to produce an executable, --
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
-- covered  by the  GNU  General  Public  License.  This exception does not --
-- however invalidate  any other reasons why  the executable file  might be --
-- covered by the  GNU Public License.                                      --
------------------------------------------------------------------------------

  --------------------------------------------------------------------------
  -- This package is based on Lumen.Binary package from Lumen library.    --
  --------------------------------------------------------------------------

package Imago.Binary is

  --------------------------------------------------------------------------

  Pragma Pure;

  --------------------------------------------------------------------------

                          -----------------------
                          -- C O N S T A N T S --
                          -----------------------

  --------------------------------------------------------------------------
  -- Basic sizes of fundamental binary data types.
  Byte_Bits : constant := 8;
  Short_Bits: constant := 16;
  Word_Bits : constant := 32;
  Long_Bits : constant := 64;

  --------------------------------------------------------------------------
  -- Derived sizes.
  Short_Bytes: constant := Short_Bits / Byte_Bits;
  Word_Bytes : constant := Word_Bits  / Byte_Bits;
  Long_Bytes : constant := Long_Bits  / Byte_Bits;

  --------------------------------------------------------------------------
  -- "Last-bit" values for use in rep clauses.
  Byte_LB : constant := Byte_Bits  - 1;
  Short_LB: constant := Short_Bits - 1;
  Word_LB : constant := Word_Bits  - 1;
  Long_LB : constant := Long_Bits  - 1;

  --------------------------------------------------------------------------

                              ---------------
                              -- T Y P E S --
                              ---------------

  --------------------------------------------------------------------------
  -- Unsigned types.
  type Byte   is mod 2 ** Byte_Bits;
  type Short  is mod 2 ** Short_Bits;
  type Word   is mod 2 ** Word_Bits;
  type Long   is mod 2 ** Long_Bits;

  for Byte'Size   use Byte_Bits;
  for Short'Size  use Short_Bits;
  for Word'Size   use Word_Bits;
  for Long'Size   use Long_Bits;

  --------------------------------------------------------------------------
  -- Signed types.
  type S_Byte   is new Integer range -(2 ** Byte_LB)  .. (2 ** Byte_LB)  - 1;
  type S_Short  is new Integer range -(2 ** Short_LB) .. (2 ** Short_LB) - 1;
  type S_Word   is new Integer range -(2 ** Word_LB)  .. (2 ** Word_LB)  - 1;
  type S_Long   is new Long_Integer range -(2 ** Long_LB) .. (2 ** Long_LB) - 1;

  for S_Byte'Size   use Byte_Bits;
  for S_Short'Size  use Short_Bits;
  for S_Word'Size   use Word_Bits;
  for S_Long'Size   use Long_Bits;

  --------------------------------------------------------------------------
  -- Array types.
  type Byte_Array     is array (Natural range <>) of Byte;
  type Short_Array    is array (Natural range <>) of Byte;
  type Word_Array     is array (Natural range <>) of Word;
  type Long_Array     is array (Natural range <>) of Long;

  type S_Byte_Array   is array (Natural range <>) of S_Byte;
  type S_Short_Array  is array (Natural range <>) of S_Short;
  type S_Word_Array   is array (Natural range <>) of S_Word;
  type S_Long_Array   is array (Natural range <>) of S_Long;

  ---------------------------------------------------------------------------

end Imago.Binary;

pragma License (Modified_GPL);
------------------------------------------------------------------------------
-- EMAIL: <darkestkhan@gmail.com>                                           --
-- License: Modified GNU GPLv3 or any later as published by Free Software   --
--  Foundation (GMGPL).                                                     --
--                                                                          --
--                    Copyright © 2014 darkestkhan                          --
------------------------------------------------------------------------------
--  This Program is Free Software: You can redistribute it and/or modify    --
--  it under the terms of The GNU General Public License as published by    --
--    the Free Software Foundation: either version 3 of the license, or     --
--                 (at your option) any later version.                      --
--                                                                          --
--      This Program is distributed in the hope that it will be useful,     --
--      but WITHOUT ANY WARRANTY; without even the implied warranty of      --
--      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the        --
--              GNU General Public License for more details.                --
--                                                                          --
--    You should have received a copy of the GNU General Public License     --
--   along with this program.  If not, see <http://www.gnu.org/licenses/>.  --
--                                                                          --
-- As a special exception,  if other files  instantiate  generics from this --
-- unit, or you link  this unit with other files  to produce an executable, --
-- this  unit  does not  by itself cause  the resulting  executable  to  be --
-- covered  by the  GNU  General  Public  License.  This exception does not --
-- however invalidate  any other reasons why  the executable file  might be --
-- covered by the  GNU Public License.                                      --
------------------------------------------------------------------------------

  --------------------------------------------------------------------------
  -- This package is based on Lumen.Binary package from Lumen library.    --
  --------------------------------------------------------------------------

package Imago.Binary is

  --------------------------------------------------------------------------

  Pragma Pure;

  --------------------------------------------------------------------------

                          -----------------------
                          -- C O N S T A N T S --
                          -----------------------

  --------------------------------------------------------------------------
  -- Basic sizes of fundamental binary data types.
  Byte_Bits : constant := 8;
  Short_Bits: constant := 16;
  Word_Bits : constant := 32;
  Long_Bits : constant := 64;

  --------------------------------------------------------------------------
  -- Derived sizes.
  Short_Bytes: constant := Short_Bits / Byte_Bits;
  Word_Bytes : constant := Word_Bits  / Byte_Bits;
  Long_Bytes : constant := Long_Bits  / Byte_Bits;

  --------------------------------------------------------------------------
  -- "Last-bit" values for use in rep clauses.
  Byte_LB : constant := Byte_Bits  - 1;
  Short_LB: constant := Short_Bits - 1;
  Word_LB : constant := Word_Bits  - 1;
  Long_LB : constant := Long_Bits  - 1;

  --------------------------------------------------------------------------

                              ---------------
                              -- T Y P E S --
                              ---------------

  --------------------------------------------------------------------------
  -- Unsigned types.
  type Byte   is mod 2 ** Byte_Bits;
  type Short  is mod 2 ** Short_Bits;
  type Word   is mod 2 ** Word_Bits;
  type Long   is mod 2 ** Long_Bits;

  for Byte'Size   use Byte_Bits;
  for Short'Size  use Short_Bits;
  for Word'Size   use Word_Bits;
  for Long'Size   use Long_Bits;

  --------------------------------------------------------------------------
  -- Signed types.
  type S_Byte   is new Integer range -(2 ** Byte_LB)  .. (2 ** Byte_LB)  - 1;
  type S_Short  is new Integer range -(2 ** Short_LB) .. (2 ** Short_LB) - 1;
  type S_Word   is new Integer range -(2 ** Word_LB)  .. (2 ** Word_LB)  - 1;
  type S_Long   is new Long_Integer range -(2 ** Long_LB) .. (2 ** Long_LB) - 1;

  for S_Byte'Size   use Byte_Bits;
  for S_Short'Size  use Short_Bits;
  for S_Word'Size   use Word_Bits;
  for S_Long'Size   use Long_Bits;

  --------------------------------------------------------------------------
  -- Array types.
  type Byte_Array     is array (Natural range <>) of Byte;
  type Short_Array    is array (Natural range <>) of Short;
  type Word_Array     is array (Natural range <>) of Word;
  type Long_Array     is array (Natural range <>) of Long;

  type S_Byte_Array   is array (Natural range <>) of S_Byte;
  type S_Short_Array  is array (Natural range <>) of S_Short;
  type S_Word_Array   is array (Natural range <>) of S_Word;
  type S_Long_Array   is array (Natural range <>) of S_Long;

  ---------------------------------------------------------------------------

end Imago.Binary;

Fix typo in Imago.Binary.

Fix typo in Imago.Binary.

Special thx to ovenpasta for spotting this.

Signed-off-by: darkestkhan <e9a7a7cf2a6af79e93742343a7a5cac5d90f9bd2@gmail.com>


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

with Util.Strings;

with Security.Auth;
with Security.Permissions;

--  == OAuth Server ==
--  OAuth server side is provided by the <tt>Security.OAuth.Servers</tt> package.
--  This package allows to implement the authorization framework described in RFC 6749
--  The OAuth 2.0 Authorization Framework.
--
--  The authorization method produce a <tt>Grant_Type</tt> object that contains the result
--  of the grant (successful or denied).  It is the responsibility of the caller to format
--  the result in JSON/XML and return it to the client.
--
--  Three important operations are defined for the OAuth 2.0 framework.
--
--  <tt>Authorize</tt> is used to obtain an authorization request.  This operation is
--  optional in the OAuth 2.0 framework since some authorization method directly return
--  the access token.  This operation is used by the "Authorization Code Grant" and the
--  "Implicit Grant".
--
--  <tt>Token</tt> is used to get the access token and optional refresh token.
--
--  <tt>Authenticate</tt> is used for the API request to verify the access token
--  and authenticate the API call.

--  Several grant types are supported.
--
--  === Application Manager ===
--  The application manager maintains the repository of applications which are known by
--  the server and which can request authorization.  Each application is identified by
--  a client identifier (represented by the <tt>client_id</tt> request parameter).
--  The application defines the authorization methods which are allowed as well as
--  the parameters to control and drive the authorization.  This includes the redirection
--  URI, the application secret, the expiration delay for the access token.
--
--  The application manager is implemented by the application server and it must
--  implement the <tt>Application_Manager</tt> interface with the <tt>Find_Application</tt>
--  method.  The <tt>Find_Application</tt> is one of the first call made during the
--  authenticate and token generation phases.
--
--  === Resource Owner Password Credentials Grant ===
--  The password grant is one of the easiest grant method to understand but it is also one
--  of the less secure.  In this grant method, the username and user password are passed in
--  the request parameter together with the application client identifier.  The realm verifies
--  the username and password and when they are correct it generates the access token with
--  an optional refresh token.
--
--    Realm : Security.OAuth.Servers.Auth_Manager;
--    Grant : Security.OAuth.Servers.Grant_Type;
--
--      Realm.Authorize (Params, Grant);
--
--  === Accessing Protected Resources ===
--  When accessing a protected resource, the API implementation will use the
--  <tt>Authenticate</tt> operation to verify the access token and get a security principal.
--  The security principal will identifies the resource owner as well as the application
--  that is doing the call.
--
--     Realm : Security.OAuth.Servers.Auth_Manager;
--     Auth  : Security.Principal_Access;
--     Token : String := ...;
--
--       Realm.Authenticate (Token, Auth);
--
--  When a security principal is returned, the access token was validated and the
--  request is granted for the application.
--
package Security.OAuth.Servers is

   Invalid_Application : exception;

   type Application is new Security.OAuth.Application with private;

   --  Check if the application has the given permission.
   function Has_Permission (App        : in Application;
                            Permission : in Security.Permissions.Permission_Index) return Boolean;

   --  Define the status of the grant.
   type Grant_Status is (Invalid_Grant, Expired_Grant, Revoked_Grant,
                         Stealed_Grant, Valid_Grant);

   --  Define the grant type.
   type Grant_Kind is (No_Grant, Access_Grant, Code_Grant,
                       Implicit_Grant, Password_Grant, Credential_Grant,
                       Extension_Grant);

   --  The <tt>Grant_Type</tt> holds the results of the authorization.
   --  When the grant is refused, the type holds information about the refusal.
   type Grant_Type is record
      --  The request grant type.
      Request : Grant_Kind := No_Grant;

      --  The response status.
      Status  : Grant_Status := Invalid_Grant;

      --  When success, the token to return.
      Token   : Ada.Strings.Unbounded.Unbounded_String;

      --  When success, the token expiration date.
      Expires : Ada.Calendar.Time;

      --  When success, the authentication principal.
      Auth    : Security.Principal_Access;

      --  When error, the type of error to return.
      Error   : Util.Strings.Name_Access;
   end record;

   type Application_Manager is limited interface;
   type Application_Manager_Access is access all Application_Manager'Class;

   --  Find the application that correspond to the given client id.
   --  The <tt>Invalid_Application</tt> exception should be raised if there is no such application.
   function Find_Application (Realm     : in Application_Manager;
                              Client_Id : in String) return Application'Class is abstract;

   type Realm_Manager is limited interface;
   type Realm_Manager_Access is access all Realm_Manager'Class;

   --  Authenticate the token and find the associated authentication principal.
   --  The access token has been verified and the token represents the identifier
   --  of the Tuple (client_id, user, session) that describes the authentication.
   --  The <tt>Authenticate</tt> procedure should look in its database (internal
   --  or external) to find the authentication principal that was granted for
   --  the token Tuple.  When the token was not found (because it was revoked),
   --  the procedure should return a null principal.  If the authentication
   --  principal can be cached, the <tt>Cacheable</tt> value should be set.
   --  In that case, the access token and authentication  principal are inserted
   --  in a cache.
   procedure Authenticate (Realm     : in out Realm_Manager;
                           Token     : in String;
                           Auth      : out Principal_Access;
                           Cacheable : out Boolean) is abstract;

   --  Create an auth token string that identifies the given principal.  The returned
   --  token will be used by <tt>Authenticate</tt> to retrieve back the principal.  The
   --  returned token does not need to be signed.  It will be inserted in the public part
   --  of the returned access token.
   function Authorize (Realm : in Realm_Manager;
                       App   : in Application'Class;
                       Scope : in String;
                       Auth  : in Principal_Access) return String is abstract;

   procedure Verify (Realm    : in out Realm_Manager;
                     Username : in String;
                     Password : in String;
                     Auth     : out Principal_Access) is abstract;

   procedure Verify (Realm : in out Realm_Manager;
                     Token : in String;
                     Auth  : out Principal_Access) is abstract;

   procedure Revoke (Realm : in out Realm_Manager;
                     Auth  : in Principal_Access) is abstract;

   type Auth_Manager is tagged limited private;
   type Auth_Manager_Access is access all Auth_Manager'Class;

   --  Set the auth private key.
   procedure Set_Private_Key (Manager : in out Auth_Manager;
                              Key     : in String);

   --  Set the application manager to use and and applications.
   procedure Set_Application_Manager (Manager    : in out Auth_Manager;
                                      Repository : in Application_Manager_Access);

   --  Set the realm manager to authentify users.
   procedure Set_Realm_Manager (Manager : in out Auth_Manager;
                                Realm   : in Realm_Manager_Access);

   --  Authorize the access to the protected resource by the application and for the
   --  given principal.  The resource owner has been verified and is represented by the
   --  <tt>Auth</tt> principal.  Extract from the request parameters represented by
   --  <tt>Params</tt> the application client id, the scope and the expected response type.
   --  Handle the "Authorization Code Grant" and "Implicit Grant" defined in RFC 6749.
   procedure Authorize (Realm   : in out Auth_Manager;
                        Params  : in Security.Auth.Parameters'Class;
                        Auth    : in Security.Principal_Access;
                        Grant   : out Grant_Type);

   procedure Token (Realm   : in out Auth_Manager;
                    Params  : in Security.Auth.Parameters'Class;
                    Grant   : out Grant_Type);

   --  Make the access token from the authorization code that was created by the
   --  <tt>Authorize</tt> operation.  Verify the client application, the redirect uri, the
   --  client secret and the validity of the authorization code.  Extract from the
   --  authorization code the auth principal that was used for the grant and make the
   --  access token.
   procedure Token_From_Code (Realm   : in out Auth_Manager;
                              App     : in Application'Class;
                              Params  : in Security.Auth.Parameters'Class;
                              Grant   : out Grant_Type);

   procedure Authorize_Code (Realm   : in out Auth_Manager;
                             App     : in Application'Class;
                             Params  : in Security.Auth.Parameters'Class;
                             Auth    : in Security.Principal_Access;
                             Grant   : out Grant_Type);

   procedure Authorize_Token (Realm   : in out Auth_Manager;
                              App     : in Application'Class;
                              Params  : in Security.Auth.Parameters'Class;
                              Auth    : in Security.Principal_Access;
                              Grant   : out Grant_Type);

   --  Make the access token from the resource owner password credentials.  The username,
   --  password and scope are extracted from the request and they are verified through the
   --  <tt>Verify</tt> procedure to obtain an associated principal.  When successful, the
   --  principal describes the authorization and it is used to forge the access token.
   --  This operation implements the RFC 6749: 4.3.  Resource Owner Password Credentials Grant.
   procedure Token_From_Password (Realm   : in out Auth_Manager;
                                  App     : in Application'Class;
                                  Params  : in Security.Auth.Parameters'Class;
                                  Grant   : out Grant_Type);

   --  RFC 6749: 5.  Issuing an Access Token
   procedure Create_Token (Realm  : in Auth_Manager;
                           Ident  : in String;
                           Grant  : in out Grant_Type);

   --  Authenticate the access token and get a security principal that identifies the app/user.
   --  See RFC 6749, 7.  Accessing Protected Resources.
   --  The access token is first searched in the cache.  If it was found, it means the access
   --  token was already verified in the past, it is granted and associated with a principal.
   --  Otherwise, we have to verify the token signature first, then the expiration date and
   --  we extract from the token public part the auth identification.  The <tt>Authenticate</tt>
   --  operation is then called to obtain the principal from the auth identification.
   --  When access token is invalid or authentification cannot be verified, a null principal
   --  is returned.  The <tt>Grant</tt> data will hold the result of the grant with the reason
   --  of failures (if any).
   procedure Authenticate (Realm : in out Auth_Manager;
                           Token : in String;
                           Grant : out Grant_Type);

   procedure Revoke (Realm     : in out Auth_Manager;
                     Token     : in String);

private

   use Ada.Strings.Unbounded;

   function Format_Expire (Expire : in Ada.Calendar.Time) return String;

   type Application is new Security.OAuth.Application with record
      Expire_Timeout : Duration := 3600.0;
      Permissions    : Security.Permissions.Permission_Index_Set := Security.Permissions.EMPTY_SET;
   end record;

   type Cache_Entry is record
      Expire : Ada.Calendar.Time;
      Auth   : Principal_Access;
   end record;

   package Cache_Map is
     new Ada.Containers.Indefinite_Hashed_Maps (Key_Type        => String,
                                                Element_Type    => Cache_Entry,
                                                Hash            => Ada.Strings.Hash,
                                                Equivalent_Keys => "=",
                                                "="             => "=");

   --  The access token cache is used to speed up the access token verification
   --  when a request to a protected resource is made.
   protected type Token_Cache is

      procedure Authenticate (Token : in String;
                              Grant : in out Grant_Type);

      procedure Insert (Token     : in String;
                        Expire    : in Ada.Calendar.Time;
                        Principal : in Principal_Access);

      procedure Remove (Token : in String);

      procedure Timeout;

   private
      Entries : Cache_Map.Map;
   end Token_Cache;

   type Auth_Manager is new Ada.Finalization.Limited_Controlled with record
      --  The repository of applications.
      Repository  : Application_Manager_Access;

      --  The realm for user authentication.
      Realm       : Realm_Manager_Access;

      --  The server private key used by the HMAC signature.
      Private_Key : Ada.Strings.Unbounded.Unbounded_String;

      --  The access token cache.
      Cache       : Token_Cache;

      --  The expiration time for the generated authorization code.
      Expire_Code : Duration := 300.0;
   end record;

   --  <expiration>.<client_id>.<auth-ident>.hmac(<public>.<private-key>)
   type Token_Validity is record
      Status       : Grant_Status := Invalid_Grant;
      Ident_Start  : Natural := 0;
      Ident_End    : Natural := 0;
      Expire       : Ada.Calendar.Time;
   end record;

   function Validate (Realm     : in Auth_Manager;
                      Client_Id : in String;
                      Token     : in String) return Token_Validity;

end Security.OAuth.Servers;

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

with Util.Strings;

with Security.Auth;
with Security.Permissions;

--  == OAuth Server ==
--  OAuth server side is provided by the <tt>Security.OAuth.Servers</tt> package.
--  This package allows to implement the authorization framework described in RFC 6749
--  The OAuth 2.0 Authorization Framework.
--
--  The authorization method produce a <tt>Grant_Type</tt> object that contains the result
--  of the grant (successful or denied).  It is the responsibility of the caller to format
--  the result in JSON/XML and return it to the client.
--
--  Three important operations are defined for the OAuth 2.0 framework.
--
--  <tt>Authorize</tt> is used to obtain an authorization request.  This operation is
--  optional in the OAuth 2.0 framework since some authorization method directly return
--  the access token.  This operation is used by the "Authorization Code Grant" and the
--  "Implicit Grant".
--
--  <tt>Token</tt> is used to get the access token and optional refresh token.
--
--  <tt>Authenticate</tt> is used for the API request to verify the access token
--  and authenticate the API call.

--  Several grant types are supported.
--
--  === Application Manager ===
--  The application manager maintains the repository of applications which are known by
--  the server and which can request authorization.  Each application is identified by
--  a client identifier (represented by the <tt>client_id</tt> request parameter).
--  The application defines the authorization methods which are allowed as well as
--  the parameters to control and drive the authorization.  This includes the redirection
--  URI, the application secret, the expiration delay for the access token.
--
--  The application manager is implemented by the application server and it must
--  implement the <tt>Application_Manager</tt> interface with the <tt>Find_Application</tt>
--  method.  The <tt>Find_Application</tt> is one of the first call made during the
--  authenticate and token generation phases.
--
--  === Resource Owner Password Credentials Grant ===
--  The password grant is one of the easiest grant method to understand but it is also one
--  of the less secure.  In this grant method, the username and user password are passed in
--  the request parameter together with the application client identifier.  The realm verifies
--  the username and password and when they are correct it generates the access token with
--  an optional refresh token.
--
--    Realm : Security.OAuth.Servers.Auth_Manager;
--    Grant : Security.OAuth.Servers.Grant_Type;
--
--      Realm.Authorize (Params, Grant);
--
--  === Accessing Protected Resources ===
--  When accessing a protected resource, the API implementation will use the
--  <tt>Authenticate</tt> operation to verify the access token and get a security principal.
--  The security principal will identifies the resource owner as well as the application
--  that is doing the call.
--
--     Realm : Security.OAuth.Servers.Auth_Manager;
--     Auth  : Security.Principal_Access;
--     Token : String := ...;
--
--       Realm.Authenticate (Token, Auth);
--
--  When a security principal is returned, the access token was validated and the
--  request is granted for the application.
--
package Security.OAuth.Servers is

   Invalid_Application : exception;

   type Application is new Security.OAuth.Application with private;

   --  Check if the application has the given permission.
   function Has_Permission (App        : in Application;
                            Permission : in Security.Permissions.Permission_Index) return Boolean;

   --  Define the status of the grant.
   type Grant_Status is (Invalid_Grant, Expired_Grant, Revoked_Grant,
                         Stealed_Grant, Valid_Grant);

   --  Define the grant type.
   type Grant_Kind is (No_Grant, Access_Grant, Code_Grant,
                       Implicit_Grant, Password_Grant, Credential_Grant,
                       Extension_Grant);

   --  The <tt>Grant_Type</tt> holds the results of the authorization.
   --  When the grant is refused, the type holds information about the refusal.
   type Grant_Type is record
      --  The request grant type.
      Request : Grant_Kind := No_Grant;

      --  The response status.
      Status  : Grant_Status := Invalid_Grant;

      --  When success, the token to return.
      Token   : Ada.Strings.Unbounded.Unbounded_String;

      --  When success, the token expiration date.
      Expires : Ada.Calendar.Time;

      --  When success, the authentication principal.
      Auth    : Security.Principal_Access;

      --  When error, the type of error to return.
      Error   : Util.Strings.Name_Access;
   end record;

   type Application_Manager is limited interface;
   type Application_Manager_Access is access all Application_Manager'Class;

   --  Find the application that correspond to the given client id.
   --  The <tt>Invalid_Application</tt> exception should be raised if there is no such application.
   function Find_Application (Realm     : in Application_Manager;
                              Client_Id : in String) return Application'Class is abstract;

   type Realm_Manager is limited interface;
   type Realm_Manager_Access is access all Realm_Manager'Class;

   --  Authenticate the token and find the associated authentication principal.
   --  The access token has been verified and the token represents the identifier
   --  of the Tuple (client_id, user, session) that describes the authentication.
   --  The <tt>Authenticate</tt> procedure should look in its database (internal
   --  or external) to find the authentication principal that was granted for
   --  the token Tuple.  When the token was not found (because it was revoked),
   --  the procedure should return a null principal.  If the authentication
   --  principal can be cached, the <tt>Cacheable</tt> value should be set.
   --  In that case, the access token and authentication  principal are inserted
   --  in a cache.
   procedure Authenticate (Realm     : in out Realm_Manager;
                           Token     : in String;
                           Auth      : out Principal_Access;
                           Cacheable : out Boolean) is abstract;

   --  Create an auth token string that identifies the given principal.  The returned
   --  token will be used by <tt>Authenticate</tt> to retrieve back the principal.  The
   --  returned token does not need to be signed.  It will be inserted in the public part
   --  of the returned access token.
   function Authorize (Realm : in Realm_Manager;
                       App   : in Application'Class;
                       Scope : in String;
                       Auth  : in Principal_Access) return String is abstract;

   procedure Verify (Realm    : in out Realm_Manager;
                     Username : in String;
                     Password : in String;
                     Auth     : out Principal_Access) is abstract;

   procedure Verify (Realm : in out Realm_Manager;
                     Token : in String;
                     Auth  : out Principal_Access) is abstract;

   procedure Revoke (Realm : in out Realm_Manager;
                     Auth  : in Principal_Access) is abstract;

   type Auth_Manager is tagged limited private;
   type Auth_Manager_Access is access all Auth_Manager'Class;

   --  Set the auth private key.
   procedure Set_Private_Key (Manager : in out Auth_Manager;
                              Key     : in String);

   --  Set the application manager to use and and applications.
   procedure Set_Application_Manager (Manager    : in out Auth_Manager;
                                      Repository : in Application_Manager_Access);

   --  Set the realm manager to authentify users.
   procedure Set_Realm_Manager (Manager : in out Auth_Manager;
                                Realm   : in Realm_Manager_Access);

   --  Authorize the access to the protected resource by the application and for the
   --  given principal.  The resource owner has been verified and is represented by the
   --  <tt>Auth</tt> principal.  Extract from the request parameters represented by
   --  <tt>Params</tt> the application client id, the scope and the expected response type.
   --  Handle the "Authorization Code Grant" and "Implicit Grant" defined in RFC 6749.
   procedure Authorize (Realm   : in out Auth_Manager;
                        Params  : in Security.Auth.Parameters'Class;
                        Auth    : in Security.Principal_Access;
                        Grant   : out Grant_Type);

   procedure Token (Realm   : in out Auth_Manager;
                    Params  : in Security.Auth.Parameters'Class;
                    Grant   : out Grant_Type);

   --  Make the access token from the authorization code that was created by the
   --  <tt>Authorize</tt> operation.  Verify the client application, the redirect uri, the
   --  client secret and the validity of the authorization code.  Extract from the
   --  authorization code the auth principal that was used for the grant and make the
   --  access token.
   procedure Token_From_Code (Realm   : in out Auth_Manager;
                              App     : in Application'Class;
                              Params  : in Security.Auth.Parameters'Class;
                              Grant   : out Grant_Type);

   procedure Authorize_Code (Realm   : in out Auth_Manager;
                             App     : in Application'Class;
                             Params  : in Security.Auth.Parameters'Class;
                             Auth    : in Security.Principal_Access;
                             Grant   : out Grant_Type);

   procedure Authorize_Token (Realm   : in out Auth_Manager;
                              App     : in Application'Class;
                              Params  : in Security.Auth.Parameters'Class;
                              Auth    : in Security.Principal_Access;
                              Grant   : out Grant_Type);

   --  Make the access token from the resource owner password credentials.  The username,
   --  password and scope are extracted from the request and they are verified through the
   --  <tt>Verify</tt> procedure to obtain an associated principal.  When successful, the
   --  principal describes the authorization and it is used to forge the access token.
   --  This operation implements the RFC 6749: 4.3.  Resource Owner Password Credentials Grant.
   procedure Token_From_Password (Realm   : in out Auth_Manager;
                                  App     : in Application'Class;
                                  Params  : in Security.Auth.Parameters'Class;
                                  Grant   : out Grant_Type);

   --  RFC 6749: 5.  Issuing an Access Token
   procedure Create_Token (Realm  : in Auth_Manager;
                           Ident  : in String;
                           Grant  : in out Grant_Type);

   --  Authenticate the access token and get a security principal that identifies the app/user.
   --  See RFC 6749, 7.  Accessing Protected Resources.
   --  The access token is first searched in the cache.  If it was found, it means the access
   --  token was already verified in the past, it is granted and associated with a principal.
   --  Otherwise, we have to verify the token signature first, then the expiration date and
   --  we extract from the token public part the auth identification.  The <tt>Authenticate</tt>
   --  operation is then called to obtain the principal from the auth identification.
   --  When access token is invalid or authentification cannot be verified, a null principal
   --  is returned.  The <tt>Grant</tt> data will hold the result of the grant with the reason
   --  of failures (if any).
   procedure Authenticate (Realm : in out Auth_Manager;
                           Token : in String;
                           Grant : out Grant_Type);

   procedure Revoke (Realm     : in out Auth_Manager;
                     Token     : in String);

private

   use Ada.Strings.Unbounded;

   function Format_Expire (Expire : in Ada.Calendar.Time) return String;

   type Application is new Security.OAuth.Application with record
      Expire_Timeout : Duration := 3600.0;
      Permissions    : Security.Permissions.Permission_Index_Set := Security.Permissions.EMPTY_SET;
   end record;

   type Cache_Entry is record
      Expire : Ada.Calendar.Time;
      Auth   : Principal_Access;
   end record;

   package Cache_Map is
     new Ada.Containers.Indefinite_Hashed_Maps (Key_Type        => String,
                                                Element_Type    => Cache_Entry,
                                                Hash            => Ada.Strings.Hash,
                                                Equivalent_Keys => "=",
                                                "="             => "=");

   --  The access token cache is used to speed up the access token verification
   --  when a request to a protected resource is made.
   protected type Token_Cache is

      procedure Authenticate (Token : in String;
                              Grant : in out Grant_Type);

      procedure Insert (Token     : in String;
                        Expire    : in Ada.Calendar.Time;
                        Principal : in Principal_Access);

      procedure Remove (Token : in String);

      procedure Timeout;

   private
      Entries : Cache_Map.Map;
   end Token_Cache;

   type Auth_Manager is new Ada.Finalization.Limited_Controlled with record
      --  The repository of applications.
      Repository  : Application_Manager_Access;

      --  The realm for user authentication.
      Realm       : Realm_Manager_Access;

      --  The server private key used by the HMAC signature.
      Private_Key : Ada.Strings.Unbounded.Unbounded_String;

      --  The access token cache.
      Cache       : Token_Cache;

      --  The expiration time for the generated authorization code.
      Expire_Code : Duration := 300.0;
   end record;

   --  The <tt>Token_Validity</tt> record provides information about a token to find out
   --  the different components it is made of and verify its validity.  The <tt>Validate</tt>
   --  procedure is in charge of checking the components and verifying the HMAC signature.
   --  The token has the following format:
   --  <expiration>.<client_id>.<auth-ident>.hmac(<public>.<private-key>)
   type Token_Validity is record
      Status       : Grant_Status := Invalid_Grant;
      Ident_Start  : Natural := 0;
      Ident_End    : Natural := 0;
      Expire       : Ada.Calendar.Time;
   end record;

   function Validate (Realm     : in Auth_Manager;
                      Client_Id : in String;
                      Token     : in String) return Token_Validity;

end Security.OAuth.Servers;

Add some documentation

Add some documentation