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

with AWS.Session;
with AWS.Messages;
with AWS.Templates;
with AWS.Services.Web_Block.Registry;

with Util.Log.Loggers;
package body Auth_CB is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Auth_CB");

   --  Name of the session attribute which holds information about the active authentication.
   OPENID_ASSOC_ATTRIBUTE : constant String := "openid-assoc";

   USER_INFO_ATTRIBUTE    : constant String := "user-info";

   Null_Association : Security.Auth.Association;
   Null_Auth        : Security.Auth.Authentication;

   package Auth_Session is
     new AWS.Session.Generic_Data (Security.Auth.Association, Null_Association);

   package User_Session is
     new AWS.Session.Generic_Data (Security.Auth.Authentication, Null_Auth);

   overriding
   function Get_Parameter (Params : in Auth_Config;
                           Name   : in String) return String is
   begin
      if Params.Exists (Name) then
         return Params.Get (Name);
      else
         return "";
      end if;
   end Get_Parameter;

   function Get_Auth_Name (Request : in AWS.Status.Data) return String is
      URI  : constant String := AWS.Status.URI (Request);
      Pos  : constant Natural := Ada.Strings.Fixed.Index (URI, "/", Ada.Strings.Backward);
   begin
      if Pos = 0 then
         return "";
      else
         Log.Info ("OpenID authentication with {0}", URI);
         return URI (Pos + 1 .. URI'Last);
      end if;
   end Get_Auth_Name;

   --  ------------------------------
   --  Implement the first step of authentication: discover the OpenID (if any) provider,
   --  create the authorization request and redirect the user to the authorization server.
   --  Some authorization data is saved in the session for the verify process.
   --  ------------------------------
   function Get_Authorization (Request : in AWS.Status.Data) return AWS.Response.Data is
      Name     : constant String := Get_Auth_Name (Request);
      Provider : constant String := Config.Get_Parameter ("auth.provider." & Name);
      URL      : constant String := Config.Get_Parameter ("auth.url." & Name);
      Mgr      : Security.Auth.Manager;
      OP       : Security.Auth.End_Point;
      Assoc    : Security.Auth.Association;
   begin
      if URL'Length = 0 or Provider'Length = 0 then
         return AWS.Response.URL (Location => "/login.html");
      end if;

      Mgr.Initialize (Config, Provider);

      --  Yadis discovery (get the XRDS file).  This step does nothing for OAuth.
      Mgr.Discover (URL, OP);

      --  Associate to the OpenID provider and get an end-point with a key.
      Mgr.Associate (OP, Assoc);

      --  Save the association in the HTTP session and
      --  redirect the user to the OpenID provider.
      declare
         Auth_URL : constant String := Mgr.Get_Authentication_URL (OP, Assoc);
         SID      : constant AWS.Session.Id := AWS.Status.Session (Request);
      begin
         Log.Info ("Redirect to auth URL: {0}", Auth_URL);

         Auth_Session.Set (SID, OPENID_ASSOC_ATTRIBUTE, Assoc);
         return AWS.Response.URL (Location => Auth_URL);
      end;
   end Get_Authorization;

   --  ------------------------------
   --  Second step of authentication: verify the authorization response.  The authorization
   --  data saved in the session is extracted and checked against the response.  If it matches
   --  the response is verified to check if the authentication succeeded or not.
   --  The user is then redirected to the success page.
   --  ------------------------------
   function Verify_Authorization (Request : in AWS.Status.Data) return AWS.Response.Data is

      use type Security.Auth.Auth_Result;

      --  Give access to the request parameters.
      type Auth_Params is limited new Security.Auth.Parameters with null record;

      overriding
      function Get_Parameter (Params : in Auth_Params;
                              Name   : in String) return String;

      overriding
      function Get_Parameter (Params : in Auth_Params;
                              Name   : in String) return String is
         pragma Unreferenced (Params);
      begin
         return AWS.Status.Parameter (Request, Name);
      end Get_Parameter;

      Mgr        : Security.Auth.Manager;
      Assoc      : Security.Auth.Association;
      Credential : Security.Auth.Authentication;
      Params     : Auth_Params;
      SID        : constant AWS.Session.Id := AWS.Status.Session (Request);
   begin
      Log.Info ("Verify openid authentication");

      if not AWS.Session.Exist (SID, OPENID_ASSOC_ATTRIBUTE) then
         Log.Warn ("Session has expired during OpenID authentication process");
         return AWS.Response.Build ("text/html", "Session has expired", AWS.Messages.S403);
      end if;

      Assoc := Auth_Session.Get (SID, OPENID_ASSOC_ATTRIBUTE);

      --  Cleanup the session and drop the association end point.
      AWS.Session.Remove (SID, OPENID_ASSOC_ATTRIBUTE);

      Mgr.Initialize (Provider => Security.Auth.Get_Provider (Assoc),
                      Params   => Config);

      --  Verify that what we receive through the callback matches the association key.
      Mgr.Verify (Assoc, Params, Credential);
      if Security.Auth.Get_Status (Credential) /= Security.Auth.AUTHENTICATED then
         Log.Info ("Authentication has failed");
         return AWS.Response.Build ("text/html", "Authentication failed", AWS.Messages.S403);
      end if;

      Log.Info ("Authentication succeeded for {0}", Security.Auth.Get_Email (Credential));

      Log.Info ("Claimed id: {0}", Security.Auth.Get_Claimed_Id (Credential));
      Log.Info ("Email:      {0}", Security.Auth.Get_Email (Credential));
      Log.Info ("Name:       {0}", Security.Auth.Get_Full_Name (Credential));

      --  Save the user information in the session (for the purpose of this demo).
      User_Session.Set (SID, USER_INFO_ATTRIBUTE, Credential);

      declare
         URL  : constant String := Config.Get_Parameter ("openid.success_url");
      begin
         Log.Info ("Redirect user to success URL: {0}", URL);

         return AWS.Response.URL (Location => URL);
      end;
   end Verify_Authorization;

   function User_Info (Request : in AWS.Status.Data) return AWS.Response.Data is
      URI        : constant String := AWS.Status.URI (Request);
      SID        : constant AWS.Session.Id := AWS.Status.Session (Request);
      Credential : Security.Auth.Authentication;
      Set        : AWS.Templates.Translate_Set;
   begin
      if AWS.Session.Exist (SID, USER_INFO_ATTRIBUTE) then
         Credential := User_Session.Get (SID, USER_INFO_ATTRIBUTE);
         AWS.Templates.Insert (Set,
           AWS.Templates.Assoc ("ID",
             Security.Auth.Get_Claimed_Id (Credential)));
         AWS.Templates.Insert (Set, AWS.Templates.Assoc ("EMAIL",
           Security.Auth.Get_Email (Credential)));
         AWS.Templates.Insert (Set, AWS.Templates.Assoc ("NAME",
           Security.Auth.Get_Full_Name (Credential)));
      end if;
      return AWS.Services.Web_Block.Registry.Build ("success", Request, Set);
   end User_Info;

end Auth_CB;

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

with AWS.Session;
with AWS.Messages;
with AWS.Templates;
with AWS.Services.Web_Block.Registry;

with Util.Log.Loggers;
package body Auth_CB is

   --  The logger
   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Auth_CB");

   --  Name of the session attribute which holds information about the active authentication.
   OPENID_ASSOC_ATTRIBUTE : constant String := "openid-assoc";

   USER_INFO_ATTRIBUTE    : constant String := "user-info";

   Null_Association : Security.Auth.Association;
   Null_Auth        : Security.Auth.Authentication;

   package Auth_Session is
     new AWS.Session.Generic_Data (Security.Auth.Association, Null_Association);

   package User_Session is
     new AWS.Session.Generic_Data (Security.Auth.Authentication, Null_Auth);

   overriding
   function Get_Parameter (Params : in Auth_Config;
                           Name   : in String) return String is
   begin
      if Params.Exists (Name) then
         return Params.Get (Name);
      else
         return "";
      end if;
   end Get_Parameter;

   function Get_Auth_Name (Request : in AWS.Status.Data) return String is
      URI  : constant String := AWS.Status.URI (Request);
      Pos  : constant Natural := Ada.Strings.Fixed.Index (URI, "/", Ada.Strings.Backward);
   begin
      if Pos = 0 then
         return "";
      else
         Log.Info ("OpenID authentication with {0}", URI);
         return URI (Pos + 1 .. URI'Last);
      end if;
   end Get_Auth_Name;

   --  ------------------------------
   --  Implement the first step of authentication: discover the OpenID (if any) provider,
   --  create the authorization request and redirect the user to the authorization server.
   --  Some authorization data is saved in the session for the verify process.
   --  ------------------------------
   function Get_Authorization (Request : in AWS.Status.Data) return AWS.Response.Data is
      Name     : constant String := Get_Auth_Name (Request);
      URL      : constant String := Config.Get_Parameter ("auth.url." & Name);
      Mgr      : Security.Auth.Manager;
      OP       : Security.Auth.End_Point;
      Assoc    : Security.Auth.Association;
   begin
      if URL'Length = 0 or Name'Length = 0 then
         return AWS.Response.URL (Location => "/login.html");
      end if;

      Mgr.Initialize (Config, Name);

      --  Yadis discovery (get the XRDS file).  This step does nothing for OAuth.
      Mgr.Discover (URL, OP);

      --  Associate to the OpenID provider and get an end-point with a key.
      Mgr.Associate (OP, Assoc);

      --  Save the association in the HTTP session and
      --  redirect the user to the OpenID provider.
      declare
         Auth_URL : constant String := Mgr.Get_Authentication_URL (OP, Assoc);
         SID      : constant AWS.Session.Id := AWS.Status.Session (Request);
      begin
         Log.Info ("Redirect to auth URL: {0}", Auth_URL);

         Auth_Session.Set (SID, OPENID_ASSOC_ATTRIBUTE, Assoc);
         return AWS.Response.URL (Location => Auth_URL);
      end;
   end Get_Authorization;

   --  ------------------------------
   --  Second step of authentication: verify the authorization response.  The authorization
   --  data saved in the session is extracted and checked against the response.  If it matches
   --  the response is verified to check if the authentication succeeded or not.
   --  The user is then redirected to the success page.
   --  ------------------------------
   function Verify_Authorization (Request : in AWS.Status.Data) return AWS.Response.Data is

      use type Security.Auth.Auth_Result;

      --  Give access to the request parameters.
      type Auth_Params is limited new Security.Auth.Parameters with null record;

      overriding
      function Get_Parameter (Params : in Auth_Params;
                              Name   : in String) return String;

      overriding
      function Get_Parameter (Params : in Auth_Params;
                              Name   : in String) return String is
         pragma Unreferenced (Params);
      begin
         return AWS.Status.Parameter (Request, Name);
      end Get_Parameter;

      Mgr        : Security.Auth.Manager;
      Assoc      : Security.Auth.Association;
      Credential : Security.Auth.Authentication;
      Params     : Auth_Params;
      SID        : constant AWS.Session.Id := AWS.Status.Session (Request);
   begin
      Log.Info ("Verify openid authentication");

      if not AWS.Session.Exist (SID, OPENID_ASSOC_ATTRIBUTE) then
         Log.Warn ("Session has expired during OpenID authentication process");
         return AWS.Response.Build ("text/html", "Session has expired", AWS.Messages.S403);
      end if;

      Assoc := Auth_Session.Get (SID, OPENID_ASSOC_ATTRIBUTE);

      --  Cleanup the session and drop the association end point.
      AWS.Session.Remove (SID, OPENID_ASSOC_ATTRIBUTE);

      Mgr.Initialize (Name   => Security.Auth.Get_Provider (Assoc),
                      Params => Config);

      --  Verify that what we receive through the callback matches the association key.
      Mgr.Verify (Assoc, Params, Credential);
      if Security.Auth.Get_Status (Credential) /= Security.Auth.AUTHENTICATED then
         Log.Info ("Authentication has failed");
         return AWS.Response.Build ("text/html", "Authentication failed", AWS.Messages.S403);
      end if;

      Log.Info ("Authentication succeeded for {0}", Security.Auth.Get_Email (Credential));

      Log.Info ("Claimed id: {0}", Security.Auth.Get_Claimed_Id (Credential));
      Log.Info ("Email:      {0}", Security.Auth.Get_Email (Credential));
      Log.Info ("Name:       {0}", Security.Auth.Get_Full_Name (Credential));

      --  Save the user information in the session (for the purpose of this demo).
      User_Session.Set (SID, USER_INFO_ATTRIBUTE, Credential);

      declare
         URL  : constant String := Config.Get_Parameter ("openid.success_url");
      begin
         Log.Info ("Redirect user to success URL: {0}", URL);

         return AWS.Response.URL (Location => URL);
      end;
   end Verify_Authorization;

   function User_Info (Request : in AWS.Status.Data) return AWS.Response.Data is
      URI        : constant String := AWS.Status.URI (Request);
      SID        : constant AWS.Session.Id := AWS.Status.Session (Request);
      Credential : Security.Auth.Authentication;
      Set        : AWS.Templates.Translate_Set;
   begin
      if AWS.Session.Exist (SID, USER_INFO_ATTRIBUTE) then
         Credential := User_Session.Get (SID, USER_INFO_ATTRIBUTE);
         AWS.Templates.Insert (Set,
           AWS.Templates.Assoc ("ID",
             Security.Auth.Get_Claimed_Id (Credential)));
         AWS.Templates.Insert (Set, AWS.Templates.Assoc ("EMAIL",
           Security.Auth.Get_Email (Credential)));
         AWS.Templates.Insert (Set, AWS.Templates.Assoc ("NAME",
           Security.Auth.Get_Full_Name (Credential)));
      end if;
      return AWS.Services.Web_Block.Registry.Build ("success", Request, Set);
   end User_Info;

end Auth_CB;

Fix initialization

Fix initialization


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

--  == HTML Renderer ==
--  The <tt>Text_Renderer</tt> allows to render a wiki document into a text content.
--  The formatting rules are ignored except for the paragraphs and sections.
package Wiki.Render.Html is

   --  ------------------------------
   --  Wiki to HTML renderer
   --  ------------------------------
   type Html_Renderer is new Renderer with private;

   --  Set the output stream.
   procedure Set_Output_Stream (Engine : in out Html_Renderer;
                                Stream : in Wiki.Streams.Html.Html_Output_Stream_Access);

   --  Set the link renderer.
   procedure Set_Link_Renderer (Document : in out Html_Renderer;
                                Links    : in Link_Renderer_Access);

   --  Render the node instance from the document.
   overriding
   procedure Render (Engine : in out Html_Renderer;
                     Doc    : in Wiki.Nodes.Document;
                     Node   : in Wiki.Nodes.Node_Type);

   --  Add a section header in the document.
   procedure Add_Header (Engine : in out Html_Renderer;
                         Header : in Wiki.Strings.WString;
                         Level  : in Positive);

   --  Add a line break (<br>).
   procedure Add_Line_Break (Document : in out Html_Renderer);

   --  Add a paragraph (<p>).  Close the previous paragraph if any.
   --  The paragraph must be closed at the next paragraph or next header.
   procedure Add_Paragraph (Document : in out Html_Renderer);

   --  Add a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   procedure Add_Blockquote (Document : in out Html_Renderer;
                             Level    : in Natural);

   --  Add a list item (<li>).  Close the previous paragraph and list item if any.
   --  The list item will be closed at the next list item, next paragraph or next header.
   procedure Add_List_Item (Document : in out Html_Renderer;
                            Level    : in Positive;
                            Ordered  : in Boolean);

   --  Add a link.
   procedure Add_Link (Document : in out Html_Renderer;
                       Name     : in Unbounded_Wide_Wide_String;
                       Link     : in Unbounded_Wide_Wide_String;
                       Language : in Unbounded_Wide_Wide_String;
                       Title    : in Unbounded_Wide_Wide_String);

   --  Add an image.
   procedure Add_Image (Document    : in out Html_Renderer;
                        Link        : in Unbounded_Wide_Wide_String;
                        Alt         : in Unbounded_Wide_Wide_String;
                        Position    : in Unbounded_Wide_Wide_String;
                        Description : in Unbounded_Wide_Wide_String);

   --  Add a quote.
   procedure Add_Quote (Document : in out Html_Renderer;
                        Quote    : in Unbounded_Wide_Wide_String;
                        Link     : in Unbounded_Wide_Wide_String;
                        Language : in Unbounded_Wide_Wide_String);

   --  Add a text block with the given format.
   procedure Add_Text (Document : in out Html_Renderer;
                       Text     : in Unbounded_Wide_Wide_String;
                       Format   : in Wiki.Documents.Format_Map);

   --  Add a text block that is pre-formatted.
   procedure Add_Preformatted (Document : in out Html_Renderer;
                               Text     : in Unbounded_Wide_Wide_String;
                               Format   : in Unbounded_Wide_Wide_String);

   procedure Start_Element (Document   : in out Html_Renderer;
                            Name       : in Unbounded_Wide_Wide_String;
                            Attributes : in Wiki.Attributes.Attribute_List_Type);

   procedure End_Element (Document : in out Html_Renderer;
                          Name     : in Unbounded_Wide_Wide_String);

   --  Finish the document after complete wiki text has been parsed.
   overriding
   procedure Finish (Document : in out Html_Renderer);

private

   procedure Close_Paragraph (Document : in out Html_Renderer);
   procedure Open_Paragraph (Document : in out Html_Renderer);

   type List_Style_Array is array (1 .. 32) of Boolean;

   Default_Links : aliased Default_Link_Renderer;

   type Html_Renderer is new Renderer with record
      Output         : Wiki.Streams.Html.Html_Output_Stream_Access := null;
      Format         : Wiki.Documents.Format_Map := (others => False);
      Links          : Link_Renderer_Access := Default_Links'Access;
      Has_Paragraph  : Boolean := False;
      Need_Paragraph : Boolean := False;
      Has_Item       : Boolean := False;
      Current_Level  : Natural := 0;
      List_Styles    : List_Style_Array := (others => False);
      Quote_Level    : Natural := 0;
      Html_Level     : Natural := 0;
   end record;

end Wiki.Render.Html;

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

--  == HTML Renderer ==
--  The <tt>Text_Renderer</tt> allows to render a wiki document into a text content.
--  The formatting rules are ignored except for the paragraphs and sections.
package Wiki.Render.Html is

   --  ------------------------------
   --  Wiki to HTML renderer
   --  ------------------------------
   type Html_Renderer is new Renderer with private;

   --  Set the output stream.
   procedure Set_Output_Stream (Engine : in out Html_Renderer;
                                Stream : in Wiki.Streams.Html.Html_Output_Stream_Access);

   --  Set the link renderer.
   procedure Set_Link_Renderer (Document : in out Html_Renderer;
                                Links    : in Link_Renderer_Access);

   --  Render the node instance from the document.
   overriding
   procedure Render (Engine : in out Html_Renderer;
                     Doc    : in Wiki.Nodes.Document;
                     Node   : in Wiki.Nodes.Node_Type);

   --  Add a section header in the document.
   procedure Add_Header (Engine : in out Html_Renderer;
                         Header : in Wiki.Strings.WString;
                         Level  : in Positive);

   --  Add a line break (<br>).
   procedure Add_Line_Break (Document : in out Html_Renderer);

   --  Add a blockquote (<blockquote>).  The level indicates the blockquote nested level.
   --  The blockquote must be closed at the next header.
   procedure Add_Blockquote (Document : in out Html_Renderer;
                             Level    : in Natural);

   --  Add a list item (<li>).  Close the previous paragraph and list item if any.
   --  The list item will be closed at the next list item, next paragraph or next header.
   procedure Add_List_Item (Document : in out Html_Renderer;
                            Level    : in Positive;
                            Ordered  : in Boolean);

   --  Add a link.
   procedure Add_Link (Document : in out Html_Renderer;
                       Name     : in Unbounded_Wide_Wide_String;
                       Link     : in Unbounded_Wide_Wide_String;
                       Language : in Unbounded_Wide_Wide_String;
                       Title    : in Unbounded_Wide_Wide_String);

   --  Add an image.
   procedure Add_Image (Document    : in out Html_Renderer;
                        Link        : in Unbounded_Wide_Wide_String;
                        Alt         : in Unbounded_Wide_Wide_String;
                        Position    : in Unbounded_Wide_Wide_String;
                        Description : in Unbounded_Wide_Wide_String);

   --  Add a quote.
   procedure Add_Quote (Document : in out Html_Renderer;
                        Quote    : in Unbounded_Wide_Wide_String;
                        Link     : in Unbounded_Wide_Wide_String;
                        Language : in Unbounded_Wide_Wide_String);

   --  Add a text block with the given format.
   procedure Add_Text (Document : in out Html_Renderer;
                       Text     : in Unbounded_Wide_Wide_String;
                       Format   : in Wiki.Documents.Format_Map);

   --  Add a text block that is pre-formatted.
   procedure Add_Preformatted (Document : in out Html_Renderer;
                               Text     : in Unbounded_Wide_Wide_String;
                               Format   : in Unbounded_Wide_Wide_String);

   procedure Start_Element (Document   : in out Html_Renderer;
                            Name       : in Unbounded_Wide_Wide_String;
                            Attributes : in Wiki.Attributes.Attribute_List_Type);

   procedure End_Element (Document : in out Html_Renderer;
                          Name     : in Unbounded_Wide_Wide_String);

   --  Finish the document after complete wiki text has been parsed.
   overriding
   procedure Finish (Document : in out Html_Renderer);

private

   procedure Close_Paragraph (Document : in out Html_Renderer);
   procedure Open_Paragraph (Document : in out Html_Renderer);

   type List_Style_Array is array (1 .. 32) of Boolean;

   Default_Links : aliased Default_Link_Renderer;

   type Html_Renderer is new Renderer with record
      Output         : Wiki.Streams.Html.Html_Output_Stream_Access := null;
      Format         : Wiki.Documents.Format_Map := (others => False);
      Links          : Link_Renderer_Access := Default_Links'Access;
      Has_Paragraph  : Boolean := False;
      Need_Paragraph : Boolean := False;
      Has_Item       : Boolean := False;
      Current_Level  : Natural := 0;
      List_Styles    : List_Style_Array := (others => False);
      Quote_Level    : Natural := 0;
      Html_Level     : Natural := 0;
   end record;

end Wiki.Render.Html;

Remove Add_Paragraph procedure

Remove Add_Paragraph procedure


-----------------------------------------------------------------------
--  ado-queries -- Database Queries
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 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 Util.Strings;
with Util.Refs;
with ADO.SQL;
with ADO.Drivers;

with Interfaces;
with Ada.Strings.Unbounded;
package ADO.Queries is

   type Query_File;
   type Query_File_Access is access all Query_File;

   type Query_Definition;
   type Query_Definition_Access is access all Query_Definition;

   type Query_Info is limited private;
   type Query_Info_Access is access all Query_Info;

   type Query_Info_Ref_Access is private;

   Null_Query_Info_Ref : constant Query_Info_Ref_Access;

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

   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;
                     Driver : in ADO.Drivers.Driver_Index) return String;

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

   function Get_SQL (From      : in Query_Definition_Access;
                     Driver    : in ADO.Drivers.Driver_Index;
                     Use_Count : in Boolean) return String;

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

      --  Query absolute path name (after path resolution).
      Path          : Ada.Strings.Unbounded.String_Access;

      --  The SHA1 hash of the query map section.
      Sha1_Map      : Util.Strings.Name_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;

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

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

private

   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;

   --  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;
                        Name : in String) return Query_Definition_Access;

   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;

   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;

   Null_Query_Info_Ref : constant Query_Info_Ref_Access := null;

