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