Skip to content

Commit b80665e

Browse files
anisimkovanisimkov
committed
Application Layer Protocol Negotiation (ALPN) support
S507-051
1 parent a9d86d5 commit b80665e

File tree

11 files changed

+648
-76
lines changed

11 files changed

+648
-76
lines changed

‎config/ssl/aws-net-ssl__gnutls.adb

Lines changed: 108 additions & 31 deletions
Original file line numberDiff line numberDiff line change
@@ -69,9 +69,19 @@ package body AWS.Net.SSL is
6969

7070
subtype Datum_Type is Certificate.Impl.Datum_Type;
7171

72+
type String_Access is access all String (Positive);
73+
function To_String_Access is
74+
new Unchecked_Conversion (TSSL.a_unsigned_char_t, String_Access);
75+
76+
function To_String (Datum : TSSL.gnutls_datum_t) return String is
77+
(To_String_Access (Datum.data) (1 .. Integer (Datum.size)));
78+
7279
function Load_File (Filename : String) return Datum_Type
7380
renames Certificate.Impl.Load_File;
7481

82+
procedure ALPN_Set (Socket : Socket_Type);
83+
-- Set ALPN from config to secure socket before handshake
84+
7585
type PCert_Array is
7686
array (Positive range <>) of aliased TSSL.gnutls_pcert_st
7787
with Convention => C;
@@ -163,7 +173,7 @@ package body AWS.Net.SSL is
163173

164174
function Equal (Left, Right : TSSL.gnutls_datum_t) return Boolean;
165175

166-
function Hash (Item : TSSL.gnutls_datum_t) return Containers.Hash_Type;
176+
function Hash (Item : TSSL.gnutls_datum_t) return Ada.Containers.Hash_Type;
167177

168178
procedure Check_File (Prefix, Filename : String);
169179
-- Check that Filename is present, raise an exception adding
@@ -175,14 +185,14 @@ package body AWS.Net.SSL is
175185
end record;
176186

177187
package Session_Container is
178-
new Containers.Hashed_Maps
188+
new Ada.Containers.Hashed_Maps
179189
(Key_Type => TSSL.gnutls_datum_t,
180190
Element_Type => Session_Element,
181191
Hash => Hash,
182192
Equivalent_Keys => Equal);
183193

184194
package Time_Set is
185-
new Containers.Ordered_Maps
195+
new Ada.Containers.Ordered_Maps
186196
(Key_Type => Calendar.Time,
187197
Element_Type => TSSL.gnutls_datum_t,
188198
"<" => Calendar."<",
@@ -235,6 +245,7 @@ package body AWS.Net.SSL is
235245
CRL_File : C.Strings.chars_ptr := C.Strings.Null_Ptr;
236246
CRL_Semaphore : Utils.Semaphore;
237247
CRL_Time_Stamp : Calendar.Time := Utils.AWS_Epoch;
248+
ALPN : SV.Vector;
238249
end record;
239250

240251
procedure Initialize
@@ -284,7 +295,8 @@ package body AWS.Net.SSL is
284295
Certificate_Required : Boolean;
285296
Trusted_CA_Filename : String;
286297
CRL_Filename : String;
287-
Session_Cache_Size : Natural);
298+
Session_Cache_Size : Natural;
299+
ALPN : SV.Vector);
288300

