-- POSIX_TCP_Garbage - Provide bindings for the disgusting filth POSIX requires to send TCP packets.
-- Copyright (C) 2022,2023 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, Interfaces.C; use Interfaces.C;

package body POSIX_TCP_Garbage is
   -- This code is similar, or identical, to that which can be found commented in POSIX_UDP_Garbage.
   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_Send (Socket        : in Int;
                    Buffer        : in System.Address;
                    Buffer_Length : in Size_T;
                    Flags         : in Int) return Ssize_T;
   pragma Import(Convention => C, Entity => C_Send, External_Name => "send");

   function C_Recv (Socket        : in Int;
                    Buffer        : in System.Address;
                    Buffer_Length : in Size_T;
                    Flags         : in Int) return Ssize_T;
   pragma Import(Convention => C, Entity => C_Recv, External_Name => "recv");

   procedure C_Listen (Socket : in Int; Backlog : in Int);
   pragma Import(Convention => C, Entity => C_Listen, External_Name => "listen");

   function C_Connect (Socket           : in Int;
                       Sockaddr_Address : in System.Address;
                       Sockaddr_Length  : in Socklen_T) return Int;
   pragma Import(Convention => C, Entity => C_Connect, External_Name => "connect");

   function C_Accept (Socket           : in Int;
                      Sockaddr_Address : in System.Address;
                      Sockaddr_Length  : in Socklen_T) return Int;
   pragma Import(Convention => C, Entity => C_Accept, External_Name => "accept");

   procedure C_Shutdown (Socket : in Int; How : in Int);
   pragma Import(Convention => C, Entity => C_Shutdown, External_Name => "shutdown");

   function Make_Sockaddr (Address : in Uint32_T; Port : in Uint16_T) return Sockaddr is
      function Htons (Data : in Uint16_T) return Uint16_T;
      function Htonl (Data : in Uint32_T) return Uint32_T;
      pragma Import(Convention => C, Entity => Htons, External_Name => "htons");
      pragma Import(Convention => C, Entity => Htonl, External_Name => "htonl");
   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
      function Ntohl (Data : in Uint32_T) return Uint32_T;
      pragma Import(Convention => C, Entity => Ntohl, External_Name => "ntohl");
   begin
      return Ntohl(Socket_Address.Sin_Addr);
   end Sockaddr_Address;

   function Sockaddr_Port (Socket_Address : in Sockaddr) return Uint16_T is
      function Ntohs (Data : in Uint16_T) return Uint16_T;
      pragma Import(Convention => C, Entity => Ntohs, External_Name => "ntohs");
   begin
      return Ntohs(Socket_Address.Sin_Port);
   end Sockaddr_Port;

   procedure Socket (Socket : out Int) is
      I : Int := C_Socket(Domain => AF_INET, Socket_Type => SOCK_STREAM, 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;

   procedure Send (Socket : in Int; Buffer : in Octet_Array; Length : out Size_T) is
      I : Ssize_T := C_Send(Socket, Buffer'Address, Buffer'Length, MSG_NOSIGNAL);
   begin
      if I = -1 then raise Send_Error; else Length := Size_T(I); end if;
   end Send;

   procedure Recv (Socket : in Int; Buffer : out Octet_Array; Length : out Size_T) is
      I : Ssize_T := C_Recv(Socket, Buffer'Address, Buffer'Length, 0);
   begin
      if I = -1 then raise Recv_Error; else Length := Size_T(I); end if;
   end Recv;

   -- These String procedures depend upon the size of a String never exceeding the bounds of Size_T.
   procedure Send (Socket : in Int; Buffer : in String; Length : out Size_T) is
      I : Ssize_T := C_Send(Socket, Buffer'Address, Buffer'Length, MSG_NOSIGNAL);
   begin
      if I = -1 then raise Send_Error; else Length := Size_T(I); end if;
   end Send;

   procedure Recv (Socket : in Int; Buffer : out String; Length : out Size_T) is
      I : Ssize_T := C_Recv(Socket, Buffer'Address, Buffer'Length, 0);
   begin
      if I = -1 then raise Recv_Error; else Length := Size_T(I); end if;
   end Recv;

   procedure Listen (Socket : in Int) is
   begin
      C_Listen(Socket, Backlog => Int'Last); -- A backlog parameter is both not needed, and ignored.
   end Listen;

   procedure Intake (Socket : in Int; Socket_Address : out Sockaddr; Connection : out Int) is
      I : Int := C_Accept(Socket, Socket_Address'Address, Sockaddr_Size);
   begin
      Connection := I;
      if I = -1 then raise Accept_Error; end if;
   end Intake;

   procedure Connect (Socket : in Int; Socket_Address : in Sockaddr) is
      I : Int := C_Connect(Socket, Socket_Address'Address, Sockaddr_Size);
   begin
      if I = -1 then raise Connect_Error; end if;
   end Connect;

   -- I've checked to find the how parameter of shutdown may only use the values one, two, or three.
   -- With some variants I've seen, there's not even some shitty C language enumeration type for it.
   -- The idiots leading these systems can't change the values, since too many programs would break.
   -- The body of mostly-working programs is, of course, the one reason anyone deals with this shit.
   -- I hate these vermin who pat themselves on the back for a grotesque system without abstraction.
   procedure Shutdown (Socket : in Int; How : in Mode) is
   begin
      C_Shutdown(Socket, Mode'Pos(How));
   end Shutdown;
end POSIX_TCP_Garbage;
.