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

--  == Permission ==
--  The Security.Permissions package defines the different permissions that can be
--  checked by the access control manager.  An application should declare each permission
--  by instantiating the <tt>Definition</tt> package:
--
--    package Perm_Create_Workspace is new Security.Permissions.Definition ("create-workspace");
--
--  This declares a permission that can be represented by "<tt>create-workspace</tt>" in
--  configuration files.  In Ada, the permission is used as follows:
--
--     Perm_Create_Workspace.Permission
--
package Security.Permissions is

   Invalid_Name : exception;

   type Permission_Index is new Natural;

   --  Get the permission index associated with the name.
   function Get_Permission_Index (Name : in String) return Permission_Index;

   --  The permission root class.
   --  Each permission is represented by a Permission_Index number to provide a fast
   --  and efficient permission check.
   type Permission (Id : Permission_Index) is tagged limited null record;

   generic
      Name : String;
   package Definition is
      function Permission return Permission_Index;
      pragma Inline_Always (Permission);
   end Definition;

   --  Add the permission name and allocate a unique permission index.
   procedure Add_Permission (Name  : in String;
                             Index : out Permission_Index);

private

   --  Get the last permission index registered in the global permission map.
   function Get_Last_Permission_Index return Permission_Index;

end Security.Permissions;

-----------------------------------------------------------------------
--  security-permissions -- Definition of permissions
--  Copyright (C) 2010, 2011, 2012, 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.
-----------------------------------------------------------------------
private with Interfaces;

--  == Permission ==
--  The Security.Permissions package defines the different permissions that can be
--  checked by the access control manager.  An application should declare each permission
--  by instantiating the <tt>Definition</tt> package:
--
--    package Perm_Create_Workspace is new Security.Permissions.Definition ("create-workspace");
--
--  This declares a permission that can be represented by "<tt>create-workspace</tt>" in
--  configuration files.  In Ada, the permission is used as follows:
--
--     Perm_Create_Workspace.Permission
--
package Security.Permissions is

   Invalid_Name   : exception;

   --  Max number of permissions supported by the implementation.
   MAX_PERMISSION : constant Natural := 256;

   type Permission_Index is new Natural range 0 .. MAX_PERMISSION;

   --  Get the permission index associated with the name.
   function Get_Permission_Index (Name : in String) return Permission_Index;

   --  The permission root class.
   --  Each permission is represented by a Permission_Index number to provide a fast
   --  and efficient permission check.
   type Permission (Id : Permission_Index) is tagged limited null record;

   generic
      Name : String;
   package Definition is
      function Permission return Permission_Index;
      pragma Inline_Always (Permission);
   end Definition;

   --  Add the permission name and allocate a unique permission index.
   procedure Add_Permission (Name  : in String;
                             Index : out Permission_Index);

   type Permission_Index_Set is private;

   --  Check if the permission index set contains the given permission index.
   function Has_Permission (Set   : in Permission_Index_Set;
                            Index : in Permission_Index) return Boolean;

private

   --  Get the last permission index registered in the global permission map.
   function Get_Last_Permission_Index return Permission_Index;

   INDEX_SET_SIZE : constant Natural := (MAX_PERMISSION + 7) / 8;

   type Permission_Index_Set is array (1 .. INDEX_SET_SIZE) of Interfaces.Unsigned_8;

end Security.Permissions;

Declare Permission_Index_Set type to represent a set of permission indexes Declare the Has_Permission to check if the set contains a given permission index Declare MAX_PERMISSION constant for the implementation limits (256 permissions means 256 instantiations of the Definition package so it should be enough)


