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

   use Interfaces;
   use Ada;

   use type Ada.Streams.Stream_Element_Offset;

   --  ------------------------------
   --  Encode the 64-bit value to LEB128 and then base64url.
   --  ------------------------------
   function Encode (Value : in Interfaces.Unsigned_64) return String is
      E       : Encoder;
      Data    : Ada.Streams.Stream_Element_Array (1 .. 10);
      Last    : Ada.Streams.Stream_Element_Offset;
      Encoded : Ada.Streams.Stream_Element_Offset;
      Result  : String (1 .. 16);
      Buf     : Ada.Streams.Stream_Element_Array (1 .. Result'Length);
      for Buf'Address use Result'Address;
      pragma Import (Ada, Buf);
   begin
      --  Encode the integer to LEB128 in the data buffer.
      Encode_LEB128 (Into => Data,
                     Pos  => Data'First,
                     Val  => Value,
                     Last => Last);

      --  Encode the data buffer in base64url.
      E.Set_URL_Mode (True);
      E.Transform (Data    => Data (Data'First .. Last),
                   Into    => Buf,
                   Last    => Last,
                   Encoded => Encoded);

      --  Strip the '=' or '==' at end of base64url.
      if Result (Positive (Last)) /= '=' then
         return Result (Result'First .. Positive (Last));
      elsif Result (Positive (Last) - 1) /= '=' then
         return Result (Result'First .. Positive (Last) - 1);
      else
         return Result (Result'First .. Positive (Last) - 2);
      end if;
   end Encode;

   --  ------------------------------
   --  Decode the base64url string and then the LEB128 integer.
   --  Raise the Encoding_Error if the string is invalid and cannot be decoded.
   --  ------------------------------
   function Decode (Value : in String) return Interfaces.Unsigned_64 is
      D       : Decoder;
      Buf     : Ada.Streams.Stream_Element_Array (1 .. Value'Length + 2);
      R       : Ada.Streams.Stream_Element_Array (1 .. Value'Length + 2);
      Last    : Ada.Streams.Stream_Element_Offset;
      Encoded : Ada.Streams.Stream_Element_Offset;
      Result  : Interfaces.Unsigned_64;
      End_Pos : constant Ada.Streams.Stream_Element_Offset
        := Value'Length + ((4 - (Value'Length mod 4)) mod 4);
   begin
      Util.Streams.Copy (Into => Buf (1 .. Value'Length), From => Value);

      --  Set back the '=' for the base64url (pad to multiple of 4.
      Buf (Value'Length + 1) := Character'Pos ('=');
      Buf (Value'Length + 2) := Character'Pos ('=');

      --  Decode using base64url
      D.Set_URL_Mode (True);
      D.Transform (Data    => Buf (Buf'First .. End_Pos),
                   Into    => R,
                   Last    => Last,
                   Encoded => Encoded);
      if Encoded /= End_Pos then
         raise Encoding_Error with "Input string is too short";
      end if;

      --  Decode the LEB128 number.
      Decode_LEB128 (From => R (R'First .. Last),
                     Pos  => R'First,
                     Val  => Result,
                     Last => Encoded);

      --  Check that everything was decoded.
      if Last + 1 /= Encoded then
         raise Encoding_Error with "Input string contains garbage at the end";
      end if;
      return Result;
   end Decode;

   --  ------------------------------
   --  Encodes the binary input stream represented by Data into
   --  the a base64 output stream Into.
   --
   --  If the transformer does not have enough room to write the result,
   --  it must return in Encoded the index of the last encoded
   --  position in the Data stream.
   --
   --  The transformer returns in Last the last valid position
   --  in the output stream Into.
   --
   --  The Encoding_Error exception is raised if the input
   --  stream cannot be transformed.
   --  ------------------------------
   overriding
   procedure Transform (E       : in Encoder;
                        Data    : in Ada.Streams.Stream_Element_Array;
                        Into    : out Ada.Streams.Stream_Element_Array;
                        Last    : out Ada.Streams.Stream_Element_Offset;
                        Encoded : out Ada.Streams.Stream_Element_Offset) is

      Pos      : Ada.Streams.Stream_Element_Offset := Into'First;
      I        : Ada.Streams.Stream_Element_Offset := Data'First;
      C1, C2   : Unsigned_8;

      Alphabet : constant Alphabet_Access := E.Alphabet;

   begin
      while I <= Data'Last loop
         if Pos + 4 > Into'Last + 1 then
            Last    := Pos - 1;
            Encoded := I - 1;
            return;
         end if;

         --  Encode the first byte, add padding if necessary.
         C1 := Unsigned_8 (Data (I));
         Into (Pos) := Alphabet (Shift_Right (C1, 2));
         if I = Data'Last then
            Into (Pos + 1) := Alphabet (Shift_Left (C1 and 3, 4));
            Into (Pos + 2) := Character'Pos ('=');
            Into (Pos + 3) := Character'Pos ('=');
            Last := Pos + 3;
            Encoded := Data'Last;
            return;
         end if;

         --  Encode the second byte, add padding if necessary.
         C2 := Unsigned_8 (Data (I + 1));
         Into (Pos + 1) := Alphabet (Shift_Left (C1 and 16#03#, 4) or Shift_Right (C2, 4));
         if I = Data'Last - 1 then
            Into (Pos + 2) := Alphabet (Shift_Left (C2 and 16#0F#, 2));
            Into (Pos + 3) := Character'Pos ('=');
            Last := Pos + 3;
            Encoded := Data'Last;
            return;
         end if;

         --  Encode the third byte
         C1 := Unsigned_8 (Data (I + 2));
         Into (Pos + 2) := Alphabet (Shift_Left (C2 and 16#0F#, 2) or Shift_Right (C1, 6));
         Into (Pos + 3) := Alphabet (C1 and 16#03F#);
         Pos := Pos + 4;
         I   := I + 3;
      end loop;
      Last    := Pos - 1;
      Encoded := Data'Last;
   end Transform;

   --  ------------------------------
   --  Set the encoder to use the base64 URL alphabet when Mode is True.
   --  The URL alphabet uses the '-' and '_' instead of the '+' and '/' characters.
   --  ------------------------------
   procedure Set_URL_Mode (E    : in out Encoder;
                           Mode : in Boolean) is
   begin
      if Mode then
         E.Alphabet := BASE64_URL_ALPHABET'Access;
      else
         E.Alphabet := BASE64_ALPHABET'Access;
      end if;
   end Set_URL_Mode;

   --  ------------------------------
   --  Create a base64 encoder using the URL alphabet.
   --  The URL alphabet uses the '-' and '_' instead of the '+' and '/' characters.
   --  ------------------------------
   function Create_URL_Encoder return Transformer_Access is
   begin
      return new Encoder '(Alphabet => BASE64_URL_ALPHABET'Access);
   end Create_URL_Encoder;

   --  ------------------------------
   --  Decodes the base64 input stream represented by Data into
   --  the binary output stream Into.
   --
   --  If the transformer does not have enough room to write the result,
   --  it must return in Encoded the index of the last encoded
   --  position in the Data stream.
   --
   --  The transformer returns in Last the last valid position
   --  in the output stream Into.
   --
   --  The Encoding_Error exception is raised if the input
   --  stream cannot be transformed.
   --  ------------------------------
   overriding
   procedure Transform (E       : in Decoder;
                        Data    : in Ada.Streams.Stream_Element_Array;
                        Into    : out Ada.Streams.Stream_Element_Array;
                        Last    : out Ada.Streams.Stream_Element_Offset;
                        Encoded : out Ada.Streams.Stream_Element_Offset) is

      use Ada.Streams;

      Pos      : Ada.Streams.Stream_Element_Offset := Into'First;
      I        : Ada.Streams.Stream_Element_Offset := Data'First;
      C1, C2   : Ada.Streams.Stream_Element;
      Val1, Val2 : Unsigned_8;

      Values : constant Alphabet_Values_Access := E.Values;

   begin
      while I <= Data'Last loop
         if Pos + 3 > Into'Last + 1 then
            Last    := Pos - 1;
            Encoded := I - 1;
            return;
         end if;

         --  Decode the first two bytes to produce the first output byte
         C1 := Data (I);
         Val1 := Values (C1);
         if (Val1 and 16#C0#) /= 0 then
            raise Encoding_Error with "Invalid character '" & Character'Val (C1) & "'";
         end if;

         C2 := Data (I + 1);
         Val2 := Values (C2);
         if (Val2 and 16#C0#) /= 0 then
            raise Encoding_Error with "Invalid character '" & Character'Val (C2) & "'";
         end if;

         Into (Pos) := Stream_Element (Shift_Left (Val1, 2) or Shift_Right (Val2, 4));

         if I + 2 > Data'Last then
            Encoded := I + 1;
            Last    := Pos;
            return;
         end if;

         --  Decode the next byte
         C1 := Data (I + 2);
         Val1 := Values (C1);
         if (Val1 and 16#C0#) /= 0 then
            if C1 /= Character'Pos ('=') then
               raise Encoding_Error with "Invalid character '" & Character'Val (C1) & "'";
            end if;
            Encoded := I + 3;
            Last    := Pos;
            return;
         end if;

         Into (Pos + 1) := Stream_Element (Shift_Left (Val2, 4) or Shift_Right (Val1, 2));

         if I + 3 > Data'Last then
            Encoded := I + 2;
            Last    := Pos + 1;
            return;
         end if;

         C2 := Data (I + 3);
         Val2 := Values (C2);
         if (Val2 and 16#C0#) /= 0 then
            if C2 /= Character'Pos ('=') then
               raise Encoding_Error with "Invalid character '" & Character'Val (C2) & "'";
            end if;
            Encoded := I + 3;
            Last    := Pos + 1;
            return;
         end if;

         Into (Pos + 2) := Stream_Element (Shift_Left (Val1, 6) or Val2);
         Pos := Pos + 3;
         I   := I + 4;
      end loop;
      Last    := Pos - 1;
      Encoded := Data'Last;
   end Transform;

   --  ------------------------------
   --  Set the decoder to use the base64 URL alphabet when Mode is True.
   --  The URL alphabet uses the '-' and '_' instead of the '+' and '/' characters.
   --  ------------------------------
   procedure Set_URL_Mode (E    : in out Decoder;
                           Mode : in Boolean) is
   begin
      if Mode then
         E.Values := BASE64_URL_VALUES'Access;
      else
         E.Values := BASE64_VALUES'Access;
      end if;
   end Set_URL_Mode;

   --  ------------------------------
   --  Create a base64 decoder using the URL alphabet.
   --  The URL alphabet uses the '-' and '_' instead of the '+' and '/' characters.
   --  ------------------------------
   function Create_URL_Decoder return Transformer_Access is
   begin
      return new Decoder '(Values => BASE64_URL_VALUES'Access);
   end Create_URL_Decoder;

end Util.Encoders.Base64;

-----------------------------------------------------------------------
--  util-encoders-base64 -- Encode/Decode a stream in base64adecimal
--  Copyright (C) 2009, 2010, 2011, 2012, 2013, 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 Util.Streams;
package body Util.Encoders.Base64 is

   use Interfaces;
   use Ada;

   use type Ada.Streams.Stream_Element_Offset;

   --  ------------------------------
   --  Encode the 64-bit value to LEB128 and then base64url.
   --  ------------------------------
   function Encode (Value : in Interfaces.Unsigned_64) return String is
      E       : Encoder;
      Data    : Ada.Streams.Stream_Element_Array (1 .. 10);
      Last    : Ada.Streams.Stream_Element_Offset;
      Encoded : Ada.Streams.Stream_Element_Offset;
      Result  : String (1 .. 16);
      Buf     : Ada.Streams.Stream_Element_Array (1 .. Result'Length);
      for Buf'Address use Result'Address;
      pragma Import (Ada, Buf);
   begin
      --  Encode the integer to LEB128 in the data buffer.
      Encode_LEB128 (Into => Data,
                     Pos  => Data'First,
                     Val  => Value,
                     Last => Last);

      --  Encode the data buffer in base64url.
      E.Set_URL_Mode (True);
      E.Transform (Data    => Data (Data'First .. Last),
                   Into    => Buf,
                   Last    => Last,
                   Encoded => Encoded);

      --  Strip the '=' or '==' at end of base64url.
      if Result (Positive (Last)) /= '=' then
         return Result (Result'First .. Positive (Last));
      elsif Result (Positive (Last) - 1) /= '=' then
         return Result (Result'First .. Positive (Last) - 1);
      else
         return Result (Result'First .. Positive (Last) - 2);
      end if;
   end Encode;

   --  ------------------------------
   --  Decode the base64url string and then the LEB128 integer.
   --  Raise the Encoding_Error if the string is invalid and cannot be decoded.
   --  ------------------------------
   function Decode (Value : in String) return Interfaces.Unsigned_64 is
      D       : Decoder;
      Buf     : Ada.Streams.Stream_Element_Array (1 .. Value'Length + 2);
      R       : Ada.Streams.Stream_Element_Array (1 .. Value'Length + 2);
      Last    : Ada.Streams.Stream_Element_Offset;
      Encoded : Ada.Streams.Stream_Element_Offset;
      Result  : Interfaces.Unsigned_64;
      End_Pos : constant Ada.Streams.Stream_Element_Offset
        := Value'Length + ((4 - (Value'Length mod 4)) mod 4);
   begin
      Util.Streams.Copy (Into => Buf (1 .. Value'Length), From => Value);

      --  Set back the '=' for the base64url (pad to multiple of 4.
      Buf (Value'Length + 1) := Character'Pos ('=');
      Buf (Value'Length + 2) := Character'Pos ('=');

      --  Decode using base64url
      D.Set_URL_Mode (True);
      D.Transform (Data    => Buf (Buf'First .. End_Pos),
                   Into    => R,
                   Last    => Last,
                   Encoded => Encoded);
      if Encoded /= End_Pos then
         raise Encoding_Error with "Input string is too short";
      end if;

      --  Decode the LEB128 number.
      Decode_LEB128 (From => R (R'First .. Last),
                     Pos  => R'First,
                     Val  => Result,
                     Last => Encoded);

      --  Check that everything was decoded.
      if Last + 1 /= Encoded then
         raise Encoding_Error with "Input string contains garbage at the end";
      end if;
      return Result;
   end Decode;

   --  ------------------------------
   --  Encodes the binary input stream represented by Data into
   --  the a base64 output stream Into.
   --
   --  If the transformer does not have enough room to write the result,
   --  it must return in Encoded the index of the last encoded
   --  position in the Data stream.
   --
   --  The transformer returns in Last the last valid position
   --  in the output stream Into.
   --
   --  The Encoding_Error exception is raised if the input
   --  stream cannot be transformed.
   --  ------------------------------
   overriding
   procedure Transform (E       : in out Encoder;
                        Data    : in Ada.Streams.Stream_Element_Array;
                        Into    : out Ada.Streams.Stream_Element_Array;
                        Last    : out Ada.Streams.Stream_Element_Offset;
                        Encoded : out Ada.Streams.Stream_Element_Offset) is

      Pos      : Ada.Streams.Stream_Element_Offset := Into'First;
      I        : Ada.Streams.Stream_Element_Offset := Data'First;
      C1, C2   : Unsigned_8;

      Alphabet : constant Alphabet_Access := E.Alphabet;

   begin
      while I <= Data'Last loop
         if Pos + 4 > Into'Last + 1 then
            Last    := Pos - 1;
            Encoded := I - 1;
            return;
         end if;

         --  Encode the first byte, add padding if necessary.
         C1 := Unsigned_8 (Data (I));
         Into (Pos) := Alphabet (Shift_Right (C1, 2));
         if I = Data'Last then
            Into (Pos + 1) := Alphabet (Shift_Left (C1 and 3, 4));
            Into (Pos + 2) := Character'Pos ('=');
            Into (Pos + 3) := Character'Pos ('=');
            Last := Pos + 3;
            Encoded := Data'Last;
            return;
         end if;

         --  Encode the second byte, add padding if necessary.
         C2 := Unsigned_8 (Data (I + 1));
         Into (Pos + 1) := Alphabet (Shift_Left (C1 and 16#03#, 4) or Shift_Right (C2, 4));
         if I = Data'Last - 1 then
            Into (Pos + 2) := Alphabet (Shift_Left (C2 and 16#0F#, 2));
            Into (Pos + 3) := Character'Pos ('=');
            Last := Pos + 3;
            Encoded := Data'Last;
            return;
         end if;

         --  Encode the third byte
         C1 := Unsigned_8 (Data (I + 2));
         Into (Pos + 2) := Alphabet (Shift_Left (C2 and 16#0F#, 2) or Shift_Right (C1, 6));
         Into (Pos + 3) := Alphabet (C1 and 16#03F#);
         Pos := Pos + 4;
         I   := I + 3;
      end loop;
      Last    := Pos - 1;
      Encoded := Data'Last;
   end Transform;

   --  ------------------------------
   --  Set the encoder to use the base64 URL alphabet when Mode is True.
   --  The URL alphabet uses the '-' and '_' instead of the '+' and '/' characters.
   --  ------------------------------
   procedure Set_URL_Mode (E    : in out Encoder;
                           Mode : in Boolean) is
   begin
      if Mode then
         E.Alphabet := BASE64_URL_ALPHABET'Access;
      else
         E.Alphabet := BASE64_ALPHABET'Access;
      end if;
   end Set_URL_Mode;

   --  ------------------------------
   --  Create a base64 encoder using the URL alphabet.
   --  The URL alphabet uses the '-' and '_' instead of the '+' and '/' characters.
   --  ------------------------------
   function Create_URL_Encoder return Transformer_Access is
   begin
      return new Encoder '(Alphabet => BASE64_URL_ALPHABET'Access);
   end Create_URL_Encoder;

   --  ------------------------------
   --  Decodes the base64 input stream represented by Data into
   --  the binary output stream Into.
   --
   --  If the transformer does not have enough room to write the result,
   --  it must return in Encoded the index of the last encoded
   --  position in the Data stream.
   --
   --  The transformer returns in Last the last valid position
   --  in the output stream Into.
   --
   --  The Encoding_Error exception is raised if the input
   --  stream cannot be transformed.
   --  ------------------------------
   overriding
   procedure Transform (E       : in out Decoder;
                        Data    : in Ada.Streams.Stream_Element_Array;
                        Into    : out Ada.Streams.Stream_Element_Array;
                        Last    : out Ada.Streams.Stream_Element_Offset;
                        Encoded : out Ada.Streams.Stream_Element_Offset) is

      use Ada.Streams;

      Pos      : Ada.Streams.Stream_Element_Offset := Into'First;
      I        : Ada.Streams.Stream_Element_Offset := Data'First;
      C1, C2   : Ada.Streams.Stream_Element;
      Val1, Val2 : Unsigned_8;

      Values : constant Alphabet_Values_Access := E.Values;

   begin
      while I <= Data'Last loop
         if Pos + 3 > Into'Last + 1 then
            Last    := Pos - 1;
            Encoded := I - 1;
            return;
         end if;

         --  Decode the first two bytes to produce the first output byte
         C1 := Data (I);
         Val1 := Values (C1);
         if (Val1 and 16#C0#) /= 0 then
            raise Encoding_Error with "Invalid character '" & Character'Val (C1) & "'";
         end if;

         C2 := Data (I + 1);
         Val2 := Values (C2);
         if (Val2 and 16#C0#) /= 0 then
            raise Encoding_Error with "Invalid character '" & Character'Val (C2) & "'";
         end if;

         Into (Pos) := Stream_Element (Shift_Left (Val1, 2) or Shift_Right (Val2, 4));

         if I + 2 > Data'Last then
            Encoded := I + 1;
            Last    := Pos;
            return;
         end if;

         --  Decode the next byte
         C1 := Data (I + 2);
         Val1 := Values (C1);
         if (Val1 and 16#C0#) /= 0 then
            if C1 /= Character'Pos ('=') then
               raise Encoding_Error with "Invalid character '" & Character'Val (C1) & "'";
            end if;
            Encoded := I + 3;
            Last    := Pos;
            return;
         end if;

         Into (Pos + 1) := Stream_Element (Shift_Left (Val2, 4) or Shift_Right (Val1, 2));

         if I + 3 > Data'Last then
            Encoded := I + 2;
            Last    := Pos + 1;
            return;
         end if;

         C2 := Data (I + 3);
         Val2 := Values (C2);
         if (Val2 and 16#C0#) /= 0 then
            if C2 /= Character'Pos ('=') then
               raise Encoding_Error with "Invalid character '" & Character'Val (C2) & "'";
            end if;
            Encoded := I + 3;
            Last    := Pos + 1;
            return;
         end if;

         Into (Pos + 2) := Stream_Element (Shift_Left (Val1, 6) or Val2);
         Pos := Pos + 3;
         I   := I + 4;
      end loop;
      Last    := Pos - 1;
      Encoded := Data'Last;
   end Transform;

   --  ------------------------------
   --  Set the decoder to use the base64 URL alphabet when Mode is True.
   --  The URL alphabet uses the '-' and '_' instead of the '+' and '/' characters.
   --  ------------------------------
   procedure Set_URL_Mode (E    : in out Decoder;
                           Mode : in Boolean) is
   begin
      if Mode then
         E.Values := BASE64_URL_VALUES'Access;
      else
         E.Values := BASE64_VALUES'Access;
      end if;
   end Set_URL_Mode;

   --  ------------------------------
   --  Create a base64 decoder using the URL alphabet.
   --  The URL alphabet uses the '-' and '_' instead of the '+' and '/' characters.
   --  ------------------------------
   function Create_URL_Decoder return Transformer_Access is
   begin
      return new Decoder '(Values => BASE64_URL_VALUES'Access);
   end Create_URL_Decoder;

end Util.Encoders.Base64;

Change the Transformer interface to accept in out parameter for the Transformer


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

with Ada.Calendar.Conversions;
with Interfaces.C;

with Util.Encoders;
with Util.Strings;
with Util.Serialize.IO;
with Util.Properties.JSON;
with Util.Log.Loggers;
package body Security.OAuth.JWT is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Security.OAuth.JWT");

   function Get_Time (From : in Util.Properties.Manager;
                      Name : in String) return Ada.Calendar.Time;

   --  Decode the part using base64url and parse the JSON content into the property manager.
   procedure Decode_Part (Into : in out Util.Properties.Manager;
                          Name : in String;
                          Data : in String);

   function Get_Time (From : in Util.Properties.Manager;
                      Name : in String) return Ada.Calendar.Time is
      Value : constant String := From.Get (Name);
   begin
      return Ada.Calendar.Conversions.To_Ada_Time (Interfaces.C.long'Value (Value));
   end Get_Time;

   --  ------------------------------
   --  Get the issuer claim from the token (the "iss" claim).
   --  ------------------------------
   function Get_Issuer (From : in Token) return String is
   begin
      return From.Claims.Get ("iss");
   end Get_Issuer;

   --  ------------------------------
   --  Get the subject claim from the token (the "sub" claim).
   --  ------------------------------
   function Get_Subject (From : in Token) return String is
   begin
      return From.Claims.Get ("sub");
   end Get_Subject;

   --  ------------------------------
   --  Get the audience claim from the token (the "aud" claim).
   --  ------------------------------
   function Get_Audience (From : in Token) return String is
   begin
      return From.Claims.Get ("aud");
   end Get_Audience;

   --  ------------------------------
   --  Get the expiration claim from the token (the "exp" claim).
   --  ------------------------------
   function Get_Expiration (From : in Token) return Ada.Calendar.Time is
   begin
      return Get_Time (From.Claims, "exp");
   end Get_Expiration;

   --  ------------------------------
   --  Get the not before claim from the token (the "nbf" claim).
   --  ------------------------------
   function Get_Not_Before (From : in Token) return Ada.Calendar.Time is
   begin
      return Get_Time (From.Claims, "nbf");
   end Get_Not_Before;

   --  ------------------------------
   --  Get the issued at claim from the token (the "iat" claim).
   --  ------------------------------
   function Get_Issued_At (From : in Token) return Ada.Calendar.Time is
   begin
      return Get_Time (From.Claims, "iat");
   end Get_Issued_At;

   --  ------------------------------
   --  Get the authentication time claim from the token (the "auth_time" claim).
   --  ------------------------------
   function Get_Authentication_Time (From : in Token) return Ada.Calendar.Time is
   begin
      return Get_Time (From.Claims, "auth_time");
   end Get_Authentication_Time;

   --  ------------------------------
   --  Get the JWT ID claim from the token (the "jti" claim).
   --  ------------------------------
   function Get_JWT_ID (From : in Token) return String is
   begin
      return From.Claims.Get ("jti");
   end Get_JWT_ID;

   --  ------------------------------
   --  Get the authorized clients claim from the token (the "azp" claim).
   --  ------------------------------
   function Get_Authorized_Presenters (From : in Token) return String is
   begin
      return From.Claims.Get ("azp");
   end Get_Authorized_Presenters;

   --  ------------------------------
   --  Get the claim with the given name from the token.
   --  ------------------------------
   function Get_Claim (From    : in Token;
                       Name    : in String;
                       Default : in String := "") return String is
   begin
      return From.Claims.Get (Name, Default);
   end Get_Claim;

   --  ------------------------------
   --  Decode the part using base64url and parse the JSON content into the property manager.
   --  ------------------------------
   procedure Decode_Part (Into : in out Util.Properties.Manager;
                          Name : in String;
                          Data : in String) is
      Decoder : constant Util.Encoders.Encoder := Util.Encoders.Create (Util.Encoders.BASE_64_URL);
      Content : constant String := Decoder.Decode (Data);
   begin
      Log.Debug ("Decoding {0}: {1}", Name, Content);

      Util.Properties.JSON.Parse_JSON (Into, Content);
   end Decode_Part;

   --  ------------------------------
   --  Decode a string representing an encoded JWT token according to the JWT specification:
   --
   --    Section 7.  Rules for Creating and Validating a JWT
   --
   --  The JWT token is composed of 3 parts encoded in Base64url and separated by '.' .
   --  The first part represents the header, the second part the claims and the last part
   --  the signature.  The <tt>Decode</tt> operation splits the parts, decodes them,
   --  parses the JSON content represented by the header and the claims.
   --  The <tt>Decode</tt> operation does not verify the signature (yet!).
   --
   --  Return the decoded token or raise an exception.
   --  ------------------------------
   function Decode (Content : in String) return Token is
      Pos1   : constant Natural := Util.Strings.Index (Content, '.');
      Pos2   : Natural;
      Result : Token;
   begin
      if Pos1 = 0 then
         Log.Error ("Invalid JWT token: missing '.' separator. JWT: {0}", Content);
         raise Invalid_Token with "Missing header separator";
      end if;
      Pos2 := Util.Strings.Index (Content, '.', Pos1 + 1);
      if Pos2 = 0 then
         Log.Error ("Invalid JWT token: missing second '.' separator. JWT: {0}", Content);
         raise Invalid_Token with "Missing signature separator";
      end if;
      Decode_Part (Result.Header, "header", Content (Content'First .. Pos1 - 1));
      Decode_Part (Result.Claims, "claims", Content (Pos1 + 1 .. Pos2 - 1));
      return Result;

   exception
      when Util.Serialize.IO.Parse_Error =>
         raise Invalid_Token with "Invalid JSON content";
   end Decode;

end Security.OAuth.JWT;

-----------------------------------------------------------------------
--  security-oauth-jwt -- OAuth Java Web Token
--  Copyright (C) 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 Ada.Calendar.Conversions;
with Interfaces.C;

with Util.Encoders;
with Util.Strings;
with Util.Serialize.IO;
with Util.Properties.JSON;
with Util.Log.Loggers;
package body Security.OAuth.JWT is

   Log : constant Util.Log.Loggers.Logger := Util.Log.Loggers.Create ("Security.OAuth.JWT");

   function Get_Time (From : in Util.Properties.Manager;
                      Name : in String) return Ada.Calendar.Time;

   --  Decode the part using base64url and parse the JSON content into the property manager.
   procedure Decode_Part (Into : in out Util.Properties.Manager;
                          Name : in String;
                          Data : in String);

   function Get_Time (From : in Util.Properties.Manager;
                      Name : in String) return Ada.Calendar.Time is
      Value : constant String := From.Get (Name);
   begin
      return Ada.Calendar.Conversions.To_Ada_Time (Interfaces.C.long'Value (Value));
   end Get_Time;

   --  ------------------------------
   --  Get the issuer claim from the token (the "iss" claim).
   --  ------------------------------
   function Get_Issuer (From : in Token) return String is
   begin
      return From.Claims.Get ("iss");
   end Get_Issuer;

   --  ------------------------------
   --  Get the subject claim from the token (the "sub" claim).
   --  ------------------------------
   function Get_Subject (From : in Token) return String is
   begin
      return From.Claims.Get ("sub");
   end Get_Subject;

   --  ------------------------------
   --  Get the audience claim from the token (the "aud" claim).
   --  ------------------------------
   function Get_Audience (From : in Token) return String is
   begin
      return From.Claims.Get ("aud");
   end Get_Audience;

   --  ------------------------------
   --  Get the expiration claim from the token (the "exp" claim).
   --  ------------------------------
   function Get_Expiration (From : in Token) return Ada.Calendar.Time is
   begin
      return Get_Time (From.Claims, "exp");
   end Get_Expiration;

   --  ------------------------------
   --  Get the not before claim from the token (the "nbf" claim).
   --  ------------------------------
   function Get_Not_Before (From : in Token) return Ada.Calendar.Time is
   begin
      return Get_Time (From.Claims, "nbf");
   end Get_Not_Before;

   --  ------------------------------
   --  Get the issued at claim from the token (the "iat" claim).
   --  ------------------------------
   function Get_Issued_At (From : in Token) return Ada.Calendar.Time is
   begin
      return Get_Time (From.Claims, "iat");
   end Get_Issued_At;

   --  ------------------------------
   --  Get the authentication time claim from the token (the "auth_time" claim).
   --  ------------------------------
   function Get_Authentication_Time (From : in Token) return Ada.Calendar.Time is
   begin
      return Get_Time (From.Claims, "auth_time");
   end Get_Authentication_Time;

   --  ------------------------------
   --  Get the JWT ID claim from the token (the "jti" claim).
   --  ------------------------------
   function Get_JWT_ID (From : in Token) return String is
   begin
      return From.Claims.Get ("jti");
   end Get_JWT_ID;

   --  ------------------------------
   --  Get the authorized clients claim from the token (the "azp" claim).
   --  ------------------------------
   function Get_Authorized_Presenters (From : in Token) return String is
   begin
      return From.Claims.Get ("azp");
   end Get_Authorized_Presenters;

   --  ------------------------------
   --  Get the claim with the given name from the token.
   --  ------------------------------
   function Get_Claim (From    : in Token;
                       Name    : in String;
                       Default : in String := "") return String is
   begin
      return From.Claims.Get (Name, Default);
   end Get_Claim;

   --  ------------------------------
   --  Decode the part using base64url and parse the JSON content into the property manager.
   --  ------------------------------
   procedure Decode_Part (Into : in out Util.Properties.Manager;
                          Name : in String;
                          Data : in String) is
      Decoder : constant Util.Encoders.Decoder := Util.Encoders.Create (Util.Encoders.BASE_64_URL);
      Content : constant String := Decoder.Decode (Data);
   begin
      Log.Debug ("Decoding {0}: {1}", Name, Content);

      Util.Properties.JSON.Parse_JSON (Into, Content);
   end Decode_Part;

   --  ------------------------------
   --  Decode a string representing an encoded JWT token according to the JWT specification:
   --
   --    Section 7.  Rules for Creating and Validating a JWT
   --
   --  The JWT token is composed of 3 parts encoded in Base64url and separated by '.' .
   --  The first part represents the header, the second part the claims and the last part
   --  the signature.  The <tt>Decode</tt> operation splits the parts, decodes them,
   --  parses the JSON content represented by the header and the claims.
   --  The <tt>Decode</tt> operation does not verify the signature (yet!).
   --
   --  Return the decoded token or raise an exception.
   --  ------------------------------
   function Decode (Content : in String) return Token is
      Pos1   : constant Natural := Util.Strings.Index (Content, '.');
      Pos2   : Natural;
      Result : Token;
   begin
      if Pos1 = 0 then
         Log.Error ("Invalid JWT token: missing '.' separator. JWT: {0}", Content);
         raise Invalid_Token with "Missing header separator";
      end if;
      Pos2 := Util.Strings.Index (Content, '.', Pos1 + 1);
      if Pos2 = 0 then
         Log.Error ("Invalid JWT token: missing second '.' separator. JWT: {0}", Content);
         raise Invalid_Token with "Missing signature separator";
      end if;
      Decode_Part (Result.Header, "header", Content (Content'First .. Pos1 - 1));
      Decode_Part (Result.Claims, "claims", Content (Pos1 + 1 .. Pos2 - 1));
      return Result;

   exception
      when Util.Serialize.IO.Parse_Error =>
         raise Invalid_Token with "Invalid JSON content";
   end Decode;

end Security.OAuth.JWT;

Use the new Decoder implementation

Use the new Decoder implementation


with
     ada.Characters.latin_1,
     ada.Characters.handling,
     ada.Strings.fixed,
     ada.Strings.Maps;

package body lace.text.Cursor
is
   use ada.Strings;

   Integer_Numerals : constant maps.character_Set := maps.to_Set ("+-0123456789");
   Float_Numerals   : constant maps.character_Set := maps.to_Set ("+-0123456789.");

   --------
   -- Forge
   --

   function First (of_Text : access constant Text.item) return Cursor.item
   is
      the_Cursor : constant Cursor.item := (of_Text.all'unchecked_Access, 1);
   begin
      return the_Cursor;
   end First;

   -------------
   -- Attributes
   --

   function at_End (Self : in Item) return Boolean
   is
   begin
      return Self.Current = 0;
   end at_End;

   function has_Element (Self : in Item) return Boolean
   is
   begin
      return not at_End (Self)
        and      Self.Current <= Self.Target.Length;
   end has_Element;

   procedure advance (Self : in out Item;   Delimiter      : in String  := " ";
                                            Repeat         : in Natural := 0;
                                            skip_Delimiter : in Boolean := True;
                                            Case_sensitive : in Boolean := True)
   is
   begin
      for Count in 1 .. Repeat + 1
      loop
         declare
            use ada.Characters.handling;
            delimiter_Position : Natural;
         begin
            if Case_sensitive
            then
               delimiter_Position := fixed.Index (Self.Target.Data (1 .. Self.Target.Length),
                                                  Delimiter,
                                                  From => Self.Current);
            else
               delimiter_Position := fixed.Index (to_Lower (Self.Target.Data (1 .. Self.Target.Length)),
                                                  to_Lower (Delimiter),
                                                  From => Self.Current);
            end if;

            if delimiter_Position = 0
            then
               Self.Current := 0;
               return;
            else
               if skip_Delimiter
               then
                  Self.Current := delimiter_Position + Delimiter'Length;

               elsif Count = Repeat + 1
               then
                  Self.Current := delimiter_Position - 1;

               else
                  Self.Current := delimiter_Position + Delimiter'Length - 1;
               end if;
            end if;
         end;
      end loop;

   exception
      when constraint_Error =>
         raise at_end_Error;
   end advance;

   procedure skip_White (Self : in out Item)
   is
   begin
      while      has_Element (Self)
        and then (    Self.Target.Data (Self.Current) = ' '
                  or  Self.Target.Data (Self.Current) = ada.Characters.Latin_1.CR
                  or  Self.Target.Data (Self.Current) = ada.Characters.Latin_1.LF
                  or  Self.Target.Data (Self.Current) = ada.Characters.Latin_1.HT)
      loop
         Self.Current := Self.Current + 1;
      end loop;
   end skip_White;

   procedure skip_Line (Self : in out Item)
   is
      Line : String := next_Line (Self) with Unreferenced;
   begin
      null;
   end skip_Line;

   function next_Token (Self      : in out Item;
                        Delimiter : in     Character := ' ';
                        Trim      : in     Boolean   := False) return String
   is
   begin
      return next_Token (Self, "" & Delimiter, Trim);
   end next_Token;

   function  next_Token  (Self : in out item;   Delimiter : in String;
                                                Trim      : in Boolean := False) return String
   is
   begin
      if at_End (Self)
      then
         raise at_end_Error;
      end if;

      declare
         use ada.Strings.fixed;
         delimiter_Position : constant Natural := Index (Self.Target.Data, Delimiter, from => Self.Current);
      begin
         if delimiter_Position = 0
         then
            return the_Token : constant String := (if Trim then fixed.Trim (Self.Target.Data (Self.Current .. Self.Target.Length), Both)
                                                           else             Self.Target.Data (Self.Current .. Self.Target.Length))
            do
               Self.Current := 0;
            end return;
         end if;

         return the_Token : constant String := (if Trim then fixed.Trim (Self.Target.Data (Self.Current .. delimiter_Position - 1), Both)
                                                        else             Self.Target.Data (Self.Current .. delimiter_Position - 1))
         do
            Self.Current := delimiter_Position + Delimiter'Length;
         end return;
      end;
   end next_Token;

   function next_Line (Self : in out item;   Trim : in Boolean := False) return String
   is
      use ada.Characters;
   begin
      return next_Token (Self, Delimiter => latin_1.LF,
                               Trim      => Trim);
   end next_Line;

   procedure skip_Token (Self : in out Item;   Delimiter : in String := " ")
   is
      ignored_Token : String := Self.next_Token (Delimiter);
   begin
      null;
   end skip_Token;

   function get_Integer (Self : in out Item) return Integer
   is
      use ada.Strings.fixed;

      Text  : String (1 .. Self.Length);
      First : Positive;
      Last  : Natural;
   begin
      Text := Self.Target.Data (Self.Current .. Self.Target.Length);
      find_Token (Text, integer_Numerals, Inside, First, Last);

      if Last = 0 then
         raise No_Data_Error;
      end if;

      Self.Current := Self.Current + Last;

      return Integer'Value (Text (First .. Last));
   end get_Integer;

   function get_Integer (Self : in out Item) return long_Integer
   is
      use ada.Strings.fixed;

      Text  : String (1 .. Self.Length);
      First : Positive;
      Last  : Natural;
   begin
      Text := Self.Target.Data (Self.Current .. Self.Target.Length);
      find_Token (Text, integer_Numerals, Inside, First, Last);

      if Last = 0 then
         raise No_Data_Error;
      end if;

      Self.Current := Self.Current + Last;

      return long_Integer'Value (Text (First .. Last));
   end get_Integer;

   function get_Real (Self : in out Item) return long_Float
   is
      use ada.Strings.fixed;

      Text  : String (1 .. Self.Length);
      First : Positive;
      Last  : Natural;
   begin
      Text := Self.Target.Data (Self.Current .. Self.Target.Length);
      find_Token (Text, float_Numerals, Inside, First, Last);

      if Last = 0 then
         raise No_Data_Error;
      end if;

      Self.Current := Self.Current + Last;

      return long_Float'Value (Text (First .. Last));
   end get_Real;

   function Length (Self : in Item) return Natural
   is
   begin
      return Self.Target.Length - Self.Current + 1;
   end Length;

   function peek (Self : in Item;   Length : in Natural := Remaining) return String
   is
      Last : constant Natural := (if Length = Natural'Last then Self.Target.Length
                                                           else Self.Current + Length - 1);
   begin
      if at_End (Self)
      then
         return "";
      end if;

      return Self.Target.Data (Self.Current .. Last);
   end peek;

   function peek_Line (Self : in Item) return String
   is
      C : Cursor.item := Self;
   begin
      return next_Line (C);
   end peek_Line;

end lace.text.Cursor;

with
     ada.Characters.latin_1,
     ada.Characters.handling,
     ada.Strings.fixed,
     ada.Strings.Maps;

package body lace.text.Cursor
is
   use ada.Strings;

   Integer_Numerals : constant maps.character_Set := maps.to_Set ("+-0123456789");
   Float_Numerals   : constant maps.character_Set := maps.to_Set ("+-0123456789.");

   --------
   -- Forge
   --

   function First (of_Text : access constant Text.item) return Cursor.item
   is
      the_Cursor : constant Cursor.item := (of_Text.all'unchecked_Access, 1);
   begin
      return the_Cursor;
   end First;

   -------------
   -- Attributes
   --

   function at_End (Self : in Item) return Boolean
   is
   begin
      return Self.Current = 0;
   end at_End;

   function has_Element (Self : in Item) return Boolean
   is
   begin
      return not at_End (Self)
        and      Self.Current <= Self.Target.Length;
   end has_Element;

   procedure advance (Self : in out Item;   Delimiter      : in String  := " ";
                                            Repeat         : in Natural := 0;
                                            skip_Delimiter : in Boolean := True;
                                            Case_sensitive : in Boolean := True)
   is
   begin
      for Count in 1 .. Repeat + 1
      loop
         declare
            use ada.Characters.handling;
            delimiter_Position : Natural;
         begin
            if Case_sensitive
            then
               delimiter_Position := fixed.Index (Self.Target.Data (1 .. Self.Target.Length),
                                                  Delimiter,
                                                  From => Self.Current);
            else
               delimiter_Position := fixed.Index (to_Lower (Self.Target.Data (1 .. Self.Target.Length)),
                                                  to_Lower (Delimiter),
                                                  From => Self.Current);
            end if;

            if delimiter_Position = 0
            then
               Self.Current := 0;
               return;
            else
               if skip_Delimiter
               then
                  Self.Current := delimiter_Position + Delimiter'Length;

               elsif Count = Repeat + 1
               then
                  Self.Current := delimiter_Position - 1;

               else
                  Self.Current := delimiter_Position + Delimiter'Length - 1;
               end if;
            end if;
         end;
      end loop;

   exception
      when constraint_Error =>
         raise at_end_Error;
   end advance;

   procedure skip_White (Self : in out Item)
   is
   begin
      while      has_Element (Self)
        and then (    Self.Target.Data (Self.Current) = ' '
                  or  Self.Target.Data (Self.Current) = ada.Characters.Latin_1.CR
                  or  Self.Target.Data (Self.Current) = ada.Characters.Latin_1.LF
                  or  Self.Target.Data (Self.Current) = ada.Characters.Latin_1.HT)
      loop
         Self.Current := Self.Current + 1;
      end loop;
   end skip_White;

   procedure skip_Line (Self : in out Item)
   is
      Line : String := next_Line (Self) with Unreferenced;
   begin
      null;
   end skip_Line;

   function next_Token (Self      : in out Item;
                        Delimiter : in     Character := ' ';
                        Trim      : in     Boolean   := False) return String
   is
   begin
      return next_Token (Self, "" & Delimiter, Trim);
   end next_Token;

   function  next_Token  (Self : in out item;   Delimiter : in String;
                                                Trim      : in Boolean := False) return String
   is
   begin
      if at_End (Self)
      then
         raise at_end_Error;
      end if;

      declare
         use ada.Strings.fixed;
         delimiter_Position : constant Natural := Index (Self.Target.Data, Delimiter, from => Self.Current);
      begin
         if delimiter_Position = 0
         then
            return the_Token : constant String := (if Trim then fixed.Trim (Self.Target.Data (Self.Current .. Self.Target.Length), Both)
                                                           else             Self.Target.Data (Self.Current .. Self.Target.Length))
            do
               Self.Current := 0;
            end return;
         end if;

         return the_Token : constant String := (if Trim then fixed.Trim (Self.Target.Data (Self.Current .. delimiter_Position - 1), Both)
                                                        else             Self.Target.Data (Self.Current .. delimiter_Position - 1))
         do
            Self.Current := delimiter_Position + Delimiter'Length;
         end return;
      end;
   end next_Token;

   function next_Line (Self : in out item;   Trim : in Boolean := False) return String
   is
      use ada.Characters;
      Token : constant String := next_Token (Self, Delimiter => latin_1.LF,
                                                   Trim      => Trim);
   begin
      if Token (Token'Last) = latin_1.CR
      then
         return Token (Token'First .. Token'Last - 1);
      else
         return Token;
      end if;
   end next_Line;

   procedure skip_Token (Self : in out Item;   Delimiter : in String := " ")
   is
      ignored_Token : String := Self.next_Token (Delimiter);
   begin
      null;
   end skip_Token;

   function get_Integer (Self : in out Item) return Integer
   is
      use ada.Strings.fixed;

      Text  : String (1 .. Self.Length);
      First : Positive;
      Last  : Natural;
   begin
      Text := Self.Target.Data (Self.Current .. Self.Target.Length);
      find_Token (Text, integer_Numerals, Inside, First, Last);

      if Last = 0 then
         raise No_Data_Error;
      end if;

      Self.Current := Self.Current + Last;

      return Integer'Value (Text (First .. Last));
   end get_Integer;

   function get_Integer (Self : in out Item) return long_Integer
   is
      use ada.Strings.fixed;

      Text  : String (1 .. Self.Length);
      First : Positive;
      Last  : Natural;
   begin
      Text := Self.Target.Data (Self.Current .. Self.Target.Length);
      find_Token (Text, integer_Numerals, Inside, First, Last);

      if Last = 0 then
         raise No_Data_Error;
      end if;

      Self.Current := Self.Current + Last;

      return long_Integer'Value (Text (First .. Last));
   end get_Integer;

   function get_Real (Self : in out Item) return long_Float
   is
      use ada.Strings.fixed;

      Text  : String (1 .. Self.Length);
      First : Positive;
      Last  : Natural;
   begin
      Text := Self.Target.Data (Self.Current .. Self.Target.Length);
      find_Token (Text, float_Numerals, Inside, First, Last);

      if Last = 0 then
         raise No_Data_Error;
      end if;

      Self.Current := Self.Current + Last;

      return long_Float'Value (Text (First .. Last));
   end get_Real;

   function Length (Self : in Item) return Natural
   is
   begin
      return Self.Target.Length - Self.Current + 1;
   end Length;

   function peek (Self : in Item;   Length : in Natural := Remaining) return String
   is
      Last : constant Natural := (if Length = Natural'Last then Self.Target.Length
                                                           else Self.Current + Length - 1);
   begin
      if at_End (Self)
      then
         return "";
      end if;

      return Self.Target.Data (Self.Current .. Last);
   end peek;

   function peek_Line (Self : in Item) return String
   is
      C : Cursor.item := Self;
   begin
      return next_Line (C);
   end peek_Line;

end lace.text.Cursor;

Handle 'CR/LF' end of lines.

lace.text.cursor: Handle 'CR/LF' end of lines.


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

with GNAT.Command_Line;

with Readline;

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

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

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

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

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

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

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

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

   --  ------------------------------
   --  Iterate over the list of connected processes and execute the <tt>Process</tt> procedure.
   --  ------------------------------
   procedure Iterator (Target  : in Target_Type;
                       Process : access procedure (Proc : in Target_Process_Type'Class)) is
      Iter : Process_Cursor := Target.Processes.First;
   begin
      while Process_Maps.Has_Element (Iter) loop
         Process (Process_Maps.Element (Iter).all);
         Process_Maps.Next (Iter);
      end loop;
   end Iterator;

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

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

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

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

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

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

            when '*' =>
               exit;

            when others =>
               Usage;

         end case;
      end loop;

   exception
      when Usage_Error =>
         raise;

      when others =>
         Usage;

   end Initialize_Options;

   --  ------------------------------
   --  Enter in the interactive loop reading the commands from the standard input
   --  and executing the commands.
   --  ------------------------------
   procedure Interactive (Target : in out MAT.Targets.Target_Type) is
   begin
      loop
         declare
            Line : constant String := Readline.Get_Line ("matp>");
         begin
            MAT.Commands.Execute (Target, Line);

         exception
            when MAT.Commands.Stop_Interp =>
               exit;
         end;
      end loop;
   end Interactive;

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

   --  ------------------------------
   --  Stop the server thread.
   --  ------------------------------
   procedure Stop (Target : in out Target_Type) is
   begin
      Target.Server.Stop;
   end Stop;

end MAT.Targets;

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

with GNAT.Command_Line;

with Readline;

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

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

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

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

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

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

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

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

   --  ------------------------------
   --  Iterate over the list of connected processes and execute the <tt>Process</tt> procedure.
   --  ------------------------------
   procedure Iterator (Target  : in Target_Type;
                       Process : access procedure (Proc : in Target_Process_Type'Class)) is
      Iter : Process_Cursor := Target.Processes.First;
   begin
      while Process_Maps.Has_Element (Iter) loop
         Process (Process_Maps.Element (Iter).all);
         Process_Maps.Next (Iter);
      end loop;
   end Iterator;

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

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

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

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

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

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

            when '*' =>
               exit;

            when others =>
               Usage;

         end case;
      end loop;

   exception
      when Usage_Error =>
         raise;

      when others =>
         Usage;

   end Initialize_Options;

   --  ------------------------------
   --  Enter in the interactive loop reading the commands from the standard input
   --  and executing the commands.
   --  ------------------------------
   procedure Interactive (Target : in out MAT.Targets.Target_Type) is
   begin
      loop
         declare
            Line : constant String := Readline.Get_Line ("matp>");
         begin
            MAT.Commands.Execute (Target, Line);

         exception
            when MAT.Commands.Stop_Interp =>
               exit;
         end;
      end loop;
   end Interactive;

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

   --  ------------------------------
   --  Stop the server thread.
   --  ------------------------------
   procedure Stop (Target : in out Target_Type) is
   begin
      Target.Server.Stop;
   end Stop;

end MAT.Targets;

Update the call to Start socket listener


------------------------------------------------------------------------------
-- EMAIL: <darkestkhan@gmail.com>                                           --
-- License: ISC License (see COPYING file)                                  --
--                                                                          --
--                        Copyright © 2015 darkestkhan                      --
------------------------------------------------------------------------------
-- Permission to use, copy, modify, and/or distribute this software for any --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- The software is provided "as is" and the author disclaims all warranties --
-- with regard to this software including all implied warranties of         --
-- merchantability and fitness. In no event shall the author be liable for  --
-- any special, direct, indirect, or consequential damages or any damages   --
-- whatsoever resulting from loss of use, data or profits, whether in an    --
-- action of contract, negligence or other tortious action, arising out of  --
-- or in connection with the use or performance of this software.           --
------------------------------------------------------------------------------
with Ada.Containers.Indefinite_Vectors;

  ------------------------------------------------------------------------------
  -- Small and simple callback based library for processing program arguments --
  ------------------------------------------------------------------------------

  ---------------------------------------------------------------------------
  --                            U  S  A  G  E                              --
  ---------------------------------------------------------------------------
  -- First register all callbacks you are interested in, then call
  -- Process_Arguments.
  --
  -- NOTE: "=" sign can't be part of argument name for registered callback.
  --
  -- Only one callback can be registered per argument, otherwise
  -- Constraint_Error is propagated.
  ---------------------------------------------------------------------------

  ---------------------------------------------------------------------------
  -- Leading single hyphen and double hyphen are stripped (if present) when
  -- processing arguments that are placed before first "--" argument,
  -- so ie. "--help", "-help" and "help" are functionally
  -- equivalent, treated as if "help" was actually passed in all 3 cases.
  -- (you should register callback just for "help", if you register it for
  -- "--help" then actually passed argument would have to be "----help" in order
  -- for it to trigger said callback)
  --
  -- In addition if you registered callback as case insensitive, then
  -- (using above example) "Help", "HELP", "help" and "HeLp" all would result in
  -- call to said callback.
  --
  -- If Argument_Type is Variable then callback will receive part of argument
  -- that is after "=" sign. (ie. "OS=Linux" argument would result in callback
  -- receiving only "Linux" as its argument).
  --
  -- For Variable, case insensitive callbacks simple rule applies:
  -- only variable name is case insensitive, with actual value (when passed to
  -- program) being unchanged.
  --
  -- All arguments with no associated callback are added to Unknown_Arguments
  --  vector as long as they appear before first "--" argument.
  --
  -- All arguments after first "--" (standalone double hyphen) are added to
  --  Input_Argument vector (this includes another "--"), w/o any kind of
  --  hyphen stripping being performed on them.
  --
  -- NOTE: No care is taken to ensure that all Input_Arguments
  --  (or Unknown_Arguments) are unique.
  ---------------------------------------------------------------------------

package CBAP is

  ---------------------------------------------------------------------------
  -- Yes, I do realize this is actually vector...
  package Argument_Lists is new
    Ada.Containers.Indefinite_Vectors (Positive, String);

  -- List of all arguments for which callbacks where not registered.
  Unknown_Arguments : Argument_Lists.Vector := Argument_Lists.Empty_Vector;
  -- List of all arguments after first "--" argument.
  Input_Arguments   : Argument_Lists.Vector := Argument_Lists.Empty_Vector;

  -- Argument_Types decides if argument is just a simple value, or a variable
  -- with value assigned to it (difference between "--val" and "--var=val")
  type Argument_Types is (Value, Variable);

  -- Argument is useful mostly for Variable type of arguments.
  type Callbacks is not null access procedure (Argument: in String);

  ---------------------------------------------------------------------------
  -- Register callbacks for processing arguments.
  -- @Callback      : Action to be performed in case appropriate argument is
  --    detected.
  -- @Called_On     : Argument for which callback is to be performed.
  -- @Argument_Type : {Value, Variable}. Value is simple argument that needs no
  --    additional parsing. Variable is argument of "Arg_Name=Some_Val" form.
  --    When callback is triggered, Value is passed to callback as input, in
  --    case of Variable it is content of argument after first "=" that is
  --    passed to callback.
  -- @Case_Sensitive: Whether or not case is significant. When False all forms
  --    of argument are treated as if written in lower case.
  procedure Register
    ( Callback      : in Callbacks;
      Called_On     : in String;
      Argument_Type : in Argument_Types := Value;
      Case_Sensitive: in Boolean        := True
    );

  -- Raised if Called_On contains "=".
  Incorrect_Called_On: exception;

  ---------------------------------------------------------------------------
  -- Parse arguments supplied to program, calling callbacks when argument with
  -- associated callback is detected.
  -- NOTE: Process_Arguments will call callbacks however many times argument
  --  with associated callback is called. So if you have callback for "help",
  --  then ./program help help help
  --  will result in 3 calls to said callback.
  procedure Process_Arguments;

  ---------------------------------------------------------------------------

end CBAP;

------------------------------------------------------------------------------
-- EMAIL: <darkestkhan@gmail.com>                                           --
-- License: ISC License (see COPYING file)                                  --
--                                                                          --
--                        Copyright © 2015 darkestkhan                      --
------------------------------------------------------------------------------
-- Permission to use, copy, modify, and/or distribute this software for any --
-- purpose with or without fee is hereby granted, provided that the above   --
-- copyright notice and this permission notice appear in all copies.        --
--                                                                          --
-- The software is provided "as is" and the author disclaims all warranties --
-- with regard to this software including all implied warranties of         --
-- merchantability and fitness. In no event shall the author be liable for  --
-- any special, direct, indirect, or consequential damages or any damages   --
-- whatsoever resulting from loss of use, data or profits, whether in an    --
-- action of contract, negligence or other tortious action, arising out of  --
-- or in connection with the use or performance of this software.           --
------------------------------------------------------------------------------
with Ada.Containers.Indefinite_Vectors;

  ------------------------------------------------------------------------------
  -- Small and simple callback based library for processing program arguments --
  ------------------------------------------------------------------------------

  ---------------------------------------------------------------------------
  --                            U  S  A  G  E                              --
  ---------------------------------------------------------------------------
  -- First register all callbacks you are interested in, then call
  -- Process_Arguments.
  --
  -- NOTE: "=" sign can't be part of argument name for registered callback.
  --
  -- Only one callback can be registered per argument, otherwise
  -- Constraint_Error is propagated.
  ---------------------------------------------------------------------------

  ---------------------------------------------------------------------------
  -- Leading single hyphen and double hyphen are stripped (if present) when
  -- processing arguments that are placed before first "--" argument,
  -- so ie. "--help", "-help" and "help" are functionally
  -- equivalent, treated as if "help" was actually passed in all 3 cases.
  -- (you should register callback just for "help", if you register it for
  -- "--help" then actually passed argument would have to be "----help" in order
  -- for it to trigger said callback)
  --
  -- In addition if you registered callback as case insensitive, then
  -- (using above example) "Help", "HELP", "help" and "HeLp" all would result in
  -- call to said callback.
  --
  -- If Argument_Type is Variable then callback will receive part of argument
  -- that is after "=" sign. (ie. "OS=Linux" argument would result in callback
  -- receiving only "Linux" as its argument).
  --
  -- For Variable, case insensitive callbacks simple rule applies:
  -- only variable name is case insensitive, with actual value (when passed to
  -- program) being unchanged.
  --
  -- All arguments with no associated callback are added to Unknown_Arguments
  --  vector as long as they appear before first "--" argument.
  --
  -- All arguments after first "--" (standalone double hyphen) are added to
  --  Input_Argument vector (this includes another "--"), w/o any kind of
  --  hyphen stripping being performed on them.
  --
  -- NOTE: No care is taken to ensure that all Input_Arguments
  --  (or Unknown_Arguments) are unique.
  ---------------------------------------------------------------------------

package CBAP is

  ---------------------------------------------------------------------------
  -- Yes, I do realize this is actually vector...
  package Argument_Lists is new
    Ada.Containers.Indefinite_Vectors (Positive, String);

  -- List of all arguments (before first "--" argument) for which callbacks
  --  where not registered.
  Unknown_Arguments : Argument_Lists.Vector := Argument_Lists.Empty_Vector;
  -- List of all arguments after first "--" argument.
  Input_Arguments   : Argument_Lists.Vector := Argument_Lists.Empty_Vector;

  -- Argument_Types decides if argument is just a simple value, or a variable
  -- with value assigned to it (difference between "--val" and "--var=val")
  type Argument_Types is (Value, Variable);

  -- Argument is useful mostly for Variable type of arguments.
  type Callbacks is not null access procedure (Argument: in String);

  ---------------------------------------------------------------------------
  -- Register callbacks for processing arguments.
  -- @Callback      : Action to be performed in case appropriate argument is
  --    detected.
  -- @Called_On     : Argument for which callback is to be performed.
  -- @Argument_Type : {Value, Variable}. Value is simple argument that needs no
  --    additional parsing. Variable is argument of "Arg_Name=Some_Val" form.
  --    When callback is triggered, Value is passed to callback as input, in
  --    case of Variable it is content of argument after first "=" that is
  --    passed to callback.
  -- @Case_Sensitive: Whether or not case is significant. When False all forms
  --    of argument are treated as if written in lower case.
  procedure Register
    ( Callback      : in Callbacks;
      Called_On     : in String;
      Argument_Type : in Argument_Types := Value;
      Case_Sensitive: in Boolean        := True
    );

  -- Raised if Called_On contains "=".
  Incorrect_Called_On: exception;

  ---------------------------------------------------------------------------
  -- Parse arguments supplied to program, calling callbacks when argument with
  -- associated callback is detected.
  -- NOTE: Process_Arguments will call callbacks however many times argument
  --  with associated callback is called. So if you have callback for "help",
  --  then ./program help help help
  --  will result in 3 calls to said callback.
  procedure Process_Arguments;

  ---------------------------------------------------------------------------

end CBAP;

Update comment.

Update comment.

Signed-off-by: darkestkhan <e9a7a7cf2a6af79e93742343a7a5cac5d90f9bd2@gmail.com>