File : adagio-upload-queue.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-upload-queue.adb,v 1.8 2004/02/24 15:26:14 Jano Exp $


with Adagio.File.Criteria;
with Adagio.Globals;
with Adagio.Globals.Options;
with Adagio.Misc;
with Adagio.Os;
with Adagio.Trace;
with Adagio.Unicode;
with Adagio.Upload.Active_clients;
with Adagio.Upload.Client_data;
with Adagio.Upload.Resource.File;
with Adagio.Xml;

with Agpl.Geoip;
with Expressions_evaluator;
with Strings.Utils;  use Strings.Utils;

with Gnat.Heap_sort_a; use Gnat;
with Gnat.Os_lib;

with Ada.Streams; use Ada.Streams;
with Ada.Streams.Stream_IO;
with Ada.Tags; use Ada.Tags;
with Ada.Unchecked_deallocation; use Ada;

package body Adagio.Upload.Queue is

   use type Upload.Resource.Handle;

   Remember_client_period : Duration 
      renames Globals.Options.Uploads_RememberClientPeriod;
   Safe_queues            : Boolean 
      renames Globals.Options.Uploads_SafeQueues;

   procedure Free is new Unchecked_deallocation (
      Queue_slot, Queue_slot_access);

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

   -- Times_client                                                       --

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

   -- Count how many times is a client in a slot_list

   function Times_client (
      This : in Slot_Vector.Object; Client_id : in String)
      return Natural is
      use Slot_vector;
      Num : Natural := 0;
   begin
      for N in 1 .. Last (This) loop
         if This.Vector (N).Client_id = Client_id then
            Num := Num + 1;
         end if;
      end loop;

      return Num;
   end Times_client;

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

   -- Trace_queue                                                        --

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

   procedure Trace_queue (
      This : in Slot_vector.Object; Rated : in Boolean := false) is
      use Slot_vector;
      Trail : Ustring;
   begin
      for N in 1 .. Last (This) loop
         Trail := U (" ");
         if This.Vector (N).Can_start then
            Trail := Trail & U ("U");
         end if;
         if This.Vector (N).Alive then
            Trail := Trail & U ("");
         else
            Trail := Trail & U ("D");
         end if;
         if Rated then
            Trace.Log ("Position" & N'img & "#" &
               Misc.To_string (Float (This.Vector (N).Rating)) & ": " &
               S (This.Vector (N).Queue_Id) & S (Trail));
         else
            Trace.Log ("Position" & N'img & ": " &
               S (This.Vector (N).Queue_Id) & S (Trail));
         end if;
      end loop;
   end Trace_queue;

   protected body Object is

   procedure Purge_dead_slots;

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

   -- Contains                                                           --

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

   function Contains (Queue_id : in String) return Boolean is
   begin
      return Id_list.Is_in (Queue_id, Ids);
   end Contains;

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

   -- Create                                                             --

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

   procedure Create (
      This           : in  Object_access;
      Name           : in  String;
      Length         : in  Natural;
      Uploads        : in  Natural;         -- Max queue length.

      Bandwidth      : in  File_size;        -- Base bandwidth.

      Minimum_speed  : in  Speed := 1024; -- That active clients must hold.

      Average_period : in  Duration := 30.0 * 60.0;
      Criteria       : in  String   := "true";
      Preemptive     : in  Preemptions := Default_preemption;
      Ordering       : in  Orderings   := Default_ordering;
      Base_folder    : in  String      := "") is

      -- From file:

      procedure Restore is
         use Ada.Calendar;
         use Ada.Streams.Stream_IO;
         use Slot_vector;

         F    : File_type;
         Path : Ustring;
         Str  : Stream_access;
         Slot : Queue_slot_access;
      begin
         if Base_folder = "" then
            Path := Name & U (".queue.dat");
         elsif Base_folder (Base_folder'Last) /= Os.Folder_separator then
            Path := Base_folder & Os.Folder_separator & Name &
               U (".queue.dat");
         else
            Path := Base_folder & Name & U (".queue.dat");
         end if;

         if not Os_lib.Is_regular_file (S (Path)) then
            Trace.Log ("Upload.Queue.Restore: Queue data not found for " &
               S (Path));
            return;
         end if;

         Open (F, Name => S (Path), Mode => In_file);
         Str := Stream (F);

         -- Loading

         while not End_of_file (F) loop
            Slot := new Queue_slot;
            Slot.Max_slots  := Length;
            Slot.Queue_id   := U (String'Input (Str));
            Slot.Client_id  := U (String'Input (Str));

            Slot.Arrival    := Calendar.Time'Input (Str);
            Slot.Last_seen  := Calendar.Time'Input (Str);
            Slot.Expiration := Calendar.Time'Input (Str);

            Slot.Client_name := Ustring'Input (Str);
            Slot.Client_file := Ustring'Input (Str);
            Slot.Client_ip   := Ustring'Input (Str);

            slot.Can_start  := false;
            Slot.Alive      := false;

            if Times_client (Clients, S (Slot.Client_id)) < Max_per_client
            then
               Append (Clients, Slot);
               Id_list.Insert (Ids, S (Slot.Queue_Id), Slot);
            else
               Free (Slot);
            end if;
         end loop;

         Close (F);
         Trace.Log ("Upload.Queue.Restore: Queue " & Name &
            " loaded correctly.", Trace.Informative);
         Purge_dead_slots;
         Schedule;
      exception
         when E : others =>
            Trace.Log ("Upload.Queue.Restore: Load failed from " & S (Path) &
               ": " & Trace.Report (E), Trace.Error);
            if Is_open (F) then
               Close (F);
            end if;
      end Restore;

   begin
      Object.Self       := This;
      Object.Name       := U (Name);
      Object.Length     := Length;
      Object.Uploads    := Uploads;
      Object.Bandwidth  := Bandwidth;
      Object.Min_speed  := Minimum_speed;
      Object.Avg_period := Average_period;
      Object.Criteria   := U (Criteria);
      Object.Preemptive := Preemptive;
      Object.Order      := Ordering;

      File_base := U (Base_folder);

      Max_per_client := Globals.Options.Uploads_MaxPerClient;

      -- Slot 0 null:

      Slot_vector.Append (Clients, null);

      -- Loading:

      Restore;
   end Create;

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

   -- Purge_dead_slots                                                   --

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

   procedure Purge_dead_slots is
      use Slot_vector;
      use type Calendar.Time;
      Now : Calendar.Time := Calendar.Clock;
   begin
      for N in reverse 1 .. Last (Clients) loop
         if (not Clients.Vector (N).Alive) and then
            Clients.Vector (N).Expiration < Now
         then
            Trace.Log ("Upload.Queue.Purge_dead_slots: Dropping too old: "
               & S (Clients.Vector (N).Queue_id));
            Remove (S (Clients.Vector (N).Queue_id));
         end if;
      end loop;
   end Purge_dead_slots;

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

   -- Enqueue                                                            --

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

   -- Try to add a new client.

   -- Can only fail if queue is full.

   procedure Enqueue (
      Client  : access Upload.Client.Object'Class;
      Success : out    Boolean) is
      Slot    : Queue_slot_access;

      procedure Save is
      begin
         Serialize (S (File_base));
      end Save;
      -- Requeuing. We'll try to reuse a dead slot of a client for a new

      -- upload. An exact match will be tried first, i.e., if the same file

      -- was requested when lost, that position will be taken.

      -- However, if the client requests a file it had not requested when

      -- lost, its slot will be used.

      procedure Requeue_client (Success : out Boolean) is
         use Slot_vector;
      begin
         for N in 1 .. Last (Clients) loop
            Slot := Clients.Vector (N);
            if (not Slot.Alive) and then
               S (Slot.Queue_Id) = Upload.Client.Queue_id (Client.all) then
               -- Revived!

               Slot.Can_start  := false;
               Slot.Alive      := true;
               Slot.Resource   := 
                  Upload.Client.Requested_resource (Client.all);

               Success := true;
               return;     --<---------------- Exit with slot revived.

            end if;
         end loop;
         -- Try to use another dead slot for the same client.

         for N in 1 .. Last (Clients) loop
            Slot := Clients.Vector (N);
            if (not Slot.Alive) and then
               S (Slot.Client_id) = Upload.Client.Id (Client.all) then
               -- Revived!


               -- Remove from old Id

               Id_list.Delete (Ids, S (Slot.Queue_id));

               Slot.Queue_id   := U (Upload.Client.Queue_id (Client.all));
               Slot.Can_start  := false;
               Slot.Alive      := true;
               Slot.Resource   := 
                  Upload.Client.Requested_resource (Client.all);

               -- Re-insert with correct id

               Id_list.Insert (Ids, S (Slot.Queue_id), Slot);

               Success := true;
               return;     --<---------------- Exit with slot revived.

            end if;
         end loop;
         Success := false;
      end Requeue_client;
   begin
      -- Criteria?

      if not Upload.Resource.Qualify (
         Upload.Resource.V (Upload.Client.Requested_resource (Client.all)).all,
         S (Criteria)) then
         Trace.Log ("Upload.Queue: " & S (Name) &
            ": Rejecting, criteria not meet.");
         Success := false;
         return;
      end if;

      -- Already queued?

      declare
         use type Id_list.Iterator_type;
         Slot : Id_list.Iterator_type :=
            Id_list.Find (Ids, Upload.Client.Queue_id (Client.all));
      begin
         if Slot /= Id_list.Back (Ids) and then
            Id_list.Element (Slot).Alive
         then
            Trace.Log ("Upload.Queue: " & S (Name) &
               ": Rejecting, already queued.");
            Success := false;
            return;
         end if;
      end;

      Purge_dead_slots;
      -- Search for a dead slot of the client:

      Requeue_client (Success);
      if Success then
         Trace.Log ("Upload.Queue: Revived slot " & S (Slot.Queue_Id));
      else
         -- Queue full?

         if Slot_vector.Length (Clients) >= Length then
            Trace.Log ("Upload.Queue: " & S (Name) &
               ": Rejecting, queue is full.");
            Success := false;
            return;
         end if;

         -- Too many appareances in this queue?

         if Times_client (Clients, Upload.Client.Id (Client.all)) >=
            Max_per_client
         then
            Trace.Log ("Upload.Queue: " & S (Name) &
               ": Rejecting, too many uploads for same client.");
            Success := false;
            return;
         end if;

         -- Insert it:

         Slot       := new Queue_slot'(
            Queue_id   => U (Upload.Client.Queue_id (Client.all)),
            Client_id  => U (Upload.Client.Id (Client.all)),
            Resource   => Upload.Client.Requested_resource (Client.all),
            Client     => Upload.Client.Object_access (Client),
            Position   => 0,
            Max_slots  => Length,
            Used_slots => Slot_vector.Last (Clients),
            Rating     => 0.0,
            Arrival    => Calendar.Clock,
            Last_seen  => Calendar.Clock,
            Expiration => Calendar.Clock,
            Can_start  => false,
            Alive      => true,
            Client_name => U (Upload.Client.Name (Client.all)),
            Client_file => 
               U (Upload.Resource.Name (
                  Upload.Resource.V (
                     Upload.Client.Requested_resource (Client.all)).all)),
            Client_ip  => U (Upload.Client.Address (Client.all))
                     );

         Slot_Vector.Append (Clients, Slot);
         Id_list.Insert (Ids, S (Slot.Queue_Id), Slot);
      end if;

      Slot.Client := Upload.Client.Object_access (Client);

      Success    := true;

      -- See if is a starter:

      Schedule;

      Trace.Log ("** Queue: " & S (Name) & " ** ");
      Trace_queue (Clients, Order.Kind = Rated);
      if Safe_queues then
         Save;
      end if;
   end Enqueue;

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

   -- Remove                                                             --

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

   -- Remove an upload by ID

   procedure Remove (Queue_id : in String) is
      use Slot_vector;
   begin
      Id_list.Delete (Ids, Queue_id);
      for N in 1 .. Last (Clients) loop
         if S (Clients.Vector (N).Queue_id) = Queue_id then
            if Clients.Vector (N).Can_start then
               Current_uploads := Current_uploads - 1;
               -- Remove from actives:

               Upload.Active_clients.List.Remove (
                  (Id       => Clients.Vector (N).Client_id,
                   Queue_id => Clients.Vector (N).Queue_id));
            end if;
            Free (Clients.Vector (N));
            Delete (Clients, N);
            -- Optimize (Clients); -- EXPERIMENTAL -- TO BE REMOVED

            exit;
         end if;
      end loop;

      Schedule;
   end Remove;

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

   -- Lost                                                               --

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

   -- Mark a slot as lost by ID

   -- Free all resources and wait until reconnection or too old.

   procedure Lost (Queue_id : in String) is
      use Calendar;
      use Id_list;
      Slot : Queue_slot_access;
   begin
      Slot := Element (Find (Ids, Queue_id));
      Slot.Alive      := false;
      Slot.Expiration := Clock + Remember_client_period;
      Slot.Last_seen  := Clock;

      Trace.Log ("Upload.Queue.Lost: Queue id " & Queue_id & " lost.");
      Purge_dead_slots;
      Schedule;
   end Lost;

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

   -- Schedule                                                           --

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

   -- Re-sort the queue and marks the slots which should start.

   -- Never should a slot uploading be moved to the not uploading zone.

   procedure Schedule is
      use Ada.Calendar;
      use Slot_vector;

      procedure Move (From, To : Natural) is
      begin
         Clients.Vector (To) := Clients.Vector (From);
      end Move;
      function Less (L, R : Natural) return Boolean is
         SL, SR : Queue_slot_access;
      begin
         SL := Clients.Vector (L);
         SR := Clients.Vector (R);
         if SL.Can_start /= SR.Can_start then
            return SL.Can_start > SR.Can_start;
         elsif SL.Alive = SR.Alive then
            if SL.Alive then
               return SL.Arrival < SR.Arrival;
            else
               return SL.Last_seen > SR.Last_seen;
            end if;
         else
            return SL.Alive > SR.Alive ;
         end if;
      end Less;
      function Less_rated (L, R: Natural) return Boolean is
         SL, SR : Queue_slot_access;
      begin
         SL := Clients.Vector (L);
         SR := Clients.Vector (R);
         if SL.Can_start /= SR.Can_start then
            return SL.Can_start > SR.Can_start;
         elsif SL.Alive = SR.Alive then
            if SL.Alive then
               if SL.Rating = SR.Rating then
                  return Less (L, R);
               else
                  return SL.Rating > SR.Rating;
               end if;
            else
               return SL.Last_seen > SR.Last_seen;
            end if;
         else
            return SL.Alive > SR.Alive;
         end if;
      exception
         when E : others =>
            Trace.Log ("Upload.Queue.Less_rated: " & Trace.Report (E),
               Trace.Error);
            return Less (L, R);
      end Less_rated;
      procedure Rate_slots is
      begin
         for N in 1 .. Last (Clients) loop
            Clients.Vector (N).Rating :=
               Rate (Clients.Vector (N).all, S (Order.Expression));
         end loop;
      end Rate_slots;

      Start   : Calendar.Time := Calendar.Clock;
      N       : Natural;
      Success : Boolean;
   begin
      -- Sort the queue

      case Order.Kind is
         when Fifo =>
            Heap_sort_a.Sort (
               Last (Clients),
               Move'Unrestricted_access,
               Less'Unrestricted_access);
         when Rated =>
            Rate_slots;
            Heap_sort_a.Sort (
               Last (Clients),
               Move'Unrestricted_access,
               Less_rated'Unrestricted_access);
         when others =>
            raise Unimplemented;
      end case;
      Trace.Log ("Upload.Queue.Schedule: " & S (Name) & " sorted in " &
         Misc.To_string (Float (Clock - Start), 5) & "s");

      -- Mark the downloads that must start:

      -- They'll be the N first that are alive

      N := 1;
      while N <= Last (Clients) and then Current_uploads < Uploads loop
         if Clients.Vector (N).Alive and then
            not Clients.Vector (N).Can_start
         then
            -- Try adding it to active clients:

            Upload.Active_clients.List.Add (
               (Id       => Clients.Vector (N).Client_id,
                Queue_id => Clients.Vector (N).Queue_id),
               Max_per_client,
               Success);
            if Success then
               Clients.Vector (N).Can_start := true;
               Current_uploads := Current_uploads + 1;
               declare
                  R : Upload.Resource.Object_access :=
                     +Upload.Client.Requested_resource (
                        Clients.Vector (N).Client.all);
               begin
                  if R.all'Tag = Upload.Resource.File.Object'Tag then
                     Upload.Resource.File.Add_upload (
                        Upload.Resource.File.Object (R.all));
                  end if;
               end;
            end if;
         end if;
         N := N + 1;
      end loop;

      -- Mark positions:

      for N in 1 .. Last (Clients) loop
         Clients.Vector (N).Position := N;
      end loop;
   end Schedule;

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

   -- Serialize                                                          --

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

   procedure Serialize (Base : String := "") is
      use Ada.Streams.Stream_IO;
      use Slot_vector;

      F    : File_type;
      Path : Ustring;
      Str  : Stream_access;

      procedure Save_slot (This : in Queue_slot_access) is
         use type Calendar.Time;
      begin
         String'Output (Str, S (This.Queue_Id));
         String'Output (Str, S (This.Client_id));

         Calendar.Time'Output (Str, This.Arrival);
         Calendar.Time'Output (Str, This.Last_seen);
         if This.Alive then
            Calendar.Time'Output (
               Str, Calendar.Clock + Remember_client_period);
         else
            Calendar.Time'Output (Str, This.Expiration);
         end if;
         
         Ustring'Output (Str, This.Client_name);
         Ustring'Output (Str, This.Client_file);
         Ustring'Output (Str, This.Client_ip);
      end Save_slot;

   begin
      if Base = "" then
         Path := Name & ".queue.dat";
      elsif Base (Base'Last) /= Os.Folder_separator then
         Path := Base & Os.Folder_separator & Name & ".queue.dat";
      else
         Path := Base & Name & ".queue.dat";
      end if;
      Create (F, Name => S (Path), Mode => out_file);
      Str := Stream (F);

      -- Savings

      for N in 1 .. Last (Clients) loop
         Save_slot (Clients.Vector (N));
      end loop;

      Close (F);
      Trace.Log ("Upload.Queue.Serialize: Queue " & S (Name) &
         " saved correctly.", Trace.Debug);
   exception
      when E : others =>
         Trace.Log ("Upload.Queue.Serialize: Save failed to " & S (Path) &
            ": " & Trace.Report (E), Trace.Error);
         if Is_open (F) then
            Close (F);
         end if;
   end Serialize;

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

   -- Check_client                                                       --

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

   -- Obtains awareness about a queued client

   procedure Check_client (Queue_id : in String; Data : out Queue_slot) is
      use Id_list;
   begin
      Data := Element (Find (Ids, Queue_id)).all;
      Data.Used_slots := Slot_vector.Last (Clients);
   end Check_client;

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

   -- Busy                                                               --

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

   -- Maximum uploads reached

   function Busy return Boolean is
   begin
      return Current_uploads >= Uploads;
   end Busy;

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

   -- Is_candidate                                                       --

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

   -- Says if a file satisfy queue entry condition

   function Is_candidate (F : in File.Object) return Boolean is
   begin
      return File.Criteria.Qualify (F, S (Criteria));
   end Is_candidate;

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

   -- Report                                                             --

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

   -- Status of the queue:

   function Report (
      From : in Natural;
      Qty  : in Natural;
      Lost : in Boolean) return Report_array is
      use Slot_vector;
      Result : Report_array (1 .. 1 + Natural'Min (Qty, 10) - 1);
      No_res : Report_array (1 .. 0);
      Slot   : Queue_slot_access;
      Status : Ustring;
      Path   : Ustring;
      Name   : Ustring;
      Spd    : Float;
      use Ada.Calendar;
      use Slot_vector;
      use type File.Object;

      Pos    : Natural := From - 1;
   begin
      if Globals.Requested_exit then
         return No_res;
      end if;

      for N in 1 .. Natural'Min (Qty, 10) loop
         -- Early exit if no more clients:

         -- Trace.Log ("Queue: Pos: " & Pos'Img);

         -- Trace.Log ("Queue: Len: " & Natural'Image (Last (Clients)));

         loop
            Pos := Pos + 1;
            exit when 
               Pos > Last (Clients) or else 
               Clients.Vector (Pos).Alive or else
               Lost;
         end loop;
         if Pos > Last (Clients) then
            return Result (1 .. N - 1);
         end if;
         -- Data of the next valid client:

         Slot := Clients.Vector (Pos);
         Path := Slot.Client_file;
         Name := Slot.Client_name;
         if not Slot.Alive then
            Status := U ("Lost");
            Spd    := 0.0;
         elsif Slot.Can_start then
            Status := U ("Uploading");
         else
            Status := U ("Waiting");
         end if;
         if Slot.Alive then
            Spd  := Client.Speed (Slot.Client.all);
            ASU.Append (Path, " (Queued since: " &
               Misc.Image (Clock - Slot.Arrival) & ")");
            if Order.Kind = Rated then
               ASU.Append (Path, " (Rating: " & Misc.To_string (
                  Float (Slot.Rating), 5) & ")");
            end if;
         else
            ASU.Append (Path, " (Lost since: " &
               Misc.Image (Clock - Slot.Last_seen) & ")");
         end if;

         Result (N) := (
            Client_id => Slot.Client_id,
            Position  => Slot.Position,
            Status    => Status,
            Speed     => Spd,
            Client    => U (Unicode.To_utf8 (S (Name))),
            File      => U (Unicode.To_utf8 (S (Path))));
      end loop;
      return Result;
   exception
      when E : others =>
         Trace.Log ("Upload.Queue.Report: " & S (Name) & ": " &
            Trace.Report (E), Trace.Error);
         return No_res;
   end Report;

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

   -- Http_report                                                        --

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

   procedure Http_report (
      Lost : in  Boolean; -- Show lost ones

      Data : out Agpl.Http.Server.Sort_handler.Data_set)
   is
      use Agpl.Http.Server.Sort_handler;
      use Ada.Calendar;
      use Slot_vector;
      use type File.Object;

   begin
      if Globals.Requested_exit then
         return;
      end if;
      for N in 1 .. Last (Clients) loop
         exit when 
            ((not Clients.Vector (N).Alive) and (not Lost));

         declare
            Row    : Data_row;
            Slot   : Queue_slot_access := Clients.Vector (N);
            Status : Ustring;
            Spd    : Float;
            Now    : Calendar.Time := Clock;
            Code   : Agpl.Geoip.Country_code;
         begin
            -- Queue name

            Append (Row, (Name, Name));

            -- Position

            Append (Row, (U (Misc.To_string (N)), RPad (N, 4)));

            -- Rating

            if Slot.Alive then
               Append (Row, (
                  U (Misc.To_string (Float (Slot.Rating))), 
                  Rpad (Float (Slot.Rating), 15)));
            else
               Append (Row, (
                  U ("N/A"), 
                  Rpad (Float'Last, 15)));
            end if;

            -- Status

            if not Slot.Alive then
               Status := U ("Lost");
               Spd    := 0.0;
            else
               if Slot.Can_start then
                  Status := U ("Uploading");
               else
                  Status := U ("Waiting");
               end if;
               Spd  := Client.Speed (Slot.Client.all);
            end if;
            Append (Row, (Status, Status));

            -- Filename

            Append (Row, (Slot.Client_file, Slot.Client_file));

            -- Speed

            Append (Row, (
               U (Misc.To_string (Spd)),
               Rpad (Spd, 10)));

            -- Client

            Append (Row, (Slot.Client_name, Slot.Client_name));

            -- Arrival

            Append (Row, (
               U (Misc.Image (Now - Slot.Arrival)),
               Rpad (Float (Now - Slot.Arrival), 15)));

            -- Last seen

            if not Slot.Alive then
               Append (Row, (
                  U (Misc.Image (Now - Slot.Last_seen)),
                  Rpad (Float (Now - Slot.Last_seen), 15)));
            else
               Append (Row, (U ("Now"), U ("0")));
            end if;

            -- Expiration

            if not Slot.Alive then
               Append (Row, (
                  U (Misc.Image (Slot.Expiration - Now)),
                  Rpad (Float (Slot.Expiration - Now), 15)));
            else
               Append (Row, (U ("N/A"), U ("0")));
            end if;

            -- IP

            Append (Row, (Slot.Client_ip, Slot.Client_ip));

            -- Country code

            Code := Agpl.Geoip.Country_code_from_addr (S (Slot.Client_ip));
            if Code = "??" then
               Append (Row, (U ("unknown"), U ("ZZ")));
            else
               Append (Row, (U (Code), U (Code)));
            end if;

            -- Country name

            if Code = "??" then
               Append (Row, (U ("Unknown"), U ("Unknown")));
            else
               Append (Row, (
                  U (Agpl.Geoip.Country_name_from_code (Code)), 
                  U (Agpl.Geoip.Country_name_from_code (Code))));
            end if;

            Append (Data, Row);
         end;
      end loop;
   end Http_report;

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

   -- Members_access                                                     --

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

   -- Get_name

   function Get_name return String is
   begin
      return S (Name);
   end Get_name;

   -- Get_slot_bandwidt

   function Get_slot_bandwidth return Speed is
   begin
      return Bandwidth / Uploads;
   end Get_slot_bandwidth;

   -- Get max length

   function Get_max_length return Natural is
   begin
      return Length;
   end Get_max_length;

   -- Get current queued clients:

   function Get_current_length return Natural is
   begin
      return Natural'Max (Slot_vector.Last (Clients), 0);
   end Get_current_length;

   -- Count alive slots:

   function Get_alive_length return Natural is
      Length : Natural := 0;
      use Slot_vector;
   begin
      for N in 1 .. Last (Clients) loop
         if Clients.Vector (N).Alive then
            Length := Length + 1;
         end if;
      end loop;

      return Length;
   end Get_alive_length;

   -- Get average period for speeds

   function Get_avg_period return Duration is
   begin
      return Avg_period;
   end Get_avg_period;

   -- Get minimum speed

   function Get_min_speed return Speed is
   begin
      return Min_speed;
   end Get_min_speed;

   -- Preemptions

   function Get_preemptions return Preemptions is
   begin
      return Preemptive;
   end Get_preemptions;

   -- Max active uploads

   function Get_uploads return Natural is
   begin
      return Uploads;
   end Get_uploads;

   function Get_current_uploads return Natural is -- uploading now

      Length : Natural := 0;
      use Slot_vector;
   begin
      for N in 1 .. Last (Clients) loop
         if Clients.Vector (N).Alive then
            if Clients.Vector (N).Can_start then
               Length := Length + 1;
            else
               return Length;
            end if;
         else
            return Length;
         end if;
      end loop;

      return Length;
   end Get_current_uploads;

   function Get_current_waiting return Natural is -- alive waiting now

      Length : Natural := 0;
      use Slot_vector;
   begin
      for N in 1 .. Last (Clients) loop
         if Clients.Vector (N).Alive then
            if not Clients.Vector (N).Can_start then
               Length := Length + 1;
            end if;
         else
            return Length;
         end if;
      end loop;

      return Length;
   end Get_current_waiting;

   end Object;

   package Eval is new Expressions_evaluator (Rating);

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

   -- Rate                                                               --

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

   function Rate (This : in Queue_slot; Expr : in String) return Rating is
      use Ada.Calendar;

      Cooked_expr : Ustring := U ("f = " & Expr);

      Uploads     : Natural;
      Bytes_sent  : File_size;
      Size        : File_size;
      Waited      : Duration;

      E           : Eval.Expressions;
      Result      : Rating;
   begin
      if not This.Alive then
         return Rating'First;
      end if;

      -- Get values:

      declare 
         F : Upload.Resource.File.Object_access;
      begin
         F := Upload.Resource.File.Object_access (+This.Resource);
         
         Uploads := File.Uploads (Upload.Resource.File.File (F.all));
      exception
         when others => -- For example, incorrect tag :)

            Uploads := 0;
      end;

      Bytes_sent := Client_data.List.Get_sent (S (This.Client_id));
      Size       := File_size (
         Upload.Resource.Size (Upload.Resource.V (This.Resource).all));
      Waited     := Clock - This.Arrival;

      -- Do replacements:

      Cooked_expr :=
         U (Replace (S (Cooked_expr), "uploads",
            "(" & Natural'Image (Uploads) & ")"));

      Cooked_expr :=
         U (Replace (S (Cooked_expr), "bytes_sent",
            "(" & File_size'Image (Bytes_sent) & ")"));

      Cooked_expr :=
         U (Replace (S (Cooked_expr), "file_size",
            "(" & File_size'Image (Size) & ")"));

      if Waited < 1.0 then
         Waited := 1.0;
      end if;
      Cooked_expr :=
         U (Replace (S (Cooked_expr), "waited",
            "(" & Duration'Image (Waited) & ")"));

      begin
         E := Eval.Create (S (Cooked_expr));
         Result := Eval.Evaluate (E, Eval.f);
         Eval.Destroy (E);
         return Result;
      exception
         when Ex : others =>
            Trace.Log ("Upload.Ratings: Unable to evaluate " &
               S (Cooked_expr) & ": " & Trace.Report (Ex), Trace.Error);
            Eval.Destroy (E);
            return Rating'First;
      end;
   end Rate;

end Adagio.Upload.Queue;