Re: Memory leak in examples
Dmitriy Anisimkov <[email protected]> Fri, 06 Aug 2004 19:33:43 +0700
| Newsgroups | gmane.comp.lang.ada.sockets |
|---|---|
| Message-ID | <[email protected]> |
This is a multi-part message in MIME format. --------------080502020501020002030204 Content-Type: text/plain; charset=ISO-8859-1; format=flowed Content-Transfer-Encoding: 7bit [email protected] wrote: >Hello, > >It turns out that dynamically allocated tasks need to be freed. The leak is >not relevant for the examples themselves, but the danger is that somebody >might use the example code as a skeleton for real code. > >The affected files are listener.adb, stream_listener.adb, tcprelay.adb. >Should I provide a patch or new versions of those files? Or would you >prefer to just insert the relevant lines: > > >with Ada.Unchecked_Deallocation; > >procedure Free is new Ada.Unchecked_Deallocation (Echo, Echo_Access); > >Dummy := new Echo; >Dummy.Start (Incoming_Socket); >Free (Dummy); -- Missing free > > > Task could be freed only after termination. You should do something like that. loop delay Some_Time; if Dumme'Terminated then Free (Dummy); exit; end if; end loop; I made a program relay.adb, similar to tcprelay.adb but with dynamic task deallocation and based on the AWS sockets interface. Task deallocation is performed in the special task Destructor, which is waiting for termination and deallocate the task. See attachment. --------------080502020501020002030204 Content-Type: text/plain; name="relay.adb" Content-Transfer-Encoding: 7bit Content-Disposition: inline; filename="relay.adb" ----------------------------------------------------------------------------- -- -- -- R E L A Y -- -- -- -- Copyright (C) 2002-2004 -- -- Dmitriy Anisimkov -- -- -- -- Relay is free software; you can redistribute it and/or modify -- -- it under terms of the GNU General Public License as published by -- -- the Free Software Foundation; either version 2, or (at your option) -- -- any later version. AdaSockets is distributed in the hope that it -- -- will be useful, but WITHOUT ANY WARRANTY; without even the implied -- -- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- -- See the GNU General Public License for more details. You should -- -- have received a copy of the GNU General Public License distributed -- -- with AdaSockets; see file COPYING. If not, write to the Free -- -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- -- 02111-1307, USA. -- -- -- -- As a special exception, if other files instantiate generics from -- -- this unit, or you link this unit with other files to produce an -- -- executable, this unit does not by itself cause the resulting -- -- executable to be covered by the GNU General Public License. This -- -- exception does not however invalidate any other reasons why the -- -- executable file might be covered by the GNU Public License. -- ----------------------------------------------------------------------------- with Ada.Command_Line; with Ada.Exceptions; with Ada.Text_IO; with Ada.Streams; with Ada.Characters.Handling; with Ada.Unchecked_Deallocation; with AWS.Net; with GNAT.OS_Lib; procedure Relay is use Ada.Command_Line; use Ada.Text_IO; -- Usage: relay localport remotehost remoteport [options] -- Example: relay 5000 localhost 25, -- then telnet localhost 5000 use AWS; use type Net.Socket_Access; type Show_Enum is (Client_IP, Error, Error_Info, First_Data, Text_Data, Binary_Data); Output_Set : array (Show_Enum) of Boolean := (others => False); Local_Port : Integer; Remote_Port : Integer; subtype Socket_Access is Net.Socket_Access; protected Direct is procedure Check (Where : Character); private Current : Character := ASCII.Nul; end Direct; type Relay; type Relay_Access is access Relay; task type Relay is entry Start (Socket : in Socket_Access; Self : in Relay_Access); end Relay; task Destructor is entry Free_Task (R : Relay_Access); end Destructor; procedure Unexpected (E : Ada.Exceptions.Exception_Occurrence; Text : String); pragma Inline (Unexpected); ------------ -- Direct -- ------------ protected body Direct is ----------- -- Check -- ----------- procedure Check (Where : Character) is begin if Where /= Current then Put_Line (ASCII.Lf & Current & Where); Current := Where; end if; end Check; end Direct; ---------------- -- Destructor -- ---------------- task body Destructor is Rf : Relay_Access; procedure Free is new Ada.Unchecked_Deallocation (Relay, Relay_Access); begin loop select accept Free_Task (R : Relay_Access) do Rf := R; end Free_Task; end select; loop exit when Rf'Terminated; delay 0.001; end loop; Free (Rf); end loop; exception when E : others => Unexpected (E, "Destructor"); end Destructor; ----------- -- Relay -- ----------- task body Relay is Server : Net.Socket_Type'CLass := Net.Socket (Remote_Port < 0); Client : Socket_Access; -- symbol < on console detect server side -- and symbol > detect client side. Connected : Boolean := False; Self : Relay_Access; First_Output : Boolean := True; procedure Move (From_FD, To_FD : in Net.Socket_Type'Class; Dir : in Character); procedure Transfer; ---------- -- Move -- ---------- procedure Move (From_FD, To_FD : in Net.Socket_Type'Class; Dir : in Character) is begin loop declare use Ada.Streams; Tmp : Stream_Element_Array := Net.Receive (From_FD); Last_Lf : Stream_Element_Offset := Tmp'First; All_Text : Boolean := True; procedure Binary_Output; procedure Text_Output; ------------------- -- Binary_Output -- ------------------- procedure Binary_Output is function Hex (V : in Stream_Element) return String; --------- -- Hex -- --------- function Hex (V : in Stream_Element) return String is Hex_V : String (1 .. 6); -- 16#00# -- 123456 package IO is new Ada.Text_IO.Modular_IO (Stream_Element); begin IO.Put (Hex_V, V, 16); if Hex_V (Hex_V'First) = ' ' then return '0' & Hex_V (5); else return Hex_V (4 .. 5); end if; end Hex; Idx : Natural := 1; First_Binary : Stream_Element_Offset; begin if All_Text then return; end if; if Last_Lf = Tmp'First then First_Binary := Tmp'First; else First_Binary := Last_Lf + 1; end if; declare Hex_Text : String (1 .. Integer (Tmp'Last - First_Binary + 1) * 3); begin for I in First_Binary .. Tmp'Last loop Hex_Text (Idx .. Idx + 1) := Hex (Tmp (I)); if I rem 26 = 0 or I = Tmp'Last then Hex_Text (Idx + 2) := ASCII.LF; else Hex_Text (Idx + 2) := ' '; end if; Idx := Idx + 3; end loop; Put (Hex_Text); Flush; end; end Binary_Output; ----------------- -- Text_Output -- ----------------- procedure Text_Output is Text : String (1 .. Tmp'Length); Chr : Character; Text_Shift : constant Integer := Text'First - Integer (Tmp'First); begin for I in Tmp'Range loop Chr := Character'Val (Stream_Element'Pos (Tmp (I))); if Ada.Characters.Handling.Is_Graphic (Chr) or else Chr = ASCII.Lf or else Chr = ASCII.Ht or else Chr = ASCII.Cr then Text (Integer (I) + Text_Shift) := Chr; if Chr = ASCII.Lf then Last_Lf := I; end if; else All_Text := False; exit; end if; end loop; if All_Text then Put (Text); Flush; elsif Last_Lf > Tmp'First then Put (Text (Text'First .. Integer (Last_Lf) + Text_Shift)); Flush; end if; end Text_Output; begin if Output_Set (First_Data .. Binary_Data) /= (First_Data .. Binary_Data => False) then Direct.Check (Dir); if (Output_Set (First_Data) and First_Output) or Output_Set (Text_Data) then Text_Output; end if; if (Output_Set (First_Data) and First_Output) or Output_Set (Binary_Data) then Binary_Output; end if; First_Output := False; end if; Net.Send (To_FD, Tmp); end; end loop; end Move; -------------- -- Transfer -- -------------- procedure Transfer is task Back_Task; protected Flag is entry Once (Result : out Boolean); procedure Complete; private Value : Boolean := True; Busy : Boolean := False; end Flag; procedure Free (Dir : Character); --------------- -- Back_Task -- --------------- task body Back_Task is begin Move (Client.all, Server, '>'); exception when Net.Socket_Error => Free ('>'); when E : others => Unexpected (E, "relay"); end Back_Task; ---------- -- Free -- ---------- procedure Free (Dir : Character) is First : Boolean; begin Flag.Once (First); if First then Net.Shutdown (Server); Net.Shutdown (Client.all); Put (Dir & "closed"); Flag.Complete; else AWS.Net.Free (Client); AWS.Net.Free (Server); return; end if; exception when E : others => Flag.Complete; Unexpected (E, "in free"); end Free; ---------- -- Flag -- ---------- protected body Flag is ---------- -- Once -- ---------- entry Once (Result : out Boolean) when not Busy is begin Result := Value; Value := False; Busy := True; end Once; -------------- -- Complete -- -------------- procedure Complete is begin Busy := False; end Complete; end Flag; begin Move (Server, Client.all, '<'); exception when Net.Socket_Error => Free ('<'); end Transfer; begin accept Start (Socket : in Socket_Access; Self : in Relay_Access) do Client := Socket; Relay.Self := Start.Self; end Start; begin AWS.Net.Connect (Server, Argument (2), abs (Remote_Port)); Connected := True; exception when AWS.Net.Socket_Error => Put_Line (">Could not connect."); Net.Shutdown (Client.all); AWS.Net.Free (Client); end; if Connected then Transfer; end if; Destructor.Free_Task (Self); exception when E : others => Put_Line ("task error"); Unexpected (E, "relay"); end Relay; ---------------- -- Unexpected -- ---------------- procedure Unexpected (E : Ada.Exceptions.Exception_Occurrence; Text : String) is begin Put_Line (Current_Error, Text & ASCII.Lf & Ada.Exceptions.Exception_Information (E)); Flush (Current_Error); GNAT.OS_Lib.OS_Abort; end Unexpected; Accepting_Socket : Net.Socket_Type'Class := Net.Socket (False); begin Local_Port := Integer'Value (Argument (1)); Remote_Port := Integer'Value (Argument (3)); for i in 4 .. Argument_Count loop Output_Set (Show_Enum'Value (Argument (i))) := True; end loop; Net.Bind (Accepting_Socket, abs (Local_Port)); Net.Listen (Accepting_Socket); loop declare Incoming_Socket : Socket_Access; Income : Relay_Access; begin Incoming_Socket := Net.Socket (Local_Port < 0); AWS.Net.Accept_Socket (Accepting_Socket, New_Socket => Incoming_Socket.all); if Output_Set (Client_IP) then Put_Line (Net.Peer_Addr (Incoming_Socket.all)); end if; Income := new Relay; Income.Start (Incoming_Socket, Income); exception when E : others => Put_Line (Current_Error, "Accept " & ASCII.Lf & Ada.Exceptions.Exception_Information (E)); if Incoming_Socket /= null then Net.Shutdown (Incoming_Socket.all); Net.Free (Incoming_Socket); end if; end; end loop; exception when Constraint_Error => Put ("Usage: " & Command_Name & " localport remotehost remoteport"); for i in Show_Enum'Range loop Put (" [" & Show_Enum'Image (i) & ']'); end loop; New_Line; when E : others => Put_Line ("main error"); Unexpected (E, "Unexpected error in main task"); end Relay; --------------080502020501020002030204 Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Disposition: inline _______________________________________________ AdaSockets mailing list [email protected] http://lists.rfc1149.net/mailman/listinfo/adasockets --------------080502020501020002030204--