end ADO.Queries;

-----------------------------------------------------------------------
--  ado-queries -- Database Queries
--  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 Util.Strings;
with Util.Refs;
with ADO.SQL;
with ADO.Drivers;

with Interfaces;
with Ada.Strings.Unbounded;
package ADO.Queries is

   type Query_File;
   type Query_File_Access is access all Query_File;

   type Query_Definition;
   type Query_Definition_Access is access all Query_Definition;

   type Query_Info is limited private;
   type Query_Info_Access is access all Query_Info;

   type Query_Info_Ref_Access is private;

   Null_Query_Info_Ref : constant Query_Info_Ref_Access;

   --  ------------------------------
   --  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;
                     Driver : in ADO.Drivers.Driver_Index) return String;

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

   function Get_SQL (From      : in Query_Definition_Access;
                     Driver    : in ADO.Drivers.Driver_Index;
                     Use_Count : in Boolean) return String;

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

      --  Query absolute path name (after path resolution).
      Path          : Ada.Strings.Unbounded.String_Access;

      --  The SHA1 hash of the query map section.
      Sha1_Map      : Util.Strings.Name_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;

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

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

private

   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;

   --  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;
                        Name : in String) return Query_Definition_Access;

   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;

   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;

   Null_Query_Info_Ref : constant Query_Info_Ref_Access := null;

