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;