File : adagio-g2-packet-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-g2-packet-queue.adb,v 1.8 2004/02/29 20:36:42 Jano Exp $


-- Queue for inbound G2 packets:

with Adagio.Statistics;
with Adagio.Statistics.Integers;
with Adagio.Trace;

package body Adagio.G2.Packet.Queue is

   use type Packet.Object;

   Stat_item : constant String := "Network - G2 - Queued packets";

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

   -- Controlled queue --

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

   protected body Object is

      -- Add a packet to the queue:

      procedure Put (Item : in Item_type) is
      begin
         if BQueue.Length (Data) > Max_pending_packets then
            Trace.Log ("G2.Packet.Queue: Queue full, dropping packet " &
               To_hex (Item.Packet), Trace.Warning);
         else
            if Is_a (Item.Packet, "/PO") then
               BQueue.Prepend (Data, Item);
            else
               BQueue.Append (Data, Item);
            end if;
            Statistics.Object.Update (
               Stat_item,
               Statistics.Integers.Increment'Access,
               Statistics.Integers.Create (1));
         end if;
      end Put;

      -- Remove a packet:

      entry Get (Item : out Item_type) when not BQueue.Is_empty (Data) is
      begin
         Item := BQueue.Element (BQueue.First (Data));
         BQueue.Delete_first (Data);
         if Item.Packet = Packet.Null_packet then 
            Trace.Log ("******* null in get");
         end if;
         Statistics.Object.Update (
            Stat_item,
            Statistics.Integers.Increment'Access,
            Statistics.Integers.Create (-1));
      end Get;

      -- Look at the first packet:

      procedure Peek (Item : out Item_type; Success : out Boolean) is
      begin
         if BQueue.Is_empty (Data) then
            Success := false;
         else
            Item := BQueue.Element (BQueue.First (Data));
            if Item.Packet = Packet.Null_packet then 
               Trace.Log ("****** null in G2.Packet.Queue.Peek", Trace.Error);
               Success := false;
            else
               Success := true;
            end if;
         end if;
      end Peek;

      -- Defer a packet from a server:

      procedure Defer (Tcp_id : in String) is
         use BQueue;
         I    : Iterator_type := First (Data);
         Item : Item_type;
      begin
         while I /= Back (Data) loop
            Item := Element (I);
            if Item.Source = Listener_tcp and then
               Item.Tcp_id /= Tcp_id then
               -- Move this packet to front:

               Delete (Data, I);
               Prepend (Data, Item);
               return;
            else
               I := Succ (I);
            end if;
         end loop;
      end Defer;

      -----------

      -- Clear --

      -----------

      procedure Clear is
      begin
         Statistics.Object.Update (
            Stat_item,
            Statistics.Integers.Increment'Access,
            Statistics.Integers.Create (-BQueue.Length (Data)));
         BQueue.Clear (Data);
      end Clear;
      
      -- Says if empty

      function Is_empty return Boolean is
      begin
         return BQueue.Is_empty (Data);
      end Is_empty;

      -- Says length

      function Length return Natural is
      begin
         return BQueue.Length (Data);
      end Length;

   end Object;

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

   -- Send                                                               --

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

   -- Send a packet via UDP

   procedure Send (
      this           : in out Object;
      P              : in     Packet.Object;
      Destination    : in     Socket.Sock_addr_type;
      Safe           : in     Boolean := false;
      In_response_to : in     Packet.Object := Packet.Null_packet) is

      I : Item_type;
      use Packet.Safe_child;
   begin
      I.Source          := Listener_udp;
      I.Packet          := P;
      I.Udp_destination := Destination;
      I.Udp_safe        := Safe;
      if In_response_to /= Null_packet then
         I.In_response_to := In_response_to;
      end if;

      this.Put (I);
   end Send;

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

   -- Send                                                               --

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

   -- Send a packet via TCP

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

      I : Item_type;
      use Packet.Safe_child;
   begin
      I.Source := Server;
      I.Packet := P;
      I.Tcp_id := U (Tcp_id);
      if In_response_to /= Null_packet then
         I.In_response_to := In_response_to;
      end if;

      this.Put (I);
   end Send;

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

   -- Control                                                            --

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

   procedure Initialize (This : in out Item_type) is
      pragma Unreferenced (This);
   begin
      null;
--      Statistics.Object.Update (

--         Stat_item,

--         Statistics.Integers.Increment'Access,

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

   end Initialize;
   procedure Adjust     (This : in out Item_type) is
      pragma Unreferenced (This);
   begin
      null;
--      Statistics.Object.Update (

--         Stat_item,

--         Statistics.Integers.Increment'Access,

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

   end Adjust;
   procedure Finalize   (This : in out Item_type) is
      pragma Unreferenced (This);
   begin
      null;
--      Statistics.Object.Update (

--         Stat_item,

--         Statistics.Integers.Increment'Access,

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

   end Finalize;

begin
   Statistics.Object.Set (
      Stat_item,
      Statistics.Integers.Create (0)); -- There are five static items around

end Adagio.G2.Packet.Queue;