ada/aws
0
0
Fork 0
mirror of https://github.com/AdaCore/aws.git synced 2026-02-12 12:29:46 -08:00
Code Issues Packages Projects Releases Wiki Activity

GNUTLS 3.6.4 compatibility

Browse Source 
Few fixes in test project names
This commit is contained in:
Dmitriy Anisimkov
2018-11-27 16:38:00 +06:00
committed by Pascal Obry
parent 32c0db15de
commit 6be41abe5d
8 changed files with 88 additions and 33 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
regtests/0033_afile_sec/s_afile_pack.adb
View File

@@ -259,8 +259,8 @@ package body S_AFile_Pack is
begin
if ASU.To_String (Session) /= Sessn then
Text_IO.Put_Line
("Server and client sessions differ "
& ASU.To_String (Session) & ' ' & Sessn);
("Server and client sessions differ """
& ASU.To_String (Session) & """ """ & Sessn & '"');
end if;
end;
@@ -287,6 +287,8 @@ package body S_AFile_Pack is
Config.Set.Server_Port (CNF, 0);
Config.Set.Security (CNF, Protocol = "https");
Config.Set.Max_Connection (CNF, 16);
Config.Set.Security_Mode (CNF, "TLSv1_2_Server");
-- TLS 1.3 does not provide equal session id in client and server
Server.Start (WS, CB'Access, CNF);

6
regtests/0043_check_mem/check_mem.adb
View File

@@ -32,6 +32,7 @@ with Ada.Command_Line;
with Ada.Exceptions;
with Ada.IO_Exceptions;
with Ada.Streams;
with Ada.Strings.Fixed;
with Ada.Strings.Unbounded;
with Ada.Text_IO.Editing;
@@ -519,7 +520,10 @@ procedure Check_Mem is
Session := To_Unbounded_String (AWS.Client.SSL_Session_Id (Connect));
if Session = Null_Unbounded_String then
if Session = Null_Unbounded_String
and then Ada.Strings.Fixed.Index
(AWS.Client.Cipher_Description (Connect), "TLS1.3") = 0
then
Check ("!!! Empty SSL session.");
end if;

77
regtests/0239_priority/priorities.adb
View File

@@ -68,7 +68,15 @@ procedure Priorities is
Previous_Chipher : ASU.Unbounded_String;
Ciphers : ASU.Unbounded_String :=
To_Unbounded_String (if GNUTLS then "NORMAL" else "DEFAULT");
To_Unbounded_String
(if GNUTLS
then "NORMAL"
& (if Net.SSL.Version > "GNUTLS 3.6.3"
then ":-VERS-TLS1.3" else "")
else "DEFAULT");
-- TLS 1.3 gives no informative error message in GNUTLS 3.6.4:
-- "The TLS connection was non-properly terminated."
-- It say nothing about lack of common ciphers.
task Server_Task is
entry Start;
@@ -79,6 +87,10 @@ procedure Priorities is
procedure Print (Text : String);
-- Prints only in Verbose mode
procedure Send_Stop_To_Server;
-- Send the last message to server side. Server will stop accepting
-- connections after that and terminate server task.
-----------
-- Error --
-----------
@@ -194,6 +206,27 @@ procedure Priorities is
Put_Line ("Server task " & Ada.Exceptions.Exception_Information (E));
end Server_Task;
Host : constant String := Net.Localhost (Net.IPv6_Available);
Port : Natural := 0;
-------------------------
-- Send_Stop_To_Server --
-------------------------
procedure Send_Stop_To_Server is
begin
Net.SSL.Initialize
(Config => Config,
Certificate_Filename => "aws-client.pem",
Trusted_CA_Filename => "private-ca.crt");
Client.Set_Config (Config);
Client.Connect (Host, Port);
Client.Send (Latest);
Client.Shutdown;
Net.SSL.Release (Config);
end Send_Stop_To_Server;
begin
Net.Log.Start (Error => Error'Unrestricted_Access, Write => null);
@@ -205,21 +238,29 @@ begin
Print (Net.SSL.Version);
Server_Task.Start;
Port := Server.Get_Port;
loop
Net.SSL.Initialize
(Config => Config,
Priorities => To_String (Ciphers),
Certificate_Filename => "aws-client.pem",
Trusted_CA_Filename => "private-ca.crt");
begin
Net.SSL.Initialize
(Config => Config,
Priorities => To_String (Ciphers),
Certificate_Filename => "aws-client.pem",
Trusted_CA_Filename => "private-ca.crt");
exception
when E : Net.Socket_Error =>
if Is_Handshake_Error (Ada.Exceptions.Exception_Message (E)) then
Send_Stop_To_Server;
exit;
end if;
raise;
end;
Client.Set_Config (Config);
Client.Set_Timeout (1.0);
declare
Host : constant String := Net.Localhost (Net.IPv6_Available);
Port : constant Positive := Server.Get_Port;
begin
Client.Connect (Host, Port);
Client.Send (Sample);
@@ -229,16 +270,7 @@ begin
Net.SSL.Release (Config);
if Is_Handshake_Error (Ada.Exceptions.Exception_Message (E)) then
Net.SSL.Initialize
(Config => Config,
Certificate_Filename => "aws-client.pem",
Trusted_CA_Filename => "private-ca.crt");
Client.Set_Config (Config);
Client.Connect (Host, Port);
Client.Send (Latest);
Client.Shutdown;
Net.SSL.Release (Config);
Send_Stop_To_Server;
exit;
else
raise;
@@ -261,7 +293,8 @@ begin
Net.SSL.Release (Config);
end loop;
Print ("Total disabled chipers" & Counter'Img);
Print
("Total disabled chipers" & Counter'Img & ASCII.LF & To_String (Ciphers));
if Counter < 4 then
Put_Line ("Too few iterations" & Counter'Img);
@@ -269,5 +302,7 @@ begin
exception
when E : others =>
Put_Line ("Main task " & Ada.Exceptions.Exception_Information (E));
Put_Line
("Main task " & Ada.Exceptions.Exception_Information (E) & ASCII.LF
& To_String (Ciphers));
end Priorities;

13
regtests/0242_ssl_reuse/ssl_reuse.adb
View File

@@ -182,7 +182,10 @@ begin
Server_Side.Started;
Net.SSL.Initialize (Config, "", Ticket_Support => False);
Net.SSL.Initialize
(Config, "", Ticket_Support => False, Security_Mode => Net.SSL.TLSv1_2);
-- TLS 1.3 in GNUTLS has some difference with session resumption mechanism
Client.Set_Config (Config);
Text_IO.Put_Line ("Sessions creation no tickets no reuse");
@@ -195,7 +198,9 @@ begin
Text_IO.Put_Line (Net.SSL.Session_Cache_Number (SrvCfg)'Img);
Net.SSL.Release (Config);
Net.SSL.Initialize (Config, "", Ticket_Support => True);
Net.SSL.Initialize
(Config, "", Ticket_Support => True, Security_Mode => Net.SSL.TLSv1_2);
-- TLS 1.3 in GNUTLS has some difference with session resumption mechanism
Client.Set_Config (Config);
Text_IO.Put_Line ("Sessions creation client tickets");
@@ -204,7 +209,9 @@ begin
Text_IO.Put_Line (Net.SSL.Session_Cache_Number (SrvCfg)'Img);
Net.SSL.Release (Config);
Net.SSL.Initialize (Config, "", Ticket_Support => False);
Net.SSL.Initialize
(Config, "", Ticket_Support => False, Security_Mode => Net.SSL.TLSv1_2);
-- TLS 1.3 in GNUTLS has some difference with session resumption mechanism
Client.Set_Config (Config);
Client.Connect (Server.Get_Addr, Server.Get_Port);

9
regtests/0243_sshort/sshort.adb
View File

@@ -80,6 +80,8 @@ procedure SShort is
Last := 0;
Client.Send ((1 => 11));
loop
First := Last + 1;
Client.Receive (Buffer (First .. Buffer'Last), Last);
@@ -88,7 +90,8 @@ procedure SShort is
if Buffer (1 .. Last) /= Sample (1 .. SShort.Last) then
if Buffer (1 .. Last) = Sample (1 .. Last) then
Ada.Text_IO.Put_Line ("Data shorter");
Ada.Text_IO.Put_Line
("Data shorter " & SShort.Last'Img & Last'Img);
else
Ada.Text_IO.Put_Line ("Data differ");
end if;
@@ -169,6 +172,10 @@ begin
Client_Side.Receive;
if Peer.Receive /= (1 => 11) then
Ada.Text_IO.Put_Line ("Unexpected responce");
end if;
select Client_Side.Received (More => True);
or delay 0.25;
Ada.Text_IO.Put_Line ("Timeout");

4
regtests/0243_sshort/sshort.gpr
View File

@@ -18,7 +18,7 @@
with "aws";
project Sock2_Sec is
project SShort is
for Source_Dirs use (".", "../common");
for Main use ("sshort.adb");
end Sock2_Sec;
end SShort;

2
regtests/0244_psig/psig.adb
View File

@@ -30,7 +30,7 @@ procedure Psig is
use AWS.Translator;
Key : Private_Key := Load ("psig.key");
begin
Set_Debug (11);
Set_Debug (2);
for J in Hash_Method loop
Put_Line (J'Img & ' ' & Base64_Encode (Signature (J'Img, Key, J)));
end loop;

4
regtests/0244_psig/psig.gpr
View File

@@ -18,7 +18,7 @@
with "aws";
project SDig is
project PSig is
for Source_Dirs use (".");
for Main use ("psig.adb");
end SDig;
end PSig;