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

with Util.Strings;

with Security.Auth;
with Security.Permissions;

--  == OAuth Server ==
--  OAuth server side is provided by the <tt>Security.OAuth.Servers</tt> package.
--  This package allows to implement the authorization framework described in RFC 6749
--  "The OAuth 2.0 Authorization Framework".
--
--  The authorization method produces a <tt>Grant_Type</tt> object that contains the result
--  of the grant (successful or denied).  It is the responsibility of the caller to format
--  the result in JSON/XML and return it to the client.
--
--  Three important operations are defined for the OAuth 2.0 framework.  They will be used
--  in the following order:
--
--  <tt>Authorize</tt> is used to obtain an authorization request.  This operation is
--  optional in the OAuth 2.0 framework since some authorization method directly return
--  the access token.  This operation is used by the "Authorization Code Grant" and the
--  "Implicit Grant".
--
--  <tt>Token</tt> is used to get the access token and optional refresh token.  Each time it
--  is called, a new token is generated.
--
--  <tt>Authenticate</tt> is used for the API request to verify the access token
--  and authenticate the API call.  This operation can be called several times with the same
--  token until the token is revoked or it has expired.
--
--  Several grant types are supported.
--
--  === Application Manager ===
--  The application manager maintains the repository of applications which are known by
--  the server and which can request authorization.  Each application is identified by
--  a client identifier (represented by the <tt>client_id</tt> request parameter).
--  The application defines the authorization methods which are allowed as well as
--  the parameters to control and drive the authorization.  This includes the redirection
--  URI, the application secret, the expiration delay for the access token.
--
--  The application manager is implemented by the application server and it must
--  implement the <tt>Application_Manager</tt> interface with the <tt>Find_Application</tt>
--  method.  The <tt>Find_Application</tt> is one of the first call made during the
--  authenticate and token generation phases.
--
--  === Resource Owner Password Credentials Grant ===
--  The password grant is one of the easiest grant method to understand but it is also one
--  of the less secure.  In this grant method, the username and user password are passed in
--  the request parameter together with the application client identifier.  The realm verifies
--  the username and password and when they are correct it generates the access token with
--  an optional refresh token.  The realm also returns in the grant the user principal that
--  identifies the user.
--
--    Realm : Security.OAuth.Servers.Auth_Manager;
--    Grant : Security.OAuth.Servers.Grant_Type;
--
--      Realm.Token (Params, Grant);
--
--  === Accessing Protected Resources ===
--  When accessing a protected resource, the API implementation will use the
--  <tt>Authenticate</tt> operation to verify the access token and get a security principal.
--  The security principal will identify the resource owner as well as the application
--  that is doing the call.
--
--     Realm : Security.OAuth.Servers.Auth_Manager;
--     Grant : Security.OAuth.Servers.Grant_Type;
--     Token : String := ...;
--
--       Realm.Authenticate (Token, Grant);
--
--  When a security principal is returned, the access token was validated and the
--  request is granted for the application.
--
package Security.OAuth.Servers is

   --  Minimum length for the server private key (160 bits min length).
   --  (See NIST Special Publication 800-107)
   MIN_KEY_LENGTH : constant Positive := 20;

   Invalid_Application : exception;

   type Application is new Security.OAuth.Application with private;

   --  Check if the application has the given permission.
   function Has_Permission (App        : in Application;
                            Permission : in Security.Permissions.Permission_Index) return Boolean;

   --  Define the status of the grant.
   type Grant_Status is (Invalid_Grant, Expired_Grant, Revoked_Grant,
                         Stealed_Grant, Valid_Grant);

   --  Define the grant type.
   type Grant_Kind is (No_Grant, Access_Grant, Code_Grant,
                       Implicit_Grant, Password_Grant, Credential_Grant,
                       Extension_Grant);

   --  The <tt>Grant_Type</tt> holds the results of the authorization.
   --  When the grant is refused, the type holds information about the refusal.
   type Grant_Type is record
      --  The request grant type.
      Request : Grant_Kind := No_Grant;

      --  The response status.
      Status  : Grant_Status := Invalid_Grant;

      --  When success, the token to return.
      Token   : Ada.Strings.Unbounded.Unbounded_String;

      --  When success, the token expiration date.
      Expires : Ada.Calendar.Time;

      --  When success, the authentication principal.
      Auth    : Security.Principal_Access;

      --  When error, the type of error to return.
      Error   : Util.Strings.Name_Access;
   end record;

   type Application_Manager is limited interface;
   type Application_Manager_Access is access all Application_Manager'Class;

   --  Find the application that correspond to the given client id.
   --  The <tt>Invalid_Application</tt> exception should be raised if there is no such application.
   function Find_Application (Realm     : in Application_Manager;
                              Client_Id : in String) return Application'Class is abstract;

   type Realm_Manager is limited interface;
   type Realm_Manager_Access is access all Realm_Manager'Class;

   --  Authenticate the token and find the associated authentication principal.
   --  The access token has been verified and the token represents the identifier
   --  of the Tuple (client_id, user, session) that describes the authentication.
   --  The <tt>Authenticate</tt> procedure should look in its database (internal
   --  or external) to find the authentication principal that was granted for
   --  the token Tuple.  When the token was not found (because it was revoked),
   --  the procedure should return a null principal.  If the authentication
   --  principal can be cached, the <tt>Cacheable</tt> value should be set.
   --  In that case, the access token and authentication  principal are inserted
   --  in a cache.
   procedure Authenticate (Realm     : in out Realm_Manager;
                           Token     : in String;
                           Auth      : out Principal_Access;
                           Cacheable : out Boolean) is abstract;

   --  Create an auth token string that identifies the given principal.  The returned
   --  token will be used by <tt>Authenticate</tt> to retrieve back the principal.  The
   --  returned token does not need to be signed.  It will be inserted in the public part
   --  of the returned access token.
   function Authorize (Realm : in Realm_Manager;
                       App   : in Application'Class;
                       Scope : in String;
                       Auth  : in Principal_Access) return String is abstract;

   procedure Verify (Realm    : in out Realm_Manager;
                     Username : in String;
                     Password : in String;
                     Auth     : out Principal_Access) is abstract;

   procedure Verify (Realm : in out Realm_Manager;
                     Token : in String;
                     Auth  : out Principal_Access) is abstract;

   procedure Revoke (Realm : in out Realm_Manager;
                     Auth  : in Principal_Access) is abstract;

   type Auth_Manager is tagged limited private;
   type Auth_Manager_Access is access all Auth_Manager'Class;

   --  Set the auth private key.
   procedure Set_Private_Key (Manager : in out Auth_Manager;
                              Key     : in String;
                              Decode  : in Boolean := False);

   --  Set the application manager to use and and applications.
   procedure Set_Application_Manager (Manager    : in out Auth_Manager;
                                      Repository : in Application_Manager_Access);

   --  Set the realm manager to authentify users.
   procedure Set_Realm_Manager (Manager : in out Auth_Manager;
                                Realm   : in Realm_Manager_Access);

   --  Authorize the access to the protected resource by the application and for the
   --  given principal.  The resource owner has been verified and is represented by the
   --  <tt>Auth</tt> principal.  Extract from the request parameters represented by
   --  <tt>Params</tt> the application client id, the scope and the expected response type.
   --  Handle the "Authorization Code Grant" and "Implicit Grant" defined in RFC 6749.
   procedure Authorize (Realm   : in out Auth_Manager;
                        Params  : in Security.Auth.Parameters'Class;
                        Auth    : in Security.Principal_Access;
                        Grant   : out Grant_Type);

   --  The <tt>Token</tt> procedure is the main entry point to get the access token and
   --  refresh token.  The request parameters are accessed through the <tt>Params</tt> interface.
   --  The operation looks at the "grant_type" parameter to identify the access method.
   --  It also looks at the "client_id" to find the application for which the access token
   --  is created.  Upon successful authentication, the operation returns a grant.
   procedure Token (Realm   : in out Auth_Manager;
                    Params  : in Security.Auth.Parameters'Class;
                    Grant   : out Grant_Type);

   --  Make the access token from the authorization code that was created by the
   --  <tt>Authorize</tt> operation.  Verify the client application, the redirect uri, the
   --  client secret and the validity of the authorization code.  Extract from the
   --  authorization code the auth principal that was used for the grant and make the
   --  access token.
   procedure Token_From_Code (Realm   : in out Auth_Manager;
                              App     : in Application'Class;
                              Params  : in Security.Auth.Parameters'Class;
                              Grant   : out Grant_Type);

   procedure Authorize_Code (Realm   : in out Auth_Manager;
                             App     : in Application'Class;
                             Params  : in Security.Auth.Parameters'Class;
                             Auth    : in Security.Principal_Access;
                             Grant   : out Grant_Type);

   procedure Authorize_Token (Realm   : in out Auth_Manager;
                              App     : in Application'Class;
                              Params  : in Security.Auth.Parameters'Class;
                              Auth    : in Security.Principal_Access;
                              Grant   : out Grant_Type);

   --  Make the access token from the resource owner password credentials.  The username,
   --  password and scope are extracted from the request and they are verified through the
   --  <tt>Verify</tt> procedure to obtain an associated principal.  When successful, the
   --  principal describes the authorization and it is used to forge the access token.
   --  This operation implements the RFC 6749: 4.3.  Resource Owner Password Credentials Grant.
   procedure Token_From_Password (Realm   : in out Auth_Manager;
                                  App     : in Application'Class;
                                  Params  : in Security.Auth.Parameters'Class;
                                  Grant   : out Grant_Type);

   --  Create a HMAC-SHA1 of the data with the private key.
   --  This function can be overriden to use another signature algorithm.
   function Sign (Realm : in Auth_Manager;
                  Data  : in String) return String;

   --  Forge an access token.  The access token is signed by an HMAC-SHA1 signature.
   --  The returned token is formed as follows:
   --    <expiration>.<ident>.HMAC-SHA1(<private-key>, <expiration>.<ident>)
   --  See also RFC 6749: 5.  Issuing an Access Token
   procedure Create_Token (Realm  : in Auth_Manager;
                           Ident  : in String;
                           Grant  : in out Grant_Type);

   --  Authenticate the access token and get a security principal that identifies the app/user.
   --  See RFC 6749, 7.  Accessing Protected Resources.
   --  The access token is first searched in the cache.  If it was found, it means the access
   --  token was already verified in the past, it is granted and associated with a principal.
   --  Otherwise, we have to verify the token signature first, then the expiration date and
   --  we extract from the token public part the auth identification.  The <tt>Authenticate</tt>
   --  operation is then called to obtain the principal from the auth identification.
   --  When access token is invalid or authentification cannot be verified, a null principal
   --  is returned.  The <tt>Grant</tt> data will hold the result of the grant with the reason
   --  of failures (if any).
   procedure Authenticate (Realm : in out Auth_Manager;
                           Token : in String;
                           Grant : out Grant_Type);

   procedure Revoke (Realm     : in out Auth_Manager;
                     Token     : in String);

