diff -uNr a/smg_comms/libudp/lib/README b/smg_comms/libudp/lib/README --- a/smg_comms/libudp/lib/README 5fdbae897eb301a711bf95707f329517db540e34c182a5beec96e93d5d0d856cec2ed6b01c1191f865e8d1c45709a462c70c3005d4aa3676eb445d1479edf2e5 +++ b/smg_comms/libudp/lib/README false @@ -1 +0,0 @@ -Placeholder. diff -uNr a/smg_comms/libudp/obj/README b/smg_comms/libudp/obj/README --- a/smg_comms/libudp/obj/README 5fdbae897eb301a711bf95707f329517db540e34c182a5beec96e93d5d0d856cec2ed6b01c1191f865e8d1c45709a462c70c3005d4aa3676eb445d1479edf2e5 +++ b/smg_comms/libudp/obj/README false @@ -1 +0,0 @@ -Placeholder. diff -uNr a/smg_comms/libudp/restrict.adc b/smg_comms/libudp/restrict.adc --- a/smg_comms/libudp/restrict.adc 0ce47e877e69cdc718556d94802736a36d5289bac7d5c58f4faffc75f0fe8f461f4799705e9b29f89e071c51141bd88b2d73917271170f7fd771ed288ad07215 +++ b/smg_comms/libudp/restrict.adc false @@ -1,83 +0,0 @@ ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- --- 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 de0cec9ced66f9d083e9c7dd1f2e02586e36481701f3b8c988f500f521454dc8ca51797961e1e773edffb7a96ad6d9b4f277b47aab056b7e313c23b8677baff3 +++ b/smg_comms/libudp/udp.adb false @@ -1,142 +0,0 @@ ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- --- 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 05f7f7804320f48222e6492be0b801ad1abbccadb9040bc1e31422001a38410945a69787e089309f2cde6c5cdae85918ae52e4efebebe803193bf7e8a2fa854a +++ b/smg_comms/libudp/udp.ads false @@ -1,148 +0,0 @@ ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- --- 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 8547b598d4310c0a25ed8feb79159195e97c8b4546f7e5099490e5fdfb83e4f2869eee9efc77a0fd24448308192059252f986fa2b14b7de67ff3686eb422554c +++ b/smg_comms/libudp/udp.gpr false @@ -1,74 +0,0 @@ ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- --- 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 392dc3bbebb8ba295916d8ea5ab5cfb2ce44fac68ccd209f4a088d3bc812b9b8bae712599cd0481146ff7db530400882cbf72bc36c637e895430c3e82aa55410 +++ b/smg_comms/libudp/unix_udp.c false @@ -1,146 +0,0 @@ -/* ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- --- 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 8755a59576bcea60f804cfa24630a8f23391ef5bef12a1d061a5a7f883e71d73b6c61bdd49be9f5aa68f3e6cde0e6b3b0595cc3c403b0df494dc0d7393a56934 +++ b/smg_comms/manifest ef8c7caae32b4f54e2750b4ef7edf2c3daac24172d9ad785f48ded094011c60f30265966e992427701bdb8f75edc2142924ea339f9e25e5dfe05b32bd1d61a26 @@ -12,3 +12,4 @@ 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). +554176 smg_comms_sender_receiver diana_coman Adds a thin layer providing sender/receiver tasks that share one input and one output message queue, sending/receiving messages via UDP from/to those queues. Also moves the udplib inside smg comms as opposed to its previous position as separate lib used by the implementation. diff -uNr a/smg_comms/restrict.adc b/smg_comms/restrict.adc --- a/smg_comms/restrict.adc 18c7ebed8adc661b7612b8484f8bce63ef26e9ca68db4060ec66be64d9a38f939db03d0396ca107d53a6f2eed44efeda224da5d3b4acb9fa5e1667a5ad3def1b +++ b/smg_comms/restrict.adc b6386fd389b850ad556b040a071c63a80f67e321908c1ab3ac9bed66d8680b334cb891acbeda52a9b77c132c13fa89f5462a6b20492ed14068298e25a2b7f785 @@ -4,7 +4,7 @@ --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_Abort_Statements); pragma Restrictions(No_Access_Parameter_Allocators); pragma Restrictions(No_Allocators); pragma Restrictions(No_Asynchronous_Control); @@ -32,10 +32,10 @@ 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_Protected_Objects); pragma Restrictions(No_Local_Timing_Events); pragma Restrictions(No_Multiple_Elaboration); -pragma Restrictions(No_Nested_Finalization); +--pragma Restrictions(No_Nested_Finalization); pragma Restrictions(No_Protected_Type_Allocators); --pragma Restrictions(No_Protected_Types); pragma Restrictions(No_Relative_Delay); diff -uNr a/smg_comms/smg_comms.gpr b/smg_comms/smg_comms.gpr --- a/smg_comms/smg_comms.gpr d3d831a938ba195f4a2959dd1373b1fb5833194c7f73556269642f0ec6cc3dbc6ba26cf37f30ee19fbf95fab1b6c7e9d97143ee36329480bfedbef398aba9862 +++ b/smg_comms/smg_comms.gpr 6afe350c4063f5e625daa8915f264c048aa8d6076c2909b49cec0e277aed3567bc9160f260ba33e5b31f1ea2ab2810beb165dbf368114657897dcac94f927267 @@ -3,14 +3,13 @@ -- http://trilema.com/2018/euloras-communication-protocol-restated/ with "c_wrappers/c_wrappers.gpr"; -with "libudp/udp.gpr"; project SMG_comms is type Mode_Type is ("debug", "release"); Mode : Mode_Type := external ("mode", "release"); - for Languages use ("Ada"); + for Languages use ("Ada", "C"); for Source_Dirs use ("src"); for Ignore_Source_Sub_Dirs use (".svn", ".git", "@*"); @@ -19,6 +18,10 @@ 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") @@ -29,6 +32,8 @@ "-gnatyd", "-gnatym", "-fdata-sections", "-ffunction-sections", "-gnatwr", "-gnatw.d", "-gnatec=" & SMG_Comms'Project_Dir & "restrict.adc"); + for Switches ("C") + use ("-O2", "-Wall", "-fstack-check"); end case; end Compiler; @@ -37,6 +42,11 @@ use ("-nostdlib"); end Builder; + package Naming is + for Spec_Suffix ("C") use ".h"; + for Body_Suffix ("C") use ".c"; + end Naming; + package Binder is case Mode is when "debug" => diff -uNr a/smg_comms/src/snd_rcv.adb b/smg_comms/src/snd_rcv.adb --- a/smg_comms/src/snd_rcv.adb false +++ b/smg_comms/src/snd_rcv.adb 8c8749a667e08f52eb06e73eb1e71f0091f7a2643e159cbb5e92da0b8cab4e4f38143d4bf9c177cfad6d3c56b617b04b119ad8c64278d0e26a9167341f23d34f @@ -0,0 +1,49 @@ + -- S.MG, 2018 + +package body snd_rcv is + -- sender + task body Sender is + E : M_UDP.Endpoint; + S : M_UDP.Socket; + Payload : M_Q.Payload_Type; + Dest : M_UDP.Endpoint; + begin + -- open the socket on local interface, specified port + E.Address := M_UDP.INADDR_ANY; + E.Port := Port; + M_UDP.Open_Socket( S, E ); + + -- infinite loop reading from out queue and sending via udp + -- caller will have to call abort to stop this! + loop + out_q.Get( Payload, Dest.Address, Dest.Port); + M_UDP.Transmit( S, Dest, Payload); + end loop; + end Sender; + + -- receiver + task body Receiver is + E : M_UDP.Endpoint; + Source : M_UDP.Endpoint; + S : M_UDP.Socket; + Payload: M_Q.Payload_Type; + Valid : Boolean; + begin + -- open the socket on local interface, specified port + E.Address := M_UDP.INADDR_ANY; + E.Port := Port; + M_UDP.Open_Socket( S, E ); + + -- infinite loop reading from out udp and writing to inbound queue + -- caller will have to call abort to stop this! + loop + M_UDP.Receive( S, Source, Payload, Valid); + -- store ONLY if valid, otherwise discard + if Valid then + in_q.Put( Payload, Source.Address, Source.Port); + end if; + end loop; + + end Receiver; + +end snd_rcv; diff -uNr a/smg_comms/src/snd_rcv.ads b/smg_comms/src/snd_rcv.ads --- a/smg_comms/src/snd_rcv.ads false +++ b/smg_comms/src/snd_rcv.ads 9dc260e7552ca1c8ba2e5cd8b9e0927ca6f0d9d519d9ff4ccff7c7e5de2418ff59fc1c55564772424ac3e85bf60fcaa5ba1842c7b251d3c190a9b7e6eefaccde @@ -0,0 +1,34 @@ + --Sender and Receiver task types for Eulora's Communication Protocol + --This is a THIN layer on top of UDP lib, mainly to move messages out + -- of the small queue of the IP stack onto a bigger, in-memory queue. + --There is NO processing of messages here: just read/write from/to UDP. + --S.MG, 2018 + +with Interfaces; +with Msg_Queue; +with UDP; + +generic + -- exact length of payload aka whether RSA or Serpent + Len: in Positive; + +package Snd_Rcv is + -- queue package with specified payload length + package M_Q is new Msg_Queue( Payload_Len => Len); + + -- outbound and inbound messages queues + -- those are meant to be accessed from outside the package too! + out_q : M_Q.Queue; + in_q : M_Q.Queue; + + -- sender type of task: takes msgs out of out_q and sends them via UDP + task type Sender( Port: Interfaces.Unsigned_16); + + -- receiver type of tasks: reads incoming msgs from UDP and puts them in in_q + task type Receiver( Port: Interfaces.Unsigned_16); + +private + -- udp lib package with specified payload length + package M_UDP is new UDP( Payload_Size => Len); + +end Snd_Rcv; diff -uNr a/smg_comms/src/udp.adb b/smg_comms/src/udp.adb --- a/smg_comms/src/udp.adb false +++ b/smg_comms/src/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/src/udp.ads b/smg_comms/src/udp.ads --- a/smg_comms/src/udp.ads false +++ b/smg_comms/src/udp.ads 20766202122e261da2b5116aa2915d66663db0d9c486fc0357108c51071fca158a1f8c5571e5c607ad4e19cb79315048b6c309d582e864e41c7684c128ed1f4a @@ -0,0 +1,149 @@ +------------------------------------------------------------------------------ +------------------------------------------------------------------------------ +-- 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; +with Raw_Types; + +generic + Payload_Size : in Positive; --to allow for Serpent/RSA different sizes + +package UDP is + + pragma Preelaborate; + + subtype Payload is Raw_Types.Octets(1 .. Payload_Size); + + 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/src/unix_udp.c b/smg_comms/src/unix_udp.c --- a/smg_comms/src/unix_udp.c false +++ b/smg_comms/src/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/tests/test_client.adb b/smg_comms/tests/test_client.adb --- a/smg_comms/tests/test_client.adb false +++ b/smg_comms/tests/test_client.adb ef36fc90ab9b5f91f7a4f3dbcc60817461c541ed3b712f2849e91be8a778bd3b7204b2d9cef86485e59489ceccb8aff98e69af241803f8958fc0f9a33ce4ab83 @@ -0,0 +1,131 @@ + -- S.MG, 2018 +with Snd_Rcv; +with Interfaces; +with Ada.Text_IO; use Ada.Text_IO; +with Raw_Types; +with UDP; + +procedure Test_Client is + PortRSA : Interfaces.Unsigned_16 := 34340; + PortS : Interfaces.Unsigned_16 := 34341; + N_S : Interfaces.Unsigned_8 := 105; + N_RSA : Interfaces.Unsigned_8 := 82; + + Server : String := "127.0.0.1"; + package test_udp is new UDP(10); + ServerA : Interfaces.Unsigned_32 := + test_udp.IP_From_String(Server); + ServerRSA : Interfaces.Unsigned_16 := 44340; + ServerS : Interfaces.Unsigned_16 := 44341; + package Snd_Rcv_RSA is new Snd_Rcv(Raw_Types.RSA_Pkt'Length); + package Snd_Rcv_S is new Snd_Rcv(Raw_Types.Serpent_Pkt'Length); + -- sender RSA and Serpent + Sender_RSA: Snd_Rcv_RSA.Sender( PortRSA ); + Sender_S : Snd_Rcv_S.Sender( PortS ); + -- receiver RSA and Serpent + Receiver_RSA: Snd_Rcv_RSA.Receiver( PortRSA ); + Receiver_S: Snd_Rcv_S.Receiver( PortS ); + + -- producer of serpent messages + task s_prod is + entry Finish; + end s_prod; + task body s_prod is + Payload : Raw_Types.Serpent_Pkt := (others => 10); + begin + Put_Line("S Producer with " & + Interfaces.Unsigned_8'Image(N_S) & "messages."); + -- send the messages with first octet the number + for I in 1..N_S loop + Payload(Payload'First) := I; + Snd_Rcv_S.out_q.Put( Payload, ServerA, ServerS); + Put_Line("Sent S message " & + Interfaces.Unsigned_8'Image(I)); + end loop; + + -- signal it's done + accept Finish; + Put_Line("S prod got the finish."); + + end s_prod; + + -- producer of RSA messages + task rsa_prod is + Entry Finish; + end rsa_prod; + task body rsa_prod is + Payload : Raw_Types.RSA_Pkt := (others => 20); + begin + Put_Line("RSA Producer with " & + Interfaces.Unsigned_8'Image(N_RSA) & "messages."); + + -- send the messages with first octet the number + for I in 1..N_RSA loop + Payload(Payload'First) := I; + Snd_Rcv_RSA.out_q.Put( Payload, ServerA, ServerRSA); + Put_Line("Sent RSA message " & + Interfaces.Unsigned_8'Image(I)); + end loop; + + -- signal it's done + accept Finish; + Put_Line("RSA prod got the finish."); + + end rsa_prod; + + -- Serpent Consumer + task s_cons is + Entry Finish; + end s_cons; + task body s_cons is + Payload: Raw_Types.Serpent_Pkt; + A: Interfaces.Unsigned_32; + P: Interfaces.Unsigned_16; + begin + for I in 1..N_S loop + -- consume one message + Snd_Rcv_S.in_q.Get(Payload, A, P); + Put_Line("S msg " & + Interfaces.Unsigned_8'Image(Payload(Payload'First)) & + " from " & Interfaces.Unsigned_32'Image(A) & + ":" & Interfaces.Unsigned_16'Image(P)); + -- do NOT echo it back + end loop; + + accept Finish; + Put_Line("S Cons got the finish."); + end s_cons; + + -- RSA Consumer + task rsa_cons is + Entry Finish; + end rsa_cons; + task body rsa_cons is + Payload: Raw_Types.RSA_Pkt; + A: Interfaces.Unsigned_32; + P: Interfaces.Unsigned_16; + begin + for I in 1..N_RSA loop + -- consume one message + Snd_Rcv_RSA.in_q.Get(Payload, A, P); + Put_Line("RSA msg " & + Interfaces.Unsigned_8'Image(Payload(Payload'First)) & + " from " & Interfaces.Unsigned_32'Image(A) & + ":" & Interfaces.Unsigned_16'Image(P)); + -- do NOT echo back + end loop; + + accept Finish; + Put_Line("RSA Cons got the finish."); + end rsa_cons; +begin + Put_Line("Test client"); + -- wait for producers/consumers to finish + rsa_prod.Finish; + s_prod.Finish; + rsa_cons.Finish; + s_cons.Finish; + + -- abort the sender & receiver to be able to finish + abort Sender_S, Receiver_S, Sender_RSA, Receiver_RSA; +end Test_Client; diff -uNr a/smg_comms/tests/test_comms.gpr b/smg_comms/tests/test_comms.gpr --- a/smg_comms/tests/test_comms.gpr 1322077daf28a3c0b18cccb0706b169ee291ecbe55510b2a6f6eac660cf384e018824ca7270cc6996af36fc00e778d52b0422fa682da40055c287079faf43afe +++ b/smg_comms/tests/test_comms.gpr bd5f2bbe91f227d83b9b7ceb4470abcb42229427406bf2f6a2bbc34efa6b8ff1338ec8c11c609a366acb7393b8c41a40b05d1e7bb96eca7980663e8be2910dc4 @@ -17,7 +17,8 @@ for Object_Dir use "obj"; for Exec_Dir use "."; - for Main use ("testall.adb", "test_queue.adb"); + for Main use ("testall.adb", "test_queue.adb", + "test_client.adb", "test_server.adb"); package Compiler is diff -uNr a/smg_comms/tests/test_server.adb b/smg_comms/tests/test_server.adb --- a/smg_comms/tests/test_server.adb false +++ b/smg_comms/tests/test_server.adb 493f6a22566564ebe01c6e59941fbd908b7dfeeab0b44e235c8118411d41313eb826b83f53e09f68ef12edeee186be16ec31608db68bd8c8556afb67ca1ee91c @@ -0,0 +1,79 @@ + -- S.MG, 2018 +with Ada.Text_IO; use Ada.Text_IO; +with Interfaces; +with Snd_Rcv; +with Raw_Types; + +procedure Test_Server is + PortRSA: Interfaces.Unsigned_16 := 44340; + PortS : Interfaces.Unsigned_16 := 44341; + N_S : Interfaces.Unsigned_8 := 105; + N_RSA : Interfaces.Unsigned_8 := 82; + package Snd_Rcv_RSA is new Snd_Rcv(Raw_Types.RSA_Pkt'Length); + package Snd_Rcv_S is new Snd_Rcv(Raw_Types.Serpent_Pkt'Length); + + -- sender/receiver tasks -- + -- sender RSA and Serpent + Sender_RSA: Snd_Rcv_RSA.Sender( PortRSA ); + Sender_S : Snd_Rcv_S.Sender( PortS ); + -- receiver RSA and Serpent + Receiver_RSA: Snd_Rcv_RSA.Receiver( PortRSA ); + Receiver_S: Snd_Rcv_S.Receiver( PortS ); + + -- Serpent Consumer + task s_cons is + Entry Finish; + end s_cons; + task body s_cons is + Payload: Raw_Types.Serpent_Pkt; + A: Interfaces.Unsigned_32; + P: Interfaces.Unsigned_16; + begin + for I in 1..N_S loop + -- consume one message and echo it back + Snd_Rcv_S.in_q.Get(Payload, A, P); + Put_Line("S msg " & + Interfaces.Unsigned_8'Image(Payload(Payload'First)) & + " from " & Interfaces.Unsigned_32'Image(A) & + ":" & Interfaces.Unsigned_16'Image(P)); + -- echo it back + Snd_Rcv_S.out_q.Put(Payload, A, P); + end loop; + + accept Finish; + Put_Line("S Cons got the finish."); + end s_cons; + + -- RSA Consumer + task rsa_cons is + Entry Finish; + end rsa_cons; + task body rsa_cons is + Payload: Raw_Types.RSA_Pkt; + A: Interfaces.Unsigned_32; + P: Interfaces.Unsigned_16; + begin + for I in 1..N_RSA loop + -- consume one message and echo it back + Snd_Rcv_RSA.in_q.Get(Payload, A, P); + Put_Line("RSA msg " & + Interfaces.Unsigned_8'Image(Payload(Payload'First)) & + " from " & Interfaces.Unsigned_32'Image(A) & + ":" & Interfaces.Unsigned_16'Image(P)); + -- echo it back + Snd_Rcv_RSA.out_q.Put(Payload, A, P); + end loop; + + accept Finish; + Put_Line("RSA Cons got the finish."); + end rsa_cons; + +begin + Put_Line("Test server"); + -- wait for consumers to finish + rsa_cons.Finish; + s_cons.Finish; + + -- abort the sender & receiver to be able to finish + abort Sender_S, Receiver_S, Sender_RSA, Receiver_RSA; +end Test_Server;