raw
udp_genesis             1 ------------------------------------------------------------------------------
udp_genesis             2 ------------------------------------------------------------------------------
udp_genesis             3 -- This file is part of 'UDP', a datagram sockets library.                  --
udp_genesis             4 --                                                                          --
udp_genesis             5 -- (C) 2018 Stanislav Datskovskiy ( www.loper-os.org )                      --
udp_genesis             6 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html     --
udp_genesis             7 --                                                                          --
udp_genesis             8 -- You do not have, nor can you ever acquire the right to use, copy or      --
udp_genesis             9 -- distribute this software ; Should you use this software for any purpose, --
udp_genesis            10 -- or copy and distribute it to anyone or in any manner, you are breaking   --
udp_genesis            11 -- the laws of whatever soi-disant jurisdiction, and you promise to         --
udp_genesis            12 -- continue doing so for the indefinite future. In any case, please         --
udp_genesis            13 -- always : read and understand any software ; verify any PGP signatures    --
udp_genesis            14 -- that you use - for any purpose.                                          --
udp_genesis            15 --                                                                          --
udp_genesis            16 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm .     --
udp_genesis            17 ------------------------------------------------------------------------------
udp_genesis            18 ------------------------------------------------------------------------------
udp_genesis            19 
udp_genesis            20 package body UDP is
udp_tester             21 
udp_tester             22    -- Bit-level compare of 2 payloads, returns number of different bits
udp_tester             23    function Bit_Compare(A: in Payload; B: in Payload) return Natural is
udp_tester             24      V     : Unsigned_8;
udp_tester             25      Count : Natural := 0;
udp_tester             26    begin
udp_tester             27      for I in Payload'Range loop
udp_tester             28        -- obtain bits that are different
udp_tester             29        V := A(I) xor B(I);
udp_tester             30        -- count the bits that are 1, if any
udp_tester             31        Counting_Loop:
udp_tester             32          while V /= 0 loop
udp_tester             33            Count := Count + Natural((V and Unsigned_8(1)));
udp_tester             34            V := Shift_Right(V, 1);
udp_tester             35          end loop Counting_Loop;
udp_tester             36      end loop;
udp_tester             37 
udp_tester             38      return Count;
udp_tester             39    end Bit_Compare;
udp_genesis            40    
udp_genesis            41    -- Generate a human representation of a (local-endian) IP Address
udp_tester             42    function IP_To_String(IP  : in IP_Address)
udp_tester             43                          return IP_Address_Text is
udp_genesis            44       Text : IP_Address_Text := (others => ' ');
udp_genesis            45    begin
udp_genesis            46       Unix_UDP_IP_To_String(IP, Text'Address, Text'Length);
udp_genesis            47       return Text;
udp_genesis            48    end IP_To_String;
udp_genesis            49    
udp_genesis            50    
udp_genesis            51    -- Generate a (local-endian) IP Address from given human representation
udp_genesis            52    function IP_From_String(IP_Text : in String) return IP_Address is
udp_genesis            53       Text_With_Null : String(1 .. IP_Text'Length + 1);
udp_genesis            54       Result : Interfaces.C.Int := 0;
udp_genesis            55       IP     : aliased IP_Address;
udp_genesis            56    begin
udp_genesis            57       -- We can't use To_C because malicious idiots demanded secondary stack.
udp_genesis            58       Text_With_Null(IP_Text'Range) := IP_Text;
udp_genesis            59       Text_With_Null(Text_With_Null'Last) := Character'Val(0);
udp_genesis            60       
udp_genesis            61       -- Let unix do the conversion
udp_genesis            62       Result := Unix_UDP_String_To_IP(Text_With_Null'Address,
udp_genesis            63                                       IP'Access);
udp_genesis            64       case Result is
udp_genesis            65          when -1 =>
udp_genesis            66             raise UDP_Invalid_Text_IP;
udp_genesis            67          when others =>
udp_genesis            68             return IP;
udp_genesis            69       end case;
udp_genesis            70    end IP_From_String;
udp_genesis            71    
udp_genesis            72    
udp_genesis            73    -- Open a UDP socket, with the given local endpoint for both TX and RX
udp_genesis            74    procedure Open_Socket(S              : out Socket;
udp_genesis            75                          Local_Endpoint : in  Endpoint) is
udp_genesis            76       Result : constant Interfaces.C.Int :=
udp_genesis            77         Unix_UDP_Socket_Open(Socket     => S'Address,
udp_genesis            78                              Local_IP   => Local_Endpoint.Address,
udp_genesis            79                              Local_Port => Local_Endpoint.Port);
udp_genesis            80    begin
udp_genesis            81       case Result is
udp_genesis            82          when -1 =>
udp_genesis            83             raise UDP_Failed_Open;
udp_genesis            84          when -2 =>
udp_genesis            85             raise UDP_Failed_SetOpt;
udp_genesis            86          when -3 =>
udp_genesis            87             raise UDP_Failed_Bind;
udp_genesis            88          when others =>
udp_genesis            89             null;
udp_genesis            90       end case;
udp_genesis            91    end Open_Socket;
udp_genesis            92    
udp_genesis            93    
udp_errata_asciil...   94    -- Permanently close the given open socket
udp_genesis            95    procedure Close_Socket(S : in out Socket) is
udp_genesis            96    begin
udp_genesis            97       Unix_UDP_Socket_Close(Socket => S'Address);
udp_genesis            98    end Close_Socket;
udp_genesis            99    
udp_genesis           100    
udp_genesis           101    -- Transmit the Payload, via Socket, to given Destination
udp_genesis           102    procedure Transmit(S           : in out Socket;
udp_genesis           103                       Destination : in     Endpoint;
udp_genesis           104                       Payload_Buf : in     Payload) is
udp_genesis           105       Result : constant Interfaces.C.Int :=
udp_genesis           106         Unix_UDP_Socket_Transmit(Socket      => S'Address,
udp_genesis           107                                  Remote_IP   => Destination.Address,
udp_genesis           108                                  Remote_Port => Destination.Port,
udp_genesis           109                                  Payload_Buf => Payload_Buf'Address,
udp_genesis           110                                  Payload_Len => Payload'Length);
udp_genesis           111    begin
udp_genesis           112       case Result is
udp_genesis           113          when -1 =>
udp_genesis           114             Close_Socket(S);
udp_genesis           115             raise UDP_Failed_Transmit;
udp_genesis           116          when others =>
udp_tester            117             if Result /= Payload'Length then
udp_tester            118               -- fail as message was truncated/not sent in full
udp_tester            119               Close_Socket(S);
udp_tester            120               raise UDP_Truncated_Send;
udp_errata_asciil...  121             end if;
udp_genesis           122       end case;
udp_genesis           123    end Transmit;
udp_genesis           124    
udp_genesis           125    
udp_genesis           126    -- Wait (potentially forever!) for a Payload, via Socket; save its Origin
udp_genesis           127    procedure Receive(S           : in out Socket;
udp_genesis           128                      Origin      : out    Endpoint;
udp_genesis           129                      Payload_Buf : out    Payload;
udp_tester            130                      Recv_Len    : out    Unsigned_32) is
udp_genesis           131       
udp_genesis           132       -- Scratch pad (if not successful, the call has no outputs)
udp_genesis           133       Incoming_Payload : aliased Payload := (others => 0);
udp_genesis           134       Incoming_IP      : aliased IP_Address;
udp_genesis           135       Incoming_Port    : aliased IP_Port;
udp_genesis           136       
udp_genesis           137       Result : constant Interfaces.C.Int :=
udp_genesis           138         Unix_UDP_Socket_Receive(Socket      => S'Address,
udp_genesis           139                                 Origin_IP   => Incoming_IP'Access,
udp_genesis           140                                 Origin_Port => Incoming_Port'Access,
udp_genesis           141                                 Payload_Buf => Incoming_Payload'Address,
udp_genesis           142                                 Payload_Len => Payload'Length);
udp_genesis           143    begin
udp_tester            144       -- Valid := False;
udp_tester            145       Recv_Len := 0;
udp_genesis           146       case Result is
udp_genesis           147          when -1 =>
udp_genesis           148             Close_Socket(S);
udp_genesis           149             raise UDP_Failed_Receive;
udp_genesis           150          when others =>
udp_genesis           151             -- No eggog:
udp_genesis           152             Origin.Address := Incoming_IP;
udp_genesis           153             Origin.Port    := Incoming_Port;
udp_genesis           154             Payload_Buf    := Incoming_Payload;
udp_genesis           155             
udp_genesis           156             -- Was a full-length payload?
udp_tester            157             --if (Result = Payload'Length) then
udp_tester            158             --   Valid := True;
udp_tester            159             --end if;
udp_tester            160             Recv_Len := Unsigned_32( Result );
udp_genesis           161       end case;
udp_genesis           162    end Receive;
udp_genesis           163    
udp_genesis           164 end UDP;