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

--  == 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
--
--  The authentication process is the following:
--
--    * The Initialize procedure is called to configure the OpenID realm and set the
--      OpenID return callback CB.
--    * The Discover procedure is called to retrieve from the OpenID provider the XRDS
--      stream and identify the provider.  An End_Point is returned.
--    * The Associate procedure is called to make the association with the End_Point.
--      The Association record holds session, and authentication.
--    * The Get_Authentication_URL builds the provider OpenID authentication
--      URL for the association.
--    * The application should redirected the user to the authentication URL.
--    * The OpenID provider authenticate the user and redirects the user to the callback CB.
--    * The association is decoded from the callback parameter.
--    * The Verify procedure is called with the association to check the result and
--      obtain the authentication results.
--
--  There are basically two steps that an application must implement.
--
--  [http://ada-security.googlecode.com/svn/wiki/OpenID.png]
--
--  == Discovery: creating the authentication URL ==
--  The first step is to create an authentication URL to which the user must be redirected.
--  In this step, we have to create an OpenId manager, discover the OpenID provider,
--  do the association and get an End_Point.
--
--    Mgr   : Openid.Manager;
--    OP    : Openid.End_Point;
--    Assoc : constant Association_Access := new Association;
--
--  The
--
--    Server.Initialize (Mgr);
--    Mgr.Discover (Provider, OP);  --  Yadis discovery (get the XRDS file).
--    Mgr.Associate (OP, Assoc.all);--  Associate and get an end-point with a key.
--
--  After this first step, you must manage to save the association in the HTTP session.
--  Then you must redirect to the authentication URL that is obtained by using:
--
--    Auth_URL : constant String := Mgr.Get_Authentication_URL (OP, Assoc.all);
--
--  == Verify: acknowledge the authentication in the callback URL ==
--  The second step is done when the user has finished the authentication successfully or not.
--  For this step, the application must get back the association that was saved in the session.
--  It must also prepare a parameters object that allows the OpenID framework to get the
--  URI parameters from the return callback.
--
--    Mgr     : Openid.Manager;
--    Assoc   : Association_Access := ...;  --  Get the association saved in the session.
--    Auth    : Openid.Authentication;
--    Params  : Auth_Params;
--
--  The OpenID manager must be initialized and the Verify procedure is called with
--  the association, parameters and the authentication result.  The Get_Status function
--  must be used to check that the authentication succeeded.
--
--    Server.Initialize (Mgr);
--    Mgr.Verify (Assoc.all, Params, Auth);
--    if Openid.Get_Status (Auth) /= Openid.AUTHENTICATED then ...  -- Failure.
--
--
--
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.Principal with private;
   type Principal_Access is access all Principal'Class;

   --  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 Manager provides the core operations for the OpenID process.
   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.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;

--  == 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
--
--  There are basically two steps that an application must implement.
--
--  [http://ada-security.googlecode.com/svn/wiki/OpenID.png]
--
--  The authentication process is the following:
--
--    * The Initialize procedure is called to configure the OpenID realm and set the
--      OpenID return callback CB.
--    * The Discover procedure is called to retrieve from the OpenID provider the XRDS
--      stream and identify the provider.  An End_Point is returned.
--    * The Associate procedure is called to make the association with the End_Point.
--      The Association record holds session, and authentication.
--    * The Get_Authentication_URL builds the provider OpenID authentication
--      URL for the association.
--    * The application should redirected the user to the authentication URL.
--    * The OpenID provider authenticate the user and redirects the user to the callback CB.
--    * The association is decoded from the callback parameter.
--    * The Verify procedure is called with the association to check the result and
--      obtain the authentication results.
--
--
--  == Discovery: creating the authentication URL ==
--  The first step is to create an authentication URL to which the user must be redirected.
--  In this step, we have to create an OpenId manager, discover the OpenID provider,
--  do the association and get an End_Point.
--
--    Mgr   : Openid.Manager;
--    OP    : Openid.End_Point;
--    Assoc : constant Association_Access := new Association;
--
--  The
--
--    Server.Initialize (Mgr);
--    Mgr.Discover (Provider, OP);  --  Yadis discovery (get the XRDS file).
--    Mgr.Associate (OP, Assoc.all);--  Associate and get an end-point with a key.
--
--  After this first step, you must manage to save the association in the HTTP session.
--  Then you must redirect to the authentication URL that is obtained by using:
--
--    Auth_URL : constant String := Mgr.Get_Authentication_URL (OP, Assoc.all);
--
--  == Verify: acknowledge the authentication in the callback URL ==
--  The second step is done when the user has finished the authentication successfully or not.
--  For this step, the application must get back the association that was saved in the session.
--  It must also prepare a parameters object that allows the OpenID framework to get the
--  URI parameters from the return callback.
--
--    Mgr     : Openid.Manager;
--    Assoc   : Association_Access := ...;  --  Get the association saved in the session.
--    Auth    : Openid.Authentication;
--    Params  : Auth_Params;
--
--  The OpenID manager must be initialized and the Verify procedure is called with
--  the association, parameters and the authentication result.  The Get_Status function
--  must be used to check that the authentication succeeded.
--
--    Server.Initialize (Mgr);
--    Mgr.Verify (Assoc.all, Params, Auth);
--    if Openid.Get_Status (Auth) /= Openid.AUTHENTICATED then ...  -- Failure.
--
--
--
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.Principal with private;
   type Principal_Access is access all Principal'Class;

   --  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 Manager provides the core operations for the OpenID process.
   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.Principal with record
      Auth : Authentication;
   end record;

end Security.Openid;

Update the documentation

Update the documentation


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

with Ada.Tags;
with Ada.Calendar;
with Ada.Unchecked_Deallocation;

with ADO.Sessions.Entities;

with AWA.Users.Models;
with AWA.Events.Models;
with AWA.Services.Contexts;
with AWA.Jobs.Modules;
with AWA.Applications;
with AWA.Events.Services;
with AWA.Modules;
package body AWA.Jobs.Services is

   package ASC renames AWA.Services.Contexts;

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

   --  ------------------------------
   --  Set the job parameter identified by the Name to the value given in Value.
   --  ------------------------------
   procedure Set_Parameter (Job   : in out Abstract_Job_Type;
                            Name  : in String;
                            Value : in String) is
   begin
      Job.Set_Parameter (Name, Util.Beans.Objects.To_Object (Value));
   end Set_Parameter;

   --  ------------------------------
   --  Set the job parameter identified by the Name to the value given in Value.
   --  ------------------------------
   procedure Set_Parameter (Job   : in out Abstract_Job_Type;
                            Name  : in String;
                            Value : in Integer) is
   begin
      Job.Set_Parameter (Name, Util.Beans.Objects.To_Object (Value));
   end Set_Parameter;

   --  ------------------------------
   --  Set the job parameter identified by the Name to the value given in Value.
   --  The value object can hold any kind of basic value type (integer, enum, date, strings).
   --  If the value represents a bean, the <tt>Invalid_Value</tt> exception is raised.
   --  ------------------------------
   procedure Set_Parameter (Job   : in out Abstract_Job_Type;
                            Name  : in String;
                            Value : in Util.Beans.Objects.Object) is
   begin
      Job.Props.Include (Name, Value);
      Job.Props_Modified := True;
   end Set_Parameter;

   --  ------------------------------
   --  Get the job parameter identified by the Name and convert the value into a string.
   --  ------------------------------
   function Get_Parameter (Job  : in Abstract_Job_Type;
                           Name : in String) return String is
      Value : constant Util.Beans.Objects.Object := Job.Get_Parameter (Name);
   begin
      return Util.Beans.Objects.To_String (Value);
   end Get_Parameter;

   --  ------------------------------
   --  Get the job parameter identified by the Name and convert the value as an integer.
   --  If the parameter is not defined, return the default value passed in Default.
   --  ------------------------------
   function Get_Parameter (Job     : in Abstract_Job_Type;
                           Name    : in String;
                           Default : in Integer) return Integer is
      Pos : constant Util.Beans.Objects.Maps.Cursor := Job.Props.Find (Name);
   begin
      if Util.Beans.Objects.Maps.Has_Element (Pos) then
         declare
            Value : constant Util.Beans.Objects.Object := Util.Beans.Objects.Maps.Element (Pos);
         begin
            if Util.Beans.Objects.Is_Null (Value) then
               return Default;
            else
               return Util.Beans.Objects.To_Integer (Value);
            end if;
         end;
      else
         return Default;
      end if;
   end Get_Parameter;

   --  ------------------------------
   --  Get the job parameter identified by the Name and return it as a typed object.
   --  ------------------------------
   function Get_Parameter (Job  : in Abstract_Job_Type;
                           Name : in String) return Util.Beans.Objects.Object is
   begin
      return Job.Props.Element (Name);
   end Get_Parameter;

   --  ------------------------------
   --  Get the job status.
   --  ------------------------------
   function Get_Status (Job : in Abstract_Job_Type) return AWA.Jobs.Models.Job_Status_Type is
   begin
      return Job.Job.Get_Status;
   end Get_Status;

   --  ------------------------------
   --  Set the job status.
   --  When the job is terminated, it is closed and the job parameters or results cannot be
   --  changed.
   --  ------------------------------
   procedure Set_Status (Job    : in out Abstract_Job_Type;
                         Status : in AWA.Jobs.Models.Job_Status_Type) is
   begin
      case Job.Job.Get_Status is
         when AWA.Jobs.Models.CANCELED | Models.FAILED | Models.TERMINATED =>
            raise Closed_Error;

         when Models.SCHEDULED | Models.RUNNING =>
            Job.Job.Set_Status (Status);

      end case;
   end Set_Status;

   --  ------------------------------
   --  Save the job information in the database.  Use the database session defined by DB
   --  to save the job.
   --  ------------------------------
   procedure Save (Job : in out Abstract_Job_Type;
                   DB  : in out ADO.Sessions.Master_Session'Class) is
   begin
      if Job.Results_Modified then
         Job.Job.Set_Results (Util.Serialize.Tools.To_JSON (Job.Results));
         Job.Results_Modified := False;
      end if;
      Job.Job.Save (DB);
   end Save;

   --  Schedule the job.
   procedure Schedule (Job        : in out Abstract_Job_Type;
                       Definition : in Job_Factory'Class) is

      procedure Set_Event (Manager : in out AWA.Events.Services.Event_Manager);

      Ctx : constant ASC.Service_Context_Access := ASC.Current;
      DB   : ADO.Sessions.Master_Session := ASC.Get_Master_Session (Ctx);
      Msg  : AWA.Events.Models.Message_Ref;
      User : constant AWA.Users.Models.User_Ref := Ctx.Get_User;
      Sess : constant AWA.Users.Models.Session_Ref := Ctx.Get_User_Session;
      App  : constant AWA.Applications.Application_Access := Ctx.Get_Application;

      procedure Set_Event (Manager : in out AWA.Events.Services.Event_Manager) is
      begin
         Manager.Set_Message_Type (Msg, Job_Create_Event.Kind);
         Manager.Set_Event_Queue (Msg, "job-queue");
      end Set_Event;

   begin
      if Job.Job.Is_Inserted then
         Log.Error ("Job is already scheduled");
         raise Schedule_Error with "The job is already scheduled.";
      end if;
      AWA.Jobs.Modules.Create_Event (Msg);
      Job.Job.Set_Create_Date (Msg.Get_Create_Date);

      DB.Begin_Transaction;
      Job.Job.Set_Name (Definition.Get_Name);
      Job.Job.Set_User (User);
      Job.Job.Set_Session (Sess);
      Job.Save (DB);

      --  Create the event
      Msg.Set_Parameters (Util.Serialize.Tools.To_JSON (Job.Props));
      App.Do_Event_Manager (Process => Set_Event'Access);
      Msg.Set_User (User);
      Msg.Set_Session (Sess);
      Msg.Set_Entity_Id (Job.Job.Get_Id);
      Msg.Set_Entity_Type (ADO.Sessions.Entities.Find_Entity_Type (Session => DB,
                                                                   Object  => Job.Job.Get_Key));
      Msg.Save (DB);

      Job.Job.Set_Event (Msg);
      Job.Job.Save (DB);
      DB.Commit;
   end Schedule;

   --  ------------------------------
   --  Execute the job and save the job information in the database.
   --  ------------------------------
   procedure Execute (Job : in out Abstract_Job_Type'Class;
                      DB  : in out ADO.Sessions.Master_Session'Class) is
      use type AWA.Jobs.Models.Job_Status_Type;
   begin
      --  Execute the job with an exception guard.
      begin
         Job.Execute;

      exception
         when E : others =>
            Log.Error ("Exception when executing job {0}", Job.Job.Get_Name);
            Log.Error ("Exception:", E, True);
            Job.Job.Set_Status (Models.FAILED);
      end;

      --  If the job did not set a completion status, mark it as terminated.
      if Job.Job.Get_Status = Models.SCHEDULED or Job.Job.Get_Status = Models.RUNNING then
         Job.Job.Set_Status (Models.TERMINATED);
      end if;

      --  And save the job.
      DB.Begin_Transaction;
      Job.Job.Set_Finish_Date (ADO.Nullable_Time '(Is_Null => False,
                                                   Value   => Ada.Calendar.Clock));
      Job.Save (DB);
      DB.Commit;
   end Execute;

   --  ------------------------------
   --  Execute the job associated with the given event.
   --  ------------------------------
   procedure Execute (Event : in AWA.Events.Module_Event'Class) is
      use AWA.Jobs.Modules;
      use type AWA.Modules.Module_Access;

      procedure Free is
         new Ada.Unchecked_Deallocation (Object => Abstract_Job_Type'Class,
                                         Name   => Abstract_Job_Access);

      Ctx    : constant ASC.Service_Context_Access := ASC.Current;
      App    : constant AWA.Applications.Application_Access := Ctx.Get_Application;
      Module : constant AWA.Modules.Module_Access := App.Find_Module (AWA.Jobs.Modules.NAME);
      DB     : ADO.Sessions.Master_Session := ASC.Get_Master_Session (Ctx);
      Job    : AWA.Jobs.Models.Job_Ref;
   begin
      if Module = null then
         Log.Warn ("There is no Job module to execute a job");
         raise Execute_Error;
      end if;
      if not (Module.all in AWA.Jobs.Modules.Job_Module'Class) then
         Log.Warn ("The 'job' module is not a valid module for job execution");
         raise Execute_Error;
      end if;

      DB.Begin_Transaction;
      Job.Load (Session => DB,
                Id      => Event.Get_Entity_Identifier);
      Job.Set_Start_Date (ADO.Nullable_Time '(Is_Null => False, Value => Ada.Calendar.Clock));
      Job.Set_Status (AWA.Jobs.Models.RUNNING);
      Job.Save (Session => DB);
      DB.Commit;

      declare
         Name : constant String := Job.Get_Name;
      begin
         Log.Info ("Restoring job '{0}'", Name);
         declare
            Plugin  : constant Job_Module_Access := Job_Module'Class (Module.all)'Access;
            Factory : constant Job_Factory_Access := Plugin.Find_Factory (Name);
            Work    : AWA.Jobs.Services.Abstract_Job_Access := null;
         begin
            if Factory /= null then
               Work := Factory.Create;
               Work.Job := Job;
               Work.Execute (DB);
               Free (Work);
            else
               Log.Error ("There is no factory to execute job '{0}'", Name);
               Job.Set_Status (AWA.Jobs.Models.FAILED);
               Job.Set_Finish_Date (ADO.Nullable_Time '(Is_Null => False,
                                                        Value   => Ada.Calendar.Clock));
               DB.Begin_Transaction;
               Job.Save (Session => DB);
               DB.Commit;
            end if;
         end;
      end;
   end Execute;

   function Get_Name (Factory : in Job_Factory'Class) return String is
   begin
      return Ada.Tags.Expanded_Name (Factory'Tag);
   end Get_Name;

   procedure Set_Work (Job  : in out Job_Type;
                       Work : in Work_Factory'Class) is
   begin
      Job.Work := Work.Work;
      Job.Job.Set_Name (Work.Get_Name);
   end Set_Work;

   procedure Execute (Job : in out Job_Type) is
   begin
      Job.Work (Job);
   end Execute;

   overriding
   function Create (Factory : in Work_Factory) return Abstract_Job_Access is
   begin
      return new Job_Type '(Ada.Finalization.Limited_Controlled with
                              Work => Factory.Work,
                              others => <>);
   end Create;

   --  ------------------------------
   --  Job Declaration
   --  ------------------------------
   --  The <tt>Definition</tt> package must be instantiated with a given job type to
   --  register the new job definition.
   package body Definition is

      function Create (Factory : in Job_Type_Factory) return Abstract_Job_Access is
         pragma Unreferenced (Factory);
      begin
         return new T;
      end Create;

   end Definition;

end AWA.Jobs.Services;

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

with Ada.Tags;
with Ada.Calendar;
with Ada.Unchecked_Deallocation;

with ADO.Sessions.Entities;

with AWA.Users.Models;
with AWA.Events.Models;
with AWA.Services.Contexts;
with AWA.Jobs.Modules;
with AWA.Applications;
with AWA.Events.Services;
with AWA.Modules;
package body AWA.Jobs.Services is

   package ASC renames AWA.Services.Contexts;

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

   --  ------------------------------
   --  Set the job parameter identified by the Name to the value given in Value.
   --  ------------------------------
   procedure Set_Parameter (Job   : in out Abstract_Job_Type;
                            Name  : in String;
                            Value : in String) is
   begin
      Job.Set_Parameter (Name, Util.Beans.Objects.To_Object (Value));
   end Set_Parameter;

   --  ------------------------------
   --  Set the job parameter identified by the Name to the value given in Value.
   --  ------------------------------
   procedure Set_Parameter (Job   : in out Abstract_Job_Type;
                            Name  : in String;
                            Value : in Integer) is
   begin
      Job.Set_Parameter (Name, Util.Beans.Objects.To_Object (Value));
   end Set_Parameter;

   --  ------------------------------
   --  Set the job parameter identified by the Name to the value given in Value.
   --  The value object can hold any kind of basic value type (integer, enum, date, strings).
   --  If the value represents a bean, the <tt>Invalid_Value</tt> exception is raised.
   --  ------------------------------
   procedure Set_Parameter (Job   : in out Abstract_Job_Type;
                            Name  : in String;
                            Value : in Util.Beans.Objects.Object) is
   begin
      Job.Props.Include (Name, Value);
      Job.Props_Modified := True;
   end Set_Parameter;

   --  ------------------------------
   --  Get the job parameter identified by the Name and convert the value into a string.
   --  ------------------------------
   function Get_Parameter (Job  : in Abstract_Job_Type;
                           Name : in String) return String is
      Value : constant Util.Beans.Objects.Object := Job.Get_Parameter (Name);
   begin
      return Util.Beans.Objects.To_String (Value);
   end Get_Parameter;

   --  ------------------------------
   --  Get the job parameter identified by the Name and convert the value as an integer.
   --  If the parameter is not defined, return the default value passed in Default.
   --  ------------------------------
   function Get_Parameter (Job     : in Abstract_Job_Type;
                           Name    : in String;
                           Default : in Integer) return Integer is
      Pos : constant Util.Beans.Objects.Maps.Cursor := Job.Props.Find (Name);
   begin
      if Util.Beans.Objects.Maps.Has_Element (Pos) then
         declare
            Value : constant Util.Beans.Objects.Object := Util.Beans.Objects.Maps.Element (Pos);
         begin
            if Util.Beans.Objects.Is_Null (Value) then
               return Default;
            else
               return Util.Beans.Objects.To_Integer (Value);
            end if;
         end;
      else
         return Default;
      end if;
   end Get_Parameter;

   --  ------------------------------
   --  Get the job parameter identified by the Name and return it as a typed object.
   --  ------------------------------
   function Get_Parameter (Job  : in Abstract_Job_Type;
                           Name : in String) return Util.Beans.Objects.Object is
   begin
      return Job.Props.Element (Name);
   end Get_Parameter;

   --  ------------------------------
   --  Get the job status.
   --  ------------------------------
   function Get_Status (Job : in Abstract_Job_Type) return AWA.Jobs.Models.Job_Status_Type is
   begin
      return Job.Job.Get_Status;
   end Get_Status;

   --  ------------------------------
   --  Set the job status.
   --  When the job is terminated, it is closed and the job parameters or results cannot be
   --  changed.
   --  ------------------------------
   procedure Set_Status (Job    : in out Abstract_Job_Type;
                         Status : in AWA.Jobs.Models.Job_Status_Type) is
   begin
      case Job.Job.Get_Status is
         when AWA.Jobs.Models.CANCELED | Models.FAILED | Models.TERMINATED =>
            raise Closed_Error;

         when Models.SCHEDULED | Models.RUNNING =>
            Job.Job.Set_Status (Status);

      end case;
   end Set_Status;

   --  ------------------------------
   --  Save the job information in the database.  Use the database session defined by DB
   --  to save the job.
   --  ------------------------------
   procedure Save (Job : in out Abstract_Job_Type;
                   DB  : in out ADO.Sessions.Master_Session'Class) is
   begin
      if Job.Results_Modified then
         Job.Job.Set_Results (Util.Serialize.Tools.To_JSON (Job.Results));
         Job.Results_Modified := False;
      end if;
      Job.Job.Save (DB);
   end Save;

   --  Schedule the job.
   procedure Schedule (Job        : in out Abstract_Job_Type;
                       Definition : in Job_Factory'Class) is

      procedure Set_Event (Manager : in out AWA.Events.Services.Event_Manager);

      Ctx : constant ASC.Service_Context_Access := ASC.Current;
      DB   : ADO.Sessions.Master_Session := ASC.Get_Master_Session (Ctx);
      Msg  : AWA.Events.Models.Message_Ref;
      User : constant AWA.Users.Models.User_Ref := Ctx.Get_User;
      Sess : constant AWA.Users.Models.Session_Ref := Ctx.Get_User_Session;
      App  : constant AWA.Applications.Application_Access := Ctx.Get_Application;

      procedure Set_Event (Manager : in out AWA.Events.Services.Event_Manager) is
      begin
         Manager.Set_Message_Type (Msg, Job_Create_Event.Kind);
         Manager.Set_Event_Queue (Msg, "job-queue");
      end Set_Event;

   begin
      if Job.Job.Is_Inserted then
         Log.Error ("Job is already scheduled");
         raise Schedule_Error with "The job is already scheduled.";
      end if;
      AWA.Jobs.Modules.Create_Event (Msg);
      Job.Job.Set_Create_Date (Msg.Get_Create_Date);

      DB.Begin_Transaction;
      Job.Job.Set_Name (Definition.Get_Name);
      Job.Job.Set_User (User);
      Job.Job.Set_Session (Sess);
      Job.Save (DB);

      --  Create the event
      Msg.Set_Parameters (Util.Serialize.Tools.To_JSON (Job.Props));
      App.Do_Event_Manager (Process => Set_Event'Access);
      Msg.Set_User (User);
      Msg.Set_Session (Sess);
      Msg.Set_Entity_Id (Job.Job.Get_Id);
      Msg.Set_Entity_Type (ADO.Sessions.Entities.Find_Entity_Type (Session => DB,
                                                                   Object  => Job.Job.Get_Key));
      Msg.Save (DB);

      Job.Job.Set_Event (Msg);
      Job.Job.Save (DB);
      DB.Commit;
   end Schedule;

   --  ------------------------------
   --  Execute the job and save the job information in the database.
   --  ------------------------------
   procedure Execute (Job : in out Abstract_Job_Type'Class;
                      DB  : in out ADO.Sessions.Master_Session'Class) is
      use type AWA.Jobs.Models.Job_Status_Type;
   begin
      --  Execute the job with an exception guard.
      begin
         Job.Execute;

      exception
         when E : others =>
            Log.Error ("Exception when executing job {0}", Job.Job.Get_Name);
            Log.Error ("Exception:", E, True);
            Job.Job.Set_Status (Models.FAILED);
      end;

      --  If the job did not set a completion status, mark it as terminated.
      if Job.Job.Get_Status = Models.SCHEDULED or Job.Job.Get_Status = Models.RUNNING then
         Job.Job.Set_Status (Models.TERMINATED);
      end if;

      --  And save the job.
      DB.Begin_Transaction;
      Job.Job.Set_Finish_Date (ADO.Nullable_Time '(Is_Null => False,
                                                   Value   => Ada.Calendar.Clock));
      Job.Save (DB);
      DB.Commit;
   end Execute;

   --  ------------------------------
   --  Execute the job associated with the given event.
   --  ------------------------------
   procedure Execute (Event : in AWA.Events.Module_Event'Class) is
      use AWA.Jobs.Modules;
      use type AWA.Modules.Module_Access;

      procedure Free is
         new Ada.Unchecked_Deallocation (Object => Abstract_Job_Type'Class,
                                         Name   => Abstract_Job_Access);

      Ctx    : constant ASC.Service_Context_Access := ASC.Current;
      App    : constant AWA.Applications.Application_Access := Ctx.Get_Application;
      Module : constant AWA.Modules.Module_Access := App.Find_Module (AWA.Jobs.Modules.NAME);
      DB     : ADO.Sessions.Master_Session := ASC.Get_Master_Session (Ctx);
      Job    : AWA.Jobs.Models.Job_Ref;
   begin
      if Module = null then
         Log.Warn ("There is no Job module to execute a job");
         raise Execute_Error;
      end if;
      if not (Module.all in AWA.Jobs.Modules.Job_Module'Class) then
         Log.Warn ("The 'job' module is not a valid module for job execution");
         raise Execute_Error;
      end if;

      DB.Begin_Transaction;
      Job.Load (Session => DB,
                Id      => Event.Get_Entity_Identifier);
      Job.Set_Start_Date (ADO.Nullable_Time '(Is_Null => False, Value => Ada.Calendar.Clock));
      Job.Set_Status (AWA.Jobs.Models.RUNNING);
      Job.Save (Session => DB);
      DB.Commit;

      declare
         Name : constant String := Job.Get_Name;
      begin
         Log.Info ("Restoring job '{0}'", Name);
         declare
            Plugin  : constant Job_Module_Access := Job_Module'Class (Module.all)'Access;
            Factory : constant Job_Factory_Access := Plugin.Find_Factory (Name);
            Work    : AWA.Jobs.Services.Abstract_Job_Access := null;
         begin
            if Factory /= null then
               Work := Factory.Create;
               Work.Job := Job;
               Event.Copy (Work.Props);
               Work.Execute (DB);
               Free (Work);
            else
               Log.Error ("There is no factory to execute job '{0}'", Name);
               Job.Set_Status (AWA.Jobs.Models.FAILED);
               Job.Set_Finish_Date (ADO.Nullable_Time '(Is_Null => False,
                                                        Value   => Ada.Calendar.Clock));
               DB.Begin_Transaction;
               Job.Save (Session => DB);
               DB.Commit;
            end if;
         end;
      end;
   end Execute;

   function Get_Name (Factory : in Job_Factory'Class) return String is
   begin
      return Ada.Tags.Expanded_Name (Factory'Tag);
   end Get_Name;

   procedure Set_Work (Job  : in out Job_Type;
                       Work : in Work_Factory'Class) is
   begin
      Job.Work := Work.Work;
      Job.Job.Set_Name (Work.Get_Name);
   end Set_Work;

   procedure Execute (Job : in out Job_Type) is
   begin
      Job.Work (Job);
   end Execute;

   overriding
   function Create (Factory : in Work_Factory) return Abstract_Job_Access is
   begin
      return new Job_Type '(Ada.Finalization.Limited_Controlled with
                              Work => Factory.Work,
                              others => <>);
   end Create;

   --  ------------------------------
   --  Job Declaration
   --  ------------------------------
   --  The <tt>Definition</tt> package must be instantiated with a given job type to
   --  register the new job definition.
   package body Definition is

      function Create (Factory : in Job_Type_Factory) return Abstract_Job_Access is
         pragma Unreferenced (Factory);
      begin
         return new T;
      end Create;

   end Definition;

end AWA.Jobs.Services;

Copy the event properties to the job properties so that the job parameters are available


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

with Ada.Unchecked_Deallocation;

with Util.Beans.Basic;
with Util.Beans.Objects;
with Util.Beans.Methods;

with ASF.Sessions;
with ASF.Events.Actions;
with ASF.Contexts.Faces;

with AWA.Users.Principals;
package body AWA.Users.Beans is

   use AWA.Users.Model;

   --  Action to register a user
   procedure Register_User (Data    : in out Authenticate_Bean;
                            Outcome : in out Unbounded_String) is
      User  : User_Ref;
      Email : Email_Ref;
   begin
      Email.Set_Email (Data.Email);
      User.Set_First_Name (Data.First_Name);
      User.Set_Last_Name (Data.Last_Name);
      User.Set_Password (Data.Password);
      Data.Manager.Create_User (User  => User,
                                Email => Email);
      Outcome := To_Unbounded_String ("success");
   end Register_User;

   --  Action to verify the user after the registration
   procedure Verify_User (Data    : in out Authenticate_Bean;
                          Outcome : in out Unbounded_String) is
      User    : User_Ref;
      Session : Session_Ref;
   begin
      Data.Manager.Verify_User (Key     => To_String (Data.Access_Key),
                                User    => User,
                                IpAddr  => "",
                                Session => Session);

      Outcome := To_Unbounded_String ("success");
   end Verify_User;

   --  Action to trigger the lost password email process.
   procedure Lost_Password (Data    : in out Authenticate_Bean;
                            Outcome : in out Unbounded_String) is
   begin
      Data.Manager.Lost_Password (Email => To_String (Data.Email));
      Outcome := To_Unbounded_String ("success");
   end Lost_Password;

   --  Action to validate the reset password key and set a new password.
   procedure Reset_Password (Data    : in out Authenticate_Bean;
                             Outcome : in out Unbounded_String) is
      User    : User_Ref;
      Session : Session_Ref;
   begin
      Data.Manager.Reset_Password (Key      => To_String (Data.Access_Key),
                                   Password => To_String (Data.Password),
                                   IpAddr   => "",
                                   User     => User,
                                   Session  => Session);
      Outcome := To_Unbounded_String ("success");
   end Reset_Password;

   procedure Set_Session_Principal (Data : in Authenticate_Bean;
                                    User : in AWA.Users.Model.User_Ref) is
      Principal : AWA.Users.Principals.Principal_Access := AWA.Users.Principals.Create (User);
      Ctx       : ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      Session   : ASF.Sessions.Session := Ctx.Get_Session (Create => True);
      Name      : constant String := "User: " & User.Get_Name;
   begin
      Session.Set_Principal (Principal.all'Access);
      Session.Set_Attribute (Name  => "user",
                             Value => Util.Beans.Objects.To_Object (Name));
   end Set_Session_Principal;

   --  Action to authenticate a user.
   procedure Authenticate_User (Data    : in out Authenticate_Bean;
                                Outcome : in out Unbounded_String) is
      User      : User_Ref;
      Session   : Session_Ref;
   begin
      Data.Manager.Authenticate (Email    => To_String (Data.Email),
                                 Password => To_String (Data.Password),
                                 IpAddr   => "",
                                 User     => User,
                                 Session  => Session);
      Outcome := To_Unbounded_String ("success");

      Data.Set_Session_Principal (User);
   end Authenticate_User;

   --  Create an authenticate bean.
   function Create_Authenticate_Bean (Module : in AWA.Users.Module.User_Module_Access)
                                      return Util.Beans.Basic.Readonly_Bean_Access is
      Object : Authenticate_Bean_Access := new Authenticate_Bean;
   begin
      Object.Module := Module;
      Object.Manager := AWA.Users.Logic.Create_User_Manager (Module);
      return Object.all'Access;
   end Create_Authenticate_Bean;

   --  The code below this line could be generated automatically by an Asis tool.

   package Authenticate_Binding is
     new ASF.Events.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                Method => Authenticate_User,
                                                Name   => "authenticate");

   package Register_Binding is
     new ASF.Events.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                Method => Register_User,
                                                Name   => "register");

   package Verify_Binding is
     new ASF.Events.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                Method => Verify_User,
                                                Name   => "verify");

   package Lost_Password_Binding is
     new ASF.Events.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                Method => Lost_Password,
                                                Name   => "lostPassword");

   package Reset_Password_Binding is
     new ASF.Events.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                Method => Reset_Password,
                                                Name   => "resetPassword");

   Binding_Array : aliased constant Util.Beans.Methods.Method_Binding_Array
     := (Authenticate_Binding.Proxy'Unchecked_Access,
         Register_Binding.Proxy'Unchecked_Access,
         Verify_Binding.Proxy'Unchecked_Access,
         Lost_Password_Binding.Proxy'Unchecked_Access,
         Reset_Password_Binding.Proxy'Unchecked_Access);

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Authenticate_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "email" then
         return Util.Beans.Objects.To_Object (From.Email);
      elsif Name = "password" then
         return Util.Beans.Objects.To_Object (From.Password);
      elsif Name = "key" then
         return Util.Beans.Objects.To_Object (From.Access_Key);
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Authenticate_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "email" then
         From.Email := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = "password" then
         From.Password := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = "key" then
         From.Access_Key := Util.Beans.Objects.To_Unbounded_String (Value);
      end if;
   end Set_Value;

   --  This bean provides some methods that can be used in a Method_Expression
   overriding
   function Get_Method_Bindings (From : in Authenticate_Bean)
                                 return Util.Beans.Methods.Method_Binding_Array_Access is
   begin
      return Binding_Array'Unchecked_Access;
   end Get_Method_Bindings;

end AWA.Users.Beans;

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

with Ada.Unchecked_Deallocation;

with Util.Beans.Basic;
with Util.Beans.Objects;
with Util.Beans.Methods;

with ASF.Sessions;
with ASF.Events.Actions;
with ASF.Contexts.Faces;

with AWA.Users.Principals;
package body AWA.Users.Beans is

   use AWA.Users.Model;

   --  Action to register a user
   procedure Register_User (Data    : in out Authenticate_Bean;
                            Outcome : in out Unbounded_String) is
      User  : User_Ref;
      Email : Email_Ref;
   begin
      Email.Set_Email (Data.Email);
      User.Set_First_Name (Data.First_Name);
      User.Set_Last_Name (Data.Last_Name);
      User.Set_Password (Data.Password);
      Data.Manager.Create_User (User  => User,
                                Email => Email);
      Outcome := To_Unbounded_String ("success");
   end Register_User;

   --  Action to verify the user after the registration
   procedure Verify_User (Data    : in out Authenticate_Bean;
                          Outcome : in out Unbounded_String) is
      User    : User_Ref;
      Session : Session_Ref;
   begin
      Data.Manager.Verify_User (Key     => To_String (Data.Access_Key),
                                User    => User,
                                IpAddr  => "",
                                Session => Session);

      Outcome := To_Unbounded_String ("success");
   end Verify_User;

   --  Action to trigger the lost password email process.
   procedure Lost_Password (Data    : in out Authenticate_Bean;
                            Outcome : in out Unbounded_String) is
   begin
      Data.Manager.Lost_Password (Email => To_String (Data.Email));
      Outcome := To_Unbounded_String ("success");
   end Lost_Password;

   --  Action to validate the reset password key and set a new password.
   procedure Reset_Password (Data    : in out Authenticate_Bean;
                             Outcome : in out Unbounded_String) is
      User    : User_Ref;
      Session : Session_Ref;
   begin
      Data.Manager.Reset_Password (Key      => To_String (Data.Access_Key),
                                   Password => To_String (Data.Password),
                                   IpAddr   => "",
                                   User     => User,
                                   Session  => Session);
      Outcome := To_Unbounded_String ("success");
   end Reset_Password;

   procedure Set_Session_Principal (Data : in Authenticate_Bean;
                                    User : in AWA.Users.Model.User_Ref) is
      Principal : AWA.Users.Principals.Principal_Access := AWA.Users.Principals.Create (User);
      Ctx       : ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      Session   : ASF.Sessions.Session := Ctx.Get_Session (Create => True);
      Name      : constant String := "User: " & User.Get_Name;
   begin
      Session.Set_Principal (Principal.all'Access);
      Session.Set_Attribute (Name  => "user",
                             Value => Util.Beans.Objects.To_Object (Name));
   end Set_Session_Principal;

   --  Action to authenticate a user.
   procedure Authenticate_User (Data    : in out Authenticate_Bean;
                                Outcome : in out Unbounded_String) is
      User      : User_Ref;
      Session   : Session_Ref;
   begin
      Data.Manager.Authenticate (Email    => To_String (Data.Email),
                                 Password => To_String (Data.Password),
                                 IpAddr   => "",
                                 User     => User,
                                 Session  => Session);
      Outcome := To_Unbounded_String ("success");

      Data.Set_Session_Principal (User);
   end Authenticate_User;

   --  Create an authenticate bean.
   function Create_Authenticate_Bean (Module : in AWA.Users.Module.User_Module_Access)
                                      return Util.Beans.Basic.Readonly_Bean_Access is
      Object : Authenticate_Bean_Access := new Authenticate_Bean;
   begin
      Object.Module := Module;
      Object.Manager := AWA.Users.Logic.Create_User_Manager (Module);
      return Object.all'Access;
   end Create_Authenticate_Bean;

   --  The code below this line could be generated automatically by an Asis tool.

   package Authenticate_Binding is
     new ASF.Events.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                Method => Authenticate_User,
                                                Name   => "authenticate");

   package Register_Binding is
     new ASF.Events.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                Method => Register_User,
                                                Name   => "register");

   package Verify_Binding is
     new ASF.Events.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                Method => Verify_User,
                                                Name   => "verify");

   package Lost_Password_Binding is
     new ASF.Events.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                Method => Lost_Password,
                                                Name   => "lostPassword");

   package Reset_Password_Binding is
     new ASF.Events.Actions.Action_Method.Bind (Bean   => Authenticate_Bean,
                                                Method => Reset_Password,
                                                Name   => "resetPassword");

   Binding_Array : aliased constant Util.Beans.Methods.Method_Binding_Array
     := (Authenticate_Binding.Proxy'Access,
         Register_Binding.Proxy'Access,
         Verify_Binding.Proxy'Access,
         Lost_Password_Binding.Proxy'Access,
         Reset_Password_Binding.Proxy'Access);

   --  Get the value identified by the name.
   overriding
   function Get_Value (From : in Authenticate_Bean;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "email" then
         return Util.Beans.Objects.To_Object (From.Email);
      elsif Name = "password" then
         return Util.Beans.Objects.To_Object (From.Password);
      elsif Name = "key" then
         return Util.Beans.Objects.To_Object (From.Access_Key);
      else
         return Util.Beans.Objects.Null_Object;
      end if;
   end Get_Value;

   --  Set the value identified by the name.
   overriding
   procedure Set_Value (From  : in out Authenticate_Bean;
                        Name  : in String;
                        Value : in Util.Beans.Objects.Object) is
   begin
      if Name = "email" then
         From.Email := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = "password" then
         From.Password := Util.Beans.Objects.To_Unbounded_String (Value);
      elsif Name = "key" then
         From.Access_Key := Util.Beans.Objects.To_Unbounded_String (Value);
      end if;
   end Set_Value;

   --  This bean provides some methods that can be used in a Method_Expression
   overriding
   function Get_Method_Bindings (From : in Authenticate_Bean)
                                 return Util.Beans.Methods.Method_Binding_Array_Access is
   begin
      return Binding_Array'Access;
   end Get_Method_Bindings;

end AWA.Users.Beans;

Replace Unchecked_Access by Access since the objects are declared at package level scope


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

with System;

with Util.Streams.Buffered;

with MAT.Types;
with MAT.Events;
package MAT.Readers is

   type Buffer_Type is private;
   type Buffer_Ptr is access all Buffer_Type;

   type Message_Type is record
      Kind   : MAT.Events.Event_Type;
      Size   : Natural;
      Buffer : Buffer_Ptr;
   end record;
   subtype Message is Message_Type;

private

   type Endian_Type is (BIG_ENDIAN, LITTLE_ENDIAN);

   type Buffer_Type is record
      Current : System.Address;
      Start   : System.Address;
      Last    : System.Address;
      Buffer  : Util.Streams.Buffered.Buffer_Access;
      Size    : Natural;
      Total   : Natural;
      Endian  : Endian_Type := LITTLE_ENDIAN;
   end record;

end MAT.Readers;

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

with System;

with Util.Streams.Buffered;

--  with MAT.Types;
with MAT.Events;
package MAT.Readers is

   type Buffer_Type is private;
   type Buffer_Ptr is access all Buffer_Type;

   type Message_Type is record
      Kind   : MAT.Events.Event_Type;
      Size   : Natural;
      Buffer : Buffer_Ptr;
   end record;
   subtype Message is Message_Type;

private

   type Endian_Type is (BIG_ENDIAN, LITTLE_ENDIAN);

   type Buffer_Type is record
      Current : System.Address;
      Start   : System.Address;
      Last    : System.Address;
      Buffer  : Util.Streams.Buffered.Buffer_Access;
      Size    : Natural;
      Total   : Natural;
      Endian  : Endian_Type := LITTLE_ENDIAN;
   end record;

end MAT.Readers;

Fix compilation warnings

Fix compilation warnings


-----------------------------------------------------------------------
--  gen-commands-page -- Page creation command for dynamo
--  Copyright (C) 2011, 2012, 2013, 2014, 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.Directories;
with Ada.Text_IO;
with Gen.Artifacts;
with Util.Strings;

package body Gen.Commands.Page is

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   overriding
   procedure Execute (Cmd       : in Command;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Name);
      use Ada.Strings.Unbounded;

      function Get_Layout return String;
      function Get_Name return String;

      Dir    : constant String := Generator.Get_Result_Directory & "web/";

      function Get_Name return String is
         Name : constant String := Args.Get_Argument (1);
         Pos  : constant Natural := Util.Strings.Rindex (Name, '.');
      begin
         if Pos = 0 then
            return Name;
         elsif Name (Pos .. Name'Last) = ".xhtml" then
            return Name (Name'First .. Pos - 1);
         elsif Name (Pos .. Name'Last) = ".html" then
            return Name (Name'First .. Pos - 1);
         else
            return Name;
         end if;
      end Get_Name;

      function Get_Layout return String is
      begin
         if Args.Get_Count = 1 then
            return "layout";
         end if;
         declare
            Layout : constant String := Args.Get_Argument (2);
         begin
            if Ada.Directories.Exists (Dir & "WEB-INF/layouts/" & Layout & ".xhtml") then
               return Layout;
            end if;

            Generator.Info ("Layout file {0} not found.", Layout);
            return Layout;
         end;
      end Get_Layout;

   begin
      if Args.Get_Count = 0 or Args.Get_Count > 2 then
         Gen.Commands.Usage;
         return;
      end if;

      Generator.Set_Force_Save (False);
      Generator.Set_Result_Directory (Dir);
      Generator.Set_Global ("pageName", Get_Name);
      Generator.Set_Global ("layout", Get_Layout);
      Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE, "page");
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Cmd : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd);
      use Ada.Text_IO;
      use Ada.Directories;

      Path    : constant String := Generator.Get_Result_Directory & "web/WEB-INF/layouts";
      Filter  : constant Filter_Type := (Ordinary_File => True, others => False);
      Search  : Search_Type;
      Ent     : Directory_Entry_Type;
   begin
      Put_Line ("add-page: Add a new web page to the application");
      Put_Line ("Usage: add-page NAME [LAYOUT]");
      New_Line;
      Put_Line ("  The web page is an XHTML file created under the 'web' directory.");
      Put_Line ("  The NAME can contain a directory that will be created if necessary.");
      Put_Line ("  The new web page can be configured to use the given layout.");
      Put_Line ("  The layout file must exist to be used.  The default layout is 'layout'.");
      Put_Line ("  You can create a new layout with 'add-layout' command.");
      Put_Line ("  You can also write your layout by adding an XHTML file in the directory:");
      Put_Line ("     " & Path);
      if Exists (Path) then
         New_Line;
         Put_Line ("  Available layouts:");

         Start_Search (Search, Directory => Path, Pattern => "*.xhtml", Filter => Filter);
         while More_Entries (Search) loop
            Get_Next_Entry (Search, Ent);
            declare
               Name   : constant String := Simple_Name (Ent);
               Layout : constant String := Base_Name (Name);
            begin
               Put_Line ("      " & Layout);
            end;
         end loop;
      end if;
      New_Line;
      Put_Line ("  The following files are generated:");
      Put_Line ("    web/<name>.xhtml");
   end Help;

end Gen.Commands.Page;

-----------------------------------------------------------------------
--  gen-commands-page -- Page creation command for dynamo
--  Copyright (C) 2011, 2012, 2013, 2014, 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.Directories;
with Ada.Text_IO;
with Gen.Artifacts;
with Util.Strings;

package body Gen.Commands.Page is

   --  ------------------------------
   --  Execute the command with the arguments.
   --  ------------------------------
   overriding
   procedure Execute (Cmd       : in Command;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Name);
      use Ada.Strings.Unbounded;

      function Get_Layout return String;
      function Get_Name return String;

      Dir    : constant String := Generator.Get_Result_Directory & "web/";

      function Get_Name return String is
         Name : constant String := Args.Get_Argument (1);
         Pos  : constant Natural := Util.Strings.Rindex (Name, '.');
      begin
         if Pos = 0 then
            return Name;
         elsif Name (Pos .. Name'Last) = ".xhtml" then
            return Name (Name'First .. Pos - 1);
         elsif Name (Pos .. Name'Last) = ".html" then
            return Name (Name'First .. Pos - 1);
         else
            return Name;
         end if;
      end Get_Name;

      function Get_Layout return String is
      begin
         if Args.Get_Count = 1 then
            return "layout";
         end if;
         declare
            Layout : constant String := Args.Get_Argument (2);
         begin
            if Ada.Directories.Exists (Dir & "WEB-INF/layouts/" & Layout & ".xhtml") then
               return Layout;
            end if;

            Generator.Info ("Layout file {0} not found.", Layout);
            return Layout;
         end;
      end Get_Layout;

   begin
      if Args.Get_Count = 0 or Args.Get_Count > 2 then
         Cmd.Usage;
         return;
      end if;

      Generator.Set_Force_Save (False);
      Generator.Set_Result_Directory (Dir);
      Generator.Set_Global ("pageName", Get_Name);
      Generator.Set_Global ("layout", Get_Layout);
      Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE, "page");
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Cmd : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd);
      use Ada.Text_IO;
      use Ada.Directories;

      Path    : constant String := Generator.Get_Result_Directory & "web/WEB-INF/layouts";
      Filter  : constant Filter_Type := (Ordinary_File => True, others => False);
      Search  : Search_Type;
      Ent     : Directory_Entry_Type;
   begin
      Put_Line ("add-page: Add a new web page to the application");
      Put_Line ("Usage: add-page NAME [LAYOUT]");
      New_Line;
      Put_Line ("  The web page is an XHTML file created under the 'web' directory.");
      Put_Line ("  The NAME can contain a directory that will be created if necessary.");
      Put_Line ("  The new web page can be configured to use the given layout.");
      Put_Line ("  The layout file must exist to be used.  The default layout is 'layout'.");
      Put_Line ("  You can create a new layout with 'add-layout' command.");
      Put_Line ("  You can also write your layout by adding an XHTML file in the directory:");
      Put_Line ("     " & Path);
      if Exists (Path) then
         New_Line;
         Put_Line ("  Available layouts:");

         Start_Search (Search, Directory => Path, Pattern => "*.xhtml", Filter => Filter);
         while More_Entries (Search) loop
            Get_Next_Entry (Search, Ent);
            declare
               Name   : constant String := Simple_Name (Ent);
               Layout : constant String := Base_Name (Name);
            begin
               Put_Line ("      " & Layout);
            end;
         end loop;
      end if;
      New_Line;
      Put_Line ("  The following files are generated:");
      Put_Line ("    web/<name>.xhtml");
   end Help;

end Gen.Commands.Page;

Use the command usage procedure to report the program usage


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

with Wiki.Attributes;
with Wiki.Documents;
with Wiki.Filters;

--  == Plugins ==
--  The <b>Wiki.Plugins</b> package defines the plugin interface that is used by the wiki
--  engine to provide pluggable extensions in the Wiki.
--
package Wiki.Plugins is

   pragma Preelaborate;

   type Plugin_Context;

   type Wiki_Plugin is limited interface;
   type Wiki_Plugin_Access is access all Wiki_Plugin'Class;
   type Plugin_Factory is limited Interface;
   type Plugin_Factory_Access is access all Plugin_Factory'Class;

   --  Find a plugin knowing its name.
   function Find (Factory : in Plugin_Factory;
                  Name    : in String) return Wiki_Plugin_Access is abstract;

   type Plugin_Context is limited record
      Filters   : Wiki.Filters.Filter_Chain;
      Factory   : Plugin_Factory_Access;
      Variables : Wiki.Attributes.Attribute_List;
   end record;

   --  Expand the plugin configured with the parameters for the document.
   procedure Expand (Plugin   : in out Wiki_Plugin;
                     Document : in out Wiki.Documents.Document;
                     Params   : in out Wiki.Attributes.Attribute_List;
                     Context  : in Plugin_Context) is abstract;

end Wiki.Plugins;

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

with Wiki.Attributes;
with Wiki.Documents;
with Wiki.Filters;

--  == Plugins ==
--  The <b>Wiki.Plugins</b> package defines the plugin interface that is used by the wiki
--  engine to provide pluggable extensions in the Wiki.
--
package Wiki.Plugins is

   pragma Preelaborate;

   type Plugin_Context;

   type Wiki_Plugin is limited interface;
   type Wiki_Plugin_Access is access all Wiki_Plugin'Class;
   type Plugin_Factory is limited Interface;
   type Plugin_Factory_Access is access all Plugin_Factory'Class;

   --  Find a plugin knowing its name.
   function Find (Factory : in Plugin_Factory;
                  Name    : in String) return Wiki_Plugin_Access is abstract;

   type Plugin_Context is limited record
      Filters   : Wiki.Filters.Filter_Chain;
      Factory   : Plugin_Factory_Access;
      Variables : Wiki.Attributes.Attribute_List;
      Syntax    : Wiki.Wiki_Syntax;
   end record;

   --  Expand the plugin configured with the parameters for the document.
   procedure Expand (Plugin   : in out Wiki_Plugin;
                     Document : in out Wiki.Documents.Document;
                     Params   : in out Wiki.Attributes.Attribute_List;
                     Context  : in Plugin_Context) is abstract;

end Wiki.Plugins;

Add the wiki syntax to the Plugin_Context