all signers:
antecedents:
press order:
patch:
(1 . 1)(0 . 0)
10 Placeholder.
- 5FDBAE897EB301A711BF95707F329517DB540E34C182A5BEEC96E93D5D0D856CEC2ED6B01C1191F865E8D1C45709A462C70C3005D4AA3676EB445D1479EDF2E5(1 . 1)(0 . 0)
15 Placeholder.
- 0CE47E877E69CDC718556D94802736A36D5289BAC7D5C58F4FAFFC75F0FE8F461F4799705E9B29F89E071C51141BD88B2D73917271170F7FD771ED288AD07215(1 . 83)(0 . 0)
20 ------------------------------------------------------------------------------
21 ------------------------------------------------------------------------------
22 -- This file is part of 'UDP', a datagram sockets library. --
23 -- --
24 -- (C) 2018 Stanislav Datskovskiy ( www.loper-os.org ) --
25 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
26 -- --
27 -- You do not have, nor can you ever acquire the right to use, copy or --
28 -- distribute this software ; Should you use this software for any purpose, --
29 -- or copy and distribute it to anyone or in any manner, you are breaking --
30 -- the laws of whatever soi-disant jurisdiction, and you promise to --
31 -- continue doing so for the indefinite future. In any case, please --
32 -- always : read and understand any software ; verify any PGP signatures --
33 -- that you use - for any purpose. --
34 -- --
35 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm . --
36 ------------------------------------------------------------------------------
37 ------------------------------------------------------------------------------
38
39 pragma Restrictions(Immediate_Reclamation);
40 pragma Restrictions(Max_Asynchronous_Select_Nesting => 0);
41 pragma Restrictions(Max_Protected_Entries => 0);
42 pragma Restrictions(Max_Select_Alternatives => 0);
43 pragma Restrictions(Max_Task_Entries => 0);
44 pragma Restrictions(Max_Tasks => 0);
45 pragma Restrictions(No_Abort_Statements);
46 pragma Restrictions(No_Access_Parameter_Allocators);
47 pragma Restrictions(No_Allocators);
48 pragma Restrictions(No_Asynchronous_Control);
49 pragma Restrictions(No_Calendar);
50 pragma Restrictions(No_Coextensions);
51 pragma Restrictions(No_Default_Stream_Attributes);
52 pragma Restrictions(No_Delay);
53 pragma Restrictions(No_Dispatch);
54 pragma Restrictions(No_Dispatching_Calls);
55 pragma Restrictions(No_Dynamic_Attachment);
56 pragma Restrictions(No_Dynamic_Priorities);
57 pragma Restrictions(No_Entry_Calls_In_Elaboration_Code);
58 pragma Restrictions(No_Entry_Queue);
59 pragma Restrictions(No_Enumeration_Maps);
60 pragma Restrictions(No_Exception_Propagation);
61 pragma Restrictions(No_Exception_Registration);
62 pragma Restrictions(No_Finalization);
63 pragma Restrictions(No_Fixed_Io);
64 pragma Restrictions(No_Floating_Point);
65 pragma Restrictions(No_Implementation_Aspect_Specifications);
66 pragma Restrictions(No_Implementation_Units);
67 pragma Restrictions(No_Implicit_Conditionals);
68 pragma Restrictions(No_Implicit_Dynamic_Code);
69 pragma Restrictions(No_Implicit_Heap_Allocations);
70 pragma Restrictions(No_Implicit_Protected_Object_Allocations);
71 pragma Restrictions(No_Implicit_Task_Allocations);
72 pragma Restrictions(No_Initialize_Scalars);
73 pragma Restrictions(No_Local_Protected_Objects);
74 pragma Restrictions(No_Local_Timing_Events);
75 pragma Restrictions(No_Multiple_Elaboration);
76 pragma Restrictions(No_Nested_Finalization);
77 pragma Restrictions(No_Protected_Type_Allocators);
78 pragma Restrictions(No_Protected_Types);
79 pragma Restrictions(No_Relative_Delay);
80 pragma Restrictions(No_Requeue_Statements);
81 pragma Restrictions(No_Secondary_Stack);
82 pragma Restrictions(No_Select_Statements);
83 pragma Restrictions(No_Specific_Termination_Handlers);
84 pragma Restrictions(No_Standard_Allocators_After_Elaboration);
85 pragma Restrictions(No_Stream_Optimizations);
86 pragma Restrictions(No_Streams);
87 pragma Restrictions(No_Task_Allocators);
88 pragma Restrictions(No_Task_At_Interrupt_Priority);
89 pragma Restrictions(No_Task_Attributes_Package);
90 pragma Restrictions(No_Task_Hierarchy);
91 pragma Restrictions(No_Tasking);
92 pragma Restrictions(No_Task_Termination);
93 pragma Restrictions(No_Terminate_Alternatives);
94 pragma Restrictions(No_Unchecked_Access);
95 pragma Restrictions(No_Unchecked_Conversion);
96 pragma Restrictions(No_Unchecked_Deallocation);
97 pragma Restrictions(No_Wide_Characters);
98 pragma Restrictions(Pure_Barriers);
99 pragma Restrictions(Simple_Barriers);
100 pragma Restrictions(Static_Priorities);
101 pragma Restrictions(Static_Storage_Size);
102 pragma Validity_Checks(ALL_CHECKS);
- DE0CEC9CED66F9D083E9C7DD1F2E02586E36481701F3B8C988F500F521454DC8CA51797961E1E773EDFFB7A96AD6D9B4F277B47AAB056B7E313C23B8677BAFF3(1 . 142)(0 . 0)
107 ------------------------------------------------------------------------------
108 ------------------------------------------------------------------------------
109 -- This file is part of 'UDP', a datagram sockets library. --
110 -- --
111 -- (C) 2018 Stanislav Datskovskiy ( www.loper-os.org ) --
112 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
113 -- --
114 -- You do not have, nor can you ever acquire the right to use, copy or --
115 -- distribute this software ; Should you use this software for any purpose, --
116 -- or copy and distribute it to anyone or in any manner, you are breaking --
117 -- the laws of whatever soi-disant jurisdiction, and you promise to --
118 -- continue doing so for the indefinite future. In any case, please --
119 -- always : read and understand any software ; verify any PGP signatures --
120 -- that you use - for any purpose. --
121 -- --
122 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm . --
123 ------------------------------------------------------------------------------
124 ------------------------------------------------------------------------------
125
126 package body UDP is
127
128 -- Generate a human representation of a (local-endian) IP Address
129 function IP_To_String(IP : in IP_Address) return IP_Address_Text is
130 Text : IP_Address_Text := (others => ' ');
131 begin
132 Unix_UDP_IP_To_String(IP, Text'Address, Text'Length);
133 return Text;
134 end IP_To_String;
135
136
137 -- Generate a (local-endian) IP Address from given human representation
138 function IP_From_String(IP_Text : in String) return IP_Address is
139 Text_With_Null : String(1 .. IP_Text'Length + 1);
140 Result : Interfaces.C.Int := 0;
141 IP : aliased IP_Address;
142 begin
143 -- We can't use To_C because malicious idiots demanded secondary stack.
144 Text_With_Null(IP_Text'Range) := IP_Text;
145 Text_With_Null(Text_With_Null'Last) := Character'Val(0);
146
147 -- Let unix do the conversion
148 Result := Unix_UDP_String_To_IP(Text_With_Null'Address,
149 IP'Access);
150 case Result is
151 when -1 =>
152 raise UDP_Invalid_Text_IP;
153 when others =>
154 return IP;
155 end case;
156 end IP_From_String;
157
158
159 -- Open a UDP socket, with the given local endpoint for both TX and RX
160 procedure Open_Socket(S : out Socket;
161 Local_Endpoint : in Endpoint) is
162 Result : constant Interfaces.C.Int :=
163 Unix_UDP_Socket_Open(Socket => S'Address,
164 Local_IP => Local_Endpoint.Address,
165 Local_Port => Local_Endpoint.Port);
166 begin
167 case Result is
168 when -1 =>
169 raise UDP_Failed_Open;
170 when -2 =>
171 raise UDP_Failed_SetOpt;
172 when -3 =>
173 raise UDP_Failed_Bind;
174 when others =>
175 null;
176 end case;
177 end Open_Socket;
178
179
180 -- Permanently close the given open socket
181 procedure Close_Socket(S : in out Socket) is
182 begin
183 Unix_UDP_Socket_Close(Socket => S'Address);
184 end Close_Socket;
185
186
187 -- Transmit the Payload, via Socket, to given Destination
188 procedure Transmit(S : in out Socket;
189 Destination : in Endpoint;
190 Payload_Buf : in Payload) is
191 Result : constant Interfaces.C.Int :=
192 Unix_UDP_Socket_Transmit(Socket => S'Address,
193 Remote_IP => Destination.Address,
194 Remote_Port => Destination.Port,
195 Payload_Buf => Payload_Buf'Address,
196 Payload_Len => Payload'Length);
197 begin
198 case Result is
199 when -1 =>
200 Close_Socket(S);
201 raise UDP_Failed_Transmit;
202 when others =>
203 -- No eggog, but must check if sent all bytes:
204 if (Result /= Payload'Length) then
205 Close_Socket(S);
206 raise UDP_Truncated_Send;
207 end if;
208 end case;
209 end Transmit;
210
211
212 -- Wait (potentially forever!) for a Payload, via Socket; save its Origin
213 procedure Receive(S : in out Socket;
214 Origin : out Endpoint;
215 Payload_Buf : out Payload;
216 Valid : out Boolean) is
217
218 -- Scratch pad (if not successful, the call has no outputs)
219 Incoming_Payload : aliased Payload := (others => 0);
220 Incoming_IP : aliased IP_Address;
221 Incoming_Port : aliased IP_Port;
222
223 Result : constant Interfaces.C.Int :=
224 Unix_UDP_Socket_Receive(Socket => S'Address,
225 Origin_IP => Incoming_IP'Access,
226 Origin_Port => Incoming_Port'Access,
227 Payload_Buf => Incoming_Payload'Address,
228 Payload_Len => Payload'Length);
229 begin
230 Valid := False;
231 case Result is
232 when -1 =>
233 Close_Socket(S);
234 raise UDP_Failed_Receive;
235 when others =>
236 -- No eggog:
237 Origin.Address := Incoming_IP;
238 Origin.Port := Incoming_Port;
239 Payload_Buf := Incoming_Payload;
240
241 -- Was a full-length payload?
242 if (Result = Payload'Length) then
243 Valid := True;
244 end if;
245 end case;
246 end Receive;
247
248 end UDP;
- 05F7F7804320F48222E6492BE0B801AD1ABBCCADB9040BC1E31422001A38410945A69787E089309F2CDE6C5CDAE85918AE52E4EFEBEBE803193BF7E8A2FA854A(1 . 148)(0 . 0)
253 ------------------------------------------------------------------------------
254 ------------------------------------------------------------------------------
255 -- This file is part of 'UDP', a datagram sockets library. --
256 -- --
257 -- (C) 2018 Stanislav Datskovskiy ( www.loper-os.org ) --
258 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
259 -- --
260 -- You do not have, nor can you ever acquire the right to use, copy or --
261 -- distribute this software ; Should you use this software for any purpose, --
262 -- or copy and distribute it to anyone or in any manner, you are breaking --
263 -- the laws of whatever soi-disant jurisdiction, and you promise to --
264 -- continue doing so for the indefinite future. In any case, please --
265 -- always : read and understand any software ; verify any PGP signatures --
266 -- that you use - for any purpose. --
267 -- --
268 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm . --
269 ------------------------------------------------------------------------------
270 ------------------------------------------------------------------------------
271
272 with Interfaces, Interfaces.C; use Interfaces, Interfaces.C;
273 with System; use System;
274
275 generic
276 Payload_Size : in Positive; --to allow for Serpent/RSA different sizes
277
278 package UDP is
279
280 pragma Preelaborate;
281
282 type Payload is array(1 .. Payload_Size) of Unsigned_8;
283
284 subtype IP_Address is Unsigned_32;
285 subtype IP_Port is Unsigned_16;
286
287 -- Magic that puts emitter on 'any' local interface
288 INADDR_ANY : constant Unsigned_32 := 0;
289
290 -- An local or remote address:port
291 type Endpoint is
292 record
293 Address : IP_Address;
294 Port : IP_Port;
295 end record;
296 -- NOTE that both elements are stored in ~local~ endianness.
297
298 -- Human Representation of any valid IP Address
299 subtype IP_Address_Text is String(1 .. 15);
300
301 -- Opaque unix turd that stores a socket's state
302 type Socket is private;
303
304 -- The public API:
305
306 -- Generate a human representation of a (local-endian) IP Address
307 function IP_To_String(IP : in IP_Address) return IP_Address_Text;
308
309 -- Generate a (local-endian) IP Address from given human representation
310 function IP_From_String(IP_Text : in String) return IP_Address;
311
312 -- Open a UDP socket, with the given local endpoint for both TX and RX
313 procedure Open_Socket(S : out Socket;
314 Local_Endpoint : in Endpoint);
315
316 -- Permanently close the given open socket
317 procedure Close_Socket(S : in out Socket);
318
319 -- Transmit the Payload, via Socket, to given Destination
320 procedure Transmit(S : in out Socket;
321 Destination : in Endpoint;
322 Payload_Buf : in Payload);
323
324 -- Wait (potentially forever!) for a Payload, via Socket; save its Origin,
325 -- and whether the received Payload was valid (i.e. expected length):
326 procedure Receive(S : in out Socket;
327 Origin : out Endpoint;
328 Payload_Buf : out Payload;
329 Valid : out Boolean);
330
331 -- Eggogology:
332 UDP_Invalid_Text_IP : exception;
333 UDP_Failed_Open : exception;
334 UDP_Failed_SetOpt : exception;
335 UDP_Failed_Bind : exception;
336 UDP_Failed_Transmit : exception;
337 UDP_Truncated_Send : exception;
338 UDP_Failed_Receive : exception;
339
340 private
341
342 -- 'nicht fuer gefingerpoken und mittengrabben!'
343
344 -- This record's elements are not accessed from ada:
345 type sockaddr_in is record
346 family : Unsigned_16;
347 port : Unsigned_16;
348 sin_addr : Unsigned_32;
349 padding : Unsigned_64;
350 end record;
351 pragma Convention(C, sockaddr_in);
352
353 -- Here we also don't care about the elements, only total mass:
354 type Socket is
355 record
356 SA : sockaddr_in;
357 FD : Interfaces.C.int;
358 end record;
359 pragma Convention(C, Socket);
360
361 -- Everything below -- imports from unix_udp.c:
362
363 procedure Unix_UDP_IP_To_String
364 (IP : Unsigned_32;
365 Output_Buffer : System.Address;
366 Output_Buffer_Size : Unsigned_32);
367 pragma Import(C, Unix_UDP_IP_To_String, "unix_udp_ip_to_string");
368
369 function Unix_UDP_String_To_IP
370 (Input_Buffer : System.Address;
371 IP : not null access Unsigned_32) return Interfaces.C.int;
372 pragma Import(C, Unix_UDP_String_To_IP, "unix_udp_string_to_ip");
373
374 function Unix_UDP_Socket_Open
375 (Socket : System.Address;
376 Local_IP : Unsigned_32;
377 Local_Port : Unsigned_16) return Interfaces.C.int;
378 pragma Import(C, Unix_UDP_Socket_Open, "unix_udp_socket_open");
379
380 procedure Unix_UDP_Socket_Close
381 (Socket : System.Address);
382 pragma Import(C, Unix_UDP_Socket_Close, "unix_udp_socket_close");
383
384 function Unix_UDP_Socket_Transmit
385 (Socket : System.Address;
386 Remote_IP : Unsigned_32;
387 Remote_Port : Unsigned_16;
388 Payload_Buf : System.Address;
389 Payload_Len : Unsigned_32) return Interfaces.C.int;
390 pragma Import(C, Unix_UDP_Socket_Transmit, "unix_udp_socket_transmit");
391
392 function Unix_UDP_Socket_Receive
393 (Socket : System.Address;
394 Origin_IP : not null access Unsigned_32;
395 Origin_Port : not null access Unsigned_16;
396 Payload_Buf : System.Address;
397 Payload_Len : Unsigned_32) return Interfaces.C.int;
398 pragma Import(C, Unix_UDP_Socket_Receive, "unix_udp_socket_receive");
399
400 end UDP;
- 8547B598D4310C0A25ED8FEB79159195E97C8B4546F7E5099490E5FDFB83E4F2869EEE9EFC77A0FD24448308192059252F986FA2B14B7DE67FF3686EB422554C(1 . 74)(0 . 0)
405 ------------------------------------------------------------------------------
406 ------------------------------------------------------------------------------
407 -- This file is part of 'UDP', a datagram sockets library. --
408 -- --
409 -- (C) 2018 Stanislav Datskovskiy ( www.loper-os.org ) --
410 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
411 -- --
412 -- You do not have, nor can you ever acquire the right to use, copy or --
413 -- distribute this software ; Should you use this software for any purpose, --
414 -- or copy and distribute it to anyone or in any manner, you are breaking --
415 -- the laws of whatever soi-disant jurisdiction, and you promise to --
416 -- continue doing so for the indefinite future. In any case, please --
417 -- always : read and understand any software ; verify any PGP signatures --
418 -- that you use - for any purpose. --
419 -- --
420 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm . --
421 ------------------------------------------------------------------------------
422 ------------------------------------------------------------------------------
423
424 project UDP is
425
426 for Object_Dir use "obj";
427
428 type Mode_Type is ("debug", "release");
429 Mode : Mode_Type := external ("mode", "release");
430
431 for Languages use ("Ada", "C");
432 for Source_Dirs use (".");
433 for Library_Dir use "lib";
434 for Library_Name use "UDP";
435 for Library_Kind use "static";
436
437 package Compiler is
438 for Leading_Required_Switches ("C") use ("-c");
439 for Object_File_Suffix ("C") use ".o";
440 for Include_Switches ("C") use ("-I");
441
442 case Mode is
443 when "debug" =>
444 for Switches ("Ada")
445 use ("-g");
446 when "release" =>
447 for Switches ("Ada")
448 use ("-O2", "-fdump-scos", "-gnata", "-fstack-check",
449 "-gnatyd", "-gnatym",
450 "-fdata-sections", "-ffunction-sections", "-gnatwr", "-gnatw.d",
451 "-gnatec=" & UDP'Project_Dir & "restrict.adc");
452 for Switches ("C")
453 use ("-O2", "-Wall", "-fstack-check");
454 end case;
455 end Compiler;
456
457 package Naming is
458 for Spec_Suffix ("C") use ".h";
459 for Body_Suffix ("C") use ".c";
460 end Naming;
461
462 package Builder is
463 for Switches ("Ada")
464 use ("-nostdlib");
465 end Builder;
466
467 package Binder is
468 case Mode is
469 when "debug" =>
470 for Switches ("Ada")
471 use ();
472 when "release" =>
473 for Switches ("Ada")
474 use ("-static");
475 end case;
476 end Binder;
477
478 end UDP;
- 392DC3BBEBB8BA295916D8EA5AB5CFB2CE44FAC68CCD209F4A088D3BC812B9B8BAE712599CD0481146FF7DB530400882CBF72BC36C637E895430C3E82AA55410(1 . 146)(0 . 0)
483 /*
484 ------------------------------------------------------------------------------
485 ------------------------------------------------------------------------------
486 -- This file is part of 'UDP', a datagram sockets library. --
487 -- --
488 -- (C) 2018 Stanislav Datskovskiy ( www.loper-os.org ) --
489 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
490 -- --
491 -- You do not have, nor can you ever acquire the right to use, copy or --
492 -- distribute this software ; Should you use this software for any purpose, --
493 -- or copy and distribute it to anyone or in any manner, you are breaking --
494 -- the laws of whatever soi-disant jurisdiction, and you promise to --
495 -- continue doing so for the indefinite future. In any case, please --
496 -- always : read and understand any software ; verify any PGP signatures --
497 -- that you use - for any purpose. --
498 -- --
499 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm . --
500 ------------------------------------------------------------------------------
501 ------------------------------------------------------------------------------
502 */
503
504 #include <string.h>
505 #include <unistd.h>
506 #include <arpa/inet.h>
507 #include <netinet/in.h>
508 #include <sys/types.h>
509 #include <sys/socket.h>
510
511
512 /* Socket state representation: */
513 typedef struct _UDP_Socket {
514 struct sockaddr_in sa_local;
515 int sock;
516 } UDP_Socket;
517
518
519 /* local-endian ip to string conversion */
520 void unix_udp_ip_to_string(uint32_t ip, char *buf, uint32_t buf_size) {
521 struct in_addr addr;
522 addr.s_addr = htonl(ip);
523 char *txt = inet_ntoa(addr);
524 /* Given IP might be shorter than buf_size so don't copy blindly. */
525 int len = strlen(txt);
526 /* ONTH don't ever copy more than buf_size either */
527 if (len > buf_size)
528 len = buf_size;
529 strncpy(buf, txt, len);
530 }
531 /* Should be replaced with native routine */
532
533
534 /* string to local-endian ip conversion */
535 int unix_udp_string_to_ip(char *buf, uint32_t *ip) {
536 struct in_addr addr;
537 if (inet_aton(buf, &addr) <= 0)
538 return -1;
539 *ip = ntohl(addr.s_addr);
540 return 0;
541 }
542 /* Should be replaced with native routine */
543
544
545 int unix_udp_socket_open(UDP_Socket *S,
546 uint32_t local_ip, uint16_t local_port) {
547 /* Open the socket FD: */
548 if ((S->sock = socket(AF_INET, SOCK_DGRAM, IPPROTO_UDP)) < 0) {
549 return -1;
550 }
551
552 memset(&S->sa_local, 0, sizeof(struct sockaddr_in));
553
554 /* Set up emitter endpoint, converting from local endianness: */
555 S->sa_local.sin_family = AF_INET;
556 S->sa_local.sin_addr.s_addr = htonl(local_ip);
557 S->sa_local.sin_port = htons(local_port);
558
559 /* Cure the asinine linuxism where dead sockets interfere with living: */
560 int one = 1;
561 if (setsockopt(S->sock, SOL_SOCKET, SO_REUSEADDR, &one, sizeof(one)) < 0) {
562 close(S->sock);
563 return -2;
564 }
565
566 /* Bind the socket */
567 if (bind(S->sock,
568 (struct sockaddr *)&(S->sa_local), sizeof(S->sa_local)) < 0) {
569 close(S->sock);
570 return -3;
571 }
572
573 /* ok */
574 return 0;
575 }
576
577
578 void unix_udp_socket_close(UDP_Socket *S) {
579 close(S->sock);
580 }
581
582
583 int unix_udp_socket_transmit(UDP_Socket *S,
584 uint32_t remote_ip, uint16_t remote_port,
585 uint8_t *payload, uint32_t payload_len) {
586 int bytes_sent = 0;
587 struct sockaddr_in remote_addr;
588 memset((char *)&remote_addr, 0, sizeof(remote_addr));
589
590 /* Set up dest endpoint, converting from local endianness: */
591 remote_addr.sin_family = AF_INET;
592 remote_addr.sin_port = htons(remote_port);
593 remote_addr.sin_addr.s_addr = htonl(remote_ip);
594
595 /* Transmit Datagram */
596 bytes_sent = sendto(S->sock, payload, payload_len,
597 0, /* no flags */
598 (struct sockaddr*)&remote_addr,
599 sizeof(remote_addr));
600 if (bytes_sent <= 0)
601 return -1;
602
603 return bytes_sent;
604 }
605
606
607 int unix_udp_socket_receive(UDP_Socket *S,
608 uint32_t *origin_ip, uint16_t *origin_port,
609 uint8_t *payload, uint32_t payload_len) {
610 int bytes_received = 0;
611 struct sockaddr_in orig_addr;
612 socklen_t orig_addr_len = sizeof(orig_addr);
613 memset((char *)&orig_addr, 0, sizeof(orig_addr));
614
615 /* Receive Datagram (blocking!) */
616 bytes_received = recvfrom(S->sock, payload, payload_len,
617 0, /* no flags */
618 (struct sockaddr *)&orig_addr,
619 &orig_addr_len);
620
621 if (bytes_received < 0) return -1;
622
623 /* Save the originator's endpoint in ~local~ endianness */
624 *origin_ip = ntohl(orig_addr.sin_addr.s_addr);
625 *origin_port = ntohs(orig_addr.sin_port);
626
627 return bytes_received;
628 }
- 8755A59576BCEA60F804CFA24630A8F23391EF5BEF12A1D061A5A7F883E71D73B6C61BDD49BE9F5AA68F3E6CDE0E6B3B0595CC3C403B0DF494DC0D7393A56934(12 . 3)(12 . 4)
633 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.
634 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.
635 553641 smg_comms_queue diana_coman Adds a protected queue type that allows thread-safe put/get of items (meant to be messages).
636 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.
- 18C7EBED8ADC661B7612B8484F8BCE63EF26E9CA68DB4060EC66BE64D9A38F939DB03D0396CA107D53A6F2EED44EFEDA224DA5D3B4ACB9FA5E1667A5AD3DEF1B(4 . 7)(4 . 7)- D3D831A938BA195F4A2959DD1373B1FB5833194C7F73556269642F0EC6CC3DBC6BA26CF37F30EE19FBF95FAB1B6C7E9D97143EE36329480BFEDBEF398ABA9862
641 --pragma Restrictions(Max_Select_Alternatives => 0);
642 --pragma Restrictions(Max_Task_Entries => 0);
643 --pragma Restrictions(Max_Tasks => 0);
644 pragma Restrictions(No_Abort_Statements);
645 --pragma Restrictions(No_Abort_Statements);
646 pragma Restrictions(No_Access_Parameter_Allocators);
647 pragma Restrictions(No_Allocators);
648 pragma Restrictions(No_Asynchronous_Control);
(32 . 10)(32 . 10)
650 pragma Restrictions(No_Implicit_Protected_Object_Allocations);
651 pragma Restrictions(No_Implicit_Task_Allocations);
652 pragma Restrictions(No_Initialize_Scalars);
653 pragma Restrictions(No_Local_Protected_Objects);
654 --pragma Restrictions(No_Local_Protected_Objects);
655 pragma Restrictions(No_Local_Timing_Events);
656 pragma Restrictions(No_Multiple_Elaboration);
657 pragma Restrictions(No_Nested_Finalization);
658 --pragma Restrictions(No_Nested_Finalization);
659 pragma Restrictions(No_Protected_Type_Allocators);
660 --pragma Restrictions(No_Protected_Types);
661 pragma Restrictions(No_Relative_Delay);
(3 . 14)(3 . 13)-
666 -- http://trilema.com/2018/euloras-communication-protocol-restated/
667
668 with "c_wrappers/c_wrappers.gpr";
669 with "libudp/udp.gpr";
670
671 project SMG_comms is
672
673 type Mode_Type is ("debug", "release");
674 Mode : Mode_Type := external ("mode", "release");
675
676 for Languages use ("Ada");
677 for Languages use ("Ada", "C");
678
679 for Source_Dirs use ("src");
680 for Ignore_Source_Sub_Dirs use (".svn", ".git", "@*");
(19 . 6)(18 . 10)
682
683 package Compiler is
684
685 for Leading_Required_Switches ("C") use ("-c");
686 for Object_File_Suffix ("C") use ".o";
687 for Include_Switches ("C") use ("-I");
688
689 case Mode is
690 when "debug" =>
691 for Switches ("Ada")
(29 . 6)(32 . 8)
693 "-gnatyd", "-gnatym",
694 "-fdata-sections", "-ffunction-sections", "-gnatwr", "-gnatw.d",
695 "-gnatec=" & SMG_Comms'Project_Dir & "restrict.adc");
696 for Switches ("C")
697 use ("-O2", "-Wall", "-fstack-check");
698 end case;
699 end Compiler;
700
(37 . 6)(42 . 11)
702 use ("-nostdlib");
703 end Builder;
704
705 package Naming is
706 for Spec_Suffix ("C") use ".h";
707 for Body_Suffix ("C") use ".c";
708 end Naming;
709
710 package Binder is
711 case Mode is
712 when "debug" =>
(0 . 0)(1 . 49)
717 -- S.MG, 2018
718
719 package body snd_rcv is
720 -- sender
721 task body Sender is
722 E : M_UDP.Endpoint;
723 S : M_UDP.Socket;
724 Payload : M_Q.Payload_Type;
725 Dest : M_UDP.Endpoint;
726 begin
727 -- open the socket on local interface, specified port
728 E.Address := M_UDP.INADDR_ANY;
729 E.Port := Port;
730 M_UDP.Open_Socket( S, E );
731
732 -- infinite loop reading from out queue and sending via udp
733 -- caller will have to call abort to stop this!
734 loop
735 out_q.Get( Payload, Dest.Address, Dest.Port);
736 M_UDP.Transmit( S, Dest, Payload);
737 end loop;
738 end Sender;
739
740 -- receiver
741 task body Receiver is
742 E : M_UDP.Endpoint;
743 Source : M_UDP.Endpoint;
744 S : M_UDP.Socket;
745 Payload: M_Q.Payload_Type;
746 Valid : Boolean;
747 begin
748 -- open the socket on local interface, specified port
749 E.Address := M_UDP.INADDR_ANY;
750 E.Port := Port;
751 M_UDP.Open_Socket( S, E );
752
753 -- infinite loop reading from out udp and writing to inbound queue
754 -- caller will have to call abort to stop this!
755 loop
756 M_UDP.Receive( S, Source, Payload, Valid);
757 -- store ONLY if valid, otherwise discard
758 if Valid then
759 in_q.Put( Payload, Source.Address, Source.Port);
760 end if;
761 end loop;
762
763 end Receiver;
764
765 end snd_rcv;
-(0 . 0)(1 . 34)
770 --Sender and Receiver task types for Eulora's Communication Protocol
771 --This is a THIN layer on top of UDP lib, mainly to move messages out
772 -- of the small queue of the IP stack onto a bigger, in-memory queue.
773 --There is NO processing of messages here: just read/write from/to UDP.
774 --S.MG, 2018
775
776 with Interfaces;
777 with Msg_Queue;
778 with UDP;
779
780 generic
781 -- exact length of payload aka whether RSA or Serpent
782 Len: in Positive;
783
784 package Snd_Rcv is
785 -- queue package with specified payload length
786 package M_Q is new Msg_Queue( Payload_Len => Len);
787
788 -- outbound and inbound messages queues
789 -- those are meant to be accessed from outside the package too!
790 out_q : M_Q.Queue;
791 in_q : M_Q.Queue;
792
793 -- sender type of task: takes msgs out of out_q and sends them via UDP
794 task type Sender( Port: Interfaces.Unsigned_16);
795
796 -- receiver type of tasks: reads incoming msgs from UDP and puts them in in_q
797 task type Receiver( Port: Interfaces.Unsigned_16);
798
799 private
800 -- udp lib package with specified payload length
801 package M_UDP is new UDP( Payload_Size => Len);
802
803 end Snd_Rcv;
-(0 . 0)(1 . 142)
808 ------------------------------------------------------------------------------
809 ------------------------------------------------------------------------------
810 -- This file is part of 'UDP', a datagram sockets library. --
811 -- --
812 -- (C) 2018 Stanislav Datskovskiy ( www.loper-os.org ) --
813 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
814 -- --
815 -- You do not have, nor can you ever acquire the right to use, copy or --
816 -- distribute this software ; Should you use this software for any purpose, --
817 -- or copy and distribute it to anyone or in any manner, you are breaking --
818 -- the laws of whatever soi-disant jurisdiction, and you promise to --
819 -- continue doing so for the indefinite future. In any case, please --
820 -- always : read and understand any software ; verify any PGP signatures --
821 -- that you use - for any purpose. --
822 -- --
823 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm . --
824 ------------------------------------------------------------------------------
825 ------------------------------------------------------------------------------
826
827 package body UDP is
828
829 -- Generate a human representation of a (local-endian) IP Address
830 function IP_To_String(IP : in IP_Address) return IP_Address_Text is
831 Text : IP_Address_Text := (others => ' ');
832 begin
833 Unix_UDP_IP_To_String(IP, Text'Address, Text'Length);
834 return Text;
835 end IP_To_String;
836
837
838 -- Generate a (local-endian) IP Address from given human representation
839 function IP_From_String(IP_Text : in String) return IP_Address is
840 Text_With_Null : String(1 .. IP_Text'Length + 1);
841 Result : Interfaces.C.Int := 0;
842 IP : aliased IP_Address;
843 begin
844 -- We can't use To_C because malicious idiots demanded secondary stack.
845 Text_With_Null(IP_Text'Range) := IP_Text;
846 Text_With_Null(Text_With_Null'Last) := Character'Val(0);
847
848 -- Let unix do the conversion
849 Result := Unix_UDP_String_To_IP(Text_With_Null'Address,
850 IP'Access);
851 case Result is
852 when -1 =>
853 raise UDP_Invalid_Text_IP;
854 when others =>
855 return IP;
856 end case;
857 end IP_From_String;
858
859
860 -- Open a UDP socket, with the given local endpoint for both TX and RX
861 procedure Open_Socket(S : out Socket;
862 Local_Endpoint : in Endpoint) is
863 Result : constant Interfaces.C.Int :=
864 Unix_UDP_Socket_Open(Socket => S'Address,
865 Local_IP => Local_Endpoint.Address,
866 Local_Port => Local_Endpoint.Port);
867 begin
868 case Result is
869 when -1 =>
870 raise UDP_Failed_Open;
871 when -2 =>
872 raise UDP_Failed_SetOpt;
873 when -3 =>
874 raise UDP_Failed_Bind;
875 when others =>
876 null;
877 end case;
878 end Open_Socket;
879
880
881 -- Permanently close the given open socket
882 procedure Close_Socket(S : in out Socket) is
883 begin
884 Unix_UDP_Socket_Close(Socket => S'Address);
885 end Close_Socket;
886
887
888 -- Transmit the Payload, via Socket, to given Destination
889 procedure Transmit(S : in out Socket;
890 Destination : in Endpoint;
891 Payload_Buf : in Payload) is
892 Result : constant Interfaces.C.Int :=
893 Unix_UDP_Socket_Transmit(Socket => S'Address,
894 Remote_IP => Destination.Address,
895 Remote_Port => Destination.Port,
896 Payload_Buf => Payload_Buf'Address,
897 Payload_Len => Payload'Length);
898 begin
899 case Result is
900 when -1 =>
901 Close_Socket(S);
902 raise UDP_Failed_Transmit;
903 when others =>
904 -- No eggog, but must check if sent all bytes:
905 if (Result /= Payload'Length) then
906 Close_Socket(S);
907 raise UDP_Truncated_Send;
908 end if;
909 end case;
910 end Transmit;
911
912
913 -- Wait (potentially forever!) for a Payload, via Socket; save its Origin
914 procedure Receive(S : in out Socket;
915 Origin : out Endpoint;
916 Payload_Buf : out Payload;
917 Valid : out Boolean) is
918
919 -- Scratch pad (if not successful, the call has no outputs)
920 Incoming_Payload : aliased Payload := (others => 0);
921 Incoming_IP : aliased IP_Address;
922 Incoming_Port : aliased IP_Port;
923
924 Result : constant Interfaces.C.Int :=
925 Unix_UDP_Socket_Receive(Socket => S'Address,
926 Origin_IP => Incoming_IP'Access,
927 Origin_Port => Incoming_Port'Access,
928 Payload_Buf => Incoming_Payload'Address,
929 Payload_Len => Payload'Length);
930 begin
931 Valid := False;
932 case Result is
933 when -1 =>
934 Close_Socket(S);
935 raise UDP_Failed_Receive;
936 when others =>
937 -- No eggog:
938 Origin.Address := Incoming_IP;
939 Origin.Port := Incoming_Port;
940 Payload_Buf := Incoming_Payload;
941
942 -- Was a full-length payload?
943 if (Result = Payload'Length) then
944 Valid := True;
945 end if;
946 end case;
947 end Receive;
948
949 end UDP;
-(0 . 0)(1 . 149)
954 ------------------------------------------------------------------------------
955 ------------------------------------------------------------------------------
956 -- This file is part of 'UDP', a datagram sockets library. --
957 -- --
958 -- (C) 2018 Stanislav Datskovskiy ( www.loper-os.org ) --
959 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
960 -- --
961 -- You do not have, nor can you ever acquire the right to use, copy or --
962 -- distribute this software ; Should you use this software for any purpose, --
963 -- or copy and distribute it to anyone or in any manner, you are breaking --
964 -- the laws of whatever soi-disant jurisdiction, and you promise to --
965 -- continue doing so for the indefinite future. In any case, please --
966 -- always : read and understand any software ; verify any PGP signatures --
967 -- that you use - for any purpose. --
968 -- --
969 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm . --
970 ------------------------------------------------------------------------------
971 ------------------------------------------------------------------------------
972
973 with Interfaces, Interfaces.C; use Interfaces, Interfaces.C;
974 with System; use System;
975 with Raw_Types;
976
977 generic
978 Payload_Size : in Positive; --to allow for Serpent/RSA different sizes
979
980 package UDP is
981
982 pragma Preelaborate;
983
984 subtype Payload is Raw_Types.Octets(1 .. Payload_Size);
985
986 subtype IP_Address is Unsigned_32;
987 subtype IP_Port is Unsigned_16;
988
989 -- Magic that puts emitter on 'any' local interface
990 INADDR_ANY : constant Unsigned_32 := 0;
991
992 -- An local or remote address:port
993 type Endpoint is
994 record
995 Address : IP_Address;
996 Port : IP_Port;
997 end record;
998 -- NOTE that both elements are stored in ~local~ endianness.
999
1000 -- Human Representation of any valid IP Address
1001 subtype IP_Address_Text is String(1 .. 15);
1002
1003 -- Opaque unix turd that stores a socket's state
1004 type Socket is private;
1005
1006 -- The public API:
1007
1008 -- Generate a human representation of a (local-endian) IP Address
1009 function IP_To_String(IP : in IP_Address) return IP_Address_Text;
1010
1011 -- Generate a (local-endian) IP Address from given human representation
1012 function IP_From_String(IP_Text : in String) return IP_Address;
1013
1014 -- Open a UDP socket, with the given local endpoint for both TX and RX
1015 procedure Open_Socket(S : out Socket;
1016 Local_Endpoint : in Endpoint);
1017
1018 -- Permanently close the given open socket
1019 procedure Close_Socket(S : in out Socket);
1020
1021 -- Transmit the Payload, via Socket, to given Destination
1022 procedure Transmit(S : in out Socket;
1023 Destination : in Endpoint;
1024 Payload_Buf : in Payload);
1025
1026 -- Wait (potentially forever!) for a Payload, via Socket; save its Origin,
1027 -- and whether the received Payload was valid (i.e. expected length):
1028 procedure Receive(S : in out Socket;
1029 Origin : out Endpoint;
1030 Payload_Buf : out Payload;
1031 Valid : out Boolean);
1032
1033 -- Eggogology:
1034 UDP_Invalid_Text_IP : exception;
1035 UDP_Failed_Open : exception;
1036 UDP_Failed_SetOpt : exception;
1037 UDP_Failed_Bind : exception;
1038 UDP_Failed_Transmit : exception;
1039 UDP_Truncated_Send : exception;
1040 UDP_Failed_Receive : exception;
1041
1042 private
1043
1044 -- 'nicht fuer gefingerpoken und mittengrabben!'
1045
1046 -- This record's elements are not accessed from ada:
1047 type sockaddr_in is record
1048 family : Unsigned_16;
1049 port : Unsigned_16;
1050 sin_addr : Unsigned_32;
1051 padding : Unsigned_64;
1052 end record;
1053 pragma Convention(C, sockaddr_in);
1054
1055 -- Here we also don't care about the elements, only total mass:
1056 type Socket is
1057 record
1058 SA : sockaddr_in;
1059 FD : Interfaces.C.int;
1060 end record;
1061 pragma Convention(C, Socket);
1062
1063 -- Everything below -- imports from unix_udp.c:
1064
1065 procedure Unix_UDP_IP_To_String
1066 (IP : Unsigned_32;
1067 Output_Buffer : System.Address;
1068 Output_Buffer_Size : Unsigned_32);
1069 pragma Import(C, Unix_UDP_IP_To_String, "unix_udp_ip_to_string");
1070
1071 function Unix_UDP_String_To_IP
1072 (Input_Buffer : System.Address;
1073 IP : not null access Unsigned_32) return Interfaces.C.int;
1074 pragma Import(C, Unix_UDP_String_To_IP, "unix_udp_string_to_ip");
1075
1076 function Unix_UDP_Socket_Open
1077 (Socket : System.Address;
1078 Local_IP : Unsigned_32;
1079 Local_Port : Unsigned_16) return Interfaces.C.int;
1080 pragma Import(C, Unix_UDP_Socket_Open, "unix_udp_socket_open");
1081
1082 procedure Unix_UDP_Socket_Close
1083 (Socket : System.Address);
1084 pragma Import(C, Unix_UDP_Socket_Close, "unix_udp_socket_close");
1085
1086 function Unix_UDP_Socket_Transmit
1087 (Socket : System.Address;
1088 Remote_IP : Unsigned_32;
1089 Remote_Port : Unsigned_16;
1090 Payload_Buf : System.Address;
1091 Payload_Len : Unsigned_32) return Interfaces.C.int;
1092 pragma Import(C, Unix_UDP_Socket_Transmit, "unix_udp_socket_transmit");
1093
1094 function Unix_UDP_Socket_Receive
1095 (Socket : System.Address;
1096 Origin_IP : not null access Unsigned_32;
1097 Origin_Port : not null access Unsigned_16;
1098 Payload_Buf : System.Address;
1099 Payload_Len : Unsigned_32) return Interfaces.C.int;
1100 pragma Import(C, Unix_UDP_Socket_Receive, "unix_udp_socket_receive");
1101
1102 end UDP;
-(0 . 0)(1 . 146)
1107 /*
1108 ------------------------------------------------------------------------------
1109 ------------------------------------------------------------------------------
1110 -- This file is part of 'UDP', a datagram sockets library. --
1111 -- --
1112 -- (C) 2018 Stanislav Datskovskiy ( www.loper-os.org ) --
1113 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
1114 -- --
1115 -- You do not have, nor can you ever acquire the right to use, copy or --
1116 -- distribute this software ; Should you use this software for any purpose, --
1117 -- or copy and distribute it to anyone or in any manner, you are breaking --
1118 -- the laws of whatever soi-disant jurisdiction, and you promise to --
1119 -- continue doing so for the indefinite future. In any case, please --
1120 -- always : read and understand any software ; verify any PGP signatures --
1121 -- that you use - for any purpose. --
1122 -- --
1123 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm . --
1124 ------------------------------------------------------------------------------
1125 ------------------------------------------------------------------------------
1126 */
1127
1128 #include <string.h>
1129 #include <unistd.h>
1130 #include <arpa/inet.h>
1131 #include <netinet/in.h>
1132 #include <sys/types.h>
1133 #include <sys/socket.h>
1134
1135
1136 /* Socket state representation: */
1137 typedef struct _UDP_Socket {
1138 struct sockaddr_in sa_local;
1139 int sock;
1140 } UDP_Socket;
1141
1142
1143 /* local-endian ip to string conversion */
1144 void unix_udp_ip_to_string(uint32_t ip, char *buf, uint32_t buf_size) {
1145 struct in_addr addr;
1146 addr.s_addr = htonl(ip);
1147 char *txt = inet_ntoa(addr);
1148 /* Given IP might be shorter than buf_size so don't copy blindly. */
1149 int len = strlen(txt);
1150 /* ONTH don't ever copy more than buf_size either */
1151 if (len > buf_size)
1152 len = buf_size;
1153 strncpy(buf, txt, len);
1154 }
1155 /* Should be replaced with native routine */
1156
1157
1158 /* string to local-endian ip conversion */
1159 int unix_udp_string_to_ip(char *buf, uint32_t *ip) {
1160 struct in_addr addr;
1161 if (inet_aton(buf, &addr) <= 0)
1162 return -1;
1163 *ip = ntohl(addr.s_addr);
1164 return 0;
1165 }
1166 /* Should be replaced with native routine */
1167
1168
1169 int unix_udp_socket_open(UDP_Socket *S,
1170 uint32_t local_ip, uint16_t local_port) {
1171 /* Open the socket FD: */
1172 if ((S->sock = socket(AF_INET, SOCK_DGRAM, IPPROTO_UDP)) < 0) {
1173 return -1;
1174 }
1175
1176 memset(&S->sa_local, 0, sizeof(struct sockaddr_in));
1177
1178 /* Set up emitter endpoint, converting from local endianness: */
1179 S->sa_local.sin_family = AF_INET;
1180 S->sa_local.sin_addr.s_addr = htonl(local_ip);
1181 S->sa_local.sin_port = htons(local_port);
1182
1183 /* Cure the asinine linuxism where dead sockets interfere with living: */
1184 int one = 1;
1185 if (setsockopt(S->sock, SOL_SOCKET, SO_REUSEADDR, &one, sizeof(one)) < 0) {
1186 close(S->sock);
1187 return -2;
1188 }
1189
1190 /* Bind the socket */
1191 if (bind(S->sock,
1192 (struct sockaddr *)&(S->sa_local), sizeof(S->sa_local)) < 0) {
1193 close(S->sock);
1194 return -3;
1195 }
1196
1197 /* ok */
1198 return 0;
1199 }
1200
1201
1202 void unix_udp_socket_close(UDP_Socket *S) {
1203 close(S->sock);
1204 }
1205
1206
1207 int unix_udp_socket_transmit(UDP_Socket *S,
1208 uint32_t remote_ip, uint16_t remote_port,
1209 uint8_t *payload, uint32_t payload_len) {
1210 int bytes_sent = 0;
1211 struct sockaddr_in remote_addr;
1212 memset((char *)&remote_addr, 0, sizeof(remote_addr));
1213
1214 /* Set up dest endpoint, converting from local endianness: */
1215 remote_addr.sin_family = AF_INET;
1216 remote_addr.sin_port = htons(remote_port);
1217 remote_addr.sin_addr.s_addr = htonl(remote_ip);
1218
1219 /* Transmit Datagram */
1220 bytes_sent = sendto(S->sock, payload, payload_len,
1221 0, /* no flags */
1222 (struct sockaddr*)&remote_addr,
1223 sizeof(remote_addr));
1224 if (bytes_sent <= 0)
1225 return -1;
1226
1227 return bytes_sent;
1228 }
1229
1230
1231 int unix_udp_socket_receive(UDP_Socket *S,
1232 uint32_t *origin_ip, uint16_t *origin_port,
1233 uint8_t *payload, uint32_t payload_len) {
1234 int bytes_received = 0;
1235 struct sockaddr_in orig_addr;
1236 socklen_t orig_addr_len = sizeof(orig_addr);
1237 memset((char *)&orig_addr, 0, sizeof(orig_addr));
1238
1239 /* Receive Datagram (blocking!) */
1240 bytes_received = recvfrom(S->sock, payload, payload_len,
1241 0, /* no flags */
1242 (struct sockaddr *)&orig_addr,
1243 &orig_addr_len);
1244
1245 if (bytes_received < 0) return -1;
1246
1247 /* Save the originator's endpoint in ~local~ endianness */
1248 *origin_ip = ntohl(orig_addr.sin_addr.s_addr);
1249 *origin_port = ntohs(orig_addr.sin_port);
1250
1251 return bytes_received;
1252 }
-(0 . 0)(1 . 131)
1257 -- S.MG, 2018
1258 with Snd_Rcv;
1259 with Interfaces;
1260 with Ada.Text_IO; use Ada.Text_IO;
1261 with Raw_Types;
1262 with UDP;
1263
1264 procedure Test_Client is
1265 PortRSA : Interfaces.Unsigned_16 := 34340;
1266 PortS : Interfaces.Unsigned_16 := 34341;
1267 N_S : Interfaces.Unsigned_8 := 105;
1268 N_RSA : Interfaces.Unsigned_8 := 82;
1269
1270 Server : String := "127.0.0.1";
1271 package test_udp is new UDP(10);
1272 ServerA : Interfaces.Unsigned_32 :=
1273 test_udp.IP_From_String(Server);
1274 ServerRSA : Interfaces.Unsigned_16 := 44340;
1275 ServerS : Interfaces.Unsigned_16 := 44341;
1276 package Snd_Rcv_RSA is new Snd_Rcv(Raw_Types.RSA_Pkt'Length);
1277 package Snd_Rcv_S is new Snd_Rcv(Raw_Types.Serpent_Pkt'Length);
1278 -- sender RSA and Serpent
1279 Sender_RSA: Snd_Rcv_RSA.Sender( PortRSA );
1280 Sender_S : Snd_Rcv_S.Sender( PortS );
1281 -- receiver RSA and Serpent
1282 Receiver_RSA: Snd_Rcv_RSA.Receiver( PortRSA );
1283 Receiver_S: Snd_Rcv_S.Receiver( PortS );
1284
1285 -- producer of serpent messages
1286 task s_prod is
1287 entry Finish;
1288 end s_prod;
1289 task body s_prod is
1290 Payload : Raw_Types.Serpent_Pkt := (others => 10);
1291 begin
1292 Put_Line("S Producer with " &
1293 Interfaces.Unsigned_8'Image(N_S) & "messages.");
1294 -- send the messages with first octet the number
1295 for I in 1..N_S loop
1296 Payload(Payload'First) := I;
1297 Snd_Rcv_S.out_q.Put( Payload, ServerA, ServerS);
1298 Put_Line("Sent S message " &
1299 Interfaces.Unsigned_8'Image(I));
1300 end loop;
1301
1302 -- signal it's done
1303 accept Finish;
1304 Put_Line("S prod got the finish.");
1305
1306 end s_prod;
1307
1308 -- producer of RSA messages
1309 task rsa_prod is
1310 Entry Finish;
1311 end rsa_prod;
1312 task body rsa_prod is
1313 Payload : Raw_Types.RSA_Pkt := (others => 20);
1314 begin
1315 Put_Line("RSA Producer with " &
1316 Interfaces.Unsigned_8'Image(N_RSA) & "messages.");
1317
1318 -- send the messages with first octet the number
1319 for I in 1..N_RSA loop
1320 Payload(Payload'First) := I;
1321 Snd_Rcv_RSA.out_q.Put( Payload, ServerA, ServerRSA);
1322 Put_Line("Sent RSA message " &
1323 Interfaces.Unsigned_8'Image(I));
1324 end loop;
1325
1326 -- signal it's done
1327 accept Finish;
1328 Put_Line("RSA prod got the finish.");
1329
1330 end rsa_prod;
1331
1332 -- Serpent Consumer
1333 task s_cons is
1334 Entry Finish;
1335 end s_cons;
1336 task body s_cons is
1337 Payload: Raw_Types.Serpent_Pkt;
1338 A: Interfaces.Unsigned_32;
1339 P: Interfaces.Unsigned_16;
1340 begin
1341 for I in 1..N_S loop
1342 -- consume one message
1343 Snd_Rcv_S.in_q.Get(Payload, A, P);
1344 Put_Line("S msg " &
1345 Interfaces.Unsigned_8'Image(Payload(Payload'First)) &
1346 " from " & Interfaces.Unsigned_32'Image(A) &
1347 ":" & Interfaces.Unsigned_16'Image(P));
1348 -- do NOT echo it back
1349 end loop;
1350
1351 accept Finish;
1352 Put_Line("S Cons got the finish.");
1353 end s_cons;
1354
1355 -- RSA Consumer
1356 task rsa_cons is
1357 Entry Finish;
1358 end rsa_cons;
1359 task body rsa_cons is
1360 Payload: Raw_Types.RSA_Pkt;
1361 A: Interfaces.Unsigned_32;
1362 P: Interfaces.Unsigned_16;
1363 begin
1364 for I in 1..N_RSA loop
1365 -- consume one message
1366 Snd_Rcv_RSA.in_q.Get(Payload, A, P);
1367 Put_Line("RSA msg " &
1368 Interfaces.Unsigned_8'Image(Payload(Payload'First)) &
1369 " from " & Interfaces.Unsigned_32'Image(A) &
1370 ":" & Interfaces.Unsigned_16'Image(P));
1371 -- do NOT echo back
1372 end loop;
1373
1374 accept Finish;
1375 Put_Line("RSA Cons got the finish.");
1376 end rsa_cons;
1377 begin
1378 Put_Line("Test client");
1379 -- wait for producers/consumers to finish
1380 rsa_prod.Finish;
1381 s_prod.Finish;
1382 rsa_cons.Finish;
1383 s_cons.Finish;
1384
1385 -- abort the sender & receiver to be able to finish
1386 abort Sender_S, Receiver_S, Sender_RSA, Receiver_RSA;
1387 end Test_Client;
- 1322077DAF28A3C0B18CCCB0706B169EE291ECBE55510B2A6F6EAC660CF384E018824CA7270CC6996AF36FC00E778D52B0422FA682DA40055C287079FAF43AFE(17 . 7)(17 . 8)
1392 for Object_Dir use "obj";
1393 for Exec_Dir use ".";
1394
1395 for Main use ("testall.adb", "test_queue.adb");
1396 for Main use ("testall.adb", "test_queue.adb",
1397 "test_client.adb", "test_server.adb");
1398
1399 package Compiler is
1400
-(0 . 0)(1 . 79)
1405 -- S.MG, 2018
1406 with Ada.Text_IO; use Ada.Text_IO;
1407 with Interfaces;
1408 with Snd_Rcv;
1409 with Raw_Types;
1410
1411 procedure Test_Server is
1412 PortRSA: Interfaces.Unsigned_16 := 44340;
1413 PortS : Interfaces.Unsigned_16 := 44341;
1414 N_S : Interfaces.Unsigned_8 := 105;
1415 N_RSA : Interfaces.Unsigned_8 := 82;
1416 package Snd_Rcv_RSA is new Snd_Rcv(Raw_Types.RSA_Pkt'Length);
1417 package Snd_Rcv_S is new Snd_Rcv(Raw_Types.Serpent_Pkt'Length);
1418
1419 -- sender/receiver tasks --
1420 -- sender RSA and Serpent
1421 Sender_RSA: Snd_Rcv_RSA.Sender( PortRSA );
1422 Sender_S : Snd_Rcv_S.Sender( PortS );
1423 -- receiver RSA and Serpent
1424 Receiver_RSA: Snd_Rcv_RSA.Receiver( PortRSA );
1425 Receiver_S: Snd_Rcv_S.Receiver( PortS );
1426
1427 -- Serpent Consumer
1428 task s_cons is
1429 Entry Finish;
1430 end s_cons;
1431 task body s_cons is
1432 Payload: Raw_Types.Serpent_Pkt;
1433 A: Interfaces.Unsigned_32;
1434 P: Interfaces.Unsigned_16;
1435 begin
1436 for I in 1..N_S loop
1437 -- consume one message and echo it back
1438 Snd_Rcv_S.in_q.Get(Payload, A, P);
1439 Put_Line("S msg " &
1440 Interfaces.Unsigned_8'Image(Payload(Payload'First)) &
1441 " from " & Interfaces.Unsigned_32'Image(A) &
1442 ":" & Interfaces.Unsigned_16'Image(P));
1443 -- echo it back
1444 Snd_Rcv_S.out_q.Put(Payload, A, P);
1445 end loop;
1446
1447 accept Finish;
1448 Put_Line("S Cons got the finish.");
1449 end s_cons;
1450
1451 -- RSA Consumer
1452 task rsa_cons is
1453 Entry Finish;
1454 end rsa_cons;
1455 task body rsa_cons is
1456 Payload: Raw_Types.RSA_Pkt;
1457 A: Interfaces.Unsigned_32;
1458 P: Interfaces.Unsigned_16;
1459 begin
1460 for I in 1..N_RSA loop
1461 -- consume one message and echo it back
1462 Snd_Rcv_RSA.in_q.Get(Payload, A, P);
1463 Put_Line("RSA msg " &
1464 Interfaces.Unsigned_8'Image(Payload(Payload'First)) &
1465 " from " & Interfaces.Unsigned_32'Image(A) &
1466 ":" & Interfaces.Unsigned_16'Image(P));
1467 -- echo it back
1468 Snd_Rcv_RSA.out_q.Put(Payload, A, P);
1469 end loop;
1470
1471 accept Finish;
1472 Put_Line("RSA Cons got the finish.");
1473 end rsa_cons;
1474
1475 begin
1476 Put_Line("Test server");
1477 -- wait for consumers to finish
1478 rsa_cons.Finish;
1479 s_cons.Finish;
1480
1481 -- abort the sender & receiver to be able to finish
1482 abort Sender_S, Receiver_S, Sender_RSA, Receiver_RSA;
1483 end Test_Server;