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
–- 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
--
-- 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
–- 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;
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;
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:
-- remote/other component. After a connection has been established
-- with the other component, the
Transmit procedure can send messages
--
in the particular thread associated with the component pair in
--
via the callback.
Result := SocketBind( Id );
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.