end ADO.Queries;

Declare the Set_SQL procedure

Declare the Set_SQL procedure


-----------------------------------------------------------------------
--  ADO SQL -- Basic SQL Generation
--  Copyright (C) 2010, 2011, 2012, 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.
-----------------------------------------------------------------------

--  Utilities for creating SQL queries and statements.
package body ADO.SQL is

   --  --------------------
   --  Buffer
   --  --------------------

   --  --------------------
   --  Clear the SQL buffer.
   --  --------------------
   procedure Clear (Target : in out Buffer) is
   begin
      Target.Buf := To_Unbounded_String ("");
   end Clear;

   --  --------------------
   --  Append an SQL extract into the buffer.
   --  --------------------
   procedure Append (Target : in out Buffer;
                     SQL    : in String) is
   begin
      Append (Target.Buf, SQL);
   end Append;

   --  --------------------
   --  Append a name in the buffer and escape that
   --  name if this is a reserved keyword.
   --  --------------------
   procedure Append_Name (Target : in out Buffer;
                          Name   : in String) is
      use type ADO.Drivers.Dialects.Dialect_Access;
      Dialect : constant ADO.Drivers.Dialects.Dialect_Access := Target.Get_Dialect;
   begin
      if Dialect /= null and then Dialect.Is_Reserved (Name) then
         declare
            Quote : constant Character := Dialect.Get_Identifier_Quote;
         begin
            Append (Target.Buf, Quote);
            Append (Target.Buf, Name);
            Append (Target.Buf, Quote);
         end;
      else
         Append (Target.Buf, Name);
      end if;
   end Append_Name;

   --  --------------------
   --  Append a string value in the buffer and
   --  escape any special character if necessary.
   --  --------------------
   procedure Append_Value (Target : in out Buffer;
                           Value  : in String) is
   begin
      Append (Target.Buf, Value);
   end Append_Value;

   --  --------------------
   --  Append a string value in the buffer and
   --  escape any special character if necessary.
   --  --------------------
   procedure Append_Value (Target : in out Buffer;
                           Value  : in Unbounded_String) is
   begin
      Append (Target.Buf, Value);
   end Append_Value;

   --  --------------------
   --  Append the integer value in the buffer.
   --  --------------------
   procedure Append_Value (Target : in out Buffer;
                           Value  : in Long_Integer) is
      S : constant String := Long_Integer'Image (Value);
   begin
      Append (Target.Buf, S (S'First + 1 .. S'Last));
   end Append_Value;

   --  --------------------
   --  Append the integer value in the buffer.
   --  --------------------
   procedure Append_Value (Target : in out Buffer;
                           Value  : in Integer) is
      S : constant String := Integer'Image (Value);
   begin
      Append (Target.Buf, S (S'First + 1 .. S'Last));
   end Append_Value;

   --  --------------------
   --  Append the identifier value in the buffer.
   --  --------------------
   procedure Append_Value (Target : in out Buffer;
                           Value  : in Identifier) is
      S : constant String := Identifier'Image (Value);
   begin
      Append (Target.Buf, S (S'First + 1 .. S'Last));
   end Append_Value;

   --  --------------------
   --  Get the SQL string that was accumulated in the buffer.
   --  --------------------
   function To_String (From : in Buffer) return String is
   begin
      return To_String (From.Buf);
   end To_String;

   --  --------------------
   --  Clear the query object.
   --  --------------------
   overriding
   procedure Clear (Target : in out Query) is
   begin
      ADO.Parameters.List (Target).Clear;
      Target.Join.Clear;
      Target.Filter.Clear;
      Target.SQL.Clear;
   end Clear;

   --  --------------------
   --  Set the SQL dialect description object.
   --  --------------------
   procedure Set_Dialect (Target : in out Query;
                          D      : in ADO.Drivers.Dialects.Dialect_Access) is
   begin
      ADO.Parameters.Abstract_List (Target).Set_Dialect (D);
      Set_Dialect (Target.SQL, D);
      Set_Dialect (Target.Filter, D);
      Set_Dialect (Target.Join, D);
   end Set_Dialect;

   procedure Set_Filter (Target : in out Query;
                         Filter : in String) is
   begin
      Target.Filter.Buf := To_Unbounded_String (Filter);
   end Set_Filter;

   function Get_Filter (Source : in Query) return String is
   begin
      if Source.Filter.Buf = Null_Unbounded_String then
         return "";
      else
         return To_String (Source.Filter.Buf);
      end if;
   end Get_Filter;

   function Has_Filter (Source : in Query) return Boolean is
   begin
      return Source.Filter.Buf /= Null_Unbounded_String
        and Length (Source.Filter.Buf) > 0;
   end Has_Filter;

   --  --------------------
   --  Set the join condition.
   --  --------------------
   procedure Set_Join (Target : in out Query;
                       Join   : in String) is
   begin
      Target.Join.Buf := To_Unbounded_String (Join);
   end Set_Join;

   --  --------------------
   --  Returns true if there is a join condition
   --  --------------------
   function Has_Join (Source : in Query) return Boolean is
   begin
      return Source.Join.Buf /= Null_Unbounded_String
        and Length (Source.Join.Buf) > 0;
   end Has_Join;

   --  --------------------
   --  Get the join condition
   --  --------------------
   function Get_Join (Source : in Query) return String is
   begin
      if Source.Join.Buf = Null_Unbounded_String then
         return "";
      else
         return To_String (Source.Join.Buf);
      end if;
   end Get_Join;

   --  --------------------
   --  Set the parameters from another parameter list.
   --  If the parameter list is a query object, also copy the filter part.
   --  --------------------
   procedure Set_Parameters (Params : in out Query;
                             From   : in ADO.Parameters.Abstract_List'Class) is
   begin
      ADO.Parameters.List (Params).Set_Parameters (From);
      if From in Query'Class then
         declare
            L : constant Query'Class := Query'Class (From);
         begin
            Params.Filter := L.Filter;
            Params.Join   := L.Join;
         end;
      end if;
   end Set_Parameters;

   --  --------------------
   --  Expand the parameters into the query and return the expanded SQL query.
   --  --------------------
   function Expand (Source : in Query) return String is
   begin
      return ADO.Parameters.Abstract_List (Source).Expand (To_String (Source.SQL.Buf));
   end Expand;

   procedure Add_Field (Update : in out Update_Query'Class;
                        Name   : in String) is
   begin
      Update.Pos := Update.Pos + 1;
      if Update.Pos > 1 then
         Append (Target => Update.Set_Fields, SQL => ",");
         Append (Target => Update.Fields, SQL => ",");
      end if;
      Append_Name (Target => Update.Set_Fields, Name => Name);
      if Update.Is_Update_Stmt then
         Append (Target => Update.Set_Fields, SQL => " = ?");
      end if;
      Append (Target => Update.Fields, SQL => "?");
   end Add_Field;

   --  ------------------------------
   --  Set the SQL dialect description object.
   --  ------------------------------
   procedure Set_Dialect (Target : in out Update_Query;
                          D      : in ADO.Drivers.Dialects.Dialect_Access) is
   begin
      Target.Set_Fields.Set_Dialect (D);
      Target.Fields.Set_Dialect (D);
      Query (Target).Set_Dialect (D);
   end Set_Dialect;

   --  ------------------------------
   --  Prepare the update/insert query to save the table field
   --  identified by Name and set it to the Value.
   --  ------------------------------
   procedure Save_Field (Update : in out Update_Query;
                         Name   : in String;
                         Value  : in Boolean) is
   begin
      Update.Add_Field (Name => Name);
      Update_Query'Class (Update).Bind_Param (Position => Update.Pos, Value => Value);
   end Save_Field;

   --  --------------------
   --  Prepare the update/insert query to save the table field
   --  identified by Name and set it to the Value.
   --  --------------------
   procedure Save_Field (Update : in out Update_Query;
                         Name   : in String;
                         Value  : in Integer) is
   begin
      Update.Add_Field (Name => Name);
      Update_Query'Class (Update).Bind_Param (Position => Update.Pos, Value => Value);
   end Save_Field;

   --  --------------------
   --  Prepare the update/insert query to save the table field
   --  identified by Name and set it to the Value.
   --  --------------------
   procedure Save_Field (Update : in out Update_Query;
                         Name   : in String;
                         Value  : in Long_Long_Integer) is
   begin
      Update.Add_Field (Name => Name);
      Update_Query'Class (Update).Bind_Param (Position => Update.Pos, Value => Value);
   end Save_Field;

   --  --------------------
   --  Prepare the update/insert query to save the table field
   --  identified by Name and set it to the Value.
   --  --------------------
   procedure Save_Field (Update : in out Update_Query;
                         Name   : in String;
                         Value  : in Identifier) is
   begin
      Update.Add_Field (Name => Name);
      Update_Query'Class (Update).Add_Param (Value => Value);
   end Save_Field;

   --  --------------------
   --  Prepare the update/insert query to save the table field
   --  identified by Name and set it to the Value.
   --  --------------------
   procedure Save_Field (Update : in out Update_Query;
                         Name   : in String;
                         Value  : in Entity_Type) is
   begin
      Update.Add_Field (Name => Name);
      Update_Query'Class (Update).Add_Param (Value => Integer (Value));
   end Save_Field;

   --  --------------------
   --  Prepare the update/insert query to save the table field
   --  identified by Name and set it to the Value.
   --  --------------------
   procedure Save_Field (Update : in out Update_Query;
                         Name   : in String;
                         Value  : in Ada.Calendar.Time) is
   begin
      Update.Add_Field (Name => Name);
      Update_Query'Class (Update).Add_Param (Value => Value);
   end Save_Field;

   --  --------------------
   --  Prepare the update/insert query to save the table field
   --  identified by Name and set it to the Value.
   --  --------------------
   procedure Save_Field (Update : in out Update_Query;
                         Name   : in String;
                         Value  : in String) is
   begin
      Update.Add_Field (Name => Name);
      Update_Query'Class (Update).Bind_Param (Position => Update.Pos, Value => Value);
   end Save_Field;

   --  --------------------
   --  Prepare the update/insert query to save the table field
   --  identified by Name and set it to the Value.
   --  --------------------
   procedure Save_Field (Update : in out Update_Query;
                         Name   : in String;
                         Value  : in Unbounded_String) is
   begin
      Update.Add_Field (Name => Name);
      Update_Query'Class (Update).Bind_Param (Position => Update.Pos, Value => Value);
   end Save_Field;

   --  ------------------------------
   --  Prepare the update/insert query to save the table field
   --  identified by Name and set it to the Value.
   --  ------------------------------
   procedure Save_Field (Update : in out Update_Query;
                         Name   : in String;
                         Value  : in ADO.Blob_Ref) is
   begin
      Update.Add_Field (Name => Name);
      Update_Query'Class (Update).Bind_Param (Position => Update.Pos, Value => Value);
   end Save_Field;

   --  ------------------------------
   --  Prepare the update/insert query to save the table field
   --  identified by Name and set it to NULL.
   --  ------------------------------
   procedure Save_Null_Field (Update : in out Update_Query;
                              Name   : in String) is
   begin
      Update.Add_Field (Name => Name);
      Update_Query'Class (Update).Bind_Null_Param (Position => Update.Pos);
   end Save_Null_Field;

   --  --------------------
   --  Check if the update/insert query has some fields to update.
   --  --------------------
   function Has_Save_Fields (Update : in Update_Query) return Boolean is
   begin
      return Update.Pos > 0;
   end Has_Save_Fields;

   procedure Set_Insert_Mode (Update : in out Update_Query) is
   begin
      Update.Is_Update_Stmt := False;
   end Set_Insert_Mode;

   procedure Append_Fields (Update : in out Update_Query;
                            Mode   : in Boolean := False) is
   begin
      if Mode then
         Append (Target => Update.SQL, SQL => To_String (Update.Fields.Buf));
      else
         Append (Target => Update.SQL, SQL => To_String (Update.Set_Fields.Buf));
      end if;
   end Append_Fields;

end ADO.SQL;

-----------------------------------------------------------------------
--  ADO SQL -- Basic SQL Generation
--  Copyright (C) 2010, 2011, 2012, 2015, 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.
-----------------------------------------------------------------------

--  Utilities for creating SQL queries and statements.
package body ADO.SQL is

   --  --------------------
   --  Buffer
   --  --------------------

   --  --------------------
   --  Clear the SQL buffer.
   --  --------------------
   procedure Clear (Target : in out Buffer) is
   begin
      Target.Buf := To_Unbounded_String ("");
   end Clear;

   --  --------------------
   --  Append an SQL extract into the buffer.
   --  --------------------
   procedure Append (Target : in out Buffer;
                     SQL    : in String) is
   begin
      Append (Target.Buf, SQL);
   end Append;

   --  --------------------
   --  Append a name in the buffer and escape that
   --  name if this is a reserved keyword.
   --  --------------------
   procedure Append_Name (Target : in out Buffer;
                          Name   : in String) is
      use type ADO.Drivers.Dialects.Dialect_Access;
      Dialect : constant ADO.Drivers.Dialects.Dialect_Access := Target.Get_Dialect;
   begin
      if Dialect /= null and then Dialect.Is_Reserved (Name) then
         declare
            Quote : constant Character := Dialect.Get_Identifier_Quote;
         begin
            Append (Target.Buf, Quote);
            Append (Target.Buf, Name);
            Append (Target.Buf, Quote);
         end;
      else
         Append (Target.Buf, Name);
      end if;
   end Append_Name;

   --  --------------------
   --  Append a string value in the buffer and
   --  escape any special character if necessary.
   --  --------------------
   procedure Append_Value (Target : in out Buffer;
                           Value  : in String) is
   begin
      Append (Target.Buf, Value);
   end Append_Value;

   --  --------------------
   --  Append a string value in the buffer and
   --  escape any special character if necessary.
   --  --------------------
   procedure Append_Value (Target : in out Buffer;
                           Value  : in Unbounded_String) is
   begin
      Append (Target.Buf, Value);
   end Append_Value;

   --  --------------------
   --  Append the integer value in the buffer.
   --  --------------------
   procedure Append_Value (Target : in out Buffer;
                           Value  : in Long_Integer) is
      S : constant String := Long_Integer'Image (Value);
   begin
      Append (Target.Buf, S (S'First + 1 .. S'Last));
   end Append_Value;

   --  --------------------
   --  Append the integer value in the buffer.
   --  --------------------
   procedure Append_Value (Target : in out Buffer;
                           Value  : in Integer) is
      S : constant String := Integer'Image (Value);
   begin
      Append (Target.Buf, S (S'First + 1 .. S'Last));
   end Append_Value;

   --  --------------------
   --  Append the identifier value in the buffer.
   --  --------------------
   procedure Append_Value (Target : in out Buffer;
                           Value  : in Identifier) is
      S : constant String := Identifier'Image (Value);
   begin
      Append (Target.Buf, S (S'First + 1 .. S'Last));
   end Append_Value;

   --  --------------------
   --  Get the SQL string that was accumulated in the buffer.
   --  --------------------
   function To_String (From : in Buffer) return String is
   begin
      return To_String (From.Buf);
   end To_String;

   --  --------------------
   --  Clear the query object.
   --  --------------------
   overriding
   procedure Clear (Target : in out Query) is
   begin
      ADO.Parameters.List (Target).Clear;
      Target.Join.Clear;
      Target.Filter.Clear;
      Target.SQL.Clear;
   end Clear;

   --  --------------------
   --  Set the SQL dialect description object.
   --  --------------------
   procedure Set_Dialect (Target : in out Query;
                          D      : in ADO.Drivers.Dialects.Dialect_Access) is
   begin
      ADO.Parameters.Abstract_List (Target).Set_Dialect (D);
      Set_Dialect (Target.SQL, D);
      Set_Dialect (Target.Filter, D);
      Set_Dialect (Target.Join, D);
   end Set_Dialect;

   procedure Set_Filter (Target : in out Query;
                         Filter : in String) is
   begin
      Target.Filter.Buf := To_Unbounded_String (Filter);
   end Set_Filter;

   function Get_Filter (Source : in Query) return String is
   begin
      if Source.Filter.Buf = Null_Unbounded_String then
         return "";
      else
         return To_String (Source.Filter.Buf);
      end if;
   end Get_Filter;

   function Has_Filter (Source : in Query) return Boolean is
   begin
      return Source.Filter.Buf /= Null_Unbounded_String
        and Length (Source.Filter.Buf) > 0;
   end Has_Filter;

   --  --------------------
   --  Set the join condition.
   --  --------------------
   procedure Set_Join (Target : in out Query;
                       Join   : in String) is
   begin
      Target.Join.Buf := To_Unbounded_String (Join);
   end Set_Join;

   --  --------------------
   --  Returns true if there is a join condition
   --  --------------------
   function Has_Join (Source : in Query) return Boolean is
   begin
      return Source.Join.Buf /= Null_Unbounded_String
        and Length (Source.Join.Buf) > 0;
   end Has_Join;

   --  --------------------
   --  Get the join condition
   --  --------------------
   function Get_Join (Source : in Query) return String is
   begin
      if Source.Join.Buf = Null_Unbounded_String then
         return "";
      else
         return To_String (Source.Join.Buf);
      end if;
   end Get_Join;

   --  --------------------
   --  Set the parameters from another parameter list.
   --  If the parameter list is a query object, also copy the filter part.
   --  --------------------
   procedure Set_Parameters (Params : in out Query;
                             From   : in ADO.Parameters.Abstract_List'Class) is
   begin
      ADO.Parameters.List (Params).Set_Parameters (From);
      if From in Query'Class then
         declare
            L : constant Query'Class := Query'Class (From);
         begin
            Params.Filter := L.Filter;
            Params.Join   := L.Join;
         end;
      end if;
   end Set_Parameters;

   --  --------------------
   --  Expand the parameters into the query and return the expanded SQL query.
   --  --------------------
   function Expand (Source : in Query) return String is
   begin
      return ADO.Parameters.Abstract_List (Source).Expand (To_String (Source.SQL.Buf));
   end Expand;

   procedure Add_Field (Update : in out Update_Query'Class;
                        Name   : in String) is
   begin
      Update.Pos := Update.Pos + 1;
      if Update.Pos > 1 then
         Append (Target => Update.Set_Fields, SQL => ",");
         Append (Target => Update.Fields, SQL => ",");
      end if;
      Append_Name (Target => Update.Set_Fields, Name => Name);
      if Update.Is_Update_Stmt then
         Append (Target => Update.Set_Fields, SQL => " = ?");
      end if;
      Append (Target => Update.Fields, SQL => "?");
   end Add_Field;

   --  ------------------------------
   --  Set the SQL dialect description object.
   --  ------------------------------
   procedure Set_Dialect (Target : in out Update_Query;
                          D      : in ADO.Drivers.Dialects.Dialect_Access) is
   begin
      Target.Set_Fields.Set_Dialect (D);
      Target.Fields.Set_Dialect (D);
      Query (Target).Set_Dialect (D);
   end Set_Dialect;

   --  ------------------------------
   --  Prepare the update/insert query to save the table field
   --  identified by Name and set it to the Value.
   --  ------------------------------
   procedure Save_Field (Update : in out Update_Query;
                         Name   : in String;
                         Value  : in Boolean) is
   begin
      Update.Add_Field (Name => Name);
      Update_Query'Class (Update).Bind_Param (Position => Update.Pos, Value => Value);
   end Save_Field;

   --  --------------------
   --  Prepare the update/insert query to save the table field
   --  identified by Name and set it to the Value.
   --  --------------------
   procedure Save_Field (Update : in out Update_Query;
                         Name   : in String;
                         Value  : in Integer) is
   begin
      Update.Add_Field (Name => Name);
      Update_Query'Class (Update).Bind_Param (Position => Update.Pos, Value => Value);
   end Save_Field;

   --  --------------------
   --  Prepare the update/insert query to save the table field
   --  identified by Name and set it to the Value.
   --  --------------------
   procedure Save_Field (Update : in out Update_Query;
                         Name   : in String;
                         Value  : in Long_Long_Integer) is
   begin
      Update.Add_Field (Name => Name);
      Update_Query'Class (Update).Bind_Param (Position => Update.Pos, Value => Value);
   end Save_Field;

   --  --------------------
   --  Prepare the update/insert query to save the table field
   --  identified by Name and set it to the Value.
   --  --------------------
   procedure Save_Field (Update : in out Update_Query;
                         Name   : in String;
                         Value  : in Long_Float) is
   begin
      Update.Add_Field (Name => Name);
      Update_Query'Class (Update).Bind_Param (Position => Update.Pos, Value => Value);
   end Save_Field;

   --  --------------------
   --  Prepare the update/insert query to save the table field
   --  identified by Name and set it to the Value.
   --  --------------------
   procedure Save_Field (Update : in out Update_Query;
                         Name   : in String;
                         Value  : in Identifier) is
   begin
      Update.Add_Field (Name => Name);
      Update_Query'Class (Update).Add_Param (Value => Value);
   end Save_Field;

   --  --------------------
   --  Prepare the update/insert query to save the table field
   --  identified by Name and set it to the Value.
   --  --------------------
   procedure Save_Field (Update : in out Update_Query;
                         Name   : in String;
                         Value  : in Entity_Type) is
   begin
      Update.Add_Field (Name => Name);
      Update_Query'Class (Update).Add_Param (Value => Integer (Value));
   end Save_Field;

   --  --------------------
   --  Prepare the update/insert query to save the table field
   --  identified by Name and set it to the Value.
   --  --------------------
   procedure Save_Field (Update : in out Update_Query;
                         Name   : in String;
                         Value  : in Ada.Calendar.Time) is
   begin
      Update.Add_Field (Name => Name);
      Update_Query'Class (Update).Add_Param (Value => Value);
   end Save_Field;

   --  --------------------
   --  Prepare the update/insert query to save the table field
   --  identified by Name and set it to the Value.
   --  --------------------
   procedure Save_Field (Update : in out Update_Query;
                         Name   : in String;
                         Value  : in String) is
   begin
      Update.Add_Field (Name => Name);
      Update_Query'Class (Update).Bind_Param (Position => Update.Pos, Value => Value);
   end Save_Field;

   --  --------------------
   --  Prepare the update/insert query to save the table field
   --  identified by Name and set it to the Value.
   --  --------------------
   procedure Save_Field (Update : in out Update_Query;
                         Name   : in String;
                         Value  : in Unbounded_String) is
   begin
      Update.Add_Field (Name => Name);
      Update_Query'Class (Update).Bind_Param (Position => Update.Pos, Value => Value);
   end Save_Field;

   --  ------------------------------
   --  Prepare the update/insert query to save the table field
   --  identified by Name and set it to the Value.
   --  ------------------------------
   procedure Save_Field (Update : in out Update_Query;
                         Name   : in String;
                         Value  : in ADO.Blob_Ref) is
   begin
      Update.Add_Field (Name => Name);
      Update_Query'Class (Update).Bind_Param (Position => Update.Pos, Value => Value);
   end Save_Field;

   --  ------------------------------
   --  Prepare the update/insert query to save the table field
   --  identified by Name and set it to NULL.
   --  ------------------------------
   procedure Save_Null_Field (Update : in out Update_Query;
                              Name   : in String) is
   begin
      Update.Add_Field (Name => Name);
      Update_Query'Class (Update).Bind_Null_Param (Position => Update.Pos);
   end Save_Null_Field;

   --  --------------------
   --  Check if the update/insert query has some fields to update.
   --  --------------------
   function Has_Save_Fields (Update : in Update_Query) return Boolean is
   begin
      return Update.Pos > 0;
   end Has_Save_Fields;

   procedure Set_Insert_Mode (Update : in out Update_Query) is
   begin
      Update.Is_Update_Stmt := False;
   end Set_Insert_Mode;

   procedure Append_Fields (Update : in out Update_Query;
                            Mode   : in Boolean := False) is
   begin
      if Mode then
         Append (Target => Update.SQL, SQL => To_String (Update.Fields.Buf));
      else
         Append (Target => Update.SQL, SQL => To_String (Update.Set_Fields.Buf));
      end if;
   end Append_Fields;

end ADO.SQL;

Implement Save_Field with a Long_Float

Implement Save_Field with a Long_Float


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

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

   Invalid_End_Point : exception;

   Service_Error     : exception;

   type Parameters is limited interface;

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

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

   function To_String (OP : End_Point) return String;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

   --  ------------------------------
   --  OpenID Manager
   --  ------------------------------
   --  The Manager provides the core operations for the OpenID process.
   type Manager is tagged limited private;

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

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

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

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

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

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

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

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

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

private

   use Ada.Strings.Unbounded;

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

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

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

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

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

end Security.Openid;

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

--  == OpenID ==
--  The Security.Openid package implements an authentication framework based
--  on OpenID 2.0.
--
--  See OpenID Authentication 2.0 - Final
--  http://openid.net/specs/openid-authentication-2_0.html
--
--  There are basically two steps that an application must implement:
--
--    * Discovery: to resolve and use the OpenID provider and redirect the user to the
--      provider authentication form.
--    * Verify: to decode the authentication and check its result.
--
--  [http://ada-security.googlecode.com/svn/wiki/OpenID.png]
--
--  The authentication process is the following:
--
--    * The application should redirect the user to the authentication URL.
--    * The OpenID provider authenticate the user and redirects the user to the callback CB.
--    * The association is decoded from the callback parameter.
--    * The Verify procedure is called with the association to check the result and
--      obtain the authentication results.
--
--  === Initialization ===
--  The initialization process must be done before each two steps (discovery and verify).
--  The OpenID manager must be declared and configured.
--
--    Mgr   : Openid.Manager;
--
--  For the configuration, the Initialize procedure is called to configure
--  the OpenID realm and set the OpenID return callback CB.  The return callback
--  must be a valid URL that is based on the realm.  Example:
--
--    Mgr.Initialize (Name      => "http://app.site.com/auth",
--                    Return_To => "http://app.site.com/auth/verify");
--
--  After this initialization, the OpenID manager can be used in the authentication process.
--
--  === Discovery: creating the authentication URL ===
--  The first step is to create an authentication URL to which the user must be redirected.
--  In this step, we have to create an OpenId manager, discover the OpenID provider,
--  do the association and get an End_Point.
--
--    OP    : Openid.End_Point;
--    Assoc : constant Association_Access := new Association;
--
--  The following steps are performed:
--
--    * The Discover procedure is called to retrieve from the OpenID provider the XRDS
--      stream and identify the provider.  An End_Point is returned in <tt>OP</tt>.
--    * The Associate procedure is called to make the association with the End_Point.
--      The Association record holds session, and authentication.
--
--    Mgr.Discover (Provider, OP);  --  Yadis discovery (get the XRDS file).
--    Mgr.Associate (OP, Assoc.all);--  Associate and get an end-point with a key.
--
--  After this first step, you must manage to save the association in the HTTP session.
--  Then you must redirect to the authentication URL that is obtained by using:
--
--    Auth_URL : constant String := Mgr.Get_Authentication_URL (OP, Assoc.all);
--
--  === Verify: acknowledge the authentication in the callback URL ===
--  The second step is done when the user has finished the authentication successfully or not.
--  For this step, the application must get back the association that was saved in the session.
--  It must also prepare a parameters object that allows the OpenID framework to get the
--  URI parameters from the return callback.
--
--    Assoc   : Association_Access := ...;  --  Get the association saved in the session.
--    Auth    : Openid.Authentication;
--    Params  : Auth_Params;
--
--  The OpenID manager must be initialized and the Verify procedure is called with
--  the association, parameters and the authentication result.  The Get_Status function
--  must be used to check that the authentication succeeded.
--
--    Mgr.Verify (Assoc.all, Params, Auth);
--    if Openid.Get_Status (Auth) /= Openid.AUTHENTICATED then ...  -- Failure.
--
--
--
package Security.Openid is

   Invalid_End_Point : exception;

   Service_Error     : exception;

   type Parameters is limited interface;

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

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

   function To_String (OP : End_Point) return String;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

   --  ------------------------------
   --  OpenID Manager
   --  ------------------------------
   --  The Manager provides the core operations for the OpenID process.
   type Manager is tagged limited private;

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

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

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

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

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

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

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

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

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

private

   use Ada.Strings.Unbounded;

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

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

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

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

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

end Security.Openid;

Update the documentation

Update the documentation


--  Generated by utildgen.c from system includes
with Interfaces.C;
package Util.Systems.Constants is

   pragma Pure;

   --  Flags used when opening a file with open/creat.
   O_RDONLY                      : constant Interfaces.C.int := 8#000000#;
   O_WRONLY                      : constant Interfaces.C.int := 8#000001#;
   O_RDWR                        : constant Interfaces.C.int := 8#000002#;
   O_CREAT                       : constant Interfaces.C.int := 8#000100#;
   O_EXCL                        : constant Interfaces.C.int := 8#000200#;
   O_TRUNC                       : constant Interfaces.C.int := 8#001000#;
   O_APPEND                      : constant Interfaces.C.int := 8#002000#;
   O_CLOEXEC                     : constant Interfaces.C.int := 8#2000000#;
   O_SYNC                        : constant Interfaces.C.int := 8#4010000#;
   O_DIRECT                      : constant Interfaces.C.int := 0;
   O_NONBLOCK                    : constant Interfaces.C.int := 8#004000#;

   --  Flags used by fcntl
   F_SETFL                       : constant Interfaces.C.int := 4;
   F_GETFL                       : constant Interfaces.C.int := 3;
   FD_CLOEXEC                    : constant Interfaces.C.int := 1;

   --  Flags used by dlopen
   RTLD_LAZY                     : constant Interfaces.C.int := 8#000001#;
   RTLD_NOW                      : constant Interfaces.C.int := 8#000002#;
   RTLD_NOLOAD                   : constant Interfaces.C.int := 8#000004#;
   RTLD_DEEPBIND                 : constant Interfaces.C.int := 8#000010#;
   RTLD_GLOBAL                   : constant Interfaces.C.int := 8#000400#;
   RTLD_LOCAL                    : constant Interfaces.C.int := 8#000000#;
   RTLD_NODELETE                 : constant Interfaces.C.int := 8#010000#;

   DLL_OPTIONS : constant String := "-ldl";

end Util.Systems.Constants;

--  Generated by utildgen.c from system includes
with Interfaces.C;
package Util.Systems.Constants is

   pragma Pure;

   --  Flags used when opening a file with open/creat.
   O_RDONLY                      : constant Interfaces.C.int := 8#000000#;
   O_WRONLY                      : constant Interfaces.C.int := 8#000001#;
   O_RDWR                        : constant Interfaces.C.int := 8#000002#;
   O_CREAT                       : constant Interfaces.C.int := 8#000100#;
   O_EXCL                        : constant Interfaces.C.int := 8#000200#;
   O_TRUNC                       : constant Interfaces.C.int := 8#001000#;
   O_APPEND                      : constant Interfaces.C.int := 8#002000#;
   O_CLOEXEC                     : constant Interfaces.C.int := 8#2000000#;
   O_SYNC                        : constant Interfaces.C.int := 8#4010000#;
   O_DIRECT                      : constant Interfaces.C.int := 0;
   O_NONBLOCK                    : constant Interfaces.C.int := 8#004000#;

   --  Flags used by fcntl
   F_SETFL                       : constant Interfaces.C.int := 4;
   F_GETFL                       : constant Interfaces.C.int := 3;
   FD_CLOEXEC                    : constant Interfaces.C.int := 1;

   --  Flags used by dlopen
   RTLD_LAZY                     : constant Interfaces.C.int := 8#000001#;
   RTLD_NOW                      : constant Interfaces.C.int := 8#000002#;
   RTLD_NOLOAD                   : constant Interfaces.C.int := 8#000004#;
   RTLD_DEEPBIND                 : constant Interfaces.C.int := 8#000010#;
   RTLD_GLOBAL                   : constant Interfaces.C.int := 8#000400#;
   RTLD_LOCAL                    : constant Interfaces.C.int := 8#000000#;
   RTLD_NODELETE                 : constant Interfaces.C.int := 8#010000#;

   DLL_OPTIONS : constant String := "-ldl";
   SYMBOL_PREFIX : constant String := "";

end Util.Systems.Constants;

Declare SYMBOL_PREFIX

Declare SYMBOL_PREFIX