Kubernetes Follow-On (Part 2)

Kubernetes Follow-On (Part 2)

In the previous post I described sending messages directly between components via TCP/IP (Transmission Control Protocol/Internet Protocol) via Microsoft WinSock rather than between Applications and then delivering the message to the applicable component.  This was done by assigning receive/client and transmit/server ports to the component and using the port along with the IP address of the computer.  At that time the example had one component in each of two applications.

Since then I have extended the examples to have two components within the first application to communicate with each other as well as one of its components communicating with the component of the second application as before.  Then, what proved to be much more difficult to for me to figure out, the addition of a second component to the second app and having both communicate with a component of a third app to be run on a second computer.  Hence using a different IP address.

During this time I was also cleaning up my WinSock package code from the time at the beginning of the decade when I first used it.  And, making some changes that I thought would improve the ability of the WinSock code to connect to its remote application's components whether on the same computer or a different one.  Some of these "improvements" proved to be an impediment to say the least.  But at least one change was necessary. 

That is, the Receive/Client and Transmit/Server WinSock subpackages (Recv and Xmit) have their Install procedure similar to components.  As with components there is the Install procedure that runs in the launch thread of the application and their callback procedure that runs in the thread assigned by the Threads package.  But unlike components there is one pair of callback procedures (one Recv and one Xmit) per pair of component partners.  Whereas in components static data can be maintained in the package body that is used and updated by the callback thread, doing so in the Recv and Xmit packages caused a problem since there was only one Recv and one Xmit Install but multiple threads to access and update the data.  Hence, the second Install would clobber selected data of the first and the callback procedures wouldn't find the expected values.  This was fixed by adding additional fields to the Comm Data and Link array records to maintain this data.  That is, where there were separate records in the Data and Link array to be accessed by each thread.  Thus removing the data it from the static data area of the Recv and Xmit subpackages and placing it in the static data of the WinSock package itself.

Also, where possible in some instances other data was moved to the thread callback procedure where the data would be on the stack of the particular thread.  That is, data that was only used by the individual callback procedure.

Delivery.dat

I also rearranged and extended the Delivery.dat file records to require more extensive searching to find the partners of the components.  That is, allowing the creation and maintenance of the Delivery.dat file to be more flexible.  This ended up as

1|Component1|192.xxx.y.c1|10.0.0.1|8001|8002|

6|RemoteComponent|192.xxx.y.c2|10.1.1.1|8006|8005|

2|Component2|192.xxx.y.c1|10.0.0.2|8002|8001|

2|Component2|192.xxx.y.c1|10.0.0.2|8009|8010|

6|RemoteComponent|192.xxx.y.c2|10.1.1.2|8010|8009|

1|Component1|192.xxx.y.c1|10.0.0.1|8003|8004|

8|Component8|192.xxx.y.c1|10.0.0.4|8007|8008|

4|NewComponent|192.xxx.y.c1|10.0.0.2|8004|8003|

5|ExComponent|192.xxx.y.c1|10.0.0.3|8005|8006|

where xxx.y.c1 and xxx.y.c2 are the other three bytes of the IP address of the first and second computers.

As before, the extra IP addresses such as 10.0.0.1 have been left in the file but are unused since the ports are sufficient to identify the component of the TCP/IP communications.

In the file the '|' character is used as a field separator.  The first field is the numeric identifier of the component and the second its name.  The third field is the IP address of the computer where the application is executed.  The fourth field is the addition IP address that would be assigned if the ports weren't used.  The fifth and sixth fields are the pair of ports assigned to the component – one for the client and one for the server. 

The ports are reversed for the partner instance of the communicating component.  For instance Component1 of the first record is to communicate with Component2 of the third record.  And Component1 of the sixth record is to communicate with NewComponent of the eighth record.  This would be more obvious if the pair of communicating components were placed next to each other in the Delivery.dat file as I had in the first post but I wanted to mix them up to be sure the code could still find the pairs.

Debugging

I did debugging by outputting Ada Text_IO to the "console".  I would use separate Put statements of text and integers to build up a line and then do a Put_Line to end the sequence.  This caused confusion when another thread would suspend the first thread and do or start its own "line" causing data of the initial output to become separated when the initial thread resumed.

Therefore, I created a new Text IO package to more easily combine strings and integers so that the write of the line could be done all at once.  I added functions to concatenate a string and an integer and to concatenate two strings while inserting a space between them in each instance.  The new TextIO package Concat of an integer to a string also removes any leading spaces that the Ada Int_IO caused so that the string and the converted integer are immediately adjacent except for the inserted space.  These two functions can be used to build up a set of such values to form a string of up to 80 characters that can be output via the new TextIO Put_Line procedure.

For instance,

      declare

        Text : Itf.V_80_String_Type;

        IPAddr : Itf.ByteArray(1..4);

        for IPAddr use at Comm.Link(I).Transmit.Socket.Data.SIn_Addr'address;

      begin

        Text.Count := 8;

        Text.Data(1..8) := "SIn_Addr";

        Text := TextIO.Concat( Text.Data(1..Text.Count), Integer(IPAddr(1)) );

        Text := TextIO.Concat( Text.Data(1..Text.Count), Integer(IPAddr(2)) );

        Text := TextIO.Concat( Text.Data(1..Text.Count), Integer(IPAddr(3)) );

        Text := TextIO.Concat( Text.Data(1..Text.Count), Integer(IPAddr(4)) );

        TextIO.Put_Line( Text );

      end;

to output the IP address as four bytes as it is stored in Comm.Link(I).Transmit.Socket.Data.

Some of the original Text_IO and Int_IO output remains.  Mostly where the output is being done while in the launch thread so other threads can not suspend it.

One Mystery Solved

Not until April 30 did the light finally dawn to me.

After not getting the one PC to communicate via TCP/IP using the WinSock of Microsoft with a second PC for some time and looking back at my work of 10 years ago when I know that I was able to communicate between two computers, I finally saw what had been in plain sight but hadn't revealed itself to me.  That is, as I "install" the components with WinSock I output text.  Included in this text was the IP address such as

                 Id  Name                                    Partner Location in table

          1 Component1                    3

          6 RemoteComponent               9

          2 Component2                    1

          2 Component2                    5

          6 RemoteComponent               4

          1 Component1                    8

          8 Component8                    0

          4 NewComponent                  6

          5 ExComponent                   2

Thread item Name Component2

EventName Component2         384

Items added - Possible_Pairs 1 1 2 Comm.Data 2 1 4265706 ß A

Items added - Possible_Pairs 2 2 6 Comm.Data 2 6 4265706 ß B

Comm.Link for Receive Socket 1 SIn_Port 16671 SIn_Addr 1124182208 Addr 4893340

SIn_Addr 192 xxx y c1

Comm.Link for Transmit Socket 1 SIn_Port 16927 SIn_Addr 1124182208 Addr 4893392

SIn_Addr 192 xxx y c1 ß B'

Comm.Link for Receive Socket 2 SIn_Port 18975 SIn_Addr 1124182208 Addr 4893444 ß D

SIn_Addr 192 xxx y c1

Comm.Link for Transmit Socket 2 SIn_Port 18719 SIn_Addr 1124182208 Addr 4893496

SIn_Addr 192 xxx y c1

Thread item Name ExComponent

EventName ExComponent         388

Items added - Possible_Pairs 3 5 6 Comm.Data 5 6 4266298 ß C

Comm.Link for Receive Socket 3 SIn_Port 17951 SIn_Addr 1124182208 Addr 4893548

SIn_Addr 192 xxx y c1

Comm.Link for Transmit Socket 3 SIn_Port 17695 SIn_Addr 1124182208 Addr 4893600

SIn_Addr 192 xxx y c1 ß C'

for communicating between the components Component2 and ExComponent of App2 of the one PC and the RemoteComponent of App3 running on the other PC.  In this output the line marked with A is between the component pair (1,2) where Component1 with an id of 1 (in the "table" at the top) is a component in App1 that runs on the same PC.  The line marked with B is for the component pair (2,6) and its Receive and Transmit Socket data is in the four lines starting at D.  The line marked with C and the four below it are for the component pair (5,6).

As can be seen all the SIn_Addr lines show the same IP address – that of the PC on which App2 (and App1) are running with their components where all of the components are executed except RemoteComponent which runs on the second PC.

I was used to this output since I had been using just App1 to communicate between its two components (Component1 and NewComponent) and Component1 communicating with Component2 – that is, two components of one application in the first instance and two components of two different applications in the second.

