~nytpu/tlsada

3064764c5534d696815a73583bd2f8447d094682 — nytpu 1 year, 11 months ago 344160d
TLS.Contexts: Move connected & configured flags to wrapper
4 files changed, 30 insertions(+), 34 deletions(-)

M src/tls-contexts-client.adb
M src/tls-contexts-server.adb
M src/tls-contexts.adb
M src/tls-contexts.ads
M src/tls-contexts-client.adb => src/tls-contexts-client.adb +4 -4
@@ 22,7 22,7 @@ package body TLS.Contexts.Client is
	------------

	overriding function Create return Client_Context
	is ((Root_Stream_Type with True, False, False, Initialize_Client));
	is ((Root_Stream_Type with Initialize_Client));


	-------------


@@ 51,7 51,7 @@ package body TLS.Contexts.Client is
					Host & ":" & Port'Image & "': " &
					Retrieve_Error_Message(Ctx.Context);
		end if;
		Ctx.Connected := True;
		Ctx.Context.Connected := True;
	end Connect;

	procedure Connect


@@ 85,7 85,7 @@ package body TLS.Contexts.Client is
					Host & ":" & Port'Image & "': " &
					Retrieve_Error_Message(Ctx.Context);
		end if;
		Ctx.Connected := True;
		Ctx.Context.Connected := True;
	end Connect;

	procedure Connect


@@ 109,7 109,7 @@ package body TLS.Contexts.Client is
					Image(Socket) & "': " &
					Retrieve_Error_Message(Ctx.Context);
		end if;
		Ctx.Connected := True;
		Ctx.Context.Connected := True;
	end Connect;



M src/tls-contexts-server.adb => src/tls-contexts-server.adb +3 -4
@@ 22,7 22,7 @@ package body TLS.Contexts.Server is
	------------

	overriding function Create return Server_Context
	is (Server_Context'(Root_Stream_Type with True, False, False, Initialize_Server));
	is (Server_Context'(Root_Stream_Type with Initialize_Server));


	----------------


@@ 44,9 44,8 @@ package body TLS.Contexts.Server is
					Image(Socket) & "': " &
					Retrieve_Error_Message(Server_Ctx.Context);
		end if;
		Connected_Context.Initialized := True;
		Connected_Context.Configured := True;
		Connected_Context.Connected := True;
		Connected_Context.Context.Configured := True;
		Connected_Context.Context.Connected := True;
	end Accept_TLS;



M src/tls-contexts.adb => src/tls-contexts.adb +18 -20
@@ 28,7 28,7 @@ package body TLS.Contexts is
	--------------------

	function Is_Initialized (Ctx : Context) return Boolean
	is (Ctx.Initialized);
	is (Ctx.Context.Context /= null);


	------------------


@@ 36,7 36,7 @@ package body TLS.Contexts is
	------------------

	function Is_Configued (Ctx : Context) return Boolean
	is (Ctx.Configured);
	is (Ctx.Context.Configured);


	------------------


@@ 44,7 44,7 @@ package body TLS.Contexts is
	------------------

	function Is_Connected (Ctx : Context) return Boolean
	is (Ctx.Connected);
	is (Ctx.Context.Connected);


	---------------


@@ 219,7 219,7 @@ package body TLS.Contexts is
			raise TLS_Error
				with "unable to configure context: " & Retrieve_Error_Message(Ctx.Context);
		end if;
		Ctx.Configured := True;
		Ctx.Context.Configured := True;
	end Configure;




@@ 308,10 308,7 @@ package body TLS.Contexts is

	procedure Close (Ctx : in out Context) is
	begin
		if Ctx.Connected then
			Close(Ctx.Context);
			Ctx.Connected := False;
		end if;
		Close(Ctx.Context);
	end Close;




@@ 553,7 550,6 @@ package body TLS.Contexts is
				raise TLS_Error
					with "unable to generate libtls tls context";
			end if;
			Ctx.Initialized := True;
		end return;
	end Initialize_Client;



@@ 570,7 566,6 @@ package body TLS.Contexts is
				raise TLS_Error
					with "unable to generate libtls tls context";
			end if;
			Ctx.Initialized := True;
		end return;
	end Initialize_Server;



@@ 582,15 577,18 @@ package body TLS.Contexts is
	procedure Close (Ctx : in out Context_Wrapper) is
		R : int;
	begin
		loop
			R := Bs.tls_close(Ctx.Context);
			if R = -1 then
				raise Connect_Error
					with "unable to close connection: " &
						Retrieve_Error_Message(Ctx);
			end if;
			exit when R /= Bs.TLS_WANT_POLLIN and R /= Bs.TLS_WANT_POLLOUT;
		end loop;
		if Ctx.Connected then
			loop
				R := Bs.tls_close(Ctx.Context);
				if R = -1 then
					raise Connect_Error
						with "unable to close connection: " &
							Retrieve_Error_Message(Ctx);
				end if;
				exit when R /= Bs.TLS_WANT_POLLIN and R /= Bs.TLS_WANT_POLLOUT;
			end loop;
			Ctx.Connected := False;
		end if;
	end Close;




@@ 607,7 605,7 @@ package body TLS.Contexts is
			Bs.tls_free(Ctx.Context);

			Ctx.Context := null;
			Ctx.Initialized := False;
			Ctx.Configured := False;
		end if;
	end Finalize;


M src/tls-contexts.ads => src/tls-contexts.ads +5 -6
@@ 186,17 186,17 @@ private
	type Context_Wrapper is
		new Ada.Finalization.Limited_Controlled with
	record
		Initialized : Boolean := False;
		Configured, Connected : Boolean := False;
		Context : access libTLS_Bindings.tls := null;
	end record;

	-- Initialize an internal client context
	function Initialize_Client return Context_Wrapper
		with Post => Initialize_Client'Result.Initialized;
		with Post => Initialize_Client'Result.Context /= null;

	-- Initialize an internal server context
	function Initialize_Server return Context_Wrapper
		with Post => Initialize_Server'Result.Initialized;
		with Post => Initialize_Server'Result.Context /= null;

	-- Close the active TLS connection
	procedure Close (Ctx : in out Context_Wrapper);


@@ 206,7 206,7 @@ private

	-- Return an error message as retrieved by tls_error
	function Retrieve_Error_Message (Ctx : Context_Wrapper) return String
		with Pre => Ctx.Initialized;
		with Pre => Ctx.Context /= null;

	-- Take a C function operating on a libtls context and returns a C string
	-- and call it with the given Context_Wrapper, and return an


@@ 217,10 217,9 @@ private
	function Call_String_Function
		(Func : String_Function; Ctx : Context_Wrapper)
		return Unbounded_String
		with Pre => Ctx.Initialized;
		with Pre => Ctx.Context /= null;

	type Context is abstract limited new Ada.Streams.Root_Stream_Type with record
		Initialized, Configured, Connected : Boolean := False;
		Context : Context_Wrapper;
	end record;