source: rtems/c/src/lib/libbsp/i386/ts_386ex/tools/network_ada/tcprelay/tcprelay.adb @ 2490f92

Last change on this file since 2490f92 was d333638, checked in by Ralf Corsepius <ralf.corsepius@…>, on 10/15/06 at 05:55:34

Convert to utf-8.
  • Property mode set to 100644
File size: 4.5 KB
Line 
1-----------------------------------------------------------------------------
2--                                                                         --
3--                         ADASOCKETS COMPONENTS                           --
4--                                                                         --
5--                            T C P R E L A Y                              --
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
37with Ada.Exceptions;   use Ada.Exceptions;
38with Ada.Text_IO;      use Ada.Text_IO;
39with Sockets;          use Sockets;
40
41procedure TCPRelay is
42
43   Relay_Host : String := "host.domain";
44
45   procedure Print_Error;
46   pragma Import (C, Print_Error, "print_error");
47
48   task type Relay is
49      pragma Storage_Size (8192);
50      entry Start (From, To : Socket_FD);
51   end Relay;
52
53   -----------
54   -- Relay --
55   -----------
56
57   task body Relay
58   is
59      From_FD, To_FD : Socket_FD;
60   begin
61      select
62         accept Start (From, To : Socket_FD) do
63            From_FD := From;
64            To_FD   := To;
65         end Start;
66      or
67         terminate;
68      end select;
69
70      loop
71         Send (To_FD, Receive (From_FD));
72      end loop;
73   exception
74      when Connection_Closed =>
75         Put_Line ("Connection closed");
76         Shutdown (From_FD, Receive);
77         Shutdown (To_FD, Send);
78   end Relay;
79
80   Accepting_Socket,
81   Incoming_Socket,
82   Outgoing_Socket   : Socket_FD;
83
84   type Relay_Access is access Relay;
85   Dummy : Relay_Access;
86
87begin
88   Socket (Accepting_Socket, AF_INET, SOCK_STREAM);
89   Setsockopt (Accepting_Socket, SOL_SOCKET, SO_REUSEADDR, 1);
90   Bind (Accepting_Socket, 4567);
91   Listen (Accepting_Socket);
92   loop
93      Put_Line ("Waiting for new connection");
94      Accept_Socket (Accepting_Socket, Incoming_Socket);
95      Put_Line ("New connection acknowledged");
96      Socket (Outgoing_Socket, AF_INET, SOCK_STREAM);
97      Put_Line ("Connecting to remote host");
98      Connect (Outgoing_Socket, Relay_Host, 5000);
99      Put_Line ("Connection established");
100      Dummy := new Relay;
101      Dummy.Start (Incoming_Socket, Outgoing_Socket);
102      Dummy := new Relay;
103      Dummy.Start (Outgoing_Socket, Incoming_Socket);
104   end loop;
105exception
106   when others =>
107      Print_Error;
108end TCPRelay;
Note: See TracBrowser for help on using the repository browser.