-- POSIX_UDP_Garbage - Provide bindings for the disgusting filth POSIX requires to send UDP packets. -- Copyright (C) 2022,2023 Prince Trippy . -- This program is free software: you can redistribute it and/or modify it under the terms of the -- GNU Affero General Public License version 3 as published by the Free Software Foundation. -- 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 Affero General Public License for more details. -- You should have received a copy of the GNU Affero General Public License along with this program. -- If not, see . with System, Interfaces.C; use Interfaces.C; package body POSIX_UDP_Garbage is -- All that's needed is to provide bindings for the socket, bind, recvfrom, and sendto functions. -- I wanted to model these more precisely, but it was frustrating and thus I used System.Address. -- This wasn't entirely poor, as it made a latter extension, the String variants, easier to make. -- I'm not certain whether this be guaranteed to work or not, but it beats Interfaces.C.Pointers. -- Anyway, it works under the shitty POSIX environments which conspire to force themselves on me. function C_Socket (Domain, Socket_Type, Protocol : in Int) return Int; pragma Import(Convention => C, Entity => C_Socket, External_Name => "socket"); function C_Bind (Socket : in Int; Sockaddr_Address : in System.Address; Sockaddr_Length : in Socklen_T) return Int; pragma Import(Convention => C, Entity => C_Bind, External_Name => "bind"); function C_Sendto (Socket : in Int; Buffer : in System.Address; Buffer_Length : in Size_T; Flags : in Int; Sockaddr_Address : in System.Address; Sockaddr_Length : in Socklen_T) return Ssize_T; pragma Import(Convention => C, Entity => C_Sendto, External_Name => "sendto"); function C_Recvfrom (Socket : in Int; -- Modelling the pointers as out should be fine. Buffer : in System.Address; Buffer_Length : in Size_T; Flags : in Int; Sockaddr_Address : in System.Address; Sockaddr_Length : in System.Address) return Ssize_T; pragma Import(Convention => C, Entity => C_Recvfrom, External_Name => "recvfrom"); -- While wholely unnecessary, it's not a bad idea to include Close as well; at least it's simple. -- Know this is one fallible system call the idiots have regardless decided shall mostly succeed. function C_Close (File_Descriptor : Int) return Int; pragma Import(Convention => C, Entity => C_Close, External_Name => "close"); -- It's ``fortunate'' how Htons, Ntohs, Htonl, and Ntohl are functions and not text replacements. -- A C language programmer gladly introduces failure cases in order to save cycles here or there. -- After all, this gives the C language program more time to search for a null octet in a string. -- The programmer who thought this nonsense was a good idea should have had his brains scattered. function Htons (Data : in Uint16_T) return Uint16_T; function Ntohs (Data : in Uint16_T) return Uint16_T; function Htonl (Data : in Uint32_T) return Uint32_T; function Ntohl (Data : in Uint32_T) return Uint32_T; pragma Import(Convention => C, Entity => Htons, External_Name => "htons"); pragma Import(Convention => C, Entity => Ntohs, External_Name => "ntohs"); pragma Import(Convention => C, Entity => Htonl, External_Name => "htonl"); pragma Import(Convention => C, Entity => Ntohl, External_Name => "ntohl"); -- As Sockaddr is a private type, I'll entirely control its initialization and accessible fields. function Make_Sockaddr (Address : in Uint32_T; Port : in Uint16_T) return Sockaddr is begin return (Sa_Family => AF_INET, Sin_Port => Htons(Port), Sin_Addr => Htonl(Address), Sa_Zero => (others => Nul)); end Make_Sockaddr; function Sockaddr_Address (Socket_Address : in Sockaddr) return Uint32_T is begin return Ntohl(Socket_Address.Sin_Addr); end Sockaddr_Address; function Sockaddr_Port (Socket_Address : in Sockaddr) return Uint16_T is begin return Ntohs(Socket_Address.Sin_Port); end Sockaddr_Port; -- These public subprograms remove those superfluous arguments, and do only what is truly needed. procedure Socket (Socket : out Int) is I : Int := C_Socket(Domain => AF_INET, Socket_Type => SOCK_DGRAM, Protocol => 0); begin Socket := I; if I = -1 then raise Socket_Error; end if; end Socket; procedure Bind (Socket : in Int; Socket_Address : in Sockaddr) is I : Int := C_Bind(Socket, Socket_Address'Address, Sockaddr_Size); begin if I = -1 then raise Bind_Error; end if; end Bind; -- The following subprograms interact with Ssize_T, and so it's vital it has a proper definition. -- Still, I know even a flaw added by another can never be met by a reasonable UDP packet length. procedure Sendto (Socket : in Int; Buffer : in Octet_Array; Socket_Address : in Sockaddr) is I : Ssize_T := C_Sendto(Socket, Buffer'Address, Buffer'Length, 0, Socket_Address'Address, Sockaddr_Size); begin if I /= Buffer'Length then raise Sendto_Error; end if; end Sendto; procedure Recvfrom (Socket : in Int; Buffer : out Octet_Array; Socket_Address : in out Sockaddr; Length : out Size_T; Truncate_Length : in Boolean := True) is S : aliased Socklen_T := Sockaddr_Size; M : Int; I : Ssize_T; begin if Truncate_Length then M := 0; else M := MSG_TRUNC; end if; I := C_Recvfrom(Socket, Buffer'Address, Buffer'Length, M, Socket_Address'Address, S'Address); if I = -1 then raise Recvfrom_Error; else Length := Size_T(I); end if; end Recvfrom; -- I suppose I could've imported Close directly for the same result here, but I already wrote it. procedure Close (File_Descriptor : Int) is I : Int := C_Close(File_Descriptor); -- There's no need to check this function's return value. begin null; end Close; -- Each procedure here is rather like its twin, sans the String parameter type and some checking. -- I must add special checking to the bodies, since the type system won't enforce certain limits. -- I can't know Positive to be wholly compatible with Size_T, and this is that crux of the issue. -- I tried to use the following check, to find it wouldn't work: Buffer'Length >= Size_T'Modulus. -- In understanding why, I further learned that the type Integer isn't necessarily comprehensive. -- However, it's irrelevant and I won't play the game of tiptoeing around these vague types here. -- The smallest permitted size for size_t in the C language is sixteen bits, fifteen for Integer. -- The Ada compiler will bemoan a too large Integer, but I needn't check for adherence to Size_T. -- The largest UDP packet is a concrete limit, and I may nicely check against that limit instead. -- The underlying system might reject messages that hit this limit, but it will accept the calls. -- I originally wanted Recvfrom to fail with a too large buffer, but changed such to truncate it. -- In practice these limits will never be hit, because the UDP packets will be very much smaller. procedure Sendto (Socket : in Int; Buffer : in String; Socket_Address : in Sockaddr) is I : Ssize_T; begin if Buffer'Length >= 2**16 then raise Sendto_Error; end if; I := C_Sendto(Socket, Buffer'Address, Buffer'Length, 0, Socket_Address'Address, Sockaddr_Size); if I /= Buffer'Length then raise Sendto_Error; end if; end Sendto; procedure Recvfrom (Socket : in Int; Buffer : out String; Socket_Address : in out Sockaddr; Length : out Size_T; Truncate_Length : in Boolean := True) is S : aliased Socklen_T := Sockaddr_Size; M : Int; B : Size_T; I : Ssize_T; begin if Buffer'Length >= 2**16 then B := 2**16 - 1; else B := Buffer'Length; end if; if Truncate_Length then M := 0; else M := MSG_TRUNC; end if; I := C_Recvfrom(Socket, Buffer'Address, B, M, Socket_Address'Address, S'Address); if I = -1 then raise Recvfrom_Error; else Length := Size_T(I); end if; end Recvfrom; end POSIX_UDP_Garbage; .