private

   use Ada.Strings.Unbounded;

   function Format_Expire (Expire : in Ada.Calendar.Time) return String;

   --  Decode the expiration date that was extracted from the token.
   function Parse_Expire (Expire : in String) return Ada.Calendar.Time;

   type Application is new Security.OAuth.Application with record
      Expire_Timeout : Duration := 3600.0;
      Permissions    : Security.Permissions.Permission_Index_Set := Security.Permissions.EMPTY_SET;
   end record;

   type Cache_Entry is record
      Expire : Ada.Calendar.Time;
      Auth   : Principal_Access;
   end record;

   package Cache_Map is
     new Ada.Containers.Indefinite_Hashed_Maps (Key_Type        => String,
                                                Element_Type    => Cache_Entry,
                                                Hash            => Ada.Strings.Hash,
                                                Equivalent_Keys => "=",
                                                "="             => "=");

   --  The access token cache is used to speed up the access token verification
   --  when a request to a protected resource is made.
   protected type Token_Cache is

      procedure Authenticate (Token : in String;
                              Grant : in out Grant_Type);

      procedure Insert (Token     : in String;
                        Expire    : in Ada.Calendar.Time;
                        Principal : in Principal_Access);

      procedure Remove (Token : in String);

      procedure Timeout;

   private
      Entries : Cache_Map.Map;
   end Token_Cache;

   type Auth_Manager is new Ada.Finalization.Limited_Controlled with record
      --  The repository of applications.
      Repository  : Application_Manager_Access;

      --  The realm for user authentication.
      Realm       : Realm_Manager_Access;

      --  The server private key used by the HMAC signature.
      Private_Key : Ada.Strings.Unbounded.Unbounded_String;

      --  The access token cache.
      Cache       : Token_Cache;

      --  The expiration time for the generated authorization code.
      Expire_Code : Duration := 300.0;
   end record;

   --  The <tt>Token_Validity</tt> record provides information about a token to find out
   --  the different components it is made of and verify its validity.  The <tt>Validate</tt>
   --  procedure is in charge of checking the components and verifying the HMAC signature.
   --  The token has the following format:
   --  <expiration>.<client_id>.<auth-ident>.hmac(<public>.<private-key>)
   type Token_Validity is record
      Status       : Grant_Status := Invalid_Grant;
      Ident_Start  : Natural := 0;
      Ident_End    : Natural := 0;
      Expire       : Ada.Calendar.Time;
   end record;

   function Validate (Realm     : in Auth_Manager;
                      Client_Id : in String;
                      Token     : in String) return Token_Validity;

end Security.OAuth.Servers;

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

with Util.Strings;

with Security.Auth;
with Security.Permissions;

--  == OAuth Server ==
--  OAuth server side is provided by the <tt>Security.OAuth.Servers</tt> package.
--  This package allows to implement the authorization framework described in RFC 6749
--  "The OAuth 2.0 Authorization Framework".
--
--  The authorization method produces a <tt>Grant_Type</tt> object that contains the result
--  of the grant (successful or denied).  It is the responsibility of the caller to format
--  the result in JSON/XML and return it to the client.
--
--  Three important operations are defined for the OAuth 2.0 framework.  They will be used
--  in the following order:
--
--  <tt>Authorize</tt> is used to obtain an authorization request.  This operation is
--  optional in the OAuth 2.0 framework since some authorization method directly return
--  the access token.  This operation is used by the "Authorization Code Grant" and the
--  "Implicit Grant".
--
--  <tt>Token</tt> is used to get the access token and optional refresh token.  Each time it
--  is called, a new token is generated.
--
--  <tt>Authenticate</tt> is used for the API request to verify the access token
--  and authenticate the API call.  This operation can be called several times with the same
--  token until the token is revoked or it has expired.
--
--  Several grant types are supported.
--
--  === Application Manager ===
--  The application manager maintains the repository of applications which are known by
--  the server and which can request authorization.  Each application is identified by
--  a client identifier (represented by the <tt>client_id</tt> request parameter).
--  The application defines the authorization methods which are allowed as well as
--  the parameters to control and drive the authorization.  This includes the redirection
--  URI, the application secret, the expiration delay for the access token.
--
--  The application manager is implemented by the application server and it must
--  implement the <tt>Application_Manager</tt> interface with the <tt>Find_Application</tt>
--  method.  The <tt>Find_Application</tt> is one of the first call made during the
--  authenticate and token generation phases.
--
--  === Resource Owner Password Credentials Grant ===
--  The password grant is one of the easiest grant method to understand but it is also one
--  of the less secure.  In this grant method, the username and user password are passed in
--  the request parameter together with the application client identifier.  The realm verifies
--  the username and password and when they are correct it generates the access token with
--  an optional refresh token.  The realm also returns in the grant the user principal that
--  identifies the user.
--
--    Realm : Security.OAuth.Servers.Auth_Manager;
--    Grant : Security.OAuth.Servers.Grant_Type;
--
--      Realm.Token (Params, Grant);
--
--  === Accessing Protected Resources ===
--  When accessing a protected resource, the API implementation will use the
--  <tt>Authenticate</tt> operation to verify the access token and get a security principal.
--  The security principal will identify the resource owner as well as the application
--  that is doing the call.
--
--     Realm : Security.OAuth.Servers.Auth_Manager;
--     Grant : Security.OAuth.Servers.Grant_Type;
--     Token : String := ...;
--
--       Realm.Authenticate (Token, Grant);
--
--  When a security principal is returned, the access token was validated and the
--  request is granted for the application.
--
package Security.OAuth.Servers is

   --  Minimum length for the server private key (160 bits min length).
   --  (See NIST Special Publication 800-107)
   MIN_KEY_LENGTH : constant Positive := 20;

   Invalid_Application : exception;

   type Application is new Security.OAuth.Application with private;

   --  Check if the application has the given permission.
   function Has_Permission (App        : in Application;
                            Permission : in Security.Permissions.Permission_Index) return Boolean;

   --  Define the status of the grant.
   type Grant_Status is (Invalid_Grant, Expired_Grant, Revoked_Grant,
                         Stealed_Grant, Valid_Grant);

   --  Define the grant type.
   type Grant_Kind is (No_Grant, Access_Grant, Code_Grant,
                       Implicit_Grant, Password_Grant, Credential_Grant,
                       Extension_Grant);

   --  The <tt>Grant_Type</tt> holds the results of the authorization.
   --  When the grant is refused, the type holds information about the refusal.
   type Grant_Type is record
      --  The request grant type.
      Request : Grant_Kind := No_Grant;

      --  The response status.
      Status  : Grant_Status := Invalid_Grant;

      --  When success, the token to return.
      Token   : Ada.Strings.Unbounded.Unbounded_String;

      --  When success, the token expiration date.
      Expires : Ada.Calendar.Time;

      --  The token expiration date in seconds.
      Expires_In : Duration := 0.0;

      --  When success, the authentication principal.
      Auth    : Security.Principal_Access;

      --  When error, the type of error to return.
      Error   : Util.Strings.Name_Access;
   end record;

   type Application_Manager is limited interface;
   type Application_Manager_Access is access all Application_Manager'Class;

   --  Find the application that correspond to the given client id.
   --  The <tt>Invalid_Application</tt> exception should be raised if there is no such application.
   function Find_Application (Realm     : in Application_Manager;
                              Client_Id : in String) return Application'Class is abstract;

   type Realm_Manager is limited interface;
   type Realm_Manager_Access is access all Realm_Manager'Class;

   --  Authenticate the token and find the associated authentication principal.
   --  The access token has been verified and the token represents the identifier
   --  of the Tuple (client_id, user, session) that describes the authentication.
   --  The <tt>Authenticate</tt> procedure should look in its database (internal
   --  or external) to find the authentication principal that was granted for
   --  the token Tuple.  When the token was not found (because it was revoked),
   --  the procedure should return a null principal.  If the authentication
   --  principal can be cached, the <tt>Cacheable</tt> value should be set.
   --  In that case, the access token and authentication  principal are inserted
   --  in a cache.
   procedure Authenticate (Realm     : in out Realm_Manager;
                           Token     : in String;
                           Auth      : out Principal_Access;
                           Cacheable : out Boolean) is abstract;

   --  Create an auth token string that identifies the given principal.  The returned
   --  token will be used by <tt>Authenticate</tt> to retrieve back the principal.  The
   --  returned token does not need to be signed.  It will be inserted in the public part
   --  of the returned access token.
   function Authorize (Realm : in Realm_Manager;
                       App   : in Application'Class;
                       Scope : in String;
                       Auth  : in Principal_Access) return String is abstract;

   procedure Verify (Realm    : in out Realm_Manager;
                     Username : in String;
                     Password : in String;
                     Auth     : out Principal_Access) is abstract;

   procedure Verify (Realm : in out Realm_Manager;
                     Token : in String;
                     Auth  : out Principal_Access) is abstract;

   procedure Revoke (Realm : in out Realm_Manager;
                     Auth  : in Principal_Access) is abstract;

   type Auth_Manager is tagged limited private;
   type Auth_Manager_Access is access all Auth_Manager'Class;

   --  Set the auth private key.
   procedure Set_Private_Key (Manager : in out Auth_Manager;
                              Key     : in String;
                              Decode  : in Boolean := False);

   --  Set the application manager to use and and applications.
   procedure Set_Application_Manager (Manager    : in out Auth_Manager;
                                      Repository : in Application_Manager_Access);

   --  Set the realm manager to authentify users.
   procedure Set_Realm_Manager (Manager : in out Auth_Manager;
                                Realm   : in Realm_Manager_Access);

   --  Authorize the access to the protected resource by the application and for the
   --  given principal.  The resource owner has been verified and is represented by the
   --  <tt>Auth</tt> principal.  Extract from the request parameters represented by
   --  <tt>Params</tt> the application client id, the scope and the expected response type.
   --  Handle the "Authorization Code Grant" and "Implicit Grant" defined in RFC 6749.
   procedure Authorize (Realm   : in out Auth_Manager;
                        Params  : in Security.Auth.Parameters'Class;
                        Auth    : in Security.Principal_Access;
                        Grant   : out Grant_Type);

   --  The <tt>Token</tt> procedure is the main entry point to get the access token and
   --  refresh token.  The request parameters are accessed through the <tt>Params</tt> interface.
   --  The operation looks at the "grant_type" parameter to identify the access method.
   --  It also looks at the "client_id" to find the application for which the access token
   --  is created.  Upon successful authentication, the operation returns a grant.
   procedure Token (Realm   : in out Auth_Manager;
                    Params  : in Security.Auth.Parameters'Class;
                    Grant   : out Grant_Type);

   --  Make the access token from the authorization code that was created by the
   --  <tt>Authorize</tt> operation.  Verify the client application, the redirect uri, the
   --  client secret and the validity of the authorization code.  Extract from the
   --  authorization code the auth principal that was used for the grant and make the
   --  access token.
   procedure Token_From_Code (Realm   : in out Auth_Manager;
                              App     : in Application'Class;
                              Params  : in Security.Auth.Parameters'Class;
                              Grant   : out Grant_Type);

   procedure Authorize_Code (Realm   : in out Auth_Manager;
                             App     : in Application'Class;
                             Params  : in Security.Auth.Parameters'Class;
                             Auth    : in Security.Principal_Access;
                             Grant   : out Grant_Type);

   procedure Authorize_Token (Realm   : in out Auth_Manager;
                              App     : in Application'Class;
                              Params  : in Security.Auth.Parameters'Class;
                              Auth    : in Security.Principal_Access;
                              Grant   : out Grant_Type);

   --  Make the access token from the resource owner password credentials.  The username,
   --  password and scope are extracted from the request and they are verified through the
   --  <tt>Verify</tt> procedure to obtain an associated principal.  When successful, the
   --  principal describes the authorization and it is used to forge the access token.
   --  This operation implements the RFC 6749: 4.3.  Resource Owner Password Credentials Grant.
   procedure Token_From_Password (Realm   : in out Auth_Manager;
                                  App     : in Application'Class;
                                  Params  : in Security.Auth.Parameters'Class;
                                  Grant   : out Grant_Type);

   --  Create a HMAC-SHA1 of the data with the private key.
   --  This function can be overriden to use another signature algorithm.
   function Sign (Realm : in Auth_Manager;
                  Data  : in String) return String;

   --  Forge an access token.  The access token is signed by an HMAC-SHA1 signature.
   --  The returned token is formed as follows:
   --    <expiration>.<ident>.HMAC-SHA1(<private-key>, <expiration>.<ident>)
   --  See also RFC 6749: 5.  Issuing an Access Token
   procedure Create_Token (Realm  : in Auth_Manager;
                           Ident  : in String;
                           Grant  : in out Grant_Type);

   --  Authenticate the access token and get a security principal that identifies the app/user.
   --  See RFC 6749, 7.  Accessing Protected Resources.
   --  The access token is first searched in the cache.  If it was found, it means the access
   --  token was already verified in the past, it is granted and associated with a principal.
   --  Otherwise, we have to verify the token signature first, then the expiration date and
   --  we extract from the token public part the auth identification.  The <tt>Authenticate</tt>
   --  operation is then called to obtain the principal from the auth identification.
   --  When access token is invalid or authentification cannot be verified, a null principal
   --  is returned.  The <tt>Grant</tt> data will hold the result of the grant with the reason
   --  of failures (if any).
   procedure Authenticate (Realm : in out Auth_Manager;
                           Token : in String;
                           Grant : out Grant_Type);

   procedure Revoke (Realm     : in out Auth_Manager;
                     Token     : in String);

