File : net-packet-ip-v4.adb

with Ada.Unchecked_Conversion, Net.Portability, Ada.Strings.Fixed;
--  with Ada.Text_IO; use Ada.Text_IO;

package body Net.Packet.IP.V4 is
   function Get_Debug return Debug_Mode;
   pragma Inline (Get_Debug);
   
   function Get_Debug return Debug_Mode is
   begin
      if do_debug /= Inherit               then return do_debug;
      elsif Net.Packet.IP.do_debug /= Inherit then
         return Net.Packet.IP.do_debug;
      elsif Net.Packet.do_debug /= Inherit then return Net.Packet.do_debug;
      else                                      return Net.do_debug;
      end if;
   end Get_Debug;
   
   function New_Address (b : Payload_Type) return Address is
      package C is new System.Address_To_Access_Conversions (ipv4_addr);
   begin
      if b.length /= ipv4_addr'Size / 8 then
         raise Constraint_Error;
      end if;
      return Address'(addr => C.To_Pointer (b.data).all);
   end New_Address;

   function To_String (a : Address) return String is
      function "+" (i : Integer_8) return String;
      pragma Inline ("+");
      function "+" (i : Integer_8) return String is
      begin
         return Ada.Strings.Fixed.Trim (Integer_8'Image (i), Ada.Strings.Left);
      end "+";
   begin
      return (+a.addr (1)) & '.' & (+a.addr (2)) & '.' &
             (+a.addr (3)) & '.' & (+a.addr (4));
   end To_String;
   
   head_length : Integer_8 := Head'Size / 8;
   word_length : Integer_8 := 4;
   
   function New_Packet (f : Payload_Type) return Packet is
      p : Head_Ptr := Head_Conv.To_Pointer (f.data);
   begin
      return Packet'
        (head    => p,
         options => (data => f.data + head_length,
                   length => word_length * p.headlen - head_length),
         payload => (data => f.data   + word_length * p.headlen,
                   length => f.length - word_length * p.headlen));
   end New_Packet;

   function Payload (p : Packet) return Payload_Type is
   begin
      return p.payload;
   end Payload;
   
   function Src (p : Packet) return Address'Class is
   begin
      return Address'(addr => (p.head.src1, p.head.src2,
                               p.head.src3, p.head.src4));
   end Src;
   
   function Dst (p : Packet) return Address'Class is
   begin
      return Address'(addr => (p.head.dst1, p.head.dst2,
                               p.head.dst3, p.head.dst4));
   end Dst;
   
end Net.Packet.IP.V4;