File : adagio-g2-core.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.adb,v 1.26 2004/03/29 19:13:30 Jano Exp $


with Adagio.Chronos;
with Adagio.Debug;
with Adagio.G2.Bandwidth;
with Adagio.G2.Local_query;
with Adagio.G2.Mesh;
with Adagio.G2.Packet.Parsing;
with Adagio.G2.Packet.Queue;
with Adagio.G2.Upload_client;
with Adagio.GUID;
with Adagio.Globals;
with Adagio.Globals.Options;
with Adagio.GWCache2;
with Adagio.Library;
with Adagio.Mmap.Strings;
with Adagio.Misc;
with Adagio.Network.Endian;
with Adagio.Network_settings;
use  Adagio.Network_settings;
with Adagio.Routing;
with Adagio.Socket;
with Adagio.Socket.IP;
with Adagio.Statistics;
with Adagio.Statistics.Booleans;
with Adagio.Statistics.Durations;
with Adagio.Statistics.Integers;
with Adagio.Streams_alias;
with Adagio.Time_t;
with Adagio.Trace;
with Adagio.Traffic;
with Adagio.Unicode;
with Adagio.Upload.Queue.Manager;
with Adagio.Zutil;

with Agpl.Geoip;

with Strings.Fields;
with Zlib;
with Zlib.Streams.Extra;

with Ada.Characters.Handling;
with Ada.Streams;                use Ada.Streams;
use Ada;

with Text_io;

