1 | ----------------------------------------------------------------------------- |
---|
2 | -- -- |
---|
3 | -- ADASOCKETS COMPONENTS -- |
---|
4 | -- -- |
---|
5 | -- L I S T E N E R -- |
---|
6 | -- -- |
---|
7 | -- B o d y -- |
---|
8 | -- -- |
---|
9 | -- $ReleaseVersion: 0.1.3 $ -- |
---|
10 | -- -- |
---|
11 | -- Copyright (C) 1998 Ãcole Nationale Supérieure des Télécommunications -- |
---|
12 | -- -- |
---|
13 | -- AdaSockets is free software; you can redistribute it and/or modify -- |
---|
14 | -- it under terms of the GNU General Public License as published by -- |
---|
15 | -- the Free Software Foundation; either version 2, or (at your option) -- |
---|
16 | -- any later version. AdaSockets is distributed in the hope that it -- |
---|
17 | -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- |
---|
18 | -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- |
---|
19 | -- See the GNU General Public License for more details. You should -- |
---|
20 | -- have received a copy of the GNU General Public License distributed -- |
---|
21 | -- with AdaSockets; see file COPYING. If not, write to the Free -- |
---|
22 | -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- |
---|
23 | -- 02111-1307, USA. -- |
---|
24 | -- -- |
---|
25 | -- As a special exception, if other files instantiate generics from -- |
---|
26 | -- this unit, or you link this unit with other files to produce an -- |
---|
27 | -- executable, this unit does not by itself cause the resulting -- |
---|
28 | -- executable to be covered by the GNU General Public License. This -- |
---|
29 | -- exception does not however invalidate any other reasons why the -- |
---|
30 | -- executable file might be covered by the GNU Public License. -- |
---|
31 | -- -- |
---|
32 | -- The main repository for this software is located at: -- |
---|
33 | -- http://www-inf.enst.fr/ANC/ -- |
---|
34 | -- -- |
---|
35 | ----------------------------------------------------------------------------- |
---|
36 | |
---|
37 | with Ada.Exceptions; use Ada.Exceptions; |
---|
38 | with Ada.Text_IO; use Ada.Text_IO; |
---|
39 | with Sockets; use Sockets; |
---|
40 | |
---|
41 | procedure Listener is |
---|
42 | |
---|
43 | -- Usage: listener |
---|
44 | -- Example: listener |
---|
45 | -- then telnet localhost `listen_port' |
---|
46 | |
---|
47 | Listen_Port : Positive := 5000; |
---|
48 | |
---|
49 | task type Echo is |
---|
50 | entry Start (FD : in Socket_FD); |
---|
51 | end Echo; |
---|
52 | |
---|
53 | function Rev (S : String) return String; |
---|
54 | -- Reverse a string |
---|
55 | |
---|
56 | ---------- |
---|
57 | -- Echo -- |
---|
58 | ---------- |
---|
59 | |
---|
60 | task body Echo is |
---|
61 | Sock : Socket_FD; |
---|
62 | begin |
---|
63 | select |
---|
64 | accept Start (FD : in Socket_FD) do |
---|
65 | Sock := FD; |
---|
66 | end Start; |
---|
67 | or |
---|
68 | terminate; |
---|
69 | end select; |
---|
70 | |
---|
71 | loop |
---|
72 | Put_Line (Sock, Rev (Get_Line (Sock))); |
---|
73 | end loop; |
---|
74 | |
---|
75 | exception |
---|
76 | when Connection_Closed => |
---|
77 | Put_Line ("Connection closed"); |
---|
78 | Shutdown (Sock, Both); |
---|
79 | end Echo; |
---|
80 | |
---|
81 | Accepting_Socket : Socket_FD; |
---|
82 | Incoming_Socket : Socket_FD; |
---|
83 | |
---|
84 | type Echo_Access is access Echo; |
---|
85 | Dummy : Echo_Access; |
---|
86 | |
---|
87 | --------- |
---|
88 | -- Rev -- |
---|
89 | --------- |
---|
90 | |
---|
91 | function Rev (S : String) return String is |
---|
92 | Result : String (1 .. S'Length); |
---|
93 | Index : Natural := 0; |
---|
94 | begin |
---|
95 | for I in reverse S'Range loop |
---|
96 | Index := Index + 1; |
---|
97 | Result (Index) := S (I); |
---|
98 | end loop; |
---|
99 | return Result; |
---|
100 | end Rev; |
---|
101 | |
---|
102 | begin |
---|
103 | Socket (Accepting_Socket, AF_INET, SOCK_STREAM); |
---|
104 | Setsockopt (Accepting_Socket, SOL_SOCKET, SO_REUSEADDR, 1); |
---|
105 | Bind (Accepting_Socket, Listen_Port); |
---|
106 | Listen (Accepting_Socket); |
---|
107 | loop |
---|
108 | Put_Line ("Waiting for new connection"); |
---|
109 | Accept_Socket (Accepting_Socket, Incoming_Socket); |
---|
110 | Put_Line ("New connection acknowledged"); |
---|
111 | Dummy := new Echo; |
---|
112 | Dummy.Start (Incoming_Socket); |
---|
113 | end loop; |
---|
114 | end Listener; |
---|