289301
private
290302
Done : Boolean := False;
@@ -445,6 +457,68 @@ package body AWS.Net.SSL is
445457
(Host, (new PCert_Array'(Load_PCert_List (4)), TLS_PK));
446458
end Add_Host_Certificate;
447459

460+
--------------
461+
-- ALPN_Get --
462+
--------------
463+
464+
function ALPN_Get (Socket : Socket_Type) return String is
465+
use type System.Address;
466+
Datum : aliased TSSL.gnutls_datum_t;
467+
Code : constant C.int :=
468+
TSSL.gnutls_alpn_get_selected_protocol
469+
(Socket.SSL, Datum'Access);
470+
begin
471+
if Code = TSSL.GNUTLS_E_REQUESTED_DATA_NOT_AVAILABLE then
472+
Datum.data := System.Null_Address;
473+
else
474+
Check_Error_Code (Code);
475+
end if;
476+
477+
if Datum.data = System.Null_Address then
478+
return "";
479+
end if;
480+
481+
return To_String (Datum);
482+
end ALPN_Get;
483+
484+
--------------
485+
-- ALPN_Set --
486+
--------------
487+
488+
procedure ALPN_Set (Socket : Socket_Type) is
489+
type Datum_List is
490+
array (1 .. Natural (Socket.Config.ALPN.Length)) of
491+
aliased TSSL.gnutls_datum_t
492+
with Convention => C;
493+
494+
type Datum_List_Access is access all Datum_List;
495+
496+
function To_Datum_Access is new Ada.Unchecked_Conversion
497+
(Datum_List_Access, TSSL.a_gnutls_datum_t);
498+
499+
Datums : aliased Datum_List;
500+
501+
begin
502+
for J in Datums'Range loop
503+
Datums (J).data := Socket.Config.ALPN (J).Element.all'Address;
504+
Datums (J).size := Socket.Config.ALPN (J).Element'Length;
505+
end loop;
506+
507+
Check_Error_Code
508+
(TSSL.gnutls_alpn_set_protocols
509+
(Socket.SSL, To_Datum_Access (Datums'Access), Datums'Length,
510+
flags => 0));
511+
end ALPN_Set;
512+
513+
--------------
514+
-- ALPN_Set --
515+
--------------
516+
517+
procedure ALPN_Set (Config : SSL.Config; Protocols : SV.Vector) is
518+
begin
519+
Config.ALPN := Protocols;
520+
end ALPN_Set;
521+
448522
------------------
449523
-- Check_Config --
450524
------------------
@@ -742,9 +816,11 @@ package body AWS.Net.SSL is
742816
Certificate_Required : Boolean;
743817
Trusted_CA_Filename : String;
744818
CRL_Filename : String;
745-
Session_Cache_Size : Natural) is
819+
Session_Cache_Size : Natural;
820+
ALPN : SV.Vector) is
746821
begin
747822
if not Done then
823+
Default_Config.ALPN := ALPN;
748824
Initialize
749825
(Default_Config,
750826
Certificate_Filename, Security_Mode, Priorities,
@@ -1029,14 +1105,9 @@ package body AWS.Net.SSL is
10291105
----------
10301106

10311107
function Hash
1032-
(Item : TSSL.gnutls_datum_t) return Containers.Hash_Type
1033-
is
1034-
type String_Access is access all String (Positive);
1035-
function To_Access is
1036-
new Unchecked_Conversion (TSSL.a_unsigned_char_t, String_Access);
1108+
(Item : TSSL.gnutls_datum_t) return Ada.Containers.Hash_Type is
10371109
begin
1038-
return Strings.Hash
1039-
(To_Access (Item.data) (1 .. Natural (Item.size)));
1110+
return Strings.Hash (To_String (Item));
10401111
end Hash;
10411112

10421113
-----------
@@ -1073,20 +1144,23 @@ package body AWS.Net.SSL is
10731144
procedure Initialize
10741145
(Config : in out SSL.Config;
10751146
Certificate_Filename : String;
1076-
Security_Mode : Method := TLS;
1077-
Priorities : String := "";
1078-
Ticket_Support : Boolean := False;
1079-
Key_Filename : String := "";
1080-
Exchange_Certificate : Boolean := False;
1081-
Certificate_Required : Boolean := False;
1082-
Trusted_CA_Filename : String := "";
1083-
CRL_Filename : String := "";
1084-
Session_Cache_Size : Natural := 16#4000#) is
1147+
Security_Mode : Method := TLS;
1148+
Priorities : String := "";
1149+
Ticket_Support : Boolean := False;
1150+
Key_Filename : String := "";
1151+
Exchange_Certificate : Boolean := False;
1152+
Certificate_Required : Boolean := False;
1153+
Trusted_CA_Filename : String := "";
1154+
CRL_Filename : String := "";
1155+
Session_Cache_Size : Natural := 16#4000#;
1156+
ALPN : SV.Vector := SV.Empty_Vector) is
10851157
begin
10861158
if Config = null then
10871159
Config := new TS_SSL;
10881160
end if;
10891161

1162+
Config.ALPN := ALPN;
1163+
10901164
Initialize
10911165
(Config.all,
10921166
Certificate_Filename => Certificate_Filename,
@@ -1271,20 +1345,21 @@ package body AWS.Net.SSL is
12711345

12721346
procedure Initialize_Default_Config
12731347
(Certificate_Filename : String;
1274-
Security_Mode : Method := TLS;
1275-
Priorities : String := "";
1276-
Ticket_Support : Boolean := False;
1277-
Key_Filename : String := "";
1278-
Exchange_Certificate : Boolean := False;
1279-
Certificate_Required : Boolean := False;
1280-
Trusted_CA_Filename : String := "";
1281-
CRL_Filename : String := "";
1282-
Session_Cache_Size : Natural := 16#4000#) is
1348+
Security_Mode : Method := TLS;
1349+
Priorities : String := "";
1350+
Ticket_Support : Boolean := False;
1351+
Key_Filename : String := "";
1352+
Exchange_Certificate : Boolean := False;
1353+
Certificate_Required : Boolean := False;
1354+
Trusted_CA_Filename : String := "";
1355+
CRL_Filename : String := "";
1356+
Session_Cache_Size : Natural := 16#4000#;
1357+
ALPN : SV.Vector := SV.Empty_Vector) is
12831358
begin
12841359
Default_Config_Sync.Initialize
12851360
(Certificate_Filename, Security_Mode, Priorities, Ticket_Support,
12861361
Key_Filename, Exchange_Certificate, Certificate_Required,
1287-
Trusted_CA_Filename, CRL_Filename, Session_Cache_Size);
1362+
Trusted_CA_Filename, CRL_Filename, Session_Cache_Size, ALPN);
12881363
end Initialize_Default_Config;
12891364

12901365
procedure Initialize_Default_Config is
@@ -1993,6 +2068,8 @@ package body AWS.Net.SSL is
19932068
-- Retrieve_Certificate for client.
19942069

19952070
TSSL.gnutls_session_set_ptr (Socket.SSL, Socket.Config.all'Address);
2071+
2072+
ALPN_Set (Socket);
19962073
end Session_Transport;
19972074

19982075
----------------

0 commit comments

Comments
 (0)