-----------------------------------------------------------------------
--  properties-bundles -- Generic name/value property management
--  Copyright (C) 2001, 2002, 2003, 2006, 2008, 2009, 2010, 2011, 2012, 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Containers;
with Ada.Finalization;
with Ada.Containers.Hashed_Maps;
with Util.Strings;
with Util.Concurrent.Locks;

--  == Property bundles ==
--  Property bundles represent several property files that share some overriding rules and
--  capabilities.  Their introduction comes from Java resource bundles which allow to
--  localize easily some configuration files or some message.  When loading a property bundle
--  a locale is defined to specify the target language and locale.  If a specific property
--  file for that locale exists, it is used first.  Otherwise, the property bundle will use
--  the default property file.
--
--  A rule exists on the name of the specific property locale file: it must start with the
--  bundle name followed by `_` and the name of the locale.  The default property file must
--  be the bundle name.  For example, the bundle `dates` is associated with the following
--  property files:
--
--    dates.properties           Default values (English locale)
--    dates_fr.properties        French locale
--    dates_de.properties        German locale
--    dates_es.properties        Spain locale
--
--  Because a bundle can be associated with one or several property files, a specific loader is
--  used.  The loader instance must be declared and configured to indicate one or several search
--  directories that contain property files.
--
--    with Util.Properties.Bundles;
--    ...
--       Loader : Util.Properties.Bundles.Loader;
--       Bundle : Util.Properties.Bundles.Manager;
--       ...
--       Util.Properties.Bundles.Initialize (Loader, "bundles;/usr/share/bundles");
--       Util.Properties.Bundles.Load_Bundle (Loader, "dates", "fr", Bundle);
--       Ada.Text_IO.Put_Line (Bundle.Get ("util.month1.long");
--
--  In this example, the `util.month1.long` key is first search in the `dates_fr` French locale
--  and if it is not found it is searched in the default locale.
package Util.Properties.Bundles is

   NO_BUNDLE : exception;

   NOT_WRITEABLE : exception;

   type Manager is new Util.Properties.Manager with private;

   --  ------------------------------
   --  Bundle loader
   --  ------------------------------
   --  The <b>Loader</b> provides facilities for loading property bundles
   --  and maintains a cache of bundles.  The cache is thread-safe but the returned
   --  bundles are not thread-safe.
   type Loader is limited private;
   type Loader_Access is access all Loader;

   --  Initialize the bundle factory and specify where the property files are stored.
   procedure Initialize (Factory : in out Loader;
                         Path    : in String);

   --  Load the bundle with the given name and for the given locale name.
   procedure Load_Bundle (Factory : in out Loader;
                          Name    : in String;
                          Locale  : in String;
                          Bundle  : out Manager'Class);
private

   procedure Add_Bundle (Self : in out Manager; Props : in Manager_Access);
   --  Add a bundle

   type Bundle_Manager_Access is access all Manager'Class;

   type Manager is new Util.Properties.Manager with null record;

   overriding
   procedure Initialize (Object : in out Manager);

   overriding
   procedure Adjust (Object : in out Manager);

   package Bundle_Map is
     new Ada.Containers.Hashed_Maps
       (Element_Type    => Bundle_Manager_Access,
        Key_Type        => Util.Strings.Name_Access,
        Hash            => Util.Strings.Hash,
        Equivalent_Keys => Util.Strings.Equivalent_Keys);

   type Loader is new Ada.Finalization.Limited_Controlled with record
      Lock    : Util.Concurrent.Locks.RW_Lock;
      Bundles : Bundle_Map.Map;
      Path    : Unbounded_String;
   end record;

   --  Finalize the bundle loader and clear the cache
   overriding
   procedure Finalize (Factory : in out Loader);

   --  Clear the cache bundle
   procedure Clear_Cache (Factory : in out Loader);

   --  Find the bundle with the given name and for the given locale name.
   procedure Find_Bundle (Factory : in out Loader;
                          Name    : in String;
                          Locale  : in String;
                          Bundle  : out Manager'Class;
                          Found   : out Boolean);

   --  Load the bundle with the given name and for the given locale name.
   procedure Load_Bundle (Factory : in out Loader;
                          Name    : in String;
                          Found   : out Boolean);

end Util.Properties.Bundles;

-----------------------------------------------------------------------
--  util-properties-bundles -- Generic name/value property management
--  Copyright (C) 2001, 2002, 2003, 2006, 2008, 2009, 2010, 2011, 2012, 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Containers;
with Ada.Finalization;
with Ada.Containers.Hashed_Maps;
with Util.Strings;
with Util.Concurrent.Locks;

--  == Property bundles ==
--  Property bundles represent several property files that share some overriding rules and
--  capabilities.  Their introduction comes from Java resource bundles which allow to
--  localize easily some configuration files or some message.  When loading a property bundle
--  a locale is defined to specify the target language and locale.  If a specific property
--  file for that locale exists, it is used first.  Otherwise, the property bundle will use
--  the default property file.
--
--  A rule exists on the name of the specific property locale file: it must start with the
--  bundle name followed by `_` and the name of the locale.  The default property file must
--  be the bundle name.  For example, the bundle `dates` is associated with the following
--  property files:
--
--    dates.properties           Default values (English locale)
--    dates_fr.properties        French locale
--    dates_de.properties        German locale
--    dates_es.properties        Spain locale
--
--  Because a bundle can be associated with one or several property files, a specific loader is
--  used.  The loader instance must be declared and configured to indicate one or several search
--  directories that contain property files.
--
--    with Util.Properties.Bundles;
--    ...
--       Loader : Util.Properties.Bundles.Loader;
--       Bundle : Util.Properties.Bundles.Manager;
--       ...
--       Util.Properties.Bundles.Initialize (Loader, "bundles;/usr/share/bundles");
--       Util.Properties.Bundles.Load_Bundle (Loader, "dates", "fr", Bundle);
--       Ada.Text_IO.Put_Line (Bundle.Get ("util.month1.long");
--
--  In this example, the `util.month1.long` key is first search in the `dates_fr` French locale
--  and if it is not found it is searched in the default locale.
package Util.Properties.Bundles is

   NO_BUNDLE : exception;

   NOT_WRITEABLE : exception;

   type Manager is new Util.Properties.Manager with private;

   --  ------------------------------
   --  Bundle loader
   --  ------------------------------
   --  The <b>Loader</b> provides facilities for loading property bundles
   --  and maintains a cache of bundles.  The cache is thread-safe but the returned
   --  bundles are not thread-safe.
   type Loader is limited private;
   type Loader_Access is access all Loader;

   --  Initialize the bundle factory and specify where the property files are stored.
   procedure Initialize (Factory : in out Loader;
                         Path    : in String);

   --  Load the bundle with the given name and for the given locale name.
   procedure Load_Bundle (Factory : in out Loader;
                          Name    : in String;
                          Locale  : in String;
                          Bundle  : out Manager'Class);
private

   procedure Add_Bundle (Self : in out Manager; Props : in Manager_Access);
   --  Add a bundle

   type Bundle_Manager_Access is access all Manager'Class;

   type Manager is new Util.Properties.Manager with null record;

   overriding
   procedure Initialize (Object : in out Manager);

   overriding
   procedure Adjust (Object : in out Manager);

   package Bundle_Map is
     new Ada.Containers.Hashed_Maps
       (Element_Type    => Bundle_Manager_Access,
        Key_Type        => Util.Strings.Name_Access,
        Hash            => Util.Strings.Hash,
        Equivalent_Keys => Util.Strings.Equivalent_Keys);

   type Loader is new Ada.Finalization.Limited_Controlled with record
      Lock    : Util.Concurrent.Locks.RW_Lock;
      Bundles : Bundle_Map.Map;
      Path    : Unbounded_String;
   end record;

   --  Finalize the bundle loader and clear the cache
   overriding
   procedure Finalize (Factory : in out Loader);

   --  Clear the cache bundle
   procedure Clear_Cache (Factory : in out Loader);

   --  Find the bundle with the given name and for the given locale name.
   procedure Find_Bundle (Factory : in out Loader;
                          Name    : in String;
                          Locale  : in String;
                          Bundle  : out Manager'Class;
                          Found   : out Boolean);

   --  Load the bundle with the given name and for the given locale name.
   procedure Load_Bundle (Factory : in out Loader;
                          Name    : in String;
                          Found   : out Boolean);

end Util.Properties.Bundles;

Fix header style

Fix header style


-----------------------------------------------------------------------
--  security-policies-roles -- Role based policies
--  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.
-----------------------------------------------------------------------

with Ada.Finalization;
with Ada.Strings.Unbounded;

package Security.Policies.Roles is

   --  Each role is represented by a Role_Type number to provide a fast
   --  and efficient role check.
   type Role_Type is new Natural range 0 .. 63;

   type Role_Type_Array is array (Positive range <>) of Role_Type;

   --  The Role_Map represents a set of roles which are assigned to a user.
   --  Each role is represented by a boolean in the map.  The implementation is limited
   --  to 64 roles (the number of different permissions can be higher).
   type Role_Map is array (Role_Type'Range) of Boolean;
   pragma Pack (Role_Map);

   type Role_Policy is new Policy with private;

   Invalid_Name : exception;

   --  Each permission is represented by a Permission_Type number to provide a fast
   --  and efficient permission check.
   type Permission_Type is new Natural range 0 .. 63;

   --  The Permission_Map represents a set of permissions which are granted to a user.
   --  Each permission is represented by a boolean in the map.  The implementation is limited
   --  to 64 permissions.
   type Permission_Map is array (Permission_Type'Range) of Boolean;
   pragma Pack (Permission_Map);

   --  ------------------------------
   --  Permission Manager
   --  ------------------------------
   --  The Permission_Manager verifies through some policy that a permission
   --  is granted to a user.

   --  Find the role type associated with the role name identified by Name.
   --  Raises Invalid_Name if there is no role type.
   function Find_Role (Manager : in Role_Policy;
                       Name    : in String) return Role_Type;

   --  Get the role name.
   function Get_Role_Name (Manager : in Role_Policy;
                           Role    : in Role_Type) return String;

   --  Create a role
   procedure Create_Role (Manager : in out Role_Policy;
                          Name    : in String;
                          Role    : out Role_Type);

   --  Get or add a role type for the given name.
   procedure Add_Role_Type (Manager   : in out Role_Policy;
                            Name      : in String;
                            Result    : out Role_Type);

private

   type Role_Name_Array is
     array (Role_Type'Range) of Ada.Strings.Unbounded.String_Access;

   type Role_Policy is new Policy with record
      Names        : Role_Name_Array;
      Next_Role    : Role_Type := Role_Type'First;
   end record;

end Security.Policies.Roles;

-----------------------------------------------------------------------
--  security-policies-roles -- Role based policies
--  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.
-----------------------------------------------------------------------

with Ada.Strings.Unbounded;

--  == Role Based Security Policy ==
--  The <tt>Security.Policies.Roles</tt> package implements a role based security policy.
--
--  A role is represented by a name in security configuration files.
package Security.Policies.Roles is

   --  Each role is represented by a Role_Type number to provide a fast
   --  and efficient role check.
   type Role_Type is new Natural range 0 .. 63;
   for Role_Type'Size use 8;

   type Role_Type_Array is array (Positive range <>) of Role_Type;

   --  The Role_Map represents a set of roles which are assigned to a user.
   --  Each role is represented by a boolean in the map.  The implementation is limited
   --  to 64 roles (the number of different permissions can be higher).
   type Role_Map is array (Role_Type'Range) of Boolean;
   pragma Pack (Role_Map);

   --  ------------------------------
   --  Role based policy
   --  ------------------------------
   type Role_Policy is new Policy with private;

   Invalid_Name : exception;

   --  Each permission is represented by a Permission_Type number to provide a fast
   --  and efficient permission check.
   type Permission_Type is new Natural range 0 .. 63;

   --  The Permission_Map represents a set of permissions which are granted to a user.
   --  Each permission is represented by a boolean in the map.  The implementation is limited
   --  to 64 permissions.
   type Permission_Map is array (Permission_Type'Range) of Boolean;
   pragma Pack (Permission_Map);

   --  ------------------------------
   --  Permission Manager
   --  ------------------------------
   --  The Permission_Manager verifies through some policy that a permission
   --  is granted to a user.

   --  Find the role type associated with the role name identified by Name.
   --  Raises Invalid_Name if there is no role type.
   function Find_Role (Manager : in Role_Policy;
                       Name    : in String) return Role_Type;

   --  Get the role name.
   function Get_Role_Name (Manager : in Role_Policy;
                           Role    : in Role_Type) return String;

   --  Create a role
   procedure Create_Role (Manager : in out Role_Policy;
                          Name    : in String;
                          Role    : out Role_Type);

   --  Get or add a role type for the given name.
   procedure Add_Role_Type (Manager   : in out Role_Policy;
                            Name      : in String;
                            Result    : out Role_Type);

private

   type Role_Name_Array is
     array (Role_Type'Range) of Ada.Strings.Unbounded.String_Access;

   type Role_Policy is new Policy with record
      Names        : Role_Name_Array;
      Next_Role    : Role_Type := Role_Type'First;
   end record;

   type Controller_Config is record
      Name    : Util.Beans.Objects.Object;
      Roles   : Permissions.Role_Type_Array (1 .. Integer (Permissions.Role_Type'Last));
      Count   : Natural := 0;
      Manager : Security.Permissions.Permission_Manager_Access;
   end record;

   --  Setup the XML parser to read the role-permission description.  For example:
   --
   --  <security-role>
   --    <role-name>admin</role-name>
   --  </security-role>
   --  <role-permission>
   --     <name>create-workspace</name>
   --     <role>admin</role>
   --     <role>manager</role>
   --  </role-permission>
   --
   --  This defines a permission create-workspace that will be granted if the
   --  user has either the admin or the manager role.
   overriding
   procedure Set_Reader_Config (Pol     : in out Policy;
                                Reader  : in out Util.Serialize.IO.XML.Parser);

end Security.Policies.Roles;

Define Set_Reader_Config to allow reading the XML configuration for role based policies


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

with AWA.Users.Models;
with AWA.Users.Principals;
with AWA.Permissions.Services;
with AWA.Modules;
with AWA.Modules.Lifecycles;
with AWA.Events;
with Security.Auth;
with Security.Random;

with ADO;
with ADO.Sessions;

--  == Introduction ==
--  The *users* module provides a *users* service which controls the user data model.
--
--  == Events ==
--  The *users* module exposes a number of events which are posted when some action
--  are performed at the service level.
--
--  === user-register ===
--  This event is posted when a new user is registered in the application.
--  It can be used to send a registration email.
--
--  === user-create ===
--  This event is posted when a new user is created.  It can be used to trigger
--  the pre-initialization of the application for the new user.
--
--  === user-lost-password ===
--  This event is posted when a user asks for a password reset through an
--  anonymous form.  It is intended to be used to send the reset password email.
--
--  === user-reset-password ===
--  This event is posted when a user has successfully reset his password.
--  It can be used to send an email.
--
package AWA.Users.Services is

   use AWA.Users.Models;

   package User_Create_Event is new AWA.Events.Definition (Name => "user-create");
   package User_Register_Event is new AWA.Events.Definition (Name => "user-register");
   package User_Lost_Password_Event is new AWA.Events.Definition (Name => "user-lost-password");
   package User_Reset_Password_Event is new AWA.Events.Definition (Name => "user-reset-password");

   package User_Lifecycle is
     new AWA.Modules.Lifecycles (Element_Type => AWA.Users.Models.User_Ref'Class);

   subtype Listener is User_Lifecycle.Listener;

   NAME : constant String := "User_Service";

   Not_Found  : exception;

   User_Exist : exception;

   --  The session is an authenticate session.  The user authenticated using password or OpenID.
   --  When the user logout, this session is closed as well as any connection session linked to
   --  the authenticate session.
   AUTH_SESSION_TYPE    : constant Integer := 1;

   --  The session is a connection session.  It is linked to an authenticate session.
   --  This session can be closed automatically due to a timeout or user's inactivity.
   --  The AID cookie refers to this connection session to create a new connection session.
   --  Once re-connecting is done, the connection session refered to by AID is marked
   --  as <b<USED_SESSION_TYPE and a new AID cookie with the new connection session is
   --  returned to the user.
   CONNECT_SESSION_TYPE : constant Integer := 0;

   --  The session is a connection session whose associated AID cookie has been used.
   --  This session cannot be used to re-connect a user through the AID cookie.
   USED_SESSION_TYPE    : constant Integer := 2;

   --  Get the user name from the email address.
   --  Returns the possible user name from his email address.
   function Get_Name_From_Email (Email : in String) return String;

   type User_Service is new AWA.Modules.Module_Manager with private;
   type User_Service_Access is access all User_Service'Class;

   --  Build the authenticate cookie.  The cookie is signed using HMAC-SHA1 with a private key.
   function Get_Authenticate_Cookie (Model : in User_Service;
                                     Id    : in ADO.Identifier)
                                     return String;

   --  Get the authenticate identifier from the cookie.
   --  Verify that the cookie is valid, the signature is correct.
   --  Returns the identified or NO_IDENTIFIER
   function Get_Authenticate_Id (Model  : in User_Service;
                                 Cookie : in String) return ADO.Identifier;

   --  Get the password hash.  The password is signed using HMAC-SHA1 with the salt.
   function Get_Password_Hash (Model    : in User_Service;
                               Password : in String;
                               Salt     : in String)
                               return String;

   --  Create a user in the database with the given user information and
   --  the associated email address.  Verify that no such user already exist.
   --  Raises User_Exist exception if a user with such email is already registered.
   procedure Create_User (Model : in out User_Service;
                          User  : in out User_Ref'Class;
                          Email : in out Email_Ref'Class);

   --  Verify the access key and retrieve the user associated with that key.
   --  Starts a new session associated with the given IP address.
   --  The authenticated user is identified by a principal instance allocated
   --  and returned in Principal.
   --  Raises Not_Found if the access key does not exist.
   procedure Verify_User (Model     : in User_Service;
                          Key       : in String;
                          IpAddr    : in String;
                          Principal : out AWA.Users.Principals.Principal_Access);

   --  Authenticate the user with his email address and his password.
   --  If the user is authenticated, return the user information and
   --  create a new session.  The IP address of the connection is saved
   --  in the session.
   --  Raises Not_Found exception if the user is not recognized
   procedure Authenticate (Model     : in User_Service;
                           Email     : in String;
                           Password  : in String;
                           IpAddr    : in String;
                           Principal : out AWA.Users.Principals.Principal_Access);

   --  Authenticate the user with his OpenID identifier.  The authentication process
   --  was made by an external OpenID provider.  If the user does not yet exists in
   --  the database, a record is created for him.  Create a new session for the user.
   --  The IP address of the connection is saved in the session.
   --  Raises Not_Found exception if the user is not recognized
   procedure Authenticate (Model     : in User_Service;
                           Auth      : in Security.Auth.Authentication;
                           IpAddr    : in String;
                           Principal : out AWA.Users.Principals.Principal_Access);

   --  Authenticate the user with the authenticate cookie generated from a previous authenticate
   --  session.  If the cookie has the correct signature, matches a valid session,
   --  return the user information and create a new session.  The IP address of the connection
   --  is saved in the session.
   --  Raises Not_Found exception if the user is not recognized
   procedure Authenticate (Model     : in User_Service;
                           Cookie    : in String;
                           Ip_Addr   : in String;
                           Principal : out AWA.Users.Principals.Principal_Access);

   --  Start the lost password process for a user.  Find the user having
   --  the given email address and send that user a password reset key
   --  in an email.
   --  Raises Not_Found exception if no user with such email exist
   procedure Lost_Password (Model : in out User_Service;
                            Email : in String);

   --  Reset the password of the user associated with the secure key.
   --  Raises Not_Found if there is no key or if the user does not have any email
   procedure Reset_Password (Model    : in out User_Service;
                             Key      : in String;
                             Password : in String;
                             IpAddr   : in String;
                             Principal : out AWA.Users.Principals.Principal_Access);

   --  Verify that the user session identified by Id is valid and still active.
   --  Returns the user and the session objects.
   --  Raises Not_Found if the session does not exist or was closed.
   procedure Verify_Session (Model   : in User_Service;
                             Id      : in ADO.Identifier;
                             User    : out User_Ref'Class;
                             Session : out Session_Ref'Class);

   --  Closes the session identified by Id.  The session identified should refer to
   --  a valid and not closed connection session.
   --  When Logout is set, the authenticate session is also closed.  The connection
   --  sessions associated with the authenticate session are also closed.
   --  Raises Not_Found if the session is invalid or already closed.
   procedure Close_Session (Model  : in User_Service;
                            Id     : in ADO.Identifier;
                            Logout : in Boolean := False);

   --  Create and generate a new access key for the user.  The access key is saved in the
   --  database and it will expire after the expiration delay.
   procedure Create_Access_Key (Model   : in out User_Service;
                                User    : in AWA.Users.Models.User_Ref'Class;
                                Key     : in out AWA.Users.Models.Access_Key_Ref;
                                Kind    : in AWA.Users.Models.Key_Type;
                                Expire  : in Duration;
                                Session : in out ADO.Sessions.Master_Session);

   procedure Send_Alert (Model : in User_Service;
                         Kind  : in AWA.Events.Event_Index;
                         User  : in User_Ref'Class;
                         Props : in out AWA.Events.Module_Event);

   --  Initialize the user service.
   overriding
   procedure Initialize (Model  : in out User_Service;
                         Module : in AWA.Modules.Module'Class);

private

   function Create_Key (Model  : in out User_Service;
                        Number : in ADO.Identifier) return String;

   procedure Create_Session (Model   : in User_Service;
                             DB      : in out ADO.Sessions.Master_Session;
                             Session : out Session_Ref'Class;
                             User    : in User_Ref'Class;
                             Ip_Addr : in String;
                             Principal : out AWA.Users.Principals.Principal_Access);

   type User_Service is new AWA.Modules.Module_Manager with record
      Server_Id   : Integer := 0;
      Random      : Security.Random.Generator;
      Auth_Key    : Ada.Strings.Unbounded.Unbounded_String;
      Permissions : AWA.Permissions.Services.Permission_Manager_Access;
   end record;

end AWA.Users.Services;

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

with AWA.Users.Models;
with AWA.Users.Principals;
with AWA.Permissions.Services;
with AWA.Modules;
with AWA.Modules.Lifecycles;
with AWA.Events;
with Security.Auth;
with Security.Random;

with ADO;
with ADO.Sessions;

--  == Introduction ==
--  The *users* module provides a *users* service which controls the user data model.
--
--  == Events ==
--  The *users* module exposes a number of events which are posted when some action
--  are performed at the service level.
--
--  === user-register ===
--  This event is posted when a new user is registered in the application.
--  It can be used to send a registration email.
--
--  === user-create ===
--  This event is posted when a new user is created.  It can be used to trigger
--  the pre-initialization of the application for the new user.
--
--  === user-lost-password ===
--  This event is posted when a user asks for a password reset through an
--  anonymous form.  It is intended to be used to send the reset password email.
--
--  === user-reset-password ===
--  This event is posted when a user has successfully reset his password.
--  It can be used to send an email.
--
package AWA.Users.Services is

   use AWA.Users.Models;

   package User_Create_Event is new AWA.Events.Definition (Name => "user-create");
   package User_Register_Event is new AWA.Events.Definition (Name => "user-register");
   package User_Lost_Password_Event is new AWA.Events.Definition (Name => "user-lost-password");
   package User_Reset_Password_Event is new AWA.Events.Definition (Name => "user-reset-password");

   package User_Lifecycle is
     new AWA.Modules.Lifecycles (Element_Type => AWA.Users.Models.User_Ref'Class);

   subtype Listener is User_Lifecycle.Listener;

   NAME : constant String := "User_Service";

   Not_Found  : exception;

   User_Exist : exception;

   --  The session is an authenticate session.  The user authenticated using password or OpenID.
   --  When the user logout, this session is closed as well as any connection session linked to
   --  the authenticate session.
   AUTH_SESSION_TYPE    : constant Integer := 1;

   --  The session is a connection session.  It is linked to an authenticate session.
   --  This session can be closed automatically due to a timeout or user's inactivity.
   --  The AID cookie refers to this connection session to create a new connection session.
   --  Once re-connecting is done, the connection session refered to by AID is marked
   --  as <b<USED_SESSION_TYPE and a new AID cookie with the new connection session is
   --  returned to the user.
   CONNECT_SESSION_TYPE : constant Integer := 0;

   --  The session is a connection session whose associated AID cookie has been used.
   --  This session cannot be used to re-connect a user through the AID cookie.
   USED_SESSION_TYPE    : constant Integer := 2;

   --  Get the user name from the email address.
   --  Returns the possible user name from his email address.
   function Get_Name_From_Email (Email : in String) return String;

   type User_Service is new AWA.Modules.Module_Manager with private;
   type User_Service_Access is access all User_Service'Class;

   --  Build the authenticate cookie.  The cookie is signed using HMAC-SHA1 with a private key.
   function Get_Authenticate_Cookie (Model : in User_Service;
                                     Id    : in ADO.Identifier)
                                     return String;

   --  Get the authenticate identifier from the cookie.
   --  Verify that the cookie is valid, the signature is correct.
   --  Returns the identified or NO_IDENTIFIER
   function Get_Authenticate_Id (Model  : in User_Service;
                                 Cookie : in String) return ADO.Identifier;

   --  Get the password hash.  The password is signed using HMAC-SHA1 with the salt.
   function Get_Password_Hash (Model    : in User_Service;
                               Password : in String;
                               Salt     : in String)
                               return String;

   --  Create a user in the database with the given user information and
   --  the associated email address.  Verify that no such user already exist.
   --  Raises User_Exist exception if a user with such email is already registered.
   procedure Create_User (Model : in out User_Service;
                          User  : in out User_Ref'Class;
                          Email : in out Email_Ref'Class;
                          Key   : in String := "");

   --  Verify the access key and retrieve the user associated with that key.
   --  Starts a new session associated with the given IP address.
   --  The authenticated user is identified by a principal instance allocated
   --  and returned in Principal.
   --  Raises Not_Found if the access key does not exist.
   procedure Verify_User (Model     : in User_Service;
                          Key       : in String;
                          IpAddr    : in String;
                          Principal : out AWA.Users.Principals.Principal_Access);

   --  Authenticate the user with his email address and his password.
   --  If the user is authenticated, return the user information and
   --  create a new session.  The IP address of the connection is saved
   --  in the session.
   --  Raises Not_Found exception if the user is not recognized
   procedure Authenticate (Model     : in User_Service;
                           Email     : in String;
                           Password  : in String;
                           IpAddr    : in String;
                           Principal : out AWA.Users.Principals.Principal_Access);

   --  Authenticate the user with his OpenID identifier.  The authentication process
   --  was made by an external OpenID provider.  If the user does not yet exists in
   --  the database, a record is created for him.  Create a new session for the user.
   --  The IP address of the connection is saved in the session.
   --  Raises Not_Found exception if the user is not recognized
   procedure Authenticate (Model     : in User_Service;
                           Auth      : in Security.Auth.Authentication;
                           IpAddr    : in String;
                           Principal : out AWA.Users.Principals.Principal_Access);

   --  Authenticate the user with the authenticate cookie generated from a previous authenticate
   --  session.  If the cookie has the correct signature, matches a valid session,
   --  return the user information and create a new session.  The IP address of the connection
   --  is saved in the session.
   --  Raises Not_Found exception if the user is not recognized
   procedure Authenticate (Model     : in User_Service;
                           Cookie    : in String;
                           Ip_Addr   : in String;
                           Principal : out AWA.Users.Principals.Principal_Access);

   --  Start the lost password process for a user.  Find the user having
   --  the given email address and send that user a password reset key
   --  in an email.
   --  Raises Not_Found exception if no user with such email exist
   procedure Lost_Password (Model : in out User_Service;
                            Email : in String);

   --  Reset the password of the user associated with the secure key.
   --  Raises Not_Found if there is no key or if the user does not have any email
   procedure Reset_Password (Model    : in out User_Service;
                             Key      : in String;
                             Password : in String;
                             IpAddr   : in String;
                             Principal : out AWA.Users.Principals.Principal_Access);

   --  Verify that the user session identified by Id is valid and still active.
   --  Returns the user and the session objects.
   --  Raises Not_Found if the session does not exist or was closed.
   procedure Verify_Session (Model   : in User_Service;
                             Id      : in ADO.Identifier;
                             User    : out User_Ref'Class;
                             Session : out Session_Ref'Class);

   --  Closes the session identified by Id.  The session identified should refer to
   --  a valid and not closed connection session.
   --  When Logout is set, the authenticate session is also closed.  The connection
   --  sessions associated with the authenticate session are also closed.
   --  Raises Not_Found if the session is invalid or already closed.
   procedure Close_Session (Model  : in User_Service;
                            Id     : in ADO.Identifier;
                            Logout : in Boolean := False);

   --  Create and generate a new access key for the user.  The access key is saved in the
   --  database and it will expire after the expiration delay.
   procedure Create_Access_Key (Model   : in out User_Service;
                                User    : in AWA.Users.Models.User_Ref'Class;
                                Key     : in out AWA.Users.Models.Access_Key_Ref;
                                Kind    : in AWA.Users.Models.Key_Type;
                                Expire  : in Duration;
                                Session : in out ADO.Sessions.Master_Session);

   procedure Send_Alert (Model : in User_Service;
                         Kind  : in AWA.Events.Event_Index;
                         User  : in User_Ref'Class;
                         Props : in out AWA.Events.Module_Event);

   --  Initialize the user service.
   overriding
   procedure Initialize (Model  : in out User_Service;
                         Module : in AWA.Modules.Module'Class);

private

   function Create_Key (Model  : in out User_Service;
                        Number : in ADO.Identifier) return String;

   procedure Create_Session (Model   : in User_Service;
                             DB      : in out ADO.Sessions.Master_Session;
                             Session : out Session_Ref'Class;
                             User    : in User_Ref'Class;
                             Ip_Addr : in String;
                             Principal : out AWA.Users.Principals.Principal_Access);

   type User_Service is new AWA.Modules.Module_Manager with record
      Server_Id   : Integer := 0;
      Random      : Security.Random.Generator;
      Auth_Key    : Ada.Strings.Unbounded.Unbounded_String;
      Permissions : AWA.Permissions.Services.Permission_Manager_Access;
   end record;

end AWA.Users.Services;

Add a Key parameter to the Create_User procedure


-----------------------------------------------------------------------
--  awa-questions-modules -- Module questions
--  Copyright (C) 2012, 2013, 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 Ada.Calendar;
with Ada.Characters.Conversions;

with AWA.Permissions;
with AWA.Services.Contexts;
with AWA.Users.Models;
with AWA.Workspaces.Models;
with AWA.Workspaces.Modules;
with Wiki;
with Wiki.Utils;

with ADO.Sessions;
with ADO.Statements;

with Util.Log.Loggers;
with AWA.Modules.Beans;
with AWA.Modules.Get;
with AWA.Questions.Beans;
with AWA.Applications;
package body AWA.Questions.Modules is

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

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

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

      --  Setup the resource bundles.
      App.Register ("questionMsg", "questions");

      --  Edit and save a question.
      Register.Register (Plugin => Plugin,
                         Name   =>  "AWA.Questions.Beans.Question_Bean",
                         Handler => AWA.Questions.Beans.Create_Question_Bean'Access);

      --  Edit and save an answer.
      Register.Register (Plugin => Plugin,
                         Name   =>  "AWA.Questions.Beans.Answer_Bean",
                         Handler => AWA.Questions.Beans.Create_Answer_Bean'Access);

      --  List of questions.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Questions.Beans.Question_List_Bean",
                         Handler => AWA.Questions.Beans.Create_Question_List_Bean'Access);

      --  Display a question with its answers.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Questions.Beans.Question_Display_Bean",
                         Handler => AWA.Questions.Beans.Create_Question_Display_Bean'Access);

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

   --  ------------------------------
   --  Get the questions module.
   --  ------------------------------
   function Get_Question_Module return Question_Module_Access is
      function Get is new AWA.Modules.Get (Question_Module, Question_Module_Access, NAME);
   begin
      return Get;
   end Get_Question_Module;

   --  ------------------------------
   --  Create or save the question.
   --  ------------------------------
   procedure Save_Question (Model    : in Question_Module;
                            Question : in out AWA.Questions.Models.Question_Ref'Class) is
      pragma Unreferenced (Model);

      function To_Wide (Item : in String) return Wide_Wide_String
                        renames Ada.Characters.Conversions.To_Wide_Wide_String;

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant AWA.Users.Models.User_Ref := Ctx.Get_User;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      WS    : AWA.Workspaces.Models.Workspace_Ref;
   begin
      Ctx.Start;
      if Question.Is_Inserted then
         Log.Info ("Updating question {0}", ADO.Identifier'Image (Question.Get_Id));

         WS := AWA.Workspaces.Models.Workspace_Ref (Question.Get_Workspace);
      else
         Log.Info ("Creating new question {0}", String '(Question.Get_Title));

         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_Questions.Permission,
                                Entity     => WS);
         Question.Set_Workspace (WS);
         Question.Set_Author (User);
      end if;

      declare
         Text : constant String := Wiki.Utils.To_Text (To_Wide (Question.Get_Description),
                                                       Wiki.SYNTAX_MIX);
         Last : Natural;
      begin
         if Text'Length < SHORT_DESCRIPTION_LENGTH then
            Last := Text'Last;
         else
            Last := SHORT_DESCRIPTION_LENGTH;
         end if;
         Question.Set_Short_Description (Text (Text'First .. Last) & "...");
      end;
      if not Question.Is_Inserted then
         Question.Set_Create_Date (Ada.Calendar.Clock);
      else
         Question.Set_Edit_Date (ADO.Nullable_Time '(Is_Null => False,
                                                     Value => Ada.Calendar.Clock));
      end if;
      Question.Save (DB);
      Ctx.Commit;
   end Save_Question;

   --  ------------------------------
   --  Delete the question.
   --  ------------------------------
   procedure Delete_Question (Model    : in Question_Module;
                              Question : in out AWA.Questions.Models.Question_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
      Ctx.Start;

      --  Check that the user has the delete permission on the given question.
      AWA.Permissions.Check (Permission => ACL_Delete_Questions.Permission,
                             Entity     => Question);

      --  Before deleting the question, delete the associated answers.
      declare
         Stmt : ADO.Statements.Delete_Statement
           := DB.Create_Statement (AWA.Questions.Models.ANSWER_TABLE);
      begin
         Stmt.Set_Filter (Filter => "question_id = ?");
         Stmt.Add_Param (Value => Question);
         Stmt.Execute;
      end;
      Question.Delete (DB);
      Ctx.Commit;
   end Delete_Question;

   --  ------------------------------
   --  Load the question.
   --  ------------------------------
   procedure Load_Question (Model    : in Question_Module;
                            Question : in out AWA.Questions.Models.Question_Ref'Class;
                            Id       : in ADO.Identifier;
                            Found    : out Boolean) is
      DB : ADO.Sessions.Session := Model.Get_Session;
   begin
      Question.Load (DB, Id, Found);
   end Load_Question;

   --  ------------------------------
   --  Create or save the answer.
   --  ------------------------------
   procedure Save_Answer (Model    : in Question_Module;
                          Question : in AWA.Questions.Models.Question_Ref'Class;
                          Answer   : in out AWA.Questions.Models.Answer_Ref'Class) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant AWA.Users.Models.User_Ref := Ctx.Get_User;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Ctx.Start;
      if Answer.Is_Inserted then
         Log.Info ("Updating question {0}", ADO.Identifier'Image (Answer.Get_Id));

      else
         Log.Info ("Creating new answer for {0}", ADO.Identifier'Image (Question.Get_Id));

         --  Check that the user has the create permission on the given workspace.
         AWA.Permissions.Check (Permission => ACL_Answer_Questions.Permission,
                                Entity     => Question);
         Answer.Set_Author (User);
      end if;

      if not Answer.Is_Inserted then
         Answer.Set_Create_Date (Ada.Calendar.Clock);
         Answer.Set_Question (Question);
      else
         Answer.Set_Edit_Date (ADO.Nullable_Time '(Value   => Ada.Calendar.Clock,
                                                   Is_Null => False));
      end if;
      Answer.Save (DB);
      Ctx.Commit;
   end Save_Answer;

   --  ------------------------------
   --  Delete the answer.
   --  ------------------------------
   procedure Delete_Answer (Model  : in Question_Module;
                            Answer : in out AWA.Questions.Models.Answer_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
      Ctx.Start;

      --  Check that the user has the delete permission on the given answer.
      AWA.Permissions.Check (Permission => ACL_Delete_Answer.Permission,
                             Entity     => Answer);

      Answer.Delete (DB);
      Ctx.Commit;
   end Delete_Answer;

   --  ------------------------------
   --  Load the answer.
   --  ------------------------------
   procedure Load_Answer (Model    : in Question_Module;
                          Answer   : in out AWA.Questions.Models.Answer_Ref'Class;
                          Question : in out AWA.Questions.Models.Question_Ref'Class;
                          Id       : in ADO.Identifier;
                          Found    : out Boolean) is
      DB : ADO.Sessions.Session := Model.Get_Session;
   begin
      Answer.Load (DB, Id, Found);
      Question := Answer.Get_Question;
   end Load_Answer;

end AWA.Questions.Modules;

-----------------------------------------------------------------------
--  awa-questions-modules -- Module questions
--  Copyright (C) 2012, 2013, 2015, 2016, 2018, 2022 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.Calendar;
with Ada.Characters.Conversions;

with AWA.Permissions;
with AWA.Services.Contexts;
with AWA.Users.Models;
with AWA.Workspaces.Models;
with AWA.Workspaces.Modules;
with Wiki;
with Wiki.Utils;

with ADO.Sessions;
with ADO.Statements;

with Util.Log.Loggers;
with AWA.Modules.Beans;
with AWA.Modules.Get;
with AWA.Questions.Beans;
with AWA.Applications;
package body AWA.Questions.Modules is

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

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

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

      --  Setup the resource bundles.
      App.Register ("questionMsg", "questions");

      --  Edit and save a question.
      Register.Register (Plugin => Plugin,
                         Name   =>  "AWA.Questions.Beans.Question_Bean",
                         Handler => AWA.Questions.Beans.Create_Question_Bean'Access);

      --  Edit and save an answer.
      Register.Register (Plugin => Plugin,
                         Name   =>  "AWA.Questions.Beans.Answer_Bean",
                         Handler => AWA.Questions.Beans.Create_Answer_Bean'Access);

      --  List of questions.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Questions.Beans.Question_List_Bean",
                         Handler => AWA.Questions.Beans.Create_Question_List_Bean'Access);

      --  Display a question with its answers.
      Register.Register (Plugin => Plugin,
                         Name   => "AWA.Questions.Beans.Question_Display_Bean",
                         Handler => AWA.Questions.Beans.Create_Question_Display_Bean'Access);

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

   --  ------------------------------
   --  Get the questions module.
   --  ------------------------------
   function Get_Question_Module return Question_Module_Access is
      function Get is new AWA.Modules.Get (Question_Module, Question_Module_Access, NAME);
   begin
      return Get;
   end Get_Question_Module;

   --  ------------------------------
   --  Create or save the question.
   --  ------------------------------
   procedure Save_Question (Model    : in Question_Module;
                            Question : in out AWA.Questions.Models.Question_Ref'Class) is
      pragma Unreferenced (Model);

      function To_Wide (Item : in String) return Wide_Wide_String
                        renames Ada.Characters.Conversions.To_Wide_Wide_String;

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant AWA.Users.Models.User_Ref := Ctx.Get_User;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      WS    : AWA.Workspaces.Models.Workspace_Ref;
   begin
      Ctx.Start;
      if Question.Is_Inserted then
         Log.Info ("Updating question {0}", ADO.Identifier'Image (Question.Get_Id));

         WS := AWA.Workspaces.Models.Workspace_Ref (Question.Get_Workspace);
      else
         Log.Info ("Creating new question {0}", String '(Question.Get_Title));

         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_Questions.Permission,
                                Entity     => WS);
         Question.Set_Workspace (WS);
         Question.Set_Author (User);
      end if;

      declare
         Text : constant String := Wiki.Utils.To_Text (To_Wide (Question.Get_Description),
                                                       Wiki.SYNTAX_MARKDOWN);
         Last : Natural;
      begin
         if Text'Length < SHORT_DESCRIPTION_LENGTH then
            Last := Text'Last;
         else
            Last := SHORT_DESCRIPTION_LENGTH;
         end if;
         Question.Set_Short_Description (Text (Text'First .. Last) & "...");
      end;
      if not Question.Is_Inserted then
         Question.Set_Create_Date (Ada.Calendar.Clock);
      else
         Question.Set_Edit_Date (ADO.Nullable_Time '(Is_Null => False,
                                                     Value => Ada.Calendar.Clock));
      end if;
      Question.Save (DB);
      Ctx.Commit;
   end Save_Question;

   --  ------------------------------
   --  Delete the question.
   --  ------------------------------
   procedure Delete_Question (Model    : in Question_Module;
                              Question : in out AWA.Questions.Models.Question_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
      Ctx.Start;

      --  Check that the user has the delete permission on the given question.
      AWA.Permissions.Check (Permission => ACL_Delete_Questions.Permission,
                             Entity     => Question);

      --  Before deleting the question, delete the associated answers.
      declare
         Stmt : ADO.Statements.Delete_Statement
           := DB.Create_Statement (AWA.Questions.Models.ANSWER_TABLE);
      begin
         Stmt.Set_Filter (Filter => "question_id = ?");
         Stmt.Add_Param (Value => Question);
         Stmt.Execute;
      end;
      Question.Delete (DB);
      Ctx.Commit;
   end Delete_Question;

   --  ------------------------------
   --  Load the question.
   --  ------------------------------
   procedure Load_Question (Model    : in Question_Module;
                            Question : in out AWA.Questions.Models.Question_Ref'Class;
                            Id       : in ADO.Identifier;
                            Found    : out Boolean) is
      DB : ADO.Sessions.Session := Model.Get_Session;
   begin
      Question.Load (DB, Id, Found);
   end Load_Question;

   --  ------------------------------
   --  Create or save the answer.
   --  ------------------------------
   procedure Save_Answer (Model    : in Question_Module;
                          Question : in AWA.Questions.Models.Question_Ref'Class;
                          Answer   : in out AWA.Questions.Models.Answer_Ref'Class) is
      pragma Unreferenced (Model);

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant AWA.Users.Models.User_Ref := Ctx.Get_User;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
   begin
      Ctx.Start;
      if Answer.Is_Inserted then
         Log.Info ("Updating question {0}", ADO.Identifier'Image (Answer.Get_Id));

      else
         Log.Info ("Creating new answer for {0}", ADO.Identifier'Image (Question.Get_Id));

         --  Check that the user has the create permission on the given workspace.
         AWA.Permissions.Check (Permission => ACL_Answer_Questions.Permission,
                                Entity     => Question);
         Answer.Set_Author (User);
      end if;

      if not Answer.Is_Inserted then
         Answer.Set_Create_Date (Ada.Calendar.Clock);
         Answer.Set_Question (Question);
      else
         Answer.Set_Edit_Date (ADO.Nullable_Time '(Value   => Ada.Calendar.Clock,
                                                   Is_Null => False));
      end if;
      Answer.Save (DB);
      Ctx.Commit;
   end Save_Answer;

   --  ------------------------------
   --  Delete the answer.
   --  ------------------------------
   procedure Delete_Answer (Model  : in Question_Module;
                            Answer : in out AWA.Questions.Models.Answer_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
      Ctx.Start;

      --  Check that the user has the delete permission on the given answer.
      AWA.Permissions.Check (Permission => ACL_Delete_Answer.Permission,
                             Entity     => Answer);

      Answer.Delete (DB);
      Ctx.Commit;
   end Delete_Answer;

   --  ------------------------------
   --  Load the answer.
   --  ------------------------------
   procedure Load_Answer (Model    : in Question_Module;
                          Answer   : in out AWA.Questions.Models.Answer_Ref'Class;
                          Question : in out AWA.Questions.Models.Question_Ref'Class;
                          Id       : in ADO.Identifier;
                          Found    : out Boolean) is
      DB : ADO.Sessions.Session := Model.Get_Session;
   begin
      Answer.Load (DB, Id, Found);
      Question := Answer.Get_Question;
   end Load_Answer;

end AWA.Questions.Modules;

Replace SYNTAX_MIX by SYNTAX_MARKDOWN

Replace SYNTAX_MIX by SYNTAX_MARKDOWN


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

package body ADO.Utils is

   --  ------------------------------
   --  Build a bean object from the identifier.
   --  ------------------------------
   function To_Object (Id : in ADO.Identifier) return Util.Beans.Objects.Object is
   begin
      if Id = ADO.NO_IDENTIFIER then
         return Util.Beans.Objects.Null_Object;
      else
         return Util.Beans.Objects.To_Object (Long_Long_Integer (Id));
      end if;
   end To_Object;

   --  ------------------------------
   --  Build the identifier from the bean object.
   --  ------------------------------
   function To_Identifier (Value : in Util.Beans.Objects.Object) return ADO.Identifier is
   begin
      if Util.Beans.Objects.Is_Null (Value) then
         return ADO.NO_IDENTIFIER;
      else
         return ADO.Identifier (Util.Beans.Objects.To_Long_Long_Integer (Value));
      end if;
   end To_Identifier;

   --  ------------------------------
   --  Compute the hash of the identifier.
   --  ------------------------------
   function Hash (Key : in ADO.Identifier) return Ada.Containers.Hash_Type is
      use Ada.Containers;
   begin

      if Key < 0 then
         return Hash_Type (-Key);
      else
         return Hash_Type (Key);
      end if;
   end Hash;

end ADO.Utils;

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

package body ADO.Utils is

   --  ------------------------------
   --  Build a bean object from the identifier.
   --  ------------------------------
   function To_Object (Id : in ADO.Identifier) return Util.Beans.Objects.Object is
   begin
      if Id = ADO.NO_IDENTIFIER then
         return Util.Beans.Objects.Null_Object;
      else
         return Util.Beans.Objects.To_Object (Long_Long_Integer (Id));
      end if;
   end To_Object;

   --  ------------------------------
   --  Build the identifier from the bean object.
   --  ------------------------------
   function To_Identifier (Value : in Util.Beans.Objects.Object) return ADO.Identifier is
   begin
      if Util.Beans.Objects.Is_Null (Value) then
         return ADO.NO_IDENTIFIER;
      else
         return ADO.Identifier (Util.Beans.Objects.To_Long_Long_Integer (Value));
      end if;
   end To_Identifier;

   --  ------------------------------
   --  Compute the hash of the identifier.
   --  ------------------------------
   function Hash (Key : in ADO.Identifier) return Ada.Containers.Hash_Type is
      use Ada.Containers;
   begin

      if Key < 0 then
         return Hash_Type (-Key);
      else
         return Hash_Type (Key);
      end if;
   end Hash;

   --  ------------------------------
   --  Return the identifier list as a comma separated list of identifiers.
   --  ------------------------------
   function To_Parameter_List (List : in Identifier_Vector) return String is
      use Identifier_Vectors;

      Result     : Ada.Strings.Unbounded.Unbounded_String;
      Pos        : Identifier_Cursor := List.First;
      Need_Comma : Boolean := False;
   begin
      while Identifier_Vectors.Has_Element (Pos) loop
         if Need_Comma then
            Ada.Strings.Unbounded.Append (Result, ",");
         end if;
         Ada.Strings.Unbounded.Append (Result, ADO.Identifier'Image (Element (Pos)));
         Need_Comma := True;
         Next (Pos);
      end loop;
      return Ada.Strings.Unbounded.To_String (Result);
   end To_Parameter_List;

end ADO.Utils;

Implement the To_Parameter_List operation


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

with Util.Beans.Objects.Maps;

with ASF.Applications;

with AWA.Modules;
with AWA.Events;
with AWA.Mail.Clients;

--  == Documentation ==
--  The *mail* module allows an application to format and send a mail
--  to users.  This module does not define any web interface.  It provides
--  a set of services and methods to send a mail when an event is
--  received.  All this is done through configuration.  The module
--  defines a set of specific ASF components to format and prepare the
--  email.
--
--  == Configuration ==
--  The *mail* module needs some properties to configure the SMTP
--  server.
--
--  ||mail.smtp.host||localhost||Defines the SMTP server host name||
--  ||mail.smtp.port||25||Defines the SMTP connection port||
--  ||mail.smtp.enable||1|||Defines whether sending email is enabled or not||
--
--  == Sending an email ==
--  Sending an email when an event is posted can be done by using
--  an XML configuration.  Basically, the *mail* module uses the event
--  framework provided by AWA.  The XML definition looks like:
--
--    <on-event name="user-register">
--      <action>#{userMail.send}</action>
--      <property name="template">/mail/register-user-message.xhtml</property>
--    </on-event>
--
--  With this definition, the mail template `/mail/register-user-message.xhtml`
--  is formatted by using the event and application context when the
--  `user-register` event is posted.
--
--  @include awa-mail-components.ads
--  @include awa-mail-components-recipients.ads
--  @include awa-mail-components-messages.ads
--
package AWA.Mail.Modules is

   NAME : constant String := "mail";

   type Mail_Module is new AWA.Modules.Module with private;
   type Mail_Module_Access is access all Mail_Module'Class;

   --  Initialize the mail module.
   overriding
   procedure Initialize (Plugin : in out Mail_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config);

   --  Create a new mail message.
   function Create_Message (Plugin : in Mail_Module)
                            return AWA.Mail.Clients.Mail_Message_Access;

   --  Get the mail template that must be used for the given event name.
   --  The mail template is configured by the property: module.template.event.
   function Get_Template (Plugin : in Mail_Module;
                          Name   : in String) return String;

   --  Format and send an email.
   procedure Send_Mail (Plugin   : in Mail_Module;
                        Template : in String;
                        Props    : in Util.Beans.Objects.Maps.Map;
                        Content  : in AWA.Events.Module_Event'Class);

   --  Get the mail module instance associated with the current application.
   function Get_Mail_Module return Mail_Module_Access;

private

   type Mail_Module is new AWA.Modules.Module with record
      Mailer : AWA.Mail.Clients.Mail_Manager_Access;
   end record;

end AWA.Mail.Modules;

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

with Util.Beans.Objects.Maps;

with ASF.Applications;

with AWA.Modules;
with AWA.Events;
with AWA.Mail.Clients;

--  == Documentation ==
--  The *mail* module allows an application to format and send a mail
--  to users.  This module does not define any web interface.  It provides
--  a set of services and methods to send a mail when an event is
--  received.  All this is done through configuration.  The module
--  defines a set of specific ASF components to format and prepare the
--  email.
--
--  == Configuration ==
--  The *mail* module needs some properties to configure the SMTP
--  server.
--
--  ||mail.smtp.host||localhost||Defines the SMTP server host name||
--  ||mail.smtp.port||25||Defines the SMTP connection port||
--  ||mail.smtp.enable||1|||Defines whether sending email is enabled or not||
--
--  == Sending an email ==
--  Sending an email when an event is posted can be done by using
--  an XML configuration.  Basically, the *mail* module uses the event
--  framework provided by AWA.  The XML definition looks like:
--
--    <on-event name="user-register">
--      <action>#{userMail.send}</action>
--      <property name="template">/mail/register-user-message.xhtml</property>
--    </on-event>
--
--  With this definition, the mail template `/mail/register-user-message.xhtml`
--  is formatted by using the event and application context when the
--  `user-register` event is posted.
--
--  @include awa-mail-components.ads
--  @include awa-mail-components-recipients.ads
--  @include awa-mail-components-messages.ads
--
--  == Ada Beans ==
--  @include mail.xml
--
package AWA.Mail.Modules is

   NAME : constant String := "mail";

   type Mail_Module is new AWA.Modules.Module with private;
   type Mail_Module_Access is access all Mail_Module'Class;

   --  Initialize the mail module.
   overriding
   procedure Initialize (Plugin : in out Mail_Module;
                         App    : in AWA.Modules.Application_Access;
                         Props  : in ASF.Applications.Config);

   --  Create a new mail message.
   function Create_Message (Plugin : in Mail_Module)
                            return AWA.Mail.Clients.Mail_Message_Access;

   --  Get the mail template that must be used for the given event name.
   --  The mail template is configured by the property: module.template.event.
   function Get_Template (Plugin : in Mail_Module;
                          Name   : in String) return String;

   --  Format and send an email.
   procedure Send_Mail (Plugin   : in Mail_Module;
                        Template : in String;
                        Props    : in Util.Beans.Objects.Maps.Map;
                        Content  : in AWA.Events.Module_Event'Class);

   --  Get the mail module instance associated with the current application.
   function Get_Mail_Module return Mail_Module_Access;

private

   type Mail_Module is new AWA.Modules.Module with record
      Mailer : AWA.Mail.Clients.Mail_Manager_Access;
   end record;

end AWA.Mail.Modules;

Add the Ada beans in the mail plugin documentation


-----------------------------------------------------------------------
--  wiki-helpers -- Helper operations for wiki parsers and renderer
--  Copyright (C) 2016, 2020, 2022 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.Wide_Wide_Characters.Handling;
with Ada.Wide_Wide_Characters.Unicode;
package body Wiki.Helpers is

   --  ------------------------------
   --  Returns True if the character is a space or tab.
   --  ------------------------------
   function Is_Space (C : in Wiki.Strings.WChar) return Boolean is
   begin
      return Ada.Wide_Wide_Characters.Handling.Is_Space (C) or C = HT or C = NBSP;
   end Is_Space;

   --  ------------------------------
   --  Returns True if the character is a space, tab or a newline.
   --  ------------------------------
   function Is_Space_Or_Newline (C : in Wiki.Strings.WChar) return Boolean is
   begin
      return Is_Space (C) or Ada.Wide_Wide_Characters.Handling.Is_Line_Terminator (C);
   end Is_Space_Or_Newline;

   --  ------------------------------
   --  Returns True if the character is a punctuation character.
   --  ------------------------------
   function Is_Punctuation (C : in Wiki.Strings.WChar) return Boolean is
   begin
      return Ada.Wide_Wide_Characters.Unicode.Is_Punctuation (C);
   end Is_Punctuation;

   --  ------------------------------
   --  Returns True if the character is a line terminator.
   --  ------------------------------
   function Is_Newline (C : in Wiki.Strings.WChar) return Boolean is
   begin
      return Ada.Wide_Wide_Characters.Handling.Is_Line_Terminator (C);
   end Is_Newline;

   --  ------------------------------
   --  Returns True if the text is a valid URL
   --  ------------------------------
   function Is_Url (Text : in Wiki.Strings.WString) return Boolean is
   begin
      if Text'Length <= 9 then
         return False;
      else
         return Text (Text'First .. Text'First + 6) = "http://"
           or Text (Text'First .. Text'First + 7) = "https://";
      end if;
   end Is_Url;

   --  ------------------------------
   --  Returns True if the extension part correspond to an image.
   --  Recognized extension are: .png, .gif, .jpg, .jpeg.
   --  The extension case is ignored.
   --  ------------------------------
   function Is_Image_Extension (Ext : in Wiki.Strings.WString) return Boolean is
      S : constant Wiki.Strings.WString := Ada.Wide_Wide_Characters.Handling.To_Lower (Ext);
   begin
      return S = ".png" or S = ".jpg" or S = ".gif" or S = ".jpeg";
   end Is_Image_Extension;

   --  ------------------------------
   --  Given the current tag on the top of the stack and the new tag that will be pushed,
   --  decide whether the current tag must be closed or not.
   --  Returns True if the current tag must be closed.
   --  ------------------------------
   function Need_Close (Tag         : in Html_Tag;
                        Current_Tag : in Html_Tag) return Boolean is
   begin
      if No_End_Tag (Current_Tag) then
         return True;
      elsif Current_Tag = Tag and Tag_Omission (Current_Tag) then
         return True;
      else
         case Current_Tag is
            when DT_TAG | DD_TAG =>
               return Tag = DD_TAG or Tag = DL_TAG or Tag = DT_TAG;

            when TD_TAG =>
               return Tag = TD_TAG or Tag = TR_TAG or Tag = TH_TAG;

            when TR_TAG =>
               return False;

            when others =>
               return False;

         end case;
      end if;
   end Need_Close;

   --  ------------------------------
   --  Get the dimension represented by the string.  The string has one of the following
   --  formats:
   --    original           -> Width, Height := Natural'Last
   --    default            -> Width := 800, Height := 0
   --    upright            -> Width := 800, Height := 0
   --    <width>px          -> Width := <width>, Height := 0
   --    x<height>px        -> Width := 0, Height := <height>
   --    <width>x<height>px -> Width := <width>, Height := <height>
   --  ------------------------------
   procedure Get_Sizes (Dimension : in Wiki.Strings.WString;
                        Width     : out Natural;
                        Height    : out Natural) is
      Pos  : Natural;
      Last : Natural;
   begin
      if Dimension = "original" then
         Width  := Natural'Last;
         Height := Natural'Last;
      elsif Dimension = "default" or Dimension = "upright" then
         Width  := 800;
         Height := 0;
      else
         Pos  := Wiki.Strings.Index (Dimension, "x");
         Last := Wiki.Strings.Index (Dimension, "px");
         if Pos > Dimension'First and Last + 1 /= Pos then
            Width := Natural'Wide_Wide_Value (Dimension (Dimension'First .. Pos - 1));
         elsif Last > 0 then
            Width := Natural'Wide_Wide_Value (Dimension (Dimension'First .. Last - 1));
         else
            Width := 0;
         end if;
         if Pos < Dimension'Last then
            Height := Natural'Wide_Wide_Value (Dimension (Pos + 1 .. Last - 1));
         else
            Height := 0;
         end if;
      end if;

   exception
      when Constraint_Error =>
         Width  := 0;
         Height := 0;
   end Get_Sizes;

   --  ------------------------------
   --  Find the position of the first non space character in the text starting at the
   --  given position.  Returns Text'Last + 1 if the text only contains spaces.
   --  ------------------------------
   function Skip_Spaces (Text : in Wiki.Strings.Wstring;
                         From : in Positive) return Positive is
      Pos : Positive := From;
   begin
      while Pos <= Text'Last and then Is_Space (Text (Pos)) loop
         Pos := Pos + 1;
      end loop;
      return Pos;
   end Skip_Spaces;

   --  ------------------------------
   --  Find the position of the last non space character scanning the text backward
   --  from the given position.  Returns Text'First - 1 if the text only contains spaces.
   --  ------------------------------
   function Trim_Spaces (Text : in Wiki.Strings.Wstring;
                         From : in Positive) return Natural is
      Pos : Natural := From;
   begin
      while Pos >= Text'First and then Is_Space (Text (Pos)) loop
         Pos := Pos - 1;
      end loop;
      return Pos;
   end Trim_Spaces;

end Wiki.Helpers;

-----------------------------------------------------------------------
--  wiki-helpers -- Helper operations for wiki parsers and renderer
--  Copyright (C) 2016, 2020, 2022 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.Wide_Wide_Characters.Handling;
with Ada.Wide_Wide_Characters.Unicode;
package body Wiki.Helpers is

   --  ------------------------------
   --  Returns True if the character is a space or tab.
   --  ------------------------------
   function Is_Space (C : in Wiki.Strings.WChar) return Boolean is
   begin
      return Ada.Wide_Wide_Characters.Handling.Is_Space (C) or C = HT or C = NBSP;
   end Is_Space;

   --  ------------------------------
   --  Returns True if the character is a space, tab or a newline.
   --  ------------------------------
   function Is_Space_Or_Newline (C : in Wiki.Strings.WChar) return Boolean is
   begin
      return Is_Space (C) or Ada.Wide_Wide_Characters.Handling.Is_Line_Terminator (C);
   end Is_Space_Or_Newline;

   --  ------------------------------
   --  Returns True if the character is a punctuation character.
   --  ------------------------------
   function Is_Punctuation (C : in Wiki.Strings.WChar) return Boolean is
   begin
      return Ada.Wide_Wide_Characters.Unicode.Is_Punctuation (C);
   end Is_Punctuation;

   --  ------------------------------
   --  Returns True if the character is a line terminator.
   --  ------------------------------
   function Is_Newline (C : in Wiki.Strings.WChar) return Boolean is
   begin
      return Ada.Wide_Wide_Characters.Handling.Is_Line_Terminator (C);
   end Is_Newline;

   --  ------------------------------
   --  Returns True if the text is a valid URL
   --  ------------------------------
   function Is_Url (Text : in Wiki.Strings.WString) return Boolean is
   begin
      if Text'Length <= 9 then
         return False;
      else
         return Text (Text'First .. Text'First + 6) = "http://"
           or Text (Text'First .. Text'First + 7) = "https://";
      end if;
   end Is_Url;

   --  ------------------------------
   --  Returns True if the extension part correspond to an image.
   --  Recognized extension are: .png, .gif, .jpg, .jpeg.
   --  The extension case is ignored.
   --  ------------------------------
   function Is_Image_Extension (Ext : in Wiki.Strings.WString) return Boolean is
      S : constant Wiki.Strings.WString := Ada.Wide_Wide_Characters.Handling.To_Lower (Ext);
   begin
      return S = ".png" or S = ".jpg" or S = ".gif" or S = ".jpeg";
   end Is_Image_Extension;

   --  ------------------------------
   --  Given the current tag on the top of the stack and the new tag that will be pushed,
   --  decide whether the current tag must be closed or not.
   --  Returns True if the current tag must be closed.
   --  ------------------------------
   function Need_Close (Tag         : in Html_Tag;
                        Current_Tag : in Html_Tag) return Boolean is
   begin
      if No_End_Tag (Current_Tag) then
         return True;
      elsif Current_Tag = Tag and Tag_Omission (Current_Tag) then
         return True;
      else
         case Current_Tag is
            when DT_TAG | DD_TAG =>
               return Tag = DD_TAG or Tag = DL_TAG or Tag = DT_TAG;

            when TD_TAG =>
               return Tag = TD_TAG or Tag = TR_TAG or Tag = TH_TAG;

            when TR_TAG =>
               return False;

            when others =>
               return False;

         end case;
      end if;
   end Need_Close;

   --  ------------------------------
   --  Get the dimension represented by the string.  The string has one of the following
   --  formats:
   --    original           -> Width, Height := Natural'Last
   --    default            -> Width := 800, Height := 0
   --    upright            -> Width := 800, Height := 0
   --    <width>px          -> Width := <width>, Height := 0
   --    x<height>px        -> Width := 0, Height := <height>
   --    <width>x<height>px -> Width := <width>, Height := <height>
   --  ------------------------------
   procedure Get_Sizes (Dimension : in Wiki.Strings.WString;
                        Width     : out Natural;
                        Height    : out Natural) is
      Pos  : Natural;
      Last : Natural;
   begin
      if Dimension = "original" then
         Width  := Natural'Last;
         Height := Natural'Last;
      elsif Dimension = "default" or Dimension = "upright" then
         Width  := 800;
         Height := 0;
      else
         Pos  := Wiki.Strings.Index (Dimension, "x");
         Last := Wiki.Strings.Index (Dimension, "px");
         if Pos > Dimension'First and Last + 1 /= Pos then
            Width := Natural'Wide_Wide_Value (Dimension (Dimension'First .. Pos - 1));
         elsif Last > 0 then
            Width := Natural'Wide_Wide_Value (Dimension (Dimension'First .. Last - 1));
         else
            Width := 0;
         end if;
         if Pos < Dimension'Last then
            Height := Natural'Wide_Wide_Value (Dimension (Pos + 1 .. Last - 1));
         else
            Height := 0;
         end if;
      end if;

   exception
      when Constraint_Error =>
         Width  := 0;
         Height := 0;
   end Get_Sizes;

   --  ------------------------------
   --  Find the position of the first non space character in the text starting at the
   --  given position.  Returns Text'Last + 1 if the text only contains spaces.
   --  ------------------------------
   function Skip_Spaces (Text : in Wiki.Strings.Wstring;
                         From : in Positive) return Positive is
      Pos : Positive := From;
   begin
      while Pos <= Text'Last and then Is_Space (Text (Pos)) loop
         Pos := Pos + 1;
      end loop;
      return Pos;
   end Skip_Spaces;

   --  ------------------------------
   --  Find the position of the last non space character scanning the text backward
   --  from the given position.  Returns Text'First - 1 if the text only contains spaces.
   --  ------------------------------
   function Trim_Spaces (Text : in Wiki.Strings.Wstring;
                         From : in Positive) return Natural is
      Pos : Natural := From;
   begin
      while Pos >= Text'First and then Is_Space (Text (Pos)) loop
         Pos := Pos - 1;
      end loop;
      return Pos;
   end Trim_Spaces;

   --  ------------------------------
   --  Find the position of the given character in the string starting at the given position.
   --  ------------------------------
   function Index (Text : in Wiki.Strings.Wstring;
                   Item : in Wiki.Strings.Wchar;
                   From : in Positive) return Natural is
      Pos : Natural := From;
   begin
      while Pos <= Text'Last loop
         if Text (Pos) = Item then
            return Pos;
         end if;
         Pos := Pos + 1;
      end loop;
      return 0;
   end Index;

end Wiki.Helpers;

Add Index function

Add Index function