Skip to content

Commit 9ba6837

Browse files
author
Lin Liu
committed
CP-311259: Define proper TLS version and ciphers
Dom0 got two TLS library implementations, openssl and gnutls And they use different format to identify the cipher policies. To keep system consistent with TLS configrations, tls lib is introduced for central management of the supported ciphers Signed-off-by: Lin Liu <lin.liu01@citrix.com>
1 parent 596b991 commit 9ba6837

6 files changed

Lines changed: 503 additions & 0 deletions

File tree

‎ocaml/libs/tls/dune‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
(library
2+
(name tls)
3+
(public_name tls)
4+
(wrapped false)
5+
)

‎ocaml/libs/tls/tls.ml‎

Lines changed: 198 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,198 @@
1+
(*
2+
* Copyright (C) Citrix Systems Inc.
3+
*
4+
* This program is free software; you can redistribute it and/or modify
5+
* it under the terms of the GNU Lesser General Public License as published
6+
* by the Free Software Foundation; version 2.1 only. with the special
7+
* exception on linking described in file LICENSE.
8+
*
9+
* This program is distributed in the hope that it will be useful,
10+
* but WITHOUT ANY WARRANTY; without even the implied warranty of
11+
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12+
* GNU Lesser General Public License for more details.
13+
*)
14+
15+
type version = TLS_1_2 | TLS_1_3
16+
17+
type cipher = AES_128_GCM | AES_256_GCM
18+
19+
type curve = Secp384r1 | Secp256r1
20+
21+
type kex = ECDHE_RSA
22+
23+
type policy = {
24+
versions: version list
25+
; ciphers: cipher list
26+
; curves: curve list
27+
; kex: kex list
28+
; server_preference: bool
29+
}
30+
31+
(** Common interface both renderers implement. *)
32+
module type Renderer = sig
33+
val string_of_versions : version list -> string
34+
(** Format-specific colon-joined version list from a version list. *)
35+
36+
val string_of_ciphers : cipher list -> string
37+
(** Format-specific colon-joined cipher list from a cipher list. *)
38+
39+
val string_of_policy : policy -> string
40+
(** Format-specific combined cipher suite string from a policy. *)
41+
42+
val string_of_curves : curve list -> string
43+
(** Format-specific colon-joined curve list from a curve list. *)
44+
45+
val string_of_server_preference : bool -> string
46+
(** Format-specific server-preference flag *)
47+
end
48+
49+
(* ---- GnuTLS renderer ---------------------------------------------------- *)
50+
51+
module GnutlsImpl = struct
52+
let string_of_version = function
53+
| TLS_1_2 ->
54+
"+VERS-TLS1.2"
55+
| TLS_1_3 ->
56+
"+VERS-TLS1.3"
57+
58+
let string_of_cipher = function
59+
| AES_128_GCM ->
60+
"+AES-128-GCM"
61+
| AES_256_GCM ->
62+
"+AES-256-GCM"
63+
64+
let string_of_versions versions =
65+
List.map string_of_version versions |> String.concat ":"
66+
67+
let string_of_ciphers ciphers =
68+
List.map string_of_cipher ciphers |> String.concat ":"
69+
70+
let string_of_curve = function
71+
| Secp384r1 ->
72+
"+GROUP-SECP384R1"
73+
| Secp256r1 ->
74+
"+GROUP-SECP256R1"
75+
76+
let string_of_curves curves =
77+
List.map string_of_curve curves |> String.concat ":"
78+
79+
let string_of_kex = function ECDHE_RSA -> "+ECDHE-RSA"
80+
81+
let string_of_server_preference = function
82+
| true ->
83+
"%SERVER_PRECEDENCE"
84+
| false ->
85+
""
86+
87+
(** Build a GnuTLS priority string from a policy.
88+
Example:
89+
["NONE:+VERS-TLS1.2:+AES-256-GCM:+AES-128-GCM:+AEAD:+ECDHE-RSA:+SIGN-ALL:+GROUP-SECP384R1:+COMP-NULL:%SERVER_PRECEDENCE"]
90+
Suitable for Samba's [tls priority =] in [smb.conf]. *)
91+
let string_of_policy {versions; ciphers; kex; curves; server_preference} =
92+
(* GnuTLS priority token order (from the GnuTLS manual):
93+
versions -> ciphers -> MACs -> KEX -> signatures -> groups -> compression -> flags *)
94+
let is_aead =
95+
List.exists (function AES_128_GCM | AES_256_GCM -> true) ciphers
96+
in
97+
let tokens =
98+
List.map string_of_version versions
99+
@ List.map string_of_cipher ciphers
100+
@ ( if is_aead then
101+
["+AEAD"]
102+
else
103+
[]
104+
)
105+
@ List.map string_of_kex kex
106+
@ ["+SIGN-ALL"]
107+
@ List.map string_of_curve curves
108+
@ ["+COMP-NULL"]
109+
@
110+
if server_preference then
111+
["%SERVER_PRECEDENCE"]
112+
else
113+
[]
114+
in
115+
Printf.sprintf "NONE:%s" (String.concat ":" tokens)
116+
end
117+
118+
(* ---- OpenSSL renderer --------------------------------------------------- *)
119+
120+
module OpensslImpl = struct
121+
(* OpenSSL TLS 1.2 suite name: ECDHE-RSA-CIPHER-HASH.
122+
For GCM (AEAD) suites the hash is used only as the PRF:
123+
AES-256-GCM -> SHA-384, AES-128-GCM -> SHA-256. *)
124+
let string_of_cipher = function
125+
| AES_256_GCM ->
126+
"ECDHE-RSA-AES256-GCM-SHA384"
127+
| AES_128_GCM ->
128+
"ECDHE-RSA-AES128-GCM-SHA256"
129+
130+
let string_of_version = function TLS_1_2 -> "TLSv1.2" | TLS_1_3 -> "TLSv1.3"
131+
132+
let string_of_versions versions =
133+
List.map string_of_version versions |> String.concat ":"
134+
135+
let string_of_ciphers ciphers =
136+
List.map string_of_cipher ciphers |> String.concat ":"
137+
138+
let string_of_curve = function
139+
| Secp384r1 ->
140+
"secp384r1"
141+
| Secp256r1 ->
142+
"secp256r1"
143+
144+
let string_of_curves curves =
145+
List.map string_of_curve curves |> String.concat ":"
146+
147+
let string_of_server_preference = function
148+
| true ->
149+
"CIPHER_SERVER_PREFERENCE"
150+
| false ->
151+
""
152+
153+
let string_of_policy _ = failwith "Not supported"
154+
end
155+
156+
(* ---- Default XenServer policy ------------------------------------------- *)
157+
158+
let default =
159+
{
160+
versions= [TLS_1_2]
161+
; ciphers= [AES_256_GCM; AES_128_GCM]
162+
; curves= [Secp384r1]
163+
; kex= [ECDHE_RSA]
164+
; server_preference= true
165+
}
166+
167+
(** Extends any [Renderer] with convenience values pre-applied to [default]. *)
168+
module type RendererWithDefaults = sig
169+
include Renderer
170+
171+
val default_policy : unit -> string
172+
173+
val default_ciphers : string
174+
175+
val default_version : string
176+
177+
val default_curve : string
178+
179+
val default_server_preference : string
180+
end
181+
182+
module WithDefaults (R : Renderer) : RendererWithDefaults = struct
183+
include R
184+
185+
let default_policy () = R.string_of_policy default
186+
187+
let default_ciphers = R.string_of_ciphers default.ciphers
188+
189+
let default_version = R.string_of_versions default.versions
190+
191+
let default_curve = R.string_of_curves default.curves
192+
193+
let default_server_preference =
194+
R.string_of_server_preference default.server_preference
195+
end
196+
197+
module Gnutls = WithDefaults (GnutlsImpl)
198+
module Openssl = WithDefaults (OpensslImpl)

‎ocaml/libs/tls/tls.mli‎

Lines changed: 95 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,95 @@
1+
(*
2+
* Copyright (C) Citrix Systems Inc.
3+
*
4+
* This program is free software; you can redistribute it and/or modify
5+
* it under the terms of the GNU Lesser General Public License as published
6+
* by the Free Software Foundation; version 2.1 only. with the special
7+
* exception on linking described in file LICENSE.
8+
*
9+
* This program is distributed in the hope that it will be useful,
10+
* but WITHOUT ANY WARRANTY; without even the implied warranty of
11+
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12+
* GNU Lesser General Public License for more details.
13+
*)
14+
15+
(** TLS policy types and format-specific string renderers.
16+
17+
Usage:
18+
{[
19+
let () = print_endline (Tls.Gnutls.default_policy ())
20+
let () = print_endline (Tls.Openssl.default_policy ())
21+
let () = print_endline Tls.Openssl.default_curve
22+
(* or with a custom policy: *)
23+
let my_policy = { ... }
24+
let () = print_endline (Tls.Openssl.string_of_policy my_policy)
25+
]} *)
26+
27+
type version = TLS_1_2 | TLS_1_3
28+
29+
type cipher =
30+
| AES_128_GCM (** AEAD; paired with SHA-256 in OpenSSL suite names *)
31+
| AES_256_GCM (** AEAD; paired with SHA-384 in OpenSSL suite names *)
32+
33+
type curve = Secp384r1 | Secp256r1
34+
35+
type kex = ECDHE_RSA
36+
37+
type policy = {
38+
versions: version list
39+
; ciphers: cipher list
40+
; curves: curve list (** Only the first curve is used for stunnel. *)
41+
; kex: kex list
42+
; server_preference: bool (** When [true], the server picks the cipher. *)
43+
}
44+
45+
(** Common interface both renderers implement. *)
46+
module type Renderer = sig
47+
val string_of_versions : version list -> string
48+
(** Format-specific colon-joined version list from a version list. *)
49+
50+
val string_of_ciphers : cipher list -> string
51+
(** Format-specific colon-joined cipher list from a cipher list. *)
52+
53+
val string_of_policy : policy -> string
54+
(** Format-specific combined cipher suite string from a policy. *)
55+
56+
val string_of_curves : curve list -> string
57+
(** Format-specific colon-joined curve list from a curve list. *)
58+
59+
val string_of_server_preference : bool -> string
60+
(** Format-specific server-preference flag, or ["" ] if disabled. *)
61+
end
62+
63+
(** Extends [Renderer] with convenience values pre-applied to the default policy. *)
64+
module type RendererWithDefaults = sig
65+
include Renderer
66+
67+
val default_policy : unit -> string
68+
(** Format-specific combined cipher suite string for the default policy.
69+
70+
This is a [unit -> string] function rather than a plain [string] value to
71+
avoid eager evaluation at module initialisation time. OCaml evaluates
72+
every top-level [let] in a functor body when the functor is applied, so a
73+
plain [string] binding would call [string_of_policy] immediately —
74+
crashing for renderers (e.g. [Openssl]) where [string_of_policy] raises.
75+
The other [default_*] values are plain strings because their underlying
76+
functions are defined for every renderer. *)
77+
78+
val default_ciphers : string
79+
(** Colon-joined cipher string for the default cipher list. *)
80+
81+
val default_version : string
82+
(** Colon-joined version string for the default version list. *)
83+
84+
val default_curve : string
85+
(** Colon-joined curve string for the default curve list. *)
86+
87+
val default_server_preference : string
88+
(** Server-preference string for the default policy. *)
89+
end
90+
91+
(** GnuTLS priority string renderer. *)
92+
module Gnutls : RendererWithDefaults
93+
94+
(** OpenSSL cipher list renderer. *)
95+
module Openssl : RendererWithDefaults

‎ocaml/tests/dune‎

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -172,6 +172,13 @@
172172
(action (run ./check-no-xenctrl %{x}))
173173
)
174174

175+
(test
176+
(name test_tls)
177+
(modes exe)
178+
(modules test_tls)
179+
(libraries alcotest tls)
180+
)
181+
175182
(env (_ (env-vars (XAPI_TEST 1))))
176183

177184
; disassemble, but without sources

0 commit comments

Comments
 (0)