File : adagio-g2-core-maintenance.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-maintenance.adb,v 1.4 2004/01/21 21:05:25 Jano Exp $
separate (Adagio.G2.Core)
procedure Maintenance (This : Server_access) is
Net : Network_access := This.Network;
type Reset_payload is record
Command : Byte := 0;
Entries : Positive;
Infinity : Byte := 1;
end record;
for Reset_payload use record
Command at 0 range 0 .. 7;
Entries at 1 range 0 .. 31;
Infinity at 5 range 0 .. 7;
end record;
for Reset_payload'Size use 8 * 6;
------------------------------------------------------------------------
-- Update_QRT --
------------------------------------------------------------------------
procedure Reset_QRT (Server : in Server_access) is
P : Packet.Object;
Reset : Reset_payload := (0, 2 ** Library.QRP_size, 1);
S : Mmap.Strings.Object := Mmap.Strings.Create (Reset'Address);
begin
P := Packet.Create ("QHT", S.all (S.all'First .. S.all'First + 5));
Send (Server, P);
end Reset_QRT;
procedure Update_QRT (Server : in Server_access) is
Patch_size : Constant Natural := 256; -- in bytes, for fragments
type Send_payload is record
Command : Byte := 1;
Fragment_no : Byte;
Fragment_count : Byte;
Compression : Byte := 1;
Bits : Byte := 1;
end record;
for Send_payload use record
Command at 0 range 0..7;
Fragment_no at 1 range 0..7;
Fragment_count at 2 range 0..7;
Compression at 3 range 0..7;
Bits at 4 range 0..7;
end record;
for Send_payload'Size use 5 * 8;
P : Packet.Object;
begin
if Server.QRT_timestamp < Library.Object.Get_QRP_timestamp then
Server.QRT_timestamp := Calendar.Clock;
-- Send table
declare
use Ada.Streams;
Table : String (1 .. 2 ** Library.QRP_size / 8) :=
Library.Object.Get_QRP;
Patch : Stream_element_array (1 .. 2 ** Library.QRP_size / 8);
for Patch'Address use Table'Address;
Pragma Import (Ada, Patch);
ZPatch : Stream_element_array := Zutil.Deflate (Patch);
Num_frags : Natural := (ZPatch'Length + 1) / Patch_size + 1;
Send : Send_payload;
SMap : Mmap.Strings.Object :=
Mmap.Strings.Create (Send'Address);
Pos : Stream_element_offset := ZPatch'First;
begin
Server.QRT_packets_sent := 0;
Server.QRT_packets := Num_frags;
Server.QRT_status := Sending;
-- Check sizes.
if Num_frags > Natural (Byte'Last) then
Trace.Log (
"G2.Core.Maintenance_task.Send_QRP: Table too large:" &
Natural'Image (Num_frags), Trace.Warning);
return;
end if;
-- Send reset
Reset_QRT (Server);
-- Send fragments
Send.Fragment_count := Byte (Num_frags);
for N in 1 .. Num_frags loop
Send.Fragment_no := Byte (N);
P := Packet.Create ("QHT",
SMap.all (1 .. Send_payload'Size / 8) &
Misc.To_string (ZPatch (Pos .. Stream_element_offset'Min (
Pos + Stream_element_offset (Patch_size) - 1,
ZPatch'Last))));
Pos := Pos + Stream_element_offset (Patch_size);
Core.Send (Server, P);
end loop;
end;
P := Packet.Create ("PO");
Core.Send (Server, P);
else
-- Mark it as sent anyways just in case it's empty and never will be sent:
Server.QRT_Status := Sent;
end if;
end Update_QRT;
begin
declare
Now : Calendar.Time := Calendar.Clock; -- Now time for reference.
Serv : Server_access := This;
begin
---------------------------------
-- Check connection starvation --
---------------------------------
if Now - Serv.Last_packet_time >
Globals.Options.G2_PingTimeout
then
-- Disconnect from server:
Disconnect (Serv.all);
Trace.Log ("G2.Core.Maintenance: Dropping server " &
Id (Serv.all) & " because of timeout",
Trace.Informative);
elsif Now - Serv.Last_packet_time >
Globals.Options.G2_PingDelay then
if Now - Serv.Last_ping_time > 5.0 then
-- Mark time
Serv.Last_ping_time := Now;
-- Send a ping.
declare
P : Packet.Object := Packet.Create ("PI");
begin
-- TCP ping
Send (Serv, P);
-- UDP ping
Packet.Queue.Send (
Net.Outbound,
P,
Socket.To_address (
S (Serv.Address) & ":" &
Misc.To_string (Serv.Port)),
Safe => true);
end;
end if;
end if;
-----------------------------
-- Update node information --
-----------------------------
if Now - Serv.Last_update > Globals.Options.G2_ServerInfoDelay then
Serv.Last_update := Now;
-- LNI
Send (Serv, Create_LNI (Net, Serv));
-- KHL
Send (Serv, Create_KHL (Net));
end if;
---------------------
-- Request profile --
---------------------
if not Serv.Profile_requested then
declare
P : Packet.Object := Packet.Create ("UPROC");
begin
Send (Serv, P);
Serv.Profile_requested := true;
end;
end if;
----------------
-- Update QRP --
----------------
if not Serv.QRT_reset then
Reset_QRT (Serv);
Serv.QRT_Reset := true;
end if;
if Now - Serv.Checked_QRP >
Globals.Options.G2_QRTUpdatePeriod and then
Now - Serv.Connection_start > Globals.Options.G2_QRTDelay
then
Serv.Checked_QRP := Now;
Update_QRT (Serv);
end if;
--------------------
-- Apt for search --
--------------------
if Globals.Options.Download_Active and then
(not Serv.Apt_For_Search) and then
Now - Serv.Connection_Start > 15.0
then
Serv.Apt_For_Search := true;
-- Starting addresses
G2.Search.Set_Start_Nodes (Net.Searcher, Net.Servers.Address_List);
G2.Search.Set_Queues (Net.Searcher, Net.Servers.Get_Queues_And_Addresses);
end if;
exception
when E : others =>
Trace.Log (
"G2.Core.Maintenance: " & Trace.Report (E), Trace.Error);
end;
end Maintenance;