-----------------------------------------------------------------------
--  util-streams-buffered-lzma -- LZMA streams
--  Copyright (C) 2018, 2019 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 Lzma.Check;
with Lzma.Container;
with Interfaces.C;
package body Util.Streams.Buffered.Lzma is

   use type Interfaces.C.size_t;
   use type Base.lzma_ret;

   subtype Offset is Ada.Streams.Stream_Element_Offset;

   --  -----------------------
   --  Initialize the stream to write on the given stream.
   --  An internal buffer is allocated for writing the stream.
   --  -----------------------
   overriding
   procedure Initialize (Stream  : in out Compress_Stream;
                         Output  : in Output_Stream_Access;
                         Size    : in Positive) is
      Result : Base.lzma_ret;
   begin
      Output_Buffer_Stream (Stream).Initialize (Output, Size);

      Stream.Stream.next_out := Stream.Buffer (Stream.Buffer'First)'Unchecked_Access;
      Stream.Stream.avail_out := Stream.Buffer'Length;
      Result := Container.lzma_easy_encoder (Stream.Stream'Unchecked_Access, 6,
                                             Check.LZMA_CHECK_CRC64);
   end Initialize;

   --  -----------------------
   --  Close the sink.
   --  -----------------------
   overriding
   procedure Close (Stream : in out Compress_Stream) is
   begin
      Stream.Flush;
      Stream.Output.Close;
   end Close;

   --  -----------------------
   --  Write the buffer array to the output stream.
   --  -----------------------
   overriding
   procedure Write (Stream : in out Compress_Stream;
                    Buffer : in Ada.Streams.Stream_Element_Array) is
      Last_Pos  : Ada.Streams.Stream_Element_Offset;
      Encoded   : Boolean := False;
      Result    : Base.lzma_ret;
   begin
      loop
         if Stream.Stream.avail_in = 0 then
            Stream.Stream.next_in := Buffer (Buffer'First)'Unrestricted_Access;
            Stream.Stream.avail_in := Interfaces.C.size_t (Buffer'Length);
            Encoded := True;
         end if;

         Result := Base.lzma_code (Stream.Stream'Unchecked_Access, Base.LZMA_RUN);

         --  Write the output data when the buffer is full or we reached the end of stream.
         if Stream.Stream.avail_out = 0 or Result = Base.LZMA_STREAM_END then
            Last_Pos := Stream.Buffer'First + Stream.Buffer'Length
              - Offset (Stream.Stream.avail_out) - 1;
            Stream.Output.Write (Stream.Buffer (Stream.Buffer'First .. Last_Pos));
            Stream.Stream.next_out := Stream.Buffer (Stream.Buffer'First)'Unchecked_Access;
            Stream.Stream.avail_out := Stream.Buffer'Length;
         end if;
         exit when Result /= Base.LZMA_OK or (Stream.Stream.avail_in = 0 and Encoded);
      end loop;
   end Write;

   --  -----------------------
   --  Flush the buffer by writing on the output stream.
   --  Raises Data_Error if there is no output stream.
   --  -----------------------
   overriding
   procedure Flush (Stream : in out Compress_Stream) is
      Last_Pos : Ada.Streams.Stream_Element_Offset;
      Result : Base.lzma_ret;
   begin
      Stream.Stream.next_in := null;
      Stream.Stream.avail_in := 0;
      loop
         Result := Base.lzma_code (Stream.Stream'Unchecked_Access, Base.LZMA_FINISH);

         if Stream.Stream.avail_out = 0 or Result = Base.LZMA_STREAM_END then
            Last_Pos := Stream.Buffer'First + Stream.Buffer'Length
              - Offset (Stream.Stream.avail_out) - 1;
            Stream.Output.Write (Stream.Buffer (Stream.Buffer'First .. Last_Pos));
            Stream.Stream.next_out := Stream.Buffer (Stream.Buffer'First)'Unchecked_Access;
            Stream.Stream.avail_out := Stream.Buffer'Length;
         end if;
         exit when Result /= Base.LZMA_OK;
      end loop;
   end Flush;

   --  -----------------------
   --  Flush the stream and release the buffer.
   --  -----------------------
   overriding
   procedure Finalize (Object : in out Compress_Stream) is
   begin
      null;
   end Finalize;

end Util.Streams.Buffered.Lzma;

-----------------------------------------------------------------------
--  util-streams-buffered-lzma -- LZMA streams
--  Copyright (C) 2018, 2019 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 Lzma.Check;
with Lzma.Container;
with Interfaces.C;
with Ada.IO_Exceptions;
package body Util.Streams.Buffered.Lzma is

   use type Interfaces.C.size_t;
   use type Base.lzma_ret;

   subtype size_t is Interfaces.C.size_t;
   subtype Offset is Ada.Streams.Stream_Element_Offset;

   --  -----------------------
   --  Initialize the stream to write on the given stream.
   --  An internal buffer is allocated for writing the stream.
   --  -----------------------
   overriding
   procedure Initialize (Stream  : in out Compress_Stream;
                         Output  : access Output_Stream'Class;
                         Size    : in Positive) is
      Result : Base.lzma_ret;
   begin
      Output_Buffer_Stream (Stream).Initialize (Output, Size);

      Stream.Stream.next_out := Stream.Buffer (Stream.Buffer'First)'Unchecked_Access;
      Stream.Stream.avail_out := Stream.Buffer'Length;
      Result := Container.lzma_easy_encoder (Stream.Stream'Unchecked_Access, 6,
                                             Check.LZMA_CHECK_CRC64);
      if Result /= Base.LZMA_OK then
         raise Ada.IO_Exceptions.Device_Error with "Cannot initialize compressor";
      end if;
   end Initialize;

   --  -----------------------
   --  Close the sink.
   --  -----------------------
   overriding
   procedure Close (Stream : in out Compress_Stream) is
   begin
      Stream.Flush;
      Output_Buffer_Stream (Stream).Close;
   end Close;

   --  -----------------------
   --  Write the buffer array to the output stream.
   --  -----------------------
   overriding
   procedure Write (Stream : in out Compress_Stream;
                    Buffer : in Ada.Streams.Stream_Element_Array) is
      Last_Pos  : Ada.Streams.Stream_Element_Offset;
      Encoded   : Boolean := False;
      Result    : Base.lzma_ret;
   begin
      loop
         if Stream.Stream.avail_in = 0 then
            Stream.Stream.next_in := Buffer (Buffer'First)'Unrestricted_Access;
            Stream.Stream.avail_in := size_t (Buffer'Length);
            Encoded := True;
         end if;

         Result := Base.lzma_code (Stream.Stream'Unchecked_Access, Base.LZMA_RUN);

         --  Write the output data when the buffer is full or we reached the end of stream.
         if Stream.Stream.avail_out = 0 or Result = Base.LZMA_STREAM_END then
            Last_Pos := Stream.Buffer'First + Stream.Buffer'Length
              - Offset (Stream.Stream.avail_out) - 1;
            Stream.Output.Write (Stream.Buffer (Stream.Buffer'First .. Last_Pos));
            Stream.Stream.next_out := Stream.Buffer (Stream.Buffer'First)'Unchecked_Access;
            Stream.Stream.avail_out := Stream.Buffer'Length;
         end if;
         exit when Result /= Base.LZMA_OK or (Stream.Stream.avail_in = 0 and Encoded);
      end loop;
   end Write;

   --  -----------------------
   --  Flush the buffer by writing on the output stream.
   --  Raises Data_Error if there is no output stream.
   --  -----------------------
   overriding
   procedure Flush (Stream : in out Compress_Stream) is
      Last_Pos : Ada.Streams.Stream_Element_Offset;
      Result : Base.lzma_ret;
   begin
      Stream.Stream.next_in := null;
      Stream.Stream.avail_in := 0;
      loop
         Result := Base.lzma_code (Stream.Stream'Unchecked_Access, Base.LZMA_FINISH);

         if Stream.Stream.avail_out = 0 or Result = Base.LZMA_STREAM_END then
            Last_Pos := Stream.Buffer'First + Stream.Buffer'Length
              - Offset (Stream.Stream.avail_out) - 1;
            Stream.Output.Write (Stream.Buffer (Stream.Buffer'First .. Last_Pos));
            Stream.Stream.next_out := Stream.Buffer (Stream.Buffer'First)'Unchecked_Access;
            Stream.Stream.avail_out := Stream.Buffer'Length;
         end if;
         exit when Result /= Base.LZMA_OK;
      end loop;
   end Flush;

   --  -----------------------
   --  Flush the stream and release the buffer.
   --  -----------------------
   overriding
   procedure Finalize (Object : in out Compress_Stream) is
   begin
      Base.lzma_end (Object.Stream'Unchecked_Access);
      Output_Buffer_Stream (Object).Finalize;
   end Finalize;

   --  -----------------------
   --  Initialize the stream to write on the given stream.
   --  An internal buffer is allocated for writing the stream.
   --  -----------------------
   overriding
   procedure Initialize (Stream  : in out Decompress_Stream;
                         Input   : access Input_Stream'Class;
                         Size    : in Positive) is
      Result : Base.lzma_ret;
   begin
      Input_Buffer_Stream (Stream).Initialize (Input, Size);

      Stream.Stream.next_in := Stream.Buffer (Stream.Buffer'First)'Unchecked_Access;
      Stream.Stream.avail_in := 0;
      Result := Container.lzma_stream_decoder (Stream.Stream'Unchecked_Access,
                                               Long_Long_Integer'Last,
                                               Container.LZMA_CONCATENATED);
      if Result /= Base.LZMA_OK then
         raise Ada.IO_Exceptions.Device_Error with "Cannot initialize decompressor";
      end if;
   end Initialize;

   --  -----------------------
   --  Write the buffer array to the output stream.
   --  -----------------------
   overriding
   procedure Read (Stream : in out Decompress_Stream;
                   Into   : out Ada.Streams.Stream_Element_Array;
                   Last   : out Ada.Streams.Stream_Element_Offset) is
      use type Base.lzma_action;

      Result : Base.lzma_ret;
   begin
      Stream.Stream.next_out  := Into (Into'First)'Unrestricted_Access;
      Stream.Stream.avail_out := Into'Length;
      loop
         if Stream.Stream.avail_in = 0 and not Stream.Is_Eof
           and Stream.Action = Base.LZMA_RUN
         then
            Stream.Fill;
            if Stream.Write_Pos >= Stream.Read_Pos then
               Stream.Stream.avail_in := size_t (Stream.Write_Pos - Stream.Read_Pos);
               Stream.Stream.next_in := Stream.Buffer (Stream.Buffer'First)'Unchecked_Access;
            else
               Stream.Stream.avail_in := 0;
               Stream.Stream.next_in := null;
               Stream.Action := Base.LZMA_FINISH;
            end if;
         end if;
         Result := Base.lzma_code (Stream.Stream'Unchecked_Access, Stream.Action);

         if Stream.Stream.avail_out = 0 or Result = Base.LZMA_STREAM_END then
            Last := Into'First + Into'Length
              - Offset (Stream.Stream.avail_out) - 1;
            return;
         end if;
         if Result /= Base.LZMA_OK then
            raise Ada.IO_Exceptions.Data_Error with "Decompression error";
         end if;
      end loop;
   end Read;

   --  -----------------------
   --  Flush the stream and release the buffer.
   --  -----------------------
   overriding
   procedure Finalize (Object : in out Decompress_Stream) is
   begin
      Base.lzma_end (Object.Stream'Unchecked_Access);
      Input_Buffer_Stream (Object).Finalize;
   end Finalize;

end Util.Streams.Buffered.Lzma;

Implement operations for Decompress_Stream to decompress LZMA streams


with Ada.IO_Exceptions;
with Interfaces.C;
with Interfaces.C.Strings;
with System;

package body OpenAL.Context is
  package C         renames Interfaces.C;
  package C_Strings renames Interfaces.C.Strings;

  function Open_Device
    (Specifier : in String) return Device_t
  is
    C_Spec : aliased C.char_array := C.To_C (Specifier);
    Device : Device_t;
  begin
    Device.Device_Data := ALC_Thin.Open_Device
      (Specifier => C_Spec (C_Spec'First)'Address);
    return Device;
  end Open_Device;

  function Open_Default_Device return Device_t is
    Device : Device_t;
  begin
    Device.Device_Data := ALC_Thin.Open_Device
      (Specifier => System.Null_Address);
    return Device;
  end Open_Default_Device;

  function Close_Device
    (Device : in Device_t) return Boolean is
  begin
    return Boolean (ALC_Thin.Close_Device (Device.Device_Data));
  end Close_Device;

  function Create_Context
    (Device : in Device_t) return Context_t is
  begin
    return Context_t (ALC_Thin.Create_Context
      (Device         => Device.Device_Data,
       Attribute_List => System.Null_Address));
  end Create_Context;

  function Make_Context_Current
    (Context : in Context_t) return Boolean is
  begin
    return Boolean (ALC_Thin.Make_Context_Current (ALC_Thin.Context_t (Context)));
  end Make_Context_Current;

  procedure Process_Context
    (Context : in Context_t) is
  begin
    ALC_Thin.Process_Context (ALC_Thin.Context_t (Context));
  end Process_Context;

  procedure Suspend_Context
    (Context : in Context_t) is
  begin
    ALC_Thin.Suspend_Context (ALC_Thin.Context_t (Context));
  end Suspend_Context;

  procedure Destroy_Context
    (Context : in Context_t) is
  begin
    ALC_Thin.Destroy_Context (ALC_Thin.Context_t (Context));
  end Destroy_Context;

  function Get_Current_Context return Context_t is
  begin
    return Context_t (ALC_Thin.Get_Current_Context);
  end Get_Current_Context;

  function Get_Context_Device (Context : in Context_t) return Device_t is
    Device : Device_t;
  begin
    Device.Device_Data := ALC_Thin.Get_Contexts_Device (ALC_Thin.Context_t (Context));
    return Device;
  end Get_Context_Device;

  function Is_Extension_Present
    (Device : in Device_t;
     Name   : in String) return Boolean
  is
    C_Name : aliased C.char_array := C.To_C (Name);
  begin
    return Boolean (ALC_Thin.Is_Extension_Present
      (Device         => Device.Device_Data,
       Extension_Name => C_Name (C_Name'First)'Address));
  end Is_Extension_Present;

  --
  -- String queries
  --

  function Get_String
    (Device    : ALC_Thin.Device_t;
     Parameter : ALC_Thin.Enumeration_t) return C_Strings.chars_ptr;
  pragma Import (C, Get_String, "alcGetString");

  use type ALC_Thin.Device_t;

  Null_Device : constant ALC_Thin.Device_t := ALC_Thin.Device_t (System.Null_Address);

  function Get_Default_Device_Specifier return String is
  begin
    return C_Strings.Value
      (Get_String
        (Device    => Null_Device,
         Parameter => ALC_Thin.ALC_DEFAULT_DEVICE_SPECIFIER));
  end Get_Default_Device_Specifier;

  function Get_Device_Specifier
    (Device : in Device_t) return String is
  begin
    if Device.Device_Data = Null_Device then
      raise Ada.IO_Exceptions.Device_Error with "invalid device";
    end if;

    return C_Strings.Value
      (Get_String
        (Device    => Device.Device_Data,
         Parameter => ALC_Thin.ALC_DEVICE_SPECIFIER));
  end Get_Device_Specifier;

  function Get_Extensions
    (Device : in Device_t) return String is
  begin
    if Device.Device_Data = Null_Device then
      raise Ada.IO_Exceptions.Device_Error with "invalid device";
    end if;

    return C_Strings.Value
      (Get_String
        (Device    => Device.Device_Data,
         Parameter => ALC_Thin.ALC_EXTENSIONS));
  end Get_Extensions;

  function Get_Default_Capture_Device_Specifier return String is
  begin
    return C_Strings.Value
      (Get_String
        (Device    => Null_Device,
         Parameter => ALC_Thin.ALC_CAPTURE_DEFAULT_DEVICE_SPECIFIER));
  end Get_Default_Capture_Device_Specifier;

  function Get_Available_Capture_Devices return OpenAL.List.String_Vector_t is
    Address : System.Address;
    List    : OpenAL.List.String_Vector_t;
  begin
    Address := ALC_Thin.Get_String
      (Device => ALC_Thin.Device_t (System.Null_Address),
       Token  => ALC_Thin.ALC_CAPTURE_DEVICE_SPECIFIER);
    OpenAL.List.Address_To_Vector
      (Address => Address,
       List    => List);
    return List;
  end Get_Available_Capture_Devices;

  --
  -- Integer queries
  --

  function Get_Major_Version
    (Device : in Device_t) return Natural
  is
    Value : aliased Natural := 0;
  begin
    ALC_Thin.Get_Integerv
      (Device => Device.Device_Data,
       Token  => ALC_Thin.ALC_MAJOR_VERSION,
       Size   => ALC_Thin.Size_t (Natural'Size / System.Storage_Unit),
       Data   => Value'Address);
    return Value;
  end Get_Major_Version;

  function Get_Minor_Version
    (Device : in Device_t) return Natural
  is
    Value : aliased Natural := 0;
  begin
    ALC_Thin.Get_Integerv
      (Device => Device.Device_Data,
       Token  => ALC_Thin.ALC_MINOR_VERSION,
       Size   => ALC_Thin.Size_t (Natural'Size / System.Storage_Unit),
       Data   => Value'Address);
    return Value;
  end Get_Minor_Version;

  function Get_Capture_Samples
    (Device : in Device_t) return Natural
  is
    Value : aliased Natural := 0;
  begin
    ALC_Thin.Get_Integerv
      (Device => Device.Device_Data,
       Token  => ALC_Thin.ALC_CAPTURE_SAMPLES,
       Size   => ALC_Thin.Size_t (Natural'Size / System.Storage_Unit),
       Data   => Value'Address);
    return Value;
  end Get_Capture_Samples;

  function Get_Frequency
    (Device : in Device_t) return Types.Frequency_t
  is
    Value : aliased Types.Frequency_t := Types.Frequency_t'First;
  begin
    ALC_Thin.Get_Integerv
      (Device => Device.Device_Data,
       Token  => ALC_Thin.ALC_FREQUENCY,
       Size   => ALC_Thin.Size_t (Types.Frequency_t'Size / System.Storage_Unit),
       Data   => Value'Address);
    return Value;
  end Get_Frequency;

  function Get_Refresh
    (Device : in Device_t) return Natural
  is
    Value : aliased Natural := 0;
  begin
    ALC_Thin.Get_Integerv
      (Device => Device.Device_Data,
       Token  => ALC_Thin.ALC_REFRESH,
       Size   => ALC_Thin.Size_t (Natural'Size / System.Storage_Unit),
       Data   => Value'Address);
    return Value;
  end Get_Refresh;

  function Get_Synchronous
    (Device : in Device_t) return Boolean
  is
    Value : aliased Natural := 0;
  begin
    ALC_Thin.Get_Integerv
      (Device => Device.Device_Data,
       Token  => ALC_Thin.ALC_SYNC,
       Size   => ALC_Thin.Size_t (Natural'Size / System.Storage_Unit),
       Data   => Value'Address);
    return Boolean'Val (Value);
  end Get_Synchronous;

  function Get_Mono_Sources
    (Device : in Device_t) return Natural
  is
    Value : aliased Natural := 0;
  begin
    ALC_Thin.Get_Integerv
      (Device => Device.Device_Data,
       Token  => ALC_Thin.ALC_MONO_SOURCES,
       Size   => ALC_Thin.Size_t (Natural'Size / System.Storage_Unit),
       Data   => Value'Address);
    return Value;
  end Get_Mono_Sources;

  function Get_Stereo_Sources
    (Device : in Device_t) return Natural
  is
    Value : aliased Natural := 0;
  begin
    ALC_Thin.Get_Integerv
      (Device => Device.Device_Data,
       Token  => ALC_Thin.ALC_STEREO_SOURCES,
       Size   => ALC_Thin.Size_t (Natural'Size / System.Storage_Unit),
       Data   => Value'Address);
    return Value;
  end Get_Stereo_Sources;

end OpenAL.Context;

with Ada.IO_Exceptions;
with Interfaces.C.Strings;
with Interfaces.C;
with OpenAL.Thin;
with System;

package body OpenAL.Context is
  package C         renames Interfaces.C;
  package C_Strings renames Interfaces.C.Strings;

  function Open_Device
    (Specifier : in String) return Device_t
  is
    C_Spec : aliased C.char_array := C.To_C (Specifier);
    Device : Device_t;
  begin
    Device.Device_Data := ALC_Thin.Open_Device
      (Specifier => C_Spec (C_Spec'First)'Address);
    return Device;
  end Open_Device;

  function Open_Default_Device return Device_t is
    Device : Device_t;
  begin
    Device.Device_Data := ALC_Thin.Open_Device
      (Specifier => System.Null_Address);
    return Device;
  end Open_Default_Device;

  function Close_Device
    (Device : in Device_t) return Boolean is
  begin
    return Boolean (ALC_Thin.Close_Device (Device.Device_Data));
  end Close_Device;

  function Create_Context
    (Device : in Device_t) return Context_t is
  begin
    return Context_t (ALC_Thin.Create_Context
      (Device         => Device.Device_Data,
       Attribute_List => System.Null_Address));
  end Create_Context;

  function Make_Context_Current
    (Context : in Context_t) return Boolean is
  begin
    return Boolean (ALC_Thin.Make_Context_Current (ALC_Thin.Context_t (Context)));
  end Make_Context_Current;

  procedure Process_Context
    (Context : in Context_t) is
  begin
    ALC_Thin.Process_Context (ALC_Thin.Context_t (Context));
  end Process_Context;

  procedure Suspend_Context
    (Context : in Context_t) is
  begin
    ALC_Thin.Suspend_Context (ALC_Thin.Context_t (Context));
  end Suspend_Context;

  procedure Destroy_Context
    (Context : in Context_t) is
  begin
    ALC_Thin.Destroy_Context (ALC_Thin.Context_t (Context));
  end Destroy_Context;

  function Get_Current_Context return Context_t is
  begin
    return Context_t (ALC_Thin.Get_Current_Context);
  end Get_Current_Context;

  function Get_Context_Device (Context : in Context_t) return Device_t is
    Device : Device_t;
  begin
    Device.Device_Data := ALC_Thin.Get_Contexts_Device (ALC_Thin.Context_t (Context));
    return Device;
  end Get_Context_Device;

  function Is_Extension_Present
    (Device : in Device_t;
     Name   : in String) return Boolean
  is
    C_Name : aliased C.char_array := C.To_C (Name);
  begin
    return Boolean (ALC_Thin.Is_Extension_Present
      (Device         => Device.Device_Data,
       Extension_Name => C_Name (C_Name'First)'Address));
  end Is_Extension_Present;

  --
  -- String queries
  --

  function Get_String
    (Device    : ALC_Thin.Device_t;
     Parameter : ALC_Thin.Enumeration_t) return C_Strings.chars_ptr;
  pragma Import (C, Get_String, "alcGetString");

  use type ALC_Thin.Device_t;

  Null_Device : constant ALC_Thin.Device_t := ALC_Thin.Device_t (System.Null_Address);

  function Get_Default_Device_Specifier return String is
  begin
    return C_Strings.Value
      (Get_String
        (Device    => Null_Device,
         Parameter => ALC_Thin.ALC_DEFAULT_DEVICE_SPECIFIER));
  end Get_Default_Device_Specifier;

  function Get_Device_Specifier
    (Device : in Device_t) return String is
  begin
    if Device.Device_Data = Null_Device then
      raise Ada.IO_Exceptions.Device_Error with "invalid device";
    end if;

    return C_Strings.Value
      (Get_String
        (Device    => Device.Device_Data,
         Parameter => ALC_Thin.ALC_DEVICE_SPECIFIER));
  end Get_Device_Specifier;

  function Get_Extensions
    (Device : in Device_t) return String is
  begin
    if Device.Device_Data = Null_Device then
      raise Ada.IO_Exceptions.Device_Error with "invalid device";
    end if;

    return C_Strings.Value
      (Get_String
        (Device    => Device.Device_Data,
         Parameter => ALC_Thin.ALC_EXTENSIONS));
  end Get_Extensions;

  function Get_Default_Capture_Device_Specifier return String is
  begin
    return C_Strings.Value
      (Get_String
        (Device    => Null_Device,
         Parameter => ALC_Thin.ALC_CAPTURE_DEFAULT_DEVICE_SPECIFIER));
  end Get_Default_Capture_Device_Specifier;

  function Get_Available_Capture_Devices return OpenAL.List.String_Vector_t is
    Address : System.Address;
    List    : OpenAL.List.String_Vector_t;
  begin
    Address := ALC_Thin.Get_String
      (Device => ALC_Thin.Device_t (System.Null_Address),
       Token  => ALC_Thin.ALC_CAPTURE_DEVICE_SPECIFIER);
    OpenAL.List.Address_To_Vector
      (Address => Address,
       List    => List);
    return List;
  end Get_Available_Capture_Devices;

  --
  -- Integer queries
  --

  function Get_Major_Version
    (Device : in Device_t) return Natural
  is
    Value : aliased Thin.Integer_t := 0;
  begin
    ALC_Thin.Get_Integerv
      (Device => Device.Device_Data,
       Token  => ALC_Thin.ALC_MAJOR_VERSION,
       Size   => 1,
       Data   => Value'Address);
    return Natural (Value);
  end Get_Major_Version;

  function Get_Minor_Version
    (Device : in Device_t) return Natural
  is
    Value : aliased Thin.Integer_t := 0;
  begin
    ALC_Thin.Get_Integerv
      (Device => Device.Device_Data,
       Token  => ALC_Thin.ALC_MINOR_VERSION,
       Size   => 1,
       Data   => Value'Address);
    return Natural (Value);
  end Get_Minor_Version;

  function Get_Capture_Samples
    (Device : in Device_t) return Natural
  is
    Value : aliased Thin.Integer_t := 0;
  begin
    ALC_Thin.Get_Integerv
      (Device => Device.Device_Data,
       Token  => ALC_Thin.ALC_CAPTURE_SAMPLES,
       Size   => 1,
       Data   => Value'Address);
    return Natural (Value);
  end Get_Capture_Samples;

  function Get_Frequency
    (Device : in Device_t) return Types.Frequency_t
  is
    Value : aliased Thin.Integer_t := 0;
  begin
    ALC_Thin.Get_Integerv
      (Device => Device.Device_Data,
       Token  => ALC_Thin.ALC_FREQUENCY,
       Size   => 1,
       Data   => Value'Address);
    return Types.Frequency_t (Value);
  end Get_Frequency;

  function Get_Refresh
    (Device : in Device_t) return Natural
  is
    Value : aliased Thin.Integer_t := 0;
  begin
    ALC_Thin.Get_Integerv
      (Device => Device.Device_Data,
       Token  => ALC_Thin.ALC_REFRESH,
       Size   => 1,
       Data   => Value'Address);
    return Natural (Value);
  end Get_Refresh;

  function Get_Synchronous
    (Device : in Device_t) return Boolean
  is
    Value : aliased Thin.Integer_t := 0;
  begin
    ALC_Thin.Get_Integerv
      (Device => Device.Device_Data,
       Token  => ALC_Thin.ALC_SYNC,
       Size   => 1,
       Data   => Value'Address);
    return Boolean'Val (Value);
  end Get_Synchronous;

  function Get_Mono_Sources
    (Device : in Device_t) return Natural
  is
    Value : aliased Thin.Integer_t := 0;
  begin
    ALC_Thin.Get_Integerv
      (Device => Device.Device_Data,
       Token  => ALC_Thin.ALC_MONO_SOURCES,
       Size   => 1,
       Data   => Value'Address);
    return Natural (Value);
  end Get_Mono_Sources;

  function Get_Stereo_Sources
    (Device : in Device_t) return Natural
  is
    Value : aliased Thin.Integer_t := 0;
  begin
    ALC_Thin.Get_Integerv
      (Device => Device.Device_Data,
       Token  => ALC_Thin.ALC_STEREO_SOURCES,
       Size   => 1,
       Data   => Value'Address);
    return Natural (Value);
  end Get_Stereo_Sources;

end OpenAL.Context;

Adjust how getIntegerv is called (do not use sizes)


-----------------------------------------------------------------------
--  awa-wikis-modules -- Module wikis
--  Copyright (C) 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with AWA.Services.Contexts;
with AWA.Workspaces.Models;
with AWA.Workspaces.Modules;
with AWA.Modules.Get;
with AWA.Permissions;
with AWA.Permissions.Services;
with AWA.Users.Models;
with AWA.Wikis.Beans;
with AWA.Modules.Beans;

with Ada.Calendar;
with ADO.Sessions;

with Util.Log.Loggers;
package body AWA.Wikis.Modules is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Awa.Wikis.Module");

   package Register is new AWA.Modules.Beans (Module => Wiki_Module,
                                              Module_Access => Wiki_Module_Access);

   --  ------------------------------
   --  Initialize the wikis module.
   --  ------------------------------
   overriding
   procedure Initialize (Plugin : in out Wiki_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config) is
   begin
      Log.Info ("Initializing the wikis module");

      --  Register here any bean class, servlet, filter.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Wikis.Beans.Wiki_Space_Bean",
                         Handler => AWA.Wikis.Beans.Create_Wiki_Space_Bean'Access);

      AWA.Modules.Module (Plugin).Initialize (App, Props);

      --  Add here the creation of manager instances.
   end Initialize;

   --  ------------------------------
   --  Get the wikis module.
   --  ------------------------------
   function Get_Wiki_Module return Wiki_Module_Access is
      function Get is new AWA.Modules.Get (Wiki_Module, Wiki_Module_Access, NAME);
   begin
      return Get;
   end Get_Wiki_Module;

   --  ------------------------------
   --  Create the wiki space.
   --  ------------------------------
   procedure Create_Wiki_Space (Module : in Wiki_Module;
                                Wiki   : in out AWA.Wikis.Models.Wiki_Space_Ref'Class) is
      pragma Unreferenced (Module);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      WS    : AWA.Workspaces.Models.Workspace_Ref;
   begin
      Log.Info ("Creating new wiki space {0}", String '(Wiki.Get_Name));

      Ctx.Start;
      AWA.Workspaces.Modules.Get_Workspace (DB, Ctx, WS);

      --  Check that the user has the create permission on the given workspace.
      AWA.Permissions.Check (Permission => ACL_Create_Wiki_Space.Permission,
                             Entity     => WS);
      Wiki.Set_Workspace (WS);
      Wiki.Save (DB);

      --  Add the permission for the user to use the new wiki space.
      AWA.Permissions.Services.Add_Permission (Session => DB,
                                               User    => User,
                                               Entity  => Wiki);
      Ctx.Commit;

      Log.Info ("Wiki {0} created for user {1}",
                ADO.Identifier'Image (Wiki.Get_Id), ADO.Identifier'Image (User));
   end Create_Wiki_Space;

   --  ------------------------------
   --  Save the wiki space.
   --  ------------------------------
   procedure Save_Wiki_Space (Module : in Wiki_Module;
                              Wiki   : in out AWA.Wikis.Models.Wiki_Space_Ref'Class) is
      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Log.Info ("Updating wiki space {0}", String '(Wiki.Get_Name));

      Ctx.Start;

      --  Check that the user has the update permission on the given wiki space.
      AWA.Permissions.Check (Permission => ACL_Update_Wiki_Space.Permission,
                             Entity     => Wiki);
      Wiki.Save (DB);
      Ctx.Commit;
   end Save_Wiki_Space;

   --  ------------------------------
   --  Load the wiki space.
   --  ------------------------------
   procedure Load_Wiki_Space (Module : in Wiki_Module;
                              Wiki   : in out AWA.Wikis.Models.Wiki_Space_Ref'Class;
                              Id     : in ADO.Identifier) is
      pragma Unreferenced (Module);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Session := AWA.Services.Contexts.Get_Session (Ctx);
      Found : Boolean;
   begin
      Wiki.Load (DB, Id, Found);
   end Load_Wiki_Space;

   --  ------------------------------
   --  Create the wiki page into the wiki space.
   --  ------------------------------
   procedure Create_Wiki_Page (Model  : in Wiki_Module;
                               Into   : in AWA.Wikis.Models.Wiki_Space_Ref'Class;
                               Page   : in out Awa.Wikis.Models.Wiki_Page_Ref'Class) is
      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Log.Info ("Create wiki page {0}", String '(Page.Get_Name));

      --  Check that the user has the create wiki page permission on the given wiki space.
      AWA.Permissions.Check (Permission => ACL_Create_Wiki_Pages.Permission,
                             Entity     => Into);

      Ctx.Start;
      Page.Set_Is_Public (Into.Get_Is_Public);
      Page.Set_Wiki (Into);
      Page.Save (DB);
      Ctx.Commit;
   end Create_Wiki_Page;

   --  ------------------------------
   --  Save the wiki page.
   --  ------------------------------
   procedure Save (Model  : in Wiki_Module;
                   Page   : in out Awa.Wikis.Models.Wiki_Page_Ref'Class) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      --  Check that the user has the create wiki page permission on the given wiki space.
      AWA.Permissions.Check (Permission => ACL_Update_Wiki_Pages.Permission,
                             Entity     => Page);

      Ctx.Start;
      Page.Save (DB);
      Ctx.Commit;
   end Save;

   --  ------------------------------
   --  Create a new wiki content for the wiki page.
   --  ------------------------------
   procedure Create_Wiki_Content (Model   : in Wiki_Module;
                                  Page    : in out Awa.Wikis.Models.Wiki_Page_Ref'Class;
                                  Content : in out AWA.Wikis.Models.Wiki_Content_Ref'Class) is
      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      User  : AWA.Users.Models.User_Ref := Ctx.Get_User;
   begin
      --  Check that the user has the create wiki content permission on the given wiki page.
      AWA.Permissions.Check (Permission => ACL_Update_Wiki_Pages.Permission,
                             Entity     => Page);

      Ctx.Start;
      Content.Set_Page (Page);
      Content.Set_Create_Date (Ada.Calendar.Clock);
      Content.Set_Author (User);
      Content.Save (DB);
      Page.Set_Content (Content);
      Page.Set_Last_Version (Page.Get_Last_Version + 1);
      Page.Save (DB);
      Ctx.Commit;
   end Create_Wiki_Content;

end AWA.Wikis.Modules;

-----------------------------------------------------------------------
--  awa-wikis-modules -- Module wikis
--  Copyright (C) 2015 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with AWA.Services.Contexts;
with AWA.Workspaces.Models;
with AWA.Workspaces.Modules;
with AWA.Modules.Get;
with AWA.Permissions;
with AWA.Permissions.Services;
with AWA.Users.Models;
with AWA.Wikis.Beans;
with AWA.Modules.Beans;

with Ada.Calendar;
with ADO.Sessions;

with Util.Log.Loggers;
package body AWA.Wikis.Modules is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Awa.Wikis.Module");

   package Register is new AWA.Modules.Beans (Module => Wiki_Module,
                                              Module_Access => Wiki_Module_Access);

   --  ------------------------------
   --  Initialize the wikis module.
   --  ------------------------------
   overriding
   procedure Initialize (Plugin : in out Wiki_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config) is
   begin
      Log.Info ("Initializing the wikis module");

      --  Register here any bean class, servlet, filter.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Wikis.Beans.Wiki_Space_Bean",
                         Handler => AWA.Wikis.Beans.Create_Wiki_Space_Bean'Access);

      AWA.Modules.Module (Plugin).Initialize (App, Props);

      --  Add here the creation of manager instances.
   end Initialize;

   --  ------------------------------
   --  Get the wikis module.
   --  ------------------------------
   function Get_Wiki_Module return Wiki_Module_Access is
      function Get is new AWA.Modules.Get (Wiki_Module, Wiki_Module_Access, NAME);
   begin
      return Get;
   end Get_Wiki_Module;

   --  ------------------------------
   --  Create the wiki space.
   --  ------------------------------
   procedure Create_Wiki_Space (Module : in Wiki_Module;
                                Wiki   : in out AWA.Wikis.Models.Wiki_Space_Ref'Class) is
      pragma Unreferenced (Module);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      WS    : AWA.Workspaces.Models.Workspace_Ref;
   begin
      Log.Info ("Creating new wiki space {0}", String '(Wiki.Get_Name));

      Ctx.Start;
      AWA.Workspaces.Modules.Get_Workspace (DB, Ctx, WS);

      --  Check that the user has the create permission on the given workspace.
      AWA.Permissions.Check (Permission => ACL_Create_Wiki_Space.Permission,
                             Entity     => WS);
      Wiki.Set_Workspace (WS);
      Wiki.Set_Create_Date (Ada.Calendar.Clock);
      Wiki.Save (DB);

      --  Add the permission for the user to use the new wiki space.
      AWA.Permissions.Services.Add_Permission (Session => DB,
                                               User    => User,
                                               Entity  => Wiki);
      Ctx.Commit;

      Log.Info ("Wiki {0} created for user {1}",
                ADO.Identifier'Image (Wiki.Get_Id), ADO.Identifier'Image (User));
   end Create_Wiki_Space;

   --  ------------------------------
   --  Save the wiki space.
   --  ------------------------------
   procedure Save_Wiki_Space (Module : in Wiki_Module;
                              Wiki   : in out AWA.Wikis.Models.Wiki_Space_Ref'Class) is
      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Log.Info ("Updating wiki space {0}", String '(Wiki.Get_Name));

      Ctx.Start;

      --  Check that the user has the update permission on the given wiki space.
      AWA.Permissions.Check (Permission => ACL_Update_Wiki_Space.Permission,
                             Entity     => Wiki);
      Wiki.Save (DB);
      Ctx.Commit;
   end Save_Wiki_Space;

   --  ------------------------------
   --  Load the wiki space.
   --  ------------------------------
   procedure Load_Wiki_Space (Module : in Wiki_Module;
                              Wiki   : in out AWA.Wikis.Models.Wiki_Space_Ref'Class;
                              Id     : in ADO.Identifier) is
      pragma Unreferenced (Module);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Session := AWA.Services.Contexts.Get_Session (Ctx);
      Found : Boolean;
   begin
      Wiki.Load (DB, Id, Found);
   end Load_Wiki_Space;

   --  ------------------------------
   --  Create the wiki page into the wiki space.
   --  ------------------------------
   procedure Create_Wiki_Page (Model  : in Wiki_Module;
                               Into   : in AWA.Wikis.Models.Wiki_Space_Ref'Class;
                               Page   : in out Awa.Wikis.Models.Wiki_Page_Ref'Class) is
      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Log.Info ("Create wiki page {0}", String '(Page.Get_Name));

      --  Check that the user has the create wiki page permission on the given wiki space.
      AWA.Permissions.Check (Permission => ACL_Create_Wiki_Pages.Permission,
                             Entity     => Into);

      Ctx.Start;
      Page.Set_Is_Public (Into.Get_Is_Public);
      Page.Set_Wiki (Into);
      Page.Save (DB);
      Ctx.Commit;
   end Create_Wiki_Page;

   --  ------------------------------
   --  Save the wiki page.
   --  ------------------------------
   procedure Save (Model  : in Wiki_Module;
                   Page   : in out Awa.Wikis.Models.Wiki_Page_Ref'Class) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      --  Check that the user has the create wiki page permission on the given wiki space.
      AWA.Permissions.Check (Permission => ACL_Update_Wiki_Pages.Permission,
                             Entity     => Page);

      Ctx.Start;
      Page.Save (DB);
      Ctx.Commit;
   end Save;

   --  ------------------------------
   --  Create a new wiki content for the wiki page.
   --  ------------------------------
   procedure Create_Wiki_Content (Model   : in Wiki_Module;
                                  Page    : in out Awa.Wikis.Models.Wiki_Page_Ref'Class;
                                  Content : in out AWA.Wikis.Models.Wiki_Content_Ref'Class) is
      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      User  : AWA.Users.Models.User_Ref := Ctx.Get_User;
   begin
      --  Check that the user has the create wiki content permission on the given wiki page.
      AWA.Permissions.Check (Permission => ACL_Update_Wiki_Pages.Permission,
                             Entity     => Page);

      Ctx.Start;
      Content.Set_Page (Page);
      Content.Set_Create_Date (Ada.Calendar.Clock);
      Content.Set_Author (User);
      Content.Save (DB);
      Page.Set_Content (Content);
      Page.Set_Last_Version (Page.Get_Last_Version + 1);
      Page.Save (DB);
      Ctx.Commit;
   end Create_Wiki_Content;

end AWA.Wikis.Modules;

Set the creation date on the wiki space

Set the creation date on the wiki space


-----------------------------------------------------------------------
--  awa-storages-services-tests -- Unit tests for storage service
--  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.Streams;
with Ada.Strings.Unbounded;

with Util.Test_Caller;

with ADO;

with Security.Contexts;

with AWA.Services.Contexts;
with AWA.Storages.Modules;
with AWA.Storages.Beans.Factories;
with AWA.Tests.Helpers.Users;
package body AWA.Storages.Services.Tests is

   use Util.Tests;
   use ADO;

   package Caller is new Util.Test_Caller (Test, "Storages.Services");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Storages.Services.Save",
                       Test_Create_Storage'Access);
      Caller.Add_Test (Suite, "Test AWA.Storages.Services.Delete",
                       Test_Delete_Storage'Access);
      Caller.Add_Test (Suite, "Test AWA.Storages.Services.Save_Folder, Folder_Bean",
                       Test_Create_Folder'Access);

   end Add_Tests;

   --  ------------------------------
   --  Save something in a storage element and keep track of the store id in the test Id.
   --  ------------------------------
   procedure Save (T : in out Test) is
      Store     : AWA.Storages.Models.Storage_Ref;
   begin
      T.Manager := AWA.Storages.Modules.Get_Storage_Manager;
      T.Assert (T.Manager /= null, "Null storage manager");

      T.Manager.Save (Into    => Store,
                      Path    => "Makefile",
                      Storage => AWA.Storages.Models.DATABASE);
      T.Assert (not Store.Is_Null, "Storage object should not be null");
      T.Id := Store.Get_Id;
      T.Assert (T.Id > 0, "Invalid storage identifier");
   end Save;

   --  ------------------------------
   --  Load the storage element refered to by the test Id.
   --  ------------------------------
   procedure Load (T : in out Test) is
      use type Ada.Streams.Stream_Element_Offset;

      Data      : ADO.Blob_Ref;
   begin
      T.Manager := AWA.Storages.Modules.Get_Storage_Manager;
      T.Assert (T.Manager /= null, "Null storage manager");

      T.Manager.Load (From => T.Id, Into => Data);
      T.Assert (not Data.Is_Null, "Null blob returned by load");
      T.Assert (Data.Value.Len > 100, "Invalid length for the blob data");
   end Load;

   --  ------------------------------
   --  Test creation of a storage object
   --  ------------------------------
   procedure Test_Create_Storage (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-storage@test.com");

      T.Save;
      T.Load;
   end Test_Create_Storage;

   --  ------------------------------
   --  Test deletion of a storage object
   --  ------------------------------
   procedure Test_Delete_Storage (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      Data      : ADO.Blob_Ref;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-storage@test.com");

      T.Save;
      T.Manager.Delete (T.Id);
      T.Manager.Load (From => T.Id, Into => Data);
      T.Assert (Data.Is_Null, "A non null blob returned by load");
   end Test_Delete_Storage;

   --  ------------------------------
   --  Test creation of a storage folder
   --  ------------------------------
   procedure Test_Create_Folder (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      Folder    : AWA.Storages.Beans.Factories.Folder_Bean;
      Outcome   : Ada.Strings.Unbounded.Unbounded_String;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-storage@test.com");

      Folder.Set_Name ("Test folder name");
      Folder.Module := AWA.Storages.Modules.Get_Storage_Module;
      Folder.Save (Outcome);
      Util.Tests.Assert_Equals (T, "success", Outcome, "Invalid outcome returned by Save action");

   end Test_Create_Folder;

end AWA.Storages.Services.Tests;

-----------------------------------------------------------------------
--  awa-storages-services-tests -- Unit tests for storage service
--  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.Streams;
with Ada.Strings.Unbounded;

with Util.Test_Caller;

with ADO;

with Security.Contexts;

with AWA.Services.Contexts;
with AWA.Storages.Modules;
with AWA.Storages.Beans.Factories;
with AWA.Tests.Helpers.Users;
package body AWA.Storages.Services.Tests is

   use Util.Tests;
   use ADO;

   package Caller is new Util.Test_Caller (Test, "Storages.Services");

   procedure Add_Tests (Suite : in Util.Tests.Access_Test_Suite) is
   begin
      Caller.Add_Test (Suite, "Test AWA.Storages.Services.Save",
                       Test_Create_Storage'Access);
      Caller.Add_Test (Suite, "Test AWA.Storages.Services.Delete",
                       Test_Delete_Storage'Access);
      Caller.Add_Test (Suite, "Test AWA.Storages.Services.Save_Folder, Folder_Bean",
                       Test_Create_Folder'Access);

   end Add_Tests;

   --  ------------------------------
   --  Save something in a storage element and keep track of the store id in the test Id.
   --  ------------------------------
   procedure Save (T : in out Test) is
      Store     : AWA.Storages.Models.Storage_Ref;
   begin
      T.Manager := AWA.Storages.Modules.Get_Storage_Manager;
      T.Assert (T.Manager /= null, "Null storage manager");

      T.Manager.Save (Into    => Store,
                      Path    => "Makefile",
                      Storage => AWA.Storages.Models.DATABASE);
      T.Assert (not Store.Is_Null, "Storage object should not be null");
      T.Id := Store.Get_Id;
      T.Assert (T.Id > 0, "Invalid storage identifier");
   end Save;

   --  ------------------------------
   --  Load the storage element refered to by the test Id.
   --  ------------------------------
   procedure Load (T : in out Test) is
      use type Ada.Streams.Stream_Element_Offset;

      Mime      : Ada.Strings.Unbounded.Unbounded_String;
      Date      : Ada.Calendar.Time;
      Data      : ADO.Blob_Ref;
   begin
      T.Manager := AWA.Storages.Modules.Get_Storage_Manager;
      T.Assert (T.Manager /= null, "Null storage manager");

      T.Manager.Load (From => T.Id, Mime => Mime, Date => Date, Into => Data);
      T.Assert (not Data.Is_Null, "Null blob returned by load");
      T.Assert (Data.Value.Len > 100, "Invalid length for the blob data");
   end Load;

   --  ------------------------------
   --  Test creation of a storage object
   --  ------------------------------
   procedure Test_Create_Storage (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-storage@test.com");

      T.Save;
      T.Load;
   end Test_Create_Storage;

   --  ------------------------------
   --  Test deletion of a storage object
   --  ------------------------------
   procedure Test_Delete_Storage (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      Data      : ADO.Blob_Ref;
      Mime      : Ada.Strings.Unbounded.Unbounded_String;
      Date      : Ada.Calendar.Time;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-storage@test.com");

      T.Save;
      T.Manager.Delete (T.Id);
      T.Manager.Load (From => T.Id, Mime => Mime, Date => Date, Into => Data);
      T.Assert (Data.Is_Null, "A non null blob returned by load");
   end Test_Delete_Storage;

   --  ------------------------------
   --  Test creation of a storage folder
   --  ------------------------------
   procedure Test_Create_Folder (T : in out Test) is
      Sec_Ctx   : Security.Contexts.Security_Context;
      Context   : AWA.Services.Contexts.Service_Context;
      Folder    : AWA.Storages.Beans.Factories.Folder_Bean;
      Outcome   : Ada.Strings.Unbounded.Unbounded_String;
   begin
      AWA.Tests.Helpers.Users.Login (Context, Sec_Ctx, "test-storage@test.com");

      Folder.Set_Name ("Test folder name");
      Folder.Module := AWA.Storages.Modules.Get_Storage_Module;
      Folder.Save (Outcome);
      Util.Tests.Assert_Equals (T, "success", Outcome, "Invalid outcome returned by Save action");

   end Test_Create_Folder;

end AWA.Storages.Services.Tests;

Update the unit test

Update the unit test


-----------------------------------------------------------------------
--  awa-users-servlets -- OpenID verification servlet for user authentication
--  Copyright (C) 2011, 2012, 2013, 2014, 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.
-----------------------------------------------------------------------
with Util.Beans.Objects;
with Util.Beans.Objects.Records;
with Util.Log.Loggers;

with ASF.Cookies;
with ASF.Servlets;

with AWA.Users.Services;
with AWA.Users.Modules;
with AWA.Users.Filters;
with AWA.Users.Principals;
package body AWA.Users.Servlets is

   --  Name of the session attribute which holds the URI to redirect after authentication.
   REDIRECT_ATTRIBUTE : constant String := "awa-redirect";

   --  Name of the request attribute that contains the URI to redirect after authentication.
   REDIRECT_PARAM     : constant String := "redirect";

   --  Name of the session attribute which holds information about the active authentication.
   OPENID_ASSOC_ATTRIBUTE : constant String := "openid-assoc";

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Users.Servlets");

   --  Make a package to store the Association in the session.
   package Association_Bean is new Util.Beans.Objects.Records (Security.Auth.Association);

   subtype Association_Access is Association_Bean.Element_Type_Access;

   function Get_Provider_URL (Server   : in Request_Auth_Servlet;
                              Request  : in ASF.Requests.Request'Class) return String;

   function Get_Provider_URL (Server   : in Request_Auth_Servlet;
                              Request  : in ASF.Requests.Request'Class) return String is
      pragma Unreferenced (Server);

      URI  : constant String := Request.Get_Path_Info;
   begin
      if URI'Length = 0 then
         return "";
      end if;
      Log.Info ("OpenID authentication with {0}", URI);
      return URI (URI'First + 1 .. URI'Last);
   end Get_Provider_URL;

   --  ------------------------------
   --  Proceed to the OpenID authentication with an OpenID provider.
   --  Find the OpenID provider URL and starts the discovery, association phases
   --  during which a private key is obtained from the OpenID provider.
   --  After OpenID discovery and association, the user will be redirected to
   --  the OpenID provider.
   --  ------------------------------
   overriding
   procedure Do_Get (Server   : in Request_Auth_Servlet;
                     Request  : in out ASF.Requests.Request'Class;
                     Response : in out ASF.Responses.Response'Class) is

      Ctx      : constant ASF.Servlets.Servlet_Registry_Access := Server.Get_Servlet_Context;
      Name     : constant String := Get_Provider_URL (Server, Request);
      URL      : constant String := Ctx.Get_Init_Parameter ("auth.url." & Name);
   begin
      Log.Info ("GET: request OpenId authentication to {0} - {1}", Name, URL);

      if Name'Length = 0 or URL'Length = 0 then
         Response.Set_Status (ASF.Responses.SC_NOT_FOUND);
         return;
      end if;

      declare
         Mgr   : Security.Auth.Manager;
         OP    : Security.Auth.End_Point;
         Bean  : constant Util.Beans.Objects.Object := Association_Bean.Create;
         Assoc : constant Association_Access := Association_Bean.To_Element_Access (Bean);
         Redirect : constant String := Request.Get_Parameter (REDIRECT_PARAM);
      begin
         Server.Initialize (Name, Mgr);

         --  Yadis discovery (get the XRDS file).  This step does nothing for OAuth.
         Mgr.Discover (URL, OP);

         --  Associate to the OpenID provider and get an end-point with a key.
         Mgr.Associate (OP, Assoc.all);

         --  Save the association in the HTTP session and
         --  redirect the user to the OpenID provider.
         declare
            Auth_URL : constant String := Mgr.Get_Authentication_URL (OP, Assoc.all);
            Session  : ASF.Sessions.Session := Request.Get_Session (Create => True);
         begin
            Log.Info ("Redirect to auth URL: {0}", Auth_URL);

            Response.Send_Redirect (Location => Auth_URL);
            Session.Set_Attribute (Name  => OPENID_ASSOC_ATTRIBUTE,
                                   Value => Bean);
            if Redirect'Length > 0 then
               Session.Set_Attribute (Name  => REDIRECT_ATTRIBUTE,
                                      Value => Util.Beans.Objects.To_Object (Redirect));
            end if;
         end;
      end;
   end Do_Get;

   --  ------------------------------
   --  Create a principal object that correspond to the authenticated user identified
   --  by the <b>Auth</b> information.  The principal will be attached to the session
   --  and will be destroyed when the session is closed.
   --  ------------------------------
   overriding
   procedure Create_Principal (Server : in Verify_Auth_Servlet;
                               Auth   : in Security.Auth.Authentication;
                               Result : out ASF.Principals.Principal_Access) is
      pragma Unreferenced (Server);
      use AWA.Users.Modules;
      use AWA.Users.Services;

      Manager   : constant User_Service_Access := AWA.Users.Modules.Get_User_Manager;
      Principal : AWA.Users.Principals.Principal_Access;
   begin
      Manager.Authenticate (Auth    => Auth,
                            IpAddr  => "",
                            Principal => Principal);
      Result := Principal.all'Access;
   end Create_Principal;

   --  ------------------------------
   --  Get the redirection URL that must be used after the authentication succeeded.
   --  ------------------------------
   function Get_Redirect_URL (Server  : in Verify_Auth_Servlet;
                              Session : in ASF.Sessions.Session'Class;
                              Request : in ASF.Requests.Request'Class) return String is
      Redir : constant Util.Beans.Objects.Object := Session.Get_Attribute (REDIRECT_ATTRIBUTE);
      Ctx   : constant ASF.Servlets.Servlet_Registry_Access := Server.Get_Servlet_Context;
   begin
      if not Util.Beans.Objects.Is_Null (Redir) then
         return Util.Beans.Objects.To_String (Redir);
      end if;
      declare
         Cookies : constant ASF.Cookies.Cookie_Array := Request.Get_Cookies;
      begin
         for I in Cookies'Range loop
            if ASF.Cookies.Get_Name (Cookies (I)) = AWA.Users.Filters.REDIRECT_COOKIE then
               return ASF.Cookies.Get_Value (Cookies (I));
            end if;
         end loop;
      end;
      return Ctx.Get_Init_Parameter ("openid.success_url");
   end Get_Redirect_URL;

   --  ------------------------------
   --  Verify the authentication result that was returned by the OpenID provider.
   --  If the authentication succeeded and the signature was correct, sets a
   --  user principals on the session.
   --  ------------------------------
   procedure Do_Get (Server   : in Verify_Auth_Servlet;
                     Request  : in out ASF.Requests.Request'Class;
                     Response : in out ASF.Responses.Response'Class) is
      use type Security.Auth.Auth_Result;

      type Auth_Params is new Security.Auth.Parameters with null record;

      overriding
      function Get_Parameter (Params : in Auth_Params;
                              Name   : in String) return String;

      overriding
      function Get_Parameter (Params : in Auth_Params;
                              Name   : in String) return String is
         pragma Unreferenced (Params);
      begin
         return Request.Get_Parameter (Name);
      end Get_Parameter;

      Session    : ASF.Sessions.Session := Request.Get_Session (Create => False);
      Bean       : Util.Beans.Objects.Object;
      Mgr        : Security.Auth.Manager;
      Assoc      : Association_Access;
      Credential : Security.Auth.Authentication;
      Params     : Auth_Params;
   begin
      Log.Info ("GET: verify openid authentication");

      if not Session.Is_Valid then
         Log.Warn ("Session has expired during OpenID authentication process");
         Response.Set_Status (ASF.Responses.SC_FORBIDDEN);
         return;
      end if;

      Bean := Session.Get_Attribute (OPENID_ASSOC_ATTRIBUTE);

      --  Cleanup the session and drop the association end point.
      Session.Remove_Attribute (OPENID_ASSOC_ATTRIBUTE);
      if Util.Beans.Objects.Is_Null (Bean) then
         Log.Warn ("Verify openid request without active session");
         Response.Set_Status (ASF.Responses.SC_FORBIDDEN);
         return;
      end if;

      Assoc := Association_Bean.To_Element_Access (Bean);
      Server.Initialize (Security.Auth.Get_Provider (Assoc.all), Mgr);

      --  Verify that what we receive through the callback matches the association key.
      Mgr.Verify (Assoc.all, Params, Credential);
      if Security.Auth.Get_Status (Credential) /= Security.Auth.AUTHENTICATED then
         Log.Info ("Authentication has failed");
         Response.Set_Status (ASF.Responses.SC_FORBIDDEN);
         return;
      end if;

      Log.Info ("Authentication succeeded for {0}", Security.Auth.Get_Email (Credential));

      --  Get a user principal and set it on the session.
      declare
         User     : ASF.Principals.Principal_Access;
         Redirect : constant String
           := Verify_Auth_Servlet'Class (Server).Get_Redirect_URL (Session, Request);
      begin
         Verify_Auth_Servlet'Class (Server).Create_Principal (Credential, User);
         Session.Set_Principal (User);
         Session.Remove_Attribute (REDIRECT_ATTRIBUTE);

         Log.Info ("Redirect user to URL: {0}", Redirect);
         Response.Send_Redirect (Redirect);
      end;
   end Do_Get;

end AWA.Users.Servlets;

-----------------------------------------------------------------------
--  awa-users-servlets -- OpenID verification servlet for user authentication
--  Copyright (C) 2011, 2012, 2013, 2014, 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.
-----------------------------------------------------------------------
with Util.Beans.Objects;
with Util.Beans.Objects.Records;
with Util.Log.Loggers;

with ASF.Cookies;
with ASF.Servlets;

with AWA.Users.Services;
with AWA.Users.Modules;
with AWA.Users.Filters;
with AWA.Users.Principals;
package body AWA.Users.Servlets is

   --  Name of the session attribute which holds the URI to redirect after authentication.
   REDIRECT_ATTRIBUTE : constant String := "awa-redirect";

   --  Name of the request attribute that contains the URI to redirect after authentication.
   REDIRECT_PARAM     : constant String := "redirect";

   --  Name of the session attribute which holds information about the active authentication.
   OPENID_ASSOC_ATTRIBUTE : constant String := "openid-assoc";

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("AWA.Users.Servlets");

   --  Make a package to store the Association in the session.
   package Association_Bean is new Util.Beans.Objects.Records (Security.Auth.Association);

   subtype Association_Access is Association_Bean.Element_Type_Access;

   function Get_Provider_URL (Server   : in Request_Auth_Servlet;
                              Request  : in ASF.Requests.Request'Class) return String;

   function Get_Provider_URL (Server   : in Request_Auth_Servlet;
                              Request  : in ASF.Requests.Request'Class) return String is
      pragma Unreferenced (Server);

      URI  : constant String := Request.Get_Path_Info;
   begin
      if URI'Length = 0 then
         return "";
      end if;
      Log.Info ("OpenID authentication with {0}", URI);
      return URI (URI'First + 1 .. URI'Last);
   end Get_Provider_URL;

   --  ------------------------------
   --  Proceed to the OpenID authentication with an OpenID provider.
   --  Find the OpenID provider URL and starts the discovery, association phases
   --  during which a private key is obtained from the OpenID provider.
   --  After OpenID discovery and association, the user will be redirected to
   --  the OpenID provider.
   --  ------------------------------
   overriding
   procedure Do_Get (Server   : in Request_Auth_Servlet;
                     Request  : in out ASF.Requests.Request'Class;
                     Response : in out ASF.Responses.Response'Class) is

      Ctx      : constant ASF.Servlets.Servlet_Registry_Access := Server.Get_Servlet_Context;
      Name     : constant String := Get_Provider_URL (Server, Request);
      URL      : constant String := Ctx.Get_Init_Parameter ("auth.url." & Name);
   begin
      Log.Info ("GET: request OpenId authentication to {0} - {1}", Name, URL);

      if Name'Length = 0 or URL'Length = 0 then
         Response.Set_Status (ASF.Responses.SC_NOT_FOUND);
         return;
      end if;

      declare
         Mgr   : Security.Auth.Manager;
         OP    : Security.Auth.End_Point;
         Bean  : constant Util.Beans.Objects.Object := Association_Bean.Create;
         Assoc : constant Association_Access := Association_Bean.To_Element_Access (Bean);
         Redirect : constant String := Request.Get_Parameter (REDIRECT_PARAM);
      begin
         Server.Initialize (Name, Mgr);

         --  Yadis discovery (get the XRDS file).  This step does nothing for OAuth.
         Mgr.Discover (URL, OP);

         --  Associate to the OpenID provider and get an end-point with a key.
         Mgr.Associate (OP, Assoc.all);

         --  Save the association in the HTTP session and
         --  redirect the user to the OpenID provider.
         declare
            Auth_URL : constant String := Mgr.Get_Authentication_URL (OP, Assoc.all);
            Session  : ASF.Sessions.Session := Request.Get_Session (Create => True);
         begin
            Log.Info ("Redirect to auth URL: {0}", Auth_URL);

            Response.Send_Redirect (Location => Auth_URL);
            Session.Set_Attribute (Name  => OPENID_ASSOC_ATTRIBUTE,
                                   Value => Bean);
            if Redirect'Length > 0 then
               Session.Set_Attribute (Name  => REDIRECT_ATTRIBUTE,
                                      Value => Util.Beans.Objects.To_Object (Redirect));
            end if;
         end;
      end;
   end Do_Get;

   --  ------------------------------
   --  Create a principal object that correspond to the authenticated user identified
   --  by the <b>Auth</b> information.  The principal will be attached to the session
   --  and will be destroyed when the session is closed.
   --  ------------------------------
   overriding
   procedure Create_Principal (Server : in Verify_Auth_Servlet;
                               Auth   : in Security.Auth.Authentication;
                               Result : out ASF.Principals.Principal_Access) is
      pragma Unreferenced (Server);
      use AWA.Users.Services;

      Manager   : constant User_Service_Access := AWA.Users.Modules.Get_User_Manager;
      Principal : AWA.Users.Principals.Principal_Access;
   begin
      Manager.Authenticate (Auth    => Auth,
                            IpAddr  => "",
                            Principal => Principal);
      Result := Principal.all'Access;
   end Create_Principal;

   --  ------------------------------
   --  Get the redirection URL that must be used after the authentication succeeded.
   --  ------------------------------
   function Get_Redirect_URL (Server  : in Verify_Auth_Servlet;
                              Session : in ASF.Sessions.Session'Class;
                              Request : in ASF.Requests.Request'Class) return String is
      Redir : constant Util.Beans.Objects.Object := Session.Get_Attribute (REDIRECT_ATTRIBUTE);
      Ctx   : constant ASF.Servlets.Servlet_Registry_Access := Server.Get_Servlet_Context;
   begin
      if not Util.Beans.Objects.Is_Null (Redir) then
         return Util.Beans.Objects.To_String (Redir);
      end if;
      declare
         Cookies : constant ASF.Cookies.Cookie_Array := Request.Get_Cookies;
      begin
         for I in Cookies'Range loop
            if ASF.Cookies.Get_Name (Cookies (I)) = AWA.Users.Filters.REDIRECT_COOKIE then
               return ASF.Cookies.Get_Value (Cookies (I));
            end if;
         end loop;
      end;
      return Ctx.Get_Init_Parameter ("openid.success_url");
   end Get_Redirect_URL;

   --  ------------------------------
   --  Verify the authentication result that was returned by the OpenID provider.
   --  If the authentication succeeded and the signature was correct, sets a
   --  user principals on the session.
   --  ------------------------------
   procedure Do_Get (Server   : in Verify_Auth_Servlet;
                     Request  : in out ASF.Requests.Request'Class;
                     Response : in out ASF.Responses.Response'Class) is
      use type Security.Auth.Auth_Result;

      type Auth_Params is new Security.Auth.Parameters with null record;

      overriding
      function Get_Parameter (Params : in Auth_Params;
                              Name   : in String) return String;

      overriding
      function Get_Parameter (Params : in Auth_Params;
                              Name   : in String) return String is
         pragma Unreferenced (Params);
      begin
         return Request.Get_Parameter (Name);
      end Get_Parameter;

      Session    : ASF.Sessions.Session := Request.Get_Session (Create => False);
      Bean       : Util.Beans.Objects.Object;
      Mgr        : Security.Auth.Manager;
      Assoc      : Association_Access;
      Credential : Security.Auth.Authentication;
      Params     : Auth_Params;
   begin
      Log.Info ("GET: verify openid authentication");

      if not Session.Is_Valid then
         Log.Warn ("Session has expired during OpenID authentication process");
         Response.Set_Status (ASF.Responses.SC_FORBIDDEN);
         return;
      end if;

      Bean := Session.Get_Attribute (OPENID_ASSOC_ATTRIBUTE);

      --  Cleanup the session and drop the association end point.
      Session.Remove_Attribute (OPENID_ASSOC_ATTRIBUTE);
      if Util.Beans.Objects.Is_Null (Bean) then
         Log.Warn ("Verify openid request without active session");
         Response.Set_Status (ASF.Responses.SC_FORBIDDEN);
         return;
      end if;

      Assoc := Association_Bean.To_Element_Access (Bean);
      Server.Initialize (Security.Auth.Get_Provider (Assoc.all), Mgr);

      --  Verify that what we receive through the callback matches the association key.
      Mgr.Verify (Assoc.all, Params, Credential);
      if Security.Auth.Get_Status (Credential) /= Security.Auth.AUTHENTICATED then
         Log.Info ("Authentication has failed");
         Response.Set_Status (ASF.Responses.SC_FORBIDDEN);
         return;
      end if;

      Log.Info ("Authentication succeeded for {0}", Security.Auth.Get_Email (Credential));

      --  Get a user principal and set it on the session.
      declare
         User     : ASF.Principals.Principal_Access;
         Redirect : constant String
           := Verify_Auth_Servlet'Class (Server).Get_Redirect_URL (Session, Request);
      begin
         Verify_Auth_Servlet'Class (Server).Create_Principal (Credential, User);
         Session.Set_Principal (User);
         Session.Remove_Attribute (REDIRECT_ATTRIBUTE);

         Log.Info ("Redirect user to URL: {0}", Redirect);
         Response.Send_Redirect (Redirect);
      end;
   end Do_Get;

end AWA.Users.Servlets;

Remove unused use clause to fix compilation warning