1--------------------------------------------------------------------------
2--  file : multiecho.adb [$Revision: 110555 $]
3--------------------------------------------------------------------------
4
5--  This is a modification of "echoserver.adb", to allow multiple
6--  connections, using Ada tasks.
7
8--  waits for a client to attach to port 8189, then
9--  reads input from the client, a line at a time, and echos it.
10--  To run this program, type "java EchoServer",
11--  then put the job in the background
12--  or switch to another window, and type
13--  "telnet <hostname> <portnumber>",
14--  replacing <hostname> by the name of
15--  the host on which you are running the echo-server
16--  and <portnumber> by the port number that the server printed
17--  out when it started up.
18--  This will connect you to the server.
19--  The server should be able to handle up to 4 concurrent connections.
20--  Use control-C to kill the server.
21
22with ada.characters.latin_1;
23with ada.exceptions;
24with ada.task_identification;
25with ada.text_io;
26with sockets;
27with sockets.internet;
28procedure multiecho is
29
30   type connection_id is range 1..4;
31   connections : array (connection_id) of sockets.stream_socket;
32
33   procedure shut_down (e : ada.exceptions.exception_occurrence);
34   main_task : ada.task_identification.task_id :=
35       ada.task_identification.current_task;
36   --  used to shut down the entire program
37
38   task type server_task;
39   servers : array (connections'range) of server_task;
40
41   lf : constant character := ada.characters.latin_1.lf;
42   -- line-feed
43   cr : constant character := ada.characters.latin_1.cr;
44   -- carriage-return
45
46   protected server_pool is
47      entry await_turn;
48      procedure next_turn;
49   private
50      turn : boolean := false;
51   end server_pool;
52
53   protected body server_pool is
54      entry await_turn when turn is
55      begin
56         turn := false;
57      end await_turn;
58      procedure next_turn is
59      begin
60         turn := true;
61      end next_turn;
62   end server_pool;
63
64   procedure writeln (outs : sockets.output_stream_ptr; s : string) is
65   begin
66      string'write (outs, s);
67      character'write (outs, cr);
68      character'write (outs, lf);
69   end writeln;
70
71   function readln (ins : sockets.input_stream_ptr) return string is
72      buf : string (1 .. 1024);
73      i : integer := 1;
74   begin
75      loop
76         character'read (ins, buf (i));
77         exit when buf (i) = lf;
78         i := i + 1;
79      end loop;
80      return buf (1 .. i-2);
81   end readln;
82
83   peer : sockets.internet.internet_socket_address;
84   s   : sockets.server_socket;
85
86   task body server_task is
87      connection : sockets.stream_socket;
88      ins : sockets.input_stream_ptr;
89      outs : sockets.output_stream_ptr;
90   begin
91      loop
92         server_pool.await_turn;
93         sockets.accept_connection (s, connection, peer);
94         server_pool.next_turn;
95         ins := sockets.get_input_stream (connection);
96         outs := sockets.get_output_stream (connection);
97         writeln (outs, "Hello! Enter BYE to exit.");
98         loop
99            declare
100               str : string := readln (ins);
101            begin
102               exit when str (1..3) = "BYE";
103               writeln (outs, "Echo: """ & str & '"');
104            end;
105         end loop;
106         sockets.close(connection);
107      end loop;
108   exception when e : others => shut_down (e);
109   end server_task;
110
111   procedure shut_down (e : ada.exceptions.exception_occurrence) is
112   begin
113      ada.text_io.put_line ("main: " & ada.exceptions.exception_name (e)
114         & ": " & ada.exceptions.exception_message (e));
115      sockets.close (s);
116      ada.task_identification.abort_task (main_task);
117   end shut_down;
118
119begin
120   sockets.open (s, sockets.internet.new_address
121     (sockets.internet.any_port, sockets.internet.all_local_addresses));
122   ada.text_io.put_line ("serving at: "
123       & sockets.internet.get_addressstring (
124--     & sockets.internet.get_hostbyaddr (
125       sockets.internet.get_internet_address (
126       sockets.internet.get_address (s)))
127     & " port "
128     & sockets.internet.port_number'image (
129       sockets.internet.get_port (
130       sockets.internet.get_address (s))));
131   server_pool.next_turn;
132exception when e : others => shut_down (e);
133end multiecho;
134
135
136