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

with Ada.Strings.Unbounded;

with Util.Log.Loggers;

with ASF.Cookies;
with ASF.Applications.Main;

with Security.Contexts;
with Security.Policies.Urls;
package body ASF.Security.Filters is

   use Util.Log;

   --  The logger
   Log : constant Loggers.Logger := Loggers.Create ("Security.Filters");

   --  ------------------------------
   --  Called by the servlet container to indicate to a servlet that the servlet
   --  is being placed into service.
   --  ------------------------------
   procedure Initialize (Server  : in out Auth_Filter;
                         Context : in ASF.Servlets.Servlet_Registry'Class) is
      use ASF.Applications.Main;
   begin
      if Context in Application'Class then
         Server.Set_Permission_Manager (Application'Class (Context).Get_Security_Manager);
      end if;
   end Initialize;

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

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

      Session : ASF.Sessions.Session;
      SID     : Unbounded_String;
      AID     : Unbounded_String;
      Auth    : ASF.Principals.Principal_Access;

      pragma Unreferenced (SID);

      procedure Fetch_Cookie (Cookie : in ASF.Cookies.Cookie);

      --  ------------------------------
      --  Collect the AID and SID cookies.
      --  ------------------------------
      procedure Fetch_Cookie (Cookie : in ASF.Cookies.Cookie) is
         Name : constant String := ASF.Cookies.Get_Name (Cookie);
      begin
         if Name = SID_COOKIE then
            SID := To_Unbounded_String (ASF.Cookies.Get_Value (Cookie));
         elsif Name = AID_COOKIE then
            AID := To_Unbounded_String (ASF.Cookies.Get_Value (Cookie));
         end if;
      end Fetch_Cookie;

      Context : aliased Contexts.Security_Context;
   begin
      Request.Iterate_Cookies (Fetch_Cookie'Access);

      Session := Request.Get_Session (Create => True);

      --  If the session does not have a principal, try to authenticate the user with
      --  the auto-login cookie.
      Auth := Session.Get_Principal;
      if Auth = null then
         Auth_Filter'Class (F).Authenticate (Request, Response, Session, To_String (AID), Auth);
         if Auth /= null then
            Session.Set_Principal (Auth);
         end if;
      end if;

      --  No principal, redirect to the login page.
      if Auth = null then
         Auth_Filter'Class (F).Do_Login (Request, Response);
         return;
      end if;

      --  A permission manager is installed, check that the user can display the page.
      if F.Manager /= null then
         Context.Set_Context (F.Manager, Auth.all'Access);
         declare
            URI  : constant String := Request.Get_Path_Info;
            Perm : constant Policies.URLs.URI_Permission (1, URI'Length)
              := URI_Permission '(1, Len => URI'Length, URI => URI);
         begin
            if not F.Manager.Has_Permission (Context, Perm) then
               Log.Info ("Deny access on {0}", URI);
--                 Auth_Filter'Class (F).Do_Deny (Request, Response);
--                 return;
            end if;
         end;
      end if;

      --  Request is authorized, proceed to the next filter.
      ASF.Servlets.Do_Filter (Chain    => Chain,
                              Request  => Request,
                              Response => Response);
   end Do_Filter;

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

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

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

end ASF.Security.Filters;

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

with Ada.Strings.Unbounded;

with Util.Log.Loggers;

with ASF.Cookies;
with ASF.Applications.Main;

with Security.Contexts;
with Security.Policies.Urls;
package body ASF.Security.Filters is

   use Util.Log;

   --  The logger
   Log : constant Loggers.Logger := Loggers.Create ("Security.Filters");

   --  ------------------------------
   --  Called by the servlet container to indicate to a servlet that the servlet
   --  is being placed into service.
   --  ------------------------------
   procedure Initialize (Server  : in out Auth_Filter;
                         Context : in ASF.Servlets.Servlet_Registry'Class) is
      use ASF.Applications.Main;
   begin
      if Context in Application'Class then
         Server.Set_Permission_Manager (Application'Class (Context).Get_Security_Manager);
      end if;
   end Initialize;

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

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

      Session : ASF.Sessions.Session;
      SID     : Unbounded_String;
      AID     : Unbounded_String;
      Auth    : ASF.Principals.Principal_Access;

      pragma Unreferenced (SID);

      procedure Fetch_Cookie (Cookie : in ASF.Cookies.Cookie);

      --  ------------------------------
      --  Collect the AID and SID cookies.
      --  ------------------------------
      procedure Fetch_Cookie (Cookie : in ASF.Cookies.Cookie) is
         Name : constant String := ASF.Cookies.Get_Name (Cookie);
      begin
         if Name = SID_COOKIE then
            SID := To_Unbounded_String (ASF.Cookies.Get_Value (Cookie));
         elsif Name = AID_COOKIE then
            AID := To_Unbounded_String (ASF.Cookies.Get_Value (Cookie));
         end if;
      end Fetch_Cookie;

      Context : aliased Contexts.Security_Context;
   begin
      Request.Iterate_Cookies (Fetch_Cookie'Access);

      Session := Request.Get_Session (Create => True);

      --  If the session does not have a principal, try to authenticate the user with
      --  the auto-login cookie.
      Auth := Session.Get_Principal;
      if Auth = null then
         Auth_Filter'Class (F).Authenticate (Request, Response, Session, To_String (AID), Auth);
         if Auth /= null then
            Session.Set_Principal (Auth);
         end if;
      end if;

      --  No principal, redirect to the login page.
      if Auth = null then
         Auth_Filter'Class (F).Do_Login (Request, Response);
         return;
      end if;

      --  A permission manager is installed, check that the user can display the page.
      if F.Manager /= null then
         Context.Set_Context (F.Manager, Auth.all'Access);
         declare
            URI  : constant String := Request.Get_Path_Info;
            Perm : constant Policies.URLs.URI_Permission (URI'Length)
              := URI_Permission '(Len => URI'Length, URI => URI);
         begin
            if not F.Manager.Has_Permission (Context, Perm) then
               Log.Info ("Deny access on {0}", URI);
--                 Auth_Filter'Class (F).Do_Deny (Request, Response);
--                 return;
            end if;
         end;
      end if;

      --  Request is authorized, proceed to the next filter.
      ASF.Servlets.Do_Filter (Chain    => Chain,
                              Request  => Request,
                              Response => Response);
   end Do_Filter;

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

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

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

end ASF.Security.Filters;

Fix compilation

Fix compilation


------------------------------------------------------------------------------
--                                                                          --
--                    Copyright (C) 2015, AdaCore                           --
--                                                                          --
--  Redistribution and use in source and binary forms, with or without      --
--  modification, are permitted provided that the following conditions are  --
--  met:                                                                    --
--     1. Redistributions of source code must retain the above copyright    --
--        notice, this list of conditions and the following disclaimer.     --
--     2. Redistributions in binary form must reproduce the above copyright --
--        notice, this list of conditions and the following disclaimer in   --
--        the documentation and/or other materials provided with the        --
--        distribution.                                                     --
--     3. Neither the name of STMicroelectronics nor the names of its       --
--        contributors may be used to endorse or promote products derived   --
--        from this software without specific prior written permission.     --
--                                                                          --
--   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS    --
--   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT      --
--   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR  --
--   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT   --
--   HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, --
--   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT       --
--   LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,  --
--   DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY  --
--   THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT    --
--   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE  --
--   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.   --
--                                                                          --
------------------------------------------------------------------------------

with System;        use System;
with STM32_SVD;     use STM32_SVD;

with STM32.Device;  use STM32.Device;

package body STM32.PWM is

   subtype Hertz is Word;

   procedure Compute_Prescalar_and_Period
     (This                : access Timer;
      Requested_Frequency : Hertz;
      Prescalar           : out Word;
      Period              : out Word)
     with Pre => Requested_Frequency > 0;
   --  Computes the minimum prescaler and thus the maximum resolution for the
   --  given timer, based on the system clocks and the requested frequency

   function Has_APB2_Frequency  (This : Timer) return Boolean;
   -- timers 1, 8, 9, 10, 11

   function Has_APB1_Frequency (This : Timer) return Boolean;
   -- timers 3, 4, 6, 7, 12, 13, 14

   procedure Configure_PWM_GPIO
     (Output : GPIO_Point;
      PWM_AF : GPIO_Alternate_Function);

   --------------------
   -- Set_Duty_Cycle --
   --------------------

   procedure Set_Duty_Cycle
     (This    : in out PWM_Modulator;
      Channel : Timer_Channel;
      Value   : Percentage)
   is
      Pulse : Short;
   begin
      This.Outputs (Channel).Duty_Cycle := Value;
      if Value = 0 then
         Set_Compare_Value (This.Output_Timer.all, Channel, Short'(0));
      else
         Pulse := Short ((This.Timer_Period + 1) * Word (Value) / 100) - 1;
         --  for a Value of 0, the computation of Pulse wraps around to
         --  65535, so we only compute it when not zero
         Set_Compare_Value (This.Output_Timer.all, Channel, Pulse);
      end if;
   end Set_Duty_Cycle;

   -------------------
   -- Set_Duty_Time --
   -------------------

   procedure Set_Duty_Time
     (This    : in out PWM_Modulator;
      Channel : Timer_Channel;
      Value   : Microseconds)
   is
      Pulse         : Short;
      Period        : constant Word := This.Timer_Period + 1;
      uS_Per_Period : constant Word := 1_000_000 / This.Frequency;
   begin
      if Value > uS_per_Period then
         raise Invalid_Request with "duty time too high";
      end if;
      Pulse := Short ((Period * Value) / uS_per_Period) - 1;
      Set_Compare_Value (This.Output_Timer.all, Channel, Pulse);
   end Set_Duty_Time;

   ------------------------
   -- Current_Duty_Cycle --
   ------------------------

   function Current_Duty_Cycle
     (This    : PWM_Modulator;
      Channel : Timer_Channel)
      return Percentage
   is
   begin
      return This.Outputs (Channel).Duty_Cycle;
   end Current_Duty_Cycle;

   ------------------------------
   -- Initialise_PWM_Modulator --
   ------------------------------

   procedure Initialise_PWM_Modulator
     (This                   : in out PWM_Modulator;
      Requested_Frequency    : Float;
      PWM_Timer              : not null access Timer;
      PWM_AF                 : GPIO_Alternate_Function)
   is
      Prescalar : Word;
   begin
      This.Output_Timer := PWM_Timer;
      This.AF := PWM_AF;

      Enable_Clock (PWM_Timer.all);

      Compute_Prescalar_and_Period
        (PWM_Timer,
         Requested_Frequency => Word (Requested_Frequency),
         Prescalar           => Prescalar,
         Period              => This.Timer_Period);

      This.Timer_Period := This.Timer_Period - 1;
      This.Frequency := Word (Requested_Frequency);

      Configure
        (PWM_Timer.all,
         Prescaler     => Short (Prescalar),
         Period        => This.Timer_Period,
         Clock_Divisor => Div1,
         Counter_Mode  => Up);

      Set_Autoreload_Preload (PWM_Timer.all, True);

      Enable (PWM_Timer.all);

      for Channel in Timer_Channel loop
         This.Outputs (Channel).Attached := False;
      end loop;
   end Initialise_PWM_Modulator;

   ------------------------
   -- Attach_PWM_Channel --
   ------------------------

   procedure Attach_PWM_Channel
     (This    : in out PWM_Modulator;
      Channel : Timer_Channel;
      Point   : GPIO_Point)
   is
   begin
      This.Outputs (Channel).Attached := True;

      Enable_CLock (Point);

      Configure_PWM_GPIO (Point, This.AF);

      Configure_Channel_Output
        (This.Output_Timer.all,
         Channel  => Channel,
         Mode     => PWM1,
         State    => Disable,
         Pulse    => 0,
         Polarity => High);

      Set_Compare_Value (This.Output_Timer.all, Channel, Short (0));

   end Attach_PWM_Channel;

   procedure Enable_PWM_Channel
     (This    : in out PWM_Modulator;
      Channel : Timer_Channel)
   is
   begin
      Enable_Channel (This.Output_Timer.all, Channel);
   end Enable_PWM_Channel;

   procedure Disable_PWM_Channel
     (This    : in out PWM_Modulator;
      Channel : Timer_Channel)
   is
   begin
      Disable_Channel (This.Output_Timer.all, Channel);
   end Disable_PWM_Channel;

   --------------
   -- Attached --
   --------------

   function Attached (This : PWM_Modulator;  Channel : Timer_Channel) return Boolean is
     (This.Outputs (Channel).Attached);

   ------------------------
   -- Configure_PWM_GPIO --
   ------------------------

   procedure Configure_PWM_GPIO
     (Output : GPIO_Point;
      PWM_AF : GPIO_Alternate_Function)
   is
      Configuration : GPIO_Port_Configuration;
   begin
      Configuration.Mode        := Mode_AF;
      Configuration.Output_Type := Push_Pull;
      Configuration.Speed       := Speed_100MHz;
      Configuration.Resistors   := Floating;

      Configure_IO (Point  => Output,
                    Config => Configuration);

      Configure_Alternate_Function (Output, AF => PWM_AF);

      Lock (Output);
   end Configure_PWM_GPIO;

   ----------------------------------
   -- Compute_Prescalar_and_Period --
   ----------------------------------

   procedure Compute_Prescalar_And_Period
     (This                : access Timer;
      Requested_Frequency : Hertz;
      Prescalar           : out Word;
      Period              : out Word)
   is
      Max_Prescalar      : constant := 16#FFFF#;
      Max_Period         : Word;
      Hardware_Frequency : Word;
      Clocks             : constant RCC_System_Clocks := System_Clock_Frequencies;
   begin
      if Has_APB1_Frequency (This.all) then
         Hardware_Frequency := Clocks.TIMCLK1;
      elsif Has_APB2_Frequency (This.all) then
         Hardware_Frequency := Clocks.TIMCLK2;
      else
         raise Unknown_Timer;
      end if;

      if Has_32bit_Counter (This.all) then
         Max_Period := 16#FFFF_FFFF#;
      else
         Max_Period := 16#FFFF#;
      end if;

      if Requested_Frequency > Hardware_Frequency then
         raise Invalid_Request with "Freq too high";
      end if;

      Prescalar := 0;
      loop
         Period := Hardware_Frequency / (Prescalar + 1);
         Period := Period / Requested_Frequency;

         exit when not
           ((Period > Max_Period) and
            (Prescalar <= Max_Prescalar));

         Prescalar := Prescalar + 1;
      end loop;

      if Prescalar > Max_Prescalar then
         raise Invalid_Request with "Freq too low";
      end if;
   end Compute_Prescalar_and_Period;

   ------------------------
   -- Has_APB2_Frequency --
   ------------------------

   function Has_APB2_Frequency (This : Timer) return Boolean is
     (This'Address = STM32_SVD.TIM1_Base or
      This'Address = STM32_SVD.TIM8_Base or
      This'Address = STM32_SVD.TIM9_Base or
      This'Address = STM32_SVD.TIM10_Base or
      This'Address = STM32_SVD.TIM11_Base);

   ------------------------
   -- Has_APB1_Frequency --
   ------------------------

   function Has_APB1_Frequency (This : Timer) return Boolean is
     (This'Address = STM32_SVD.TIM3_Base or
      This'Address = STM32_SVD.TIM4_Base or
      This'Address = STM32_SVD.TIM6_Base or
      This'Address = STM32_SVD.TIM7_Base or
      This'Address = STM32_SVD.TIM12_Base or
      This'Address = STM32_SVD.TIM13_Base or
      This'Address = STM32_SVD.TIM14_Base);

end STM32.PWM;

------------------------------------------------------------------------------
--                                                                          --
--                    Copyright (C) 2015, AdaCore                           --
--                                                                          --
--  Redistribution and use in source and binary forms, with or without      --
--  modification, are permitted provided that the following conditions are  --
--  met:                                                                    --
--     1. Redistributions of source code must retain the above copyright    --
--        notice, this list of conditions and the following disclaimer.     --
--     2. Redistributions in binary form must reproduce the above copyright --
--        notice, this list of conditions and the following disclaimer in   --
--        the documentation and/or other materials provided with the        --
--        distribution.                                                     --
--     3. Neither the name of STMicroelectronics nor the names of its       --
--        contributors may be used to endorse or promote products derived   --
--        from this software without specific prior written permission.     --
--                                                                          --
--   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS    --
--   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT      --
--   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR  --
--   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT   --
--   HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, --
--   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT       --
--   LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,  --
--   DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY  --
--   THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT    --
--   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE  --
--   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.   --
--                                                                          --
------------------------------------------------------------------------------

with System;        use System;
with STM32_SVD;     use STM32_SVD;

with STM32.Device;  use STM32.Device;

package body STM32.PWM is

   subtype Hertz is Word;

   procedure Compute_Prescalar_and_Period
     (This                : access Timer;
      Requested_Frequency : Hertz;
      Prescalar           : out Word;
      Period              : out Word)
     with Pre => Requested_Frequency > 0;
   --  Computes the minimum prescaler and thus the maximum resolution for the
   --  given timer, based on the system clocks and the requested frequency

   function Has_APB2_Frequency  (This : Timer) return Boolean;
   -- timers 1, 8, 9, 10, 11

   function Has_APB1_Frequency (This : Timer) return Boolean;
   -- timers 3, 4, 6, 7, 12, 13, 14

   procedure Configure_PWM_GPIO
     (Output : GPIO_Point;
      PWM_AF : GPIO_Alternate_Function);

   --------------------
   -- Set_Duty_Cycle --
   --------------------

   procedure Set_Duty_Cycle
     (This    : in out PWM_Modulator;
      Channel : Timer_Channel;
      Value   : Percentage)
   is
      Pulse : Short;
   begin
      This.Outputs (Channel).Duty_Cycle := Value;
      if Value = 0 then
         Set_Compare_Value (This.Output_Timer.all, Channel, Short'(0));
      else
         Pulse := Short ((This.Timer_Period + 1) * Word (Value) / 100) - 1;
         --  for a Value of 0, the computation of Pulse wraps around to
         --  65535, so we only compute it when not zero
         Set_Compare_Value (This.Output_Timer.all, Channel, Pulse);
      end if;
   end Set_Duty_Cycle;

   -------------------
   -- Set_Duty_Time --
   -------------------

   procedure Set_Duty_Time
     (This    : in out PWM_Modulator;
      Channel : Timer_Channel;
      Value   : Microseconds)
   is
      Pulse         : Short;
      Period        : constant Word := This.Timer_Period + 1;
      uS_Per_Period : constant Word := 1_000_000 / This.Frequency;
   begin
      if Value > uS_per_Period then
         raise Invalid_Request with "duty time too high";
      end if;
      Pulse := Short ((Period * Value) / uS_per_Period) - 1;
      Set_Compare_Value (This.Output_Timer.all, Channel, Pulse);
   end Set_Duty_Time;

   ------------------------
   -- Current_Duty_Cycle --
   ------------------------

   function Current_Duty_Cycle
     (This    : PWM_Modulator;
      Channel : Timer_Channel)
      return Percentage
   is
   begin
      return This.Outputs (Channel).Duty_Cycle;
   end Current_Duty_Cycle;

   ------------------------------
   -- Initialise_PWM_Modulator --
   ------------------------------

   procedure Initialise_PWM_Modulator
     (This                   : in out PWM_Modulator;
      Requested_Frequency    : Float;
      PWM_Timer              : not null access Timer;
      PWM_AF                 : GPIO_Alternate_Function)
   is
      Prescalar : Word;
   begin
      This.Output_Timer := PWM_Timer;
      This.AF := PWM_AF;

      Enable_Clock (PWM_Timer.all);

      Compute_Prescalar_and_Period
        (PWM_Timer,
         Requested_Frequency => Word (Requested_Frequency),
         Prescalar           => Prescalar,
         Period              => This.Timer_Period);

      This.Timer_Period := This.Timer_Period - 1;
      This.Frequency := Word (Requested_Frequency);

      Configure
        (PWM_Timer.all,
         Prescaler     => Short (Prescalar),
         Period        => This.Timer_Period,
         Clock_Divisor => Div1,
         Counter_Mode  => Up);

      Set_Autoreload_Preload (PWM_Timer.all, True);

      if Advanced_Timer (This.Output_Timer.all) then
         Enable_Main_Output (This.Output_Timer.all);
      end if;

      Enable (PWM_Timer.all);

      for Channel in Timer_Channel loop
         This.Outputs (Channel).Attached := False;
      end loop;
   end Initialise_PWM_Modulator;

   ------------------------
   -- Attach_PWM_Channel --
   ------------------------

   procedure Attach_PWM_Channel
     (This    : in out PWM_Modulator;
      Channel : Timer_Channel;
      Point   : GPIO_Point)
   is
   begin
      This.Outputs (Channel).Attached := True;

      Enable_CLock (Point);

      Configure_PWM_GPIO (Point, This.AF);

      Configure_Channel_Output
        (This.Output_Timer.all,
         Channel  => Channel,
         Mode     => PWM1,
         State    => Disable,
         Pulse    => 0,
         Polarity => High);

      Set_Compare_Value (This.Output_Timer.all, Channel, Short (0));

   end Attach_PWM_Channel;

   procedure Enable_PWM_Channel
     (This    : in out PWM_Modulator;
      Channel : Timer_Channel)
   is
   begin
      Enable_Channel (This.Output_Timer.all, Channel);
   end Enable_PWM_Channel;

   procedure Disable_PWM_Channel
     (This    : in out PWM_Modulator;
      Channel : Timer_Channel)
   is
   begin
      Disable_Channel (This.Output_Timer.all, Channel);
   end Disable_PWM_Channel;

   --------------
   -- Attached --
   --------------

   function Attached (This : PWM_Modulator;  Channel : Timer_Channel) return Boolean is
     (This.Outputs (Channel).Attached);

   ------------------------
   -- Configure_PWM_GPIO --
   ------------------------

   procedure Configure_PWM_GPIO
     (Output : GPIO_Point;
      PWM_AF : GPIO_Alternate_Function)
   is
      Configuration : GPIO_Port_Configuration;
   begin
      Configuration.Mode        := Mode_AF;
      Configuration.Output_Type := Push_Pull;
      Configuration.Speed       := Speed_100MHz;
      Configuration.Resistors   := Floating;

      Configure_IO (Point  => Output,
                    Config => Configuration);

      Configure_Alternate_Function (Output, AF => PWM_AF);

      Lock (Output);
   end Configure_PWM_GPIO;

   ----------------------------------
   -- Compute_Prescalar_and_Period --
   ----------------------------------

   procedure Compute_Prescalar_And_Period
     (This                : access Timer;
      Requested_Frequency : Hertz;
      Prescalar           : out Word;
      Period              : out Word)
   is
      Max_Prescalar      : constant := 16#FFFF#;
      Max_Period         : Word;
      Hardware_Frequency : Word;
      Clocks             : constant RCC_System_Clocks := System_Clock_Frequencies;
   begin
      if Has_APB1_Frequency (This.all) then
         Hardware_Frequency := Clocks.TIMCLK1;
      elsif Has_APB2_Frequency (This.all) then
         Hardware_Frequency := Clocks.TIMCLK2;
      else
         raise Unknown_Timer;
      end if;

      if Has_32bit_Counter (This.all) then
         Max_Period := 16#FFFF_FFFF#;
      else
         Max_Period := 16#FFFF#;
      end if;

      if Requested_Frequency > Hardware_Frequency then
         raise Invalid_Request with "Freq too high";
      end if;

      Prescalar := 0;
      loop
         Period := Hardware_Frequency / (Prescalar + 1);
         Period := Period / Requested_Frequency;

         exit when not
           ((Period > Max_Period) and
            (Prescalar <= Max_Prescalar));

         Prescalar := Prescalar + 1;
      end loop;

      if Prescalar > Max_Prescalar then
         raise Invalid_Request with "Freq too low";
      end if;
   end Compute_Prescalar_and_Period;

   ------------------------
   -- Has_APB2_Frequency --
   ------------------------

   function Has_APB2_Frequency (This : Timer) return Boolean is
     (This'Address = STM32_SVD.TIM1_Base or
      This'Address = STM32_SVD.TIM8_Base or
      This'Address = STM32_SVD.TIM9_Base or
      This'Address = STM32_SVD.TIM10_Base or
      This'Address = STM32_SVD.TIM11_Base);

   ------------------------
   -- Has_APB1_Frequency --
   ------------------------

   function Has_APB1_Frequency (This : Timer) return Boolean is
     (This'Address = STM32_SVD.TIM3_Base or
      This'Address = STM32_SVD.TIM4_Base or
      This'Address = STM32_SVD.TIM6_Base or
      This'Address = STM32_SVD.TIM7_Base or
      This'Address = STM32_SVD.TIM12_Base or
      This'Address = STM32_SVD.TIM13_Base or
      This'Address = STM32_SVD.TIM14_Base);

end STM32.PWM;

Enable main output for advanced timers

STM32.PWM: Enable main output for advanced timers


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

with Util.Serialize.Mappers;

with AWA.Events.Queues.Fifos;
with AWA.Events.Queues.Persistents;
package body AWA.Events.Queues is

   --  ------------------------------
   --  Queue the event.
   --  ------------------------------
   procedure Enqueue (Into  : in Queue_Ref;
                      Event : in AWA.Events.Module_Event'Class) is
   begin
      if not Into.Is_Null then
         declare
            Q : constant Queue_Info_Accessor := Into.Value;
         begin
            if Q.Queue /= null then
               Q.Queue.Enqueue (Event);
            end if;
         end;
      end if;
   end Enqueue;

   --  ------------------------------
   --  Dequeue an event and process it with the Process procedure.
   --  ------------------------------
   procedure Dequeue (From    : in Queue_Ref;
                      Process : access procedure (Event : in Module_Event'Class)) is
   begin
      if not From.Is_Null then
         declare
            Q : constant Queue_Info_Accessor := From.Value;
         begin
            if Q.Queue /= null then
               From.Value.Queue.Dequeue (Process);
            end if;
         end;
      end if;
   end Dequeue;

   --  ------------------------------
   --  Returns true if the queue is available.
   --  ------------------------------
   function Has_Queue (Queue : in Queue_Ref'Class) return Boolean is
   begin
      return not Queue.Is_Null and then Queue.Value.Queue /= null;
   end Has_Queue;

   --  ------------------------------
   --  Returns the queue name.
   --  ------------------------------
   function Get_Name (Queue : in Queue_Ref'Class) return String is
   begin
      if Queue.Is_Null then
         return "";
      else
         return Queue.Value.Name;
      end if;
   end Get_Name;

   --  ------------------------------
   --  Get the model queue reference object.
   --  Returns a null object if the queue is not persistent.
   --  ------------------------------
   function Get_Queue (Queue : in Queue_Ref'Class) return AWA.Events.Models.Queue_Ref is
   begin
      if Queue.Is_Null or else Queue.Value.Queue = null then
         return AWA.Events.Models.Null_Queue;
      else
         return Queue.Value.Queue.Get_Queue;
      end if;
   end Get_Queue;

   FIFO_QUEUE_TYPE       : constant String := "fifo";
   PERSISTENT_QUEUE_TYPE : constant String := "persist";

   --  ------------------------------
   --  Create the event queue identified by the name Name.  The queue factory
   --  identified by Kind is called to create the event queue instance.
   --  Returns a reference to the queue.
   --  ------------------------------
   function Create_Queue (Name    : in String;
                          Kind    : in String;
                          Props   : in EL.Beans.Param_Vectors.Vector;
                          Context : in EL.Contexts.ELContext'Class)
                          return Queue_Ref is
      Result : Queue_Ref;
      Q      : constant Queue_Info_Access := new Queue_Info '(Util.Refs.Ref_Entity with
                                                              Length => Name'Length,
                                                              Name   => Name,
                                                              others => <>);
   begin
      Queue_Refs.Ref (Result) := Queue_Refs.Create (Q);
      if Kind = FIFO_QUEUE_TYPE then
         Q.Queue := AWA.Events.Queues.Fifos.Create_Queue (Name, Props, Context);
      elsif Kind = PERSISTENT_QUEUE_TYPE then
         Q.Queue := AWA.Events.Queues.Persistents.Create_Queue (Name, Props, Context);
      else
         raise Util.Serialize.Mappers.Field_Error with "Invalid queue type: " & Kind;
      end if;
      return Result;
   end Create_Queue;

   function Null_Queue return Queue_Ref is
      Result : Queue_Ref;
   begin
      return Result;
   end Null_Queue;

   --  ------------------------------
   --  Finalize the referenced object.  This is called before the object is freed.
   --  ------------------------------
   overriding
   procedure Finalize (Object : in out Queue_Info) is
      procedure Free is
         new Ada.Unchecked_Deallocation (Object => Queue'Class,
                                         Name   => Queue_Access);
   begin
      if Object.Queue /= null then
         Object.Queue.Finalize;
         Free (Object.Queue);
      end if;
   end Finalize;

end AWA.Events.Queues;

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

with Util.Serialize.Mappers;

with AWA.Events.Queues.Fifos;
with AWA.Events.Queues.Persistents;
with AWA.Events.Queues.Observers;
package body AWA.Events.Queues is

   --  ------------------------------
   --  Queue the event.
   --  ------------------------------
   procedure Enqueue (Into  : in Queue_Ref;
                      Event : in AWA.Events.Module_Event'Class) is
   begin
      if not Into.Is_Null then
         declare
            Q : constant Queue_Info_Accessor := Into.Value;
         begin
            if Q.Queue /= null then
               Q.Queue.Enqueue (Event);
               Observers.Notify (Q.Listeners, Into);
            end if;
         end;
      end if;
   end Enqueue;

   --  ------------------------------
   --  Dequeue an event and process it with the Process procedure.
   --  ------------------------------
   procedure Dequeue (From    : in Queue_Ref;
                      Process : access procedure (Event : in Module_Event'Class)) is
   begin
      if not From.Is_Null then
         declare
            Q : constant Queue_Info_Accessor := From.Value;
         begin
            if Q.Queue /= null then
               From.Value.Queue.Dequeue (Process);
            end if;
         end;
      end if;
   end Dequeue;

   --  ------------------------------
   --  Add a listener that will be called each time an event is queued.
   --  ------------------------------
   procedure Add_Listener (Into     : in Queue_Ref;
                           Listener : in Util.Listeners.Listener_Access) is
   begin
      if not Into.Is_Null then
         declare
            Q : constant Queue_Info_Accessor := Into.Value;
         begin
            Q.Listeners.Append (Listener);
         end;
      end if;
   end Add_Listener;

   --  ------------------------------
   --  Returns true if the queue is available.
   --  ------------------------------
   function Has_Queue (Queue : in Queue_Ref'Class) return Boolean is
   begin
      return not Queue.Is_Null and then Queue.Value.Queue /= null;
   end Has_Queue;

   --  ------------------------------
   --  Returns the queue name.
   --  ------------------------------
   function Get_Name (Queue : in Queue_Ref'Class) return String is
   begin
      if Queue.Is_Null then
         return "";
      else
         return Queue.Value.Name;
      end if;
   end Get_Name;

   --  ------------------------------
   --  Get the model queue reference object.
   --  Returns a null object if the queue is not persistent.
   --  ------------------------------
   function Get_Queue (Queue : in Queue_Ref'Class) return AWA.Events.Models.Queue_Ref is
   begin
      if Queue.Is_Null or else Queue.Value.Queue = null then
         return AWA.Events.Models.Null_Queue;
      else
         return Queue.Value.Queue.Get_Queue;
      end if;
   end Get_Queue;

   --  ------------------------------
   --  Create the event queue identified by the name Name.  The queue factory
   --  identified by Kind is called to create the event queue instance.
   --  Returns a reference to the queue.
   --  ------------------------------
   function Create_Queue (Name    : in String;
                          Kind    : in String;
                          Props   : in EL.Beans.Param_Vectors.Vector;
                          Context : in EL.Contexts.ELContext'Class)
                          return Queue_Ref is
      Result : Queue_Ref;
      Q      : constant Queue_Info_Access
        := new Queue_Info '(Util.Refs.Ref_Entity with
                            Length => Name'Length,
                            Name   => Name,
                            others => <>);
   begin
      Queue_Refs.Ref (Result) := Queue_Refs.Create (Q);
      if Kind = FIFO_QUEUE_TYPE then
         Q.Queue := Queues.Fifos.Create_Queue (Name, Props, Context);
      elsif Kind = PERSISTENT_QUEUE_TYPE then
         Q.Queue := Queues.Persistents.Create_Queue (Name, Props, Context);
      else
         raise Util.Serialize.Mappers.Field_Error with "Invalid queue type: " & Kind;
      end if;
      return Result;
   end Create_Queue;

   function Null_Queue return Queue_Ref is
      Result : Queue_Ref;
   begin
      return Result;
   end Null_Queue;

   --  ------------------------------
   --  Finalize the referenced object.  This is called before the object is freed.
   --  ------------------------------
   overriding
   procedure Finalize (Object : in out Queue_Info) is
      procedure Free is
         new Ada.Unchecked_Deallocation (Object => Queue'Class,
                                         Name   => Queue_Access);
   begin
      if Object.Queue /= null then
         Object.Queue.Finalize;
         Free (Object.Queue);
      end if;
   end Finalize;

end AWA.Events.Queues;

Add Add_Listener procedure and call the observer Notify procedure when an event is posted


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

   --  Initialize the filter.
   overriding
   procedure Initialize (Filter  : in out Auth_Filter;
                         Config  : in ASF.Servlets.Filter_Config) is
   begin
      null;
   end Initialize;

   function Get_Access_Token (Req : in ASF.Requests.Request'Class) return String is
   begin
      return "";
   end Get_Access_Token;

   --  The Do_Filter method of the Filter is called by the container each time
   --  a request/response pair is passed through the chain due to a client request
   --  for a resource at the end of the chain.  The Filter_Chain passed in to this
   --  method allows the Filter to pass on the request and response to the next
   --  entity in the chain.
   --
   --  Before passing the control to the next filter, initialize the service
   --  context to give access to the current application, current user and
   --  manage possible transaction rollbacks.
   overriding
   procedure Do_Filter (F        : in Auth_Filter;
                        Request  : in out ASF.Requests.Request'Class;
                        Response : in out ASF.Responses.Response'Class;
                        Chain    : in out ASF.Servlets.Filter_Chain) is
      use type AWA.OAuth.Services.Auth_Manager_Access;

      use type ASF.Principals.Principal_Access;

      type Context_Type is new AWA.Services.Contexts.Service_Context with null record;

      --  Get the attribute registered under the given name in the HTTP session.
      overriding
      function Get_Session_Attribute (Ctx  : in Context_Type;
                                      Name : in String) return Util.Beans.Objects.Object;

      --  Set the attribute registered under the given name in the HTTP session.
      overriding
      procedure Set_Session_Attribute (Ctx   : in out Context_Type;
                                       Name  : in String;
                                       Value : in Util.Beans.Objects.Object);

      overriding
      function Get_Session_Attribute (Ctx  : in Context_Type;
                                      Name : in String) return Util.Beans.Objects.Object is
         pragma Unreferenced (Ctx);
      begin
         return Request.Get_Session.Get_Attribute (Name);
      end Get_Session_Attribute;

      --  Set the attribute registered under the given name in the HTTP session.
      overriding
      procedure Set_Session_Attribute (Ctx   : in out Context_Type;
                                       Name  : in String;
                                       Value : in Util.Beans.Objects.Object) is
         pragma Unreferenced (Ctx);
         S : ASF.Sessions.Session := Request.Get_Session;
      begin
         S.Set_Attribute (Name, Value);
      end Set_Session_Attribute;

      App : constant ASF.Servlets.Servlet_Registry_Access
        := ASF.Servlets.Get_Servlet_Context (Chain);
      Bearer : constant String := Get_Access_Token (Request);
      Auth   : Security.Principal_Access;
      Grant  : Security.OAuth.Servers.Grant_Type;
   begin
      if F.Realm = null then
         return;
      end if;
      F.Realm.Authenticate (Bearer, Grant);

      declare
         Context     : aliased Context_Type;
         Application : AWA.Applications.Application_Access;
      begin
         --  Get the application
         if App.all in AWA.Applications.Application'Class then
            Application := AWA.Applications.Application'Class (App.all)'Access;
         else
            Application := null;
         end if;
--         Context.Set_Context (Application, Grant.Auth);

         --  Give the control to the next chain up to the servlet.
         ASF.Servlets.Do_Filter (Chain    => Chain,
                                 Request  => Request,
                                 Response => Response);

         --  By leaving this scope, the active database transactions are rollbacked
         --  (finalization of Service_Context)
      end;
   end Do_Filter;

end AWA.OAuth.Filters;

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

   --  Initialize the filter.
   overriding
   procedure Initialize (Filter  : in out Auth_Filter;
                         Config  : in ASF.Servlets.Filter_Config) is
   begin
      null;
   end Initialize;

   function Get_Access_Token (Req : in ASF.Requests.Request'Class) return String is
   begin
      return "";
   end Get_Access_Token;

   --  The Do_Filter method of the Filter is called by the container each time
   --  a request/response pair is passed through the chain due to a client request
   --  for a resource at the end of the chain.  The Filter_Chain passed in to this
   --  method allows the Filter to pass on the request and response to the next
   --  entity in the chain.
   --
   --  Before passing the control to the next filter, initialize the service
   --  context to give access to the current application, current user and
   --  manage possible transaction rollbacks.
   overriding
   procedure Do_Filter (F        : in Auth_Filter;
                        Request  : in out ASF.Requests.Request'Class;
                        Response : in out ASF.Responses.Response'Class;
                        Chain    : in out ASF.Servlets.Filter_Chain) is
      use type AWA.OAuth.Services.Auth_Manager_Access;

      use type ASF.Principals.Principal_Access;

      type Context_Type is new AWA.Services.Contexts.Service_Context with null record;

      --  Get the attribute registered under the given name in the HTTP session.
      overriding
      function Get_Session_Attribute (Ctx  : in Context_Type;
                                      Name : in String) return Util.Beans.Objects.Object;

      --  Set the attribute registered under the given name in the HTTP session.
      overriding
      procedure Set_Session_Attribute (Ctx   : in out Context_Type;
                                       Name  : in String;
                                       Value : in Util.Beans.Objects.Object);

      overriding
      function Get_Session_Attribute (Ctx  : in Context_Type;
                                      Name : in String) return Util.Beans.Objects.Object is
         pragma Unreferenced (Ctx);
      begin
         return Request.Get_Session.Get_Attribute (Name);
      end Get_Session_Attribute;

      --  Set the attribute registered under the given name in the HTTP session.
      overriding
      procedure Set_Session_Attribute (Ctx   : in out Context_Type;
                                       Name  : in String;
                                       Value : in Util.Beans.Objects.Object) is
         pragma Unreferenced (Ctx);
         S : ASF.Sessions.Session := Request.Get_Session;
      begin
         S.Set_Attribute (Name, Value);
      end Set_Session_Attribute;

      App : constant ASF.Servlets.Servlet_Registry_Access
        := ASF.Servlets.Get_Servlet_Context (Chain);
      Bearer : constant String := Get_Access_Token (Request);
      Auth   : Security.Principal_Access;
      Grant  : Security.OAuth.Servers.Grant_Type;
   begin
      if F.Realm = null then
         return;
      end if;
      F.Realm.Authenticate (Bearer, Grant);

      declare
         Context     : aliased Context_Type;
         Application : AWA.Applications.Application_Access;
      begin
         --  Get the application
         if App.all in AWA.Applications.Application'Class then
            Application := AWA.Applications.Application'Class (App.all)'Access;
         else
            Application := null;
         end if;
--         Context.Set_Context (Application, Grant.Auth);

         --  Give the control to the next chain up to the servlet.
         ASF.Servlets.Do_Filter (Chain    => Chain,
                                 Request  => Request,
                                 Response => Response);

         --  By leaving this scope, the active database transactions are rollbacked
         --  (finalization of Service_Context)
      end;
   end Do_Filter;

end AWA.OAuth.Filters;

Remove unused with clauses

Remove unused with clauses


-----------------------------------------------------------------------
--  Util testsuite - Util Testsuite
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 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 AWA.Users.Services.Tests;
with AWA.Users.Tests;
with AWA.Blogs.Modules.Tests;
with AWA.Helpers.Selectors.Tests;
with AWA.Storages.Services.Tests;
with AWA.Events.Services.Tests;
with AWA.Mail.Clients.Tests;
with AWA.Mail.Modules.Tests;
with AWA.Images.Services.Tests;
with AWA.Votes.Modules.Tests;
with AWA.Tags.Modules.Tests;
with AWA.Questions.Modules.Tests;
with AWA.Counters.Modules.Tests;
with AWA.Modules.Tests;

with ASF.Converters.Dates;

with AWA.Users.Modules;
with AWA.Mail.Modules;
with AWA.Blogs.Modules;
with AWA.Workspaces.Modules;
with AWA.Storages.Modules;
with AWA.Images.Modules;
with AWA.Questions.Modules;
with AWA.Votes.Modules;
with AWA.Tags.Modules;
with AWA.Changelogs.Modules;
with AWA.Counters.Modules;

with AWA.Converters.Dates;
with AWA.Tests;
with AWA.Services.Contexts;
with AWA.Jobs.Services.Tests;
with AWA.Jobs.Modules.Tests;
with AWA.Settings.Modules.Tests;
with AWA.Comments.Modules.Tests;
with AWA.Changelogs.Modules.Tests;
with AWA.Wikis.Modules.Tests;

with ASF.Server.Web;
with ASF.Server.Tests;
package body AWA.Testsuite is
   Users          : aliased AWA.Users.Modules.User_Module;

   Workspaces     : aliased AWA.Workspaces.Modules.Workspace_Module;

   Mail           : aliased AWA.Mail.Modules.Mail_Module;

   Jobs           : aliased AWA.Jobs.Modules.Job_Module;

   Comments       : aliased AWA.Comments.Modules.Comment_Module;

   Blogs          : aliased AWA.Blogs.Modules.Blog_Module;

   Storages       : aliased AWA.Storages.Modules.Storage_Module;

   Images         : aliased AWA.Images.Modules.Image_Module;

   Questions      : aliased AWA.Questions.Modules.Question_Module;

   Votes          : aliased AWA.Votes.Modules.Vote_Module;

   Tags           : aliased AWA.Tags.Modules.Tag_Module;

   Settings       : aliased AWA.Settings.Modules.Setting_Module;

   Changelogs     : aliased AWA.Changelogs.Modules.Changelog_Module;

   Wikis          : aliased AWA.Wikis.Modules.Wiki_Module;

   Counters       : aliased AWA.Counters.Modules.Counter_Module;

   Date_Converter : aliased ASF.Converters.Dates.Date_Converter;

   Rel_Date_Converter : aliased AWA.Converters.Dates.Relative_Date_Converter;

   Tests : aliased Util.Tests.Test_Suite;

   function Suite return Util.Tests.Access_Test_Suite is
      Ret : constant Util.Tests.Access_Test_Suite := Tests'Access;
   begin
      AWA.Modules.Tests.Add_Tests (Ret);
      AWA.Events.Services.Tests.Add_Tests (Ret);
      AWA.Mail.Clients.Tests.Add_Tests (Ret);
      AWA.Mail.Modules.Tests.Add_Tests (Ret);
      AWA.Users.Services.Tests.Add_Tests (Ret);
      AWA.Users.Tests.Add_Tests (Ret);
      AWA.Counters.Modules.Tests.Add_Tests (Ret);
      AWA.Helpers.Selectors.Tests.Add_Tests (Ret);
      AWA.Jobs.Modules.Tests.Add_Tests (Ret);
      AWA.Jobs.Services.Tests.Add_Tests (Ret);
      AWA.Settings.Modules.Tests.Add_Tests (Ret);
      AWA.Comments.Modules.Tests.Add_Tests (Ret);
      AWA.Blogs.Modules.Tests.Add_Tests (Ret);
      AWA.Storages.Services.Tests.Add_Tests (Ret);
      AWA.Images.Services.Tests.Add_Tests (Ret);
      AWA.Changelogs.Modules.Tests.Add_Tests (Ret);
      AWA.Votes.Modules.Tests.Add_Tests (Ret);
      AWA.Tags.Modules.Tests.Add_Tests (Ret);
      AWA.Questions.Modules.Tests.Add_Tests (Ret);
      AWA.Wikis.Modules.Tests.Add_Tests (Ret);
      return Ret;
   end Suite;

   procedure Initialize (Props : in Util.Properties.Manager) is
   begin
      Initialize (null, Props, True);
   end Initialize;

   --  ------------------------------
   --  Initialize the AWA test framework mockup.
   --  ------------------------------
   procedure Initialize (App         : in AWA.Applications.Application_Access;
                         Props       : in Util.Properties.Manager;
                         Add_Modules : in Boolean) is
      use AWA.Applications;
   begin
      AWA.Tests.Initialize (App, Props, Add_Modules);

      if Add_Modules then
         declare
            Application : constant Applications.Application_Access := AWA.Tests.Get_Application;
            Ctx         : AWA.Services.Contexts.Service_Context;
            Users  : constant AWA.Users.Modules.User_Module_Access := AWA.Testsuite.Users'Access;
         begin
            Ctx.Set_Context (Application, null);
            Register (App    => Application.all'Access,
                      Name   => AWA.Users.Modules.NAME,
                      URI    => "user",
                      Module => Users.all'Access);

            Register (App    => Application.all'Access,
                      Name   => "mail",
                      URI    => "mail",
                      Module => Mail'Access);

            Register (App    => Application.all'Access,
                      Name   => "workspaces",
                      URI    => "workspaces",
                      Module => Workspaces'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Counters.Modules.NAME,
                      URI    => "counters",
                      Module => Counters'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Comments.Modules.NAME,
                      URI    => "comments",
                      Module => Comments'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Storages.Modules.NAME,
                      URI    => "storages",
                      Module => Storages'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Images.Modules.NAME,
                      URI    => "images",
                      Module => Images'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Jobs.Modules.NAME,
                      URI    => "jobs",
                      Module => Jobs'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Settings.Modules.NAME,
                      URI    => "settings",
                      Module => Settings'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Votes.Modules.NAME,
                      URI    => "votes",
                      Module => Votes'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Changelogs.Modules.NAME,
                      URI    => "changelogs",
                      Module => Changelogs'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Tags.Modules.NAME,
                      URI    => "tags",
                      Module => Tags'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Blogs.Modules.NAME,
                      URI    => "blogs",
                      Module => Blogs'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Questions.Modules.NAME,
                      URI    => "questions",
                      Module => Questions'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Wikis.Modules.NAME,
                      URI    => "wikis",
                      Module => Wikis'Access);

            Application.Start;
            if Props.Exists ("test.server") then
               declare
                  WS : ASF.Server.Web.AWS_Container;
               begin
                  Application.Add_Converter (Name      => "dateConverter",
                                             Converter => Date_Converter'Access);
                  Application.Add_Converter (Name      => "smartDateConverter",
                                             Converter => Rel_Date_Converter'Access);

                  WS.Register_Application ("/asfunit", Application.all'Access);

                  WS.Start;
                  delay 6000.0;
               end;
            end if;
            ASF.Server.Tests.Set_Context (Application.all'Access);
         end;
      end if;
   end Initialize;

end AWA.Testsuite;

-----------------------------------------------------------------------
--  Util testsuite - Util Testsuite
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 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 AWA.Users.Services.Tests;
with AWA.Users.Tests;
with AWA.Blogs.Modules.Tests;
with AWA.Helpers.Selectors.Tests;
with AWA.Storages.Services.Tests;
with AWA.Events.Services.Tests;
with AWA.Mail.Clients.Tests;
with AWA.Mail.Modules.Tests;
with AWA.Images.Services.Tests;
with AWA.Votes.Modules.Tests;
with AWA.Tags.Modules.Tests;
with AWA.Questions.Modules.Tests;
with AWA.Counters.Modules.Tests;
with AWA.Modules.Tests;

with ASF.Converters.Dates;

with AWA.Users.Modules;
with AWA.Mail.Modules;
with AWA.Blogs.Modules;
with AWA.Workspaces.Modules;
with AWA.Storages.Modules;
with AWA.Images.Modules;
with AWA.Questions.Modules;
with AWA.Votes.Modules;
with AWA.Tags.Modules;
with AWA.Changelogs.Modules;
with AWA.Counters.Modules;

with AWA.Converters.Dates;
with AWA.Tests;
with AWA.Services.Contexts;
with AWA.Jobs.Services.Tests;
with AWA.Jobs.Modules.Tests;
with AWA.Settings.Modules.Tests;
with AWA.Comments.Modules.Tests;
with AWA.Changelogs.Modules.Tests;
with AWA.Wikis.Modules.Tests;

--  with ASF.Server.Web;
with ASF.Server.Tests;
package body AWA.Testsuite is
   Users          : aliased AWA.Users.Modules.User_Module;

   Workspaces     : aliased AWA.Workspaces.Modules.Workspace_Module;

   Mail           : aliased AWA.Mail.Modules.Mail_Module;

   Jobs           : aliased AWA.Jobs.Modules.Job_Module;

   Comments       : aliased AWA.Comments.Modules.Comment_Module;

   Blogs          : aliased AWA.Blogs.Modules.Blog_Module;

   Storages       : aliased AWA.Storages.Modules.Storage_Module;

   Images         : aliased AWA.Images.Modules.Image_Module;

   Questions      : aliased AWA.Questions.Modules.Question_Module;

   Votes          : aliased AWA.Votes.Modules.Vote_Module;

   Tags           : aliased AWA.Tags.Modules.Tag_Module;

   Settings       : aliased AWA.Settings.Modules.Setting_Module;

   Changelogs     : aliased AWA.Changelogs.Modules.Changelog_Module;

   Wikis          : aliased AWA.Wikis.Modules.Wiki_Module;

   Counters       : aliased AWA.Counters.Modules.Counter_Module;

   Date_Converter : aliased ASF.Converters.Dates.Date_Converter;

   Rel_Date_Converter : aliased AWA.Converters.Dates.Relative_Date_Converter;

   Tests : aliased Util.Tests.Test_Suite;

   function Suite return Util.Tests.Access_Test_Suite is
      Ret : constant Util.Tests.Access_Test_Suite := Tests'Access;
   begin
      AWA.Modules.Tests.Add_Tests (Ret);
      AWA.Events.Services.Tests.Add_Tests (Ret);
      AWA.Mail.Clients.Tests.Add_Tests (Ret);
      AWA.Mail.Modules.Tests.Add_Tests (Ret);
      AWA.Users.Services.Tests.Add_Tests (Ret);
      AWA.Users.Tests.Add_Tests (Ret);
      AWA.Counters.Modules.Tests.Add_Tests (Ret);
      AWA.Helpers.Selectors.Tests.Add_Tests (Ret);
      AWA.Jobs.Modules.Tests.Add_Tests (Ret);
      AWA.Jobs.Services.Tests.Add_Tests (Ret);
      AWA.Settings.Modules.Tests.Add_Tests (Ret);
      AWA.Comments.Modules.Tests.Add_Tests (Ret);
      AWA.Blogs.Modules.Tests.Add_Tests (Ret);
      AWA.Storages.Services.Tests.Add_Tests (Ret);
      AWA.Images.Services.Tests.Add_Tests (Ret);
      AWA.Changelogs.Modules.Tests.Add_Tests (Ret);
      AWA.Votes.Modules.Tests.Add_Tests (Ret);
      AWA.Tags.Modules.Tests.Add_Tests (Ret);
      AWA.Questions.Modules.Tests.Add_Tests (Ret);
      AWA.Wikis.Modules.Tests.Add_Tests (Ret);
      return Ret;
   end Suite;

   procedure Initialize (Props : in Util.Properties.Manager) is
   begin
      Initialize (null, Props, True);
   end Initialize;

   --  ------------------------------
   --  Initialize the AWA test framework mockup.
   --  ------------------------------
   procedure Initialize (App         : in AWA.Applications.Application_Access;
                         Props       : in Util.Properties.Manager;
                         Add_Modules : in Boolean) is
      use AWA.Applications;
   begin
      AWA.Tests.Initialize (App, Props, Add_Modules);

      if Add_Modules then
         declare
            Application : constant Applications.Application_Access := AWA.Tests.Get_Application;
            Ctx         : AWA.Services.Contexts.Service_Context;
            Users  : constant AWA.Users.Modules.User_Module_Access := AWA.Testsuite.Users'Access;
         begin
            Ctx.Set_Context (Application, null);
            Register (App    => Application.all'Access,
                      Name   => AWA.Users.Modules.NAME,
                      URI    => "user",
                      Module => Users.all'Access);

            Register (App    => Application.all'Access,
                      Name   => "mail",
                      URI    => "mail",
                      Module => Mail'Access);

            Register (App    => Application.all'Access,
                      Name   => "workspaces",
                      URI    => "workspaces",
                      Module => Workspaces'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Counters.Modules.NAME,
                      URI    => "counters",
                      Module => Counters'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Comments.Modules.NAME,
                      URI    => "comments",
                      Module => Comments'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Storages.Modules.NAME,
                      URI    => "storages",
                      Module => Storages'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Images.Modules.NAME,
                      URI    => "images",
                      Module => Images'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Jobs.Modules.NAME,
                      URI    => "jobs",
                      Module => Jobs'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Settings.Modules.NAME,
                      URI    => "settings",
                      Module => Settings'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Votes.Modules.NAME,
                      URI    => "votes",
                      Module => Votes'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Changelogs.Modules.NAME,
                      URI    => "changelogs",
                      Module => Changelogs'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Tags.Modules.NAME,
                      URI    => "tags",
                      Module => Tags'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Blogs.Modules.NAME,
                      URI    => "blogs",
                      Module => Blogs'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Questions.Modules.NAME,
                      URI    => "questions",
                      Module => Questions'Access);

            Register (App    => Application.all'Access,
                      Name   => AWA.Wikis.Modules.NAME,
                      URI    => "wikis",
                      Module => Wikis'Access);

            Application.Start;
--              if Props.Exists ("test.server") then
--                 declare
--                    WS : ASF.Server.Web.AWS_Container;
--                 begin
--                    Application.Add_Converter (Name      => "dateConverter",
--                                               Converter => Date_Converter'Access);
--                    Application.Add_Converter (Name      => "smartDateConverter",
--                                               Converter => Rel_Date_Converter'Access);
--
--                    WS.Register_Application ("/asfunit", Application.all'Access);
--
--                    WS.Start;
--                    delay 6000.0;
--                 end;
--              end if;
            ASF.Server.Tests.Set_Context (Application.all'Access);
         end;
      end if;
   end Initialize;

end AWA.Testsuite;

Disable and comment out the AWS server with the test.server mode


-----------------------------------------------------------------------
--  gen-model -- Model for Code Generator
--  Copyright (C) 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.Strings.Fixed;
with Ada.Strings.Maps;
with DOM.Core.Nodes;
with Gen.Utils;
package body Gen.Model is

   Trim_Chars : constant Ada.Strings.Maps.Character_Set
     := Ada.Strings.Maps.To_Set (" " & ASCII.HT & ASCII.LF & ASCII.CR);

   --  ------------------------------
   --  Get the object unique name.
   --  ------------------------------
   function Get_Name (From : in Definition) return String is
   begin
      return Ada.Strings.Unbounded.To_String (From.Def_Name);
   end Get_Name;

   function Name (From : in Definition) return Ada.Strings.Unbounded.Unbounded_String is
   begin
      return From.Def_Name;
   end Name;

   --  ------------------------------
   --  Set the object unique name.
   --  ------------------------------
   procedure Set_Name (Def  : in out Definition;
                       Name : in String) is
   begin
      Def.Def_Name := Ada.Strings.Unbounded.To_Unbounded_String (Name);
   end Set_Name;

   procedure Set_Name (Def  : in out Definition;
                       Name : in Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Def.Def_Name := Name;
   end Set_Name;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   function Get_Value (From : in Definition;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "comment" then
         return From.Comment;

      elsif Name = "rowIndex" then
         return Util.Beans.Objects.To_Object (From.Row_Index);

      elsif Name = "name" then
         return Util.Beans.Objects.To_Object (From.Def_Name);
      else
         return From.Attrs.Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   function Get_Attribute (From : in Definition;
                           Name : in String) return String is
      V : constant Util.Beans.Objects.Object := From.Get_Value (Name);
   begin
      return Util.Beans.Objects.To_String (V);
   end Get_Attribute;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   function Get_Attribute (From : in Definition;
                           Name : in String) return Ada.Strings.Unbounded.Unbounded_String is
   begin
      return Ada.Strings.Unbounded.To_Unbounded_String (From.Get_Attribute (Name));
   end Get_Attribute;

   --  ------------------------------
   --  Set the comment associated with the element.
   --  ------------------------------
   procedure Set_Comment (Def     : in out Definition;
                          Comment : in String) is
      Trimmed_Comment : constant String := Ada.Strings.Fixed.Trim (Comment, Trim_Chars, Trim_Chars);
   begin
      Def.Comment := Util.Beans.Objects.To_Object (Trimmed_Comment);
   end Set_Comment;

   --  ------------------------------
   --  Get the comment associated with the element.
   --  ------------------------------
   function Get_Comment (Def : in Definition) return Util.Beans.Objects.Object is
   begin
      return Def.Comment;
   end Get_Comment;

   --  ------------------------------
   --  Set the location (file and line) where the model element is defined in the XMI file.
   --  ------------------------------
   procedure Set_Location (Node     : in out Definition;
                           Location : in String) is
   begin
      Node.Location := Ada.Strings.Unbounded.To_Unbounded_String (Location);
   end Set_Location;

   --  ------------------------------
   --  Get the location file and line where the model element is defined.
   --  ------------------------------
   function Get_Location (Node : in Definition) return String is
   begin
      return Ada.Strings.Unbounded.To_String (Node.Location);
   end Get_Location;

   --  ------------------------------
   --  Initialize the definition from the DOM node attributes.
   --  ------------------------------
   procedure Initialize (Def  : in out Definition;
                         Name : in Ada.Strings.Unbounded.Unbounded_String;
                         Node : in DOM.Core.Node) is
      use type DOM.Core.Node;

      Attrs : constant DOM.Core.Named_Node_Map := DOM.Core.Nodes.Attributes (Node);
   begin
      Def.Def_Name := Name;
      Def.Comment := Util.Beans.Objects.To_Object (Gen.Utils.Get_Comment (Node));

      for I in 0 .. DOM.Core.Nodes.Length (Attrs) loop
         declare
            A : constant DOM.Core.Node := DOM.Core.Nodes.Item (Attrs, I);
         begin
            if A /= null then
               declare
                  Name  : constant DOM.Core.DOM_String := DOM.Core.Nodes.Node_Name (A);
                  Value : constant DOM.Core.DOM_String := DOM.Core.Nodes.Node_Value (A);
               begin
                  Def.Attrs.Include (Name, Util.Beans.Objects.To_Object (Value));
               end;
            end if;
         end;
      end loop;
   end Initialize;

   --  ------------------------------
   --  Validate the definition by checking and reporting problems to the logger interface.
   --  ------------------------------
   procedure Validate (Def : in out Definition;
                       Log : in out Util.Log.Logging'Class) is
   begin
      if Ada.Strings.Unbounded.Length (Def.Def_Name) = 0 then
         Log.Error (Def.Get_Location & ": name is empty");
      end if;
   end Validate;

end Gen.Model;

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

   Trim_Chars : constant Ada.Strings.Maps.Character_Set
     := Ada.Strings.Maps.To_Set (" " & ASCII.HT & ASCII.LF & ASCII.CR);

   --  ------------------------------
   --  Get the object unique name.
   --  ------------------------------
   function Get_Name (From : in Definition) return String is
   begin
      return Ada.Strings.Unbounded.To_String (From.Def_Name);
   end Get_Name;

   function Name (From : in Definition) return Ada.Strings.Unbounded.Unbounded_String is
   begin
      return From.Def_Name;
   end Name;

   --  ------------------------------
   --  Set the object unique name.
   --  ------------------------------
   procedure Set_Name (Def  : in out Definition;
                       Name : in String) is
   begin
      Def.Def_Name := Ada.Strings.Unbounded.To_Unbounded_String (Name);
   end Set_Name;

   procedure Set_Name (Def  : in out Definition;
                       Name : in Ada.Strings.Unbounded.Unbounded_String) is
   begin
      Def.Def_Name := Name;
   end Set_Name;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   function Get_Value (From : in Definition;
                       Name : in String) return Util.Beans.Objects.Object is
   begin
      if Name = "comment" then
         return From.Comment;

      elsif Name = "rowIndex" then
         return Util.Beans.Objects.To_Object (From.Row_Index);

      elsif Name = "name" then
         return Util.Beans.Objects.To_Object (From.Def_Name);
      else
         return From.Attrs.Get_Value (Name);
      end if;
   end Get_Value;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   function Get_Attribute (From : in Definition;
                           Name : in String) return String is
      V : constant Util.Beans.Objects.Object := From.Get_Value (Name);
   begin
      return Util.Beans.Objects.To_String (V);
   end Get_Attribute;

   --  ------------------------------
   --  Get the value identified by the name.
   --  If the name cannot be found, the method should return the Null object.
   --  ------------------------------
   function Get_Attribute (From : in Definition;
                           Name : in String) return Ada.Strings.Unbounded.Unbounded_String is
   begin
      return Ada.Strings.Unbounded.To_Unbounded_String (From.Get_Attribute (Name));
   end Get_Attribute;

   --  ------------------------------
   --  Set the comment associated with the element.
   --  ------------------------------
   procedure Set_Comment (Def     : in out Definition;
                          Comment : in String) is
      Trimmed_Comment : constant String
        := Ada.Strings.Fixed.Trim (Comment, Trim_Chars, Trim_Chars);
   begin
      Def.Comment := Util.Beans.Objects.To_Object (Trimmed_Comment);
   end Set_Comment;

   --  ------------------------------
   --  Get the comment associated with the element.
   --  ------------------------------
   function Get_Comment (Def : in Definition) return Util.Beans.Objects.Object is
   begin
      return Def.Comment;
   end Get_Comment;

   --  ------------------------------
   --  Set the location (file and line) where the model element is defined in the XMI file.
   --  ------------------------------
   procedure Set_Location (Node     : in out Definition;
                           Location : in String) is
   begin
      Node.Location := Ada.Strings.Unbounded.To_Unbounded_String (Location);
   end Set_Location;

   --  ------------------------------
   --  Get the location file and line where the model element is defined.
   --  ------------------------------
   function Get_Location (Node : in Definition) return String is
   begin
      return Ada.Strings.Unbounded.To_String (Node.Location);
   end Get_Location;

   --  ------------------------------
   --  Initialize the definition from the DOM node attributes.
   --  ------------------------------
   procedure Initialize (Def  : in out Definition;
                         Name : in Ada.Strings.Unbounded.Unbounded_String;
                         Node : in DOM.Core.Node) is
      use type DOM.Core.Node;

      Attrs : constant DOM.Core.Named_Node_Map := DOM.Core.Nodes.Attributes (Node);
   begin
      Def.Def_Name := Name;
      Def.Comment := Util.Beans.Objects.To_Object (Gen.Utils.Get_Comment (Node));

      for I in 0 .. DOM.Core.Nodes.Length (Attrs) loop
         declare
            A : constant DOM.Core.Node := DOM.Core.Nodes.Item (Attrs, I);
         begin
            if A /= null then
               declare
                  Name  : constant DOM.Core.DOM_String := DOM.Core.Nodes.Node_Name (A);
                  Value : constant DOM.Core.DOM_String := DOM.Core.Nodes.Node_Value (A);
               begin
                  Def.Attrs.Include (Name, Util.Beans.Objects.To_Object (Value));
               end;
            end if;
         end;
      end loop;
   end Initialize;

   --  ------------------------------
   --  Validate the definition by checking and reporting problems to the logger interface.
   --  ------------------------------
   procedure Validate (Def : in out Definition;
                       Log : in out Util.Log.Logging'Class) is
   begin
      if Ada.Strings.Unbounded.Length (Def.Def_Name) = 0 then
         Log.Error (Def.Get_Location & ": name is empty");
      end if;
   end Validate;

end Gen.Model;

Fix style compilation warning

Fix style compilation warning