private

   use Ada.Strings.Unbounded;

   function Format_Expire (Expire : in Ada.Calendar.Time) return String;

   --  Decode the expiration date that was extracted from the token.
   function Parse_Expire (Expire : in String) return Ada.Calendar.Time;

   type Application is new Security.OAuth.Application with record
      Expire_Timeout : Duration := 3600.0;
      Permissions    : Security.Permissions.Permission_Index_Set := Security.Permissions.EMPTY_SET;
   end record;

   type Cache_Entry is record
      Expire : Ada.Calendar.Time;
      Auth   : Principal_Access;
   end record;

   package Cache_Map is
     new Ada.Containers.Indefinite_Hashed_Maps (Key_Type        => String,
                                                Element_Type    => Cache_Entry,
                                                Hash            => Ada.Strings.Hash,
                                                Equivalent_Keys => "=",
                                                "="             => "=");

   --  The access token cache is used to speed up the access token verification
   --  when a request to a protected resource is made.
   protected type Token_Cache is

      procedure Authenticate (Token : in String;
                              Grant : in out Grant_Type);

      procedure Insert (Token     : in String;
                        Expire    : in Ada.Calendar.Time;
                        Principal : in Principal_Access);

      procedure Remove (Token : in String);

      procedure Timeout;

   private
      Entries : Cache_Map.Map;
   end Token_Cache;

   type Auth_Manager is new Ada.Finalization.Limited_Controlled with record
      --  The repository of applications.
      Repository  : Application_Manager_Access;

      --  The realm for user authentication.
      Realm       : Realm_Manager_Access;

      --  The server private key used by the HMAC signature.
      Private_Key : Ada.Strings.Unbounded.Unbounded_String;

      --  The access token cache.
      Cache       : Token_Cache;

      --  The expiration time for the generated authorization code.
      Expire_Code : Duration := 300.0;
   end record;

   --  The <tt>Token_Validity</tt> record provides information about a token to find out
   --  the different components it is made of and verify its validity.  The <tt>Validate</tt>
   --  procedure is in charge of checking the components and verifying the HMAC signature.
   --  The token has the following format:
   --  <expiration>.<client_id>.<auth-ident>.hmac(<public>.<private-key>)
   type Token_Validity is record
      Status       : Grant_Status := Invalid_Grant;
      Ident_Start  : Natural := 0;
      Ident_End    : Natural := 0;
      Expire       : Ada.Calendar.Time;
   end record;

   function Validate (Realm     : in Auth_Manager;
                      Client_Id : in String;
                      Token     : in String) return Token_Validity;

end Security.OAuth.Servers;

Add Expires_In member to the Grant_Type