So it was only after many days, after yet another attempt to duplicate the work of years ago by different code, that I realized that the IP addresses shouldn't all be alike now that RemoteComponent was involved which ran on the other PC.  That the C_Accept WinSock function should be providing the IP address of the PC to which it should be transmitting.  And it wasn't available to do so.  (I assumed at that time that the Accept was the Windows call that should use the other PC's IP address – that is, the IP address to which the Server would be sending the message.  More about that later.)

Thus the other IP address was not available in the tables that WinSock Install had created from which the above text was output.  However, it is available in the Delivery.dat file that is used to provide some of the information in the nine lines at the beginning of the sample output as shown in the Delivery.dat file above.  In the Delivery file the two instances of component id 6 (the second line and the fifth) contain the IP address of the second PC.  Therefore, in building the transmit IP address (the lines marked with B' and C') the IP address of the RemoteComponent needed to be supplied.  (Or so I assumed at the time.  That is, I assumed that the transmit would need the IP address of the computer to which it was sending the message.)

The mystery is why did it take me so long to recognize that this address wasn't being made available for the C_Accept function to use.

The Second Mystery Solved

On May 4th, after making adjustments to use the other PC's IP address as the transmit entry, as mentioned above, the connections still weren't being made.  As I went through the Microsoft WinSock material again I realized that the other PC's IP address was supposed to be for the Client – my Receive – component and not the Server – my Transmit – entry.  So I switched the usage.

What with other changes I had made in the meantime, connections still weren't being made.  But I reverted one change back to how I had had it – that is, doing the assignment of the address family, type, and protocol to the socket; the bind; and the listen back to the Xmit Install and out of the particular Xmit thread of the component where I had moved it.  This caused it to happen prior to the threads running for each of the components.  And therefore in advance of the assignment of the address family, type, and protocol followed by the connect function invocation for the client/receive that remained as the initial activity of each of the Recv threads.

I then got a very brief connection (that luckily I just happened to see) buried in the text output of the remote component of the third application that was running on the other PC.  There were apparently two causes for this only brief appearance of messages being received.  One was the security software that quickly didn't like the strange new request for service.  And which refused to believe an operator (myself) that would respond to always allow the request.  The other was that after getting WSA errors, WinSock would refuse to continue.

Success!!

However, trying often enough seemed to satisfy the security software and starting and running all three applications at close to the same time avoided the WinSock non-connection problems and hence WSA errors.  Under these conditions the components of all three applications communicated – sent and received messages – with each other and didn't stop until the applications were terminated.

Therefore, components within a particular application can communicate, components within different applications on the same computer can communicate, and components in applications on different computers can communicate.  That is, as long as all the applications of the configuration's component pairs specified in the Delivery.dat file are run at the same time.

Sample Output

App1 message sample

Component1 received a message: Component2 message  <-- 1

Xmit Callback loop 2 2 True

index of 2

Xmit after C_Accept 2

Component1 wait for event

Component1 after end of wait

Component1 sending to Component2

Transmit Index 1 DeliverTo 2

Transmit sent using socket port 16927

Component1 sending to component4

Transmit Index 2 DeliverTo 4

NewComponent received a message: Component1 message for 4 <-- 1

Transmit sent using socket port 17439

NewComponent in forever loop

Transmit Index 3 DeliverTo 1

Transmit 3 not connected, returning

Xmit Callback loop 3 3 True

index of 3

Xmit after C_Accept 3

Component1 received a message: Component2 message <-- 2

Component1 wait for event

Component1 after end of wait

Component1 sending to Component2

Transmit Index 1 DeliverTo 2

Transmit sent using socket port 16927

Component1 sending to component4

Transmit Index 2 DeliverTo 4

NewComponent received a message: Component1 message for 4 <-- 2

Transmit sent using socket port 17439

NewComponent in forever loop

Transmit Index 3 DeliverTo 1

Component1 received a message: Component4 message   3 <-- 1

Transmit sent using socket port 17183

Component1 received a message: Component2 message  <-- 3

This sample shows messages received by Component1 of App1 from Component2 of App2 and those received by the intra-App1 components – Component1 from NewComponent (also identified as Component4) and by NewComponent from Component1.  Three messages received by Component1 from Component2 of App2; two messages received by NewComponent from Component1; and one message received by Component1 from NewComponent (identified as Component4 in the message) in the sample shown.

This next sample shows messages received by Component2 of App2.

Component2 received a message: RemoteComponent message -> 1

ExComponent wait to transmit to 6

Transmit Index 2 DeliverTo 6

Transmit 2 not connected, returning

Component2 to send to Component1

Transmit Index 1 DeliverTo 1

Transmit 1 not connected, returning

Component2 to send to RemoteComponent

Transmit Index 2 DeliverTo 6

Transmit 2 not connected, returning

Xmit Callback loop 2 2 True

index of 2

Xmit after C_Accept 2

Xmit after C_Accept 1

ExComponent wait to transmit to 6

Transmit Index 2 DeliverTo 6

Transmit sent using socket port 18975

Xmit Callback loop 3 3 True

index of 3

Xmit Callback initial loop end

Component2 received a message: RemoteComponent message -> 2

Component2 to send to Component1

Transmit Index 1 DeliverTo 1

Transmit sent using socket port 16671

Component2 to send to RemoteComponent

Transmit Index 2 DeliverTo 6

Transmit sent using socket port 18975

ExComponent wait to transmit to 6

Transmit Index 2 DeliverTo 6

Transmit sent using socket port 18975

Component2 received a message: Component1 message for 2 -> 1

Component2 received a message: RemoteComponent message  -> 3

Xmit Callback loop 3 3 True

index of 3

Xmit Callback initial loop end

ExComponent wait to transmit to 6

Transmit Index 2 DeliverTo 6

Transmit sent using socket port 18975

Component2 to send to Component1

Transmit Index 1 DeliverTo 1

Transmit sent using socket port 16671

Component2 to send to RemoteComponent

Transmit Index 2 DeliverTo 6

Transmit sent using socket port 18975

Component2 received a message: Component1 message for 2 <-- 2

Component2 received a message: RemoteComponent message  <-- 4

It shows four messages received and delivered to Component2 from RemoteComponent of App3 running on the other PC and two messages received by Component2 from Component1 of App1 running on the same PC.

The third sample illustrates the messages received by the RemoteComponent of App3 running on the other PC.  This sample shows three messages received from Component2 of App2 and four messages received from the ExComponent of App2.

RemoteComponent sending to component5

RemoteComponent received a message: ExComponent message ß 1

RemoteComponent sending to component2

Transmit Index 1 DeliverTo 2

Transmit sent using socket port 18719

RemoteComponent received a message: Component2 message to 6 ß 1

RemoteComponent sending to component5

RemoteComponent received a message: ExComponent message ß 2

RemoteComponent sending to component2

Transmit Index 1 DeliverTo 2

Transmit sent using socket port 18719

RemoteComponent received a message: ExComponent message ß 3

RemoteComponent received a message: Component2 message to 6 ß 2

RemoteComponent sending to component5

RemoteComponent sending to component2

Transmit Index 1 DeliverTo 2

Transmit sent using socket port 18719

RemoteComponent received a message: ExComponent message ß 4

RemoteComponent received a message: Component2 message to 6 ß 3

RemoteComponent sending to component5

The three samples illustrate components of the same application communicating with each other, components of two different applications running on the same PC communicating with each other, and components running on two different PCs communicating with each other.  In each case just using the TCP/IP IP address and the WinSock ports assigned to the components.

Follow-On

The next problem to be solved is how to continue communicating between the running applications when not all those of the configuration are being run.

Sample output of the failure to communicate follows.

ERROR: WSALastError      10061 ç

Client Socket 3 NOT Connected

ERROR: Client Connect 3 FAILED: ç

WinSock Receive 03                 3

Receive NOT Connected 3 17695

Component2 to send to Component1

Transmit Index 1 DeliverTo 1

Transmit sent using socket port 16671

Component2 to send to RemoteComponent

Transmit Index 2 DeliverTo 6

Transmit 2 not connected, returning

ReceiveCreate Index 3

ExComponent wait to transmit to 6

Transmit Index 2 DeliverTo 6

Transmit 2 not connected, returning

Component2 received a message: Component1 message for 2 ß

ERROR: WSALastError      10061 ç

ERROR: WinSock Receive failed 2

ERROR: WSALastError          0

ERROR: WinSock Receive failed 1

ERROR: WSALastError          0Xmit after C_Accept 2

ERROR: Server Client Socket NOT accepted

ERROR: WSALastError          0

Xmit Callback initial loop end

Client Socket 3 NOT Connected

ERROR: Client Connect 3 FAILED:

WinSock Receive 03                 3

Receive NOT Connected 3 17695

ReceiveCreate Index 3

ERROR: WSALastError      10093 ç

There is the initial WSA error of 10061 for a failure between App2 and App3, then one message received for Component2 from Component1, followed by another 10061 error.  This is then followed by 10093 errors of which the first is shown.

A Microsoft on-line document says that error 10061 is for Connection refused – that the target computer actively refused the connection. That, it states, this condition usually results from trying to connect to a service that is inactive on the foreign host—that is, one with no server application running.  10093 has the comment Successful WSAStartup not yet performed or WSACleanup has been called too many times.  Since the WSAStartup was done the error would seem to be for WSACleanup called too many times.  Since there were two 10061 errors, too many times would seem to be mean more than once.

Code

Other than the new components which are clones of those presented in the first post and the changes that had to be made to Threads to allow for more threads as more components were added, which are just an extension of the previously presented code, the code not shown before is that of the TextIO package and the body of the WinSock package and its sub packages.

TextIO code

The specification

with Itf;

package TextIO is

  function Concat

  ( S1 : String;

    I2 : Integer

  ) return Itf.V_80_String_Type;

  function Concat

  ( S1 : String;

    S2 : String

  ) return Itf.V_80_String_Type;

  procedure Put_Line

  ( Text : in Itf.V_80_String_Type

  );

end TextIO;

The implementation

with Text_IO;

package body TextIO is

  function toString

  ( Int : in Natural

  ) return Itf.V_String_Type is

    Start

    -- Index of first non-zero digit

    : Integer;

    Temp1

    -- Temporary string

    : Itf.V_String_Type

    := ( Count => 0,

         Data  => ( others => '0' ) );

    Temp2

    -- Return string

    : Itf.V_String_Type

    := ( Count => 0,

         Data  => ( others => ' ' ) );

    Work

    -- Working integer

    : Integer := Int;

  begin -- toString

    for I in reverse 1..12 loop

      Temp1.Data(I) := Character'Val( Character'Pos( '0' ) + ( Work mod 10 ) );

      Temp1.Count := Temp1.Count + 1;

      Work := Work / 10;

      exit when Work = 0;

    end loop;

    if Work /= 0 then

      Text_IO.Put_Line("ERROR: Conversion Error in TextIO toString");

    end if;

    -- Remove leading 0s

    Start := 12;

    for I in 1..11 loop

      if Temp1.Data(I) /= '0' then

        Start := I;

        exit;

      end if;

      Temp1.Data(I) := ' ';

    end loop;

    -- Move digits to the beginning and into the string to be returned

    Temp2.Count := 0;

    for I in Start..12 loop

      Temp2.Count := Temp2.Count + 1;

      Temp2.Data(Temp2.Count) := Temp1.Data(I);

    end loop;

    return Temp2;

  end toString;

  function Concat -- leaving separating space

  ( S1 : String;

    I2 : Integer

  ) return Itf.V_80_String_Type is

    Temp1 : Itf.V_80_String_Type;

    Temp2 : Itf.V_String_Type;

  begin -- Concat

    Temp1.Data := ( others => ' ' );

    Temp2 := toString(abs(I2));

    Temp1.Count := S1'Length;

    Temp1.Data(1..S1'Length) := S1;

    -- Insert separating space after input string

    Temp1.Count := Temp1.Count + 1;

    Temp1.Data(Temp1.Count) := ' ';

    -- Concatenate string of converted integer

    Temp1.Data(Temp1.Count+1..Temp1.Count+Temp2.Count) :=

      Temp2.Data(1..Temp2.Count);

    Temp1.Count := Temp1.Count+Temp2.Count;

    return Temp1;

  end Concat;

  function Concat

  ( S1 : String;

    S2 : String

  ) return Itf.V_80_String_Type is

    Count : Integer;

    Temp1 : Itf.V_80_String_Type;

  begin -- Concat

    Temp1.Count := S1'Length;

    Temp1.Data(1..Temp1.Count) := S1;

    Temp1.Count := Temp1.Count + 1;

    Temp1.Data(Temp1.Count) := ' '; -- Insert separating space

    Count := Temp1.Count + S2'Length;

    Temp1.Data(Temp1.Count+1..Count) := S2;

    Temp1.Count := Count;

    return Temp1;

  end Concat;

  procedure Put_Line

  ( Text : in Itf.V_80_String_Type

  ) is

  begin -- Put_Line

    Text_IO.Put_Line(Text.Data(1..Text.Count));

  end Put_Line;

end TextIO;

WinSock Package code

No doubt the WinSock package can still use some improvements.  Here are its current packages and separates.

The specification

with ExecItf;

with Itf;

with System;

package WinSock is

  subtype Component_Ids_Type

  -- Identifier of the hosted components.

  -- Notes:

  --   This allows for a configuration with a maximum of 63 components.

  is Integer range 0..63;

  subtype Component_Name_Type

  is String(1..25);

  type ReceiveCallbackType

  -- Callback to return received message to its component

  is access procedure( Message : in String );

  -- Do overall initialization of arrays

  procedure Initialize;

  -- Add to the tables for particular component

  procedure Install

  ( ComponentId  : in Component_Ids_Type;

    Component    : in String;

    RecvCallback : in ReceiveCallbackType

  );

  -- Finalize the Comm arrays and invoke the Recv and Xmit for each pair

  procedure Finalize;

  -- Send a message to its DeliverTo component

  procedure Transmit

  ( DeliverTo : in Component_Ids_Type;

    Count     : in Itf.Message_Size_Type;

    Message   : in System.Address

  );

end WinSock;

The implementation (without the code separates)

with Text_IO;

with Unchecked_Conversion;

package body WinSock is

  package Int_IO is new Text_IO.Integer_IO( Integer );

  type Communication_Direction_Type

  is ( Receive,

       Transmit );

  type Possible_Pairs_Count_Type

  -- Range of possible component pairs that can inter-communicate

  is range 0..45;

  subtype Possible_Pairs_Index_Type

  is Possible_Pairs_Count_Type range 1..Possible_Pairs_Count_Type'Last;

  type Connection_Count_Type

  -- Number of allowed different connections that can be treated at one time

  is new Integer range 0..10;

  subtype Connection_Index_Type

  -- Index into Connection Data array

  is Connection_Count_Type range 1..Connection_Count_Type'last;

  WSAData

  -- Windows structure that contains the information on the configuration of

  -- the WinSock DLL, including the highest version available.  This structure

  -- is a record that contains

  --   wVersion      : Exec_Itf.WORD;

  --   wHighVersion  : Exec_Itf.WORD;

  --   szDescription : Exec_Itf.WSA_CHAR_Array(0..WSADESCRIPTION_LEN);

  --   szSystemStatus: Exec_Itf.WSA_CHAR_Array(0..WSASYS_STATUS_LEN);

  --   iMaxSockets   : Exec_Itf.USHORT;

  --   iMaxUdpDg     : Exec_Itf.USHORT;

  --   lpVendorInfo  : Exec_Itf.PSTR;

  : ExecItf.WSADATA;

  function to_LPWSADATA -- convert address to ExecItf.WinSock pointer

  is new Unchecked_Conversion( Source => System.Address,

                               Target => ExecItf.LPWSADATA );

  lpWSAData

  -- Pointer to Windows WSADATA structure that contains the information on the

  -- configuration of the WinSock DLL, including the highest version available

  : constant ExecItf.LPWSADATA

  := to_LPWSADATA(WSAData'address);

  type SockAddr_In

  is record

    SIn_Family : ExecItf.SHORT;   -- Internet protocol (16 bits)

    SIn_Port   : ExecItf.USHORT;  -- Address port (16 bits)

    SIn_Addr   : ExecItf.ULONG;   -- IP address (32 bits)

    SIn_Zero   : Itf.ByteArray(1..8);

  end record;

  for SockAddr_In

  use record

    SIn_Family at 0 range 0 .. 15;

    SIn_Port   at 2 range 0 .. 15;

    SIn_Addr   at 4 range 0 .. 31;

    SIn_Zero   at 8 range 0 .. 63;

  end record;

  for SockAddr_In'size use 16*8; -- bits

  type Socket_Info_Type

  -- Socket handle and IP address with port of a particular component and

  –- its application to act as a WinSock server or client

  is record

    Socket : ExecItf.Socket;

    -- Handle to be supplied to accept function to obtain client socket when

    -- client application connect is accepted by this application acting as a

    -- WinSock server or handle to be supplied to connect function to obtain

    -- a connection to a remote server when this application is acting as a

    -- WinSock client

    Data : SockAddr_In;

    -- SA_family, port and IP address of the Server Socket

    Addr   : ExecItf.PSOCKADDR;

    -- Pointer to description of local address of Server Socket.  The SOCKADDR

    -- to which it points is a record that contains

    --   SA_family : u_short;

    --   SA_data   : ExecItf.WSA_CHAR_Array(0..13);

  end record;

  Null_Socket_Info

  : constant Socket_Info_Type

  := ( Socket => ExecItf.Invalid_Socket,

       Data   => ( SIn_Family => 0,

                   SIn_Port   => 0,

                   SIn_Addr   => 0,

                   SIn_Zero   => ( others => 0 ) ),

       Addr   => null );

  type Communication_Connection_Data_Type

  -- Data about server/client sockets that have requested a connection with a

  -- client or server.

  --

  -- In this peer-to-peer implementation, each application contains components

  -- and each component is both a server to other components and their client.

  -- As such each component of the pair can be connected to the other via a

  -- pair of Window socket ports. One connected as if a particular component is

  -- the WinSock server and the other as if it is the client. 

  --

  -- Along with the IP address each socket is identified via a port number;

  -- one port for the server and one for the client.

  --

  -- Since the client, as the reader, has to wait for data from its server, the

  -- client connect attempt with its receive are implemented in its own thread;

  -- one thread for each component to connect as the client.

  --

  -- Likewise, the server portion of the application has to attempt to accept

  -- connections from each of the other applications.  Therefore, the accept

  -- request must be in a loop where the accept will return when a particular

  -- client connect request is accepted.  The accept returns the new socket

  -- to be used and the IP address with the port.  Since one or more remote

  -- components may be in an application(s) that may not be running, the accept

  -- can block waiting for components to request to connect that aren't initially

  -- running.  Therefore, each server also has its own accept connection thread

  -- so the rest of the application can run while the accepts are taking place.

  --

  -- Note: The accept function returns a new socket that replaces that of the

  -- original bind and listen.

  --

  -- With both components of a communication pair acting as a server and a

  -- client of the other, each will attempt to connect to the other as a

  -- client and each will attempt to accept the other's request to connect.

  -- Therefore, each shall have a socket it obtained for the client connect

  -- request and one that it obtained for the server bind and listen and

  -- passed to its accept request (although the accept request can otherwise

  -- specify null).  For each accept a client socket will be returned to use

  -- in the communications.

  --

  -- Thus, the transmit to the other component will use the socket returned

  -- by the accept no matter what application it happens to be in.  The

  -- receive from the other application will use the socket returned by the

  -- receive thread.

  is record

    Supported : Boolean;

    -- True if Apps Configuration indicates that both applications of the

    -- connection pair support WinSock communications

    Connected : Boolean;

    -- True if this application acting as a WinSock client has connected

    -- with its server

    Created   : Boolean;

    -- True if this application acting as a WinSock server has created

    -- the Socket

    Name      : Component_Name_Type;

    -- Name by which to register the Driver Receive or Transmit components

    Socket    : Socket_Info_Type;

    -- Socket handle and IP address to attempt to connect to remote application

  end record;

  Null_Communication_Connection_Data

  : constant Communication_Connection_Data_Type

  := ( Supported => False,

       Connected => False,

       Created   => False,

       Name      => ( others => ' ' ),

       Socket    => Null_Socket_Info );

  type Communication_Connection_Type

  -- Similar data for the WinSock client and server

  is record

    Receive  : Communication_Connection_Data_Type;

    Transmit : Communication_Connection_Data_Type;

  end record;

  type Communication_Connection_Link_Type

  is array( Connection_Index_Type )

  of Communication_Connection_Type;

  type Component_Id_Pair_Type

  -- Pair of application identifiers to identify applications that can communicate

  is array( 1..2 ) of Component_Ids_Type;

  type Delivery_Table_Count_Type

  -- Range of Delivery Table entries

  is new Integer range 0..16;

  type Delivery_Table_Positions_Type

  -- Locations of the matched pair in the Delivery_Table

  is array (1..2) of Delivery_Table_Count_Type;

  type Communication_Data_Type

  is record

    Available         : Boolean;

    -- True if remote application is available in the configuration

    Bound             : Boolean;

    -- True if the Bind for the Transmit socket has succeeded

    Pair              : Component_Id_Pair_Type;

    -- Identifiers of the application pair; always lower number first

    Local_Com         : Component_Ids_Type;

    -- Identifier of running component

    Remote_Com        : Component_Ids_Type;

    -- Identifier of other (i.e., remote) component of the pair

    Receive_Wait      : ExecItf.HANDLE;

    -- Wait event handle of receive thread

    Transmit_Wait     : ExecItf.HANDLE;

    -- Wait event handle of transmit thread

    Receive_Callback  : ReceiveCallbackType;

    -- Callback to component's procedure to receive messages

    DeliveryId        : Component_Ids_Type;

    -- Delivery_Table Component Identifier for transmit

    DeliveryPosition  : Delivery_Table_Positions_Type;

    -- Pair of indexes into Delivery_Table of the matched pair of components

  end record;

  Null_Data_Info

  : constant Communication_Data_Type

  := ( Available        => False,

       Bound            => False,

       Pair             => ( 0, 0 ),

       Local_Com        => 0,

       Remote_Com       => 0,

       Receive_Wait     => System.Null_Address,

       Transmit_Wait    => System.Null_Address,

       Receive_Callback => null,

       DeliveryId       => 0,

       DeliveryPosition => ( 0, 0 )

     );

  type Communication_Data_Array_Type

  is array( Connection_Index_Type ) of Communication_Data_Type;

  type Communication_Type

  -- Structure containing WinSock clients of the components of the configuration

  –- that receive messages from other components and servers that transmit to other

  -- components. That is, any of the components can be a server that send messages

  –- to other components as well as a client that receives messages.

  is record

    Count : Connection_Count_Type;

    -- Number of entries in the Data and Link arrays

    Data  : Communication_Data_Array_Type;

    -- Data to be used in conjunction with WinSock threads

    Link  : Communication_Connection_Link_Type;

    -- Data to be used by this application to receive from / transmit to the

    -- other components of this or other applications

  end record;

  Comm

  -- Information about threads and Microsoft Windows connections

  -- for each application

  : Communication_Type;

  pragma Volatile( Comm ); -- since accessed by multiple threads

  type Possible_Pairs_Type

  is array( Possible_Pairs_Index_Type ) of Component_Id_Pair_Type;

  Possible_Pairs

  --| Possible pairs of component ids in the Delivery.dat file

  : Possible_Pairs_Type;

  Possible_Pair_Indexes

  --| Possible pairs of applications with lower numbered indexes first

  : constant Possible_Pairs_Type

  := (  1 => ( 1, 2 ),

        2 => ( 1, 3 ),

        3 => ( 1, 4 ),

        4 => ( 1, 5 ),

        5 => ( 1, 6 ),

        6 => ( 1, 7 ),

        7 => ( 1, 8 ),

        8 => ( 1, 9 ),

        9 => ( 1, 10 ),

       10 => ( 2, 3 ),

       11 => ( 2, 4 ),

       12 => ( 2, 5 ),

       13 => ( 2, 6 ),

       14 => ( 2, 7 ),

       15 => ( 2, 8 ),

       16 => ( 2, 9 ),

       17 => ( 2, 10 ),

       18 => ( 3, 4 ),

       19 => ( 3, 5 ),

       20 => ( 3, 6 ),

       21 => ( 3, 7 ),

       22 => ( 3, 8 ),

       23 => ( 3, 9 ),

       24 => ( 3, 10 ),

       25 => ( 4, 5 ),

       26 => ( 4, 6 ),

       27 => ( 4, 7 ),

       28 => ( 4, 8 ),

       29 => ( 4, 9 ),

       30 => ( 4, 10 ),

       31 => ( 5, 6 ),

       32 => ( 5, 7 ),

       33 => ( 5, 8 ),

       34 => ( 5, 9 ),

       35 => ( 5, 10 ),

       36 => ( 6, 7 ),

       37 => ( 6, 8 ),

       38 => ( 6, 9 ),

       39 => ( 6, 10 ),

       40 => ( 7, 8 ),

       41 => ( 7, 9 ),

       42 => ( 7, 10 ),

       43 => ( 8, 9 ),

       44 => ( 8, 10 ),

       45 => ( 9, 10 )

     );

  type File_Type

  -- Delivery name and handle

  is record

    Name   : ExecItf.Config_File_Name_Type;

    -- Name of delivery data file for applications

    Handle : ExecItf.File_Handle;

    -- Handle of delivery data file after created

  end record;

  Delivery_File

  -- Name and Handle of Delivery.dat file

  : File_Type;

  type DeliveryBytesType

  is record

    Count : Integer; -- number of bytes in message

    Bytes : Itf.ByteArray(1..15);

  end record;

  type ComponentNameType

  is record

    Count : Integer; -- number of characters in name

    Value : String(1..20);

  end record;

  type Delivery_Table_Data_Type

  is record

    ComId      : Component_Ids_Type;

    -- Identifier of component of the table entry

    ComName    : ComponentNameType;

    -- Name of component of the table entry

    PCAddress  : DeliveryBytesType;

    -- IP address of PC of the component

    ComRoute   : DeliveryBytesType;

    -- IP address of the individual component

    PortServer : Integer;

    -- Identifier of the server/transmit port

    PortClient : Integer;

    -- Identifier of the client/receive port

    Partner    : Delivery_Table_Count_Type;

    -- Index of the component with the opposite ports

  end record;

  type Delivery_Table_Data_Array_Type

  is array (1..Delivery_Table_Count_Type'Last) of Delivery_Table_Data_Type;

  type Delivery_Table_Type

  -- Table of the contents of the Delivery.dat file

  is record

    Count : Delivery_Table_Count_Type;

    -- Number of valid entries in the table

    Last  : Delivery_Table_Count_Type;

    -- Last table location matched to ComponentId of component being Installed

    List  : Delivery_Table_Data_Array_Type;

    -- Space for the maximum number of entries

  end record;

  Delivery_Error

  -- Whether an error occurred in Install

  : Boolean := False;

  Delivery_Table

  -- Parsed contents of Delivery.dat file

  : Delivery_Table_Type;

  NameIndex

  -- Index of component in Delivery_Table

  : Integer := 0;

  function to_ac_SOCKADDR_t -- convert address to ExecItf.WinSock pointer

  is new Unchecked_Conversion( Source => System.Address,

                               Target => ExecItf.PSOCKADDR );

  function FindDeliveryFile

  return File_Type;

  procedure MatchComId

  ( Start : in out Possible_Pairs_Count_Type;

    ComId : in Component_Ids_Type

  );

  function MatchName

  ( Start : in Possible_Pairs_Count_Type;

    Name  : in String

  ) return Possible_Pairs_Count_Type;

  -- Parse the Delivery.dat file to create the Delivery_Table

  procedure ParseDelivery;

  -- Lookup the component and check that the table entries cross reference

  procedure DeliveryLookup

  ( ComId   : in Component_Ids_Type;

    -- Current component's id

    Pair    : in Component_Id_Pair_Type;

    -- Pair of component ids to be looked up

    Matched : out Boolean;

    -- Whether the pair is in the Delivery table

    OtherId : out Component_Ids_Type;

    -- Other component id of the matched pair

    Indexes : out Delivery_Table_Positions_Type

    -- Locations of matched pair in the table

  );

  -- Validate the Delivery_Table; return True if not invalid

  function ValidateDelivery

  return Boolean;

  function to_Digit

  ( Number : in Integer

  ) return Character;

  package Recv is

  -- Receive message from a particular component

    procedure Install

    ( Id : in Connection_Count_Type

      -- Identifier of the component

    );

  end Recv;

  package Xmit is

  -- Transmit message to a particular component

    procedure Install

    ( Id : in Connection_Count_Type

      -- Identifier of the component

    );

  end Xmit;

  -- Separate declarations

  procedure Finalize is separate;

  function FindDeliveryFile

  return File_Type is separate;

  procedure Initialize is separate;

  procedure Install

  ( ComponentId  : in Component_Ids_Type;

    Component    : in String;

    RecvCallback : in ReceiveCallbackType

  ) is separate;

  procedure MatchComId

  ( Start : in out Possible_Pairs_Count_Type;

    ComId : in Component_Ids_Type

  ) is separate;

  function MatchName

  ( Start : in Possible_Pairs_Count_Type;

    Name  : in String

  ) return Possible_Pairs_Count_Type is separate;

  procedure ParseDelivery is separate;

  function ValidateDelivery

  return Boolean is separate;

  procedure DeliveryLookup

  ( ComId   : in Component_Ids_Type;

    Pair    : in Component_Id_Pair_Type;

    Matched : out Boolean;

    OtherId : out Component_Ids_Type;

    Indexes : out Delivery_Table_Positions_Type

  ) is separate;

  function to_Digit

  ( Number : in Integer

  ) return Character is

  -- Convert number from 1 thru 9 to a alpha digit.

  begin -- to_Digit

    case Number is

      when 1 => return '1';

      when 2 => return '2';

      when 3 => return '3';

      when 4 => return '4';

      when 5 => return '5';

      when 6 => return '6';

      when 7 => return '7';

      when 8 => return '8';

      when 9 => return '9';

      when others =>

        Text_IO.Put("ERROR: to_Digit for Number not 1 thru 0");

        Int_IO.Put(Number);

        Text_IO.Put_Line(" ");

        return '0';

    end case;

  end to_Digit;

  procedure Transmit

  ( DeliverTo : in Component_Ids_Type;

    Count     : in Itf.Message_Size_Type;

    Message   : in System.Address

  ) is separate;

  package body Recv is separate;

  package body Xmit is separate;

end WinSock;

The Delivery.dat file read/parse and table procedures/functions code

with CStrings;

with Directory;

with GNAT.IO;

with Text_IO;

separate( WinSock )

function FindDeliveryFile

return File_Type is

-- Notes: If running via GPS the folder that contains the gpr file seems to be

--        the current directory.  If running from a DOS window of the Build

--        folder, that is the current directory.  If run the exe file while

--        in the folder of .dat file, that's the current directory.

  package Int_IO is new Text_IO.Integer_IO( Integer );

  DeliveryFile

  : Itf.V_Long_String_Type;

  Last

  : String(1..5);

  Path

  : Itf.V_Long_String_Type;

  Result

  -- Create result

  : Integer;

  use type ExecItf.File_Handle;

begin -- FindDeliveryFile

  -- Get the current directory/folder.

  Path := Directory.GetCurrentDirectory;

  -- Attempt to open "Delivery.dat" file containing the current WinSock data

  -- to deliver messages.

  DeliveryFile.Data(1..Path.Count) := Path.Data(1..Path.Count);

  DeliveryFile.Data(Path.Count+1..Path.Count+12) := "Delivery.dat";

  DeliveryFile.Count := Path.Count+12;

  Delivery_File := ( Name   => ( others => ASCII.NUL ),

                     Handle => ExecItf.Invalid_File_Handle );

  Delivery_File.Name(1..DeliveryFile.Count) :=

    DeliveryFile.Data(1..DeliveryFile.Count);

  Delivery_File.Handle := ExecItf.Open_Read( Name => Delivery_File.Name );

  if Delivery_File.Handle = ExecItf.Invalid_File_Handle then

    Result := Integer(ExecItf.GetLastError);

    Text_IO.Put("Delivery file doesn't exist");

    Int_IO.Put(Integer(Result));

    Text_IO.Put_Line(" ");

    -- Not in current directory.  Try previous directories.

    WhileLoop:

    while Delivery_File.Handle = ExecItf.Invalid_File_Handle loop

      for I in reverse 1..Path.Count-1 loop

        -- Find the previous backslash.

        if Path.Data(I) = '\' then

          DeliveryFile.Data(1..I) := Path.Data(1..I);

          DeliveryFile.Data(I+1..I+12) := "Delivery.dat";

          DeliveryFile.Count := I+12;

          Text_IO.Put_Line(DeliveryFile.Data(1..I+12));

          Path.Count := I; -- where '\' was found

          Text_IO.Put("next path that will be searched ");

          Text_IO.Put_Line(Path.Data(1..Path.Count));

          Delivery_File := ( Name   => ( others => ASCII.NUL ),

                             Handle => ExecItf.Invalid_File_Handle );

          Delivery_File.Name(1..DeliveryFile.Count) :=

            DeliveryFile.Data(1..DeliveryFile.Count);

          Delivery_File.Handle := ExecItf.Open_Read

                                  ( Name => Delivery_File.Name );

          if Delivery_File.Handle = ExecItf.Invalid_File_Handle then

            if I < 5 then

              exit WhileLoop; -- not going to be found in the path

            end if;

          else

            exit WhileLoop;

          end if;

        end if;

      end loop;

    end loop WhileLoop;

    if Delivery_File.Handle = ExecItf.Invalid_File_Handle then

      -- Not in previous directories.  Prompt for the Path.

      Text_IO.Put("Enter the path to the Delivery.dat file: ");

      GNAT.IO.Get_Line( DeliveryFile.Data, DeliveryFile.Count );

      -- Check whether the .dat file was included

      Last(1..4) := DeliveryFile.Data

                    (DeliveryFile.Count-3..DeliveryFile.Count);

      Last(5) := ASCII.NUL;

      declare

        Dat : String(1..5) := ".dat ";

      begin

        Dat(5) := ASCII.NUL;

        if (CStrings.Compare(Last'Address,Dat'Address,true) = 0) then

          -- Check whether the trailing \ was entered

          if DeliveryFile.Data(DeliveryFile.Count) /= '\' then

            DeliveryFile.Count := DeliveryFile.Count + 1;

            DeliveryFile.Data(DeliveryFile.Count) := '\';

          end if;

          -- Append the file name

          DeliveryFile.Data(DeliveryFile.Count+1..DeliveryFile.Count+12) :=

            "Delivery.dat";

          Delivery_File.Name := ( others => ASCII.NUL );

          Delivery_File.Name(1..DeliveryFile.Count+12) :=

            DeliveryFile.Data(1..DeliveryFile.Count+12);

          Text_IO.Put("New path ");

          Text_IO.Put_Line(DeliveryFile.Data(1..DeliveryFile.Count+12));

          -- Attempt to open the file

          Delivery_File.Handle := ExecItf.Open_Read( Name => Delivery_File.Name );

          if Delivery_File.Handle = ExecItf.Invalid_File_Handle then

            Result := Integer(ExecItf.GetLastError);

            Text_IO.Put("Entered Configuration file of ");

            Text_IO.Put(Delivery_File.Name(1..DeliveryFile.Count));

            Text_IO.Put_Line(" doesn't exist");

          end if;

        end if;

      end;

    end if;

  end if;

  return Delivery_File;

end FindDeliveryFile;

with CStrings;

separate( WinSock )

procedure ParseDelivery is

  package Int_IO is new Text_IO.Integer_IO( Integer );

  Max_File_Size

  : constant Integer := 1000;

  type FileDataType is new String(1..Max_File_Size);

  CR1         : Itf.Byte := 16#0D#; --'\r'

  CR          : Character;

  for CR use at CR1'Address;

  NL1         : Itf.Byte := 16#0A#; -- '\n'

  NL          : Character;

  for NL use at NL1'Address;

  Delimiter   : Character := '|';

  Bytes_Read

  -- Number of bytes read from Delivery.dat file

  : Integer := 0;

  Delivery_Data

  -- Data read from Delivery.dat file

  : FileDataType;

  Field

  -- Field of record being parsed

  : Integer := 0;

  I

  -- Index into Delivery_Data

  : Integer := 0;

  Index

  -- Index into Temp

  : Integer := 0;

  Result

  -- last error result

  : Integer;

  Success

  -- ReadFile return

  : Boolean;

  Temp

  : String(1..40);

  use type ExecItf.File_Handle;

 

begin -- ParseDelivery

  Delivery_Table.Count := 0;

  Delivery_Error := False;

  -- Obtain the IP address associated with the PC and that assigned to this

  -- component.

  -- First, obtain the path of the delivery file containing what should be a

  -- representation of the PC's static route table and open it.

  Delivery_File := FindDeliveryFile;

  -- Return if Configuration File not opened

  if Delivery_File.Handle = ExecItf.Invalid_File_Handle then

    Text_IO.Put_Line("ERROR: Delivery file not found");

    Delivery_Error := True;

    return;

  end if;

 

  -- Fill-in the Delivery_Table from the Delivery_File

  Bytes_Read := ExecItf.Read_File

                ( File => Delivery_File.Handle,  -- handle of disk file

                  Addr => Delivery_Data'address, -- buffer to receive data

                  Num  => Max_File_Size );       -- size of the buffer

  if Bytes_Read <= 0 then

    Result := Integer(ExecItf.GetLastError);

    Delivery_Error := True;

    return;

  end if;

  -- Close the file

  Success := ExecItf.Close_File( Handle => Delivery_File.Handle );

  -- Parse the delivery file data.

  Field := 0;

  I := 0;

  while I < Bytes_Read loop

    I := I + 1;

    if Field = 6 then

      -- Bypass end of line characters

      if Delivery_Data(I) = CR or else Delivery_Data(I) = NL then

        null;

      else

        Index := Index + 1;

        Temp(Index) := Delivery_Data(I); -- retain character for next phase

        Field := 0; -- start over for next application

       end if;

    else -- parse within the record

      if Delivery_Data(I) /= Delimiter then

        Index := Index + 1;

        Temp(Index) := Delivery_Data(I); -- retain byte

      else -- treat field prior to delimiter

        if Field = 0 then -- First get component id

          declare

            Success : Boolean;

          begin

            Delivery_Table.Count := Delivery_Table.Count + 1;

            Temp(Index+1) := ASCII.NUL; -- append trailing NUL

            CStrings.TryParse( From    => Temp'Address,

                               Size    => Index,

                               Result  => Delivery_Table.List(Delivery_Table.Count).ComId,

                               Success => Success );

          end;

          Index := 0;

         

        elsif Field = 1 then -- Next get component name

          declare

            StrData : String(1..Index);

            for StrData use at Temp'Address;

          begin

            Delivery_Table.List(Delivery_Table.Count).ComName.Value :=

              ( others => ' ' );

            Delivery_Table.List(Delivery_Table.Count).ComName.Count := Index;

            for J in 1..Index loop

              Delivery_Table.List(Delivery_Table.Count).ComName.Value(J) :=

                StrData(J);

            end loop;

          end;

          Index := 0;

        elsif Field = 2 then -- IP address of PC

          declare

            ByteData : Itf.ByteArray(1..Index);

            for ByteData use at Temp'Address;

          begin

            Delivery_Table.List(Delivery_Table.Count).PCAddress.Bytes :=

              ( others => 0 );

            Delivery_Table.List(Delivery_Table.Count).PCAddress.Count := Index;

            Delivery_Table.List(Delivery_Table.Count).PCAddress.Bytes(1..Index) :=

              ByteData(1..Index);

          end;

          Index := 0;

        elsif Field = 3 then -- Route Table IP address of component

          declare

            ByteData : Itf.ByteArray(1..Index);

            for ByteData use at Temp'Address;

          begin

            Delivery_Table.List(Delivery_Table.Count).ComRoute.Bytes :=

              ( others => 0 );

            Delivery_Table.List(Delivery_Table.Count).ComRoute.Count := Index;

            Delivery_Table.List(Delivery_Table.Count).ComRoute.Bytes(1..Index) :=

              ByteData(1..Index);

          end;

          Index := 0;

        elsif Field = 4 then -- Port to use for Server

          declare

            Success : Boolean;

          begin

            Temp(Index+1) := ASCII.NUL; -- append trailing NUL

            CStrings.TryParse

            ( From    => Temp'Address,

              Size    => Index,

              Result  => Delivery_Table.List(Delivery_Table.Count).PortServer,

              Success => Success );

            if not Success then

              Text_IO.Put_Line

                ("ERROR: Delivery.dat contains non-numeric value for Server Port");

            end if;

          end;

          Index := 0;

        else -- Port to use for Client

          declare

            Success : Boolean;

          begin

            Temp(Index+1) := ASCII.NUL; -- append trailing NUL

            CStrings.TryParse

            ( From    => Temp'Address,

              Size    => Index,

              Result  => Delivery_Table.List(Delivery_Table.Count).PortClient,

              Success => Success );

            if not Success then

              Text_IO.Put_Line

                ("ERROR: Delivery.dat contains non-numeric value for Client Port");

            end if;

          end;

          Index := 0;

        end if;

        Field := Field + 1;

      end if;

    end if;

  end loop;

end ParseDelivery;

separate( WinSock )

procedure DeliveryLookup

( ComId   : in Component_Ids_Type;

  Pair    : in Component_Id_Pair_Type;

  Matched : out Boolean;

  OtherId : out Component_Ids_Type;

  Indexes : out Delivery_Table_Positions_Type

) is

  OtherComponent : Component_Ids_Type := 0;

  Partner1 : Delivery_Table_Count_Type;

  Partner2 : Delivery_Table_Count_Type;

 

begin -- DeliveryLookup

  -- Determine if one component of the pair is the current component

  if Pair(1) = ComId then

    OtherComponent := Pair(2);

  elsif Pair(2) = ComId then

    OtherComponent := Pair(1);

  end if;

  -- return if Pair doesn't contain the component's identifier

  if OtherComponent = 0 then -- No match of ComId in pair

    Matched := False;

    OtherId := 0;

    Indexes := (0,0);

    return;

  end if;

  -- Determine if each component of the Pair cross references the other

  for I in Delivery_Table.Last+1..Delivery_Table.Count loop

    -- Does the Delivery Table location contain one of the pair?

    if Delivery_Table.List(I).ComId = ComId then

      Partner1 := Delivery_Table.List(I).Partner;

      if Partner1 > I then -- not already examined

        -- Find any matching partner

        for J in I+1..Delivery_Table.Count loop

          Partner2 := Delivery_Table.List(J).Partner;

          if Delivery_Table.List(Partner1).ComId = OtherComponent and then

             Delivery_Table.List(Partner1).Partner = Partner2

          then -- matched

            Matched := True;

            OtherId := OtherComponent;

            Indexes(1) := I;

            Indexes(2) := J;

            Delivery_Table.Last := I;

            return;

          end if;

        end loop;

      end if;

    elsif Delivery_Table.List(I).ComId = OtherComponent then

      Partner1 := Delivery_Table.List(I).Partner;

      if Partner1 > I then -- not already examined

        -- Find any matching partner

        for J in I+1..Delivery_Table.Count loop

          Partner2 := Delivery_Table.List(J).Partner;

          if Delivery_Table.List(Partner1).ComId = ComId and then

             Delivery_Table.List(Partner1).Partner = Partner2

          then -- matched

            Matched := True;

            OtherId := OtherComponent;

            Delivery_Table.Last := I;

            Indexes(1) := J;

            Indexes(2) := I;

            return;

          end if;

        end loop;

      end if;

    end if;

  end loop;

  -- No match of component partners in pair

  Matched := False;

  OtherId := 0;

  Indexes := (0,0);

  return;

end DeliveryLookup;

separate( WinSock )

function ValidateDelivery

return Boolean is

  Count   : Integer := 0;

  Failure : Boolean := False;

begin -- ValidateDelivery

  for I in 1..Delivery_Table.Count loop

    Delivery_Table.List(I).Partner := 0;

    -- Check that ComId is within range

    if Delivery_Table.List(I).ComId > 0 and then

      Delivery_Table.List(I).ComId <=

        Component_Ids_Type(Delivery_Table_Count_Type'Last)

    then

      null;

    else

      Text_IO.Put_Line("ERROR: Delivery.dat ComId is out-of-range");

    end if;

     

    -- Check that an entry with a duplicate ComId has the same ComName

    for J in I+1..Delivery_Table.Count loop

      if Delivery_Table.List(J).ComId = Delivery_Table.List(I).ComId then

        if Delivery_Table.List(J).ComName /= Delivery_Table.List(I).ComName then

          Text_IO.Put

            ("WARNING: ComponentName mismatch between Delivery.dat records at");

          Int_IO.Put(Integer(I));

          Text_IO.Put(" and");

          Int_IO.Put(Integer(J));

          Text_IO.Put_Line(" ");

        end if;

      end if;

    end loop;

    -- Check that IP addresses are in dot notation

    Count := Delivery_Table.List(I).PCAddress.Count;

    declare

      Dots  : Integer := 0;

      Previous : Integer := 1;

      AsString : String(1..Count);

      for AsString use at Delivery_Table.List(I).PCAddress.Bytes(1)'address;

    begin

      CheckDot:

      for S in Previous..Count loop

        if AsString(S) = '.' then -- dot found

          Dots := Dots + 1;

          for D in Previous..S-1 loop

            if AsString(D) not in '0'..'9' then

              Text_IO.Put(AsString);

              Text_IO.Put(" contains invalid dotted IP formatting at record");

              Int_IO.Put(Integer(I));

              Text_IO.Put_Line(" ");

              exit CheckDot; -- loop

            end if;

          end loop;

          Previous := S+1;

          if Dots = 3 then

            for D in Previous..Count loop

              if AsString(D) not in '0'..'9' then

                Text_IO.Put(AsString);

                Text_IO.Put(" contains invalid dotted IP formatting at record");

                Int_IO.Put(Integer(I));

                Text_IO.Put_Line(" ");

                exit CheckDot; -- loop

              end if;

            end loop;

            exit CheckDot; -- finished with all the bytes

          end if;

        end if;

      end loop CheckDot;

    end;

-- add check the other IP field

-- add check format and values of PCAddress

    -- Check PortServer and PortClient for some range of values

    if (Delivery_Table.List(I).PortServer < 8000 or else

        Delivery_Table.List(I).PortServer > 9999) or else

       (Delivery_Table.List(I).PortClient < 8000 or else

        Delivery_Table.List(I).PortClient > 9999)

    then

      Text_IO.Put_Line

        ("ERROR: Server or Client Port not within selected range of 8000-9999");

    end if;

   

-- add check that another record doesn't have the same PortServer or the same PortClient

    -- Find component partner of this entry

    for J in 1..Delivery_Table.Count loop

      if I /= J then -- avoid current entry

        if Delivery_Table.List(I).PortServer =

           Delivery_Table.List(J).PortClient and then

           Delivery_Table.List(I).PortClient =

           Delivery_Table.List(J).PortServer

        then

          Delivery_Table.List(I).Partner := J;

          exit; -- inner loop; can't be more than one partner

        end if;

      end if;

    end loop;

  end loop; -- for I

-- add check that there are no entries without a Partner?? or just

-- issue a warning.

  -- Issue a warning if entry has no partner.

  for I in 1..Delivery_Table.Count loop

    if Delivery_Table.List(I).Partner = 0 then

      declare

        ComName : String(1..Delivery_Table.List(I).ComName.Count);

        for ComName use at Delivery_Table.List(I).ComName.Value'Address;

      begin

        Text_IO.Put("WARNING: Delivery.dat lacks a partner component for");

        Int_IO.Put(Delivery_Table.List(I).ComId);

        Text_IO.Put(" ");

        Text_IO.Put_Line(ComName);

      end;

    end if;

  end loop;

  return not Failure;

end ValidateDelivery;

The Initialize, Install, and Finalize procedures of my WinSock package.

with CStrings;

with GNAT.OS_Lib;

with Text_IO;

separate( WinSock )

procedure Initialize is

  Win_Status

  -- Result of WSAStartup call

  : ExecItf.INT;

  use type ExecItf.INT;

begin -- Initialize

  --   Do the Windows sockets initialization.

  Win_Status := ExecItf.WSAStartup( VersionRequired => 16#0202#, -- version 2.2

                                    WSAData         => lpWSAData );

  if Win_Status /= 0 then

    Text_IO.Put("ERROR: WinSock WSAStartup failed");

    Int_IO.Put(Integer(Win_Status));

    Text_IO.Put_Line(" ");

    return;

  end if;

  -- Initialize communication array.

  -- Notes:

  --   The array has been set to null when declared.  The Comm.Link Transmit

  --   Socket will have its last value filled in when a connection is accepted.

  Comm.Count := 0;

  for I in Connection_Index_Type loop

    Comm.Data(I) := Null_Data_Info;

    Comm.Link(I).Receive  := Null_Communication_Connection_Data;

    Comm.Link(I).Transmit := Null_Communication_Connection_Data;

  end loop;

  -- Build Delivery_Table from Delivery.dat file

  ParseDelivery;

  -- Validate that table doesn't contain extraneous entries

  if not ValidateDelivery then

    -- quit if Delivery.dat built an invalid table

    GNAT.OS_Lib.OS_Exit(0);

  end if;

  Delivery_Table.Last := 0;

  for I in 1..Delivery_Table.Count loop

    Int_IO.Put(Integer(Delivery_Table.List(I).ComId));

    Text_IO.Put(" ");

    Text_IO.Put(String(Delivery_Table.List(I).ComName.Value));

    Int_IO.Put(Integer(Delivery_Table.List(I).Partner));

    Text_IO.Put_Line(" ");

  end loop;

  –- Initialize Possible Pairs

  for I in Possible_Pairs_Index_Type'range loop

    Possible_Pairs(I) := ( 0, 0 );

  end loop;

  -- Look up name of host PC and display

  declare

    HostLen  : Integer := 0;

    HostName : String(1..25) := ( others => ASCII.Nul );

    Prefix   : String(1..11) := "Host Name  ";

    ResultStr: String(1..40);

    Result   : CStrings.SubStringType;

    function to_PSTR is new Unchecked_Conversion( Source => System.Address,

                                                  Target => ExecItf.PSTR );

  begin

    Win_Status := ExecItf.GetHostName( Name    => to_PSTR(HostName'address),

                                       NameLen => 20 );

    if Win_Status = 0 then

      for I in 1..25 loop

        if HostName(I) = ASCII.Nul then

          HostLen := I - 1;

          exit;

        end if;

      end loop;

      Prefix(11) := ASCII.NUL;

      if HostLen > 0 then

        Result := (40,ResultStr'Address);

        CStrings.Append(Prefix'Address, HostName'Address, Result);

        Text_IO.Put_Line(ResultStr(1..Result.Length));

      end if;

    end if;

  end;

end Initialize;

with CStrings;

with TextIO;

with Threads;

separate( WinSock )

procedure Install

( ComponentId  : in Component_Ids_Type;

  Component    : in String;

  RecvCallback : in ReceiveCallbackType

) is

  package Int_IO is new Text_IO.Integer_IO( Integer );

  Digit

  -- Digit of remote component identifier ('1', '2', '3', '4', ...)

  : Character;

  IC

  -- Index into Comm arrays

  : Connection_Count_Type;

  InitialCommCount

  -- Comm.Count upon entry

  : Connection_Count_Type;

  Index

  -- Index into Temp

  : Integer := 0;

  PCAddress

  -- Server IP address

  : DeliveryBytesType;

  Port

  -- Server port id number

  : Natural;

  Default_WinSock_Receive_Component_Name

  -- WinSock receive name without digit identifying client application

  : constant Component_Name_Type

  := "WinSock Receive 00       ";

  Default_WinSock_Server_Accept_Component_Name

  -- WinSock server accept connection name without digit identifying client application

  : constant Component_Name_Type

  := "WinSock Server Accept 00 ";

  use type ExecItf.INT;

  use type ExecItf.File_Handle;

  function to_Integer is new Unchecked_Conversion -- for debug

                             ( Source => ExecItf.PSOCKADDR,

                               Target => Integer );

  function to_Ptr is new Unchecked_Conversion

                         ( Source => System.Address,

                           Target => ExecItf.PCSTR );

  function to_Callback is new Unchecked_Conversion

                              ( Source => System.Address,

                                Target => Threads.CallbackType );

  function callback_toInt is new Unchecked_Conversion

                                 ( Source => ReceiveCallbackType,

                                   Target => Integer );

begin -- Install

  -- Reinitialize for a new search for matching components.

  Delivery_Table.Last := 0;

  InitialCommCount := Comm.Count;

  -- Fill in server addresses to allow each remote client that supports

  -- WinSock to connect to a known server if the local app supports WinSock.

  declare

    OtherComponent : Component_Ids_Type;

    -- The other component of the matched Pair

    ComId      : Possible_Pairs_Count_Type;

    Index      : Possible_Pairs_Count_Type;

    Indexes    : Delivery_Table_Positions_Type;

    ItemAdded  : Boolean;

    Matched    : Boolean; -- True if Pair matched to Delivery_Table entries

    Pair       : Component_Id_Pair_Type;

  begin

    ComId      := Possible_Pairs_Count_Type(ComponentId);

    Index      := 1;

    FindPair:

    for I in Possible_Pairs_Index_Type'range loop

      ItemAdded := False;

      Pair := Possible_Pair_Indexes(I);

      DeliveryLookup( ComId   => ComponentId,

                      Pair    => Pair,

                      Matched => Matched,

                      OtherId => OtherComponent,

                      Indexes => Indexes);

      if Matched then

        IC := Connection_Count_Type(Index) + InitialCommCount;

        Comm.Data(IC).Pair := Pair;

        Comm.Data(IC).Local_Com := ComponentId;

        if Pair(1) = ComponentId then

          Comm.Data(IC).Receive_Callback := RecvCallback;

          Comm.Data(IC).Remote_Com := Pair(2);

        else -- Pair(2) = ComponentId

            Comm.Data(IC).Receive_Callback := RecvCallback;

            Comm.Data(IC).Remote_Com := Pair(1);

        end if;

        Comm.Data(IC).DeliveryPosition := Indexes;

        -- display possible pair

        declare

          Text : Itf.V_80_String_Type;

        begin

          Text.Data(1..28) := "Items added - Possible_Pairs";

          Text := TextIO.Concat( Text.Data(1..28), Integer(IC) );

          Text := TextIO.Concat( Text.Data(1..Text.Count), Integer(Pair(1)) );

          Text := TextIO.Concat( Text.Data(1..Text.Count), Integer(Pair(2)) );

          Text := TextIO.Concat( Text.Data(1..Text.Count), "Comm.Data" );

          Text := TextIO.Concat( Text.Data(1..Text.Count),

                                 Integer(Comm.Data(IC).Local_Com) );

          Text := TextIO.Concat( Text.Data(1..Text.Count),

                                 Integer(Comm.Data(IC).Remote_Com) );

          Text := TextIO.Concat( Text.Data(1..Text.Count),

                                 callback_toInt(Comm.Data(IC).Receive_Callback) );

          TextIO.Put_Line(Text);

        end;

        ItemAdded := True;

        Comm.Count := Comm.Count + 1;

      end if; -- Matched

      exit when Index = Possible_Pairs_Index_Type'last or else

                ( Possible_Pair_Indexes(I)(1) > ComponentId and then

                  Possible_Pair_Indexes(I)(2) > ComponentId );

      if ItemAdded then

        Index := Index + 1;

      end if;

    end loop FindPair; -- for I in range

  end;

  -- Finish initialize of communication array.

  -- Notes:

  --   The array has been set to null when declared.  The Comm.Link Transmit

  --   Socket will be filled in when a connection is accepted.

  declare

    CIndex : Possible_Pairs_Count_Type; -- Client/Receive index

    SIndex : Possible_Pairs_Count_Type; -- Server/Transmit index

  begin

    for I in InitialCommCount+1..Comm.Count loop

      CIndex := Possible_Pairs_Count_Type(

                  Comm.Data(Connection_Count_Type(I)).DeliveryPosition(2));

      SIndex := Possible_Pairs_Count_Type(

                  Comm.Data(Connection_Count_Type(I)).DeliveryPosition(1));

      Port := Delivery_Table.List(Delivery_Table_Count_Type(CIndex)).PortClient;

      PCAddress := Delivery_Table.List(Delivery_Table_Count_Type(CIndex)).PCAddress;

      Comm.Link(I).Receive.Socket.Data.SIn_Family :=

        ExecItf.AF_INET; -- Internet address family

      Comm.Link(I).Receive.Socket.Data.SIn_Port :=

        ExecItf.htons(ExecItf.USHORT(Port));

      Comm.Link(I).Receive.Socket.Data.SIn_Addr :=

        ExecItf.inet_addr(to_Ptr(PCAddress.Bytes'Address));

      Comm.Link(I).Receive.Socket.Addr :=

        to_ac_SOCKADDR_t(Comm.Link(I).Receive.Socket.Data'address);

      -- Note: The Server/Transmit index is that of the 2nd DeliveryPosition.

      --       However, setting the Port continues to use the Client/Receive

      --       index since it uses the .PortServer selection.  That is, the

      --       other half of the pair of ports that are reversed in the Delivery

      --       file since the first of the pair is the Client/Receive port and

      --       the second is the Server/Transmit port.

      -- Note: The Transmit socket will be modified when the connection is accepted.

      Port := Delivery_Table.List(Delivery_Table_Count_Type(CIndex)).PortServer;

      PCAddress := Delivery_Table.List(Delivery_Table_Count_Type(SIndex)).PCAddress;

      Comm.Link(I).Transmit.Socket.Data.SIn_Family :=

        ExecItf.AF_INET; -- Internet address family

      Comm.Link(I).Transmit.Socket.Data.SIn_Port :=

        ExecItf.htons(ExecItf.USHORT(Port));

      Comm.Link(I).Transmit.Socket.Data.SIn_Addr :=

        ExecItf.inet_addr(to_Ptr(PCAddress.Bytes'Address));

      Comm.Link(I).Transmit.Socket.Addr :=

        to_ac_SOCKADDR_t(Comm.Link(I).Transmit.Socket.Data'address);

      declare

        Text : Itf.V_80_String_Type;

      begin

        Text.Data(1..28) := "Comm.Link for Receive Socket";

        Text := TextIO.Concat( Text.Data(1..28), Integer(I) );

        Text := TextIO.Concat( Text.Data(1..Text.Count), "SIn_Port" );

        Text := TextIO.Concat( Text.Data(1..Text.Count),

                               Integer(Comm.Link(I).Receive.Socket.Data.SIn_Port) );

        Text := TextIO.Concat( Text.Data(1..Text.Count), "SIn_Addr" );

        Text := TextIO.Concat( Text.Data(1..Text.Count),

                               Integer(Comm.Link(I).Receive.Socket.Data.SIn_Addr) );

        Text := TextIO.Concat( Text.Data(1..Text.Count), "Addr" );

        Text := TextIO.Concat( Text.Data(1..Text.Count),

                               to_Integer(Comm.Link(I).Receive.Socket.Addr) );

        TextIO.Put_Line( Text );

      end;

      declare

        Text : Itf.V_80_String_Type;

        IPAddr : Itf.ByteArray(1..4);

        for IPAddr use at Comm.Link(I).Receive.Socket.Data.SIn_Addr'address;

      begin

        Text.Count := 8;

        Text.Data(1..8) := "SIn_Addr";

        Text := TextIO.Concat( Text.Data(1..Text.Count), Integer(IPAddr(1)) );

        Text := TextIO.Concat( Text.Data(1..Text.Count), Integer(IPAddr(2)) );

        Text := TextIO.Concat( Text.Data(1..Text.Count), Integer(IPAddr(3)) );

        Text := TextIO.Concat( Text.Data(1..Text.Count), Integer(IPAddr(4)) );

        TextIO.Put_Line( Text );

      end;

      declare

        Text : Itf.V_80_String_Type;

      begin

        Text.Data(1..29) := "Comm.Link for Transmit Socket";

           --              1234567890123456789012345678

        Text := TextIO.Concat( Text.Data(1..29), Integer(I) );

        Text := TextIO.Concat( Text.Data(1..Text.Count), "SIn_Port" );

        Text := TextIO.Concat( Text.Data(1..Text.Count),

                               Integer(Comm.Link(I).Transmit.Socket.Data.SIn_Port) );

        Text := TextIO.Concat( Text.Data(1..Text.Count), "SIn_Addr" );

        Text := TextIO.Concat( Text.Data(1..Text.Count),

                               Integer(Comm.Link(I).Transmit.Socket.Data.SIn_Addr) );

        Text := TextIO.Concat( Text.Data(1..Text.Count), "Addr" );

        Text := TextIO.Concat( Text.Data(1..Text.Count),

                               to_Integer(Comm.Link(I).Transmit.Socket.Addr) );

        TextIO.Put_Line( Text );

      end;

      declare

        Text : Itf.V_80_String_Type;

        IPAddr : Itf.ByteArray(1..4);

        for IPAddr use at Comm.Link(I).Transmit.Socket.Data.SIn_Addr'address;

      begin

        Text.Count := 8;

        Text.Data(1..8) := "SIn_Addr";

        Text := TextIO.Concat( Text.Data(1..Text.Count), Integer(IPAddr(1)) );

        Text := TextIO.Concat( Text.Data(1..Text.Count), Integer(IPAddr(2)) );

        Text := TextIO.Concat( Text.Data(1..Text.Count), Integer(IPAddr(3)) );

        Text := TextIO.Concat( Text.Data(1..Text.Count), Integer(IPAddr(4)) );

        TextIO.Put_Line( Text );

      end;

      declare

        Text : Itf.V_80_String_Type;

        Byte_Data : Itf.ByteArray(1..24);

        for Byte_Data use at Comm.Link(I).Transmit.Socket'address;

      begin

        Text.Count := 1;

        Text.Data(1..1) := " ";

        for B in 1..12 loop

          Text := TextIO.Concat( Text.Data(1..Text.Count),  Integer(Byte_Data(B)) );

        end loop;

        for B in 13..24 loop

          Text := TextIO.Concat( Text.Data(1..Text.Count),  Integer(Byte_Data(B)) );

        end loop;

        TextIO.Put_Line( Text );

      end;

      Digit := to_Digit(Integer(I));

      Comm.Link(I).Receive.Name := Default_WinSock_Receive_Component_Name;

      Comm.Link(I).Receive.Name(18) := Digit;

      Comm.Link(I).Transmit.Name := Default_WinSock_Server_Accept_Component_Name;

      Comm.Link(I).Transmit.Name(24) := Digit;

    end loop;

  end;

end Install;

separate( WinSock )

procedure Finalize is

begin -- Finalize

  -- Set the Receive_Index and Receive and Transmit Supported

  for I in 1..Comm.Count loop

    FindRemoteCom:

    for J in 1..Comm.Count loop

      if Comm.Data(J).Local_Com = Comm.Data(I).Local_Com and then

         Comm.Data(J).DeliveryId = 0 -- not set as yet set

      then

        for K in 1..Comm.Count loop

          if Comm.Data(J).Remote_Com = Comm.Data(K).Remote_Com then

            Comm.Link(I).Receive.Supported := True;

            Comm.Link(I).Transmit.Supported := True;

            Comm.Data(J).DeliveryId :=

              Component_Ids_Type(Comm.Data(K).Remote_Com);

            exit FindRemoteCom; -- loop

          end if;

        end loop;

      end if;

    end loop FindRemoteCom;

  end loop;

  -- Install threads for receive "components".

  for I in 1..Comm.Count loop

    Text_IO.Put("WinSock-Install Recv Index");

    Int_IO.Put(Integer(I));

    if Comm.Link(I).Transmit.Supported then

      Text_IO.Put_Line(" Transmit.Supported");

    else

      Text_IO.Put_Line(" ");

    end if;

    if Comm.Link(I).Transmit.Supported then

      Recv.Install( Id => I );

      -- Install threads for transmit "component".

      Text_IO.Put("WinSock-Install Xmit Index");

      Int_IO.Put(Integer(I));

      Text_IO.Put_Line(" ");

      Xmit.Install( Id => I );

    end if;

  end loop;

end Finalize;

The Transmit procedure is to be used by components to send a message to another component.  It uses the client socket of the accept of the Xmit Callback that replaces the original value stored in the Comm.Link(Index).Transmit.Socket.Socket location.  Hence it doesn't execute the Send until Connected is indicated.  Therefore, it can be invoked directly by a component to transmit a message but the request will be ignored until there is a connection to the other component.

Since this procedure can be invoked from multiple component threads the only static data that it uses is that of the Comm arrays for the particular component.  The other variables are on the stack.  Therefore, if one component thread suspends another, it will use its own stack and not overwrite the variables of the suspended thread.

with CStrings;

with TextIO;

separate( WinSock )

procedure Transmit

( DeliverTo : in Component_Ids_Type;

  Count     : in Itf.Message_Size_Type;

  Message   : in System.Address

) is

  Bytes_Written

  -- Number of bytes sent

  : ExecItf.INT;

  Index

  -- Index into Comm array

  : Connection_Count_Type := 0;

  function to_PCSTR is new Unchecked_Conversion( Source => System.Address,

                                                 Target => ExecItf.PCSTR );

  use type ExecItf.INT;

begin -- Transmit

  -- Find location of pair for remote application and set Index into Comm.

  for I in 1..Comm.Count loop

    if Comm.Data(I).DeliveryId = DeliverTo then

      Index := I;

      declare

        Text : String(1..28) := "Transmit Index N DeliverTo D";

      begin

        Text(16) := to_Digit(Integer(Index));

        Text(28) := to_Digit(Integer(DeliverTo));

        Text_IO.Put_Line(text);     

      end;

      exit;

    end if;

  end loop;

  -- Return if remote component doesn't exist for this configuration.

  if Index = 0 then

    return;

  end if;

  -- Return if the select socket isn't available; i.e., connected.

  if not Comm.Link(Index).Transmit.Connected then

    if Index = 1 then

      Text_IO.Put_Line("Transmit 1 not connected, returning");

    elsif Index = 2 then

      Text_IO.Put_Line("Transmit 2 not connected, returning");

    else

      Text_IO.Put_Line("Transmit 3 not connected, returning");

    end if;

    return;

  end if;

   

  Bytes_Written :=

    ExecItf.Send( S     => Comm.Link(Index).Transmit.Socket.Socket,

                  Buf   => to_PCSTR(Message),

                  Len   => ExecItf.INT(Count),

                  Flags => 0 );

  if Bytes_Written /= ExecItf.INT(Count) then

    Text_IO.Put("ERROR: WinSock Message Send failed");

    Int_IO.Put(Integer(Bytes_Written));

    Text_IO.Put(" ");

    Text_IO.Put(String(Comm.Link(Index).Transmit.Name(1..25)));

    Int_IO.Put(Integer(Index));

    Int_IO.Put(Integer(Comm.Link(Index).Transmit.Socket.Data.SIn_Port));

    Text_IO.Put_Line(" ");

    ExecItf.Display_Last_WSA_Error;

  else

    declare

      Text : Itf.V_80_String_Type;

    begin

      Text := TextIO.Concat

              ( "Transmit sent using socket port",

                Integer(Comm.Link(Index).Transmit.Socket.Data.SIn_Port) );

      TextIO.Put_Line( Text );

    end;

  end if;

end Transmit;

The Xmit subpackage with its Install and callbacks for separate threads

with CStrings;

with Interfaces.C;

with TextIO;

with Threads;

separate( WinSock )

package body Xmit is

  procedure Callback

  ( Id : in Integer

  );

  -– Bind the socket

  function SocketBind

  ( Index : in Connection_Count_Type

  ) return Boolean;

  –- Listen for an incoming connection

  function SocketListen

  ( Index : in Connection_Count_Type

  ) return Boolean;

  procedure Install

  ( Id : in Connection_Count_Type

  ) is

  -- This procedure runs in the startup thread.

    Name : String(1..25);

    Result : Boolean;

    TransmitResult

    -- Result of Install of Transmit with Threads

    : Threads.RegisterResult;

    use type ExecItf.SOCKET;

    use type Interfaces.C.int;

    use type Threads.InstallResult;

    function to_Callback is new Unchecked_Conversion

                                ( Source => System.Address,

                                  Target => Threads.CallbackType );

  begin -- Install

    Name := Comm.Link(Id).Transmit.Name;

    -- Install thread for the server

    TransmitResult := Threads.Install

                      ( Name     => Name,

                        Index    => Integer(Id),

                        Priority => Threads.NORMAL,

                        Callback => to_Callback(Callback'Address) );

    if TransmitResult.Status = Threads.Valid then

      Comm.Data(Id).Transmit_Wait := TransmitResult.Event;

      Text_IO.Put("Install Xmit ");

      Text_IO.Put(Name);

      Int_IO.Put(Integer(Id));

      Text_IO.Put_Line(" ");

    end if;

    -- Create the socket for Transmit.

    -- Note:

    --  The socket server receives accepts a client connection from a

    --  remote/other component.  After a connection has been established

    --  with the other component, the Transmit procedure can send messages

    --  to it.  The Bind and Listen are done here and the Accept is done

    --  in the particular thread associated with the component pair in

    --  via the callback.

    -- Bind server socket and indicate socket is bound if bind successful

    Result := SocketBind( Id );

    -- Listen for a connection and indicate created if successful

    if Result then

      Result := SocketListen( Id );

    end if;

  end Install;

  function SocketBind

  ( Index : in Connection_Count_Type

  ) return Boolean is

    Status

    -- 0 means function was successful; -1 otherwise

    : ExecItf.INT;

    use type ExecItf.SOCKET;

    use type Interfaces.C.int;

  begin -- SocketBind

    Comm.Link(Index).Transmit.Socket.Socket :=

      ExecItf.Socket_Func( AF       => ExecItf.PF_INET,       -- address family

                           C_Type   => ExecItf.SOCK_STREAM,   -- connection-oriented

                           Protocol => ExecItf.IPPROTO_TCP ); -- for TCP

    if Comm.Link(Index).Transmit.Socket.Socket = ExecItf.INVALID_SOCKET then

      Text_IO.Put_Line("ERROR: Server Socket NOT created");

      ExecItf.Display_Last_WSA_Error;

      Status := ExecItf.WSACleanup;

      return False;

    end if;

    if Index = 1 then

      Text_IO.Put("Xmit 1 TransmitCreate");

    elsif Index = 2 then

      Text_IO.Put("Xmit 2 TransmitCreate");

    else

      Text_IO.Put("Xmit 3 TransmitCreate");

    end if;

    Int_IO.Put(integer(Comm.Link(Index).Transmit.Socket.Socket));

    Text_IO.Put_Line(" ");

    -- Bind server socket and indicate socket created if bind successful.

    Status :=

      ExecItf.Bind

      ( S       => Comm.Link(Index).Transmit.Socket.Socket,

        Addr    => Comm.Link(Index).Transmit.Socket.Addr,

        NameLen => ExecItf.INT(Comm.Link(Index).Transmit.Socket.Data'size/8) );

    if Status /= 0 then

      ExecItf.Display_Last_WSA_Error;

      Text_IO.Put("ERROR: Server created socket but Bind FAILED" );

      Int_IO.Put(Integer(Status));

      Text_IO.Put_Line(" ");

      Status := ExecItf.CloseSocket( S => Comm.Link(Index).Transmit.Socket.Socket );

      Comm.Link(Index).Transmit.Socket.Socket := ExecItf.INVALID_SOCKET;

      Status := ExecItf.WSACleanup;

      return False;

    else

      Comm.Data(Index).Bound := True;

      return True;

    end if;

  end SocketBind;

  function SocketListen

  ( Index : in Connection_Count_Type

  ) return Boolean is

    Status

    -- 0 means function was successful; -1 otherwise

    : ExecItf.INT;

    use type Interfaces.C.int;

  begin -- SocketListen

    if ExecItf.Listen( S       => Comm.Link(Index).Transmit.Socket.Socket,

                       Backlog => 1 ) < 0 -- only allow one connection per remote client

    then

      Comm.Link(Index).Transmit.Created := False;

      Text_IO.Put_Line("ERROR: Server bound socket but Listen FAILED" );

      ExecItf.Display_Last_WSA_Error;

      Status := ExecItf.CloseSocket

                ( S => Comm.Link(Index).Transmit.Socket.Socket );

      Comm.Link(Index).Transmit.Socket.Socket := ExecItf.INVALID_SOCKET;

      Status := ExecItf.WSACleanup;

      return False;

    else

      Comm.Link(Index).Transmit.Created := True;

      if Index = 1 then

        Text_IO.Put_line("Xmit 1 Transmit Created");

      elsif Index = 2 then

        Text_IO.Put_line("Xmit 2 Transmit Created");

      else

        Text_IO.Put_line("Xmit 3 Transmit Created");

      end if;

    end if;

    return True;

  end SocketListen;

  -- Forever loop as initiated by Threads

  procedure Callback

  ( Id : in Integer

  ) is

  -- This procedure runs in the particular thread assigned to accept the

  -- connection for a component.

    Client_Socket

    -- Accepted client socket

    : ExecItf.SOCKET := ExecItf.INVALID_SOCKET;

    type Int_Ptr_Type is access ExecItf.INT;

    use type Interfaces.C.int;

    Index

    -- Index for Component for Comm.Link

    : Connection_Count_Type

    := Connection_Count_Type(Id);

    Client_Address_Size

    -- Size of socket address structure

    : ExecItf.INT

    := Comm.Link(Index).Transmit.Socket.Data'size/8;

    use type ExecItf.SOCKET;

    function to_Int_Ptr is new Unchecked_Conversion( Source => System.Address,

                                                     Target => Int_Ptr_Type );

    function to_Integer is new Unchecked_Conversion -- for debug

                               ( Source => ExecItf.PSOCKADDR,

                                 Target => Integer );

  begin -- Callback

    Connect:

    Loop

      declare

        Text : String(1..28);

      begin

        Text(1..19) := "Xmit Callback loop ";

        Text(20) := to_Digit(Integer(Id));

        Text(21) := ' ';

        Text(22) := to_Digit(Integer(Index));

        if Comm.Link(Index).Transmit.Created then

          Text(23..28) := " True ";

        else

          Text(23..28) := " False";

        end if;

        Text_IO.Put_Line(Text);

      end;

      if Index = 1 then

        Text_IO.Put_Line("index of 1");

      elsif Index = 2 then

        Text_IO.Put_Line("index of 2");

      else

        Text_IO.Put_Line("index of 3");

      end if;

      if Comm.Link(Index).Transmit.Created and then

         Comm.Link(Index).Receive.Connected and then

         not Comm.Link(Index).Transmit.Connected

      then

        -- Accept a client connection.

        Client_Socket :=

          ExecItf.C_Accept( S       => Comm.Link(Index).Transmit.Socket.Socket,

                            Addr    => null,

                            AddrLen => null );

        declare

          Text : Itf.V_80_String_Type;

        begin

          Text := TextIO.Concat( "Xmit after C_Accept", Integer(Index) );

          TextIO.Put_Line(Text);

        end;

        if Client_Socket = ExecItf.INVALID_SOCKET then

          Text_IO.Put_Line("ERROR: Server Client Socket NOT accepted");

          ExecItf.Display_Last_WSA_Error;

        else -- Accepted

          Comm.Link(Index).Transmit.Connected := True;

          Comm.Link(Index).Transmit.Socket.Socket := Client_Socket;

          exit Connect; -- loop

        end if; -- invalid Client_Socket

      end if; -- Comm.Link(Index).Transmit.Created

      Text_IO.Put_Line("Xmit Callback initial loop end");

      delay(1.0*Duration(Index)); -- seconds

    end loop Connect;

    -- Nothing else for the thread to do.

    Forever:

    loop

      delay 3.0; -- seconds

    end loop Forever;

  end Callback;

end Xmit;

The Recv subpackage with its Install, Create, and callbacks for the separate threads.  Unlike the Server create that is done from the Install procedure, the Client create (here named ReceiveCreate) is done from the beginning of the particular thread for the client.

separate( WinSock.Recv )

procedure ReceiveCreate

( Index : in Connection_Count_Type

) is

  Status

  -- 0 means function was successful; -1 otherwise

  : ExecItf.INT;

  use type ExecItf.SOCKET;

  use type ExecItf.INT;

begin -- ReceiveCreate

  -- Ignore create attempt if configuration doesn't specify that the

  -- method is supported for the remote application.

  -- Notes:

  --   Transmit Supported is whether the remote component supports transmit

  --   via WinSock and hence this application should be able to receive from it.

  if not Comm.Link(Index).Transmit.Supported then

    Text_IO.Put("ReceiveCreate not supported");

    return;

  end if;

  declare

    Text : String(1..21);

  begin

    Text(1..20) := "ReceiveCreate Index ";

    Text(21) := to_Digit(Integer(Index));

    Text_IO.Put_Line(Text);

  end;

  -- Create socket.

  -- Notes:

  --   The socket client receives messages from the server.  The socket

  --   server sends messages to the client.  Therefore, the running

  --   application component acts as the socket client for a particular

  --   connection and the remote application component acts as the server

  --   and transmits the message.  There is a connection pair for each

  --   component with the running application supporting the component that

  --   is acting as the client for the other side of the component pair that

  --   is used to send messages to this application's component.

  Comm.Link(Index).Receive.Socket.Socket :=

     ExecItf.Socket_Func( AF       => ExecItf.PF_INET,       -- address family

                          C_Type   => ExecItf.SOCK_STREAM,   -- connection-oriented

                          Protocol => ExecItf.IPPROTO_TCP ); -- for TCP

  if Comm.Link(Index).Receive.Socket.Socket = ExecItf.INVALID_SOCKET then

    ExecItf.Display_Last_WSA_Error;

    Status := ExecItf.WSACleanup;

    declare

      Text : String(1..28) := "Client Socket NOT created: x";

    begin

      Text(28) := to_Digit(Integer(Index));

      Text_IO.Put_Line(Text);

    end;

  else -- valid

    -- Connect to server.

    Status :=

      ExecItf.Connect( S       => Comm.Link(Index).Receive.Socket.Socket,

                       Name    => Comm.Link(Index).Receive.Socket.Addr,

                       NameLen => ExecItf.Int(Comm.Link(Index).Receive.Socket.Data'size/8) );

    if Status = 0 then

      Comm.Link(Index).Receive.Connected := True;

      -- Indicate that there is a remote component that can be used by one of

      -- the Client Receive threads in one of the instances of the Recv package.

      Comm.Data(Index).Available := True;

      if Index = 1 then

        Text_IO.Put_Line("Client Socket 1 Connected");

        Text_IO.Put_Line("Comm.Data(1) Available for Client ");

      elsif Index = 2 then

        Text_IO.Put_Line("Client Socket 2 Connected");

        Text_IO.Put_Line("Comm.Data(2) Available for Client ");

      else

        Text_IO.Put_Line("Client Socket 3 Connected");

        Text_IO.Put_Line("Comm.Data(3) Available for Client ");

      end if;

    else

      ExecItf.Display_Last_WSA_Error;

      Status := ExecItf.WSACleanup;

      Status := ExecItf.CloseSocket( S => Comm.Link(Index).Receive.Socket.Socket );

      Comm.Link(Index).Receive.Socket.Socket := ExecItf.INVALID_SOCKET;

      if Index = 1 then

        Text_IO.Put_Line("Client Socket 1 NOT Connected");

        Text_IO.Put_line("ERROR: Client Connect 1 FAILED: ");

      elsif Index = 2 then

        Text_IO.Put_Line("Client Socket 2 NOT Connected");

        Text_IO.Put_line("ERROR: Client Connect 2 FAILED: ");

      else

        Text_IO.Put_Line("Client Socket 3 NOT Connected");

        Text_IO.Put_line("ERROR: Client Connect 3 FAILED: ");

      end if;

      Text_IO.Put(String(Comm.Link(Index).Receive.Name));

      Int_IO.Put(Integer(Index));

      Text_IO.Put_Line(" ");

    end if;

  end if;

  declare

    Txt  : String(1..23);

    Text : Itf.V_80_String_Type;

  begin

    if Comm.Link(Index).Receive.Connected then

      Txt(1..18) := "Receive Connected ";

      Text.Count := 18;

    else

      Txt(1..22) := "Receive NOT Connected ";

      Text.Count := 22;

    end if;

    Text.Count := Text.Count + 1;

    Txt(Text.Count) := To_Digit(Integer(Index));

    Text := TextIO.Concat

            ( Txt(1..Text.Count),

              Integer(Comm.Link(Index).Receive.Socket.Data.SIn_Port) );

    TextIO.Put_Line(Text);

  end;

  if Comm.Link(Index).Receive.Socket.Socket /= ExecItf.INVALID_SOCKET then

    Text_IO.Put_Line("valid socket");

  end if;

end ReceiveCreate;

with CStrings;

with Interfaces.C;

with TextIO;

with Threads;

separate( WinSock )

package body Recv is

  type Received_Message_Connection_Type

  -- Connection of received message

  is record

    Remote : Connection_Count_Type;

    -- Remote connection of received message

    Length : Integer;

    -- Length of received message

  end record;

  function to_Ptr is new Unchecked_Conversion

                         ( Source => System.Address,

                           Target => ExecItf.PSTR );

   

  procedure Callback

  ( Id : in Integer

  );

  procedure ReceiveCreate

  ( Index : in Connection_Count_Type

  );

 

  procedure Install

  ( Id : in Connection_Count_Type

  ) is

  -- This procedure runs in the startup thread.

    Name  : String(1..25);

    ReceiveResult

    -- Result of Install of Receive with Threads

    : Threads.RegisterResult;

    use type Threads.InstallResult;

    function to_Callback is new Unchecked_Conversion

                                ( Source => System.Address,

                                  Target => Threads.CallbackType );

  begin -- Install

    Name := Comm.Link(Id).Receive.Name;

    Text_IO.Put("Install Recv ");

    Text_IO.Put(Name);

    Int_IO.Put(Integer(Id));

    Text_IO.Put_Line(" ");

    -- Install client thread for receive.

    ReceiveResult := Threads.Install

                     ( Name     => Name,

                       Index    => Integer(Id),

                       Priority => Threads.HIGH,

                       Callback => to_Callback(Callback'Address) );

    if ReceiveResult.Status = Threads.Valid then

      Comm.Data(Id).Receive_Wait := ReceiveResult.Event;

    end if;

  end Install;

  -- Forever loop as initiated by Threads to connect to the remote component

  -- and then receive messages from it.

  -- Notes:

  --   o The data for the socket to be used between the local and remote components

  --     is stored in the WinSock table available by the Index of Id.

  --   o This procedure is that of one of the threads.  Therefore, there is not a

  --     calling procedure that can be returned to.  Hence, there cannot be a

  --     return from this procedure.

  procedure Callback

  ( Id : in Integer

  ) is

  -- This procedure runs in the particular thread to wait for a message for

  -- the component of the Id.  The Id is passed by the Threads package as passed

  -- to it via the Install.

    Index

    -- Index into Comm.Link as passed in from Threads

    : Connection_Count_Type;

    Message

    -- Message as read from socket

    : Itf.Message_Buffer_Type;

    Received_Size

    -- Size of received message

    : ExecItf.INT;

    Result

    -- Return value for Close

    : ExecItf.INT;

    use type ExecItf.SOCKET;

    use type Interfaces.C.Int;

  begin -- Callback

    declare

      Text : String(1..26);

    begin

      Text(1..25) := "in WinSock Recv callback ";

      Text(26) := to_Digit(Integer(Id));

      Text_IO.Put_Line(Text);

    end;

    Index := Connection_Count_Type(Id);

    Forever:

    loop

      -- If the receive socket has not been connected, do so.

      if not Comm.Link(Index).Receive.Connected then

        ReceiveCreate( Index => Index );

      end if;

      -- Read from the socket and treat it.  Avoid the read if the socket

      -- has been closed.

      -- Notes:

      --   Since this is a separate process/thread, there can be no return

      --   from it when the socket is closed.

      if Comm.Link(Index).Receive.Connected and then

         Comm.Link(Index).Receive.Socket.Socket /= ExecItf.INVALID_SOCKET

      then

        declare

          function to_Int is new Unchecked_Conversion

                                 ( Source => System.Address,

                                   Target => Integer );

        begin

          Received_Size :=

            ExecItf.Recv( S     => Comm.Link(Index).Receive.Socket.Socket,

                          Buf   => to_Ptr(Message'address),

                          Len   => ExecItf.INT(Message'size/8),

                          Flags => 0 );

        end;

        if Received_Size < 0 then

          declare

            Text : Itf.V_80_String_Type;

          begin

            Text.Data(1..29) := "ERROR: WinSock Receive failed";

            Text := TextIO.Concat( Text.Data(1..29),

                                   Integer(Index) );

            TextIO.Put_Line(Text);

          end;

          ExecItf.Display_Last_WSA_Error;

          Result := ExecItf.CloseSocket

                    ( S => Comm.Link(Index).Receive.Socket.Socket );

          Comm.Link(Index).Receive.Socket.Socket := ExecItf.INVALID_SOCKET;

        elsif Received_Size = 0 then

          Text_IO.Put_Line("ERROR: WinSock Receive of 0 bytes");

        else

          -- Pass the message to its associated component

          declare

            Msg : String(1..Integer(Received_Size));

            for Msg use at Message'Address;

            function callback_toInt is new Unchecked_Conversion

                                           ( Source => ReceiveCallbackType,

                                             Target => Integer );

          begin

            Comm.Data(Index).Receive_Callback(Msg);

          end;

        end if; -- Received_Size < 0

      else -- not Comm(Index)(Receive).Socket_Connected

        delay 0.5; -- seconds and then return to try once more

      end if; -- Comm(Index)(Receive).Socket_Connected

    end loop Forever;

  end Callback;

  procedure ReceiveCreate

  ( Index : in Connection_Count_Type

  ) is separate;

end Recv;

A sample component.  The others are very similar.  Their only purpose is to send and receive messages via TCP/IP of Microsoft WinSock as interfaced via my WinSock Ada package.  Actual components would, of course, have unique responsibilities and are used to isolate the component from other dependences and allow them to be moved from one application to another without the necessity of modifying the applications.  (Except for the references in the main procedure.)

Each sample component declares the messages it is going to request to be transmitted, installs itself with the Threads package to obtain its thread to run in its callback and then along with the WinSock package to which it identifies itself and specifies the callback by which it will be notified of received messages.  In its callback thread it can perform its tasks (of which none are provided since the reason for supplying the components is only to illustrate messaging) and send messages to other components of the configuration reporting results or requesting information.

with ExecItf;

package Component2 is

  -- Return component's wakeup event handle

  function WakeupEvent

  return ExecItf.HANDLE;

  procedure Install;

end Component2;

with System;

with Text_IO;

with Threads;

with Unchecked_Conversion;

with WinSock;

package body Component2 is

  package Int_IO is new Text_IO.Integer_IO( Integer );

  ComponentWakeup

  -- Wakeup Event handle of the component

  : ExecItf.HANDLE;

  Message

  : String(1..18)

  := "Component2 message";

  MessageTo6

  : String(1..23)

  := "Component2 message to 6";

  procedure Callback

  ( Id : in Integer

  );

  procedure ReceiveCallback

  ( Message : in String --Itf.Message_Buffer_Type

  );

  procedure Install is

    Result : Threads.RegisterResult;

    use type Threads.InstallResult;

    function to_Callback is new Unchecked_Conversion

                                ( Source => System.Address,

                                  Target => Threads.CallbackType );

    function to_RecvCallback is new Unchecked_Conversion

                                    ( Source => System.Address,

                                      Target => WinSock.ReceiveCallbackType );

  begin -- Install

    -- Install the component into the Threads package.

    Result := Threads.Install

              ( Name     => "Component2",

                Index    => 0, -- value doesn't matter

                Priority => Threads.NORMAL,

                Callback => to_Callback(Callback'Address)

              );

    if Result.Status = Threads.VALID then

      ComponentWakeup := Result.Event; -- make visible to WinSock via function

      -- Do the Windows sockets initialization and install its threads.

      WinSock.Install( ComponentId => 2,

                       Component   => "Component2",

                       RecvCallback => to_RecvCallback(ReceiveCallback'Address)

                     );

    end if;

  end Install;

  -- Return component's wakeup event handle

  function WakeupEvent

  return ExecItf.HANDLE is

  begin -- WakeupEvent

    return ComponentWakeup;

  end WakeupEvent;

  -- Received message from WinSock Recv

  procedure ReceiveCallback

  ( Message : in String --Itf.Message_Buffer_Type

  ) is

  begin -- ReceiveCallback

    Text_IO.Put("Component2 received a message: ");

    declare

      Msg : String(1..Message'Length);

      for Msg use at Message'Address;

    begin

      Text_IO.Put_Line(Msg);

    end;

  end ReceiveCallback;

  -- Forever loop as initiated by Threads

  procedure Callback

  ( Id : in Integer

  ) is

  begin -- Callback

    Text_IO.Put("in Component2 callback");

    Int_IO.Put(Id);

    Text_IO.Put_Line(" ");

    loop -- forever

      Text_IO.Put_Line("Component2 to send to Component1");

      WinSock.Transmit( DeliverTo => 1,

                        Count     => 18,

                        Message   => Message'address );

      Text_IO.Put_Line("Component2 to send to RemoteComponent");

      WinSock.Transmit( DeliverTo => 6,

                        Count     => 23,

                        Message   => MessageTo6'address );

      Delay(2.0);

    end loop;

  end Callback;

end Component2;

A sample application main procedure.  The others are very similar. 

Their only purpose is to Initialize and Finalize the WinSock package that interfaces with Microsoft WinSock, install the components that are to run within the application, and then invoke Threads Create to create all the component and WinSock Recv and Xmit threads and cause their callback forever loops to be entered – each in its own thread. At that point, the launch thread ceases to execute any code and only the code in the forever loops executes.

with Component2;

with ExComponent;

with Text_IO;

with Threads;

with WinSock;

procedure App2 is

begin -- App2

  -- Initialize certain WinSock tables and input and parse the Delivery.dat file

  WinSock.Initialize;

  -- Install the components of App2

  Component2.Install;

  ExComponent.Install;

  -- Complete the WinSock tables and install the WinSock Recv and Xmit for each

  -- pair of components

  WinSock.Finalize;

  Text_IO.Put_Line("calling Threads Create");

  -- Create the threads for the thread table objects and enter the callbacks

  Threads.Create;

end App2;

The Itf package can be found in older posts.  Nothing new except that

  type V_80_String_Type

  is record

    Count : Integer;

    Data  : String(1..80);

  end record;

is declared.