source: ada-examples/pingpong/pingpong.adb @ 67e0556

ada-examples-4-10-branchada-examples-4-9-branch
Last change on this file since 67e0556 was 67e0556, checked in by Joel Sherrill <joel.sherrill@…>, on Sep 27, 2007 at 2:40:57 PM

2007-09-27 Joel Sherrill <joel.sherrill@…>

  • ChangeLog?, Makefile, README, pingpong.adb: New files.
  • Property mode set to 100644
File size: 7.5 KB
Line 
1with Ada.Text_IO;
2with Ada.Exceptions; use Ada.Exceptions;
3with GNAT.Sockets;   use GNAT.Sockets;
4
5procedure PingPong is
6
7   Group : constant String := "239.255.128.128";
8   --  Multicast groupe: administratively scoped IP address
9   --
10   task Pong is
11      entry Start;
12      entry Stop;
13   end Pong;
14
15   task body Pong is
16      Address  : Sock_Addr_Type;
17      Server   : Socket_Type;
18      Socket   : Socket_Type;
19      Channel  : Stream_Access;
20
21   begin
22      accept Start;
23      --
24      --  Get an Internet address of a host (here the local host name).
25      --  Note that a host can have several addresses. Here we get
26      --  the first one which is supposed to be the official one.
27      --
28      Address.Addr := Addresses (Get_Host_By_Name (Host_Name), 1);
29      --
30      --  Get a socket address that is an Internet address and a port
31      --
32      Address.Port := 5432;
33      --
34      --  The first step is to create a socket. Once created, this
35      --  socket must be associated to with an address. Usually only
36      --  a server (Pong here) needs to bind an address explicitly.
37      --  Most of the time clients can skip this step because the
38      --  socket routines will bind an arbitrary address to an unbound
39      --  socket.
40      --
41      Create_Socket (Server);
42      --
43      --  Allow reuse of local addresses.
44      --
45      Set_Socket_Option
46        (Server,
47         Socket_Level,
48         (Reuse_Address, True));
49
50      Bind_Socket (Server, Address);
51      --
52      --  A server marks a socket as willing to receive connect events.
53      --
54      Listen_Socket (Server);
55      --
56      --  Once a server calls Listen_Socket, incoming connects events
57      --  can be accepted. The returned Socket is a new socket that
58      --  represents the server side of the connection. Server remains
59      --  available to receive further connections.
60      --
61      Accept_Socket (Server, Socket, Address);
62      --
63      --  Return a stream associated to the connected socket.
64      --
65      Channel := Stream (Socket);
66      --
67      --  Force Pong to block
68      --
69      delay 0.2;
70      --
71      --  Receive and print message from client Ping.
72      --
73      declare
74         Message : String := String'Input (Channel);
75      begin
76         Ada.Text_IO.Put_Line (Message);
77         --
78         --  Send same message to server Pong.
79         --
80         String'Output (Channel, Message);
81      end;
82
83      Close_Socket (Server);
84      Close_Socket (Socket);
85      --
86      --  Part of the multicast example
87      --
88      --  Create a datagram socket to send connectionless, unreliable
89      --  messages of a fixed maximum length.
90      --
91      Create_Socket (Socket, Family_Inet, Socket_Datagram);
92      --
93      --  Allow reuse of local addresses.
94      --
95      Set_Socket_Option
96        (Socket,
97         Socket_Level,
98         (Reuse_Address, True));
99      --
100      --  Join a multicast group.
101      --
102      Set_Socket_Option
103        (Socket,
104         IP_Protocol_For_IP_Level,
105         (Add_Membership, Inet_Addr (Group), Any_Inet_Addr));
106      --
107      --  Controls the live time of the datagram to avoid it being
108      --  looped forever due to routing errors. Routers decrement
109      --  the TTL of every datagram as it traverses from one network
110      --  to another and when its value reaches 0 the packet is
111      --  dropped. Default is 1.
112      --
113      Set_Socket_Option
114        (Socket,
115         IP_Protocol_For_IP_Level,
116         (Multicast_TTL, 1));
117      --
118      --  Want the data you send to be looped back to your host.
119      --
120      Set_Socket_Option
121        (Socket,
122         IP_Protocol_For_IP_Level,
123         (Multicast_Loop, True));
124      --
125      --  If this socket is intended to receive messages, bind it to a
126      --  given socket address.
127      --
128      Address.Addr := Any_Inet_Addr;
129      Address.Port := 55505;
130
131      Bind_Socket (Socket, Address);
132      --
133      --  If this socket is intended to send messages, provide the
134      --  receiver socket address.
135      --
136      Address.Addr := Inet_Addr (Group);
137      Address.Port := 55506;
138
139      Channel := Stream (Socket, Address);
140      --
141      --  Receive and print message from client Ping.
142      --
143      declare
144         Message : String := String'Input (Channel);
145
146      begin
147         --
148         --  Get the address of the sender.
149         --
150         Address := Get_Address (Channel);
151         Ada.Text_IO.Put_Line (Message & " from " & Image (Address));
152         --
153         --  Send same message to server Pong.
154         --
155         String'Output (Channel, Message);
156      end;
157
158      Close_Socket (Socket);
159
160      accept Stop;
161
162   exception when E : others =>
163      Ada.Text_IO.Put_Line
164        (Exception_Name (E) & ": " & Exception_Message (E));
165   end Pong;
166
167   task Ping is
168      entry Start;
169      entry Stop;
170   end Ping;
171
172   task body Ping is
173      Address  : Sock_Addr_Type;
174      Socket   : Socket_Type;
175      Channel  : Stream_Access;
176
177   begin
178      accept Start;
179   --
180   --  See comments in Ping section for the first steps.
181   --
182      Address.Addr := Addresses (Get_Host_By_Name (Host_Name), 1);
183      Address.Port := 5432;
184      Create_Socket (Socket);
185
186      Set_Socket_Option
187        (Socket,
188         Socket_Level,
189         (Reuse_Address, True));
190      --
191      --  Force Pong to block
192      --
193      delay 0.2;
194      --
195      --  If the client's socket is not bound, Connect_Socket will
196      --  bind to an unused address. The client uses Connect_Socket to
197      --  create a logical connection between the client's socket and
198      --  a server's socket returned by Accept_Socket.
199      --
200      Connect_Socket (Socket, Address);
201
202      Channel := Stream (Socket);
203      --
204      --  Send message to server Pong.
205      --
206      String'Output (Channel, "Hello world");
207      --
208      --  Force Ping to block
209      --
210      delay 0.2;
211      --
212      --  Receive and print message from server Pong.
213      --
214      Ada.Text_IO.Put_Line (String'Input (Channel));
215      Close_Socket (Socket);
216      --
217      --  Part of multicast example. Code similar to Pong's one.
218      --
219      Create_Socket (Socket, Family_Inet, Socket_Datagram);
220
221      Set_Socket_Option
222        (Socket,
223         Socket_Level,
224         (Reuse_Address, True));
225
226      Set_Socket_Option
227        (Socket,
228         IP_Protocol_For_IP_Level,
229         (Add_Membership, Inet_Addr (Group), Any_Inet_Addr));
230
231      Set_Socket_Option
232        (Socket,
233         IP_Protocol_For_IP_Level,
234         (Multicast_TTL, 1));
235
236      Set_Socket_Option
237        (Socket,
238         IP_Protocol_For_IP_Level,
239         (Multicast_Loop, True));
240
241      Address.Addr := Any_Inet_Addr;
242      Address.Port := 55506;
243
244      Bind_Socket (Socket, Address);
245
246      Address.Addr := Inet_Addr (Group);
247      Address.Port := 55505;
248
249      Channel := Stream (Socket, Address);
250      --
251      --  Send message to server Pong.
252      --
253      String'Output (Channel, "Hello world");
254      --
255      --  Receive and print message from server Pong.
256      --
257      declare
258         Message : String := String'Input (Channel);
259
260      begin
261         Address := Get_Address (Channel);
262         Ada.Text_IO.Put_Line (Message & " from " & Image (Address));
263      end;
264
265      Close_Socket (Socket);
266
267      accept Stop;
268
269   exception when E : others =>
270      Ada.Text_IO.Put_Line
271        (Exception_Name (E) & ": " & Exception_Message (E));
272   end Ping;
273   
274begin
275   --  Indicate whether the thread library provides process
276   --  blocking IO. Basically, if you are not using FSU threads
277   --  the default is ok.
278   --
279   Initialize (Process_Blocking_IO => False);
280   Ping.Start;
281   Pong.Start;
282   Ping.Stop;
283   Pong.Stop;
284   Finalize;
285end PingPong;
Note: See TracBrowser for help on using the repository browser.