-- Usable_Datagram_Package - Provide a UDP interface that should satisfy most any underlying system.
-- Copyright (C) 2022,2023,2024 Prince Trippy <programmer@verisimilitudes.net>.
-- 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 <http://www.gnu.org/licenses/>.
with System, Unchecked_Conversion, POSIX_UDP_Garbage; use POSIX_UDP_Garbage;
package body Usable_Datagram_Package is
function Uint32_To_Address is new Unchecked_Conversion(Source => Uint32_T, Target => Address);
function Address_To_Uint32 is new Unchecked_Conversion(Source => Address, Target => Uint32_T);
function To_Uint32_T (From : in Address) return Uint32_T is
use System;
A : Address := From;
for A'Alignment use Uint32_T'Alignment; -- This is probably overly-cautious but makes no harm.
begin
case Default_Bit_Order is
when High_Order_First => null;
when Low_Order_First => A := (A(4), A(3), A(2), A(1));
end case;
return Address_To_Uint32(A);
end To_Uint32_T;
function From_Uint32_T (From : in Uint32_T) return Address is
use System;
A : Address;
U : Uint32_T := From;
for A'Alignment use Uint32_T'Alignment;
begin
A := Uint32_To_Address(U);
case Default_Bit_Order is
when High_Order_First => null;
when Low_Order_First => A := (A(4), A(3), A(2), A(1));
end case;
return A;
end From_Uint32_T;
procedure Initialize (Object : in out System_Resource) is
S : Sockaddr := Make_Sockaddr(Address => 0, Port => Uint16_T(Object.Where));
begin
Socket(Object.Socket_Nonsense);
Bind(Socket => Object.Socket_Nonsense, Socket_Address => S);
exception -- Here's where I'd raise these with different messages, if Ada 2005 hadn't added that.
when Socket_Error => raise Sys_Error;
when Bind_Error => Close(Object.Socket_Nonsense); raise Sys_Error; -- This close was subtle.
end Initialize;
procedure Finalize (Object : in out System_Resource) is
begin
Close(Object.Socket_Nonsense);
end Finalize;
procedure Hit (By : in System_Resource;
Data : in Octet_Array;
To : in Address;
At_Port : in Port) is
S : Sockaddr := Make_Sockaddr(Address => To_Uint32_T(To), Port => Uint16_T(At_Port));
begin
Sendto(Socket => By.Socket_Nonsense, Socket_Address => S,
Buffer => POSIX_UDP_Garbage.Octet_Array(Data));
exception
when Sendto_Error => raise Hit_Error;
end Hit;
procedure Get (By : in System_Resource;
Data : out Octet_Array;
From : out Address;
From_Port : out Port;
Fitting : in Fit := Equals) is
S : Sockaddr;
I : Interfaces.C.Size_T;
B : array (Fit) of Boolean := (Equals => False, Larger => True,
Lesser => False, Ignore => True);
begin
Recvfrom(Socket => By.Socket_Nonsense, Buffer => POSIX_UDP_Garbage.Octet_Array(Data),
Length => I, Socket_Address => S, Truncate_Length => B(Fitting)); -- Quite befitting.
From := From_Uint32_T(Sockaddr_Address(S));
From_Port := Port(Sockaddr_Port(S));
case Fitting is
when Equals => if Integer(I) /= Data'Length then raise Fit_Error; end if;
when Larger => if Integer(I) < Data'Length then raise Fit_Error; end if;
when Lesser => if Integer(I) > Data'Length then raise Fit_Error; end if;
when Ignore => null;
end case;
exception
when Recvfrom_Error => raise Get_Error;
end Get;
procedure Get (By : in System_Resource;
Data : out Octet_Array;
From : out Address;
From_Port : out Port;
Length : out Data_Length) is
S : Sockaddr;
I : Interfaces.C.Size_T;
begin
Recvfrom(Socket => By.Socket_Nonsense, Buffer => POSIX_UDP_Garbage.Octet_Array(Data),
Length => I, Socket_Address => S, Truncate_Length => False);
From := From_Uint32_T(Sockaddr_Address(S));
From_Port := Port(Sockaddr_Port(S));
Length := Data_Length(I);
exception
when Recvfrom_Error => raise Get_Error;
end Get;
procedure Get (By : in System_Resource;
Data : out Octet_Array;
From : out Address;
From_Port : out Port;
Padding : in Interfaces.Unsigned_8) is
S : Sockaddr;
I : Interfaces.C.Size_T;
begin
Recvfrom(Socket => By.Socket_Nonsense, Buffer => POSIX_UDP_Garbage.Octet_Array(Data),
Length => I, Socket_Address => S);
From := From_Uint32_T(Sockaddr_Address(S));
From_Port := Port(Sockaddr_Port(S));
Data(Data'First + Data_Length(I) .. Data'Last) := (others => Padding);
exception
when Recvfrom_Error => raise Get_Error;
end Get;
-- These procedures are mostly like their counterparts, except for the different parameter lists.
-- All special and required checks about the length of a String are handled in POSIX_UDP_Garbage.
procedure Hit (By : in System_Resource;
Data : in String;
To : in Address;
At_Port : in Port) is
S : Sockaddr := Make_Sockaddr(Address => To_Uint32_T(To), Port => Uint16_T(At_Port));
begin
Sendto(Socket => By.Socket_Nonsense, Socket_Address => S, Buffer => Data);
exception
when Sendto_Error => raise Hit_Error;
end Hit;
procedure Get (By : in System_Resource;
Data : out String;
From : out Address;
From_Port : out Port;
Fitting : in Fit := Equals) is
S : Sockaddr;
I : Interfaces.C.Size_T;
B : array (Fit) of Boolean := (Equals => False, Larger => True,
Lesser => False, Ignore => True);
begin
Recvfrom(Socket => By.Socket_Nonsense, Buffer => Data,
Length => I, Socket_Address => S, Truncate_Length => B(Fitting));
From := From_Uint32_T(Sockaddr_Address(S));
From_Port := Port(Sockaddr_Port(S));
case Fitting is
when Equals => if Integer(I) /= Data'Length then raise Fit_Error; end if;
when Larger => if Integer(I) < Data'Length then raise Fit_Error; end if;
when Lesser => if Integer(I) > Data'Length then raise Fit_Error; end if;
when Ignore => null;
end case;
exception
when Recvfrom_Error => raise Get_Error;
end Get;
procedure Get (By : in System_Resource;
Data : out String;
From : out Address;
From_Port : out Port;
Length : out Data_Length) is
S : Sockaddr;
I : Interfaces.C.Size_T;
begin
Recvfrom(Socket => By.Socket_Nonsense, Buffer => Data,
Length => I, Socket_Address => S, Truncate_Length => False);
From := From_Uint32_T(Sockaddr_Address(S));
From_Port := Port(Sockaddr_Port(S));
Length := Data_Length(I);
exception
when Recvfrom_Error => raise Get_Error;
end Get;
procedure Get (By : in System_Resource;
Data : out String;
From : out Address;
From_Port : out Port;
Padding : in Character) is
S : Sockaddr;
I : Interfaces.C.Size_T;
begin
Recvfrom(Socket => By.Socket_Nonsense, Buffer => Data, Length => I, Socket_Address => S);
From := From_Uint32_T(Sockaddr_Address(S));
From_Port := Port(Sockaddr_Port(S));
Data(Data'First + Data_Length(I) .. Data'Last) := (others => Padding);
exception
when Recvfrom_Error => raise Get_Error;
end Get;
end Usable_Datagram_Package;