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


with Adagio.Convert;
with Adagio.G2.Packet;
with Adagio.Misc;
with Adagio.Network.Endian;
with Adagio.Socket;
with Adagio.Socket.IP;
with Adagio.Trace;
with Adagio.Unicode;
with Adagio.Xml;
with Adagio.Xml.Utils;

with Sha1;

with Agpl.Strings;

package body Adagio.G2.Hit is

   package Endian renames Adagio.Network.Endian;

   use Type Ustring;

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

   -- Create                                                             --

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

   -- Create all hits from a QH2 packet.

   function Create (Item : in Packet.Queue.Item_Type) return Object_Array is
      H        : Packet.Object renames Item.Packet;
      Result   : Object_Array (1 .. Max_Hits);
      Num_Hits : Natural             := 0;
      Hits     : Packet.Object_Array := Packet.Get_Children (H, "H");
      Groups   : Packet.Object_Array := Packet.Get_Children (H, "HG");
      Big_Endian : Boolean := Packet.Big_Endian (H);
      Last_Sha1  : Ustring;

      type Group_Type is record
         Id   : Natural;
         Busy : Boolean;
         BW   : Speed;
      end record;
      Group_Data : array (Groups'Range) of Group_Type;
   begin
      -- Prepare groups:

      for I in Groups'Range loop
         declare
            Pay : constant String := Packet.Payload (Packet.Get_Child (Groups (I), "SS"));
         begin
            Group_Data (I).Id   := 
               Endian.Convert ( 
                  Endian.To_Byte_Array (Packet.Payload (Groups (I))),
                  Big_Endian);
            Group_Data (I).Busy := 
               Endian.Convert (
                  Endian.To_Byte_Array (Pay (Pay'First .. Pay'First + 1)),
                  Big_Endian) >=
               Endian.Convert (
                  Endian.To_Byte_Array (Pay (Pay'First + 2 .. Pay'First + 2)),
                  Big_Endian);
            Group_Data (I).BW := 
               Endian.Convert (
                  Endian.To_Byte_Array (Pay (Pay'First + 3 .. Pay'First + 6)),
                  Big_Endian);
         end;
      end loop;
      -- Create Hits

      for I in Hits'Range loop
         Last_Sha1 := Null_Ustring;
         Num_Hits   := Num_Hits + 1;
         -- Sender Guid

         Result (Num_Hits).Sender_Guid := Packet.Payload (Packet.Get_Child (H, "GU"));
         -- Sender Address

         if Packet.Is_A (H, "/QH2/NA") then
            Result (Num_Hits).Sender_Addr := U (G2.To_Address (
               Packet.Payload (Packet.Get_Child (H, "NA")),
               Big_Endian));
            if S (Result (Num_Hits).Sender_Addr) /= Socket.Image (Item.Udp_Source) and then
               not Socket.IP.Is_Public (S (Result (Num_Hits).Sender_Addr))
            then
               -- Mark firewalled

               Result (Num_Hits).Firewalled := true;
            end if;
         else
            Result (Num_Hits).Sender_Addr := U (Socket.Image (Item.Udp_Source));
         end if;
         if Result (Num_Hits).Firewalled then
            -- Add the packet source public address as a firewall too

            -- Add firewalled sources HERE from NA

            null;
         end if;
         -- Vendor code

         if Packet.Is_A (H, "/QH2/V") then
            Result (Num_Hits).Vendor := U (Packet.Payload (Packet.Get_Child (H, "V")));
         end if;
         -- Browsable

         Result (Num_Hits).Browsable := Packet.Is_A (H, "/QH2/BUP");
         -- Chatable

         Result (Num_Hits).Chatable := Packet.Is_A (H, "/QH2/PCT");
         -- Get groups info:

         declare
            Group : Integer;
         begin
            if Packet.Is_A (Hits (I), "/H/G") then
               Group := Endian.Convert (
                  Endian.To_Byte_Array (Packet.Payload (Packet.Get_child (Hits (I), "G"))),
                  Big_Endian);
            else
               Group := 0;
            end if;
            for K in Group_Data'Range loop
               if Group = Group_Data (K).Id then
                  Result (Num_Hits).Busy      := Group_Data (K).Busy;
                  Result (Num_Hits).Bandwidth := Group_Data (K).BW;
                  exit;
               end if;
            end loop;
         end;
         -- Add the URNs

         declare
            Urns : Packet.Object_Array := Packet.Get_Children (Hits (I), "URN");
         begin
            for J in Urns'Range loop
               declare
                  Pay  : String := Packet.Payload (Urns (J));
                  Urn  : String := Misc.Get_C_String (Pay);
                  Hash : String := Pay (Pay'First + Urn'Length + 1 .. Pay'Last);
               begin
                  if Urn = "sha1" then
                     Last_Sha1 := U (Sha1.To_Base32 (Sha1.From_Char_Array (Hash)));
                     Add_Hash (Result (Num_Hits), urn, 
                        Sha1.To_Base32 (Sha1.From_Char_Array (Hash)));
--                     Trace.Log ("G2.Hit.Create: Adding hash for family " & Urn, 

--                        Trace.Always);

                  elsif Urn = "bp" then
                     Last_Sha1 := U (Sha1.To_Base32 (Sha1.From_Char_Array (
                           Hash (Hash'First .. Hash'First + 19))));
                     Add_Hash (Result (Num_Hits), "sha1", 
                        Sha1.To_Base32 (Sha1.From_Char_Array (
                           Hash (Hash'First .. Hash'First + 19))));
--                     Trace.Log ("G2.Hit.Create: Adding hash for family " & Urn, 

--                        Trace.Always);

                  else
                     null;
--                     Trace.Log ("G2.Hit.Create: Discarding hash for family " & Urn, 

--                        Trace.Always);

                  end if;
               end;
            end loop;
         end;
         -- Add URL if available

         if Packet.Is_A (Hits (I), "/H/URL") then
            Result (Num_Hits).Url := 
               U (Packet.Payload (Packet.Get_Child (Hits (I), "URL")));
--            Trace.Log ("G2.Hit.Create: Adding URL: " & S (Result (Num_Hits).Url),

--               Trace.Always);

         end if;
         -- Add Name skipping the 4-bytes for size if necessary

         if Packet.Is_A (Hits (I), "/H/DN") then
            if Packet.Is_A (Hits (I), "/H/SZ") then
               declare
                  Pay : String := Packet.Payload (Packet.Get_Child (Hits (I), "DN"));
                  Bad : Boolean := false;
               begin
                  -- Check for spurious sizes in names:

                  for K in Pay'First .. Pay'First + 3 loop
                     if Pay (K) < ' ' then
                        Bad := true;
                        exit;
                     end if;
                  end loop;
                  if Bad then
                     Set_Name (Result (Num_Hits), Agpl.Strings.Trim (Unicode.G2_To_String (
                        Pay (Pay'first + 4 .. Pay'Last),
                        Big_Endian)));
                     Trace.Log ("Correcting hit name: " & Pay, Trace.Debug);
                  else
                     Set_Name (Result (Num_Hits), Agpl.Strings.Trim (Unicode.G2_To_String (
                        Pay,
                        Big_Endian)));
                  end if;
               end;
            else
               declare
                  Pay : String := Packet.Payload (Packet.Get_Child (Hits (I), "DN"));
               begin
                  Set_Name (Result (Num_Hits), Agpl.Strings.Trim (Unicode.G2_To_String (
                     Pay (Pay'First + 4 .. Pay'Last),
                     Big_Endian)));
               end;
            end if;
         else
            Trace.Log ("G2.Hit.Create: Unnamed hit (xml?)", Trace.Warning);
            Set_Name (Result (Num_Hits), "(No data)");
         end if;
         -- Set Size:

         if Packet.Is_A (Hits (I), "/H/SZ") then
            Set_Size (Result (Num_Hits), Natural (Endian.Convert_L (
               Endian.To_Byte_Array (Packet.Payload (Packet.Get_Child (Hits (I), "SZ"))),
               Big_Endian)));
         elsif Packet.Is_A (Hits (I), "/H/DN") then
            declare
               Pay : String := Packet.Payload (Packet.Get_Child (Hits (I), "DN"));
            begin
               Set_Size (Result (Num_Hits), Endian.Convert (
                  Endian.To_Byte_Array (Pay (Pay'First .. Pay'First + 3)),
                  Big_Endian));
            end;
         end if;
         -- Set Alt Sources

         if Packet.Is_A (Hits (I), "/H/CSC") then
            Result (Num_Hits).Alt_Sources := Endian.Convert (
               Endian.To_Byte_Array (Packet.Payload (Packet.Get_Child (Hits (I), "CSC"))),
               Big_Endian);
         end if;
         -- Get User comments

         if Packet.Is_A (Hits (I), "/H/COM") then
            declare
               Xmlstr : String := "<dummy>" & Unicode.G2_To_String (
                  Packet.Payload (Packet.Get_Child (Hits (I), "COM")),
                  Big_Endian) & "</dummy>";
               Doc    : Xml.Document := Xml.From_String (Xmlstr);
            begin
               Result (Num_Hits).Comment := U (Xml.Get_Attribute ("", "comment", Doc, ""));
               begin
                  Result (Num_Hits).Rating  := 
                     Xml.Utils.Get_Num ("comment", "rating", Doc, -1);
                  Result (Num_Hits).Rated   := true;
               exception
                  when Constraint_Error =>
                     null; -- No rating present

               end;
               Xml.Delete (Doc);
            end;
         end if;
         -- Get Preview URL

         if Packet.Is_A (Hits (I), "/H/PVU") then
            Result (Num_Hits).Preview := U (Unicode.G2_To_String (
               Packet.Payload (Packet.Get_Child (Hits (I), "PVU")),
               Big_Endian));
            if Result (Num_Hits).Preview = Null_Ustring then
               Result (Num_Hits).Preview := "http://" &
                  Result (Num_Hits).Sender_Addr & "/gnutella/preview/v1?urn:" &
                  S (Last_Sha1);
            end if;
            -- Trace.log ("ADDING HIT WITH PREVIEW: " & S (Result (Num_Hits).Preview),

            --   Trace.Always);

         end if;
         -- Get sender nick

         if Packet.Is_A (H, "/QH2/UPROD/NICK") then
            Result (Num_Hits).Nick := U (Unicode.G2_To_String (
               Packet.Payload (Packet.Get_Child (H, "UPROD/NICK")),
               Big_Endian));
         end if;
      end loop;

      return Result (1 .. Num_Hits);
   exception
      when E : others =>
         Trace.Log ("G2.Hit.Create: " & Trace.Report (E), Trace.Warning);
         raise Malformed_Hit;
   end Create;

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

   -- Get_Extra                                                          --

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

   function Get_Extra (This : in Object) return String is
      R : Ustring;
      use ASU;
   begin
      if This.Busy then
         Append (R, "<img src=""busy.png"">;");
      else
         Append (R, "<img src=""ready.png"">;");
      end if;
      if This.Rated then
         Append (R, "<img src=""star" & Misc.To_String (This.Rating) & ".png"">;");
      end if;
      if This.Comment /= Null_Ustring then
         Append (R, "Comment: " & This.Comment & ";");
      end if;
--      if This.Preview /= Null_Ustring then

--         Append (R, "<a href=""" & This.Preview & """>Preview</a>;");

--      end if;

      if This.Alt_Sources > 0 then
         Append (R, "Alt+" & Misc.To_String (This.Alt_Sources) & ";");
      end if;
      if This.Bandwidth > 0 then
         Append (R, "BW:" & Convert.To_Size (This.Bandwidth * 1024) & "/s;");
      end if; 
      if This.Nick /= Null_Ustring then
         Append (R, This.Nick);
         if This.Vendor /= Null_Ustring then
            Append (R, " using " & This.Vendor & ";");
         else
            Append (R, ";");
         end if;
      elsif This.Vendor /= Null_Ustring then
         Append (R, This.Vendor & ";");
      end if;

      Return Slice (R, 1, Length (R) - 1); -- Removing last ';'

   end Get_Extra;

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

   -- Get_Id                                                             --

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

   -- Should return a unique id, identifying the source (IP based or something).

   function Get_Id (This : in Object) return String is
   begin
      return This.Sender_Guid;
   end Get_Id;

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

   -- Is Firewalled                                                      --

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

   function Is_Firewalled (This : in Object) return Boolean is
   begin
      return This.Firewalled;
   end Is_Firewalled;

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

   -- Merge                                                              --

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

   -- Merge two hits to get extra features from a set of hits.

   -- Merges second on first

   procedure Merge (L : in out Object; R : in Object) is
   begin
      L.Vendor      := Null_Ustring;
      L.Nick        := Null_Ustring;
      L.Firewalled  := L.Firewalled and R.Firewalled;
      L.Alt_Sources := L.Alt_Sources + R.Alt_Sources;
      if L.Rated then
         if R.Rated then
            L.Rating := Natural'Min (L.Rating, R.Rating);
         end if;
      elsif R.Rated then
         L.Rated  := true;
         L.Rating := R.Rating;
      end if;
      L.Busy := L.Busy and R.Busy;
      if not R.Busy then
         L.Bandwidth := L.Bandwidth + R.Bandwidth;
         if L.Bandwidth >= Speed'Last / 1024 then
            L.Bandwidth := Speed'Last / 1024;
         end if;
      end if;
   end Merge;

end Adagio.G2.Hit;