package body Adagio.G2.Core is

   Stat_longest : constant String := "Servers - G2 - Longest connection";
   Stat_servers : constant String := "Servers - G2 - New servers";

   use type Calendar.Time;

   package ACH renames Ada.Characters.Handling;

   -- Auxiliaries for average uptime queue:

   function Average (Left : in Duration; Right : in Integer) return float is
   begin
      if Right = 0 then 
         return 0.0;
      else
         return float (Left) / float (Right);
      end if;
   end Average;

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

   -- Network stuff --

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


   -- Gives the network identifier

   function Id (this: in Network_type) return String is
      pragma Unreferenced (This);
   begin
      return Network_id;
   end Id;

   -- Connect to that network. Will get servers and connect them as needed.

   procedure Connect(this: in out Network_type) is
   begin
      -- Local port

      this.Port:= Globals.Options.G2_port;
      this.Status:= Network.Connecting;

      -- Restore mesh:

      if Use_mesh then
         G2.Mesh.Object.Restore (
            Globals.Data_Folder & "mesh." & G2.Mesh.Object.Id.all & ".dat");
         G2.Mesh.Object.Configure (
            Globals.Options.library_mesh_sources,
            Globals.Options.library_mesh_TTL);
      end if;

      -- Create connector:

      this.Connector:= new Connector_type;
      this.Connector.Start(this'Unrestricted_access);

      -- Create polling task:

      this.Polling:= new Polling_type;
      this.Polling.Start (this'Unrestricted_access);

      -- Listener

      G2.Listener.Start(this.Listener, this.Port);

      -- Transceiver

      this.Transceiver := new G2.Transceiver.Object;
      G2.Transceiver.Set_BW_limits (
         This.Transceiver.all,
         BW_in  => Globals.Options.G2_UdpBandwidthIn,
         BW_out => Globals.Options.G2_UdpBandwidthOut);
      G2.Transceiver.Start (
         this.Transceiver.all, 
         G2.Listener.Get_udp (this.Listener),
         this.Inbound'Unrestricted_access);

      -- Sender

      this.Send_udp := new Sender_udp;
      this.Send_udp.Start (this'Unrestricted_access);

      -- Searcher

      if Globals.Options.Download_Active then
         This.Searcher := new G2.Search.Object;
         G2.Search.Start (
            This.Searcher, 
            This.Outbound'Unchecked_Access,
            This.Transceiver);
      end if;

   end Connect;

   -- Disconnect:

   procedure Disconnect(this: in out Network_type) is
      use type G2.Search.Object_Access;
   begin
      -- Transceiver out:

      G2.Transceiver.Shutdown (this.Transceiver.all);

      -- Listener shutdown:

      G2.Listener.Shutdown(this.Listener);
      
      -- Ensure all tasks termination:

      this.Servers.Disconnect_all;

      -- Save mesh:

      if Use_mesh then
         G2.Mesh.Object.Save (
            Globals.Data_Folder & "mesh." & G2.Mesh.Object.Id.all & ".dat");
      end if;

      -- Stop searcher:

      if This.Searcher /= null then
         G2.Search.Shutdown (This.Searcher.all);
      end if;

      this.Status:= Network.Disconnected;
   end Disconnect;

   -- Says status of the network.

   function Status(this: in Network_type) return Network.Network_status is
   begin
      return this.Status;
   end Status;

   -- Obtain search handler. Can return null if the network is not to be

   -- searched:

   function Get_Search_Handler (This : in Network_Type) 
      return Searches.Handler.Object_Access 
   is
   begin
      return Searches.Handler.Object_Access (This.Searcher);
   end Get_Search_Handler;

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

   -- Server stuff --

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


   -- Get a unique id to identify it:

   function Id(this: in Server_type) return String is
      P: constant String:= Natural'Image(this.Port);
   begin
      return To_string(this.Address) & ":" & P(P'first + 1 .. P'last);
   end Id;

   -- Get description

   function Describe (this: in Server_type) return String is
      function QRT_status return String is
      begin
         if This.QRT_status = Sending then
            return Misc.To_lower (QRT_Status_type'Image (This.QRT_status)) &
               " (" & Misc.To_string (This.QRT_packets_sent) & "/" &
               Misc.To_string (This.QRT_packets + 1) & ")";
         else
            return Misc.To_lower (QRT_Status_type'Image (This.QRT_status));
         end if;
      end;
      UA : Ustring;
   begin
      if This.Slot /= null then
         UA := This.Slot.User_agent;
      else
         UA := U ("unknown agent");
      end if;
      if UA = U ("") then
         UA := U ("unknown agent");
      end if;
      return Id (this) & "; Nick: " & 
         Xml.Get_attribute ("identity/handle", "primary", 
         this.User_profile, "Anonymous") & " (" 
         & S (UA) & "); Load:" &
         this.Num_leaves'Img & "/" & Misc.To_string (this.Max_leaves) & 
         "; QRT: " & QRT_status & 
         "; Rating: " & Misc.To_string (Rate (This), 2);
   end Describe;

   -- Get network it belongs:

   function Net(this: in Server_type) return String is
      pragma Unreferenced (This);
   begin
      return Network_id;
   end Net;

   -- Evaluate its goodness to be connected:

   function Rate(this: in Server_type) return Server.Rating is
   begin
      return This.Score;
   end Rate;

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

   -- Add_score                                                          --

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

   -- Adds score to a server ensuring no overflow

   procedure Add_score (This : in out Server_type; Score : in Server.Rating)
   is
   begin
      This.Score := This.Score + Score;
   exception
      when Constraint_error =>
         This.Score := Server.Rating'Last;
   end Add_score;

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

   -- Add_hub                                                            --

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

   -- Creates a hub and adds it to the cache, if possible

   procedure Add_hub (
      Address : in String; Port : in Natural; Score : in Float := 1000000.0)
   is
      Serv : Server_access := new Server_type;
   begin
      Create (Serv.all, The_network, Address, Port);
      Serv.Score := Score;
      Server.List.Add (Server.Object_access (Serv));
   exception
      when Server.Server_already_cached =>
         null;
   end Add_hub;

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

   -- Parse_ultrapeers                                                  --

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

   -- Parse from a standard X-Try-Ultrapeers and add to server cache

   procedure Parse_ultrapeers (Net : in Network_access; S : in String) is
      use Strings.Fields;
      Discarded  : Natural := 0;
   begin
      if S'Length < 1 then 
         return;
      end if;
      if S (S'Last) = ',' then
         Parse_ultrapeers (Net, S (S'First .. S'Last - 1));
         return;
      end if;
      for N in 1 .. Count_Fields (S, ',') loop
         declare
            Ultrapeer  : String := Select_field (S, N, ',');
            New_server : Server_access;
         begin
            New_server := new Server_type;
            Create (
               New_server.all, 
               Net,
               Select_field (Ultrapeer, 1, ':'),
               Natural'Value (
                  Select_field (Select_field (Ultrapeer, 2, ':'), 1, ' ')));
            begin
               if Reachable (New_server.all) then
                  Server.List.Add (Server.Object_access (New_server));
               else
                  Server.Free (Server.Object_access (New_server));
                  Discarded := Discarded + 1;
               end if;
            exception
               when others =>
                  Discarded := Discarded + 1;
            end;
         end;
      end loop;
      if Count_fields (S, ',') > 0 then
         Trace.Log ("Added" & 
            Natural'Image (Count_Fields (S, ',') - Discarded)
            & " servers from X-Try-Ultrapeers header.");
         Trace.Log ("Discarded" & Discarded'Img 
            & " servers from X-Try-Ultrapeers header.");
      end if;
   exception
      when E : others =>
         Trace.Log ("G2.Core.Parse_ultrapeers: " & Trace.Report (E), 
            Trace.Error);
   end Parse_ultrapeers;

   procedure Fail (this : in out Server_type) is
   begin
      this.Failures := this.Failures + 1;
      this.Score    := this.Score / 2.0;
   end Fail;

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

   -- Prepare_connect --

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

   -- Prepare everything for a new server connection attempt:

   procedure Prepare_connect (This : in out Server_type) is
   begin
      -- Clean queue:

      This.Slot.Outbound.Clear;

      -- QRT

      This.QRT_timestamp := Past_aeons;
      This.Checked_QRP   := Past_aeons;
      This.QRT_reset     := false;
      This.QRT_status    := Not_sent;

      -- Deflate:

      This.Slot.Deflate  := false;
      This.Slot.ZCreated := false;
      Circular_stream.Reset (This.Slot.CStream_in);
      Circular_stream.Reset (This.Slot.CStream_out);
      This.Slot.OBuffer_used := false;
      Chronos.Reset (This.Slot.ZCron);
      This.Slot.ZFlushed := true;
   end Prepare_connect;

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

   -- Connect                       --

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

   -- Establish a connection:

   procedure Connect(this: in out Server_type) is
      use type Socket.Error_type;
   begin
      if not Reachable (This) then
         Fail (This);
         Disconnect (This);
         Trace.Log ("G2.Core.Connect: Discarding unreachable server: " &
            Id (This));
         return;
      end if;

      case This.Connection_stage is
         -- STARTING --

         when Starting =>
            This.Last_try_connect := Calendar.Clock;
            This.Connection_stage := Connecting;
            Trace.Log ("G2.Server.Connect: connecting to " & Id(this) & 
               " (rating: " & Misc.To_string (Float (Rate (this))) & ")...");

            -- Initialization of vars:

            this.QRT_reset  := false;
            this.QRT_status := Not_sent;

            -- Socket things:

            this.Network.Servers.Set_status (
               this'Unrestricted_access, Connecting);
            -- Socket startup:

            Socket.Create_stream (This.Slot.Socket);
            Socket.Set_blocking_io (This.Slot.Socket, false); -- From now on.

            begin
               -- Do it!

               Socket.Connect(
                  This.Slot.Socket, To_string(this.Address), this.Port);
                    -- Should have been raised Operation_would_block!

                    raise Constraint_error;
            exception
               when E : Socket.Socket_error =>
                  if Socket.Get_error (E) = Socket.Operation_would_block then
                     -- Normal connection in progress...

                     This.Connection_stage := Connecting;
                  else
                     Fail (this);
                     Clear (this);
                     this.Network.Servers.Set_status 
                       (this'Unrestricted_access, Disconnected);
                     raise;
                  end if;
               when Socket.Security_ban =>
                  Fail (this);
                  Clear (this);
                  this.Network.Servers.Set_status 
                    (this'Unrestricted_access, Disconnected);
                  Trace.Log ("Connection with " & Id (This) & " failed " &
                     "[security ban]", Trace.Informative);
               when E : others => 
                  Fail (this);
                  Clear (this);
                  this.Network.Servers.Set_status 
                    (this'Unrestricted_access, Disconnected);
                  Trace.Log ("Connection with " & Id (This) & " failed: " &
                     Trace.Report (E), Trace.Error);
            end;
         -- CONNECTING --

         when Connecting =>
            if Calendar.Clock - This.Connection_start >
               Globals.Options.G2_ConnectTimeout
            then
               Fail (this);
               Clear (this);
               this.Network.Servers.Set_status 
                 (this'Unrestricted_access, Disconnected);
               Trace.Log ("Connection with " & Id (This) & 
                  " failed [timeout].");
               return;
            end if;        
            -- success

            if Socket.Is_writable (This.Slot.Socket) then
               -- Step to handshaking:

               This.Handshake_start  := Calendar.Clock;
               This.Connection_stage := Handshake_preparing;
               this.Network.Servers.Set_status 
                 (this'Unrestricted_access, Handshaking);
               Trace.Log ("Connection with " & Id (This) & " started.");
            -- Failure

            elsif (not Socket.Is_alive (This.Slot.Socket)) or else
               Socket.Connection_failed (This.Slot.Socket) 
            then
               Fail (this);
               Clear (this);
               this.Network.Servers.Set_status 
                 (this'Unrestricted_access, Disconnected); 
               Trace.Log ("Connection with " & Id (This) & 
                  " failed [refused].");
               return;
            end if;
         when others =>
            raise Constraint_error;
      end case;
   end Connect;

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

   -- Handshake                     --

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

    -- Do the handshaking:

   procedure Handshake(this: in out Server_type) is
      Ask: String:= S (Globals.Options.G2_HandshakeAsk);
      Ack: String:= S (Globals.Options.G2_HandshakeAnswer);
      Head : Http.Header.Set renames This.Slot.Head;
      procedure Drop(Reason: String) is
      begin
         String'Write(this.Slot.Stream, Ack & " 500 " & Reason & 
            Http.CRLF & Http.CRLF);
         Disconnect(this);
      end Drop;
      use type Socket.Error_type;
   begin
      if Calendar.Clock - This.Handshake_start >
         Globals.Options.G2_HandshakeTimeout then
         Fail (This);
         Disconnect (This);
         return;
      end if;  
      if not Socket.Is_alive (This.Slot.Socket) then
         Fail (This);
         Disconnect (This);
         return;
      end if;
      case This.Connection_stage is
         -- PREPARING --

         when Handshake_preparing =>
            this.Last_seen := Calendar.Clock;
            this.Network.Servers.Set_status (
               this'Unrestricted_access, Handshaking);
            this.Slot.Stream := 
               Tcp_slot.Stream_access (Socket.Stream (this.Slot.Socket));
            -- Prepare headers:

            Http.Header.Clear (Head);
            case Socket.IP.Kind(To_string(this.Address)) is
               when Socket.IP.Local =>
                  Http.Header.Add(Head, "Listen-IP", 
                     "127.0.0.1:" & Misc.To_string(this.Local_port));
               when Socket.IP.Internal =>
                  Http.Header.Add(Head, "Listen-IP", 
                     Socket.IP.Get_IP(false) & ":" & 
                     Misc.To_string(this.Local_port));
               when Socket.IP.Public =>
                  Http.Header.Add(Head, "Listen-IP", 
                     Socket.IP.Get_IP(Internet_route = Direct) & ":" & 
                     Misc.To_string(this.Local_port));
            end case;
            Http.Header.Add (Head, "Remote-IP", To_string(this.Address));
            Http.Header.Add (Head, "User-Agent", User_agent);
            Http.Header.Add (Head, "Accept", Content_type);
            Http.Header.Add (Head, "X-Ultrapeer", "False");
            Http.Header.Add (Head, "X-Ultrapeer-Needed", "True");
            if Globals.Options.G2_CompressedLink then
               Http.Header.Add (Head, "Accept-Encoding", "deflate");
            end if;
            Http.Header.Set_response (Head, Ask);
            This.Connection_stage := Handshake_sending_first;
         -- SENDING FIRST --

         when Handshake_sending_first =>
            if Socket.Is_writable (This.Slot.Socket) then
               begin
                  Http.Header.Write (Head, this.Slot.Stream.all, true, true);
                  Trace.Log("G2.Handshaking (1): Sent: " & 
                     Http.Header.Write(Head), File => To_string(Logfile));
                  This.Connection_stage := Handshake_receiving;
                  Http.Header.Parser.Reset (This.Slot.Http_parser);
               exception
                  when E : Socket.Socket_error =>
                     if Socket.Get_error (E) /= 
                        Socket.Operation_would_block 
                     then
                        raise;
                     end if;
               end;
            end if;
         -- RECEIVING --

         when Handshake_receiving =>
            -- Read data

            if not Http.Header.Parser.Completed (This.Slot.Http_parser) then
               Http.Header.Parser.Check (
                  This.Slot.Http_parser, This.Slot.Socket);
            end if;

            -- Check for completion

            if Http.Header.Parser.Completed (This.Slot.Http_parser) then
               Http.Header.Parser.Get_headers (This.Slot.Http_parser, Head);
               Trace.Log("G2.Handshaking (2): Read: " & 
                  Http.Header.Write(Head), File => To_string(Logfile));
            else 
               return;  --<---------------------- EARLY EXIT POINT!

            end if;

            -- Parse ultrapeers:

            if ACH.To_lower (Http.Header.Get (Head, "Content-Type")) =
               G2.Content_type 
               or else 
               Misc.Contains (Misc.To_lower(
                  Http.Header.Get (Head, "User-Agent")), "Shareaza")
            then
               Parse_ultrapeers (
                  this.Network, Http.Header.Get (Head, "X-Try-Ultrapeers"));
            end if;

            -- Check for G2:

            if ACH.To_lower (Http.Header.Get (Head, "Content-Type")) /=
               G2.Content_type 
            then
               Trace.Log ("G2.Handshake: Dropping: Content-Type: " &
                  Http.Header.Get (Head, "Content-Type"));
               Fail (this);
               Drop ("Searching for G2 hubs");
               Trace.Log (
                  Http.Header.Write(Head), File => To_string (Logfile));
               return;
            end if;

            -- Check for deflate:

            if ACH.To_lower (Http.Header.Get (Head, "Content-Encoding")) =
               "deflate" and then Globals.Options.G2_CompressedLink
            then
               This.Slot.Deflate := true;
            end if;

            -- If not success, disconnect:

            if Http.Header.Get_response (Head)(14 .. 16) /= "200" then
               Trace.Log("G2.Handshake: Disconnecting from " & Id(this) & 
                  " because: " & Http.Header.Get_response (Head));
               Fail       (this);
               Disconnect (this);
               return;
            end if;

            Trace.Log ("G2.Handshake: " & Http.Header.Get(Head, "Listen-IP") &
               " is a " & Http.Header.Get(Head, "User-Agent"));
            -- Check for ultrapeer:

            if ACH.To_lower (Http.Header.Get(Head, "X-Ultrapeer")) /= "true" 
            then
               Trace.Log ("G2.Handshake: Dropping: X-Ultrapeer: " &
                  Http.Header.Get (Head, "X-Ultrapeer"));
               Fail (this);
               Drop ("Searching for ultrapeers");
               Trace.Log (
                  Http.Header.Write(Head), File => To_string (Logfile));
               return;
            end if;

            -- Keep some data

            This.Slot.User_agent := U (Http.Header.Get (Head, "User-Agent"));

            -- Public visible IP in case of Nat forwarding:

            if Internet_Route = NatForward then
               declare
                  NATF_Address : constant String := Http.Header.Get (Head, "Remote-IP");
               begin
                  if NATF_Address'length > 0 then
                     Network_Settings.Set_NATF_Address (NATF_Address);
                  end if;
               end;
            end if;

            -- Prepare final ack:

            Http.Header.Clear (Head);
            Http.Header.Set_response (Head, ack & " 200 OK");
            Http.Header.Add   (Head, "Accept",       Content_type);
            Http.Header.Add   (Head, "Content-Type", Content_type);
            Http.Header.Add   (Head, "X-Ultrapeer",  "False");
            if This.Slot.Deflate then
               Http.Header.Add (Head, "Content-Encoding", "deflate");
            end if;

            This.Connection_stage := Handshake_sending_last;
         -- SENDING LAST --

         when Handshake_sending_last =>
            if Socket.Is_writable (This.Slot.Socket) then
               begin
                  Http.Header.Write (Head, this.Slot.Stream.all, true, true);
                  -- Beyond this point, we have sucessfully sent the headers

                  Trace.Log("G2.Handshaking (3): Sent: " & 
                     Http.Header.Write(Head), File => To_string(Logfile));
                  Http.Header.Clear (Head);

                  -- My first G2 packet, sparks!

                  this.Failures         := 0;
                  this.Successes        := this.Successes + 1;
                  this.Last_packet_time := Calendar.Clock;
                  this.Last_ping_time   := Calendar.Clock;
                  this.Connection_start := Calendar.Clock;
                  this.Slot.Outbound.Clear;

                  G2.Packet.Parsing.Create (
                     this.Slot.Packet_parser, 
                     this.Slot.CStream_in'Access,
                     Available_cstream'Access);

                  -- Create ZStream:

                  if This.Slot.Deflate then
                     This.Slot.ZCreated := true;
                     Zlib.Streams.Create (
                        This.Slot.ZStream_in,
                        Zlib.Streams.Out_stream,
                        This.Slot.CStream_in'Access,
                        Back_compressed => false);
                     Zlib.Streams.Create (
                        This.Slot.ZStream_out,
                        Zlib.Streams.Out_stream,
                        This.Slot.CStream_out'Access,
                        Back_compressed => true);
                     Trace.Log ("Connection with " & Id (This) & 
                        " is compressed (deflate)");
                  end if;

                  -- Connected!

                  this.Network.Servers.Set_status 
                     (this'Unrestricted_access, Connected);
                  this.Network.Status := Network.Connected;
               exception
                  when E : Socket.Socket_error =>
                     if Socket.Get_error (E) /=
                        Socket.Operation_would_block 
                     then
                        raise;
                     end if;
               end;
            end if;
         when others =>
            Trace.Log ("G2.Server.Handshake: Unexpected stage: " &
               This.Connection_stage'Img, Trace.Error);
            raise Constraint_error;
      end case;
   exception
      when E: others =>
         Trace.Log("G2.Server.Handshake: Failed to " & Id(this) & ": " &
            Trace.Report(E));
         Fail (This);
         Disconnect (This);
   end Handshake;

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

   -- Disconnect                                                        --

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

   procedure Disconnect(this: in out Server_type) is
   begin
      Disconnect2 (This);
   end Disconnect;
   procedure Disconnect2(
      this: in out Server_type; Spare : in Boolean := false) 
   is
      Uptime : Duration := Calendar.Clock - this.Connection_start;
   begin
      This.Network.Servers.Set_status 
         (this'Unrestricted_access, Disconnecting);

      Clear (This);

      if not Spare then
         Average_uptime.Push (this.Uptimes, Uptime);
      end if;
      
      this.Last_try   := this.Last_try_connect;
      
      begin
         Trace.Log ("Disconnected from " & Id (this));
         Trace.Log ("  -- Uptime:" & Misc.Image (Uptime));

         Trace.Log ("  -- Avg up:" & 

            Misc.Image (Duration (Average_uptime.Average (this.Uptimes))));
      exception
         when Average_uptime.No_data =>
            null;
      end;

      This.Network.Servers.Set_status 
         (this'Unrestricted_access, Disconnected);
   exception
      when others =>
         This.Network.Servers.Set_status (
            this'Unrestricted_access, Disconnected);
   end Disconnect2;

   -- Disconnects and lowers rating to 0!

   procedure Disconnect_hub(this: in String) is
      Serv : Server_access;
   begin
      The_network.Servers.Get (This, Connected, Serv);
      if Serv /= null then
         Serv.Score := 1.0;
         Disconnect2 (Serv.all, Spare => true);
      end if;
   end Disconnect_hub;

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

   -- Clear                                                              --

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

   procedure Clear (This : in out Server_type) is
   begin
      Socket.Shutdown (this.Slot.Socket);
      Socket.Close    (this.Slot.Socket);

      if This.Slot.ZCreated then
         begin
            This.Slot.ZCreated := false;
            -- Abort fluxes:

            Zlib.Streams.Extra.Close_abort (This.Slot.ZStream_in);
            Zlib.Streams.Extra.Close_abort (This.Slot.ZStream_out);
         exception
            when E : others =>
               Trace.Log ("G2.Close: " & Trace.Report (E), Trace.Error);
         end;
      end if;

      Circular_stream.Reset (This.Slot.CStream_in);
      Circular_stream.Reset (This.Slot.CStream_out);

      this.Slot.Outbound.Clear;
      this.Slot.User_agent := Null_ustring;

      this.QRT_timestamp := Past_aeons;
      this.Checked_QRP   := Past_aeons;

      this.Connection_stage := Starting;
   end Clear;

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

   -- Dropable                                                           --

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

   -- True when the server is to be purged:

   function Dropable (this : in Server_type) return Boolean is 
   begin
      return 
         (not This.Is_root) and then
         Calendar.Clock - this.Last_seen > 
            Globals.Options.G2_ConfidencePeriod and then
         this.Failures >= Globals.Options.G2_Retries;
   end Dropable;

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

   -- Is_Ready                                                           --

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

   -- True when ready to connect

   function Is_Ready (This : in Server_Type) return Boolean is
   begin
      if this.Failures >= Globals.Options.G2_Retries then
         return false;
      elsif this.Failures > 0 and then
         Calendar.Clock - this.Last_try < Globals.Options.G2_RestPeriod 
      then
         return false;
      else
         return true;
      end if;
   end Is_Ready;

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

   -- Reachable                                                          --

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

   -- Check against connection settings:

   function Reachable (This : in Server_type) return Boolean is
   begin
      return Routing.TCP_Reachable (Id (This));
   end;

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

   -- Equal                                                              --

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

   function Equal (L, R : Server_access) return Boolean is
   begin
      return Id (L.all) = Id (R.all);
   end Equal;

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

   -- Serialize                                                          --

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

   -- Dump:

   procedure Serialize
     (Stream: access Streams.Root_stream_type'Class;
      this: in Server_type) is 
   begin
      String'Output                (Stream, To_string(this.Address));
      Natural'Output               (Stream, this.Port);
      Natural'Output               (Stream, this.Failures);
      Natural'Output               (Stream, this.Successes);
      Average_uptime.Object'Output (Stream, this.Uptimes);
      Server.Rating'Output         (Stream, this.Score);
      Calendar.Time'Output         (Stream, this.Last_seen);
      Calendar.Time'Output         (Stream, this.Last_try);
   end Serialize;

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

   -- Restore                                                            --

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

   -- Recover:

   function Restore
     (Stream: access Streams.Root_stream_type'Class) return Server_type is
      S: Server_type;
   begin
      S.Address     := To_ustring (String'Input    (Stream));
      S.Port        := Natural'Input               (Stream);
      S.Failures    := Natural'Input               (Stream);
      S.Successes   := Natural'Input               (Stream);
      S.Uptimes     := Average_uptime.Object'Input (Stream);
      S.Score       := Server.Rating'Input         (Stream);
      S.Last_seen   := Calendar.Time'Input         (Stream);
      S.Last_try    := Calendar.Time'Input         (Stream);
      return S;
   end Restore;

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

   -- Check_Pipes                                                        --

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

   -- Check for data to read:

   Stat_cron : Chronos.Object;
   procedure Check_pipes(this: in out Server_type) is
      P     : G2.Packet.Object := G2.Packet.Null_packet;
      Item  : G2.Packet.Queue.Item_type;
      Dur   : Duration;
      Max   : Duration;
      Avail : Ada.Streams.Stream_element_count;
      Allow : Natural;
      use type G2.Packet.Object;

      -- Get available bandwidth for reading 

      function Get_bandwidth return Natural is
         Aw, Awx : Natural := 0;
         Needed  : Natural;
      begin
         if This.Slot.Deflate then
            Needed := Natural'Min (
               Socket.Available (This.Slot.Socket),
               Circular_stream.Available_write (This.Slot.CStream_in) / 2 +1);
         else
            Needed := Natural'Min (
               Socket.Available (This.Slot.Socket),
               Circular_stream.Available_write (This.Slot.CStream_in));
         end if;
         Bandwidth.Server_link.Commit (Needed, Aw, Extra => false);
         if Aw < Needed then
            Bandwidth.Server_link.Commit (Needed - Aw, Awx, Extra => true);
         end if;
         return Aw + Awx;
      end Get_bandwidth;

   begin
      loop
         -- Check alive:

         if not Socket.Is_alive (this.Slot.Socket) then
            Trace.Log (
               "G2 server connection lost (" &
               Id (this) & ")", Trace.Informative);
            Disconnect (this);
            exit;
         else
            this.Last_seen := Calendar.Clock;

            if Chronos.Elapsed (Stat_cron) > 0.8 then
               Chronos.Reset (Stat_cron);
               Dur := this.Last_seen - this.Connection_start;
               begin
                  Max := Statistics.Durations.Value (
                     Statistics.Durations.Duration_value (
                        Statistics.Object.Get (Stat_longest)));
               exception
                  when Statistics.Value_not_defined =>
                     Max := 0.0;
               end;
               if Dur > Max then
                  Statistics.Object.Set (Stat_longest,
                     Statistics.Durations.Create (Dur));
               end if;
            end if;
         end if;

         Allow := Get_bandwidth;
         if Allow = 0 then 
            return; -- <-- EARLY EXIT BY BANDWIDTH THROTTLE

         end if; 
         Avail := Stream_element_count (Allow);

         -- Try to pass compressed data to the uncompressed stream:

         if This.Slot.Deflate then
            if Circular_stream.Available_write (This.Slot.CStream_in) < 
               Natural'(Packet.Max_packet_size)
            then
               null; -- Can't read still...

            else
               declare
                  Buff : Ada.Streams.Stream_element_array (1 .. Avail);
                  Last : Ada.Streams.Stream_element_offset;
               begin
                  Ada.Streams.Read (This.Slot.Stream.all, Buff, Last);
                  if Last /= Avail then
                     raise Constraint_error;
                  else
                     -- Decompression to the in stream

                     Zlib.Streams.Write (This.Slot.ZStream_in, Buff);
                  end if;
               end;
            end if;
         else
            -- Pass uncompressed data to the stream

            declare
               Buff : Ada.Streams.Stream_element_array (1 .. Avail);
               Last : Ada.Streams.Stream_element_offset;
            begin
               Ada.Streams.Read (This.Slot.Stream.all, Buff, Last);
               if Last /= Avail then
                  raise Constraint_error;
               else
                  -- Pass to the in stream

                  Circular_stream.Write (This.Slot.CStream_in, Buff);
               end if;
            end;
         end if;
         
         -- Try to acquire packets:

         G2.Packet.Parsing.Check (this.Slot.Packet_parser, Result => P);

         exit when P = G2.Packet.Null_packet;

         this.Last_packet_time := Calendar.Clock;
         this.Last_seen        := Calendar.Clock;

         -- Stat received packets

         G2.Packets_received := Natural'Min (
            G2.Packets_received + 1, Natural'Last - 1);
         This.Packets_in     := Natural'Min (
            This.Packets_in     + 1, Natural'Last - 1);

         -- Do something with it

         Item.Source := G2.Packet.Queue.Server;
         Item.Tcp_id := U (id (this));
         Item.Packet := P;
         this.Network.Inbound.Put (Item);

         -- Mark traffic

         Traffic.Add ((
            Arrival  => Calendar.Clock,
            Protocol => Protocol_descr,
            Way      => Traffic.Incoming,
            From     => Item.Tcp_id,
            Name     => U (G2.Packet.Name (Item.Packet)),
            Data     => U (G2.Packet.To_hex (Item.Packet))));
      end loop;
   exception
      when E : others =>
         Trace.Log ("G2.Core.Check_pipes [" & S (This.Slot.User_agent) & "]: " & 
            Trace.Report (E),
            Trace.Error);
         Disconnect (this);
   end Check_pipes;

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

   -- Send_Pending                                                       --

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

   -- Send pending data:

   -- First try to send any already buffered, then try to get new data

   procedure Send_pending (This : in out Server_type) is
      Awarded : Natural;
      -- Get available bandwidth for sending

      function Get_bandwidth return Natural is
         Aw, Awx : Natural := 0;
         Needed  : Natural;
      begin
         Needed := Natural'Min (
            This.Slot.OBuffer'Length,
            Circular_stream.Available_read (This.Slot.CStream_out));
         Bandwidth.Server_link.Commit (Needed, Aw, Extra => false);
         if Aw < Needed then
            Bandwidth.Server_link.Commit (Needed - Aw, Awx, Extra => true);
         end if;
         return Aw + Awx;
      end Get_bandwidth;
   begin
      -- Flush buffer if necessary:

      if Chronos.Elapsed (This.Slot.ZCron) > 5.0 then
         Chronos.Reset (This.Slot.ZCron);
         if This.Slot.Deflate and then not This.Slot.ZFlushed then
            Zlib.Streams.Flush (This.Slot.ZStream_out);
            This.Slot.ZFlushed := true;
         end if;
      end if;

      while 
         This.Slot.OBuffer_used or else
         Circular_stream.Available_read (This.Slot.CStream_out) > Natural'(0)
      loop
         if This.Slot.OBuffer_used then
            -- Check alive:

            if not Socket.Is_alive (this.Slot.Socket) then
               Trace.Log (
                  "G2 server connection lost (" &
                  Id (this) & ")", Trace.Informative);
               Disconnect (this);
               return; -- <-- EXIT BY DEAD SERVER

            end if;
            if not Socket.Is_writable (this.Slot.Socket) then
               Trace.Log ("G2.Send_pending: Soft delayed for " &
                  Id (This), Trace.Never);
               return; -- <-- EXIT BY CONNECTION CONGESTION

            end if;
            begin
               Write (
                  This.Slot.Stream.all, 
                  This.Slot.OBuffer (1 .. This.Slot.OLast));
               -- Write successful:

               This.Slot.OBuffer_used := false;
            exception
               when E : Socket.Socket_error =>
                  case Socket.Get_error (E) is
                     when Socket.Operation_would_block =>
                        Trace.Log ("G2.Send_pending: Hard delayed for " &
                           Id (This));
                        return; -- <-- EXIT BY CONNECTION CONGESTION

                     when others =>
                        raise;
                  end case;
            end;
         end if;
         if Circular_stream.Available_read (This.Slot.CStream_out) > 
               Natural'(0) 
            and then not This.Slot.OBuffer_used
         then
            -- Bandwidth things:

            Awarded := Get_bandwidth;
            if Awarded > 0 then
               -- Reading:

               Circular_stream.Read (
                  This.Slot.CStream_out, 
                  This.Slot.OBuffer (
                     1 .. Ada.Streams.Stream_element_offset (Awarded)), 
                  This.Slot.OLast);
               This.Slot.OBuffer_used := true;
            else
               return; -- <-- EXIT BY BANDWIDTH THROTTLE

            end if;
         end if;
      end loop;
   exception
      when E : others =>
         Trace.Log ("G2.Core.Send_pending: " & Trace.Report (E),
            Trace.Error);
         Disconnect (this);
   end Send_pending;

   -- Create a new server from a dotted adress:port 

   procedure Create (
      this     : out Server_type; 
      Net      : in  Network_access;
      Address  : in  String; 
      Port     : in  Natural;
      Seen     : in  Calendar.Time := Calendar.Clock) is
   begin
      this.Address   := To_ustring(Address);
      this.Port      := Port;
      this.Network   := Net;
      this.Last_seen := Seen;
   end Create;

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

   -- Available_cstream --

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

   -- Helper for availables:

   function Available_cstream (
      This : access Ada.Streams.Root_stream_type'Class)
      return Natural is
   begin
      return Circular_stream.Available_read (
         Circular_stream.Object_access (This).all);
   end Available_cstream; 
   ----------------------

   -- Available_socket --

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

   function Available_Socket (
      This : access Ada.Streams.Root_stream_type'class) return Natural is
   begin
      return Socket.Available (Socket.Stream_access (This).all);
   end Available_socket;

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

   -- Surveillance --

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


   -- Monitors that we are really connected.

   task body Connector_type is

      Net : Network_access;   -- Network object it belongs...

      Active_servers : Natural renames Globals.Options.G2_ActiveServers;
      Try_servers    : Natural renames Globals.Options.G2_TryServers;

   begin
      -- Start connecting

      accept Start(this: in Network_access) do
         Net:= this;
         Net.Status:= Network.Connecting;
      end;
      Main: loop
         declare
            Curr_active_servers  : Natural := 0;
            Serv : Server_access;
         begin
            -- End?

            exit when Globals.Requested_exit;
            -- Sleep.

            delay Globals.Options.G2_PollPeriod;
            -- Check to how many servers we are connected:

            Curr_active_servers  := Net.Servers.Status_count (Connected);
            if Curr_active_servers > 0 then
               Net.Status := Network.Connected;
            else
               Net.Status := Network.Connecting;
            end if;

            -- Establish new connections as needed:

            if Curr_active_servers < Active_servers and then
               Net.Servers.Count < Try_servers then
               -- Get new servers and try to connect:

               declare
                  -- Cached:

                  Cached : Server.Object_access_array := 
                     Server.List.Get_best
                       (Network_id, Try_servers - Net.Servers.Count);
                  -- From webcache only if we had not enough cached ones:

                  GWCached : GWCache2.Network_node_array :=
                     GWCache2.Query_any (Network_id, 
                        Try_servers - Net.Servers.Count - Cached'Length);
                  New_server : Server_access;
                  Discarded  : Natural := 0;
               begin
                  -- Start connection sequence:

                  -- And add to our list of servers:

                  for n in Cached'Range loop
                     New_server := Server_access (Cached (n));
                     -- Other data:

                     New_server.Network          := Net;
                     New_server.Local_port       := Net.Port;
                     New_server.Connection_start := Calendar.Clock;
                     New_server.Profile_requested:= false;
                     New_server.Connection_stage := Starting;
                     -- Allocate in slots:

                     Net.Servers.Add (New_server);
                     -- Start connection sequence:

                     -- Not necessary because the poll task will do that:

                  end loop;
                  -- Create new G2 servers and add to cache:

                  for n in GWCached'Range loop
                     New_server := new Server_type;
                     Create (New_server.all, Net, 
                        To_string (GWCached (n).Address), GWCached (n).Port);
                     begin
                        Server.List.Add (Server.Object_access (New_server));
                     exception
                        when Server.Server_already_cached =>
                           Discarded := Discarded + 1;
                     end;
                  end loop;
                  if GWCached'Length > 0 then
                     Trace.Log ("Added" & Natural'Image (
                        GWCached'Length - Discarded) & 
                        " servers from GWebCache2");
                     Trace.Log ("Discarded" & Discarded'Img & 
                        " servers from GWebCache2");
                  end if;
               exception
                  when E: others =>
                     Trace.Log ("G2.Connector [Adding servers]: " &
                        Trace.Report (E), Trace.Error);
               end;
            end if;
            while Curr_active_servers > Active_servers loop
               -- We should disconnect newers :

               Net.Servers.Get_newest (Serv);
               exit when Serv = null;
               Disconnect2 (Serv.all, Spare => true);
               Curr_active_servers := Curr_active_servers - 1;
            end loop;
         exception
            when E: others =>
               Trace.Log ("G2.Connector_type [Main loop]: " & 
                  Trace.Report (E), Trace.Error);
         end;
      end loop Main;
      Trace.Log ("G2.Connector_type exited");
   exception
      when E: others =>
         Trace.Log ("G2.Connector_type [Body]: " & Trace.Report (E), 
            Trace.Error);
   end Connector_type;

   task body Polling_type is

      Net               : Network_access;
      P                 : Duration renames Globals.Options.G2_PollConnection;
      Delta_score       : Server.Rating;
      Serv              : Server_access;
      Serv_aux          : Server_access;
      Serv_next         : Server_access;
      Connected_servers : Natural renames Globals.Options.G2_ActiveServers;
      Must_drop         : Boolean;

      use type Calendar.Time;
   begin
      accept Start (this : in Network_access) do
         Net := this;
      end;
      Delta_score := Server.Rating (P);
      Main: loop
         begin
            exit when Globals.Requested_exit;

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

            -- DISPATCHER --

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

            Dispatcher (Net);
            -------------

            -- SERVERS --

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

            Must_drop := 
               Connected_servers <= Net.Servers.Status_count(Connected);
            Net.Servers.Get_first (Serv);
            while Serv /= null loop
               case Serv.Network.Servers.Status (Serv) is
                  when Disconnected =>
                     -- Drop packets pending outbound

                     Serv.Slot.Outbound.Clear;

                     Serv_aux  := Serv;
                     Serv_next := Serv;
                     Net.Servers.Get_next (Serv_next);
                     Net.Servers.Remove (Serv);
                     Serv := Serv_aux;
                     Server.List.Check_in (Server.Object_access (Serv));
                     Serv := Serv_next;
                  when Disconnecting =>
                     null; -- Still cleaning up

                  when Connecting =>
                     if Must_drop then
                        Disconnect (Serv.all);
                     else
                        Connect (Serv.all);
                     end if;
                  when Handshaking =>
                     if Must_drop then
                        Disconnect (Serv.all);
                     else
                        Handshake (Serv.all);
                     end if;
                  when Connected =>
                     -- Increase score:

                     Add_score (Serv.all, Delta_score);
                     -- Check pipes for each connected server:

                     Check_pipes (Serv.all);
                     -- Send outbound packtes

                     if Net.Servers.Status (Serv) = Connected then
                        Sender (Serv);
                     end if;
                     -- General maintenance

                     if Net.Servers.Status (Serv) = Connected then
                        Maintenance (Serv);
                     end if;
               end case;
               if Serv /= null then
                  Net.Servers.Get_next (Serv);
               end if;
            end loop;
         exception
            when E: others =>
               Trace.Log ("G2.Polling_type [Main loop]: " & Trace.Report (E), 
                  Trace.Error);
               if Serv /= null then
                  Trace.Log ("G2.Polling_type [Main loop]: " & Id (Serv.all) &
                  ": " & Server_Status'Image (
                     Serv.Network.Servers.Status (Serv)) & ": " &
                     Serv.Connection_stage'Img, Trace.Error);
                  Disconnect (Serv.all);
               end if;
         end;
         -- Sleep

         delay P;
         if Debug.Debug_statistics_enabled then
            Statistics.Object.Set ("Tasking - Server poll", 
               Statistics.Booleans.Create (true));
         end if;
      end loop Main;
      Trace.Log ("G2.Polling_type exited");
   exception
      when E: others =>
         Trace.Log("G2.Polling_type [Body]: " & Trace.Report(E), Trace.Error);
   end Polling_type;

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

   -- Servers pool --

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

   protected body Server_pool is separate;

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

   -- Maintenance --

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

   procedure Maintenance (This : Server_access) is separate;

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

   -- Dispatcher --

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

   procedure Dispatcher (Net : access Network_type) is separate;
   ------------

   -- Sender --

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

   task body Sender_udp is separate;
   procedure Sender (This : access Server_type) is separate;

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

   -- Processing packets --

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

   procedure Process_packet (
      Net    : in Network_access; 
      Source : in Server_access;
      Item   : in Packet.Queue.Item_type)
   is separate;

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

   -- Creating packets --

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


   -- Create a LNI packet with info about us, in respect to the given server.

   function Create_LNI (
      Net: in Network_access;
      Destination : in Server_access) return Packet.Object is

      P        : Packet.Object;   -- Root

      C        : Packet.Object;   -- Children

      Payload  : UString;         -- Payload


   begin
      P := Packet.Create ("LNI");

      -- NA child

      case Socket.IP.Kind (To_string (Destination.Address)) is
         when Socket.IP.Local =>
            Payload := U (To_string (To_address ("127.0.0.1")));
         when Socket.IP.Internal =>
            Payload := U (To_string (To_address (Socket.IP.Get_IP(false))));
         when Socket.IP.Public =>
            Payload := U (To_string (To_address (
               Socket.IP.Get_IP(Internet_route = Direct))));
      end case;

      Payload := Payload & U (To_string (Network.Endian.Convert (
         Net.Port, 2, Packet.Big_endian (P))));

      C := Packet.Create ("NA", S (Payload));
      Packet.Add_child (P, C);

      -- GU child (GUID)

      C := Packet.Create ("GU", GUID.To_char_array (GUID.My_GUID));
      Packet.Add_child (P, C);

      -- V child (vendor code)

      C := Packet.Create ("V", Vendor_code);
      Packet.Add_child (P, C);

      -- LS child (library statistics)

      C := Packet.Create (
         "LS",
         To_string (Network.Endian.Convert (Library.Object.Num_files, 4,
            Packet.Big_endian (P))) &
         To_string (Network.Endian.Convert (Library.Object.Size_files, 4,
            Packet.Big_endian (P))));
      Packet.Add_child (P, C);

      return P;
   end Create_LNI;

   -- Create a /UPROD/XML packet with gprofile.xsd conformat payload.

   function Create_UPROD return Packet.Object is
      P : Packet.Object := Packet.Create ("UPROD");
      C : Packet.Object;
   begin
      -- Add XML payload

      C := Packet.Create ("XML", 
            Unicode.G2_to_string (
            Xml.Compress (Xml.To_string (
            Xml.Get ("gProfile", Globals.Config))), 
               Packet.Big_endian (P)));

      Packet.Add_child (P, C);

      return P;
   end Create_UPROD;

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

   -- Create_KHL                                                         --

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

   function Create_KHL (Net : in Network_access) return Packet.Object is
      pragma Unreferenced (Net);
      P       : Packet.Object := Packet.Create ("KHL");
      C       : Packet.Object;
      Data    : Ustring;
      Servers : Server.Object_access_array := 
         Server.List.Get_best (G2.Network_id, 20); 
   begin
      for N in Servers'Range loop
         Server.List.Check_in (Servers (N));
      end loop;
      C := Packet.Create ("TS", 
         To_string (Time_t.Clock, Packet.Big_endian (P)));
      Packet.Add_child (P, C);
      for N in Servers'Range loop -- NO SERVERS REPORTED!!!

         exit;
         Data := U (To_string (To_address (S (
               Server_access (Servers (N)).Address))));
         Data := Data &
            To_string (Network.Endian.Convert (
               Server_access (Servers (N)).Port, 2, 
               Packet.Big_endian (P))) &
            String'(1 .. 4 => Character'Val (0));
         C := Packet.Create ("CH", S (Data));
         Packet.Add_child (P, C);
      end loop;
      return P;
   end Create_KHL;

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

   -- Report --

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

   function Report (Net : Network_type) return Report_array is
   begin
      return Net.Servers.Report;
   end Report;

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

   -- Send                                                               --

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

   -- Send a packet via TCP

   procedure Send (
      this           : in     Server_access;
      P              : in     Packet.Object;
      In_response_to : in     Packet.Object := Packet.Null_packet) is

      I : Packet.Queue.Item_type;
      use Packet.Safe_child;
      use type Packet.Object;
   begin
      if This = null then
         return;
      end if;

      I.Packet := P;
      I.Tcp_id := U (Id (This.all));
      I.Source := Packet.Queue.Server;
      if In_response_to /= Packet.Null_packet then
         I.In_response_to := In_response_to;
      end if;

      if this.Slot /= null then
         this.Slot.Outbound.Put (I);
      end if;
   end Send; 

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

   -- Finalize                                                           --

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

   procedure Initialize (this : in out Server_type) is
      pragma Unreferenced (This);
   begin
      null;
--      begin

--         Statistics.Object.Update (

--            Stat_servers, 

--            Statistics.Integers.Increment'Access,

--            Statistics.Integers.Create (1));

--      exception

--         when others => null;

--      end;

   end Initialize;
   procedure Adjust (this : in out Server_type) is
      pragma Unreferenced (This);
   begin
      null;
--      begin

--         Statistics.Object.Update (

--            Stat_servers, 

--            Statistics.Integers.Increment'Access,

--            Statistics.Integers.Create (1));

--      exception

--         when others => null;

--      end;

   end Adjust;
   procedure Finalize (this : in out Server_type) is
      use type Xml.Node;
   begin
      if this.User_profile /= null then
         Xml.Delete (this.User_profile);
         this.User_profile := null;
      end if;
--     Trace.Log ("<----");

--      begin

--         Statistics.Object.Update (

--            Stat_servers, 

--            Statistics.Integers.Increment'Access,

--            Statistics.Integers.Create (-1));

--      exception

--         when others => null;

--      end;

      Adagio.Server.Finalize (Adagio.Server.Object (This));
   end Finalize;

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

   -- Connected hubs --

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

   function Connected_hubs return Natural is
   begin
      return The_network.Servers.Status_count (Connected);
   end Connected_hubs;

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

   -- Hubs_http_handler                                                  --

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

   procedure Hubs_http_handler (
      Data : out Agpl.Http.Server.Sort_Handler.Data_set) 
   is
      Serv  : Server_access;
      Score : Natural;
   begin
      The_network.Servers.Get_first (Serv);
      while Serv /= null loop
         begin
            Score := Natural (Serv.Score);
         exception
            when Constraint_error =>
               Score := 0;
         end;
         declare
            use Agpl.Http.Server.Sort_handler;
            use Ada.Calendar;
            Row    : Data_row;
            CC     : Agpl.Geoip.Country_code :=
               Agpl.Geoip.Country_code_from_addr (Id (Serv.all));
            Uptime : Duration := Clock - Serv.Connection_start;
         begin
            -- Country code flag

            if CC = "??" then
               Append (Row, (U ("unknown"), Null_ustring));
            else
               Append (Row, (U (CC), Null_ustring));
            end if;
            -- Country

            if CC /= "??" then
               Append (Row, (
                  U (Agpl.Geoip.Country_name_from_code (CC)),
                  U (Agpl.Geoip.Country_name_from_code (CC))));
            else 
               Append (Row, (
                  U (Agpl.Geoip.Country_name_from_code (CC)),
                  U ("Zz")));
            end if;
            -- IP:port

            Append (Row, (U (Id (Serv.all)), U (Id (Serv.all))));
            -- Status

            Append (Row, (
               U (Server_status'Image (The_network.Servers.Status (Serv))),
               U (Server_status'Image (The_network.Servers.Status (Serv)))));
            -- Nick

            Append (Row, (
               U (Xml.Get_attribute ("identity/handle", "primary", 
                  Serv.User_profile, "Anonymous")),
               U (Xml.Get_attribute ("identity/handle", "primary", 
                  Serv.User_profile, "Anonymous"))));
            -- User_agent

            Append (Row, (Serv.Slot.User_agent, Serv.Slot.User_agent));
            -- Leaf load

            Append (Row, (
               U (Misc.To_string (Serv.Num_leaves) & "/" &
                  Misc.To_string (Serv.Max_leaves)),
               Rpad (Serv.Num_leaves)));
            -- Qrp status

            if Serv.QRT_status /= Sending then
               Append (Row, (
                  U (Serv.QRT_status'Img), U (Serv.QRT_status'Img)));
            else
               Append (Row, (
                  U (Serv.QRT_status'Img & " (" & 
                     Misc.To_string (Serv.QRT_packets_sent) & "/" &
                     Misc.To_string (Serv.QRT_packets + 1) & ")"),
                  U (Serv.QRT_status'Img & S (RPad (Serv.QRT_packets_sent))))
                  );
            end if;
            -- Rating

            Append (Row, (
               U (Misc.To_string (Serv.Score, 0)),
               Rpad (Score, 6)));
            -- Uptime

            Append (Row, (
               U (Misc.Image (Uptime)),
               Rpad (Natural (Uptime))));
            -- Packets in

            Append (Row, (
               U (Misc.To_string (Serv.Packets_in)),
               Rpad (Serv.Packets_in)));
            -- Packets out

            Append (Row, (
               U (Misc.To_string (Serv.Packets_out)),
               Rpad (Serv.Packets_out)));

            -- Row

            Append (Data, Row);
         end;
         The_network.Servers.Get_next (Serv);
      end loop;
   end Hubs_http_handler;

begin
   
   The_network := new G2.Core.Network_type;
   Network.List.Add (Network.Object_access (The_network));

   Trace.Log ("G2_server size: " & 
      Integer'Image (Server_type'size / 8));

--   Statistics.Object.Set (Stat_servers,

--      Statistics.Integers.Create (0));


   Hardcoded_servers:
      declare
         Serv  : Server_access;
         Nodes : Xml.Node_array := Xml.Get_all ("network/Gnutella2/root",
            Globals.Config);
         use Strings.Fields;
      begin
         for N in Nodes'Range loop
            declare
               Full_addr : String renames
                  Xml.Get_attribute (Nodes (N), "address", "");
               Addr : String := Select_field (Full_addr, 1, ':');
               Port : String := Select_field (Full_addr, 2, ':');
            begin
               if Addr /= "" and then Port /= "" then
                  Serv := new Server_type;
                  Create (Serv.all, The_network, Addr, Natural'Value (Port));
                  Serv.Score := Server.Rating (
                     Xml.Utils.Get_num (Nodes (N), "rating", Natural'Last));
                  Serv.Is_root := true;
                  Server.List.Add (Server.Object_access (Serv));
                  Trace.Log ("Added root Gnutella2 server: " & Full_addr);
               else
                  Trace.Log ("Cannot add invalid Gnutella2 server: " & 
                     Full_addr, Trace.Warning);
               end if;
            end;
         end loop;
      end Hardcoded_servers;

end Adagio.G2.Core;