-- -- $Id$ -- with Ada.Text_IO; with Ada.Exceptions; use Ada.Exceptions; with GNAT.Sockets; use GNAT.Sockets; procedure PingPong is Group : constant String := "239.255.128.128"; -- Multicast groupe: administratively scoped IP address -- task Pong is entry Start; entry Stop; end Pong; task body Pong is Address : Sock_Addr_Type; Server : Socket_Type; Socket : Socket_Type; Channel : Stream_Access; begin accept Start; -- -- Get an Internet address of a host (here the local host name). -- Note that a host can have several addresses. Here we get -- the first one which is supposed to be the official one. -- Ada.Text_IO.Put_Line ("PONG: Get_Host_By_Name" & Host_Name); Address.Addr := Addresses (Get_Host_By_Name (Host_Name), 1); Ada.Text_IO.Put_Line ("PONG: Back from Get_Host_By_Name"); -- -- Get a socket address that is an Internet address and a port -- Address.Port := 5432; -- -- The first step is to create a socket. Once created, this -- socket must be associated to with an address. Usually only -- a server (Pong here) needs to bind an address explicitly. -- Most of the time clients can skip this step because the -- socket routines will bind an arbitrary address to an unbound -- socket. -- Create_Socket (Server); -- -- Allow reuse of local addresses. -- Set_Socket_Option (Server, Socket_Level, (Reuse_Address, True)); Bind_Socket (Server, Address); -- -- A server marks a socket as willing to receive connect events. -- Listen_Socket (Server); -- -- Once a server calls Listen_Socket, incoming connects events -- can be accepted. The returned Socket is a new socket that -- represents the server side of the connection. Server remains -- available to receive further connections. -- Accept_Socket (Server, Socket, Address); -- -- Return a stream associated to the connected socket. -- Channel := Stream (Socket); -- -- Force Pong to block -- delay 0.2; -- -- Receive and print message from client Ping. -- declare Message : String := String'Input (Channel); begin Ada.Text_IO.Put_Line (Message); -- -- Send same message to server Pong. -- String'Output (Channel, Message); end; Close_Socket (Server); Close_Socket (Socket); -- -- Part of the multicast example -- -- Create a datagram socket to send connectionless, unreliable -- messages of a fixed maximum length. -- Create_Socket (Socket, Family_Inet, Socket_Datagram); -- -- Allow reuse of local addresses. -- Set_Socket_Option (Socket, Socket_Level, (Reuse_Address, True)); -- -- Join a multicast group. -- Set_Socket_Option (Socket, IP_Protocol_For_IP_Level, (Add_Membership, Inet_Addr (Group), Any_Inet_Addr)); -- -- Controls the live time of the datagram to avoid it being -- looped forever due to routing errors. Routers decrement -- the TTL of every datagram as it traverses from one network -- to another and when its value reaches 0 the packet is -- dropped. Default is 1. -- Set_Socket_Option (Socket, IP_Protocol_For_IP_Level, (Multicast_TTL, 1)); -- -- Want the data you send to be looped back to your host. -- Set_Socket_Option (Socket, IP_Protocol_For_IP_Level, (Multicast_Loop, True)); -- -- If this socket is intended to receive messages, bind it to a -- given socket address. -- Address.Addr := Any_Inet_Addr; Address.Port := 55505; Bind_Socket (Socket, Address); -- -- If this socket is intended to send messages, provide the -- receiver socket address. -- Address.Addr := Inet_Addr (Group); Address.Port := 55506; Channel := Stream (Socket, Address); -- -- Receive and print message from client Ping. -- declare Message : String := String'Input (Channel); begin -- -- Get the address of the sender. -- Address := Get_Address (Channel); Ada.Text_IO.Put_Line (Message & " from " & Image (Address)); -- -- Send same message to server Pong. -- String'Output (Channel, Message); end; Close_Socket (Socket); accept Stop; exception when E : others => Ada.Text_IO.Put_Line (Exception_Name (E) & ": " & Exception_Message (E)); end Pong; task Ping is entry Start; entry Stop; end Ping; task body Ping is Address : Sock_Addr_Type; Socket : Socket_Type; Channel : Stream_Access; begin accept Start; -- -- See comments in Ping section for the first steps. -- Ada.Text_IO.Put_Line ("PING: Get_Host_By_Name" & Host_Name); Address.Addr := Addresses (Get_Host_By_Name (Host_Name), 1); Ada.Text_IO.Put_Line ("PING: Back from Get_Host_By_Name"); Address.Port := 5432; Create_Socket (Socket); Set_Socket_Option (Socket, Socket_Level, (Reuse_Address, True)); -- -- Force Pong to block -- delay 0.2; -- -- If the client's socket is not bound, Connect_Socket will -- bind to an unused address. The client uses Connect_Socket to -- create a logical connection between the client's socket and -- a server's socket returned by Accept_Socket. -- Connect_Socket (Socket, Address); Channel := Stream (Socket); -- -- Send message to server Pong. -- String'Output (Channel, "Hello world"); -- -- Force Ping to block -- delay 0.2; -- -- Receive and print message from server Pong. -- Ada.Text_IO.Put_Line (String'Input (Channel)); Close_Socket (Socket); -- -- Part of multicast example. Code similar to Pong's one. -- Create_Socket (Socket, Family_Inet, Socket_Datagram); Set_Socket_Option (Socket, Socket_Level, (Reuse_Address, True)); Set_Socket_Option (Socket, IP_Protocol_For_IP_Level, (Add_Membership, Inet_Addr (Group), Any_Inet_Addr)); Set_Socket_Option (Socket, IP_Protocol_For_IP_Level, (Multicast_TTL, 1)); Set_Socket_Option (Socket, IP_Protocol_For_IP_Level, (Multicast_Loop, True)); Address.Addr := Any_Inet_Addr; Address.Port := 55506; Bind_Socket (Socket, Address); Address.Addr := Inet_Addr (Group); Address.Port := 55505; Channel := Stream (Socket, Address); -- -- Send message to server Pong. -- String'Output (Channel, "Hello world"); -- -- Receive and print message from server Pong. -- declare Message : String := String'Input (Channel); begin Address := Get_Address (Channel); Ada.Text_IO.Put_Line (Message & " from " & Image (Address)); end; Close_Socket (Socket); accept Stop; exception when E : others => Ada.Text_IO.Put_Line (Exception_Name (E) & ": " & Exception_Message (E)); end Ping; begin -- Indicate whether the thread library provides process -- blocking IO. Basically, if you are not using FSU threads -- the default is ok. -- Initialize (Process_Blocking_IO => False); Ping.Start; Pong.Start; Ping.Stop; Pong.Stop; Finalize; end PingPong;