File : adagio-g2-packet-parsing.adb


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

--                         ADAGIO - ADALID - AENEA.                         --

--                                                                          --

--                            Copyright (C) 2003                            --

--                                 A. Mosteo.                               --

--                                                                          --

--  Authors: A. Mosteo. (adagio@mosteo.com)                                 --

--                                                                          --

--  If you have any questions in regard to this software, please address    --

--  them to the above email.                                                --

--                                                                          --

--  This program is free software; you can redistribute it and/or modify    --

--  it under the terms of the GNU General Public License as published by    --

--  the Free Software Foundation; either version 2 of the License, or (at   --

--  your option) any later version.                                         --

--                                                                          --

--  This program is distributed in the hope that it will be useful, but     --

--  WITHOUT ANY WARRANTY; without even the implied warranty of              --

--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU       --

--  General Public License for more details.                                --

--                                                                          --

--  You should have received a copy of the GNU General Public License       --

--  along with this library; if not, write to the Free Software Foundation, --

--  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.          --

--                                                                          --

--  You are not allowed to use any part of this code to develop a program   --

--  whose output would be used to harass or prosecute other users of the    --

--  networks Adagio connects with. All data collected with Adagio or a tool --

--  containing Adagio code about other network users must remain            --

--  confidential and cannot be made public by any mean, nor be used to      --

--  harass or legally prosecute these users.                                --

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

--  $Id: adagio-g2-packet-parsing.adb,v 1.6 2004/02/24 15:26:10 Jano Exp $


with Adagio.Memory_stream_unconstrained;
with Adagio.Misc;
with Adagio.Network.Endian;

with Ada.Unchecked_conversion;

with Interfaces;                 use Interfaces;