Add Expires_In member to the Grant_Type


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

   --  ------------------------------
   --  Set or update a variable in the `Wiki.Filters.Variable` filter.
   --  ------------------------------
   overriding
   procedure Expand (Plugin   : in out Variable_Plugin;
                     Document : in out Wiki.Documents.Document;
                     Params   : in out Wiki.Attributes.Attribute_List;
                     Context  : in out Plugin_Context) is
      pragma Unreferenced (Plugin, Document);
   begin
      if Wiki.Attributes.Length (Params) >= 3 then
         declare
            First  : Wiki.Attributes.Cursor := Wiki.Attributes.First (Params);
            Second : Wiki.Attributes.Cursor;
         begin
            Wiki.Attributes.Next (First);
            Second := First;
            Wiki.Attributes.Next (Second);
            Wiki.Filters.Variables.Add_Variable (Context.Filters,
                                                 Wiki.Attributes.Get_Wide_Value (First),
                                                 Wiki.Attributes.Get_Wide_Value (Second));
         end;
      end if;
   end Expand;

   --  ------------------------------
   --  List the variables from the `Wiki.Filters.Variable` filter.
   --  ------------------------------
   overriding
   procedure Expand (Plugin   : in out List_Variable_Plugin;
                     Document : in out Wiki.Documents.Document;
                     Params   : in out Wiki.Attributes.Attribute_List;
                     Context  : in out Plugin_Context) is
      pragma Unreferenced (Plugin);
      procedure Print_Variable (Name  : in Wiki.Strings.WString;
                                Value : in Wiki.Strings.WString);

      Has_Table  : Boolean := False;
      Format     : Format_Map := (others => False);
      Attributes : Wiki.Attributes.Attribute_List;

      procedure Print_Variable (Name  : in Wiki.Strings.WString;
                                Value : in Wiki.Strings.WString) is
      begin
         Has_Table := True;
         Context.Filters.Add_Row (Document);
         Context.Filters.Add_Column (Document, Attributes);
         Context.Filters.Add_Text (Document, Name, Format);
         Context.Filters.Add_Column (Document, Attributes);
         Context.Filters.Add_Text (Document, Value, Format);
      end Print_Variable;

   begin
      Wiki.Filters.Variables.Iterate (Context.Filters, Print_Variable'Access);
      if Has_Table then
         Context.Filters.Finish_Table (Document);
      end if;
   end Expand;

end Wiki.Plugins.Variables;

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

   --  ------------------------------
   --  Set or update a variable in the `Wiki.Filters.Variable` filter.
   --  ------------------------------
   overriding
   procedure Expand (Plugin   : in out Variable_Plugin;
                     Document : in out Wiki.Documents.Document;
                     Params   : in out Wiki.Attributes.Attribute_List;
                     Context  : in out Plugin_Context) is
      pragma Unreferenced (Plugin, Document);
   begin
      if Wiki.Attributes.Length (Params) >= 3 then
         declare
            First  : Wiki.Attributes.Cursor := Wiki.Attributes.First (Params);
            Second : Wiki.Attributes.Cursor;
         begin
            Wiki.Attributes.Next (First);
            Second := First;
            Wiki.Attributes.Next (Second);
            Wiki.Filters.Variables.Add_Variable (Context.Filters,
                                                 Wiki.Attributes.Get_Wide_Value (First),
                                                 Wiki.Attributes.Get_Wide_Value (Second));
         end;
      end if;
   end Expand;

   --  ------------------------------
   --  List the variables from the `Wiki.Filters.Variable` filter.
   --  ------------------------------
   overriding
   procedure Expand (Plugin   : in out List_Variable_Plugin;
                     Document : in out Wiki.Documents.Document;
                     Params   : in out Wiki.Attributes.Attribute_List;
                     Context  : in out Plugin_Context) is
      pragma Unreferenced (Plugin);
      procedure Print_Variable (Name  : in Wiki.Strings.WString;
                                Value : in Wiki.Strings.WString);

      Has_Table  : Boolean := False;
      Format     : constant Format_Map := (others => False);
      Attributes : Wiki.Attributes.Attribute_List;

      procedure Print_Variable (Name  : in Wiki.Strings.WString;
                                Value : in Wiki.Strings.WString) is
      begin
         Has_Table := True;
         Context.Filters.Add_Row (Document);
         Context.Filters.Add_Column (Document, Attributes);
         Context.Filters.Add_Text (Document, Name, Format);
         Context.Filters.Add_Column (Document, Attributes);
         Context.Filters.Add_Text (Document, Value, Format);
      end Print_Variable;

   begin
      Wiki.Filters.Variables.Iterate (Context.Filters, Print_Variable'Access);
      if Has_Table then
         Context.Filters.Finish_Table (Document);
      end if;
   end Expand;

end Wiki.Plugins.Variables;

Change Format local variable to a constant


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

with ADO;
with Wiki.Strings;
with AWA.Modules;
with AWA.Blogs.Models;
with AWA.Counters.Definition;

with Security.Permissions;

--  == Integration ==
--  The <tt>Blog_Module</tt> manages the creation, update, removal of blog posts in an application.
--  It provides operations that are used by the blog beans or other services to create and update
--  posts.  An instance of the <tt>Blog_Module</tt> must be declared and registered in the
--  AWA application.  The module instance can be defined as follows:
--
--    type Application is new AWA.Applications.Application with record
--       Blog_Module : aliased AWA.Blogs.Modules.Blog_Module;
--    end record;
--
--  And registered in the `Initialize_Modules` procedure by using:
--
--    Register (App    => App.Self.all'Access,
--              Name   => AWA.Blogs.Modules.NAME,
--              URI    => "blogs",
--              Module => App.Blog_Module'Access);
--
package AWA.Blogs.Modules is

   NAME : constant String := "blogs";

   --  The configuration parameter that defines the image link prefix in rendered HTML content.
   PARAM_IMAGE_PREFIX : constant String := "image_prefix";

   --  Define the permissions.
   package ACL_Create_Blog is new Security.Permissions.Definition ("blog-create");
   package ACL_Delete_Blog is new Security.Permissions.Definition ("blog-delete");
   package ACL_Create_Post is new Security.Permissions.Definition ("blog-create-post");
   package ACL_Delete_Post is new Security.Permissions.Definition ("blog-delete-post");
   package ACL_Update_Post is new Security.Permissions.Definition ("blog-update-post");

   --  Define the read post counter.
   package Read_Counter is new AWA.Counters.Definition (Models.POST_TABLE, "read_count");

   Not_Found : exception;

   type Blog_Module is new AWA.Modules.Module with private;
   type Blog_Module_Access is access all Blog_Module'Class;

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

   --  Configures the module after its initialization and after having read its XML configuration.
   overriding
   procedure Configure (Plugin : in out Blog_Module;
                        Props  : in ASF.Applications.Config);

   --  Get the blog module instance associated with the current application.
   function Get_Blog_Module return Blog_Module_Access;

   --  Get the image prefix that was configured for the Blog module.
   function Get_Image_Prefix (Module : in Blog_Module)
                              return Wiki.Strings.UString;

   --  Create a new blog for the user workspace.
   procedure Create_Blog (Model        : in Blog_Module;
                          Title        : in String;
                          Result       : out ADO.Identifier);

   --  Create a new post associated with the given blog identifier.
   procedure Create_Post (Model   : in Blog_Module;
                          Blog_Id : in ADO.Identifier;
                          Title   : in String;
                          URI     : in String;
                          Text    : in String;
                          Comment : in Boolean;
                          Status  : in AWA.Blogs.Models.Post_Status_Type;
                          Result  : out ADO.Identifier);

   --  Update the post title and text associated with the blog post identified by <b>Post</b>.
   procedure Update_Post (Model   : in Blog_Module;
                          Post_Id : in ADO.Identifier;
                          Title   : in String;
                          URI     : in String;
                          Text    : in String;
                          Comment : in Boolean;
                          Status  : in AWA.Blogs.Models.Post_Status_Type);

   --  Delete the post identified by the given identifier.
   procedure Delete_Post (Model   : in Blog_Module;
                          Post_Id : in ADO.Identifier);

   --  Load the image data associated with a blog post.  The image must be public and the
   --  post visible for the image to be retrieved by anonymous users.
   procedure Load_Image (Model    : in Blog_Module;
                         Post_Id  : in ADO.Identifier;
                         Image_Id : in ADO.Identifier;
                         Width    : in out Natural;
                         Height   : in out Natural;
                         Mime     : out Ada.Strings.Unbounded.Unbounded_String;
                         Date     : out Ada.Calendar.Time;
                         Into     : out ADO.Blob_Ref);

private

   type Blog_Module is new AWA.Modules.Module with record
      Image_Prefix : Wiki.Strings.UString;
   end record;

end AWA.Blogs.Modules;

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

with ADO;
with Wiki.Strings;
with AWA.Modules;
with AWA.Blogs.Models;
with AWA.Counters.Definition;
with AWA.Blogs.Servlets;

with Security.Permissions;

--  == Integration ==
--  The <tt>Blog_Module</tt> manages the creation, update, removal of blog posts in an application.
--  It provides operations that are used by the blog beans or other services to create and update
--  posts.  An instance of the <tt>Blog_Module</tt> must be declared and registered in the
--  AWA application.  The module instance can be defined as follows:
--
--    type Application is new AWA.Applications.Application with record
--       Blog_Module : aliased AWA.Blogs.Modules.Blog_Module;
--    end record;
--
--  And registered in the `Initialize_Modules` procedure by using:
--
--    Register (App    => App.Self.all'Access,
--              Name   => AWA.Blogs.Modules.NAME,
--              URI    => "blogs",
--              Module => App.Blog_Module'Access);
--
package AWA.Blogs.Modules is

   NAME : constant String := "blogs";

   --  The configuration parameter that defines the image link prefix in rendered HTML content.
   PARAM_IMAGE_PREFIX : constant String := "image_prefix";

   --  Define the permissions.
   package ACL_Create_Blog is new Security.Permissions.Definition ("blog-create");
   package ACL_Delete_Blog is new Security.Permissions.Definition ("blog-delete");
   package ACL_Create_Post is new Security.Permissions.Definition ("blog-create-post");
   package ACL_Delete_Post is new Security.Permissions.Definition ("blog-delete-post");
   package ACL_Update_Post is new Security.Permissions.Definition ("blog-update-post");

   --  Define the read post counter.
   package Read_Counter is new AWA.Counters.Definition (Models.POST_TABLE, "read_count");

   Not_Found : exception;

   type Blog_Module is new AWA.Modules.Module with private;
   type Blog_Module_Access is access all Blog_Module'Class;

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

   --  Configures the module after its initialization and after having read its XML configuration.
   overriding
   procedure Configure (Plugin : in out Blog_Module;
                        Props  : in ASF.Applications.Config);

   --  Get the blog module instance associated with the current application.
   function Get_Blog_Module return Blog_Module_Access;

   --  Get the image prefix that was configured for the Blog module.
   function Get_Image_Prefix (Module : in Blog_Module)
                              return Wiki.Strings.UString;

   --  Create a new blog for the user workspace.
   procedure Create_Blog (Model        : in Blog_Module;
                          Title        : in String;
                          Result       : out ADO.Identifier);

   --  Create a new post associated with the given blog identifier.
   procedure Create_Post (Model   : in Blog_Module;
                          Blog_Id : in ADO.Identifier;
                          Title   : in String;
                          URI     : in String;
                          Text    : in String;
                          Comment : in Boolean;
                          Status  : in AWA.Blogs.Models.Post_Status_Type;
                          Result  : out ADO.Identifier);

   --  Update the post title and text associated with the blog post identified by <b>Post</b>.
   procedure Update_Post (Model   : in Blog_Module;
                          Post_Id : in ADO.Identifier;
                          Title   : in String;
                          URI     : in String;
                          Text    : in String;
                          Comment : in Boolean;
                          Status  : in AWA.Blogs.Models.Post_Status_Type);

   --  Delete the post identified by the given identifier.
   procedure Delete_Post (Model   : in Blog_Module;
                          Post_Id : in ADO.Identifier);

   --  Load the image data associated with a blog post.  The image must be public and the
   --  post visible for the image to be retrieved by anonymous users.
   procedure Load_Image (Model    : in Blog_Module;
                         Post_Id  : in ADO.Identifier;
                         Image_Id : in ADO.Identifier;
                         Width    : in out Natural;
                         Height   : in out Natural;
                         Mime     : out Ada.Strings.Unbounded.Unbounded_String;
                         Date     : out Ada.Calendar.Time;
                         Into     : out ADO.Blob_Ref);

private

   type Blog_Module is new AWA.Modules.Module with record
      Image_Prefix : Wiki.Strings.UString;
      Image_Servlet : aliased AWA.Blogs.Servlets.Image_Servlet;
   end record;

end AWA.Blogs.Modules;

Add the Image_Servlet to the Blog_Module type


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

with Util.Log.Loggers;
with Util.Strings.Transforms;
package body Gen.Commands.Project is

   use Util.Log;

   Log : constant Loggers.Logger := Loggers.Create ("Gen.Commands.Project");

   --  ------------------------------
   --  Generator Command
   --  ------------------------------
   function Get_Name_From_Email (Email : in String) return String;

   --  ------------------------------
   --  Get the user name from the email address.
   --  Returns the possible user name from his email address.
   --  ------------------------------
   function Get_Name_From_Email (Email : in String) return String is
      Pos : Natural := Util.Strings.Index (Email, '<');
   begin
      if Pos > 0 then
         return Email (Email'First .. Pos - 1);
      end if;
      Pos := Util.Strings.Index (Email, '@');
      if Pos > 0 then
         return Email (Email'First .. Pos - 1);
      else
         return Email;
      end if;
   end Get_Name_From_Email;

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

      Web_Flag  : aliased Boolean := False;
      Tool_Flag : aliased Boolean := False;
      Ado_Flag  : aliased Boolean := False;
      Gtk_Flag  : aliased Boolean := False;
      Lib_Flag  : aliased Boolean := False;
   begin
      --  If a dynamo.xml file exists, read it.
      if Ada.Directories.Exists ("dynamo.xml") then
         Generator.Read_Project ("dynamo.xml");
      else
         Generator.Set_Project_Property ("license", "apache");
         Generator.Set_Project_Property ("author", "unknown");
         Generator.Set_Project_Property ("author_email", "unknown@company.com");
      end if;
      --  Parse the command line
      loop
         case Getopt ("l: ? -web -tool -ado -gtk") is
         when ASCII.NUL => exit;

         when '-' =>
            if Full_Switch = "-web" then
               Web_Flag := True;
            elsif Full_Switch = "-tool" then
               Tool_Flag := True;
            elsif Full_Switch = "-ado" then
               Ado_Flag := True;
            elsif Full_Switch = "-lib" then
               Lib_Flag := True;
            elsif Full_Switch = "-gtk" then
               Gtk_Flag := True;
            end if;

         when 'l' =>
            declare
               L : constant String := Util.Strings.Transforms.To_Lower_Case (Parameter);
            begin
               Log.Info ("License {0}", L);

               if L = "apache" then
                  Generator.Set_Project_Property ("license", "apache");
               elsif L = "gpl" then
                  Generator.Set_Project_Property ("license", "gpl");
               elsif L = "gpl3" then
                  Generator.Set_Project_Property ("license", "gpl3");
               elsif L = "mit" then
                  Generator.Set_Project_Property ("license", "mit");
               elsif L = "bsd3" then
                  Generator.Set_Project_Property ("license", "bsd3");
               elsif L = "proprietary" then
                  Generator.Set_Project_Property ("license", "proprietary");
               else
                  Generator.Error ("Invalid license: {0}", L);
                  Generator.Error ("Valid licenses: apache, gpl, gpl3, mit, bsd3, proprietary");
                  return;
               end if;
            end;

         when others =>
            null;
         end case;
      end loop;
      if not Web_Flag and not Ado_Flag and not Tool_Flag and not Gtk_Flag then
         Web_Flag := True;
      end if;
      declare
         Name  : constant String := Get_Argument;
         Arg2  : constant String := Get_Argument;
         Arg3  : constant String := Get_Argument;
      begin
         if Name'Length = 0 then
            Generator.Error ("Missing project name");
            Cmd.Usage;
            return;
         end if;

         if Util.Strings.Index (Arg2, '@') > Arg2'First then
            Generator.Set_Project_Property ("author_email", Arg2);
            if Arg3'Length = 0 then
               Generator.Set_Project_Property ("author", Get_Name_From_Email (Arg2));
            else
               Generator.Set_Project_Property ("author", Arg3);
            end if;

         elsif Util.Strings.Index (Arg3, '@') > Arg3'First then
            Generator.Set_Project_Property ("author", Arg2);
            Generator.Set_Project_Property ("author_email", Arg3);

         elsif Arg3'Length > 0 then
            Generator.Error ("The last argument should be the author's email address.");
            Cmd.Usage;
            return;
         end if;

         Generator.Set_Project_Property ("is_web", Boolean'Image (Web_Flag));
         Generator.Set_Project_Property ("is_tool", Boolean'Image (Tool_Flag));
         Generator.Set_Project_Property ("is_ado", Boolean'Image (Ado_Flag));
         Generator.Set_Project_Property ("is_gtk", Boolean'Image (Gtk_Flag));
         Generator.Set_Project_Property ("is_lib", Boolean'Image (Lib_Flag));
         Generator.Set_Project_Name (Name);
         Generator.Set_Force_Save (False);
         if Ado_Flag then
            Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE, "project-ado");
         elsif Gtk_Flag then
            Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE, "project-gtk");
         elsif Lib_Flag then
            Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE, "project-lib");
         else
            Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE, "project");
         end if;

         Generator.Save_Project;
         declare
            use type GNAT.OS_Lib.String_Access;

            Path   : constant GNAT.OS_Lib.String_Access
              := GNAT.OS_Lib.Locate_Exec_On_Path ("autoconf");
            Args   : GNAT.OS_Lib.Argument_List (1 .. 0);
            Status : Boolean;
         begin
            if Path = null then
               Generator.Error ("The 'autoconf' tool was not found.  It is necessary to "
                                & "generate the configure script.");
               Generator.Error ("Install 'autoconf' or launch it manually.");
            else
               Ada.Directories.Set_Directory (Generator.Get_Result_Directory);
               Log.Info ("Executing {0}", Path.all);
               GNAT.OS_Lib.Spawn (Path.all, Args, Status);
               if not Status then
                  Generator.Error ("Execution of {0} failed", Path.all);
               end if;
            end if;
         end;
      end;
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Cmd       : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Generator);
      use Ada.Text_IO;
   begin
      Put_Line ("create-project: Create a new Ada Web Application project");
      Put_Line ("Usage: create-project [-l apache|gpl|gpl3|mit|bsd3|proprietary] [--web] [--tool]"
                & "[--lib] [--ado] [--gtk] NAME [AUTHOR] [EMAIL]");
      New_Line;
      Put_Line ("  Creates a new AWA application with the name passed in NAME.");
      Put_Line ("  The application license is controlled with the -l option. ");
      Put_Line ("  License headers can use either the Apache, the MIT license, the BSD 3 clauses");
      Put_Line ("  license, the GNU licenses or a proprietary license.");
      Put_Line ("  The author's name and email addresses are also reported in generated files.");
      New_Line;
      Put_Line ("  --web   Generate a Web application (the default)");
      Put_Line ("  --tool  Generate a command line tool");
      Put_Line ("  --ado   Generate a database tool operation for ADO");
      Put_Line ("  --gtk   Generate a GtkAda project");
      Put_Line ("  --lib   Generate a library project");
   end Help;

end Gen.Commands.Project;

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

with Util.Log.Loggers;
with Util.Strings.Transforms;
package body Gen.Commands.Project is

   use Util.Log;

   Log : constant Loggers.Logger := Loggers.Create ("Gen.Commands.Project");

   --  ------------------------------
   --  Generator Command
   --  ------------------------------
   function Get_Name_From_Email (Email : in String) return String;

   --  ------------------------------
   --  Get the user name from the email address.
   --  Returns the possible user name from his email address.
   --  ------------------------------
   function Get_Name_From_Email (Email : in String) return String is
      Pos : Natural := Util.Strings.Index (Email, '<');
   begin
      if Pos > 0 then
         return Email (Email'First .. Pos - 1);
      end if;
      Pos := Util.Strings.Index (Email, '@');
      if Pos > 0 then
         return Email (Email'First .. Pos - 1);
      else
         return Email;
      end if;
   end Get_Name_From_Email;

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

      Web_Flag  : aliased Boolean := False;
      Tool_Flag : aliased Boolean := False;
      Ado_Flag  : aliased Boolean := False;
      Gtk_Flag  : aliased Boolean := False;
      Lib_Flag  : aliased Boolean := False;
   begin
      --  If a dynamo.xml file exists, read it.
      if Ada.Directories.Exists ("dynamo.xml") then
         Generator.Read_Project ("dynamo.xml");
      else
         Generator.Set_Project_Property ("license", "apache");
         Generator.Set_Project_Property ("author", "unknown");
         Generator.Set_Project_Property ("author_email", "unknown@company.com");
      end if;
      --  Parse the command line
      loop
         case Getopt ("l: ? -lib -web -tool -ado -gtk") is
         when ASCII.NUL => exit;

         when '-' =>
            if Full_Switch = "-web" then
               Web_Flag := True;
            elsif Full_Switch = "-tool" then
               Tool_Flag := True;
            elsif Full_Switch = "-ado" then
               Ado_Flag := True;
            elsif Full_Switch = "-lib" then
               Lib_Flag := True;
            elsif Full_Switch = "-gtk" then
               Gtk_Flag := True;
            end if;

         when 'l' =>
            declare
               L : constant String := Util.Strings.Transforms.To_Lower_Case (Parameter);
            begin
               Log.Info ("License {0}", L);

               if L = "apache" then
                  Generator.Set_Project_Property ("license", "apache");
               elsif L = "gpl" then
                  Generator.Set_Project_Property ("license", "gpl");
               elsif L = "gpl3" then
                  Generator.Set_Project_Property ("license", "gpl3");
               elsif L = "mit" then
                  Generator.Set_Project_Property ("license", "mit");
               elsif L = "bsd3" then
                  Generator.Set_Project_Property ("license", "bsd3");
               elsif L = "proprietary" then
                  Generator.Set_Project_Property ("license", "proprietary");
               else
                  Generator.Error ("Invalid license: {0}", L);
                  Generator.Error ("Valid licenses: apache, gpl, gpl3, mit, bsd3, proprietary");
                  return;
               end if;
            end;

         when others =>
            null;
         end case;
      end loop;
      if not Web_Flag and not Ado_Flag and not Tool_Flag and not Gtk_Flag then
         Web_Flag := True;
      end if;
      declare
         Name  : constant String := Get_Argument;
         Arg2  : constant String := Get_Argument;
         Arg3  : constant String := Get_Argument;
      begin
         if Name'Length = 0 then
            Generator.Error ("Missing project name");
            Cmd.Usage;
            return;
         end if;

         if Util.Strings.Index (Arg2, '@') > Arg2'First then
            Generator.Set_Project_Property ("author_email", Arg2);
            if Arg3'Length = 0 then
               Generator.Set_Project_Property ("author", Get_Name_From_Email (Arg2));
            else
               Generator.Set_Project_Property ("author", Arg3);
            end if;

         elsif Util.Strings.Index (Arg3, '@') > Arg3'First then
            Generator.Set_Project_Property ("author", Arg2);
            Generator.Set_Project_Property ("author_email", Arg3);

         elsif Arg3'Length > 0 then
            Generator.Error ("The last argument should be the author's email address.");
            Cmd.Usage;
            return;
         end if;

         Generator.Set_Project_Property ("is_web", Boolean'Image (Web_Flag));
         Generator.Set_Project_Property ("is_tool", Boolean'Image (Tool_Flag));
         Generator.Set_Project_Property ("is_ado", Boolean'Image (Ado_Flag));
         Generator.Set_Project_Property ("is_gtk", Boolean'Image (Gtk_Flag));
         Generator.Set_Project_Property ("is_lib", Boolean'Image (Lib_Flag));
         Generator.Set_Project_Name (Name);
         Generator.Set_Force_Save (False);
         if Ado_Flag then
            Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE, "project-ado");
         elsif Gtk_Flag then
            Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE, "project-gtk");
         elsif Lib_Flag then
            Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE, "project-lib");
         else
            Gen.Generator.Generate_All (Generator, Gen.Artifacts.ITERATION_TABLE, "project");
         end if;

         Generator.Save_Project;
         declare
            use type GNAT.OS_Lib.String_Access;

            Path   : constant GNAT.OS_Lib.String_Access
              := GNAT.OS_Lib.Locate_Exec_On_Path ("autoconf");
            Args   : GNAT.OS_Lib.Argument_List (1 .. 0);
            Status : Boolean;
         begin
            if Path = null then
               Generator.Error ("The 'autoconf' tool was not found.  It is necessary to "
                                & "generate the configure script.");
               Generator.Error ("Install 'autoconf' or launch it manually.");
            else
               Ada.Directories.Set_Directory (Generator.Get_Result_Directory);
               Log.Info ("Executing {0}", Path.all);
               GNAT.OS_Lib.Spawn (Path.all, Args, Status);
               if not Status then
                  Generator.Error ("Execution of {0} failed", Path.all);
               end if;
            end if;
         end;
      end;
   end Execute;

   --  ------------------------------
   --  Write the help associated with the command.
   --  ------------------------------
   overriding
   procedure Help (Cmd       : in Command;
                   Generator : in out Gen.Generator.Handler) is
      pragma Unreferenced (Cmd, Generator);
      use Ada.Text_IO;
   begin
      Put_Line ("create-project: Create a new Ada Web Application project");
      Put_Line ("Usage: create-project [-l apache|gpl|gpl3|mit|bsd3|proprietary] [--web] [--tool]"
                & " [--lib] [--ado] [--gtk] NAME [AUTHOR] [EMAIL]");
      New_Line;
      Put_Line ("  Creates a new AWA application with the name passed in NAME.");
      Put_Line ("  The application license is controlled with the -l option. ");
      Put_Line ("  License headers can use either the Apache, the MIT license, the BSD 3 clauses");
      Put_Line ("  license, the GNU licenses or a proprietary license.");
      Put_Line ("  The author's name and email addresses are also reported in generated files.");
      New_Line;
      Put_Line ("  --web   Generate a Web application (the default)");
      Put_Line ("  --tool  Generate a command line tool");
      Put_Line ("  --ado   Generate a database tool operation for ADO");
      Put_Line ("  --gtk   Generate a GtkAda project");
      Put_Line ("  --lib   Generate a library project");
   end Help;

end Gen.Commands.Project;

Add missing --lib option to the Getopt operation for create-project command


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

with Util.Log.Loggers;

with AWA.Modules.Get;
with AWA.Modules.Beans;
with AWA.Blogs.Beans;
with AWA.Applications;
with AWA.Services.Contexts;
with AWA.Permissions;
with AWA.Permissions.Services;
with AWA.Workspaces.Models;
with AWA.Workspaces.Modules;
with AWA.Storages.Models;

with ADO.Objects;
with ADO.Sessions;
with ADO.Statements;

package body AWA.Blogs.Modules is

   package ASC renames AWA.Services.Contexts;

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

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

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

      --  Setup the resource bundles.
      App.Register ("blogMsg", "blogs");

      Register.Register (Plugin  => Plugin,
                         Name    => "AWA.Blogs.Beans.Post_Bean",
                         Handler => AWA.Blogs.Beans.Create_Post_Bean'Access);

      Register.Register (Plugin  => Plugin,
                         Name    => "AWA.Blogs.Beans.Post_List_Bean",
                         Handler => AWA.Blogs.Beans.Create_Post_List_Bean'Access);

      Register.Register (Plugin  => Plugin,
                         Name    => "AWA.Blogs.Beans.Blog_Admin_Bean",
                         Handler => AWA.Blogs.Beans.Create_Blog_Admin_Bean'Access);

      Register.Register (Plugin  => Plugin,
                         Name    => "AWA.Blogs.Beans.Blog_Bean",
                         Handler => AWA.Blogs.Beans.Create_Blog_Bean'Access);

      Register.Register (Plugin  => Plugin,
                         Name    => "AWA.Blogs.Beans.Status_List_Bean",
                         Handler => AWA.Blogs.Beans.Create_Status_List'Access);

      Register.Register (Plugin  => Plugin,
                         Name    => "AWA.Blogs.Beans.Stat_Bean",
                         Handler => AWA.Blogs.Beans.Create_Blog_Stat_Bean'Access);

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

   --  ------------------------------
   --  Configures the module after its initialization and after having read its XML configuration.
   --  ------------------------------
   overriding
   procedure Configure (Plugin : in out Blog_Module;
                        Props  : in ASF.Applications.Config) is
      pragma Unreferenced (Props);

      Image_Prefix : constant String := Plugin.Get_Config (PARAM_IMAGE_PREFIX);
   begin
      Plugin.Image_Prefix := Wiki.Strings.To_UString (Wiki.Strings.To_WString (Image_Prefix));
   end Configure;

   --  ------------------------------
   --  Get the blog module instance associated with the current application.
   --  ------------------------------
   function Get_Blog_Module return Blog_Module_Access is
      function Get is new AWA.Modules.Get (Blog_Module, Blog_Module_Access, NAME);
   begin
      return Get;
   end Get_Blog_Module;

   --  ------------------------------
   --  Create a new blog for the user workspace.
   --  ------------------------------
   procedure Create_Blog (Model        : in Blog_Module;
                          Title        : in String;
                          Result       : out ADO.Identifier) is
      pragma Unreferenced (Model);
      use type ADO.Identifier;

      Ctx   : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Blog  : AWA.Blogs.Models.Blog_Ref;
      WS    : AWA.Workspaces.Models.Workspace_Ref;
   begin
      Log.Info ("Creating blog {0} for user", Title);

      Ctx.Start;
      AWA.Workspaces.Modules.Get_Workspace (DB, Ctx, WS);

      --  Check that the user has the create blog permission on the given workspace.
      AWA.Permissions.Check (Permission => ACL_Create_Blog.Permission,
                             Entity     => WS);

      Blog.Set_Name (Title);
      Blog.Set_Workspace (WS);
      Blog.Set_Create_Date (Ada.Calendar.Clock);
      Blog.Save (DB);

      --  Add the permission for the user to use the new blog.
      AWA.Workspaces.Modules.Add_Permission (Session   => DB,
                                             User      => User,
                                             Entity    => Blog,
                                             Workspace => WS.Get_Id,
                                             List      => (ACL_Delete_Blog.Permission,
                                                           ACL_Update_Post.Permission,
                                                           ACL_Create_Post.Permission,
                                                           ACL_Delete_Post.Permission));
      Ctx.Commit;

      Result := Blog.Get_Id;
      Log.Info ("Blog {0} created for user {1}",
                ADO.Identifier'Image (Result), ADO.Identifier'Image (User));
   end Create_Blog;

   --  ------------------------------
   --  Create a new post associated with the given blog identifier.
   --  ------------------------------
   procedure Create_Post (Model   : in Blog_Module;
                          Blog_Id : in ADO.Identifier;
                          Title   : in String;
                          URI     : in String;
                          Text    : in String;
                          Comment : in Boolean;
                          Status  : in AWA.Blogs.Models.Post_Status_Type;
                          Result  : out ADO.Identifier) is
      pragma Unreferenced (Model);
      use type ADO.Identifier;

      Ctx   : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Blog  : AWA.Blogs.Models.Blog_Ref;
      Post  : AWA.Blogs.Models.Post_Ref;
      Found : Boolean;
   begin
      Log.Debug ("Creating post for user");

      Ctx.Start;
      --  Get the blog instance.
      Blog.Load (Session => DB,
                 Id      => Blog_Id,
                 Found   => Found);
      if not Found then
         Log.Error ("Blog {0} not found", ADO.Identifier'Image (Blog_Id));
         raise Not_Found with "Blog not found";
      end if;

      --  Check that the user has the create post permission on the given blog.
      AWA.Permissions.Check (Permission => ACL_Create_Post.Permission,
                             Entity     => Blog);

      --  Build the new post.
      Post.Set_Title (Title);
      Post.Set_Text (Text);
      Post.Set_Create_Date (Ada.Calendar.Clock);
      Post.Set_Uri (URI);
      Post.Set_Author (Ctx.Get_User);
      Post.Set_Status (Status);
      Post.Set_Blog (Blog);
      Post.Set_Allow_Comments (Comment);
      Post.Save (DB);
      Ctx.Commit;

      Result := Post.Get_Id;
      Log.Info ("Post {0} created for user {1}",
                ADO.Identifier'Image (Result), ADO.Identifier'Image (User));
   end Create_Post;

   --  ------------------------------
   --  Update the post title and text associated with the blog post identified by <b>Post</b>.
   --  ------------------------------
   procedure Update_Post (Model   : in Blog_Module;
                          Post_Id : in ADO.Identifier;
                          Title   : in String;
                          URI     : in String;
                          Text    : in String;
                          Comment : in Boolean;
                          Status  : in AWA.Blogs.Models.Post_Status_Type) is
      pragma Unreferenced (Model);
      use type AWA.Blogs.Models.Post_Status_Type;

      Ctx   : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Post  : AWA.Blogs.Models.Post_Ref;
      Found : Boolean;
   begin
      Ctx.Start;
      Post.Load (Session => DB, Id => Post_Id, Found => Found);
      if not Found then
         Log.Error ("Post {0} not found", ADO.Identifier'Image (Post_Id));
         raise Not_Found;
      end if;

      --  Check that the user has the update post permission on the given post.
      AWA.Permissions.Check (Permission => ACL_Update_Post.Permission,
                             Entity     => Post);

      if Status = AWA.Blogs.Models.POST_PUBLISHED and then Post.Get_Publish_Date.Is_Null then
         Post.Set_Publish_Date (ADO.Nullable_Time '(Is_Null => False,
                                                    Value   => Ada.Calendar.Clock));
      end if;
      Post.Set_Title (Title);
      Post.Set_Text (Text);
      Post.Set_Uri (URI);
      Post.Set_Status (Status);
      Post.Set_Allow_Comments (Comment);
      Post.Save (DB);
      Ctx.Commit;
   end Update_Post;

   --  ------------------------------
   --  Delete the post identified by the given identifier.
   --  ------------------------------
   procedure Delete_Post (Model   : in Blog_Module;
                          Post_Id : in ADO.Identifier) is
      pragma Unreferenced (Model);

      Ctx   : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Post  : AWA.Blogs.Models.Post_Ref;
      Found : Boolean;
   begin
      Ctx.Start;
      Post.Load (Session => DB, Id => Post_Id, Found => Found);
      if not Found then
         Log.Error ("Post {0} not found", ADO.Identifier'Image (Post_Id));
         raise Not_Found;
      end if;

      --  Check that the user has the delete post permission on the given post.
      AWA.Permissions.Check (Permission => ACL_Delete_Post.Permission,
                             Entity     => Post);

      Post.Delete (Session => DB);
      Ctx.Commit;
   end Delete_Post;

   --  ------------------------------
   --  Load the image data associated with a blog post.  The image must be public and the
   --  post visible for the image to be retrieved by anonymous users.
   --  ------------------------------
   procedure Load_Image (Model    : in Blog_Module;
                         Post_Id  : in ADO.Identifier;
                         Image_Id : in ADO.Identifier;
                         Width    : in out Natural;
                         Height   : in out Natural;
                         Mime     : out Ada.Strings.Unbounded.Unbounded_String;
                         Date     : out Ada.Calendar.Time;
                         Into     : out ADO.Blob_Ref) is
      pragma Unreferenced (Model);
      use type AWA.Storages.Models.Storage_Type;

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB    : constant ADO.Sessions.Session := AWA.Services.Contexts.Get_Session (Ctx);
      Query : ADO.Statements.Query_Statement;
      Kind  : AWA.Storages.Models.Storage_Type;
   begin
      if Width = Natural'Last or Height = Natural'Last then
         Query := DB.Create_Statement (Models.Query_Blog_Image_Get_Data);
      elsif Width > 0 then
         Query := DB.Create_Statement (Models.Query_Blog_Image_Width_Get_Data);
         Query.Bind_Param ("width", Width);
      elsif Height > 0 then
         Query := DB.Create_Statement (Models.Query_Blog_Image_Height_Get_Data);
         Query.Bind_Param ("height", Height);
      else
         Query := DB.Create_Statement (Models.Query_Blog_Image_Get_Data);
      end if;
      Query.Bind_Param ("post_id", Post_Id);
      Query.Bind_Param ("store_id", Image_Id);
      Query.Bind_Param ("user_id", User);
      Query.Execute;
      if not Query.Has_Elements then
         Log.Warn ("Blog post image entity {0} not found", ADO.Identifier'Image (Image_Id));
         raise ADO.Objects.NOT_FOUND;
      end if;
      Mime   := Query.Get_Unbounded_String (0);
      Date   := Query.Get_Time (1);
      Width  := Query.Get_Natural (4);
      Height := Query.Get_Natural (5);
      Kind   := AWA.Storages.Models.Storage_Type'Val (Query.Get_Integer (3));
      if Kind = AWA.Storages.Models.DATABASE then
         Into := Query.Get_Blob (6);
      else
         null;
      end if;
   end Load_Image;

end AWA.Blogs.Modules;

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

with Util.Log.Loggers;

with AWA.Modules.Get;
with AWA.Modules.Beans;
with AWA.Blogs.Beans;
with AWA.Applications;
with AWA.Services.Contexts;
with AWA.Permissions;
with AWA.Permissions.Services;
with AWA.Workspaces.Models;
with AWA.Workspaces.Modules;
with AWA.Storages.Models;

with ADO.Objects;
with ADO.Sessions;
with ADO.Statements;

package body AWA.Blogs.Modules is

   package ASC renames AWA.Services.Contexts;

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

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

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

      --  Setup the resource bundles.
      App.Register ("blogMsg", "blogs");

      Register.Register (Plugin  => Plugin,
                         Name    => "AWA.Blogs.Beans.Post_Bean",
                         Handler => AWA.Blogs.Beans.Create_Post_Bean'Access);

      Register.Register (Plugin  => Plugin,
                         Name    => "AWA.Blogs.Beans.Post_List_Bean",
                         Handler => AWA.Blogs.Beans.Create_Post_List_Bean'Access);

      Register.Register (Plugin  => Plugin,
                         Name    => "AWA.Blogs.Beans.Blog_Admin_Bean",
                         Handler => AWA.Blogs.Beans.Create_Blog_Admin_Bean'Access);

      Register.Register (Plugin  => Plugin,
                         Name    => "AWA.Blogs.Beans.Blog_Bean",
                         Handler => AWA.Blogs.Beans.Create_Blog_Bean'Access);

      Register.Register (Plugin  => Plugin,
                         Name    => "AWA.Blogs.Beans.Status_List_Bean",
                         Handler => AWA.Blogs.Beans.Create_Status_List'Access);

      Register.Register (Plugin  => Plugin,
                         Name    => "AWA.Blogs.Beans.Stat_Bean",
                         Handler => AWA.Blogs.Beans.Create_Blog_Stat_Bean'Access);

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

   --  ------------------------------
   --  Configures the module after its initialization and after having read its XML configuration.
   --  ------------------------------
   overriding
   procedure Configure (Plugin : in out Blog_Module;
                        Props  : in ASF.Applications.Config) is
      pragma Unreferenced (Props);

      Image_Prefix : constant String := Plugin.Get_Config (PARAM_IMAGE_PREFIX);
   begin
      Plugin.Image_Prefix := Wiki.Strings.To_UString (Wiki.Strings.To_WString (Image_Prefix));
   end Configure;

   --  ------------------------------
   --  Get the blog module instance associated with the current application.
   --  ------------------------------
   function Get_Blog_Module return Blog_Module_Access is
      function Get is new AWA.Modules.Get (Blog_Module, Blog_Module_Access, NAME);
   begin
      return Get;
   end Get_Blog_Module;

   --  ------------------------------
   --  Get the image prefix that was configured for the Blog module.
   --  ------------------------------
   function Get_Image_Prefix (Module : in Blog_Module)
                              return Wiki.Strings.UString is
   begin
      return Module.Image_Prefix;
   end Get_Image_Prefix;

   --  ------------------------------
   --  Create a new blog for the user workspace.
   --  ------------------------------
   procedure Create_Blog (Model        : in Blog_Module;
                          Title        : in String;
                          Result       : out ADO.Identifier) is
      pragma Unreferenced (Model);
      use type ADO.Identifier;

      Ctx   : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Blog  : AWA.Blogs.Models.Blog_Ref;
      WS    : AWA.Workspaces.Models.Workspace_Ref;
   begin
      Log.Info ("Creating blog {0} for user", Title);

      Ctx.Start;
      AWA.Workspaces.Modules.Get_Workspace (DB, Ctx, WS);

      --  Check that the user has the create blog permission on the given workspace.
      AWA.Permissions.Check (Permission => ACL_Create_Blog.Permission,
                             Entity     => WS);

      Blog.Set_Name (Title);
      Blog.Set_Workspace (WS);
      Blog.Set_Create_Date (Ada.Calendar.Clock);
      Blog.Save (DB);

      --  Add the permission for the user to use the new blog.
      AWA.Workspaces.Modules.Add_Permission (Session   => DB,
                                             User      => User,
                                             Entity    => Blog,
                                             Workspace => WS.Get_Id,
                                             List      => (ACL_Delete_Blog.Permission,
                                                           ACL_Update_Post.Permission,
                                                           ACL_Create_Post.Permission,
                                                           ACL_Delete_Post.Permission));
      Ctx.Commit;

      Result := Blog.Get_Id;
      Log.Info ("Blog {0} created for user {1}",
                ADO.Identifier'Image (Result), ADO.Identifier'Image (User));
   end Create_Blog;

   --  ------------------------------
   --  Create a new post associated with the given blog identifier.
   --  ------------------------------
   procedure Create_Post (Model   : in Blog_Module;
                          Blog_Id : in ADO.Identifier;
                          Title   : in String;
                          URI     : in String;
                          Text    : in String;
                          Comment : in Boolean;
                          Status  : in AWA.Blogs.Models.Post_Status_Type;
                          Result  : out ADO.Identifier) is
      pragma Unreferenced (Model);
      use type ADO.Identifier;

      Ctx   : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Blog  : AWA.Blogs.Models.Blog_Ref;
      Post  : AWA.Blogs.Models.Post_Ref;
      Found : Boolean;
   begin
      Log.Debug ("Creating post for user");

      Ctx.Start;
      --  Get the blog instance.
      Blog.Load (Session => DB,
                 Id      => Blog_Id,
                 Found   => Found);
      if not Found then
         Log.Error ("Blog {0} not found", ADO.Identifier'Image (Blog_Id));
         raise Not_Found with "Blog not found";
      end if;

      --  Check that the user has the create post permission on the given blog.
      AWA.Permissions.Check (Permission => ACL_Create_Post.Permission,
                             Entity     => Blog);

      --  Build the new post.
      Post.Set_Title (Title);
      Post.Set_Text (Text);
      Post.Set_Create_Date (Ada.Calendar.Clock);
      Post.Set_Uri (URI);
      Post.Set_Author (Ctx.Get_User);
      Post.Set_Status (Status);
      Post.Set_Blog (Blog);
      Post.Set_Allow_Comments (Comment);
      Post.Save (DB);
      Ctx.Commit;

      Result := Post.Get_Id;
      Log.Info ("Post {0} created for user {1}",
                ADO.Identifier'Image (Result), ADO.Identifier'Image (User));
   end Create_Post;

   --  ------------------------------
   --  Update the post title and text associated with the blog post identified by <b>Post</b>.
   --  ------------------------------
   procedure Update_Post (Model   : in Blog_Module;
                          Post_Id : in ADO.Identifier;
                          Title   : in String;
                          URI     : in String;
                          Text    : in String;
                          Comment : in Boolean;
                          Status  : in AWA.Blogs.Models.Post_Status_Type) is
      pragma Unreferenced (Model);
      use type AWA.Blogs.Models.Post_Status_Type;

      Ctx   : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Post  : AWA.Blogs.Models.Post_Ref;
      Found : Boolean;
   begin
      Ctx.Start;
      Post.Load (Session => DB, Id => Post_Id, Found => Found);
      if not Found then
         Log.Error ("Post {0} not found", ADO.Identifier'Image (Post_Id));
         raise Not_Found;
      end if;

      --  Check that the user has the update post permission on the given post.
      AWA.Permissions.Check (Permission => ACL_Update_Post.Permission,
                             Entity     => Post);

      if Status = AWA.Blogs.Models.POST_PUBLISHED and then Post.Get_Publish_Date.Is_Null then
         Post.Set_Publish_Date (ADO.Nullable_Time '(Is_Null => False,
                                                    Value   => Ada.Calendar.Clock));
      end if;
      Post.Set_Title (Title);
      Post.Set_Text (Text);
      Post.Set_Uri (URI);
      Post.Set_Status (Status);
      Post.Set_Allow_Comments (Comment);
      Post.Save (DB);
      Ctx.Commit;
   end Update_Post;

   --  ------------------------------
   --  Delete the post identified by the given identifier.
   --  ------------------------------
   procedure Delete_Post (Model   : in Blog_Module;
                          Post_Id : in ADO.Identifier) is
      pragma Unreferenced (Model);

      Ctx   : constant ASC.Service_Context_Access := AWA.Services.Contexts.Current;
      DB    : ADO.Sessions.Master_Session := AWA.Services.Contexts.Get_Master_Session (Ctx);
      Post  : AWA.Blogs.Models.Post_Ref;
      Found : Boolean;
   begin
      Ctx.Start;
      Post.Load (Session => DB, Id => Post_Id, Found => Found);
      if not Found then
         Log.Error ("Post {0} not found", ADO.Identifier'Image (Post_Id));
         raise Not_Found;
      end if;

      --  Check that the user has the delete post permission on the given post.
      AWA.Permissions.Check (Permission => ACL_Delete_Post.Permission,
                             Entity     => Post);

      Post.Delete (Session => DB);
      Ctx.Commit;
   end Delete_Post;

   --  ------------------------------
   --  Load the image data associated with a blog post.  The image must be public and the
   --  post visible for the image to be retrieved by anonymous users.
   --  ------------------------------
   procedure Load_Image (Model    : in Blog_Module;
                         Post_Id  : in ADO.Identifier;
                         Image_Id : in ADO.Identifier;
                         Width    : in out Natural;
                         Height   : in out Natural;
                         Mime     : out Ada.Strings.Unbounded.Unbounded_String;
                         Date     : out Ada.Calendar.Time;
                         Into     : out ADO.Blob_Ref) is
      pragma Unreferenced (Model);
      use type AWA.Storages.Models.Storage_Type;

      Ctx   : constant Services.Contexts.Service_Context_Access := AWA.Services.Contexts.Current;
      User  : constant ADO.Identifier := Ctx.Get_User_Identifier;
      DB    : constant ADO.Sessions.Session := AWA.Services.Contexts.Get_Session (Ctx);
      Query : ADO.Statements.Query_Statement;
      Kind  : AWA.Storages.Models.Storage_Type;
   begin
      if Width = Natural'Last or Height = Natural'Last then
         Query := DB.Create_Statement (Models.Query_Blog_Image_Get_Data);
      elsif Width > 0 then
         Query := DB.Create_Statement (Models.Query_Blog_Image_Width_Get_Data);
         Query.Bind_Param ("width", Width);
      elsif Height > 0 then
         Query := DB.Create_Statement (Models.Query_Blog_Image_Height_Get_Data);
         Query.Bind_Param ("height", Height);
      else
         Query := DB.Create_Statement (Models.Query_Blog_Image_Get_Data);
      end if;
      Query.Bind_Param ("post_id", Post_Id);
      Query.Bind_Param ("store_id", Image_Id);
      Query.Bind_Param ("user_id", User);
      Query.Execute;
      if not Query.Has_Elements then
         Log.Warn ("Blog post image entity {0} not found", ADO.Identifier'Image (Image_Id));
         raise ADO.Objects.NOT_FOUND;
      end if;
      Mime   := Query.Get_Unbounded_String (0);
      Date   := Query.Get_Time (1);
      Width  := Query.Get_Natural (4);
      Height := Query.Get_Natural (5);
      Kind   := AWA.Storages.Models.Storage_Type'Val (Query.Get_Integer (3));
      if Kind = AWA.Storages.Models.DATABASE then
         Into := Query.Get_Blob (6);
      else
         null;
      end if;
   end Load_Image;

end AWA.Blogs.Modules;

Implement the Get_Image_Prefix function

Implement the Get_Image_Prefix function