-----------------------------------------------------------------------
--  Clients - Abstract representation of client information
--  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.Text_IO;
with Ada.Command_Line;

with GNAT.Command_Line;

with Util.Strings;
with Util.Log.Loggers;

with MAT.Commands;
with MAT.Targets.Readers;
package body MAT.Targets is

   --  ------------------------------
   --  Get the console instance.
   --  ------------------------------
   function Console (Target : in Target_Type) return MAT.Consoles.Console_Access is
   begin
      return Target.Console;
   end Console;

   --  ------------------------------
   --  Set the console instance.
   --  ------------------------------
   procedure Console (Target  : in out Target_Type;
                      Console : in MAT.Consoles.Console_Access) is
   begin
      Target.Console := Console;
   end Console;

   --  ------------------------------
   --  Get the current process instance.
   --  ------------------------------
   function Process (Target : in Target_Type) return Target_Process_Type_Access is
   begin
      return Target.Current;
   end Process;

   --  ------------------------------
   --  Initialize the target object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory and other events.
   --  ------------------------------
   procedure Initialize (Target : in out Target_Type;
                         Reader : in out MAT.Readers.Manager_Base'Class) is
   begin
      MAT.Targets.Readers.Initialize (Target => Target,
                                      Reader => Reader);
   end Initialize;

   --  ------------------------------
   --  Create a process instance to hold and keep track of memory and other information about
   --  the given process ID.
   --  ------------------------------
   procedure Create_Process (Target  : in out Target_Type;
                             Pid     : in MAT.Types.Target_Process_Ref;
                             Path    : in Ada.Strings.Unbounded.Unbounded_String;
                             Process : out Target_Process_Type_Access) is
      Path_String : constant String := Ada.Strings.Unbounded.To_String (Path);
   begin
      Process := Target.Find_Process (Pid);
      if Process = null then
         Process := new Target_Process_Type;
         Process.Pid := Pid;
         Process.Path := Path;
         Process.Symbols := MAT.Symbols.Targets.Target_Symbols_Refs.Create;
         Target.Processes.Insert (Pid, Process);
         Target.Console.Notice (MAT.Consoles.N_PID_INFO,
                                "Process" & MAT.Types.Target_Process_Ref'Image (Pid) & " created");
         Target.Console.Notice (MAT.Consoles.N_PATH_INFO,
                                "Path " & Path_String);
         if Target.Options.Load_Symbols then
            MAT.Commands.Symbol_Command (Target, Path_String);
         end if;
      end if;
      if Target.Current = null then
         Target.Current := Process;
      end if;
   end Create_Process;

   --  ------------------------------
   --  Find the process instance from the process ID.
   --  ------------------------------
   function Find_Process (Target : in Target_Type;
                          Pid    : in MAT.Types.Target_Process_Ref)
                          return Target_Process_Type_Access is
      Pos : constant Process_Cursor := Target.Processes.Find (Pid);
   begin
      if Process_Maps.Has_Element (Pos) then
         return Process_Maps.Element (Pos);
      else
         return null;
      end if;
   end Find_Process;

   --  ------------------------------
   --  Convert the string to a socket address.  The string can have two forms:
   --     port
   --     host:port
   --  ------------------------------
   function To_Sock_Addr_Type (Param : in String) return GNAT.Sockets.Sock_Addr_Type is
      Pos    : constant Natural := Util.Strings.Index (Param, ':');
      Result : GNAT.Sockets.Sock_Addr_Type;
   begin
      if Pos > 0 then
         Result.Port := GNAT.Sockets.Port_Type'Value (Param (Pos + 1 .. Param'Last));
         Result.Addr := GNAT.Sockets.Inet_Addr (Param (Param'First .. Pos - 1));
      else
         Result.Port := GNAT.Sockets.Port_Type'Value (Param);
         Result.Addr := GNAT.Sockets.Any_Inet_Addr;
      end if;
      return Result;
   end To_Sock_Addr_Type;

   --  ------------------------------
   --  Print the application usage.
   --  ------------------------------
   procedure Usage is
      use Ada.Text_IO;
   begin
      Put_Line ("Usage: mat [-i] [-nw] [-ns] [-b [ip:]port] [file.mat]");
      Put_Line ("-i            Enable the interactive mode");
      Put_Line ("-nw           Disable the graphical mode");
      Put_Line ("-b [ip:]port  Define the port and local address to bind");
      Put_Line ("-ns           Disable the automatic symbols loading");
      Ada.Command_Line.Set_Exit_Status (2);
      raise Usage_Error;
   end Usage;

   --  ------------------------------
   --  Parse the command line arguments and configure the target instance.
   --  ------------------------------
   procedure Initialize_Options (Target  : in out MAT.Targets.Target_Type) is
   begin
      Util.Log.Loggers.Initialize ("matp.properties");
      GNAT.Command_Line.Initialize_Option_Scan (Stop_At_First_Non_Switch => True,
                                                Section_Delimiters       => "targs");
      loop
         case GNAT.Command_Line.Getopt ("i nw ns b:") is
            when ASCII.NUL =>
               exit;

            when 'i' =>
               Target.Options.Interactive := True;

            when 'b' =>
               Target.Options.Address := To_Sock_Addr_Type (GNAT.Command_Line.Parameter);

            when 'n' =>
               if GNAT.Command_Line.Full_Switch = "nw" then
                  Target.Options.Graphical := False;
               else
                  Target.Options.Load_Symbols := False;
               end if;

            when '*' =>
               exit;

            when others =>
               Usage;

         end case;
      end loop;

   exception
      when Usage_Error =>
         raise;

      when others =>
         Usage;

   end Initialize_Options;

end MAT.Targets;

-----------------------------------------------------------------------
--  Clients - Abstract representation of client information
--  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.Text_IO;
with Ada.Command_Line;

with GNAT.Command_Line;

with Util.Strings;
with Util.Log.Loggers;

with MAT.Commands;
with MAT.Targets.Readers;
package body MAT.Targets is

   --  ------------------------------
   --  Get the console instance.
   --  ------------------------------
   function Console (Target : in Target_Type) return MAT.Consoles.Console_Access is
   begin
      return Target.Console;
   end Console;

   --  ------------------------------
   --  Set the console instance.
   --  ------------------------------
   procedure Console (Target  : in out Target_Type;
                      Console : in MAT.Consoles.Console_Access) is
   begin
      Target.Console := Console;
   end Console;

   --  ------------------------------
   --  Get the current process instance.
   --  ------------------------------
   function Process (Target : in Target_Type) return Target_Process_Type_Access is
   begin
      return Target.Current;
   end Process;

   --  ------------------------------
   --  Initialize the target object to manage the memory slots, the stack frames
   --  and setup the reader to analyze the memory and other events.
   --  ------------------------------
   procedure Initialize (Target : in out Target_Type;
                         Reader : in out MAT.Readers.Manager_Base'Class) is
   begin
      MAT.Targets.Readers.Initialize (Target => Target,
                                      Reader => Reader);
   end Initialize;

   --  ------------------------------
   --  Create a process instance to hold and keep track of memory and other information about
   --  the given process ID.
   --  ------------------------------
   procedure Create_Process (Target  : in out Target_Type;
                             Pid     : in MAT.Types.Target_Process_Ref;
                             Path    : in Ada.Strings.Unbounded.Unbounded_String;
                             Process : out Target_Process_Type_Access) is
      Path_String : constant String := Ada.Strings.Unbounded.To_String (Path);
   begin
      Process := Target.Find_Process (Pid);
      if Process = null then
         Process := new Target_Process_Type;
         Process.Pid := Pid;
         Process.Path := Path;
         Process.Symbols := MAT.Symbols.Targets.Target_Symbols_Refs.Create;
         Target.Processes.Insert (Pid, Process);
         Target.Console.Notice (MAT.Consoles.N_PID_INFO,
                                "Process" & MAT.Types.Target_Process_Ref'Image (Pid) & " created");
         Target.Console.Notice (MAT.Consoles.N_PATH_INFO,
                                "Path " & Path_String);
         if Target.Options.Load_Symbols then
            MAT.Commands.Symbol_Command (Target, Path_String);
         end if;
      end if;
      if Target.Current = null then
         Target.Current := Process;
      end if;
   end Create_Process;

   --  ------------------------------
   --  Find the process instance from the process ID.
   --  ------------------------------
   function Find_Process (Target : in Target_Type;
                          Pid    : in MAT.Types.Target_Process_Ref)
                          return Target_Process_Type_Access is
      Pos : constant Process_Cursor := Target.Processes.Find (Pid);
   begin
      if Process_Maps.Has_Element (Pos) then
         return Process_Maps.Element (Pos);
      else
         return null;
      end if;
   end Find_Process;

   --  ------------------------------
   --  Convert the string to a socket address.  The string can have two forms:
   --     port
   --     host:port
   --  ------------------------------
   function To_Sock_Addr_Type (Param : in String) return GNAT.Sockets.Sock_Addr_Type is
      Pos    : constant Natural := Util.Strings.Index (Param, ':');
      Result : GNAT.Sockets.Sock_Addr_Type;
   begin
      if Pos > 0 then
         Result.Port := GNAT.Sockets.Port_Type'Value (Param (Pos + 1 .. Param'Last));
         Result.Addr := GNAT.Sockets.Inet_Addr (Param (Param'First .. Pos - 1));
      else
         Result.Port := GNAT.Sockets.Port_Type'Value (Param);
         Result.Addr := GNAT.Sockets.Any_Inet_Addr;
      end if;
      return Result;
   end To_Sock_Addr_Type;

   --  ------------------------------
   --  Print the application usage.
   --  ------------------------------
   procedure Usage is
      use Ada.Text_IO;
   begin
      Put_Line ("Usage: mat [-i] [-nw] [-ns] [-b [ip:]port] [file.mat]");
      Put_Line ("-i            Enable the interactive mode");
      Put_Line ("-nw           Disable the graphical mode");
      Put_Line ("-b [ip:]port  Define the port and local address to bind");
      Put_Line ("-ns           Disable the automatic symbols loading");
      Ada.Command_Line.Set_Exit_Status (2);
      raise Usage_Error;
   end Usage;

   --  ------------------------------
   --  Parse the command line arguments and configure the target instance.
   --  ------------------------------
   procedure Initialize_Options (Target  : in out MAT.Targets.Target_Type) is
   begin
      Util.Log.Loggers.Initialize ("matp.properties");
      GNAT.Command_Line.Initialize_Option_Scan (Stop_At_First_Non_Switch => True,
                                                Section_Delimiters       => "targs");
      loop
         case GNAT.Command_Line.Getopt ("i nw ns b:") is
            when ASCII.NUL =>
               exit;

            when 'i' =>
               Target.Options.Interactive := True;

            when 'b' =>
               Target.Options.Address := To_Sock_Addr_Type (GNAT.Command_Line.Parameter);

            when 'n' =>
               if GNAT.Command_Line.Full_Switch = "nw" then
                  Target.Options.Graphical := False;
               else
                  Target.Options.Load_Symbols := False;
               end if;

            when '*' =>
               exit;

            when others =>
               Usage;

         end case;
      end loop;

   exception
      when Usage_Error =>
         raise;

      when others =>
         Usage;

   end Initialize_Options;

   --  ------------------------------
   --  Start the server to listen to MAT event socket streams.
   --  ------------------------------
   procedure Start (Target : in out Target_Type) is
   begin
      Target.Server.Start (Target.Options.Address);
   end Start;

end MAT.Targets;

Implement the Start procedure

Implement the Start procedure


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

   use Ada.Text_IO;
   use Ada.Strings.Unbounded;

   --  ------------------------------
   --  Execute the wifi 'status' command to print the Wifi current status.
   --  ------------------------------
   procedure Do_Status (Command   : in Command_Type;
                        Args      : in Argument_List'Class;
                        Context   : in out Context_Type) is
      Console : constant Druss.Commands.Consoles.Console_Access := Context.Console;
      N : Natural := 0;

      procedure Box_Status (Gateway : in out Druss.Gateways.Gateway_Type) is
      begin
         Gateway.Refresh;
         Console.Start_Row;
         Console.Print_Field (F_IP_ADDR, Gateway.Ip);
         Console.Print_Field (F_WAN_IP, Gateway.Wan.Get ("wan.ip.address", " "));
         Print_Status (Console, F_INTERNET, Gateway.Wan.Get ("wan.internet.state", " "));
         Console.Print_Field (F_VOIP, Gateway.Voip.Get ("voip.status", " "));
         Print_On_Off (Console, F_WIFI, Gateway.Wifi.Get ("wireless.radio.24.enable", " "));
         if not Gateway.Wifi.Exists ("wireless.radio.5.enable") then
            Console.Print_Field (F_WIFI5, "");
         else
            Print_On_Off (Console, F_WIFI5, Gateway.Wifi.Get ("wireless.radio.5.enable", " "));
         end if;
         Console.Print_Field (F_ACCESS_CONTROL, Gateway.IPtv.Get ("iptv.0.address", "x"));
         Console.End_Row;
         N := N + 1;
         Gateway.IPtv.Save_Properties ("iptv" & Util.Strings.Image (N) & ".properties");
      end Box_Status;

   begin
      Console.Start_Title;
      Console.Print_Title (F_IP_ADDR, "LAN IP", 15);
      Console.Print_Title (F_WAN_IP, "WAN IP", 15);
      Console.Print_Title (F_INTERNET, "Internet", 9);
      Console.Print_Title (F_VOIP, "VoIP", 6);
      Console.Print_Title (F_WIFI, "Wifi 2.4G", 10);
      Console.Print_Title (F_WIFI5, "Wifi 5G", 10);
      Console.Print_Title (F_ACCESS_CONTROL, "Parental", 10);
      Console.Print_Title (F_DYNDNS, "DynDNS", 10);
      Console.Print_Title (F_DEVICES, "Devices", 12);
      Console.End_Title;
      Druss.Gateways.Iterate (Context.Gateways, Box_Status'Access);
   end Do_Status;

   --  Execute a status command to report information about the Bbox.
   overriding
   procedure Execute (Command   : in Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is
   begin
      Command.Do_Status (Args, Context);
   end Execute;

   --  Write the help associated with the command.
   overriding
   procedure Help (Command   : in Command_Type;
                   Context   : in out Context_Type) is
   begin
      Put_Line ("status: Control and get status about the Bbox Wifi");
      Put_Line ("Usage: wifi {<action>} [<parameters>]");
      New_Line;
      Put_Line ("  status [IP]...         Turn ON the wifi on the Bbox.");
      Put_Line ("  wifi off [IP]...        Turn OFF the wifi on the Bbox.");
      Put_Line ("  wifi show               Show information about the wifi on the Bbox.");
      Put_Line ("  wifi devices            Show the wifi devices which are connected.");
   end Help;

end Druss.Commands.Status;

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

   use Ada.Text_IO;
   use Ada.Strings.Unbounded;

   --  ------------------------------
   --  Execute the wifi 'status' command to print the Wifi current status.
   --  ------------------------------
   procedure Do_Status (Command   : in Command_Type;
                        Args      : in Argument_List'Class;
                        Context   : in out Context_Type) is
      Console : constant Druss.Commands.Consoles.Console_Access := Context.Console;
      N : Natural := 0;

      procedure Box_Status (Gateway : in out Druss.Gateways.Gateway_Type) is
      begin
         Gateway.Refresh;
         Console.Start_Row;
         Console.Print_Field (F_IP_ADDR, Gateway.Ip);
         Console.Print_Field (F_WAN_IP, Gateway.Wan.Get ("wan.ip.address", " "));
         Print_Status (Console, F_INTERNET, Gateway.Wan.Get ("wan.internet.state", " "));
         Console.Print_Field (F_VOIP, Gateway.Voip.Get ("voip.0.status", " "));
         Print_On_Off (Console, F_WIFI, Gateway.Wifi.Get ("wireless.radio.24.enable", " "));
         if not Gateway.Wifi.Exists ("wireless.radio.5.enable") then
            Console.Print_Field (F_WIFI5, "");
         else
            Print_On_Off (Console, F_WIFI5, Gateway.Wifi.Get ("wireless.radio.5.enable", " "));
         end if;
         Console.Print_Field (F_ACCESS_CONTROL, Gateway.IPtv.Get ("iptv.length", "x"));
         Console.Print_Field (F_DEVICES, Gateway.Hosts.Get ("hosts.list.length", ""));
         Print_Uptime (Console, F_UPTIME, Gateway.Device.Get ("device.uptime", ""));
         Console.End_Row;
         N := N + 1;
         Gateway.Hosts.Save_Properties ("sum-" & Util.Strings.Image (N) & ".properties");
      end Box_Status;

   begin
      Console.Start_Title;
      Console.Print_Title (F_IP_ADDR, "LAN IP", 16);
      Console.Print_Title (F_WAN_IP, "WAN IP", 16);
      Console.Print_Title (F_INTERNET, "Internet", 9);
      Console.Print_Title (F_VOIP, "VoIP", 6);
      Console.Print_Title (F_WIFI, "Wifi 2.4G", 10);
      Console.Print_Title (F_WIFI5, "Wifi 5G", 10);
      Console.Print_Title (F_ACCESS_CONTROL, "Parental", 10);
      Console.Print_Title (F_DYNDNS, "DynDNS", 10);
      Console.Print_Title (F_DEVICES, "Devices", 12);
      Console.Print_Title (F_UPTIME, "Uptime", 12);
      Console.End_Title;
      Druss.Gateways.Iterate (Context.Gateways, Gateways.ITER_ENABLE, Box_Status'Access);
   end Do_Status;

   --  Execute a status command to report information about the Bbox.
   overriding
   procedure Execute (Command   : in Command_Type;
                      Name      : in String;
                      Args      : in Argument_List'Class;
                      Context   : in out Context_Type) is
   begin
      Command.Do_Status (Args, Context);
   end Execute;

   --  Write the help associated with the command.
   overriding
   procedure Help (Command   : in Command_Type;
                   Context   : in out Context_Type) is
   begin
      Put_Line ("status: Control and get status about the Bbox Wifi");
      Put_Line ("Usage: wifi {<action>} [<parameters>]");
      New_Line;
      Put_Line ("  status [IP]...         Turn ON the wifi on the Bbox.");
      Put_Line ("  wifi off [IP]...        Turn OFF the wifi on the Bbox.");
      Put_Line ("  wifi show               Show information about the wifi on the Bbox.");
      Put_Line ("  wifi devices            Show the wifi devices which are connected.");
   end Help;

end Druss.Commands.Status;

Add more useful information for the device command


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

package AWA is

   pragma Preelaborate;

   --  Library SVN identification
   SVN_URL : constant String := "$HeadURL: file:///opt/repository/svn/ada/awa/trunk/src/awa.ads $";

   --  Revision used (must run 'make version' to update)
   SVN_REV : constant String := "$Rev: 318 $";

end AWA;

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

package AWA is

   pragma Pure;

   --  Library SVN identification
   SVN_URL : constant String := "$HeadURL: file:///opt/repository/svn/ada/awa/trunk/src/awa.ads $";

   --  Revision used (must run 'make version' to update)
   SVN_REV : constant String := "$Rev: 318 $";

end AWA;

Make the package Pure

Make the package Pure


--  This file is covered by the Internet Software Consortium (ISC) License
--  Reference: ../License.txt

with Ada.Text_IO;
with Ada.Characters.Latin_1;

package body Port_Specification.Makefile is

   package TIO renames Ada.Text_IO;
   package LAT renames Ada.Characters.Latin_1;

   --------------------------------------------------------------------------------------------
   --  generator
   --------------------------------------------------------------------------------------------
   procedure generator
     (specs         : Portspecs;
      variant       : String;
      opsys         : supported_opsys;
      arch_standard : supported_arch;
      osrelease     : String;
      osmajor       : String;
      osversion     : String;
      option_string : String;
      output_file   : String
     )
   is
      procedure send (data : String; use_put : Boolean := False);
      procedure send (varname, value : String);
      procedure send (varname : String; value : HT.Text);
      procedure send (varname : String; crate : string_crate.Vector; flavor : Positive := 1);
      procedure send (varname : String; crate : list_crate.Map);
      procedure send (varname : String; value : Boolean; dummy : Boolean);
      procedure send (varname : String; value, default : Integer);
      procedure print_item (position : string_crate.Cursor);
      procedure dump_list (position : list_crate.Cursor);
      procedure dump_distfiles (position : string_crate.Cursor);
      procedure dump_ext_zip   (position : string_crate.Cursor);
      procedure dump_ext_7z    (position : string_crate.Cursor);
      procedure dump_ext_lha   (position : string_crate.Cursor);
--      procedure dump_ext_HT    (position : string_crate.Cursor);

      write_to_file   : constant Boolean := (output_file /= "");
      makefile_handle : TIO.File_Type;
      varname_prefix  : HT.Text;

      procedure send (data : String;  use_put : Boolean := False) is
      begin
         if write_to_file then
            if use_put then
               TIO.Put (makefile_handle, data);
            else
               TIO.Put_Line (makefile_handle, data);
            end if;
         else
            if use_put then
               TIO.Put (data);
            else
               TIO.Put_Line (data);
            end if;
         end if;
      end send;

      procedure send (varname, value : String) is
      begin
         send (varname & LAT.Equals_Sign & value);
      end send;

      procedure send (varname : String; value : HT.Text) is
      begin
         if not HT.IsBlank (value) then
            send (varname & LAT.Equals_Sign & HT.USS (value));
         end if;
      end send;

      procedure send (varname : String; value : Boolean; dummy : Boolean) is
      begin
         if value then
            send (varname & LAT.Equals_Sign & "yes");
         end if;
      end send;

      procedure send (varname : String; value, default : Integer) is
      begin
         if value /= default then
            send (varname & LAT.Equals_Sign & HT.int2str (value));
         end if;
      end send;

      procedure send (varname : String; crate : string_crate.Vector; flavor : Positive := 1) is
      begin
         if crate.Is_Empty then
            return;
         end if;
         case flavor is
            when 1 =>
               send (varname & "=", True);
               crate.Iterate (Process => print_item'Access);
               send ("");
            when 2 =>
               varname_prefix := HT.SUS (varname);
               crate.Iterate (Process => dump_distfiles'Access);
            when 3 =>
               crate.Iterate (Process => dump_ext_zip'Access);
            when 4 =>
               crate.Iterate (Process => dump_ext_7z'Access);
            when 5 =>
               crate.Iterate (Process => dump_ext_lha'Access);
            when others =>
               null;
         end case;
      end send;

      procedure send (varname : String; crate : list_crate.Map) is
      begin
         varname_prefix := HT.SUS (varname);
         crate.Iterate (Process => dump_list'Access);
      end send;

      procedure dump_list (position : list_crate.Cursor)
      is
         NDX : String := HT.USS (varname_prefix)  & "_" &
                         HT.USS (list_crate.Element (position).group) & LAT.Equals_Sign;
      begin
         send (NDX, True);
         list_crate.Element (position).list.Iterate (Process => print_item'Access);
         send ("");
      end dump_list;

      procedure print_item (position : string_crate.Cursor)
      is
         index : Natural := string_crate.To_Index (position);
      begin
         if index > 1 then
            send (" ", True);
         end if;
         send (HT.USS (string_crate.Element (position)), True);
      end print_item;

      procedure dump_distfiles (position : string_crate.Cursor)
      is
         index : Natural := string_crate.To_Index (position);
         NDX   : String  := HT.USS (varname_prefix)  & "_" & HT.int2str (index) & LAT.Equals_Sign;
      begin
         send (NDX & HT.USS (string_crate.Element (position)));
      end dump_distfiles;

      procedure dump_ext_zip (position : string_crate.Cursor)
      is
         N : String := HT.USS (string_crate.Element (position));
      begin
         send ("EXTRACT_HEAD_" & N & "=/usr/bin/unzip -qo");
         send ("EXTRACT_TAIL_" & N & "=-d ${EXTRACT_WRKDIR_" & N & "}");
      end dump_ext_zip;

      procedure dump_ext_7z (position : string_crate.Cursor)
      is
         N : String := HT.USS (string_crate.Element (position));
      begin
         send ("EXTRACT_HEAD_" & N & "=7z x -bd -y -o${EXTRACT_WRKDIR_" & N & "} >/dev/null");
         send ("EXTRACT_TAIL_" & N & "=# empty");
      end dump_ext_7z;

      procedure dump_ext_lha (position : string_crate.Cursor)
      is
         N : String := HT.USS (string_crate.Element (position));
      begin
         send ("EXTRACT_HEAD_" & N & "=lha xfpw=${EXTRACT_WRKDIR_" & N & "}");
         send ("EXTRACT_TAIL_" & N & "=# empty");
      end dump_ext_lha;

--        procedure dump_ext_HT (position : string_crate.Cursor)
--        is
--           index : Natural := string_crate.To_Index (position);
--        begin
--        end dump_ext_HT;

   begin
      if not specs.variant_exists (variant) then
         TIO.Put_Line ("Error : Variant '" & variant & "' does not exist!");
         return;
      end if;

      if write_to_file then
        TIO.Create (File => makefile_handle,
                    Mode => TIO.Out_File,
                    Name => output_file);
      end if;

      --  TODO: Check these to see if they are actually used.
      --  The pkg manifests did use many of these, but they will be generated by ravenadm

      send ("# Makefile has been autogenerated by ravenadm tool" & LAT.LF);

      send ("NAMEBASE",         HT.USS (specs.namebase));
      send ("VERSION",          HT.USS (specs.version));
      send ("REVISION",         specs.revision, 0);
      send ("EPOCH",            specs.epoch, 0);
      send ("KEYWORDS",         specs.keywords);    --  probably remove
      send ("VARIANT",          variant);
      send ("DL_SITES",         specs.dl_sites);
      send ("DISTFILE",         specs.distfiles, 2);
      send ("DIST_SUBDIR",      specs.dist_subdir);
      send ("DISTNAME",         specs.distname);
      send ("DF_INDEX",         specs.df_index);
      send ("EXTRACT_ONLY",     specs.extract_only);
      send ("ZIP-EXTRACT",      specs.extract_zip, 3);
      send ("7Z-EXTRACT",       specs.extract_7z, 4);
      send ("LHA-EXTRACT",      specs.extract_lha, 5);
      send ("NO_BUILD",         specs.skip_build, True);
      send ("SINGLE_JOB",       specs.single_job, True);
      send ("DESTDIR_VIA_ENV",  specs.destdir_env, True);
      send ("BUILD_WRKSRC",     specs.build_wrksrc);
      send ("MAKEFILE",         specs.makefile);
      send ("MAKE_ENV",         specs.make_env);
      send ("MAKE_ARGS",        specs.make_args);
      send ("CFLAGS",           specs.cflags);

      --  TODO: This is not correct, placeholder.  rethink.
      send (".include " & LAT.Quotation & "/usr/raven/share/mk/raven.mk" & LAT.Quotation);

      if write_to_file then
         TIO.Close (makefile_handle);
      end if;
   exception
      when others =>
         if TIO.Is_Open (makefile_handle) then
            TIO.Close (makefile_handle);
         end if;
   end generator;

end Port_Specification.Makefile;

--  This file is covered by the Internet Software Consortium (ISC) License
--  Reference: ../License.txt

with Ada.Text_IO;
with Ada.Characters.Latin_1;

package body Port_Specification.Makefile is

   package TIO renames Ada.Text_IO;
   package LAT renames Ada.Characters.Latin_1;

   --------------------------------------------------------------------------------------------
   --  generator
   --------------------------------------------------------------------------------------------
   procedure generator
     (specs         : Portspecs;
      variant       : String;
      opsys         : supported_opsys;
      arch_standard : supported_arch;
      osrelease     : String;
      osmajor       : String;
      osversion     : String;
      option_string : String;
      output_file   : String
     )
   is
      procedure send (data : String; use_put : Boolean := False);
      procedure send (varname, value : String);
      procedure send (varname : String; value : HT.Text);
      procedure send (varname : String; crate : string_crate.Vector; flavor : Positive := 1);
      procedure send (varname : String; crate : list_crate.Map; flavor : Positive := 1);
      procedure send (varname : String; value : Boolean; dummy : Boolean);
      procedure send (varname : String; value, default : Integer);
      procedure print_item (position : string_crate.Cursor);
      procedure dump_list (position : list_crate.Cursor);
      procedure dump_distfiles (position : string_crate.Cursor);
      procedure dump_ext_zip   (position : string_crate.Cursor);
      procedure dump_ext_7z    (position : string_crate.Cursor);
      procedure dump_ext_lha   (position : string_crate.Cursor);
      procedure dump_extract_head_tail (position : list_crate.Cursor);

      write_to_file   : constant Boolean := (output_file /= "");
      makefile_handle : TIO.File_Type;
      varname_prefix  : HT.Text;

      procedure send (data : String;  use_put : Boolean := False) is
      begin
         if write_to_file then
            if use_put then
               TIO.Put (makefile_handle, data);
            else
               TIO.Put_Line (makefile_handle, data);
            end if;
         else
            if use_put then
               TIO.Put (data);
            else
               TIO.Put_Line (data);
            end if;
         end if;
      end send;

      procedure send (varname, value : String) is
      begin
         send (varname & LAT.Equals_Sign & value);
      end send;

      procedure send (varname : String; value : HT.Text) is
      begin
         if not HT.IsBlank (value) then
            send (varname & LAT.Equals_Sign & HT.USS (value));
         end if;
      end send;

      procedure send (varname : String; value : Boolean; dummy : Boolean) is
      begin
         if value then
            send (varname & LAT.Equals_Sign & "yes");
         end if;
      end send;

      procedure send (varname : String; value, default : Integer) is
      begin
         if value /= default then
            send (varname & LAT.Equals_Sign & HT.int2str (value));
         end if;
      end send;

      procedure send (varname : String; crate : string_crate.Vector; flavor : Positive := 1) is
      begin
         if crate.Is_Empty then
            return;
         end if;
         case flavor is
            when 1 =>
               send (varname & "=", True);
               crate.Iterate (Process => print_item'Access);
               send ("");
            when 2 =>
               varname_prefix := HT.SUS (varname);
               crate.Iterate (Process => dump_distfiles'Access);
            when 3 =>
               crate.Iterate (Process => dump_ext_zip'Access);
            when 4 =>
               crate.Iterate (Process => dump_ext_7z'Access);
            when 5 =>
               crate.Iterate (Process => dump_ext_lha'Access);
            when others =>
               null;
         end case;
      end send;

      procedure send (varname : String; crate : list_crate.Map; flavor : Positive := 1) is
      begin
         varname_prefix := HT.SUS (varname);
         case flavor is
            when 1 => crate.Iterate (Process => dump_list'Access);
            when 6 => crate.Iterate (Process => dump_extract_head_tail'Access);
            when others => null;
         end case;
      end send;

      procedure dump_list (position : list_crate.Cursor)
      is
         NDX : String := HT.USS (varname_prefix)  & "_" &
                         HT.USS (list_crate.Element (position).group) & LAT.Equals_Sign;
      begin
         send (NDX, True);
         list_crate.Element (position).list.Iterate (Process => print_item'Access);
         send ("");
      end dump_list;

      procedure dump_extract_head_tail (position : list_crate.Cursor)
      is
         NDX : String := HT.USS (varname_prefix)  & "_" &
                         HT.USS (list_crate.Element (position).group) & LAT.Equals_Sign;
      begin
         if not list_crate.Element (position).list.Is_Empty then
            send (NDX, True);
            list_crate.Element (position).list.Iterate (Process => print_item'Access);
            send ("");
         end if;
      end dump_extract_head_tail;

      procedure print_item (position : string_crate.Cursor)
      is
         index : Natural := string_crate.To_Index (position);
      begin
         if index > 1 then
            send (" ", True);
         end if;
         send (HT.USS (string_crate.Element (position)), True);
      end print_item;

      procedure dump_distfiles (position : string_crate.Cursor)
      is
         index : Natural := string_crate.To_Index (position);
         NDX   : String  := HT.USS (varname_prefix)  & "_" & HT.int2str (index) & LAT.Equals_Sign;
      begin
         send (NDX & HT.USS (string_crate.Element (position)));
      end dump_distfiles;

      procedure dump_ext_zip (position : string_crate.Cursor)
      is
         N : String := HT.USS (string_crate.Element (position));
      begin
         send ("EXTRACT_HEAD_" & N & "=/usr/bin/unzip -qo");
         send ("EXTRACT_TAIL_" & N & "=-d ${EXTRACT_WRKDIR_" & N & "}");
      end dump_ext_zip;

      procedure dump_ext_7z (position : string_crate.Cursor)
      is
         N : String := HT.USS (string_crate.Element (position));
      begin
         send ("EXTRACT_HEAD_" & N & "=7z x -bd -y -o${EXTRACT_WRKDIR_" & N & "} >/dev/null");
         send ("EXTRACT_TAIL_" & N & "=# empty");
      end dump_ext_7z;

      procedure dump_ext_lha (position : string_crate.Cursor)
      is
         N : String := HT.USS (string_crate.Element (position));
      begin
         send ("EXTRACT_HEAD_" & N & "=lha xfpw=${EXTRACT_WRKDIR_" & N & "}");
         send ("EXTRACT_TAIL_" & N & "=# empty");
      end dump_ext_lha;

   begin
      if not specs.variant_exists (variant) then
         TIO.Put_Line ("Error : Variant '" & variant & "' does not exist!");
         return;
      end if;

      if write_to_file then
        TIO.Create (File => makefile_handle,
                    Mode => TIO.Out_File,
                    Name => output_file);
      end if;

      --  TODO: Check these to see if they are actually used.
      --  The pkg manifests did use many of these, but they will be generated by ravenadm

      send ("# Makefile has been autogenerated by ravenadm tool" & LAT.LF);

      send ("NAMEBASE",         HT.USS (specs.namebase));
      send ("VERSION",          HT.USS (specs.version));
      send ("REVISION",         specs.revision, 0);
      send ("EPOCH",            specs.epoch, 0);
      send ("KEYWORDS",         specs.keywords);    --  probably remove
      send ("VARIANT",          variant);
      send ("DL_SITES",         specs.dl_sites);
      send ("DISTFILE",         specs.distfiles, 2);
      send ("DIST_SUBDIR",      specs.dist_subdir);
      send ("DISTNAME",         specs.distname);
      send ("DF_INDEX",         specs.df_index);
      send ("EXTRACT_ONLY",     specs.extract_only);
      send ("ZIP-EXTRACT",      specs.extract_zip, 3);
      send ("7Z-EXTRACT",       specs.extract_7z, 4);
      send ("LHA-EXTRACT",      specs.extract_lha, 5);
      send ("EXTRACT_HEAD",     specs.extract_head, 6);
      send ("EXTRACT_TAIL",     specs.extract_tail, 6);
      send ("NO_BUILD",         specs.skip_build, True);
      send ("SINGLE_JOB",       specs.single_job, True);
      send ("DESTDIR_VIA_ENV",  specs.destdir_env, True);
      send ("BUILD_WRKSRC",     specs.build_wrksrc);
      send ("MAKEFILE",         specs.makefile);
      send ("MAKE_ENV",         specs.make_env);
      send ("MAKE_ARGS",        specs.make_args);
      send ("CFLAGS",           specs.cflags);

      --  TODO: This is not correct, placeholder.  rethink.
      send (".include " & LAT.Quotation & "/usr/raven/share/mk/raven.mk" & LAT.Quotation);

      if write_to_file then
         TIO.Close (makefile_handle);
      end if;
   exception
      when others =>
         if TIO.Is_Open (makefile_handle) then
            TIO.Close (makefile_handle);
         end if;
   end generator;

end Port_Specification.Makefile;

Support EXTRACT_HEAD/EXTRACT_TAIL in makefile generation


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

with ASF.Contexts.Faces;
with ASF.Contexts.Flash;
with ASF.Sessions;
with ASF.Principals;
with ASF.Cookies;
with ASF.Events.Faces.Actions;
with ASF.Applications.Messages.Factory;

with GNAT.MD5;

with Security.OpenID;
with ASF.Security.Filters;

with Util.Strings.Transforms;
package body Users is

   use Ada.Strings.Unbounded;
   use Security.OpenID;
   use type ASF.Principals.Principal_Access;
   use type ASF.Contexts.Faces.Faces_Context_Access;

   procedure Remove_Cookie (Name : in String);

   --  ------------------------------
   --  Given an Email address, return the Gravatar link to the user image.
   --  (See http://en.gravatar.com/site/implement/hash/ and
   --  http://en.gravatar.com/site/implement/images/)
   --  ------------------------------
   function Get_Gravatar_Link (Email : in String) return String is
      E : constant String := Util.Strings.Transforms.To_Lower_Case (Email);
      C : constant GNAT.MD5.Message_Digest := GNAT.MD5.Digest (E);
   begin
      return "http://www.gravatar.com/avatar/" & C;
   end Get_Gravatar_Link;

   --  ------------------------------
   --  Get the user information identified by the given name.
   --  ------------------------------
   function Get_Value (From : in User_Info;
                       Name : in String) return Util.Beans.Objects.Object is
      pragma Unreferenced (From);

      F : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      S : ASF.Sessions.Session;
      P : ASF.Principals.Principal_Access := null;
      U : Security.OpenID.Principal_Access := null;
   begin
      if F /= null then
         S := F.Get_Session;
         if S.Is_Valid then
            P := S.Get_Principal;
            if P /= null then
               U := Security.OpenID.Principal'Class (P.all)'Access;
            end if;
         end if;
      end if;
      if Name = "authenticated" then
         return Util.Beans.Objects.To_Object (U /= null);
      end if;
      if U = null then
         return Util.Beans.Objects.Null_Object;
      end if;
      if Name = "email" then
         return Util.Beans.Objects.To_Object (U.Get_Email);
      end if;
      if Name = "language" then
         return Util.Beans.Objects.To_Object (Get_Language (U.Get_Authentication));
      end if;
      if Name = "first_name" then
         return Util.Beans.Objects.To_Object (Get_First_Name (U.Get_Authentication));
      end if;
      if Name = "last_name" then
         return Util.Beans.Objects.To_Object (Get_Last_Name (U.Get_Authentication));
      end if;
      if Name = "full_name" then
         return Util.Beans.Objects.To_Object (Get_Full_Name (U.Get_Authentication));
      end if;
      if Name = "id" then
         return Util.Beans.Objects.To_Object (Get_Claimed_Id (U.Get_Authentication));
      end if;
      if Name = "country" then
         return Util.Beans.Objects.To_Object (Get_Country (U.Get_Authentication));
      end if;
      if Name = "sessionId" then
         return Util.Beans.Objects.To_Object (S.Get_Id);
      end if;
      if Name = "gravatar" then
         return Util.Beans.Objects.To_Object (Get_Gravatar_Link (U.Get_Email));
      end if;

      return Util.Beans.Objects.To_Object (U.Get_Name);
   end Get_Value;

   --  ------------------------------
   --  Helper to send a remove cookie in the current response
   --  ------------------------------
   procedure Remove_Cookie (Name : in String) is
      Ctx : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      C   : ASF.Cookies.Cookie := ASF.Cookies.Create (Name, "");
   begin
      ASF.Cookies.Set_Path (C, Ctx.Get_Request.Get_Context_Path);
      ASF.Cookies.Set_Max_Age (C, 0);
      Ctx.Get_Response.Add_Cookie (Cookie => C);
   end Remove_Cookie;

   --  ------------------------------
   --  Logout by dropping the user session.
   --  ------------------------------
   procedure Logout (From    : in out User_Info;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (From);

      F : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      S : ASF.Sessions.Session := F.Get_Session;
      P : ASF.Principals.Principal_Access := null;
      U : Security.OpenID.Principal_Access := null;
   begin
      if S.Is_Valid then
         P := S.Get_Principal;
         if P /= null then
            U := Security.OpenID.Principal'Class (P.all)'Access;
         end if;
         S.Invalidate;
      end if;
      if U /= null then
         F.Get_Flash.Set_Keep_Messages (True);
         ASF.Applications.Messages.Factory.Add_Message (F.all, "samples.openid_logout_message",
                                                        Get_Full_Name (U.Get_Authentication));
      end if;
      Remove_Cookie (ASF.Security.Filters.SID_COOKIE);
      Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("logout_success");
   end Logout;

   package Logout_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => User_Info,
                                                      Method => Logout,
                                                      Name   => "logout");

   Binding_Array : aliased constant Util.Beans.Methods.Method_Binding_Array
     := (1 => Logout_Binding.Proxy'Unchecked_Access);

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

end Users;

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

with ASF.Contexts.Faces;
with ASF.Contexts.Flash;
with ASF.Sessions;
with ASF.Principals;
with ASF.Cookies;
with ASF.Events.Faces.Actions;
with ASF.Applications.Messages.Factory;

with GNAT.MD5;

with Security.Auth;
with ASF.Security.Filters;

with Util.Strings.Transforms;
package body Users is

   use Ada.Strings.Unbounded;
   use Security.Auth;
   use type ASF.Principals.Principal_Access;
   use type ASF.Contexts.Faces.Faces_Context_Access;

   procedure Remove_Cookie (Name : in String);

   --  ------------------------------
   --  Given an Email address, return the Gravatar link to the user image.
   --  (See http://en.gravatar.com/site/implement/hash/ and
   --  http://en.gravatar.com/site/implement/images/)
   --  ------------------------------
   function Get_Gravatar_Link (Email : in String) return String is
      E : constant String := Util.Strings.Transforms.To_Lower_Case (Email);
      C : constant GNAT.MD5.Message_Digest := GNAT.MD5.Digest (E);
   begin
      return "http://www.gravatar.com/avatar/" & C;
   end Get_Gravatar_Link;

   --  ------------------------------
   --  Get the user information identified by the given name.
   --  ------------------------------
   function Get_Value (From : in User_Info;
                       Name : in String) return Util.Beans.Objects.Object is
      pragma Unreferenced (From);

      F : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      S : ASF.Sessions.Session;
      P : ASF.Principals.Principal_Access := null;
      U : Security.Auth.Principal_Access := null;
   begin
      if F /= null then
         S := F.Get_Session;
         if S.Is_Valid then
            P := S.Get_Principal;
            if P /= null then
               U := Security.Auth.Principal'Class (P.all)'Access;
            end if;
         end if;
      end if;
      if Name = "authenticated" then
         return Util.Beans.Objects.To_Object (U /= null);
      end if;
      if U = null then
         return Util.Beans.Objects.Null_Object;
      end if;
      if Name = "email" then
         return Util.Beans.Objects.To_Object (U.Get_Email);
      end if;
      if Name = "language" then
         return Util.Beans.Objects.To_Object (Get_Language (U.Get_Authentication));
      end if;
      if Name = "first_name" then
         return Util.Beans.Objects.To_Object (Get_First_Name (U.Get_Authentication));
      end if;
      if Name = "last_name" then
         return Util.Beans.Objects.To_Object (Get_Last_Name (U.Get_Authentication));
      end if;
      if Name = "full_name" then
         return Util.Beans.Objects.To_Object (Get_Full_Name (U.Get_Authentication));
      end if;
      if Name = "id" then
         return Util.Beans.Objects.To_Object (Get_Claimed_Id (U.Get_Authentication));
      end if;
      if Name = "country" then
         return Util.Beans.Objects.To_Object (Get_Country (U.Get_Authentication));
      end if;
      if Name = "sessionId" then
         return Util.Beans.Objects.To_Object (S.Get_Id);
      end if;
      if Name = "gravatar" then
         return Util.Beans.Objects.To_Object (Get_Gravatar_Link (U.Get_Email));
      end if;

      return Util.Beans.Objects.To_Object (U.Get_Name);
   end Get_Value;

   --  ------------------------------
   --  Helper to send a remove cookie in the current response
   --  ------------------------------
   procedure Remove_Cookie (Name : in String) is
      Ctx : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      C   : ASF.Cookies.Cookie := ASF.Cookies.Create (Name, "");
   begin
      ASF.Cookies.Set_Path (C, Ctx.Get_Request.Get_Context_Path);
      ASF.Cookies.Set_Max_Age (C, 0);
      Ctx.Get_Response.Add_Cookie (Cookie => C);
   end Remove_Cookie;

   --  ------------------------------
   --  Logout by dropping the user session.
   --  ------------------------------
   procedure Logout (From    : in out User_Info;
                     Outcome : in out Ada.Strings.Unbounded.Unbounded_String) is
      pragma Unreferenced (From);

      F : constant ASF.Contexts.Faces.Faces_Context_Access := ASF.Contexts.Faces.Current;
      S : ASF.Sessions.Session := F.Get_Session;
      P : ASF.Principals.Principal_Access := null;
      U : Security.Auth.Principal_Access := null;
   begin
      if S.Is_Valid then
         P := S.Get_Principal;
         if P /= null then
            U := Security.Auth.Principal'Class (P.all)'Access;
         end if;
         S.Invalidate;
      end if;
      if U /= null then
         F.Get_Flash.Set_Keep_Messages (True);
         ASF.Applications.Messages.Factory.Add_Message (F.all, "samples.openid_logout_message",
                                                        Get_Full_Name (U.Get_Authentication));
      end if;
      Remove_Cookie (ASF.Security.Filters.SID_COOKIE);
      Outcome := Ada.Strings.Unbounded.To_Unbounded_String ("logout_success");
   end Logout;

   package Logout_Binding is
     new ASF.Events.Faces.Actions.Action_Method.Bind (Bean   => User_Info,
                                                      Method => Logout,
                                                      Name   => "logout");

   Binding_Array : aliased constant Util.Beans.Methods.Method_Binding_Array
     := (1 => Logout_Binding.Proxy'Unchecked_Access);

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

end Users;

Use the Security.Auth implementation

Use the Security.Auth implementation


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

with Util.Strings;
with Util.Refs;
with ADO.SQL;
with ADO.Drivers;

private with Interfaces;
with Ada.Strings.Unbounded;
with Ada.Finalization;

--  == Named Queries ==
--  Ada Database Objects provides a small framework which helps in
--  using complex SQL queries in an application by using named queries.
--  The benefit of the framework are the following:
--
--    * The SQL query result are directly mapped in Ada records,
--    * It is easy to change or tune an SQL query without re-building the application,
--    * The SQL query can be easily tuned for a given database.
--
--  The database query framework uses an XML query file:
--
--    * The XML query file defines a mapping that represents the result of SQL queries,
--    * The XML mapping is used by Dynamo to generate an Ada record,
--    * The XML query file also defines a set of SQL queries, each query being identified by a unique name,
--    * The XML query file is read by the application to obtain the SQL query associated with a query name,
--    * The application uses the `List` procedure generated by Dynamo.
--
--  === XML Query File ===
--  The XML query file uses the `query-mapping` root element.  It should
--  define at most one `class` mapping and several `query` definitions.
--  The `class` definition should come first before any `query` definition.
--
--    <query-mapping>
--       <class>...</class>
--       <query>...</query>
--    </query-mapping>
--
--  === SQL Result Mapping ===
--  The XML query mapping is very close to the database table mapping.
--  The difference is that there is no need to specify any table name
--  nor any SQL type.  The XML query mapping is used to build an Ada
--  record that correspond to query results.  Unlike the database table mapping,
--  the Ada record will not be tagged and its definition will expose all the record
--  members directly.
--
--  The following XML query mapping:
--
--    <query-mapping>
--      <class name='Samples.Model.User_Info'>
--        <property name="name" type="String">
--           <comment>the user name</comment>
--        </property>
--        <property name="email" type="String">
--           <comment>the email address</comment>
--        </property>
--      </class>
--    </query-mapping>
--
--  will generate the following Ada record:
--
--    package Samples.Model is
--       type User_Info is record
--         Name  : Unbounded_String;
--         Email : Unbounded_String;
--       end record;
--    end Samples.Model;
--
--  The same query mapping can be used by different queries.
--
--  === SQL Queries ===
--  The XML query file defines a list of SQL queries that the application
--  can use.  Each query is associated with a unique name.  The application
--  will use that name to identify the SQL query to execute.  For each query,
--  the file also describes the SQL query pattern that must be used for
--  the query execution.
--
--    <query name='xxx' class='Samples.Model.User_Info'>
--       <sql driver='mysql'>
--         select u.name, u.email from user
--       </sql>
--       <sql driver='sqlite'>
--          ...
--       </sql>
--       <sql-count driver='mysql'>
--          select count(*) from user u
--       </sql-count>
--    </query>
--
--  The query contains basically two SQL patterns.  The `sql` element represents
--  the main SQL pattern.  This is the SQL that is used by the `List` operation.
--  In some cases, the result set returned by the query is limited to return only
--  a maximum number of rows.  This is often use in paginated lists.
--
--  The `sql-count` element represents an SQL query to indicate the total number
--  of elements if the SQL query was not limited.
package ADO.Queries is

   --  Exception raised when a query does not exist or is empty.
   Query_Error : exception;

   type Query_Index is new Natural;

   type File_Index is new Natural;

   type Query_File is limited private;
   type Query_File_Access is access all Query_File;

   type Query_Definition is limited private;
   type Query_Definition_Access is access all Query_Definition;

   type Query_Manager is limited new Ada.Finalization.Limited_Controlled with private;
   type Query_Manager_Access is access all Query_Manager;

   --  ------------------------------
   --  Query Context
   --  ------------------------------
   --  The Context type holds the necessary information to build and execute
   --  a query whose SQL pattern is defined in an XML query file.
   type Context is new ADO.SQL.Query with private;

   --  Set the query definition which identifies the SQL query to execute.
   --  The query is represented by the <tt>sql</tt> XML entry.
   procedure Set_Query (Into  : in out Context;
                        Query : in Query_Definition_Access);

   --  Set the query count definition which identifies the SQL query to execute.
   --  The query count is represented by the <tt>sql-count</tt> XML entry.
   procedure Set_Count_Query (Into  : in out Context;
                              Query : in Query_Definition_Access);

   --  Set the query to execute as SQL statement.
   procedure Set_SQL (Into : in out Context;
                      SQL  : in String);

   procedure Set_Query (Into  : in out Context;
                        Name  : in String);

   --  Set the limit for the SQL query.
   procedure Set_Limit (Into  : in out Context;
                        First : in Natural;
                        Last  : in Natural);

   --  Get the first row index.
   function Get_First_Row_Index (From : in Context) return Natural;

   --  Get the last row index.
   function Get_Last_Row_Index (From : in Context) return Natural;

   --  Get the maximum number of rows that the SQL query can return.
   --  This operation uses the sql-count query.
   function Get_Max_Row_Count (From : in Context) return Natural;

   --  Get the SQL query that correspond to the query context.
   function Get_SQL (From    : in Context;
                     Manager : in Query_Manager'Class) return String;

   function Get_SQL (From      : in Query_Definition_Access;
                     Manager   : in Query_Manager;
                     Use_Count : in Boolean) return String;

private

   --  ------------------------------
   --  Query Definition
   --  ------------------------------
   --  The Query_Definition holds the SQL query pattern which is defined
   --  in an XML query file.  The query is identified by a name and a given XML
   --  query file can contain several queries.  The Dynamo generator generates
   --  one instance of Query_Definition for each query defined in the XML
   --  file.  The XML file is loaded during application initialization (or later)
   --  to get the SQL query pattern.  Multi-thread concurrency is achieved by
   --  the Query_Info_Ref atomic reference.
   type Query_Definition is limited record
      --  The query name.
      Name   : Util.Strings.Name_Access;

      --  The query file in which the query is defined.
      File   : Query_File_Access;

      --  The next query defined in the query file.
      Next   : Query_Definition_Access;

      --  The SQL query pattern (initialized when reading the XML query file).
      --  Query  : Query_Info_Ref_Access;
      Query  : Query_Index := 0;
   end record;

   --  ------------------------------
   --  Query File
   --  ------------------------------
   --  The Query_File describes the SQL queries associated and loaded from
   --  a given XML query file.  The Dynamo generator generates one instance of
   --  Query_File for each XML query file that it has read.  The Path,
   --  Sha1_Map, Queries and Next are initialized statically by the generator (during
   --  package elaboration).
   type Query_File is limited record
      --  Query relative path name
      Name          : Util.Strings.Name_Access;

      --  The SHA1 hash of the query map section.
      Sha1_Map      : Util.Strings.Name_Access;

      --  The first query defined for that file.
      Queries       : Query_Definition_Access;

      --  The next XML query file registered in the application.
      Next          : Query_File_Access;

      --  The unique file index.
      File          : File_Index := 0;
   end record;

   type Context is new ADO.SQL.Query with record
      First      : Natural := 0;
      Last       : Natural := 0;
      Last_Index : Natural := 0;
      Max_Row_Count : Natural := 0;
      Query_Def  : Query_Definition_Access := null;
      Is_Count   : Boolean := False;
   end record;

   use Ada.Strings.Unbounded;

   --  SQL query pattern
   type Query_Pattern is limited record
      SQL : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   type Query_Pattern_Array is array (ADO.Drivers.Driver_Index) of Query_Pattern;

   type Query_Info is new Util.Refs.Ref_Entity with record
      Main_Query  : Query_Pattern_Array;
      Count_Query : Query_Pattern_Array;
   end record;
   type Query_Info_Access is access all Query_Info;

   package Query_Info_Ref is
      new Util.Refs.References (Query_Info, Query_Info_Access);

   type Query_Info_Ref_Access is access all Query_Info_Ref.Atomic_Ref;

   subtype Query_Index_Table is Query_Index range 1 .. Query_Index'Last;
   subtype File_Index_Table is File_Index range 1 .. File_Index'Last;

   type Query_File_Info is record
      --  Query absolute path name (after path resolution).
      Path          : Ada.Strings.Unbounded.Unbounded_String;

      --  File
      File          : Query_File_Access;

      --  Stamp when the query file will be checked.
      Next_Check    : Interfaces.Unsigned_32;

      --  Stamp identifying the modification date of the query file.
      Last_Modified : Interfaces.Unsigned_32;
   end record;

   --  Find the query with the given name.
   --  Returns the query definition that matches the name or null if there is none
   function Find_Query (File : in Query_File_Info;
                        Name : in String) return Query_Definition_Access;

   type Query_Table is array (Query_Index_Table range <>) of Query_Info_Ref.Ref;
   type Query_Table_Access is access all Query_Table;

   type File_Table is array (File_Index_Table range <>) of Query_File_Info;
   type File_Table_Access is access all File_Table;

   type Query_Manager is limited new Ada.Finalization.Limited_Controlled with record
      Driver  : ADO.Drivers.Driver_Index;
      Queries : Query_Table_Access;
      Files   : File_Table_Access;
   end record;

   overriding
   procedure Finalize (Manager : in out Query_Manager);

end ADO.Queries;

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

with Util.Strings;
with Util.Refs;
with ADO.SQL;
with ADO.Drivers;

private with Interfaces;
with Ada.Strings.Unbounded;
with Ada.Finalization;

--  == Named Queries ==
--  Ada Database Objects provides a small framework which helps in
--  using complex SQL queries in an application by using named queries.
--  The benefit of the framework are the following:
--
--    * The SQL query result are directly mapped in Ada records,
--    * It is easy to change or tune an SQL query without re-building the application,
--    * The SQL query can be easily tuned for a given database.
--
--  The database query framework uses an XML query file:
--
--    * The XML query file defines a mapping that represents the result of SQL queries,
--    * The XML mapping is used by Dynamo code generator to generate an Ada record,
--    * The XML query file also defines a set of SQL queries, each query being
--      identified by a unique name,
--    * The XML query file is read by the application to obtain the SQL query
--      associated with a query name,
--    * The application uses the `List` procedure generated by Dynamo.
--
--  === XML Query File ===
--  The XML query file uses the `query-mapping` root element.  It should
--  define at most one `class` mapping and several `query` definitions.
--  The `class` definition should come first before any `query` definition.
--
--    <query-mapping>
--       <class>...</class>
--       <query>...</query>
--    </query-mapping>
--
--  === SQL Result Mapping ===
--  The XML query mapping is very close to the database XML table mapping.
--  The difference is that there is no need to specify any table name
--  nor any SQL type.  The XML query mapping is used to build an Ada
--  record that correspond to query results.  Unlike the database table mapping,
--  the Ada record will not be tagged and its definition will expose all the record
--  members directly.
--
--  The following XML query mapping:
--
--    <query-mapping>
--      <class name='Samples.Model.User_Info'>
--        <property name="name" type="String">
--           <comment>the user name</comment>
--        </property>
--        <property name="email" type="String">
--           <comment>the email address</comment>
--        </property>
--      </class>
--    </query-mapping>
--
--  will generate the following Ada record and it will instantiate the Ada container `Vectors`
--  generic to provide a support for vectors of the record:
--
--    package Samples.Model is
--       type User_Info is record
--         Name  : Unbounded_String;
--         Email : Unbounded_String;
--       end record;
--       package User_Info_Vectors is
--          new Ada.Containers.Vectors (Index_Type   => Natural,
--                                      Element_Type => User_Info,
--                                      "="          => "=");
--       subtype User_Info_Vector is User_Info_Vectors.Vector;
--    end Samples.Model;
--
--  A `List` operation is also generated and can be used to execute an SQL query and have
--  the result mapped in the record.
--
--  The same query mapping can be used by different queries.
--
--  After writing or updating a query mapping, it is necessary to launch the
--  Dynamo code generator to generate the corresponding Ada model.
--
--  === SQL Queries ===
--  The XML query file defines a list of SQL queries that the application
--  can use.  Each query is associated with a unique name.  The application
--  will use that name to identify the SQL query to execute.  For each query,
--  the file also describes the SQL query pattern that must be used for
--  the query execution.
--
--    <query-mapping>
--      <query name='user-list' class='Samples.Model.User_Info'>
--       <sql driver='mysql'>
--         SELECT u.name, u.email FROM user AS u
--       </sql>
--       <sql driver='sqlite'>
--          ...
--       </sql>
--       <sql-count driver='mysql'>
--          SELECT COUNT(*) FROM user AS u
--       </sql-count>
--      </query>
--    </query-mapping>
--
--  The query contains basically two SQL patterns.  The `sql` element represents
--  the main SQL pattern.  This is the SQL that is used by the `List` operation.
--  In some cases, the result set returned by the query is limited to return only
--  a maximum number of rows.  This is often use in paginated lists.
--
--  The `sql-count` element represents an SQL query to indicate the total number
--  of elements if the SQL query was not limited.
--
--  The `sql` and `sql-count` XML element can have an optional `driver` attribute.
--  When defined, the attribute indicates the database driver name that is specific
--  to the query.  When empty or not defined, the SQL is not specific to a database driver.
--
--  For each query, the Dynamo code generator generates a query definition instance which
--  can be used in the Ada code to be able to use the query.  Such instance is static and
--  readonly and serves as a reference when using the query.  For the above query,
--  the Dynamo code generator generates:
--
--    package Samples.User.Model is
--       Query_User_List : constant ADO.Queries.Query_Definition_Access;
--    private
--       ...
--    end Samples.User.Model;
--
--  When a new query is added, the Dynamo code generator must be launched to update
--  the generated Ada code.
--
--  === Using Named Queries ===
--  In order to use a named query, it is necessary to create a query context instance
--  and initialize it.  The query context holds the information about the query definition
--  as well as the parameters to execute the query.  It provides a `Set_Query` and
--  `Set_Count_Query` operation that allows to configure the named query to be executed.
--  It also provides all the `Bind_Param` and `Add_Param` operations to allow giving the
--  query parameters.
--
--    with ADO.Sessions;
--    with ADO.Queries;
--    ...
--      Session : ADO.Sessions.Session := Factory.Get_Session;
--      Query   : ADO.Queries.Context;
--      Users   : Samples.User.Model.User_Info_Vector;
--      ...
--         Query.Set_Query (Samples.User.Model.Query_User_List);
--         Samples.User.Model.List (Users, Session, Query);
--
--  To use the `sql-count` part of the query, you will use the `Set_Count_Query`
--  with the same query definition.  You will then create a query statement from the
--  named query context and run the query.  Since the query is expected to contain exactly
--  one row, you can use the `Get_Result_Integer` to get the first row and column result.
--  For example:
--
--    Query.Set_Count_Query (Samples.User.Model.Query_User_List);
--    ...
--    Stmt : ADO.Statements.Query_Statement
--      := Session.Create_Statement (Query);
--    ...
--    Stmt.Execute;
--    ...
--    Count : Natural := Stmt.Get_Result_Integer;
--
--  You may also use the `ADO.Datasets.Get_Count` operation which simplifies these steps
--  in:
--
--    Query.Set_Count_Query (Samples.User.Model.Query_User_List);
--    ...
--    Count : Natural := ADO.Datasets.Get_Count (Session, Query);
--
package ADO.Queries is

   --  Exception raised when a query does not exist or is empty.
   Query_Error : exception;

   type Query_Index is new Natural;

   type File_Index is new Natural;

   type Query_File is limited private;
   type Query_File_Access is access all Query_File;

   type Query_Definition is limited private;
   type Query_Definition_Access is access all Query_Definition;

   type Query_Manager is limited new Ada.Finalization.Limited_Controlled with private;
   type Query_Manager_Access is access all Query_Manager;

   --  ------------------------------
   --  Query Context
   --  ------------------------------
   --  The Context type holds the necessary information to build and execute
   --  a query whose SQL pattern is defined in an XML query file.
   type Context is new ADO.SQL.Query with private;

   --  Set the query definition which identifies the SQL query to execute.
   --  The query is represented by the <tt>sql</tt> XML entry.
   procedure Set_Query (Into  : in out Context;
                        Query : in Query_Definition_Access);

   --  Set the query count definition which identifies the SQL query to execute.
   --  The query count is represented by the <tt>sql-count</tt> XML entry.
   procedure Set_Count_Query (Into  : in out Context;
                              Query : in Query_Definition_Access);

   --  Set the query to execute as SQL statement.
   procedure Set_SQL (Into : in out Context;
                      SQL  : in String);

   procedure Set_Query (Into  : in out Context;
                        Name  : in String);

   --  Set the limit for the SQL query.
   procedure Set_Limit (Into  : in out Context;
                        First : in Natural;
                        Last  : in Natural);

   --  Get the first row index.
   function Get_First_Row_Index (From : in Context) return Natural;

   --  Get the last row index.
   function Get_Last_Row_Index (From : in Context) return Natural;

   --  Get the maximum number of rows that the SQL query can return.
   --  This operation uses the sql-count query.
   function Get_Max_Row_Count (From : in Context) return Natural;

   --  Get the SQL query that correspond to the query context.
   function Get_SQL (From    : in Context;
                     Manager : in Query_Manager'Class) return String;

   function Get_SQL (From      : in Query_Definition_Access;
                     Manager   : in Query_Manager;
                     Use_Count : in Boolean) return String;

private

   --  ------------------------------
   --  Query Definition
   --  ------------------------------
   --  The Query_Definition holds the SQL query pattern which is defined
   --  in an XML query file.  The query is identified by a name and a given XML
   --  query file can contain several queries.  The Dynamo generator generates
   --  one instance of Query_Definition for each query defined in the XML
   --  file.  The XML file is loaded during application initialization (or later)
   --  to get the SQL query pattern.  Multi-thread concurrency is achieved by
   --  the Query_Info_Ref atomic reference.
   type Query_Definition is limited record
      --  The query name.
      Name   : Util.Strings.Name_Access;

      --  The query file in which the query is defined.
      File   : Query_File_Access;

      --  The next query defined in the query file.
      Next   : Query_Definition_Access;

      --  The SQL query pattern (initialized when reading the XML query file).
      --  Query  : Query_Info_Ref_Access;
      Query  : Query_Index := 0;
   end record;

   --  ------------------------------
   --  Query File
   --  ------------------------------
   --  The Query_File describes the SQL queries associated and loaded from
   --  a given XML query file.  The Dynamo generator generates one instance of
   --  Query_File for each XML query file that it has read.  The Path,
   --  Sha1_Map, Queries and Next are initialized statically by the generator (during
   --  package elaboration).
   type Query_File is limited record
      --  Query relative path name
      Name          : Util.Strings.Name_Access;

      --  The SHA1 hash of the query map section.
      Sha1_Map      : Util.Strings.Name_Access;

      --  The first query defined for that file.
      Queries       : Query_Definition_Access;

      --  The next XML query file registered in the application.
      Next          : Query_File_Access;

      --  The unique file index.
      File          : File_Index := 0;
   end record;

   type Context is new ADO.SQL.Query with record
      First      : Natural := 0;
      Last       : Natural := 0;
      Last_Index : Natural := 0;
      Max_Row_Count : Natural := 0;
      Query_Def  : Query_Definition_Access := null;
      Is_Count   : Boolean := False;
   end record;

   use Ada.Strings.Unbounded;

   --  SQL query pattern
   type Query_Pattern is limited record
      SQL : Ada.Strings.Unbounded.Unbounded_String;
   end record;

   type Query_Pattern_Array is array (ADO.Drivers.Driver_Index) of Query_Pattern;

   type Query_Info is new Util.Refs.Ref_Entity with record
      Main_Query  : Query_Pattern_Array;
      Count_Query : Query_Pattern_Array;
   end record;
   type Query_Info_Access is access all Query_Info;

   package Query_Info_Ref is
      new Util.Refs.References (Query_Info, Query_Info_Access);

   type Query_Info_Ref_Access is access all Query_Info_Ref.Atomic_Ref;

   subtype Query_Index_Table is Query_Index range 1 .. Query_Index'Last;
   subtype File_Index_Table is File_Index range 1 .. File_Index'Last;

   type Query_File_Info is record
      --  Query absolute path name (after path resolution).
      Path          : Ada.Strings.Unbounded.Unbounded_String;

      --  File
      File          : Query_File_Access;

      --  Stamp when the query file will be checked.
      Next_Check    : Interfaces.Unsigned_32;

      --  Stamp identifying the modification date of the query file.
      Last_Modified : Interfaces.Unsigned_32;
   end record;

   --  Find the query with the given name.
   --  Returns the query definition that matches the name or null if there is none
   function Find_Query (File : in Query_File_Info;
                        Name : in String) return Query_Definition_Access;

   type Query_Table is array (Query_Index_Table range <>) of Query_Info_Ref.Ref;
   type Query_Table_Access is access all Query_Table;

   type File_Table is array (File_Index_Table range <>) of Query_File_Info;
   type File_Table_Access is access all File_Table;

   type Query_Manager is limited new Ada.Finalization.Limited_Controlled with record
      Driver  : ADO.Drivers.Driver_Index;
      Queries : Query_Table_Access;
      Files   : File_Table_Access;
   end record;

   overriding
   procedure Finalize (Manager : in out Query_Manager);

end ADO.Queries;

Clarify documentation on named queries

Clarify documentation on named queries


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

with DOM.Core;
package Gen.Utils is

   --  Generic procedure to iterate over the DOM nodes children of node
   --  and having the entity name name.
   generic
      type T is limited private;
      with procedure Process (Closure : in out T;
                              Node    : DOM.Core.Node);
   procedure Iterate_Nodes (Closure : in out T;
                            Node    : in DOM.Core.Node;
                            Name    : in String;
                            Recurse : in Boolean := True);

   --  Get the first DOM child from the given entity tag
   function Get_Child (Node : in DOM.Core.Node;
                       Name : in String) return DOM.Core.Node;

   --  Get the content of the node
   function Get_Data_Content (Node : in DOM.Core.Node) return String;

   --  Get the content of the node identified by Name under the given DOM node.
   function Get_Data_Content (Node : in DOM.Core.Node;
                              Name : in String) return String;

   --  Get a boolean attribute
   function Get_Attribute (Node    : in DOM.Core.Node;
                           Name    : in String;
                           Default : in Boolean := False) return Boolean;

   --  Get a string attribute
   function Get_Attribute (Node    : in DOM.Core.Node;
                           Name    : in String;
                           Default : in String := "") return String;

   --  Get the Ada package name from a qualified type
   function Get_Package_Name (Name : in String) return String;

   --  Get the Ada type name from a full qualified type
   function Get_Type_Name (Name : in String) return String;

   --  Get a query name from the XML query file name
   function Get_Query_Name (Path : in String) return String;

   use Ada.Strings.Unbounded;
   package String_Set is
     new Ada.Containers.Ordered_Sets (Element_Type => Ada.Strings.Unbounded.Unbounded_String,
                                      "<"          => Ada.Strings.Unbounded."<",
                                      "="          => Ada.Strings.Unbounded."=");

   package String_List is new Ada.Containers.Indefinite_Vectors (Index_Type   => Positive,
                                                                 Element_Type => String,
                                                                 "="          => "=");

   --  Returns True if the Name is a valid project or module name.
   --  The name must be a valid Ada identifier.
   function Is_Valid_Name (Name : in String) return Boolean;

end Gen.Utils;

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

with DOM.Core;
package Gen.Utils is

   --  Generic procedure to iterate over the DOM nodes children of node
   --  and having the entity name name.
   generic
      type T (<>) is limited private;
      with procedure Process (Closure : in out T;
                              Node    : DOM.Core.Node);
   procedure Iterate_Nodes (Closure : in out T;
                            Node    : in DOM.Core.Node;
                            Name    : in String;
                            Recurse : in Boolean := True);

   --  Get the first DOM child from the given entity tag
   function Get_Child (Node : in DOM.Core.Node;
                       Name : in String) return DOM.Core.Node;

   --  Get the content of the node
   function Get_Data_Content (Node : in DOM.Core.Node) return String;

   --  Get the content of the node identified by Name under the given DOM node.
   function Get_Data_Content (Node : in DOM.Core.Node;
                              Name : in String) return String;

   --  Get a boolean attribute
   function Get_Attribute (Node    : in DOM.Core.Node;
                           Name    : in String;
                           Default : in Boolean := False) return Boolean;

   --  Get a string attribute
   function Get_Attribute (Node    : in DOM.Core.Node;
                           Name    : in String;
                           Default : in String := "") return String;

   --  Get the Ada package name from a qualified type
   function Get_Package_Name (Name : in String) return String;

   --  Get the Ada type name from a full qualified type
   function Get_Type_Name (Name : in String) return String;

   --  Get a query name from the XML query file name
   function Get_Query_Name (Path : in String) return String;

   use Ada.Strings.Unbounded;
   package String_Set is
     new Ada.Containers.Ordered_Sets (Element_Type => Ada.Strings.Unbounded.Unbounded_String,
                                      "<"          => Ada.Strings.Unbounded."<",
                                      "="          => Ada.Strings.Unbounded."=");

   package String_List is new Ada.Containers.Indefinite_Vectors (Index_Type   => Positive,
                                                                 Element_Type => String,
                                                                 "="          => "=");

   --  Returns True if the Name is a valid project or module name.
   --  The name must be a valid Ada identifier.
   function Is_Valid_Name (Name : in String) return Boolean;

end Gen.Utils;

Allow to use indefinite types for the generic iterate operation