File : adagio-g2-core-process_packet.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-core-process_packet.adb,v 1.8 2004/02/24 15:26:10 Jano Exp $


separate (Adagio.G2.Core)
procedure Process_packet (
   Net    : in Network_access; 
   Source : in Server_access;
   Item   : in Packet.Queue.Item_type) is
   
   P     : G2.Packet.Object renames Item.Packet;
   Serv  : Server_access;

   use type G2.Search.Object_Access;
   use type Packet.Object;
   use type Packet.Queue.Source_type;
   use type Xml.Node;

   package Conv renames Adagio.Network.Endian;

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

   -- Broadcast_packet                                                   --

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

   -- Echoes a packet to all connected servers except supplied one:

   -- R = In_response_to

   procedure Broadcast_packet (
      P      : in Packet.Object; 
      R      : in Packet.Object := Packet.Null_packet;
      Server : in Server_access := null) is

      Serv : Server_access;
   begin
      Net.Servers.Get_first (Serv);
      while Serv /= Null loop
         if Serv /= Server and then Net.Servers.Status (Serv) = Connected then
            Send (Serv, P, R);
         end if;
         Net.Servers.Get_next (Serv);
      end loop;
   end Broadcast_packet;

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

   -- Process_PI_UDP                                                     --

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

   procedure Process_PI_UDP is
      Server : Server_access;
      C      : Packet.Object := Packet.Create ("RELAY");
   begin
      Packet.Add_child (P, C);
      Net.Servers.Get_first (Server);
      while Server /= null loop
         if Id (Server.all) /= Item.Tcp_Id and then
            Net.Servers.Status (Server) = Connected
         then
            declare
               I : Packet.Queue.Item_type;
            begin
               Packet.Queue.Send (
                  Net.Outbound,
                  P,
                  Socket.To_address (Id (Server.all)),
                  Safe => true,
                  In_response_to => I.Packet);
            end;
         end if;
         Net.Servers.Get_next (Server);
      end loop;
   end Process_PI_UDP;

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

   -- Process_KHL                                                        --

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

   procedure Process_KHL is
      Hubs  : Packet.Object_array := Packet.Get_children (Item.Packet, "CH");
      Hubs2 : Packet.Object_array := Packet.Get_children (Item.Packet, "NH");
      Discarded   : Natural := 0;
      Remote_time : Time_t.Time_t;
      Has_times   : Boolean;
      use type Time_t.Time_t;
   begin
      if Packet.Is_a (Item.Packet, "/KHL/TS") then
         Has_times := true;
         Remote_time := To_time_t (Packet.Payload (Packet.Get_child ( 
               Item.Packet, "TS")), Packet.Big_endian (
                  Packet.Get_child (Item.Packet, "TS")));
      end if;
      for N in Hubs2'Range loop
         declare
            Address : String := Packet.Payload (Hubs2 (N));
            Sock    : Socket.Sock_addr_type;
            Server  : Server_access;
         begin
            if Address'Length /= 10 and then Address'Length /= 6 then
               raise Unimplemented; -- Not an IPv4 address

            end if;
            Sock := To_address (
               Address (Address'First .. Address'First + 5), 
               Packet.Big_endian (Item.Packet));

            Server := new Server_type;
            Server.Score := 250.0; -- Below GWebCached2 ones but above CH

            Create (Server.all, Net, Socket.Image (Sock.Addr), 
               Natural (Sock.Port));
            if Reachable (Server.all) then
               Adagio.Server.List.Add (Adagio.Server.Object_access (Server));
            else
               Adagio.Server.Free (Adagio.Server.Object_access (Server));
               Discarded := Discarded + 1;
            end if;
         exception
            when Adagio.Server.Server_already_cached =>
               Discarded := Discarded + 1;
            when E : others =>
               Trace.Log ("G2.Core.Process_packet.Process_KHL/NH: " &
                  Trace.Report (E), Trace.Warning);
         end;
      end loop;
      for N in Hubs'Range loop
         declare
            Address : String := Packet.Payload (Hubs (N));
            Sock    : Socket.Sock_addr_type;
            Server  : Server_access;
            Seen    : Time_t.Time_t := To_time_t (
               Address (Address'Last - 3 .. Address'Last),
                     Packet.Big_endian (Item.Packet));
            Seen2   : Calendar.Time;
         begin
            if Address'Length /= 10 and then Address'Length /= 6 then
               exit;
               raise Unimplemented; -- Not an IPv4 address

            end if;
            Sock := To_address (
               Address (Address'First .. Address'First + 5), 
               Packet.Big_endian (Item.Packet));
            if Has_times then
               Seen2 := 
                  Calendar.Clock - Time_t.To_duration (Remote_time - Seen);
            else
               Seen2 := Calendar.Clock;
            end if;

            Server := new Server_type;
            Server.Score := 200.0; -- Below GWebCached2 ones and NH ones

            Create (Server.all, Net, Socket.Image (Sock.Addr), 
               Natural (Sock.Port), Seen2);
            if Reachable (Server.all) then
               Adagio.Server.List.Add (Adagio.Server.Object_access (Server));
            else
               Adagio.Server.Free (Adagio.Server.Object_access (Server));
               Discarded := Discarded + 1;
            end if;
         exception
            when Adagio.Server.Server_already_cached =>
               Discarded := Discarded + 1;
            when E : others =>
               Trace.Log ("G2.Core.Process_packet.Process_KHL/CH: " &
                  Trace.Report (E), Trace.Warning);
         end;
      end loop;
      Trace.Log ("G2.Core.Process_packet.Process_KHL: Added" & 
         Natural'Image (Hubs'Length + Hubs2'Length - Discarded) & 
         " servers from KHL.");
      Trace.Log ("G2.Core.Process_packet.Process_KHL: Discarded" & 
         Natural'Image (Discarded) & " servers from KHL.");
   end Process_KHL;

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

   -- Process_Q2                                                         --

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

   procedure Process_Q2 is
      Neighbours : Ustring_array := Net.Servers.Address_list;
      Last : Natural := Neighbours'Last;
      Tcp_queue : Packet.Queue.Object_access;
   begin
      if Item.Source = Packet.Queue.Listener_UDP then
         Trace.Log ("G2.Core.Process_packet: Query received via UDP", 
            Trace.Warning);
         return; -- Only hubs should receive that.

      end if;

      if Source /= null then
         Tcp_queue := Source.Slot.Outbound'Access;
      end if;

      -- Check against our databases:

      -- DN queries:

      if Packet.Is_a (Item.Packet, "/Q2/DN") then
         G2.Local_query.DN (
            Unicode.G2_to_string (Packet.Payload (Packet.Get_child (
               Item.Packet, "DN")), Packet.Big_endian (Item.Packet)),
            Item,
            Net.Outbound'Access, 
            Tcp_queue,
            Net.Port,
            Neighbours (1 .. Last));
      end if;
      -- URN queries:

      if Packet.Is_a (Item.Packet, "/Q2/URN") then
         G2.Local_query.URN (
            Item, 
            Net.Outbound'Access,
            Tcp_queue,
            Net.Port,
            Neighbours (1 .. Last));
      end if;
      -- MD queries:

      if Packet.Is_a (Item.Packet, "/Q2/MD") then
         G2.Local_query.MD (
            Item, 
            Net.Outbound'Access,
            Tcp_queue,
            Net.Port,
            Neighbours (1 .. Last));
      end if;
   exception
      when Unicode.Invalid_encoding =>
         Trace.Log ("G2.Process_packet (Q2): Received query with unsupported"&
            " language.");
   end Process_Q2;

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

   -- Process_PUSH                                                       --

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

   procedure Process_PUSH is
      Addr : Socket.Sock_addr_type;
   begin
      Addr := To_address (
         Packet.Payload (Item.Packet), Packet.Big_endian (Item.Packet));
      Upload.Queue.Manager.Object.Enqueue (
         G2.Upload_client.Create_pushed (Addr));
   end Process_PUSH;
begin
   -----------

   -- /?/TO --

   -----------

   if Packet.Get_child (P, "TO") /= Packet.Null_packet and then
      Guid.To_char_array (Guid.My_guid) /= 
         Packet.Payload (Packet.Get_child (P, "TO")) then
      Trace.Log ("G2.Core.Process_packet: /?/TO received for " &
         Packet.Payload (Packet.Get_child (P, "TO")));
      -- Shouldn't get these being a leaf!

      raise Unimplemented;
   -- /PI --

   ---------

   elsif Packet.Is_a (P, "/PI") then
      declare
         Po : G2.Packet.Object;
      begin
         Po := G2.Packet.Create ("PO");

         if Item.Source = Packet.Queue.Server then
            Send (Source, Po, Item.Packet);
         else
            Packet.Queue.Send (
               Net.Outbound, 
               Po, 
               Item.Udp_source,
               Safe => true,
               In_response_to => Item.Packet);
         end if;
      end;
      -------------

      -- /PI/UDP --

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

      if Packet.Is_a (P, "/PI/UDP") and not Packet.Is_a (P, "/PI/RELAY") then
         Process_PI_UDP;
      elsif Packet.Is_a (P, "/PI/UDP") and Packet.Is_a (P, "/PI/RELAY") then
         -- Should not receive relays being a leaf node!

         -- Trace.Log ("Process_Packet: /PI/RELAY received while being leaf.", Trace.Warning);

         null;
      elsif not Packet.Is_a (P, "/PI/UDP") then
         null; -- regular PI

      else -- other combinations not valid:

         Trace.Log ("G2.Core.Process_packet: Invalid packet received:", 
            Trace.Informative);
         Trace.Log (Packet.To_hex (P));
         Packet.Parsing.Trace_tree (P);
      end if;
   ---------

   -- /PO --

   ---------

   elsif Packet.Is_a (P, "/PO") then
      case Item.Source is
         when Packet.Queue.Server =>
            null;
         when others =>
            null;
      end case;
   ----------

   -- /LNI --

   ----------

   elsif Packet.Is_a (P, "/LNI") then
      -- Get statistics of server:

      if Packet.Is_a (P, "/LNI/HS") then
         if Item.Source = Packet.Queue.Server then
            Net.Servers.Get (S (Item.Tcp_Id), Connected, Serv);
            if Serv /= null then
               declare
                  Data : String := Packet.Payload (
                     Packet.Get_child (P, "HS"));
               begin
                  -- Update statistics

                  Serv.Num_leaves := Conv.Convert (
                     Conv.To_byte_array (Data (Data'First .. Data'First + 1)),
                     Packet.Big_endian (P));
                  Serv.Max_leaves := Conv.Convert (
                     Conv.To_byte_array (
                        Data (Data'First + 2 .. Data'First + 3)),
                     Packet.Big_endian (P));
               end;
            end if;
         end if;
      end if;
   ------------

   -- /UPROC --

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

   elsif Packet.Is_a (P, "/UPROC") then
      declare
         I     : Packet.Queue.Item_type := Item;
      begin
         I.Packet          := Core.Create_UPROD;
         I.In_response_to  := Item.Packet;
         I.Udp_destination := Item.Udp_source;
         Send (Source, I.Packet, Item.Packet);
      end;
   ------------

   -- /UPROD --

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

   elsif Packet.Is_a (P, "/UPROD") then
      -- Parse profile

      if Packet.Is_a (P, "/UPROD/XML") then
         Net.Servers.Get (Item.Tcp_Id, Connected, Serv);
         if Serv /= null then
            declare
               Data : String := Unicode.G2_to_String (
                  Packet.Payload (Packet.Get_child (Item.Packet, "XML")),
                  Packet.Big_endian (Item.Packet));
               Doc  : Xml.Document := Xml.From_string (Data);
            begin
               if Serv.User_profile /= null then
                  Xml.Delete (Serv.User_profile);
               end if;
               Serv.User_profile := Doc;
            end;
         end if;
      end if;
   ---------

   -- /Q2 --

   ---------

   elsif Packet.Is_a (P, "/Q2") then
--      Trace.Log ("Query received:");

--      Packet.Parsing.Trace_tree (P);

      Process_Q2;
   -------------

   -- /HAW    --

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

   elsif Packet.Is_a (P, "/HAW") then
      null;
   -------------

   -- /KHL    --

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

   elsif Packet.Is_a (P, "/KHL") then
      Process_KHL;
   -------------

   -- /PUSH   --

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

   elsif Packet.Is_a (P, "/PUSH") then
      Process_PUSH;
   --------------------

   -- SEARCH RELATED --

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

   elsif Packet.Is_a (P, "/QKA") or else
         Packet.Is_a (P, "/QA") or else
         Packet.Is_a (P, "/QH2")
   then
      if Net.Searcher /= null then
         G2.Search.Process_Search_Packet (Net.Searcher, Item);
      end if;
   ------------------

   -- DISCARDABLES --

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

   elsif Packet.Is_a (P, "/Q1") or else
         Packet.Is_a (P, "/QKR")
   then
      null;
   -------------

   -- UNKNOWN --

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

   else
      Trace.Log ("Discarded unknown packet: " & G2.Packet.To_hex (P), 
         Trace.Informative);
      Packet.Parsing.Trace_tree (P);
   end if;
exception
   when E: others =>
      Trace.Log ("G2.Core.Process_packet: " & Trace.Report (E), Trace.Error);
      Trace.Log ("G2.Core.Process_packet: " & Packet.To_hex (Item.Packet), 
         Trace.Error);
end Process_packet;