------------------------------------------------------------------------------
-- EMAIL: <darkestkhan@gmail.com>                                           --
-- License: ISC License (see COPYING file)                                  --
--                                                                          --
--                        Copyright © 2015 darkestkhan                      --
------------------------------------------------------------------------------
-- Permission to use, copy, modify, and/or distribute this software for any --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- The software is provided "as is" and the author disclaims all warranties --
-- with regard to this software including all implied warranties of         --
-- merchantability and fitness. In no event shall the author be liable for  --
-- any special, direct, indirect, or consequential damages or any damages   --
-- whatsoever resulting from loss of use, data or profits, whether in an    --
-- action of contract, negligence or other tortious action, arising out of  --
-- or in connection with the use or performance of this software.           --
------------------------------------------------------------------------------
with Ada.Characters.Handling;
with Ada.Containers.Hashed_Sets;
with Ada.Command_Line;
with Ada.Strings.Fixed;
with Ada.Strings.Hash;
package body CBAP is

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

  function To_Lower (Item: in String) return String
    renames Ada.Characters.Handling.To_Lower;

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

  type Callback_Data is
  record
    Hash    : Ada.Containers.Hash_Type;
    Callback: Callbacks;
    Arg_Type: Argument_Types  := Value;
    Case_Sensitive: Boolean   := True;
  end record;

  function Hash (This: in Callback_Data) return Ada.Containers.Hash_Type
  is
  begin
    return This.Hash;
  end Hash;

  overriding function "=" (Left, Right: in Callback_Data) return Boolean
  is
    use type Ada.Containers.Hash_Type;
  begin
    return Left.Hash = Right.Hash;
  end "=";

  procedure Null_Callback (Item: in String) is null;

  Empty_Callback_Data: constant Callback_Data :=
    Callback_Data'(0, Null_Callback'Access, Value, True);

  package Callback_Sets is new
    Ada.Containers.Hashed_Sets (Callback_Data, Hash, "=");

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

  Callback_Set: Callback_Sets.Set := Callback_Sets.Empty_Set;

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

  procedure Register
    ( Callback      : in Callbacks;
      Called_On     : in String;
      Argument_Type : in Argument_Types := Value;
      Case_Sensitive: in Boolean        := True
    )
  is
    Var: Callback_Data :=
      Callback_Data'(0, Callback, Argument_Type, Case_Sensitive);
  begin
    if Ada.Strings.Fixed.Index (Called_On, "=", Called_On'First) /= 0 then
      raise Incorrect_Called_On with Called_On;
    end if;

    if Case_Sensitive then
      Var.Hash := Ada.Strings.Hash (Called_On);
    else
      Var.Hash := Ada.Strings.Hash (To_Lower (Called_On));
    end if;

    Callback_Set.Insert (Var);
  exception
    when Constraint_Error => raise Constraint_Error with
      "Following argument already has callback registered: " & Called_On;
  end Register;

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

  procedure Process_Arguments
  is

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

    package CLI renames Ada.Command_Line;

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

    procedure Add_Inputs (From: in Natural)
    is
    begin
      if not (From < CLI.Argument_Count) then
        return;
      end if;

      for K in From + 1 .. CLI.Argument_Count loop
        Input_Arguments.Append (CLI.Argument (K));
      end loop;
    end Add_Inputs;

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

    function Extract_Name   (Item: in String) return String
    is
    begin
      return Item
        (Item'First .. Ada.Strings.Fixed.Index (Item, "=", Item'First) - 1);
    end Extract_Name;

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

    function Extract_Value  (Item: in String) return String
    is
    begin
      return Item
        (Ada.Strings.Fixed.Index (Item, "=", Item'First) + 1 .. Item'Last);
    end Extract_Value;

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

    procedure Check_Callback (Item: in String)
    is
      Dummy_Callback  : Callback_Data := Empty_Callback_Data;
      Actual_Callback : Callback_Data := Empty_Callback_Data;
    begin
      -- Check for case insensitive value callback
      Dummy_Callback.Hash := Ada.Strings.Hash (To_Lower (Item));
      if Callback_Set.Contains (Dummy_Callback) then
        Actual_Callback :=
          Callback_Sets.Element (Callback_Set.Find (Dummy_Callback));

        if not (Actual_Callback.Case_Sensitive) and
          Actual_Callback.Arg_Type = Value
        then
          Actual_Callback.Callback (Item);
          return;
        end if;
      end if;

      -- Check for case sensitive value callback
      Dummy_Callback.Hash := Ada.Strings.Hash (Item);
      if Callback_Set.Contains (Dummy_Callback) then
        Actual_Callback :=
          Callback_Sets.Element (Callback_Set.Find (Dummy_Callback));

        if Actual_Callback.Arg_Type = Value and
          Actual_Callback.Case_Sensitive
        then
          Actual_Callback.Callback (Item);
          return;
        end if;
      end if;

      -- Check for case insensitive variable callback
      Dummy_Callback.Hash := Ada.Strings.Hash (To_Lower (Extract_Name (Item)));
      if Callback_Set.Contains (Dummy_Callback) then
        Actual_Callback :=
          Callback_Sets.Element (Callback_Set.Find (Dummy_Callback));

        if not (Actual_Callback.Case_Sensitive) and
          Actual_Callback.Arg_Type = Variable
        then
          Actual_Callback.Callback (Extract_Value (Item));
          return;
        end if;
      end if;

      -- Check for case sensitive variable callback
      Dummy_Callback.Hash := Ada.Strings.Hash (Extract_Name (Item));
      if Callback_Set.Contains (Dummy_Callback) then
        Actual_Callback :=
          Callback_Sets.Element (Callback_Set.Find (Dummy_Callback));

        if Actual_Callback.Arg_Type = Variable and
          Actual_Callback.Case_Sensitive
        then
          Actual_Callback.Callback (Extract_Value (Item));
          return;
        end if;
      end if;

      -- No callback associated with argument has been found.
      Unknown_Arguments.Append (Item);
    end Check_Callback;

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

  begin
    if CLI.Argument_Count = 0 then
      return;
    end if;

    for K in 1 .. CLI.Argument_Count loop
      declare
        Arg: constant String := CLI.Argument (K);
      begin
        if Arg = "--" then
          Add_Inputs (K);
          return;
        end if;

        -- Strip leading hyphens
        if Arg'Length > 2 and then Arg (Arg'First .. Arg'First + 1) = "--" then
          Check_Callback (Arg (Arg'First + 2 .. Arg'Last));
        elsif Arg'Length > 1 and then Arg (1 .. 1) = "-" then
          Check_Callback (Arg (Arg'First + 1 .. Arg'Last));
        else
          Check_Callback (Arg);
        end if;
      end;
    end loop;
  end Process_Arguments;

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

end CBAP;

------------------------------------------------------------------------------
-- EMAIL: <darkestkhan@gmail.com>                                           --
-- License: ISC License (see COPYING file)                                  --
--                                                                          --
--                        Copyright © 2015 darkestkhan                      --
------------------------------------------------------------------------------
-- Permission to use, copy, modify, and/or distribute this software for any --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- The software is provided "as is" and the author disclaims all warranties --
-- with regard to this software including all implied warranties of         --
-- merchantability and fitness. In no event shall the author be liable for  --
-- any special, direct, indirect, or consequential damages or any damages   --
-- whatsoever resulting from loss of use, data or profits, whether in an    --
-- action of contract, negligence or other tortious action, arising out of  --
-- or in connection with the use or performance of this software.           --
------------------------------------------------------------------------------
with Ada.Characters.Handling;
with Ada.Containers.Hashed_Sets;
with Ada.Command_Line;
with Ada.Strings.Fixed;
with Ada.Strings.Hash;
package body CBAP is

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

  function To_Lower (Item: in String) return String
    renames Ada.Characters.Handling.To_Lower;

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

  type Callback_Data is
  record
    Hash    : Ada.Containers.Hash_Type;
    Callback: Callbacks;
    Arg_Type: Argument_Types  := Value;
    Case_Sensitive: Boolean   := True;
  end record;

  function Hash (This: in Callback_Data) return Ada.Containers.Hash_Type
  is
  begin
    return This.Hash;
  end Hash;

  overriding function "=" (Left, Right: in Callback_Data) return Boolean
  is
    use type Ada.Containers.Hash_Type;
  begin
    return Left.Hash = Right.Hash;
  end "=";

  procedure Null_Callback (Item: in String) is null;

  Empty_Callback_Data: constant Callback_Data :=
    Callback_Data'(0, Null_Callback'Access, Value, True);

  package Callback_Sets is new
    Ada.Containers.Hashed_Sets (Callback_Data, Hash, "=");

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

  Callback_Set: Callback_Sets.Set := Callback_Sets.Empty_Set;

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

  procedure Register
    ( Callback      : in Callbacks;
      Called_On     : in String;
      Argument_Type : in Argument_Types := Value;
      Case_Sensitive: in Boolean        := True
    )
  is
    Var: Callback_Data :=
      Callback_Data'(0, Callback, Argument_Type, Case_Sensitive);
  begin
    if Ada.Strings.Fixed.Index (Called_On, "=", Called_On'First) /= 0 then
      raise Incorrect_Called_On with Called_On;
    end if;

    if Case_Sensitive then
      Var.Hash := Ada.Strings.Hash (Called_On);
    else
      Var.Hash := Ada.Strings.Hash (To_Lower (Called_On));
    end if;

    Callback_Set.Insert (Var);
  exception
    when Constraint_Error => raise Constraint_Error with
      "Following argument already has callback registered: " & Called_On;
  end Register;

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

  procedure Process_Arguments
  is

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

    package CLI renames Ada.Command_Line;

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

    procedure Add_Inputs (From: in Natural)
    is
    begin
      if not (From < CLI.Argument_Count) then
        return;
      end if;

      for K in From + 1 .. CLI.Argument_Count loop
        Input_Arguments.Append (CLI.Argument (K));
      end loop;
    end Add_Inputs;

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

    function Extract_Name   (Item: in String) return String
    is
    begin
      return Item
        (Item'First .. Ada.Strings.Fixed.Index (Item, "=", Item'First) - 1);
    end Extract_Name;

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

    function Extract_Value  (Item: in String) return String
    is
      Pos: constant Natural := Ada.Strings.Fixed.Index (Item, "=", Item'First);
    begin
      if Pos = Item'Last then
        return ""; -- in case: "variable="
      else
        return Item (Pos + 1 .. Item'Last);
      end if;
    end Extract_Value;

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

    procedure Check_Callback (Item: in String)
    is
      Dummy_Callback  : Callback_Data := Empty_Callback_Data;
      Actual_Callback : Callback_Data := Empty_Callback_Data;
    begin
      Case_Check: -- loop over case sensitiviness
      for Case_Sensitive in Boolean'Range loop

        Arg_Type_Check: -- loop over argument type
        for Arg_Type in Argument_Types'Range loop
          if Arg_Type = Value then
            if Case_Sensitive then
              Dummy_Callback.Hash := Ada.Strings.Hash (Item);
            else
              Dummy_Callback.Hash := Ada.Strings.Hash (To_Lower (Item));
            end if;
          else -- For Variable we need to need to hash name ONLY
            if Case_Sensitive then
              Dummy_Callback.Hash := Ada.Strings.Hash (Extract_Name (Item));
            else
              Dummy_Callback.Hash := Ada.Strings.Hash
                (Extract_Name (To_Lower (Item)));
            end if;
          end if;

          if Callback_Set.Contains (Dummy_Callback) then
            Actual_Callback :=
              Callback_Sets.Element (Callback_Set.Find (Dummy_Callback));

            if Actual_Callback.Case_Sensitive = Case_Sensitive and
               Actual_Callback.Arg_Type = Arg_Type
            then
              if Arg_Type = Value then
                Actual_Callback.Callback (Item);
                return;
              else -- Special circuitry for Variable type
                declare
                  Pos: constant Natural :=
                    Ada.Strings.Fixed.Index (Item, "=", Item'First);
                begin
                  if Pos = 0 then
                    Unknown_Arguments.Append (Item);
                    return;
                  else
                    Actual_Callback.Callback (Extract_Value (Item));
                    return;
                  end if;
                end;
              end if;
            end if;
          end if; -- Callback_Set.Contains
        end loop Arg_Type_Check;
      end loop Case_Check;

      -- No callback associated with argument has been found.
      Unknown_Arguments.Append (Item);
    end Check_Callback;

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

  begin
    if CLI.Argument_Count = 0 then
      return;
    end if;

    for K in 1 .. CLI.Argument_Count loop
      declare
        Arg: constant String := CLI.Argument (K);
      begin
        if Arg = "--" then
          Add_Inputs (K);
          return;
        end if;

        -- Strip leading hyphens
        if Arg'Length > 2 and then Arg (Arg'First .. Arg'First + 1) = "--" then
          Check_Callback (Arg (Arg'First + 2 .. Arg'Last));
        elsif Arg'Length > 1 and then Arg (1 .. 1) = "-" then
          Check_Callback (Arg (Arg'First + 1 .. Arg'Last));
        else
          Check_Callback (Arg);
        end if;
      end;
    end loop;
  end Process_Arguments;

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

end CBAP;

Refactor implementation of Process_Arguments.

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


-----------------------------------------------------------------------
--  security-openid -- Open ID 2.0 Support
--  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 Ada.Strings.Unbounded;
with Ada.Calendar;
with Ada.Finalization;

with Util.Http;
with Security.Permissions;

--  The Security.Openid package implements an authentication framework based
--  on OpenID 2.0.
--
--  See OpenID Authentication 2.0 - Final
--  http://openid.net/specs/openid-authentication-2_0.html
package Security.Openid is

   Invalid_End_Point : exception;

   Service_Error     : exception;

   type Parameters is limited interface;

   function Get_Parameter (Params : in Parameters;
                           Name   : in String) return String is abstract;

   --  ------------------------------
   --  OpenID provider
   --  ------------------------------
   --  The End_Point represents the OpenID provider that will authenticate
   --  the user.
   type End_Point is private;

   function To_String (OP : End_Point) return String;

   --  ------------------------------
   --  Association
   --  ------------------------------
   --  The OpenID association contains the shared secret between the relying party
   --  and the OpenID provider.  The association can be cached and reused to authenticate
   --  different users using the same OpenID provider.  The association also has an
   --  expiration date.
   type Association is private;

   --  Dump the association as a string (for debugging purposes)
   function To_String (Assoc : Association) return String;

   type Auth_Result is (AUTHENTICATED, CANCEL, SETUP_NEEDED, UNKNOWN, INVALID_SIGNATURE);

   --  ------------------------------
   --  OpenID provider
   --  ------------------------------
   --
   type Authentication is private;

   --  Get the email address
   function Get_Email (Auth : in Authentication) return String;

   --  Get the user first name.
   function Get_First_Name (Auth : in Authentication) return String;

   --  Get the user last name.
   function Get_Last_Name (Auth : in Authentication) return String;

   --  Get the user full name.
   function Get_Full_Name (Auth : in Authentication) return String;

   --  Get the user identity.
   function Get_Identity (Auth : in Authentication) return String;

   --  Get the user claimed identity.
   function Get_Claimed_Id (Auth : in Authentication) return String;

   --  Get the user language.
   function Get_Language (Auth : in Authentication) return String;

   --  Get the user country.
   function Get_Country (Auth : in Authentication) return String;

   --  Get the result of the authentication.
   function Get_Status (Auth : in Authentication) return Auth_Result;

   --  ------------------------------
   --  OpenID Default principal
   --  ------------------------------
   type Principal is new Security.Permissions.Principal with private;
   type Principal_Access is access all Principal'Class;

   --  Returns true if the given role is stored in the user principal.
   function Has_Role (User : in Principal;
                      Role : in Permissions.Role_Type) return Boolean;

   --  Get the principal name.
   function Get_Name (From : in Principal) return String;

   --  Get the user email address.
   function Get_Email (From : in Principal) return String;

   --  Get the authentication data.
   function Get_Authentication (From : in Principal) return Authentication;

   --  Create a principal with the given authentication results.
   function Create_Principal (Auth : in Authentication) return Principal_Access;

   --  ------------------------------
   --  OpenID Manager
   --  ------------------------------
   --  The process is the following:
   --
   --  o Initialize is called to configure the OpenID realm and set the
   --    OpenID return callback CB.
   --  o Discover is called to retrieve from the OpenID provider the XRDS
   --    stream and identify the provider.  An End_Point is returned.
   --  o Associate is called to make the association with the End_Point.
   --    The Association record holds session, and authentication.
   --  o Get_Authentication_URL builds the provider OpenID authentication
   --    URL for the association.
   --  o The user should be redirected to the authentication URL.
   --  o The OpenID provider authenticate the user and redirects the user to the callback CB.
   --  o The association is decoded from the callback parameter.
   --  o Verify is called with the association to check the result and
   --    obtain the authentication results.
   type Manager is tagged limited private;

   --  Initialize the OpenID realm.
   procedure Initialize (Realm     : in out Manager;
                         Name      : in String;
                         Return_To : in String);

   --  Discover the OpenID provider that must be used to authenticate the user.
   --  The Name can be an URL or an alias that identifies the provider.
   --  A cached OpenID provider can be returned.
   --  (See OpenID Section 7.3 Discovery)
   procedure Discover (Realm  : in out Manager;
                       Name   : in String;
                       Result : out End_Point);

   --  Associate the application (relying party) with the OpenID provider.
   --  The association can be cached.
   --  (See OpenID Section 8 Establishing Associations)
   procedure Associate (Realm  : in out Manager;
                        OP     : in End_Point;
                        Result : out Association);

   function Get_Authentication_URL (Realm : in Manager;
                                    OP    : in End_Point;
                                    Assoc : in Association) return String;

   --  Verify the authentication result
   procedure Verify (Realm   : in out Manager;
                     Assoc   : in Association;
                     Request : in Parameters'Class;
                     Result  : out Authentication);

   --  Verify the authentication result
   procedure Verify_Discovered (Realm   : in out Manager;
                                Assoc   : in Association;
                                Request : in Parameters'Class;
                                Result  : out Authentication);

   --  Verify the signature part of the result
   procedure Verify_Signature (Realm   : in Manager;
                               Assoc   : in Association;
                               Request : in Parameters'Class;
                               Result  : in out Authentication);

   --  Read the XRDS document from the URI and initialize the OpenID provider end point.
   procedure Discover_XRDS (Realm  : in out Manager;
                            URI    : in String;
                            Result : out End_Point);

   --  Extract from the XRDS content the OpenID provider URI.
   --  The default implementation is very basic as it returns the first <URI>
   --  available in the stream without validating the XRDS document.
   --  Raises the Invalid_End_Point exception if the URI cannot be found.
   procedure Extract_XRDS (Realm   : in out Manager;
                           Content : in String;
                           Result  : out End_Point);

private

   use Ada.Strings.Unbounded;

   type Association is record
      Session_Type : Unbounded_String;
      Assoc_Type   : Unbounded_String;
      Assoc_Handle : Unbounded_String;
      Mac_Key      : Unbounded_String;
      Expired      : Ada.Calendar.Time;
   end record;

   type Authentication is record
      Status     : Auth_Result;
      Identity   : Unbounded_String;
      Claimed_Id : Unbounded_String;
      Email      : Unbounded_String;
      Full_Name  : Unbounded_String;
      First_Name : Unbounded_String;
      Last_Name  : Unbounded_String;
      Language   : Unbounded_String;
      Country    : Unbounded_String;
      Gender     : Unbounded_String;
      Timezone   : Unbounded_String;
      Nickname   : Unbounded_String;
   end record;

   type End_Point is record
      URL        : Unbounded_String;
      Alias      : Unbounded_String;
      Expired    : Ada.Calendar.Time;
   end record;

   type Manager is new Ada.Finalization.Limited_Controlled with record
      Realm     : Unbounded_String;
      Return_To : Unbounded_String;
   end record;

   type Principal is new Security.Permissions.Principal with record
      Auth : Authentication;
   end record;

end Security.Openid;

-----------------------------------------------------------------------
--  security-openid -- Open ID 2.0 Support
--  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 Ada.Strings.Unbounded;
with Ada.Calendar;
with Ada.Finalization;

with Security.Permissions;

--  == OpenID ==
--  The Security.Openid package implements an authentication framework based
--  on OpenID 2.0.
--
--  See OpenID Authentication 2.0 - Final
--  http://openid.net/specs/openid-authentication-2_0.html
package Security.Openid is

   Invalid_End_Point : exception;

   Service_Error     : exception;

   type Parameters is limited interface;

   function Get_Parameter (Params : in Parameters;
                           Name   : in String) return String is abstract;

   --  ------------------------------
   --  OpenID provider
   --  ------------------------------
   --  The End_Point represents the OpenID provider that will authenticate
   --  the user.
   type End_Point is private;

   function To_String (OP : End_Point) return String;

   --  ------------------------------
   --  Association
   --  ------------------------------
   --  The OpenID association contains the shared secret between the relying party
   --  and the OpenID provider.  The association can be cached and reused to authenticate
   --  different users using the same OpenID provider.  The association also has an
   --  expiration date.
   type Association is private;

   --  Dump the association as a string (for debugging purposes)
   function To_String (Assoc : Association) return String;

   type Auth_Result is (AUTHENTICATED, CANCEL, SETUP_NEEDED, UNKNOWN, INVALID_SIGNATURE);

   --  ------------------------------
   --  OpenID provider
   --  ------------------------------
   --
   type Authentication is private;

   --  Get the email address
   function Get_Email (Auth : in Authentication) return String;

   --  Get the user first name.
   function Get_First_Name (Auth : in Authentication) return String;

   --  Get the user last name.
   function Get_Last_Name (Auth : in Authentication) return String;

   --  Get the user full name.
   function Get_Full_Name (Auth : in Authentication) return String;

   --  Get the user identity.
   function Get_Identity (Auth : in Authentication) return String;

   --  Get the user claimed identity.
   function Get_Claimed_Id (Auth : in Authentication) return String;

   --  Get the user language.
   function Get_Language (Auth : in Authentication) return String;

   --  Get the user country.
   function Get_Country (Auth : in Authentication) return String;

   --  Get the result of the authentication.
   function Get_Status (Auth : in Authentication) return Auth_Result;

   --  ------------------------------
   --  OpenID Default principal
   --  ------------------------------
   type Principal is new Security.Permissions.Principal with private;
   type Principal_Access is access all Principal'Class;

   --  Returns true if the given role is stored in the user principal.
   function Has_Role (User : in Principal;
                      Role : in Permissions.Role_Type) return Boolean;

   --  Get the principal name.
   function Get_Name (From : in Principal) return String;

   --  Get the user email address.
   function Get_Email (From : in Principal) return String;

   --  Get the authentication data.
   function Get_Authentication (From : in Principal) return Authentication;

   --  Create a principal with the given authentication results.
   function Create_Principal (Auth : in Authentication) return Principal_Access;

   --  ------------------------------
   --  OpenID Manager
   --  ------------------------------
   --  The process is the following:
   --
   --  o Initialize is called to configure the OpenID realm and set the
   --    OpenID return callback CB.
   --  o Discover is called to retrieve from the OpenID provider the XRDS
   --    stream and identify the provider.  An End_Point is returned.
   --  o Associate is called to make the association with the End_Point.
   --    The Association record holds session, and authentication.
   --  o Get_Authentication_URL builds the provider OpenID authentication
   --    URL for the association.
   --  o The user should be redirected to the authentication URL.
   --  o The OpenID provider authenticate the user and redirects the user to the callback CB.
   --  o The association is decoded from the callback parameter.
   --  o Verify is called with the association to check the result and
   --    obtain the authentication results.
   type Manager is tagged limited private;

   --  Initialize the OpenID realm.
   procedure Initialize (Realm     : in out Manager;
                         Name      : in String;
                         Return_To : in String);

   --  Discover the OpenID provider that must be used to authenticate the user.
   --  The Name can be an URL or an alias that identifies the provider.
   --  A cached OpenID provider can be returned.
   --  (See OpenID Section 7.3 Discovery)
   procedure Discover (Realm  : in out Manager;
                       Name   : in String;
                       Result : out End_Point);

   --  Associate the application (relying party) with the OpenID provider.
   --  The association can be cached.
   --  (See OpenID Section 8 Establishing Associations)
   procedure Associate (Realm  : in out Manager;
                        OP     : in End_Point;
                        Result : out Association);

   function Get_Authentication_URL (Realm : in Manager;
                                    OP    : in End_Point;
                                    Assoc : in Association) return String;

   --  Verify the authentication result
   procedure Verify (Realm   : in out Manager;
                     Assoc   : in Association;
                     Request : in Parameters'Class;
                     Result  : out Authentication);

   --  Verify the authentication result
   procedure Verify_Discovered (Realm   : in out Manager;
                                Assoc   : in Association;
                                Request : in Parameters'Class;
                                Result  : out Authentication);

   --  Verify the signature part of the result
   procedure Verify_Signature (Realm   : in Manager;
                               Assoc   : in Association;
                               Request : in Parameters'Class;
                               Result  : in out Authentication);

   --  Read the XRDS document from the URI and initialize the OpenID provider end point.
   procedure Discover_XRDS (Realm  : in out Manager;
                            URI    : in String;
                            Result : out End_Point);

   --  Extract from the XRDS content the OpenID provider URI.
   --  The default implementation is very basic as it returns the first <URI>
   --  available in the stream without validating the XRDS document.
   --  Raises the Invalid_End_Point exception if the URI cannot be found.
   procedure Extract_XRDS (Realm   : in out Manager;
                           Content : in String;
                           Result  : out End_Point);

private

   use Ada.Strings.Unbounded;

   type Association is record
      Session_Type : Unbounded_String;
      Assoc_Type   : Unbounded_String;
      Assoc_Handle : Unbounded_String;
      Mac_Key      : Unbounded_String;
      Expired      : Ada.Calendar.Time;
   end record;

   type Authentication is record
      Status     : Auth_Result;
      Identity   : Unbounded_String;
      Claimed_Id : Unbounded_String;
      Email      : Unbounded_String;
      Full_Name  : Unbounded_String;
      First_Name : Unbounded_String;
      Last_Name  : Unbounded_String;
      Language   : Unbounded_String;
      Country    : Unbounded_String;
      Gender     : Unbounded_String;
      Timezone   : Unbounded_String;
      Nickname   : Unbounded_String;
   end record;

   type End_Point is record
      URL        : Unbounded_String;
      Alias      : Unbounded_String;
      Expired    : Ada.Calendar.Time;
   end record;

   type Manager is new Ada.Finalization.Limited_Controlled with record
      Realm     : Unbounded_String;
      Return_To : Unbounded_String;
   end record;

   type Principal is new Security.Permissions.Principal with record
      Auth : Authentication;
   end record;

end Security.Openid;

Include in generated dynamo documentation


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

package Security.Random is

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

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

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

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

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

private

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

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

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

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

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

end Security.Random;

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

package Security.Random is

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

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

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

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

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

private

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

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

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

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

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

end Security.Random;

Fix compilation with gnat-2016

Fix compilation with gnat-2016


-----------------------------------------------------------------------
--  util-streams -- Stream utilities
--  Copyright (C) 2010, 2016, 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 Ada.Streams;

--  = Streams =
--  The `Util.Streams` package provides several types and operations to allow the
--  composition of input and output streams.  Input streams can be chained together so that
--  they traverse the different stream objects when the data is read from them.  Similarly,
--  output streams can be chained and the data that is written will traverse the different
--  streams from the first one up to the last one in the chain.  During such traversal, the
--  stream object is able to bufferize the data or make transformations on the data.
--
--  The `Input_Stream` interface represents the stream to read data.  It only provides a
--  `Read` procedure.  The `Output_Stream` interface represents the stream to write data.
--  It provides a `Write`, `Flush` and `Close` operation.
--
--  To use the packages described here, use the following GNAT project:
--
--    with "utilada_sys";
--
--  @include util-streams-buffered.ads
--  @include util-streams-texts.ads
--  @include util-streams-files.ads
--  @include util-streams-pipes.ads
--  @include util-streams-sockets.ads
--  @include util-streams-raw.ads
--  @include util-streams-base16.ads
--  @include util-streams-base64.ads
--  @include util-streams-aes.ads
package Util.Streams is

   pragma Preelaborate;

   --  -----------------------
   --  Output stream
   --  -----------------------
   --  The Output_Stream is an interface that accepts output bytes
   --  and sends them to a sink.
   type Output_Stream is limited interface;
   type Output_Stream_Access is access all Output_Stream'Class;

   --  Write the buffer array to the output stream.
   procedure Write (Stream : in out Output_Stream;
                    Buffer : in Ada.Streams.Stream_Element_Array) is abstract;

   --  Flush the buffer (if any) to the sink.
   procedure Flush (Stream : in out Output_Stream) is null;

   --  Close the sink.
   procedure Close (Stream : in out Output_Stream) is null;

   --  -----------------------
   --  Input stream
   --  -----------------------
   --  The Input_Stream is the interface that reads input bytes
   --  from a source and returns them.
   type Input_Stream is limited interface;
   type Input_Stream_Access is access all Input_Stream'Class;

   --  Read into the buffer as many bytes as possible and return in
   --  last the position of the last byte read.
   procedure Read (Stream : in out Input_Stream;
                   Into   : out Ada.Streams.Stream_Element_Array;
                   Last   : out Ada.Streams.Stream_Element_Offset) is abstract;

   --  Copy the input stream to the output stream until the end of the input stream
   --  is reached.
   procedure Copy (From : in out Input_Stream'Class;
                   Into : in out Output_Stream'Class);

   --  Copy the stream array to the string.
   --  The string must be large enough to hold the stream array
   --  or a Constraint_Error exception is raised.
   procedure Copy (From : in Ada.Streams.Stream_Element_Array;
                   Into : in out String);

   --  Copy the string to the stream array.
   --  The stream array must be large enough to hold the string
   --  or a Constraint_Error exception is raised.
   procedure Copy (From : in String;
                   Into : in out Ada.Streams.Stream_Element_Array);

   --  Notes:
   --  ------
   --  The Ada.Streams.Root_Stream_Type implements the Output_Stream
   --  and Input_Stream.  It is however not easy to use for composing various
   --  stream behaviors.
end Util.Streams;

-----------------------------------------------------------------------
--  util-streams -- Stream utilities
--  Copyright (C) 2010, 2016, 2018, 2019, 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.
-----------------------------------------------------------------------

with Ada.Streams;

--  = Streams =
--  The `Util.Streams` package provides several types and operations to allow the
--  composition of input and output streams.  Input streams can be chained together so that
--  they traverse the different stream objects when the data is read from them.  Similarly,
--  output streams can be chained and the data that is written will traverse the different
--  streams from the first one up to the last one in the chain.  During such traversal, the
--  stream object is able to bufferize the data or make transformations on the data.
--
--  The `Input_Stream` interface represents the stream to read data.  It only provides a
--  `Read` procedure.  The `Output_Stream` interface represents the stream to write data.
--  It provides a `Write`, `Flush` and `Close` operation.
--
--  To use the packages described here, use the following GNAT project:
--
--    with "utilada_sys";
--
--  @include util-streams-buffered.ads
--  @include util-streams-texts.ads
--  @include util-streams-files.ads
--  @include util-streams-pipes.ads
--  @include util-streams-sockets.ads
--  @include util-streams-raw.ads
--  @include util-streams-base16.ads
--  @include util-streams-base64.ads
--  @include util-streams-aes.ads
package Util.Streams is

   pragma Preelaborate;

   --  -----------------------
   --  Output stream
   --  -----------------------
   --  The Output_Stream is an interface that accepts output bytes
   --  and sends them to a sink.
   type Output_Stream is limited interface;
   type Output_Stream_Access is access all Output_Stream'Class;

   --  Write the buffer array to the output stream.
   procedure Write (Stream : in out Output_Stream;
                    Buffer : in Ada.Streams.Stream_Element_Array) is abstract;

   --  Flush the buffer (if any) to the sink.
   procedure Flush (Stream : in out Output_Stream) is null;

   --  Close the sink.
   procedure Close (Stream : in out Output_Stream) is null;

   --  -----------------------
   --  Input stream
   --  -----------------------
   --  The Input_Stream is the interface that reads input bytes
   --  from a source and returns them.
   type Input_Stream is limited interface;
   type Input_Stream_Access is access all Input_Stream'Class;

   --  Read into the buffer as many bytes as possible and return in
   --  last the position of the last byte read.
   procedure Read (Stream : in out Input_Stream;
                   Into   : out Ada.Streams.Stream_Element_Array;
                   Last   : out Ada.Streams.Stream_Element_Offset) is abstract;

   --  Copy the input stream to the output stream until the end of the input stream
   --  is reached.
   procedure Copy (From : in out Input_Stream'Class;
                   Into : in out Output_Stream'Class);

   --  Copy the stream array to the string.
   --  The string must be large enough to hold the stream array
   --  or a Constraint_Error exception is raised.
   procedure Copy (From : in Ada.Streams.Stream_Element_Array;
                   Into : in out String);

   --  Copy the string to the stream array.
   --  The stream array must be large enough to hold the string
   --  or a Constraint_Error exception is raised.
   procedure Copy (From : in String;
                   Into : in out Ada.Streams.Stream_Element_Array);

   --  Write a raw string on the stream.
   procedure Write (Stream : in out Output_Stream'Class;
                    Item   : in Character);

   procedure Write (Stream : in out Output_Stream'Class;
                    Item   : in String);

   --  Write a wide character on the stream using a UTF-8 sequence.
   procedure Write_Wide (Stream : in out Output_Stream'Class;
                         Item   : in Wide_Wide_Character);

   procedure Write_Wide (Stream : in out Output_Stream'Class;
                         Item   : in Wide_Wide_String);

   --  Notes:
   --  ------
   --  The Ada.Streams.Root_Stream_Type implements the Output_Stream
   --  and Input_Stream.  It is however not easy to use for composing various
   --  stream behaviors.
end Util.Streams;

Add Write and Write_Wide procedures to help in writing character and strings


-----------------------------------------------------------------------
--  atlas -- atlas applications
-----------------------------------------------------------------------
--  Copyright (C) 2012, 2013, 2014, 2015, 2016, 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 ASF.Servlets.Faces;
with Servlet.Core.Files;
with ASF.Servlets.Ajax;
with ASF.Filters.Dump;
with ASF.Filters.Cache_Control;
with Servlet.Core.Measures;

with ASF.Security.Servlets;
with ASF.Converters.Sizes;
with ASF.Applications;

with AWA.Users.Servlets;
with AWA.Users.Modules;
with AWA.Mail.Modules;
with AWA.Blogs.Modules;
with AWA.Applications;
with AWA.Workspaces.Modules;
with AWA.Storages.Modules;
with AWA.Images.Modules;
with AWA.Questions.Modules;
with AWA.Wikis.Modules;
with AWA.Wikis.Previews;
with AWA.Jobs.Modules;
with AWA.Counters.Modules;
with AWA.Votes.Modules;
with AWA.Tags.Modules;
with AWA.Comments.Modules;
with AWA.Services.Filters;
with AWA.Converters.Dates;

with Atlas.Microblog.Modules;
with Atlas.Reviews.Modules;
package Atlas.Applications is

   CONFIG_PATH  : constant String := "/atlas";
   CONTEXT_PATH : constant String := "/atlas";

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

   --  Given an Email address, return the Gravatar link to the user image.
   --  (See http://en.gravatar.com/site/implement/hash/ and
   --  http://en.gravatar.com/site/implement/images/)
   function Get_Gravatar_Link (Email : in String) return String;

   --  EL function to convert an Email address to a Gravatar image.
   function To_Gravatar_Link (Email : in Util.Beans.Objects.Object)
                              return Util.Beans.Objects.Object;

   type Application is new AWA.Applications.Application with private;
   type Application_Access is access all Application'Class;

   --  Initialize the application.
   procedure Initialize (App    : in Application_Access;
                         Config : in ASF.Applications.Config);

   --  Initialize the ASF components provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the component factories used by the application.
   overriding
   procedure Initialize_Components (App : in out Application);

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

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

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

private

   type Application is new AWA.Applications.Application with record
      Self              : Application_Access;
      --  Application servlets and filters (add new servlet and filter instances here).
      Faces             : aliased ASF.Servlets.Faces.Faces_Servlet;
      Ajax              : aliased ASF.Servlets.Ajax.Ajax_Servlet;
      Files             : aliased Servlet.Core.Files.File_Servlet;
      Dump              : aliased ASF.Filters.Dump.Dump_Filter;
      Service_Filter    : aliased AWA.Services.Filters.Service_Filter;
      Measures          : aliased Servlet.Core.Measures.Measure_Servlet;
      No_Cache          : aliased ASF.Filters.Cache_Control.Cache_Control_Filter;

      --  Authentication servlet and filter.
      Auth              : aliased ASF.Security.Servlets.Request_Auth_Servlet;
      Verify_Auth       : aliased AWA.Users.Servlets.Verify_Auth_Servlet;

      --  Converters shared by web requests.
      Rel_Date_Converter : aliased AWA.Converters.Dates.Relative_Date_Converter;
      Size_Converter     : aliased ASF.Converters.Sizes.Size_Converter;

      --  The application modules.
      User_Module       : aliased AWA.Users.Modules.User_Module;
      Workspace_Module  : aliased AWA.Workspaces.Modules.Workspace_Module;
      Blog_Module       : aliased AWA.Blogs.Modules.Blog_Module;
      Mail_Module       : aliased AWA.Mail.Modules.Mail_Module;
      Job_Module        : aliased AWA.Jobs.Modules.Job_Module;
      Storage_Module    : aliased AWA.Storages.Modules.Storage_Module;
      Image_Module      : aliased AWA.Images.Modules.Image_Module;
      Vote_Module       : aliased AWA.Votes.Modules.Vote_Module;
      Question_Module   : aliased AWA.Questions.Modules.Question_Module;
      Tag_Module        : aliased AWA.Tags.Modules.Tag_Module;
      Comment_Module    : aliased AWA.Comments.Modules.Comment_Module;
      Wiki_Module       : aliased AWA.Wikis.Modules.Wiki_Module;
      Preview_Module    : aliased AWA.Wikis.Previews.Preview_Module;
      Counter_Module    : aliased AWA.Counters.Modules.Counter_Module;

      Microblog_Module  : aliased Atlas.Microblog.Modules.Microblog_Module;
      Review_Module     : aliased Atlas.Reviews.Modules.Review_Module;
   end record;

end Atlas.Applications;

-----------------------------------------------------------------------
--  atlas -- atlas applications
--  Copyright (C) 2012, 2013, 2014, 2015, 2016, 2018, 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.
-----------------------------------------------------------------------
with Util.Beans.Objects;

with ASF.Servlets.Faces;
with Servlet.Core.Files;
with ASF.Servlets.Ajax;
with ASF.Filters.Dump;
with ASF.Filters.Cache_Control;
with Servlet.Core.Measures;

with ASF.Security.Servlets;
with ASF.Converters.Sizes;
with ASF.Applications;

with AWA.Users.Servlets;
with AWA.Users.Modules;
with AWA.Mail.Modules;
with AWA.Blogs.Modules;
with AWA.Applications;
with AWA.Workspaces.Modules;
with AWA.Storages.Modules;
with AWA.Images.Modules;
with AWA.Questions.Modules;
with AWA.Wikis.Modules;
with AWA.Wikis.Previews;
with AWA.Jobs.Modules;
with AWA.Counters.Modules;
with AWA.Votes.Modules;
with AWA.Tags.Modules;
with AWA.Comments.Modules;
with AWA.Services.Filters;
with AWA.Converters.Dates;

with Atlas.Microblog.Modules;
with Atlas.Reviews.Modules;
package Atlas.Applications is

   CONFIG_PATH  : constant String := "/atlas";
   CONTEXT_PATH : constant String := "/atlas";

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

   --  Given an Email address, return the Gravatar link to the user image.
   --  (See http://en.gravatar.com/site/implement/hash/ and
   --  http://en.gravatar.com/site/implement/images/)
   function Get_Gravatar_Link (Email : in String) return String;

   --  EL function to convert an Email address to a Gravatar image.
   function To_Gravatar_Link (Email : in Util.Beans.Objects.Object)
                              return Util.Beans.Objects.Object;

   type Application is new AWA.Applications.Application with private;
   type Application_Access is access all Application'Class;

   --  Initialize the ASF components provided by the application.
   --  This procedure is called by Initialize.
   --  It should register the component factories used by the application.
   overriding
   procedure Initialize_Components (App : in out Application);

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

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

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

private

   type Application is new AWA.Applications.Application with record
      Self              : Application_Access;
      --  Application servlets and filters (add new servlet and filter instances here).
      Faces             : aliased ASF.Servlets.Faces.Faces_Servlet;
      Ajax              : aliased ASF.Servlets.Ajax.Ajax_Servlet;
      Files             : aliased Servlet.Core.Files.File_Servlet;
      Dump              : aliased ASF.Filters.Dump.Dump_Filter;
      Service_Filter    : aliased AWA.Services.Filters.Service_Filter;
      Measures          : aliased Servlet.Core.Measures.Measure_Servlet;
      No_Cache          : aliased ASF.Filters.Cache_Control.Cache_Control_Filter;

      --  Authentication servlet and filter.
      Auth              : aliased ASF.Security.Servlets.Request_Auth_Servlet;
      Verify_Auth       : aliased AWA.Users.Servlets.Verify_Auth_Servlet;

      --  Converters shared by web requests.
      Rel_Date_Converter : aliased AWA.Converters.Dates.Relative_Date_Converter;
      Size_Converter     : aliased ASF.Converters.Sizes.Size_Converter;

      --  The application modules.
      User_Module       : aliased AWA.Users.Modules.User_Module;
      Workspace_Module  : aliased AWA.Workspaces.Modules.Workspace_Module;
      Blog_Module       : aliased AWA.Blogs.Modules.Blog_Module;
      Mail_Module       : aliased AWA.Mail.Modules.Mail_Module;
      Job_Module        : aliased AWA.Jobs.Modules.Job_Module;
      Storage_Module    : aliased AWA.Storages.Modules.Storage_Module;
      Image_Module      : aliased AWA.Images.Modules.Image_Module;
      Vote_Module       : aliased AWA.Votes.Modules.Vote_Module;
      Question_Module   : aliased AWA.Questions.Modules.Question_Module;
      Tag_Module        : aliased AWA.Tags.Modules.Tag_Module;
      Comment_Module    : aliased AWA.Comments.Modules.Comment_Module;
      Wiki_Module       : aliased AWA.Wikis.Modules.Wiki_Module;
      Preview_Module    : aliased AWA.Wikis.Previews.Preview_Module;
      Counter_Module    : aliased AWA.Counters.Modules.Counter_Module;

      Microblog_Module  : aliased Atlas.Microblog.Modules.Microblog_Module;
      Review_Module     : aliased Atlas.Reviews.Modules.Review_Module;
   end record;

end Atlas.Applications;

Remove the Initialize procedure

Remove the Initialize procedure


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

package body Util.Dates.ISO8601 is

   --  ------------------------------
   --  Parses an ISO8601 date and return it as a calendar time.
   --  Raises Constraint_Error if the date format is not recognized.
   --  ------------------------------
   function Value (Date : in String) return Ada.Calendar.Time is
      use Ada.Calendar;
      use Ada.Calendar.Formatting;

      Result : Date_Record;
      Pos    : Natural;
   begin
      if Date'Length < 4 then
         raise Constraint_Error with "Invalid date";
      end if;
      Result.Hour       := 0;
      Result.Minute     := 0;
      Result.Second     := 0;
      Result.Sub_Second := 0.0;
      Result.Time_Zone  := 0;
      Result.Year := Year_Number'Value (Date (Date'First .. Date'First + 3));
      if Date'Length = 4 then
         --  ISO8601 date: YYYY
         Result.Month := 1;
         Result.Month_Day := 1;

      elsif Date'Length = 7 and Date (Date'First + 4) = '-' then
         --  ISO8601 date: YYYY-MM
         Result.Month := Month_Number'Value (Date (Date'First + 4 .. Date'Last));
         Result.Month_Day := 1;

      elsif Date'Length = 8 then
         --  ISO8601 date: YYYYMMDD
         Result.Month := Month_Number'Value (Date (Date'First + 4 .. Date'First + 5));
         Result.Month_Day := Day_Number'Value (Date (Date'First + 6 .. Date'First + 7));

      elsif Date'Length >= 9 and then Date (Date'First + 4) = '-'
        and then Date (Date'First + 7) = '-'
      then
         --  ISO8601 date: YYYY-MM-DD
         Result.Month := Month_Number'Value (Date (Date'First + 5 .. Date'First + 6));
         Result.Month_Day := Day_Number'Value (Date (Date'First + 8 .. Date'First + 9));

         --  ISO8601 date: YYYY-MM-DDTHH
         if Date'Length > 12 then
            if Date (Date'First + 10) /= 'T' then
               raise Constraint_Error with "invalid date";
            end if;
            Result.Hour := Hour_Number'Value (Date (Date'First + 11 .. Date'First + 12));
            Pos := Date'First + 13;
         end if;
         if Date'Length > 15 then
            if Date (Date'First + 13) /= ':' then
               raise Constraint_Error with "invalid date";
            end if;
            Result.Minute := Minute_Number'Value (Date (Date'First + 14 .. Date'First + 15));
            Pos := Date'First + 16;
         end if;
         if Date'Length > 18 then
            if Date (Date'First + 16) /= ':' then
               raise Constraint_Error with "invalid date";
            end if;
            Result.Second := Second_Number'Value (Date (Date'First + 17 .. Date'First + 18));
            Pos := Date'First + 19;
         end if;

         --  ISO8601 timezone: +hh:mm or -hh:mm
--           if Date'Length > Pos + 4 then
--              if Date (Pos) /= '+' and Date (Pos) /= '-' and Date (Pos + 2) /= ':' then
--                 raise Constraint_Error with "invalid date";
--              end if;
--           end if;
      else
         raise Constraint_Error with "invalid date";
      end if;
      return Ada.Calendar.Formatting.Time_Of (Year        => Result.Year,
                                              Month       => Result.Month,
                                              Day         => Result.Month_Day,
                                              Hour        => Result.Hour,
                                              Minute      => Result.Minute,
                                              Second      => Result.Second,
                                              Sub_Second  => Result.Sub_Second,
                                              Time_Zone   => Result.Time_Zone);
   end Value;

   --  ------------------------------
   --  Return the ISO8601 date.
   --  ------------------------------
   function Image (Date : in Ada.Calendar.Time) return String is
      D : Date_Record;
   begin
      Split (D, Date);
      return Image (D);
   end Image;

   function Image (Date : in Date_Record) return String is
      To_Char : constant array (0 .. 9) of Character := "0123456789";
      Result  : String (1 .. 10) := "0000-00-00";
   begin
      Result (1) := To_Char (Date.Year / 1000);
      Result (2) := To_Char (Date.Year / 100 mod 10);
      Result (3) := To_Char (Date.Year / 10 mod 10);
      Result (4) := To_Char (Date.Year mod 10);
      Result (6) := To_Char (Date.Month / 10);
      Result (7) := To_Char (Date.Month mod 10);
      Result (9) := To_Char (Date.Month_Day / 10);
      Result (10) := To_Char (Date.Month_Day mod 10);
      return Result;
   end Image;

   function Image (Date      : in Ada.Calendar.Time;
                   Precision : in Precision_Type) return String is
      D : Date_Record;
   begin
      Split (D, Date);
      return Image (D, Precision);
   end Image;

   function Image (Date      : in Date_Record;
                   Precision : in Precision_Type) return String is
      use type Ada.Calendar.Time_Zones.Time_Offset;

      To_Char : constant array (0 .. 9) of Character := "0123456789";
      Result  : String (1 .. 29) := "0000-00-00T00:00:00.000-00:00";
     N,  Tz      : Natural;
   begin
      Result (1) := To_Char (Date.Year / 1000);
      Result (2) := To_Char (Date.Year / 100 mod 10);
      Result (3) := To_Char (Date.Year / 10 mod 10);
      Result (4) := To_Char (Date.Year mod 10);
      if Precision = YEAR then
         return Result (1 .. 4);
      end if;
      Result (6) := To_Char (Date.Month / 10);
      Result (7) := To_Char (Date.Month mod 10);
      if Precision = MONTH then
         return Result (1 .. 7);
      end if;
      Result (9) := To_Char (Date.Month_Day / 10);
      Result (10) := To_Char (Date.Month_Day mod 10);
      if Precision = DAY then
         return Result (1 .. 10);
      end if;
      Result (12) := To_Char (Date.Hour / 10);
      Result (13) := To_Char (Date.Hour mod 10);
      if Precision = HOUR then
         return Result (1 .. 13);
      end if;
      Result (15) := To_Char (Date.Minute / 10);
      Result (16) := To_Char (Date.Minute mod 10);
      if Precision = MINUTE then
         return Result (1 .. 16);
      end if;
      Result (18) := To_Char (Date.Second / 10);
      Result (19) := To_Char (Date.Second mod 10);
      if Precision = SECOND then
         return Result (1 .. 19);
      end if;
      N := Natural (Date.Sub_Second * 1000.0);
      Result (21) := To_Char (N / 100);
      Result (22) := To_Char ((N mod 100) / 10);
      Result (23) := To_Char (N mod 10);
      if Date.Time_Zone < 0 then
         Tz := Natural (-Date.Time_Zone);
      else
         Result (24) := '+';
         Tz := Natural (Date.Time_Zone);
      end if;
      Result (25) := To_Char (Tz / 600);
      Result (26) := To_Char ((Tz / 60) mod 10);
      Tz := Tz mod 60;
      Result (28) := To_Char (Tz / 10);
      Result (29) := To_Char (Tz mod 10);
      return Result;
   end Image;

end Util.Dates.ISO8601;

-----------------------------------------------------------------------
--  util-dates-iso8601 -- ISO8601 dates
--  Copyright (C) 2011, 2013, 2015, 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.
-----------------------------------------------------------------------

package body Util.Dates.ISO8601 is

   --  ------------------------------
   --  Parses an ISO8601 date and return it as a calendar time.
   --  Raises Constraint_Error if the date format is not recognized.
   --  ------------------------------
   function Value (Date : in String) return Ada.Calendar.Time is
      use Ada.Calendar;
      use Ada.Calendar.Formatting;

      Result : Date_Record;
      Pos    : Natural;
   begin
      if Date'Length < 4 then
         raise Constraint_Error with "Invalid date";
      end if;
      Result.Hour       := 0;
      Result.Minute     := 0;
      Result.Second     := 0;
      Result.Sub_Second := 0.0;
      Result.Time_Zone  := 0;
      Result.Year := Year_Number'Value (Date (Date'First .. Date'First + 3));
      if Date'Length = 4 then
         --  ISO8601 date: YYYY
         Result.Month := 1;
         Result.Month_Day := 1;

      elsif Date'Length = 7 and Date (Date'First + 4) = '-' then
         --  ISO8601 date: YYYY-MM
         Result.Month := Month_Number'Value (Date (Date'First + 4 .. Date'Last));
         Result.Month_Day := 1;

      elsif Date'Length = 8 then
         --  ISO8601 date: YYYYMMDD
         Result.Month := Month_Number'Value (Date (Date'First + 4 .. Date'First + 5));
         Result.Month_Day := Day_Number'Value (Date (Date'First + 6 .. Date'First + 7));

      elsif Date'Length >= 9 and then Date (Date'First + 4) = '-'
        and then Date (Date'First + 7) = '-'
      then
         --  ISO8601 date: YYYY-MM-DD
         Result.Month := Month_Number'Value (Date (Date'First + 5 .. Date'First + 6));
         Result.Month_Day := Day_Number'Value (Date (Date'First + 8 .. Date'First + 9));

         --  ISO8601 date: YYYY-MM-DDTHH
         if Date'Length > 12 then
            if Date (Date'First + 10) /= 'T' then
               raise Constraint_Error with "invalid date";
            end if;
            Result.Hour := Hour_Number'Value (Date (Date'First + 11 .. Date'First + 12));
            Pos := Date'First + 13;
         end if;
         if Date'Length > 15 then
            if Date (Date'First + 13) /= ':' then
               raise Constraint_Error with "invalid date";
            end if;
            Result.Minute := Minute_Number'Value (Date (Date'First + 14 .. Date'First + 15));
            Pos := Date'First + 16;
         end if;
         if Date'Length > 18 then
            if Date (Date'First + 16) /= ':' then
               raise Constraint_Error with "invalid date";
            end if;
            Result.Second := Second_Number'Value (Date (Date'First + 17 .. Date'First + 18));
            Pos := Date'First + 19;
         end if;

         --  ISO8601 timezone: +hh:mm or -hh:mm
--           if Date'Length > Pos + 4 then
--              if Date (Pos) /= '+' and Date (Pos) /= '-' and Date (Pos + 2) /= ':' then
--                 raise Constraint_Error with "invalid date";
--              end if;
--           end if;
      else
         raise Constraint_Error with "invalid date";
      end if;
      return Ada.Calendar.Formatting.Time_Of (Year        => Result.Year,
                                              Month       => Result.Month,
                                              Day         => Result.Month_Day,
                                              Hour        => Result.Hour,
                                              Minute      => Result.Minute,
                                              Second      => Result.Second,
                                              Sub_Second  => Result.Sub_Second,
                                              Time_Zone   => Result.Time_Zone);
   end Value;

   --  ------------------------------
   --  Return the ISO8601 date.
   --  ------------------------------
   function Image (Date : in Ada.Calendar.Time) return String is
      D : Date_Record;
   begin
      Split (D, Date);
      return Image (D);
   end Image;

   function Image (Date : in Date_Record) return String is
      To_Char : constant array (0 .. 9) of Character := "0123456789";
      Result  : String (1 .. 10) := "0000-00-00";
   begin
      Result (1) := To_Char (Date.Year / 1000);
      Result (2) := To_Char (Date.Year / 100 mod 10);
      Result (3) := To_Char (Date.Year / 10 mod 10);
      Result (4) := To_Char (Date.Year mod 10);
      Result (6) := To_Char (Date.Month / 10);
      Result (7) := To_Char (Date.Month mod 10);
      Result (9) := To_Char (Date.Month_Day / 10);
      Result (10) := To_Char (Date.Month_Day mod 10);
      return Result;
   end Image;

   function Image (Date      : in Ada.Calendar.Time;
                   Precision : in Precision_Type) return String is
      D : Date_Record;
   begin
      Split (D, Date);
      return Image (D, Precision);
   end Image;

   function Image (Date      : in Date_Record;
                   Precision : in Precision_Type) return String is
      use type Ada.Calendar.Time_Zones.Time_Offset;

      To_Char : constant array (0 .. 9) of Character := "0123456789";
      Result  : String (1 .. 29) := "0000-00-00T00:00:00.000-00:00";
      N,  Tz  : Natural;
   begin
      Result (1) := To_Char (Date.Year / 1000);
      Result (2) := To_Char (Date.Year / 100 mod 10);
      Result (3) := To_Char (Date.Year / 10 mod 10);
      Result (4) := To_Char (Date.Year mod 10);
      if Precision = YEAR then
         return Result (1 .. 4);
      end if;
      Result (6) := To_Char (Date.Month / 10);
      Result (7) := To_Char (Date.Month mod 10);
      if Precision = MONTH then
         return Result (1 .. 7);
      end if;
      Result (9) := To_Char (Date.Month_Day / 10);
      Result (10) := To_Char (Date.Month_Day mod 10);
      if Precision = DAY then
         return Result (1 .. 10);
      end if;
      Result (12) := To_Char (Date.Hour / 10);
      Result (13) := To_Char (Date.Hour mod 10);
      if Precision = HOUR then
         return Result (1 .. 13);
      end if;
      Result (15) := To_Char (Date.Minute / 10);
      Result (16) := To_Char (Date.Minute mod 10);
      if Precision = MINUTE then
         return Result (1 .. 16);
      end if;
      Result (18) := To_Char (Date.Second / 10);
      Result (19) := To_Char (Date.Second mod 10);
      if Precision = SECOND then
         return Result (1 .. 19);
      end if;
      N := Natural (Date.Sub_Second * 1000.0);
      Result (21) := To_Char (N / 100);
      Result (22) := To_Char ((N mod 100) / 10);
      Result (23) := To_Char (N mod 10);
      if Date.Time_Zone < 0 then
         Tz := Natural (-Date.Time_Zone);
      else
         Result (24) := '+';
         Tz := Natural (Date.Time_Zone);
      end if;
      Result (25) := To_Char (Tz / 600);
      Result (26) := To_Char ((Tz / 60) mod 10);
      Tz := Tz mod 60;
      Result (28) := To_Char (Tz / 10);
      Result (29) := To_Char (Tz mod 10);
      return Result;
   end Image;

end Util.Dates.ISO8601;

Fix indentation

Fix indentation


-----------------------------------------------------------------------
--  awa-wikis-writers-text -- Wiki HTML writer
--  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.
-----------------------------------------------------------------------

package body AWA.Wikis.Writers.Text is

   use AWA.Wikis.Documents;

   --  ------------------------------
   --  Set the output writer.
   --  ------------------------------
   procedure Set_Writer (Document : in out Text_Writer;
                         Writer   : in ASF.Contexts.Writer.Response_Writer_Access) is
   begin
      Document.Writer := Writer;
   end Set_Writer;

   --  ------------------------------
   --  Add a section header in the document.
   --  ------------------------------
   overriding
   procedure Add_Header (Document : in out Text_Writer;
                         Header   : in Unbounded_Wide_Wide_String;
                         Level    : in Positive) is
      pragma Unreferenced (Level);
   begin
      Document.Close_Paragraph;
      if not Document.Empty_Line then
         Document.Add_Line_Break;
      end if;
      Document.Writer.Write (Header);
      Document.Add_Line_Break;
   end Add_Header;

   --  ------------------------------
   --  Add a line break (
).
   --  ------------------------------
   overriding
   procedure Add_Line_Break (Document : in out Text_Writer) is
   begin
      Document.Writer.Write (ASCII.LF);
      Document.Empty_Line := True;
   end Add_Line_Break;

   --  ------------------------------
   --  Add a paragraph (
).  Close the previous paragraph if any.
   --  The paragraph must be closed at the next paragraph or next header.
   --  ------------------------------
   overriding
   procedure Add_Paragraph (Document : in out Text_Writer) is
   begin
      Document.Close_Paragraph;
      Document.Need_Paragraph := True;
      Document.Add_Line_Break;
   end Add_Paragraph;

   --  ------------------------------
   --  Add a list item (
).  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.
   --  ------------------------------
   overriding
   procedure Add_List_Item (Document : in out Text_Writer;
                            Level    : in Positive;
                            Ordered  : in Boolean) is
      pragma Unreferenced (Level, Ordered);
   begin
      if not Document.Empty_Line then
         Document.Add_Line_Break;
      end if;
      Document.Need_Paragraph := False;
      Document.Open_Paragraph;
   end Add_List_Item;

   procedure Close_Paragraph (Document : in out Text_Writer) is
   begin
      if Document.Has_Paragraph then
         Document.Add_Line_Break;
      end if;
      Document.Has_Paragraph := False;
   end Close_Paragraph;

   procedure Open_Paragraph (Document : in out Text_Writer) is
   begin
      if Document.Need_Paragraph then
         Document.Has_Paragraph  := True;
         Document.Need_Paragraph := False;
      end if;
   end Open_Paragraph;

   --  ------------------------------
   --  Add an horizontal rule (
).
   --  ------------------------------
   overriding
   procedure Add_Horizontal_Rule (Document : in out Text_Writer) is
   begin
      Document.Close_Paragraph;
   end Add_Horizontal_Rule;

   --  ------------------------------
   --  Add a link.
   --  ------------------------------
   overriding
   procedure Add_Link (Document : in out Text_Writer;
                       Name     : in Unbounded_Wide_Wide_String;
                       Link     : in Unbounded_Wide_Wide_String;
                       Language : in Unbounded_Wide_Wide_String;
                       Title    : in Unbounded_Wide_Wide_String) is
      pragma Unreferenced (Language);
   begin
      Document.Open_Paragraph;
      if Length (Title) > 0 then
         Document.Writer.Write (Title);
      end if;
      Document.Writer.Write (Link);
      Document.Writer.Write (Name);
      Document.Empty_Line := False;
   end Add_Link;

   --  ------------------------------
   --  Add an image.
   --  ------------------------------
   overriding
   procedure Add_Image (Document    : in out Text_Writer;
                        Link        : in Unbounded_Wide_Wide_String;
                        Alt         : in Unbounded_Wide_Wide_String;
                        Position    : in Unbounded_Wide_Wide_String;
                        Description : in Unbounded_Wide_Wide_String) is
      pragma Unreferenced (Position);
   begin
      Document.Open_Paragraph;
      if Length (Alt) > 0 then
         Document.Writer.Write (Alt);
      end if;
      if Length (Description) > 0 then
         Document.Writer.Write (Description);
      end if;
      Document.Writer.Write (Link);
      Document.Empty_Line := False;
   end Add_Image;

   --  ------------------------------
   --  Add a quote.
   --  ------------------------------
   overriding
   procedure Add_Quote (Document : in out Text_Writer;
                        Quote    : in Unbounded_Wide_Wide_String;
                        Link     : in Unbounded_Wide_Wide_String;
                        Language : in Unbounded_Wide_Wide_String) is
      pragma Unreferenced (Link, Language);
   begin
      Document.Open_Paragraph;
      Document.Writer.Write (Quote);
      Document.Empty_Line := False;
   end Add_Quote;

   --  ------------------------------
   --  Add a text block with the given format.
   --  ------------------------------
   overriding
   procedure Add_Text (Document : in out Text_Writer;
                       Text     : in Unbounded_Wide_Wide_String;
                       Format   : in AWA.Wikis.Documents.Format_Map) is
      pragma Unreferenced (Format);
   begin
      Document.Writer.Write (Text);
      Document.Empty_Line := False;
   end Add_Text;

   --  ------------------------------
   --  Add a text block that is pre-formatted.
   --  ------------------------------
   procedure Add_Preformatted (Document : in out Text_Writer;
                               Text     : in Unbounded_Wide_Wide_String;
                               Format   : in Unbounded_Wide_Wide_String) is
      pragma Unreferenced (Format);
   begin
      Document.Close_Paragraph;
      Document.Writer.Write (Text);
      Document.Empty_Line := False;
   end Add_Preformatted;

   --  ------------------------------
   --  Finish the document after complete wiki text has been parsed.
   --  ------------------------------
   overriding
   procedure Finish (Document : in out Text_Writer) is
   begin
      Document.Close_Paragraph;
   end Finish;

end AWA.Wikis.Writers.Text;

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

package body AWA.Wikis.Writers.Text is

   use AWA.Wikis.Documents;

   --  ------------------------------
   --  Set the output writer.
   --  ------------------------------
   procedure Set_Writer (Document : in out Text_Writer;
                         Writer   : in ASF.Contexts.Writer.Response_Writer_Access) is
   begin
      Document.Writer := Writer;
   end Set_Writer;

   --  ------------------------------
   --  Add a section header in the document.
   --  ------------------------------
   overriding
   procedure Add_Header (Document : in out Text_Writer;
                         Header   : in Unbounded_Wide_Wide_String;
                         Level    : in Positive) is
      pragma Unreferenced (Level);
   begin
      Document.Close_Paragraph;
      if not Document.Empty_Line then
         Document.Add_Line_Break;
      end if;
      Document.Writer.Write (Header);
      Document.Add_Line_Break;
   end Add_Header;

   --  ------------------------------
   --  Add a line break (
).
   --  ------------------------------
   overriding
   procedure Add_Line_Break (Document : in out Text_Writer) is
   begin
      Document.Writer.Write (ASCII.LF);
      Document.Empty_Line := True;
   end Add_Line_Break;

   --  ------------------------------
   --  Add a paragraph (
).  Close the previous paragraph if any.
   --  The paragraph must be closed at the next paragraph or next header.
   --  ------------------------------
   overriding
   procedure Add_Paragraph (Document : in out Text_Writer) is
   begin
      Document.Close_Paragraph;
      Document.Need_Paragraph := True;
      Document.Add_Line_Break;
   end Add_Paragraph;

   --  ------------------------------
   --  Add a blockquote (
).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   --  ------------------------------
   overriding
   procedure Add_Blockquote (Document : in out Text_Writer;
                             Level    : in Natural) is
   begin
      Document.Close_Paragraph;
   end Add_Blockquote;

   --  ------------------------------
   --  Add a list item (
).  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.
   --  ------------------------------
   overriding
   procedure Add_List_Item (Document : in out Text_Writer;
                            Level    : in Positive;
                            Ordered  : in Boolean) is
      pragma Unreferenced (Level, Ordered);
   begin
      if not Document.Empty_Line then
         Document.Add_Line_Break;
      end if;
      Document.Need_Paragraph := False;
      Document.Open_Paragraph;
   end Add_List_Item;

   procedure Close_Paragraph (Document : in out Text_Writer) is
   begin
      if Document.Has_Paragraph then
         Document.Add_Line_Break;
      end if;
      Document.Has_Paragraph := False;
   end Close_Paragraph;

   procedure Open_Paragraph (Document : in out Text_Writer) is
   begin
      if Document.Need_Paragraph then
         Document.Has_Paragraph  := True;
         Document.Need_Paragraph := False;
      end if;
   end Open_Paragraph;

   --  ------------------------------
   --  Add an horizontal rule (
).
   --  ------------------------------
   overriding
   procedure Add_Horizontal_Rule (Document : in out Text_Writer) is
   begin
      Document.Close_Paragraph;
   end Add_Horizontal_Rule;

   --  ------------------------------
   --  Add a link.
   --  ------------------------------
   overriding
   procedure Add_Link (Document : in out Text_Writer;
                       Name     : in Unbounded_Wide_Wide_String;
                       Link     : in Unbounded_Wide_Wide_String;
                       Language : in Unbounded_Wide_Wide_String;
                       Title    : in Unbounded_Wide_Wide_String) is
      pragma Unreferenced (Language);
   begin
      Document.Open_Paragraph;
      if Length (Title) > 0 then
         Document.Writer.Write (Title);
      end if;
      Document.Writer.Write (Link);
      Document.Writer.Write (Name);
      Document.Empty_Line := False;
   end Add_Link;

   --  ------------------------------
   --  Add an image.
   --  ------------------------------
   overriding
   procedure Add_Image (Document    : in out Text_Writer;
                        Link        : in Unbounded_Wide_Wide_String;
                        Alt         : in Unbounded_Wide_Wide_String;
                        Position    : in Unbounded_Wide_Wide_String;
                        Description : in Unbounded_Wide_Wide_String) is
      pragma Unreferenced (Position);
   begin
      Document.Open_Paragraph;
      if Length (Alt) > 0 then
         Document.Writer.Write (Alt);
      end if;
      if Length (Description) > 0 then
         Document.Writer.Write (Description);
      end if;
      Document.Writer.Write (Link);
      Document.Empty_Line := False;
   end Add_Image;

   --  ------------------------------
   --  Add a quote.
   --  ------------------------------
   overriding
   procedure Add_Quote (Document : in out Text_Writer;
                        Quote    : in Unbounded_Wide_Wide_String;
                        Link     : in Unbounded_Wide_Wide_String;
                        Language : in Unbounded_Wide_Wide_String) is
      pragma Unreferenced (Link, Language);
   begin
      Document.Open_Paragraph;
      Document.Writer.Write (Quote);
      Document.Empty_Line := False;
   end Add_Quote;

   --  ------------------------------
   --  Add a text block with the given format.
   --  ------------------------------
   overriding
   procedure Add_Text (Document : in out Text_Writer;
                       Text     : in Unbounded_Wide_Wide_String;
                       Format   : in AWA.Wikis.Documents.Format_Map) is
      pragma Unreferenced (Format);
   begin
      Document.Writer.Write (Text);
      Document.Empty_Line := False;
   end Add_Text;

   --  ------------------------------
   --  Add a text block that is pre-formatted.
   --  ------------------------------
   procedure Add_Preformatted (Document : in out Text_Writer;
                               Text     : in Unbounded_Wide_Wide_String;
                               Format   : in Unbounded_Wide_Wide_String) is
      pragma Unreferenced (Format);
   begin
      Document.Close_Paragraph;
      Document.Writer.Write (Text);
      Document.Empty_Line := False;
   end Add_Preformatted;

   --  ------------------------------
   --  Finish the document after complete wiki text has been parsed.
   --  ------------------------------
   overriding
   procedure Finish (Document : in out Text_Writer) is
   begin
      Document.Close_Paragraph;
   end Finish;

end AWA.Wikis.Writers.Text;

Implement the Add_Blockquote procedure

Implement the Add_Blockquote procedure