package body Adagio.G2.Packet.Parsing is

   use type Adagio.Streams.Element_array_access;

   function To_control_byte is new
      Unchecked_conversion(Unsigned_8, Control_byte_type);
   function From_control_byte is new
      Unchecked_conversion(Control_byte_type, Unsigned_8);

   -- Returns a newly allocated G2 packet from a stream.

   -- Pre: The stream holds enough ready data for the packet or

   --    it will try to block.

   -- Pre: The control byte and len have been read from the stream and

   --    the stream position is in the name field.

   function From_stream (
      Control_byte : in Control_byte_type;
      Length       : in Natural;
      Stream       : access Ada.Streams.Root_stream_type'Class)
      return Packet.Object is

      P : Packet.Object;
      C : Child_access;
      Dummy : Natural;
      
   begin
      From_stream (Control_byte, Length, Stream, C, Dummy);
      if C = null then
         return Null_packet;
      else
         Safe_child.Bind (P, C);
         return P;
      end if;
   end;

   -- Entirely from stream:

   function From_stream (
      Stream       : access Ada.Streams.Root_stream_type'Class)
      return Packet.Object is
      P : Packet.Object;
      C : Child_access;
      Dummy : Natural;
   begin
      From_stream (Stream, C, Dummy);
      Safe_child.Bind (P, C);
      return P;
   end From_stream;

   -- Returns a newly allocated G2 packet from a stream element array.

   function From_element_array (Data : in Ada.Streams.Stream_element_array) 
      return Packet.Object is
      M : aliased Memory_stream_unconstrained.Stream_type (
         Data'Unrestricted_access);
      P : Packet.Object;
      C : Child_access;
      Dummy : Natural;
   begin
      From_stream (M'Access, C, Dummy);
      Safe_child.Bind (P, C);
      return P;
   end From_element_array;

   -- Returns a newly allocated G2 packet from a stream.

   -- Pre: The stream holds enough ready data for the packet or

   --    it will try to block.

   -- Pre: The control byte and len have been read from the stream and

   --    the stream position is in the name field.

   procedure From_stream (
      Control_byte : in Control_byte_type;
      Length       : in Natural;
      Stream       : access Ada.Streams.Root_stream_type'Class;
      Child        : out Packet.Child_access;
      Read         : out Natural)
   is
      
      P            : Packet.Child_access:= new Packet.Child;
      P_child      : Packet.Child_access;
      Children_size: Natural := 0;
      Child_size   : Natural;

   begin

      Read := 0;

--      Trace.Log (" ------> ");


      -- Read the control byte:

      P.Control_byte := Control_byte;

      -- Read length:

      P.Len := Length;

--      Trace.Log ("Len_len:" & P.Control_byte.Len_len'Img);

--      Trace.Log ("Name_len:" & P.Control_byte.Name_len'Img);

--      Trace.Log ("Len:" & P.Len'Img);


      -- Read name:

      declare
         Name : String (1 .. P.Control_byte.Name_len + 1);
      begin
         String'Read (Stream, Name);
         P.Type_name := B (Name);
         Read        := Read + Name'Length;
--         Trace.Log ("Name: " & Name);

      end;

      -- TRICK ONLY FOR BUG IN SHAREAZA 1.8.11.2

      if true and then S (P.Type_name) = "CH" and then P.Len = 10 and then 
         P.Control_byte.Compound_flag 
      then
         P.Control_byte.Compound_flag := false;
      end if;
      ------------------------------------------


      -- Has children?

      if P.Control_byte.Compound_flag and then P.Len > 0 then
         loop
            -- New child

            From_stream (Stream, P_child, Child_size);
            -- Is end?

            if P_child /= null then
               Children_size := Children_size + Child_size;
               -- Check ending without 0 byte:

               if Children_size = P.Len then
                  Add_child (P, P_child);
                  exit;
               elsif Children_size > P.Len then
                  Trace.Log("G2.Packet.Parsing.From_stream (1): " & 
                     "Children too large.", Trace.Warning);
                  raise Constraint_error;
               else
                  Add_child (P, P_child);
               end if;
            else
               -- Regular exit because of null byte.

               -- We must count it!

               Children_size := Children_size + 1; 
               exit;
            end if;
         end loop;
      end if;

      -- Has payload?

      if Children_size < P.Len then
         declare 
            Payload : String (1 .. P.Len - Children_size);
         begin
            String'Read (Stream, Payload);
            P.Payload := U (Payload);
            Read      := Read + Payload'Length;
         end;
      end if;

--      Trace.Log (" <------ ");


      Read  := Read + Children_size;
      Child := P;

   exception
      when E: others =>
         Trace.Log("G2.Packet.Parsing.From_stream (1): " & Trace.Report(E),
            Trace.Error);

         -- No leaks:

         if P_child /= null then
            Trace.Log ("Child: " & S (P_child.Type_Name) &
            "; Big endian: " & P_child.Control_byte.Big_endian'Img &
            "; Len: " & P_child.Len'Img &
            "; LenLen: " & P_child.Control_byte.Len_Len'Img &
            "; CF: " & P_child.Control_byte.Compound_flag'Img &
            "; NameLen: " & P_child.Control_byte.Name_Len'Img, Trace.Error);
            Free (P_child);
         end if;
         if P /= null then
            Trace.Log ("Packet: " & S (P.Type_Name) &
            "; Big endian: " & P.Control_byte.Big_endian'Img &
            "; Len: " & P.Len'Img &
            "; LenLen: " & P.Control_byte.Len_Len'Img &
            "; CF: " & P.Control_byte.Compound_flag'Img &
            "; NameLen: " & P.Control_byte.Name_Len'Img, Trace.Error);
            Free (P);
         end if;

         Child := null;
         raise;
   end From_stream;

   -- Returns a G2 packet.

   -- It is read fully from the beggining of the stream, assuming there is

   -- enough data in it.

   -- Control byte is also taken from the string; Length as well.

   procedure From_stream (
      Stream       : access Ada.Streams.Root_stream_type'Class;
      Child        : out Packet.Child_access;
      Read         : out Natural)
   is

      Byte         : Unsigned_8;
      Control_byte : Control_byte_type;
      Child_size   : Natural;
      
   begin

      Read := 0;

      -- Read the control byte:

      Unsigned_8'Read(Stream, Byte);
      Read := Read + 1;


      -- If its null, return null packet (no more children)

      if Byte = 0 then
         Child := null;
         return;
      else
         Control_byte := To_control_byte (Byte);
      end if;

      -- Read length:

      declare
         Len : Network.Endian.Byte_array (1 .. Control_byte.Len_len);
      begin
         Network.Endian.Byte_array'Read (Stream, Len);
         Read := Read + Len'Length;

         -- Read remainder from stream:

         From_stream (
            Control_byte, 
            Network.Endian.Convert (Len, Control_byte.Big_endian), 
            Stream, 
            Child,
            Child_size);
         Read := Read + Child_size;
         return;
      end;

   exception
      when E: others =>
         Trace.Log("G2.Packet.Parsing.From_stream (2): " & Trace.Report(E),
            Trace.Error);

         raise;
         Child := null;
   end From_stream;

   -- Draws a tree of the packet:

   procedure Trace_tree (
      this : in Packet.Object; 
      Level  : in Trace.Warning_Level := Trace.Debug;
      Indent : in Natural := 0) is
   begin
      Trace_tree (Safe_child.Value (this), Level, Indent);
   end Trace_tree;

   -- Draws a tree of the packet:

   procedure Trace_tree (
      this : in Packet.Child_access; 
      Level  : in Trace.Warning_Level := Trace.Debug;
      Indent : in Natural := 0) is

      Line : String (1 .. Indent) := (others => '-');

   begin
      Trace.Log (Line & S (this.Type_name) & 
         " (Payload length:" & Natural'Image (ASU.Length (This.Payload)) &
         ") " & Misc.To_hex (S (This.Payload)), Level);
      for n in 1 .. Children_vector.Length (this.Children) loop
         Trace_tree (this.Children.Vector (n), Level, Indent + 2);
      end loop;
   end Trace_tree;

   -- Initialize:

   procedure Create (
      This         : out Object;
      Link         : in  Adagio.Streams.Stream_access;
      Available    : in  Available_function) is
   begin
      this.Link         := Link;
      this.Pipe_status  := Ready;
      this.Packet_len   := 0;
      this.Available    := Available;
   end Create;

   -- Call this function each time a packet is to be checked

   -- Will return Null_packet until a packet is fully acquired:

   procedure Check (
      this              : in out Object;
      Aggresive         : in Boolean := true;
      Result            : out Packet.Object) is

      Available : Natural;
   begin
      -- A priori:

      Result := Null_packet;

      case this.Pipe_status is 

         when Ready =>
            -- Read control byte:

            if This.Available (this.Link) > 0 then
               G2.Packet.Control_byte_type'Read (
                  this.Link, this.Control_byte);
               -- There is length ?

               if this.Control_byte.Len_len = 0 then
                  this.Pipe_status   := Length_done;
                  this.Packet_len := 0;
               else
                  this.Pipe_status   := Control_done;
               end if;

               -- Debug append

               Asu.Append (
                  This.Debug_curr_packet, Character'Val (
                     From_control_byte (this.Control_byte)));

               -- Try length / body:

               if Aggresive then
                  Check (this, Result => Result);
               end if;
            end if;

         when Control_done =>
            -- Read length

            if This.Available (this.Link) >= 
               this.Control_byte.Len_len 
            then
               declare
                  Len : Network.Endian.Byte_array 
                    (1 .. this.Control_byte.Len_len);
               begin
                  Network.Endian.Byte_array'Read (this.Link, Len);
                  this.Packet_len := Network.Endian.Convert 
                    (Len, this.Control_byte.Big_endian);

                  -- Debug append

                  for N in Len'Range loop
                     Asu.Append (This.Debug_curr_packet, Character'Val (Len (N)));
                  end loop;

                  if this.Packet_len <= Max_packet_size then
                     this.Pipe_status := Length_done;
                  elsif this.Packet_len >= Max_admisible_size then
                     raise Max_admisible_size_error;
                  else
                     this.Pipe_status := Skipping;
                     -- Adjust size to skip:

                     This.Packet_len:= 
                        This.Packet_len + This.Control_byte.Name_len + 1;
                     Trace.Log ("G2.Packet.Parsing.Check: Starting to drop packet " &
                        " too large (" & Misc.To_string (This.Packet_len) &
                        ")", Trace.Warning);
                  end if;
               end;
               -- Try full packet:

               if Aggresive then
                  Check (this, Result => Result);
               end if;
            end if;

         when Length_done =>
            -- Read a full packet:

            if This.Available (this.Link) >= 
               this.Packet_len + this.Control_byte.Name_len + 1 then
               -- Parse a packet!

               Result := G2.Packet.Parsing.From_stream (
                  this.Control_byte, this.Packet_len, this.Link);
               this.Pipe_status := Ready;
               This.Debug_prev_packet := This.Debug_curr_packet;
               This.Debug_curr_packet := Null_ustring;
            end if;

         when Skipping =>
            -- Skip packet length:

            Available := 
               Natural'Min (This.Packet_len, 
                  Natural'Min (This.Available (This.Link), 1024));
            if Available > 0 then
               declare
                  Buff : Ada.Streams.Stream_element_array (
                     1 .. Ada.Streams.Stream_element_offset (Available));
                  Last : Ada.Streams.Stream_element_offset;
               begin
                  Ada.Streams.Read (This.Link.all, Buff, Last);
                  if Natural (Last) /= Available then 
                     raise Constraint_error;
                  end if;
                  This.Packet_len := This.Packet_len - Available;
                  if This.Packet_len = 0 then
                     This.Pipe_status := Ready;
                     This.Debug_prev_packet := This.Debug_curr_packet;
                     This.Debug_curr_packet := Null_ustring;
                  end if;
               end;
            end if;
      end case;
   end Check;

end Adagio.G2.Packet.Parsing;