diff -uNr a/smg_comms/libudp/lib/README b/smg_comms/libudp/lib/README --- a/smg_comms/libudp/lib/README false +++ b/smg_comms/libudp/lib/README 5fdbae897eb301a711bf95707f329517db540e34c182a5beec96e93d5d0d856cec2ed6b01c1191f865e8d1c45709a462c70c3005d4aa3676eb445d1479edf2e5 @@ -0,0 +1 @@ +Placeholder. diff -uNr a/smg_comms/libudp/obj/README b/smg_comms/libudp/obj/README --- a/smg_comms/libudp/obj/README false +++ b/smg_comms/libudp/obj/README 5fdbae897eb301a711bf95707f329517db540e34c182a5beec96e93d5d0d856cec2ed6b01c1191f865e8d1c45709a462c70c3005d4aa3676eb445d1479edf2e5 @@ -0,0 +1 @@ +Placeholder. diff -uNr a/smg_comms/libudp/restrict.adc b/smg_comms/libudp/restrict.adc --- a/smg_comms/libudp/restrict.adc false +++ b/smg_comms/libudp/restrict.adc 0ce47e877e69cdc718556d94802736a36d5289bac7d5c58f4faffc75f0fe8f461f4799705e9b29f89e071c51141bd88b2d73917271170f7fd771ed288ad07215 @@ -0,0 +1,83 @@ +------------------------------------------------------------------------------ +------------------------------------------------------------------------------ +-- This file is part of 'UDP', a datagram sockets library. -- +-- -- +-- (C) 2018 Stanislav Datskovskiy ( www.loper-os.org ) -- +-- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html -- +-- -- +-- You do not have, nor can you ever acquire the right to use, copy or -- +-- distribute this software ; Should you use this software for any purpose, -- +-- or copy and distribute it to anyone or in any manner, you are breaking -- +-- the laws of whatever soi-disant jurisdiction, and you promise to -- +-- continue doing so for the indefinite future. In any case, please -- +-- always : read and understand any software ; verify any PGP signatures -- +-- that you use - for any purpose. -- +-- -- +-- See also http://trilema.com/2015/a-new-software-licensing-paradigm . -- +------------------------------------------------------------------------------ +------------------------------------------------------------------------------ + +pragma Restrictions(Immediate_Reclamation); +pragma Restrictions(Max_Asynchronous_Select_Nesting => 0); +pragma Restrictions(Max_Protected_Entries => 0); +pragma Restrictions(Max_Select_Alternatives => 0); +pragma Restrictions(Max_Task_Entries => 0); +pragma Restrictions(Max_Tasks => 0); +pragma Restrictions(No_Abort_Statements); +pragma Restrictions(No_Access_Parameter_Allocators); +pragma Restrictions(No_Allocators); +pragma Restrictions(No_Asynchronous_Control); +pragma Restrictions(No_Calendar); +pragma Restrictions(No_Coextensions); +pragma Restrictions(No_Default_Stream_Attributes); +pragma Restrictions(No_Delay); +pragma Restrictions(No_Dispatch); +pragma Restrictions(No_Dispatching_Calls); +pragma Restrictions(No_Dynamic_Attachment); +pragma Restrictions(No_Dynamic_Priorities); +pragma Restrictions(No_Entry_Calls_In_Elaboration_Code); +pragma Restrictions(No_Entry_Queue); +pragma Restrictions(No_Enumeration_Maps); +pragma Restrictions(No_Exception_Propagation); +pragma Restrictions(No_Exception_Registration); +pragma Restrictions(No_Finalization); +pragma Restrictions(No_Fixed_Io); +pragma Restrictions(No_Floating_Point); +pragma Restrictions(No_Implementation_Aspect_Specifications); +pragma Restrictions(No_Implementation_Units); +pragma Restrictions(No_Implicit_Conditionals); +pragma Restrictions(No_Implicit_Dynamic_Code); +pragma Restrictions(No_Implicit_Heap_Allocations); +pragma Restrictions(No_Implicit_Protected_Object_Allocations); +pragma Restrictions(No_Implicit_Task_Allocations); +pragma Restrictions(No_Initialize_Scalars); +pragma Restrictions(No_Local_Protected_Objects); +pragma Restrictions(No_Local_Timing_Events); +pragma Restrictions(No_Multiple_Elaboration); +pragma Restrictions(No_Nested_Finalization); +pragma Restrictions(No_Protected_Type_Allocators); +pragma Restrictions(No_Protected_Types); +pragma Restrictions(No_Relative_Delay); +pragma Restrictions(No_Requeue_Statements); +pragma Restrictions(No_Secondary_Stack); +pragma Restrictions(No_Select_Statements); +pragma Restrictions(No_Specific_Termination_Handlers); +pragma Restrictions(No_Standard_Allocators_After_Elaboration); +pragma Restrictions(No_Stream_Optimizations); +pragma Restrictions(No_Streams); +pragma Restrictions(No_Task_Allocators); +pragma Restrictions(No_Task_At_Interrupt_Priority); +pragma Restrictions(No_Task_Attributes_Package); +pragma Restrictions(No_Task_Hierarchy); +pragma Restrictions(No_Tasking); +pragma Restrictions(No_Task_Termination); +pragma Restrictions(No_Terminate_Alternatives); +pragma Restrictions(No_Unchecked_Access); +pragma Restrictions(No_Unchecked_Conversion); +pragma Restrictions(No_Unchecked_Deallocation); +pragma Restrictions(No_Wide_Characters); +pragma Restrictions(Pure_Barriers); +pragma Restrictions(Simple_Barriers); +pragma Restrictions(Static_Priorities); +pragma Restrictions(Static_Storage_Size); +pragma Validity_Checks(ALL_CHECKS); diff -uNr a/smg_comms/libudp/udp.adb b/smg_comms/libudp/udp.adb --- a/smg_comms/libudp/udp.adb false +++ b/smg_comms/libudp/udp.adb de0cec9ced66f9d083e9c7dd1f2e02586e36481701f3b8c988f500f521454dc8ca51797961e1e773edffb7a96ad6d9b4f277b47aab056b7e313c23b8677baff3 @@ -0,0 +1,142 @@ +------------------------------------------------------------------------------ +------------------------------------------------------------------------------ +-- This file is part of 'UDP', a datagram sockets library. -- +-- -- +-- (C) 2018 Stanislav Datskovskiy ( www.loper-os.org ) -- +-- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html -- +-- -- +-- You do not have, nor can you ever acquire the right to use, copy or -- +-- distribute this software ; Should you use this software for any purpose, -- +-- or copy and distribute it to anyone or in any manner, you are breaking -- +-- the laws of whatever soi-disant jurisdiction, and you promise to -- +-- continue doing so for the indefinite future. In any case, please -- +-- always : read and understand any software ; verify any PGP signatures -- +-- that you use - for any purpose. -- +-- -- +-- See also http://trilema.com/2015/a-new-software-licensing-paradigm . -- +------------------------------------------------------------------------------ +------------------------------------------------------------------------------ + +package body UDP is + + -- Generate a human representation of a (local-endian) IP Address + function IP_To_String(IP : in IP_Address) return IP_Address_Text is + Text : IP_Address_Text := (others => ' '); + begin + Unix_UDP_IP_To_String(IP, Text'Address, Text'Length); + return Text; + end IP_To_String; + + + -- Generate a (local-endian) IP Address from given human representation + function IP_From_String(IP_Text : in String) return IP_Address is + Text_With_Null : String(1 .. IP_Text'Length + 1); + Result : Interfaces.C.Int := 0; + IP : aliased IP_Address; + begin + -- We can't use To_C because malicious idiots demanded secondary stack. + Text_With_Null(IP_Text'Range) := IP_Text; + Text_With_Null(Text_With_Null'Last) := Character'Val(0); + + -- Let unix do the conversion + Result := Unix_UDP_String_To_IP(Text_With_Null'Address, + IP'Access); + case Result is + when -1 => + raise UDP_Invalid_Text_IP; + when others => + return IP; + end case; + end IP_From_String; + + + -- Open a UDP socket, with the given local endpoint for both TX and RX + procedure Open_Socket(S : out Socket; + Local_Endpoint : in Endpoint) is + Result : constant Interfaces.C.Int := + Unix_UDP_Socket_Open(Socket => S'Address, + Local_IP => Local_Endpoint.Address, + Local_Port => Local_Endpoint.Port); + begin + case Result is + when -1 => + raise UDP_Failed_Open; + when -2 => + raise UDP_Failed_SetOpt; + when -3 => + raise UDP_Failed_Bind; + when others => + null; + end case; + end Open_Socket; + + + -- Permanently close the given open socket + procedure Close_Socket(S : in out Socket) is + begin + Unix_UDP_Socket_Close(Socket => S'Address); + end Close_Socket; + + + -- Transmit the Payload, via Socket, to given Destination + procedure Transmit(S : in out Socket; + Destination : in Endpoint; + Payload_Buf : in Payload) is + Result : constant Interfaces.C.Int := + Unix_UDP_Socket_Transmit(Socket => S'Address, + Remote_IP => Destination.Address, + Remote_Port => Destination.Port, + Payload_Buf => Payload_Buf'Address, + Payload_Len => Payload'Length); + begin + case Result is + when -1 => + Close_Socket(S); + raise UDP_Failed_Transmit; + when others => + -- No eggog, but must check if sent all bytes: + if (Result /= Payload'Length) then + Close_Socket(S); + raise UDP_Truncated_Send; + end if; + end case; + end Transmit; + + + -- Wait (potentially forever!) for a Payload, via Socket; save its Origin + procedure Receive(S : in out Socket; + Origin : out Endpoint; + Payload_Buf : out Payload; + Valid : out Boolean) is + + -- Scratch pad (if not successful, the call has no outputs) + Incoming_Payload : aliased Payload := (others => 0); + Incoming_IP : aliased IP_Address; + Incoming_Port : aliased IP_Port; + + Result : constant Interfaces.C.Int := + Unix_UDP_Socket_Receive(Socket => S'Address, + Origin_IP => Incoming_IP'Access, + Origin_Port => Incoming_Port'Access, + Payload_Buf => Incoming_Payload'Address, + Payload_Len => Payload'Length); + begin + Valid := False; + case Result is + when -1 => + Close_Socket(S); + raise UDP_Failed_Receive; + when others => + -- No eggog: + Origin.Address := Incoming_IP; + Origin.Port := Incoming_Port; + Payload_Buf := Incoming_Payload; + + -- Was a full-length payload? + if (Result = Payload'Length) then + Valid := True; + end if; + end case; + end Receive; + +end UDP; diff -uNr a/smg_comms/libudp/udp.ads b/smg_comms/libudp/udp.ads --- a/smg_comms/libudp/udp.ads false +++ b/smg_comms/libudp/udp.ads 05f7f7804320f48222e6492be0b801ad1abbccadb9040bc1e31422001a38410945a69787e089309f2cde6c5cdae85918ae52e4efebebe803193bf7e8a2fa854a @@ -0,0 +1,148 @@ +------------------------------------------------------------------------------ +------------------------------------------------------------------------------ +-- This file is part of 'UDP', a datagram sockets library. -- +-- -- +-- (C) 2018 Stanislav Datskovskiy ( www.loper-os.org ) -- +-- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html -- +-- -- +-- You do not have, nor can you ever acquire the right to use, copy or -- +-- distribute this software ; Should you use this software for any purpose, -- +-- or copy and distribute it to anyone or in any manner, you are breaking -- +-- the laws of whatever soi-disant jurisdiction, and you promise to -- +-- continue doing so for the indefinite future. In any case, please -- +-- always : read and understand any software ; verify any PGP signatures -- +-- that you use - for any purpose. -- +-- -- +-- See also http://trilema.com/2015/a-new-software-licensing-paradigm . -- +------------------------------------------------------------------------------ +------------------------------------------------------------------------------ + +with Interfaces, Interfaces.C; use Interfaces, Interfaces.C; +with System; use System; + +generic + Payload_Size : in Positive; --to allow for Serpent/RSA different sizes + +package UDP is + + pragma Preelaborate; + + type Payload is array(1 .. Payload_Size) of Unsigned_8; + + subtype IP_Address is Unsigned_32; + subtype IP_Port is Unsigned_16; + + -- Magic that puts emitter on 'any' local interface + INADDR_ANY : constant Unsigned_32 := 0; + + -- An local or remote address:port + type Endpoint is + record + Address : IP_Address; + Port : IP_Port; + end record; + -- NOTE that both elements are stored in ~local~ endianness. + + -- Human Representation of any valid IP Address + subtype IP_Address_Text is String(1 .. 15); + + -- Opaque unix turd that stores a socket's state + type Socket is private; + + -- The public API: + + -- Generate a human representation of a (local-endian) IP Address + function IP_To_String(IP : in IP_Address) return IP_Address_Text; + + -- Generate a (local-endian) IP Address from given human representation + function IP_From_String(IP_Text : in String) return IP_Address; + + -- Open a UDP socket, with the given local endpoint for both TX and RX + procedure Open_Socket(S : out Socket; + Local_Endpoint : in Endpoint); + + -- Permanently close the given open socket + procedure Close_Socket(S : in out Socket); + + -- Transmit the Payload, via Socket, to given Destination + procedure Transmit(S : in out Socket; + Destination : in Endpoint; + Payload_Buf : in Payload); + + -- Wait (potentially forever!) for a Payload, via Socket; save its Origin, + -- and whether the received Payload was valid (i.e. expected length): + procedure Receive(S : in out Socket; + Origin : out Endpoint; + Payload_Buf : out Payload; + Valid : out Boolean); + + -- Eggogology: + UDP_Invalid_Text_IP : exception; + UDP_Failed_Open : exception; + UDP_Failed_SetOpt : exception; + UDP_Failed_Bind : exception; + UDP_Failed_Transmit : exception; + UDP_Truncated_Send : exception; + UDP_Failed_Receive : exception; + +private + + -- 'nicht fuer gefingerpoken und mittengrabben!' + + -- This record's elements are not accessed from ada: + type sockaddr_in is record + family : Unsigned_16; + port : Unsigned_16; + sin_addr : Unsigned_32; + padding : Unsigned_64; + end record; + pragma Convention(C, sockaddr_in); + + -- Here we also don't care about the elements, only total mass: + type Socket is + record + SA : sockaddr_in; + FD : Interfaces.C.int; + end record; + pragma Convention(C, Socket); + + -- Everything below -- imports from unix_udp.c: + + procedure Unix_UDP_IP_To_String + (IP : Unsigned_32; + Output_Buffer : System.Address; + Output_Buffer_Size : Unsigned_32); + pragma Import(C, Unix_UDP_IP_To_String, "unix_udp_ip_to_string"); + + function Unix_UDP_String_To_IP + (Input_Buffer : System.Address; + IP : not null access Unsigned_32) return Interfaces.C.int; + pragma Import(C, Unix_UDP_String_To_IP, "unix_udp_string_to_ip"); + + function Unix_UDP_Socket_Open + (Socket : System.Address; + Local_IP : Unsigned_32; + Local_Port : Unsigned_16) return Interfaces.C.int; + pragma Import(C, Unix_UDP_Socket_Open, "unix_udp_socket_open"); + + procedure Unix_UDP_Socket_Close + (Socket : System.Address); + pragma Import(C, Unix_UDP_Socket_Close, "unix_udp_socket_close"); + + function Unix_UDP_Socket_Transmit + (Socket : System.Address; + Remote_IP : Unsigned_32; + Remote_Port : Unsigned_16; + Payload_Buf : System.Address; + Payload_Len : Unsigned_32) return Interfaces.C.int; + pragma Import(C, Unix_UDP_Socket_Transmit, "unix_udp_socket_transmit"); + + function Unix_UDP_Socket_Receive + (Socket : System.Address; + Origin_IP : not null access Unsigned_32; + Origin_Port : not null access Unsigned_16; + Payload_Buf : System.Address; + Payload_Len : Unsigned_32) return Interfaces.C.int; + pragma Import(C, Unix_UDP_Socket_Receive, "unix_udp_socket_receive"); + +end UDP; diff -uNr a/smg_comms/libudp/udp.gpr b/smg_comms/libudp/udp.gpr --- a/smg_comms/libudp/udp.gpr false +++ b/smg_comms/libudp/udp.gpr 8547b598d4310c0a25ed8feb79159195e97c8b4546f7e5099490e5fdfb83e4f2869eee9efc77a0fd24448308192059252f986fa2b14b7de67ff3686eb422554c @@ -0,0 +1,74 @@ +------------------------------------------------------------------------------ +------------------------------------------------------------------------------ +-- This file is part of 'UDP', a datagram sockets library. -- +-- -- +-- (C) 2018 Stanislav Datskovskiy ( www.loper-os.org ) -- +-- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html -- +-- -- +-- You do not have, nor can you ever acquire the right to use, copy or -- +-- distribute this software ; Should you use this software for any purpose, -- +-- or copy and distribute it to anyone or in any manner, you are breaking -- +-- the laws of whatever soi-disant jurisdiction, and you promise to -- +-- continue doing so for the indefinite future. In any case, please -- +-- always : read and understand any software ; verify any PGP signatures -- +-- that you use - for any purpose. -- +-- -- +-- See also http://trilema.com/2015/a-new-software-licensing-paradigm . -- +------------------------------------------------------------------------------ +------------------------------------------------------------------------------ + +project UDP is + + for Object_Dir use "obj"; + + type Mode_Type is ("debug", "release"); + Mode : Mode_Type := external ("mode", "release"); + + for Languages use ("Ada", "C"); + for Source_Dirs use ("."); + for Library_Dir use "lib"; + for Library_Name use "UDP"; + for Library_Kind use "static"; + + package Compiler is + for Leading_Required_Switches ("C") use ("-c"); + for Object_File_Suffix ("C") use ".o"; + for Include_Switches ("C") use ("-I"); + + case Mode is + when "debug" => + for Switches ("Ada") + use ("-g"); + when "release" => + for Switches ("Ada") + use ("-O2", "-fdump-scos", "-gnata", "-fstack-check", + "-gnatyd", "-gnatym", + "-fdata-sections", "-ffunction-sections", "-gnatwr", "-gnatw.d", + "-gnatec=" & UDP'Project_Dir & "restrict.adc"); + for Switches ("C") + use ("-O2", "-Wall", "-fstack-check"); + end case; + end Compiler; + + package Naming is + for Spec_Suffix ("C") use ".h"; + for Body_Suffix ("C") use ".c"; + end Naming; + + package Builder is + for Switches ("Ada") + use ("-nostdlib"); + end Builder; + + package Binder is + case Mode is + when "debug" => + for Switches ("Ada") + use (); + when "release" => + for Switches ("Ada") + use ("-static"); + end case; + end Binder; + +end UDP; diff -uNr a/smg_comms/libudp/unix_udp.c b/smg_comms/libudp/unix_udp.c --- a/smg_comms/libudp/unix_udp.c false +++ b/smg_comms/libudp/unix_udp.c 392dc3bbebb8ba295916d8ea5ab5cfb2ce44fac68ccd209f4a088d3bc812b9b8bae712599cd0481146ff7db530400882cbf72bc36c637e895430c3e82aa55410 @@ -0,0 +1,146 @@ +/* +------------------------------------------------------------------------------ +------------------------------------------------------------------------------ +-- This file is part of 'UDP', a datagram sockets library. -- +-- -- +-- (C) 2018 Stanislav Datskovskiy ( www.loper-os.org ) -- +-- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html -- +-- -- +-- You do not have, nor can you ever acquire the right to use, copy or -- +-- distribute this software ; Should you use this software for any purpose, -- +-- or copy and distribute it to anyone or in any manner, you are breaking -- +-- the laws of whatever soi-disant jurisdiction, and you promise to -- +-- continue doing so for the indefinite future. In any case, please -- +-- always : read and understand any software ; verify any PGP signatures -- +-- that you use - for any purpose. -- +-- -- +-- See also http://trilema.com/2015/a-new-software-licensing-paradigm . -- +------------------------------------------------------------------------------ +------------------------------------------------------------------------------ +*/ + +#include +#include +#include +#include +#include +#include + + +/* Socket state representation: */ +typedef struct _UDP_Socket { + struct sockaddr_in sa_local; + int sock; +} UDP_Socket; + + +/* local-endian ip to string conversion */ +void unix_udp_ip_to_string(uint32_t ip, char *buf, uint32_t buf_size) { + struct in_addr addr; + addr.s_addr = htonl(ip); + char *txt = inet_ntoa(addr); + /* Given IP might be shorter than buf_size so don't copy blindly. */ + int len = strlen(txt); + /* ONTH don't ever copy more than buf_size either */ + if (len > buf_size) + len = buf_size; + strncpy(buf, txt, len); +} +/* Should be replaced with native routine */ + + +/* string to local-endian ip conversion */ +int unix_udp_string_to_ip(char *buf, uint32_t *ip) { + struct in_addr addr; + if (inet_aton(buf, &addr) <= 0) + return -1; + *ip = ntohl(addr.s_addr); + return 0; +} +/* Should be replaced with native routine */ + + +int unix_udp_socket_open(UDP_Socket *S, + uint32_t local_ip, uint16_t local_port) { + /* Open the socket FD: */ + if ((S->sock = socket(AF_INET, SOCK_DGRAM, IPPROTO_UDP)) < 0) { + return -1; + } + + memset(&S->sa_local, 0, sizeof(struct sockaddr_in)); + + /* Set up emitter endpoint, converting from local endianness: */ + S->sa_local.sin_family = AF_INET; + S->sa_local.sin_addr.s_addr = htonl(local_ip); + S->sa_local.sin_port = htons(local_port); + + /* Cure the asinine linuxism where dead sockets interfere with living: */ + int one = 1; + if (setsockopt(S->sock, SOL_SOCKET, SO_REUSEADDR, &one, sizeof(one)) < 0) { + close(S->sock); + return -2; + } + + /* Bind the socket */ + if (bind(S->sock, + (struct sockaddr *)&(S->sa_local), sizeof(S->sa_local)) < 0) { + close(S->sock); + return -3; + } + + /* ok */ + return 0; +} + + +void unix_udp_socket_close(UDP_Socket *S) { + close(S->sock); +} + + +int unix_udp_socket_transmit(UDP_Socket *S, + uint32_t remote_ip, uint16_t remote_port, + uint8_t *payload, uint32_t payload_len) { + int bytes_sent = 0; + struct sockaddr_in remote_addr; + memset((char *)&remote_addr, 0, sizeof(remote_addr)); + + /* Set up dest endpoint, converting from local endianness: */ + remote_addr.sin_family = AF_INET; + remote_addr.sin_port = htons(remote_port); + remote_addr.sin_addr.s_addr = htonl(remote_ip); + + /* Transmit Datagram */ + bytes_sent = sendto(S->sock, payload, payload_len, + 0, /* no flags */ + (struct sockaddr*)&remote_addr, + sizeof(remote_addr)); + if (bytes_sent <= 0) + return -1; + + return bytes_sent; +} + + +int unix_udp_socket_receive(UDP_Socket *S, + uint32_t *origin_ip, uint16_t *origin_port, + uint8_t *payload, uint32_t payload_len) { + int bytes_received = 0; + struct sockaddr_in orig_addr; + socklen_t orig_addr_len = sizeof(orig_addr); + memset((char *)&orig_addr, 0, sizeof(orig_addr)); + + /* Receive Datagram (blocking!) */ + bytes_received = recvfrom(S->sock, payload, payload_len, + 0, /* no flags */ + (struct sockaddr *)&orig_addr, + &orig_addr_len); + + if (bytes_received < 0) return -1; + + /* Save the originator's endpoint in ~local~ endianness */ + *origin_ip = ntohl(orig_addr.sin_addr.s_addr); + *origin_port = ntohs(orig_addr.sin_port); + + return bytes_received; +} diff -uNr a/smg_comms/manifest b/smg_comms/manifest --- a/smg_comms/manifest 58a5a4d81e10e1017a43df99ec183c85d77223cbae6d3657a5c6b87d8325650dde3c63bd0bf9598d84e5c0f87626820763af763714194b71767c74f0524d39ad +++ b/smg_comms/manifest 8755a59576bcea60f804cfa24630a8f23391ef5bef12a1d061a5a7f883e71d73b6c61bdd49be9f5aa68f3e6cde0e6b3b0595cc3c403b0df494dc0d7393a56934 @@ -11,3 +11,4 @@ 551086 smg_comms_files diana_coman Adds read/write for File Transfer (4.3) and File Request (4.4). Refactors the rest to have read/write of 16 bits values in one single place (i.e. separate method called from everywhere else) because of how common it is + sensitive to endianness. 551832 smg_comms_actions_rsa diana_coman Adds read/write for RSA keys (5.1) and Client Action (4.5). Refactors to allow choice of padding and enable direct testing of private procedure in Messages. 552633 smg_comms_shorter_e diana_coman Changes to support arbitrary size of public exponent both at key generation time (rsa.c) and at use for packing/unpacking messages. Also adds required changes to c_wrappers to work around the idiocy in MPI lib that means it will get stuck in endless loop in some cases when the buffer of an mpi is set to 0-leading values. +553641 smg_comms_queue diana_coman Adds a protected queue type that allows thread-safe put/get of items (meant to be messages). diff -uNr a/smg_comms/restrict.adc b/smg_comms/restrict.adc --- a/smg_comms/restrict.adc 8d73d5adc05be61c685c3f7123733fa7f032043684d5703dda4ae9092d4de5513226538bcf7256a9926db2f860ce5acc8c4b2a5739f12d88c0f47436c6325674 +++ b/smg_comms/restrict.adc 18c7ebed8adc661b7612b8484f8bce63ef26e9ca68db4060ec66be64d9a38f939db03d0396ca107d53a6f2eed44efeda224da5d3b4acb9fa5e1667a5ad3def1b @@ -1,9 +1,9 @@ pragma Restrictions(Immediate_Reclamation); pragma Restrictions(Max_Asynchronous_Select_Nesting => 0); -pragma Restrictions(Max_Protected_Entries => 0); -pragma Restrictions(Max_Select_Alternatives => 0); -pragma Restrictions(Max_Task_Entries => 0); -pragma Restrictions(Max_Tasks => 0); +--pragma Restrictions(Max_Protected_Entries => 0); +--pragma Restrictions(Max_Select_Alternatives => 0); +--pragma Restrictions(Max_Task_Entries => 0); +--pragma Restrictions(Max_Tasks => 0); pragma Restrictions(No_Abort_Statements); pragma Restrictions(No_Access_Parameter_Allocators); pragma Restrictions(No_Allocators); @@ -37,11 +37,11 @@ pragma Restrictions(No_Multiple_Elaboration); pragma Restrictions(No_Nested_Finalization); pragma Restrictions(No_Protected_Type_Allocators); -pragma Restrictions(No_Protected_Types); +--pragma Restrictions(No_Protected_Types); pragma Restrictions(No_Relative_Delay); pragma Restrictions(No_Requeue_Statements); pragma Restrictions(No_Secondary_Stack); -pragma Restrictions(No_Select_Statements); +--pragma Restrictions(No_Select_Statements); pragma Restrictions(No_Specific_Termination_Handlers); pragma Restrictions(No_Standard_Allocators_After_Elaboration); pragma Restrictions(No_Stream_Optimizations); @@ -49,8 +49,8 @@ pragma Restrictions(No_Task_Allocators); pragma Restrictions(No_Task_At_Interrupt_Priority); pragma Restrictions(No_Task_Attributes_Package); -pragma Restrictions(No_Task_Hierarchy); -pragma Restrictions(No_Tasking); +--pragma Restrictions(No_Task_Hierarchy); +--pragma Restrictions(No_Tasking); pragma Restrictions(No_Task_Termination); pragma Restrictions(No_Terminate_Alternatives); pragma Restrictions(No_Unchecked_Access); @@ -58,7 +58,7 @@ pragma Restrictions(No_Unchecked_Deallocation); pragma Restrictions(No_Wide_Characters); pragma Restrictions(Pure_Barriers); -pragma Restrictions(Simple_Barriers); +--pragma Restrictions(Simple_Barriers); pragma Restrictions(Static_Priorities); pragma Restrictions(Static_Storage_Size); pragma Validity_Checks(ALL_CHECKS); diff -uNr a/smg_comms/smg_comms.gpr b/smg_comms/smg_comms.gpr --- a/smg_comms/smg_comms.gpr 1ef7799c9abe4df9e1beb1903c3ea0eba7b9af7407de48e0a8556933a600490bed4815f14da7ae5554209ee93e01a55bb5479ecddda7560e590c9768cde955a2 +++ b/smg_comms/smg_comms.gpr d3d831a938ba195f4a2959dd1373b1fb5833194c7f73556269642f0ec6cc3dbc6ba26cf37f30ee19fbf95fab1b6c7e9d97143ee36329480bfedbef398aba9862 @@ -3,6 +3,7 @@ -- http://trilema.com/2018/euloras-communication-protocol-restated/ with "c_wrappers/c_wrappers.gpr"; +with "libudp/udp.gpr"; project SMG_comms is diff -uNr a/smg_comms/src/msg_queue.adb b/smg_comms/src/msg_queue.adb --- a/smg_comms/src/msg_queue.adb false +++ b/smg_comms/src/msg_queue.adb e898f5449946b8c920b0aabb349806aeeb5ecda298afe8eb37f155a6968732841899ebc52216ecf6cd8a26608d3d9b2c77bee12f107394425d875f65009e2473 @@ -0,0 +1,36 @@ + -- S.MG, 2018 + +package body Msg_Queue is + protected body Queue is + entry Put(Payload : in Payload_Type; + Address : in Interfaces.Unsigned_32; + Port : in Interfaces.Unsigned_16) + when Count < Max_Q_len is + M: Msg; + begin + -- fill the Msg item structure + M.Payload := Payload; + M.IP_Address := Address; + M.IP_Port := Port; + -- add it to queue and update counter + pos + Q( Write_Pos ) := M; + Write_Pos := Write_Pos + 1; + Count := Count + 1; + end Put; + + entry Get(Payload : out Payload_Type; + Address : out Interfaces.Unsigned_32; + Port : out Interfaces.Unsigned_16) + when Count > 0 is + M: Msg; + begin + M := Q( Read_Pos ); + Payload := M.Payload; + Address := M.IP_Address; + Port := M.IP_Port; + Read_Pos := Read_Pos + 1; + Count := Count - 1; + end Get; + + end Queue; +end Msg_Queue; diff -uNr a/smg_comms/src/msg_queue.ads b/smg_comms/src/msg_queue.ads --- a/smg_comms/src/msg_queue.ads false +++ b/smg_comms/src/msg_queue.ads d4b1ba2b8ad78e263c6cf10f9e0f93fbc748038d4c3fc4e6b5e00272cfd6de159acf585c090e120feadafc0e693252c02b22a069849ec9144502caeb790a3bf0 @@ -0,0 +1,52 @@ + -- FIFO queue of UDP messages with protected read/write (thread-safe). + -- S.MG, 2018 + +with Raw_Types; +with Interfaces; + +generic + -- exact length of payload of items in the queue (1470 or 1472 in Eulora) + Payload_Len: in Positive; + +package Msg_Queue is + + -- payload type + subtype Payload_Type is Raw_Types.Octets(1..Payload_Len); + + -- maximum length of the message queue + Max_Q_Len: constant := 1024; + + -- index in the queue will be modular type + type Index is mod Max_Q_Len; + + -- an item in the queue; IP/port stored only for the "other" (variable) end. + type Msg is + record + Payload : Raw_Types.Octets(1..Payload_Len); + IP_Address : Interfaces.Unsigned_32; + IP_Port : Interfaces.Unsigned_16; + end record; + + -- an array of messages + type Msg_Array is array(Index) of Msg; + + -- the actual queue of messages, as a protected type + protected type Queue is + -- adds the given entry to the queue if there is space; BLOCKS if no space + entry Put(Payload : in Payload_Type; + Address : in Interfaces.Unsigned_32; + Port : in Interfaces.Unsigned_16); + + -- reads next entry from queue when available; BLOCKS if no entries + entry Get(Payload : out Payload_Type; + Address : out Interfaces.Unsigned_32; + Port : out Interfaces.Unsigned_16); + + private + + Q: Msg_Array; + Read_Pos, Write_Pos: Index := Index'First; + Count: Natural range 0..Max_Q_Len := 0; + end Queue; + +end Msg_Queue; diff -uNr a/smg_comms/tests/q_pkg.adb b/smg_comms/tests/q_pkg.adb --- a/smg_comms/tests/q_pkg.adb false +++ b/smg_comms/tests/q_pkg.adb efb0dc9b71686733434226651dc61a439fb9ce64e10688ff59b7d832a5251d310f99825c271dd91a92f0771e6f7378306c653c659afe318bb8e89c49cb19f76a @@ -0,0 +1,54 @@ + +package body Q_Pkg is + procedure Start is + U32: Unsigned_32 := 100; + U16: Unsigned_16 := 1; + Write: Boolean; + begin + Put_Line("Start"); + for I in 1..W'Length loop + if I mod 2 = 0 then + Write := False; + else + Write := True; + end if; + W(I).Start(U32, U16, W'Length-I+10, Write); + U32 := U32 + 1; + U16 := U16 + 1; + end loop; + end Start; + + task body Worker is + Pay: MQ.Payload_Type := (others => 0); + Address: Unsigned_32; + Port : Unsigned_16; + begin + accept Start(A: in Unsigned_32; + P: in Unsigned_16; + Times: in Positive; + Write: in Boolean) do + if Write then + for I in 1 .. Times loop + Pay(Pay'First) := Unsigned_8( I mod 256 ); + Pay(Pay'First+1) := Unsigned_8( (I / 256) mod 256); + Q.Put( Pay, A, P ); + Put_Line(Integer'Image(I) & "." & + Unsigned_32'Image(A) & "." & Unsigned_16'Image(P) & + " WROTE: " & Unsigned_8'Image(Pay(Pay'First)) & + Unsigned_8'Image(Pay(Pay'First+1))); + end loop; + else + for I in 1 .. Times loop + Q.Get( Pay, Address, Port ); + Put_Line(Integer'Image(I) & "." & + Unsigned_32'Image(A) & "." & Unsigned_16'Image(P) & + " read: " & Unsigned_8'Image(Pay(Pay'First)) & + Unsigned_8'Image(Pay(Pay'First+1)) & + " from " & Unsigned_32'Image(Address) & "." & + Unsigned_16'Image(Port)); + end loop; + end if; + end Start; + end Worker; + +end Q_Pkg; diff -uNr a/smg_comms/tests/q_pkg.ads b/smg_comms/tests/q_pkg.ads --- a/smg_comms/tests/q_pkg.ads false +++ b/smg_comms/tests/q_pkg.ads f422a91bdd9a7872e9f5574d5024ff788e9668c2092d21ae32150e004858fb34661813f1b1e9128cb69a900f355264891b9ec9932b3521a278073a1bb299f942 @@ -0,0 +1,25 @@ + --S.MG, 2018 + +with Msg_Queue; +with Ada.Text_IO; use Ada.Text_IO; +with Interfaces; use Interfaces; +with Raw_Types; +with RNG; + + +package Q_Pkg is + procedure Start; +private + package MQ is new Msg_Queue(Payload_Len => 10); + Q: MQ.Queue; + + task type Worker is + Entry Start(A: in Unsigned_32; + P: in Unsigned_16; + Times: in Positive; + Write: in Boolean); + end Worker; + + W: array(1..10) of Worker; + +end Q_Pkg; diff -uNr a/smg_comms/tests/test_comms.gpr b/smg_comms/tests/test_comms.gpr --- a/smg_comms/tests/test_comms.gpr f12ca7f8f9755ad77b5ef30ad9ee5c3ca83d1d24ffa5807f669005a3ce8f3ba37321e313e76c5d6141af32c716a61cca94e5a668291f46c2633a8a447b7758a9 +++ b/smg_comms/tests/test_comms.gpr 1322077daf28a3c0b18cccb0706b169ee291ecbe55510b2a6f6eac660cf384e018824ca7270cc6996af36fc00e778d52b0422fa682da40055c287079faf43afe @@ -17,7 +17,7 @@ for Object_Dir use "obj"; for Exec_Dir use "."; - for Main use ("testall.adb"); + for Main use ("testall.adb", "test_queue.adb"); package Compiler is diff -uNr a/smg_comms/tests/test_queue.adb b/smg_comms/tests/test_queue.adb --- a/smg_comms/tests/test_queue.adb false +++ b/smg_comms/tests/test_queue.adb e5681238f8214e8e2a7014ea33bb4f926151dfc6fc993da3dd777bb845ead2e745d0053034bb1001eb7da818ef17ee6a18d68fddc1b3f1e42937ad160ac670f3 @@ -0,0 +1,8 @@ + -- Basic example of using a message Queue with multiple readers/writers + -- S.MG, 2018 + +with Q_Pkg; +procedure Test_Queue is +begin + Q_Pkg.Start; +end Test_Queue;