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_genesis            21    
udp_genesis            22    -- Generate a human representation of a (local-endian) IP Address
udp_genesis            23    function IP_To_String(IP : in IP_Address) return IP_Address_Text is
udp_genesis            24       Text : IP_Address_Text := (others => ' ');
udp_genesis            25    begin
udp_genesis            26       Unix_UDP_IP_To_String(IP, Text'Address, Text'Length);
udp_genesis            27       return Text;
udp_genesis            28    end IP_To_String;
udp_genesis            29    
udp_genesis            30    
udp_genesis            31    -- Generate a (local-endian) IP Address from given human representation
udp_genesis            32    function IP_From_String(IP_Text : in String) return IP_Address is
udp_genesis            33       Text_With_Null : String(1 .. IP_Text'Length + 1);
udp_genesis            34       Result : Interfaces.C.Int := 0;
udp_genesis            35       IP     : aliased IP_Address;
udp_genesis            36    begin
udp_genesis            37       -- We can't use To_C because malicious idiots demanded secondary stack.
udp_genesis            38       Text_With_Null(IP_Text'Range) := IP_Text;
udp_genesis            39       Text_With_Null(Text_With_Null'Last) := Character'Val(0);
udp_genesis            40       
udp_genesis            41       -- Let unix do the conversion
udp_genesis            42       Result := Unix_UDP_String_To_IP(Text_With_Null'Address,
udp_genesis            43                                       IP'Access);
udp_genesis            44       case Result is
udp_genesis            45          when -1 =>
udp_genesis            46             raise UDP_Invalid_Text_IP;
udp_genesis            47          when others =>
udp_genesis            48             return IP;
udp_genesis            49       end case;
udp_genesis            50    end IP_From_String;
udp_genesis            51    
udp_genesis            52    
udp_genesis            53    -- Open a UDP socket, with the given local endpoint for both TX and RX
udp_genesis            54    procedure Open_Socket(S              : out Socket;
udp_genesis            55                          Local_Endpoint : in  Endpoint) is
udp_genesis            56       Result : constant Interfaces.C.Int :=
udp_genesis            57         Unix_UDP_Socket_Open(Socket     => S'Address,
udp_genesis            58                              Local_IP   => Local_Endpoint.Address,
udp_genesis            59                              Local_Port => Local_Endpoint.Port);
udp_genesis            60    begin
udp_genesis            61       case Result is
udp_genesis            62          when -1 =>
udp_genesis            63             raise UDP_Failed_Open;
udp_genesis            64          when -2 =>
udp_genesis            65             raise UDP_Failed_SetOpt;
udp_genesis            66          when -3 =>
udp_genesis            67             raise UDP_Failed_Bind;
udp_genesis            68          when others =>
udp_genesis            69             null;
udp_genesis            70       end case;
udp_genesis            71    end Open_Socket;
udp_genesis            72    
udp_genesis            73    
udp_errata_asciil...   74    -- Permanently close the given open socket
udp_genesis            75    procedure Close_Socket(S : in out Socket) is
udp_genesis            76    begin
udp_genesis            77       Unix_UDP_Socket_Close(Socket => S'Address);
udp_genesis            78    end Close_Socket;
udp_genesis            79    
udp_genesis            80    
udp_genesis            81    -- Transmit the Payload, via Socket, to given Destination
udp_genesis            82    procedure Transmit(S           : in out Socket;
udp_genesis            83                       Destination : in     Endpoint;
udp_genesis            84                       Payload_Buf : in     Payload) is
udp_genesis            85       Result : constant Interfaces.C.Int :=
udp_genesis            86         Unix_UDP_Socket_Transmit(Socket      => S'Address,
udp_genesis            87                                  Remote_IP   => Destination.Address,
udp_genesis            88                                  Remote_Port => Destination.Port,
udp_genesis            89                                  Payload_Buf => Payload_Buf'Address,
udp_genesis            90                                  Payload_Len => Payload'Length);
udp_genesis            91    begin
udp_genesis            92       case Result is
udp_genesis            93          when -1 =>
udp_genesis            94             Close_Socket(S);
udp_genesis            95             raise UDP_Failed_Transmit;
udp_genesis            96          when others =>
udp_errata_asciil...   97             -- No eggog, but must check if sent all bytes:
udp_errata_asciil...   98             if (Result /= Payload'Length) then
udp_errata_asciil...   99                Close_Socket(S);
udp_errata_asciil...  100                raise UDP_Truncated_Send;
udp_errata_asciil...  101             end if;
udp_genesis           102       end case;
udp_genesis           103    end Transmit;
udp_genesis           104    
udp_genesis           105    
udp_genesis           106    -- Wait (potentially forever!) for a Payload, via Socket; save its Origin
udp_genesis           107    procedure Receive(S           : in out Socket;
udp_genesis           108                      Origin      : out    Endpoint;
udp_genesis           109                      Payload_Buf : out    Payload;
udp_genesis           110                      Valid       : out    Boolean) is
udp_genesis           111       
udp_genesis           112       -- Scratch pad (if not successful, the call has no outputs)
udp_genesis           113       Incoming_Payload : aliased Payload := (others => 0);
udp_genesis           114       Incoming_IP      : aliased IP_Address;
udp_genesis           115       Incoming_Port    : aliased IP_Port;
udp_genesis           116       
udp_genesis           117       Result : constant Interfaces.C.Int :=
udp_genesis           118         Unix_UDP_Socket_Receive(Socket      => S'Address,
udp_genesis           119                                 Origin_IP   => Incoming_IP'Access,
udp_genesis           120                                 Origin_Port => Incoming_Port'Access,
udp_genesis           121                                 Payload_Buf => Incoming_Payload'Address,
udp_genesis           122                                 Payload_Len => Payload'Length);
udp_genesis           123    begin
udp_genesis           124       Valid := False;
udp_genesis           125       case Result is
udp_genesis           126          when -1 =>
udp_genesis           127             Close_Socket(S);
udp_genesis           128             raise UDP_Failed_Receive;
udp_genesis           129          when others =>
udp_genesis           130             -- No eggog:
udp_genesis           131             Origin.Address := Incoming_IP;
udp_genesis           132             Origin.Port    := Incoming_Port;
udp_genesis           133             Payload_Buf    := Incoming_Payload;
udp_genesis           134             
udp_genesis           135             -- Was a full-length payload?
udp_genesis           136             if (Result = Payload'Length) then
udp_genesis           137                Valid := True;
udp_genesis           138             end if;
udp_genesis           139       end case;
udp_genesis           140    end Receive;
udp_genesis           141    
udp_genesis           142 end UDP;