diff --git a/ocaml/xapi-consts/test/dune b/ocaml/xapi-consts/test/dune new file mode 100644 index 00000000000..8329a2e05fc --- /dev/null +++ b/ocaml/xapi-consts/test/dune @@ -0,0 +1,5 @@ +(test + (name test_tls_policy) + (package xapi-consts) + (libraries alcotest xapi-consts) +) diff --git a/ocaml/xapi-consts/test/test_tls_policy.ml b/ocaml/xapi-consts/test/test_tls_policy.ml new file mode 100644 index 00000000000..e73ca1260a2 --- /dev/null +++ b/ocaml/xapi-consts/test/test_tls_policy.ml @@ -0,0 +1,167 @@ +(* + * Copyright (C) Citrix Systems Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published + * by the Free Software Foundation; version 2.1 only. with the special + * exception on linking described in file LICENSE. + * + * This program 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 Lesser General Public License for more details. + *) + +open Tls_policy + +(* ---- GnuTLS tests ------------------------------------------------------- *) + +let test_gnutls_default_policy () = + let expected = + "NONE:+VERS-TLS1.2:+AES-256-GCM:+AES-128-GCM:+AEAD:+ECDHE-RSA:+SIGN-ALL:+GROUP-SECP384R1:+COMP-NULL:%SERVER_PRECEDENCE" + in + Alcotest.(check string) + "default GnuTLS policy" expected (Gnutls.default_policy ()) + +let test_gnutls_default_ciphers () = + Alcotest.(check string) + "default GnuTLS ciphers" "+AES-256-GCM:+AES-128-GCM" Gnutls.default_ciphers + +let test_gnutls_default_version () = + Alcotest.(check string) + "default GnuTLS version" "+VERS-TLS1.2" Gnutls.default_version + +let test_gnutls_default_curve () = + Alcotest.(check string) + "default GnuTLS curve" "+GROUP-SECP384R1" Gnutls.default_curve + +let test_gnutls_default_server_preference () = + Alcotest.(check string) + "default GnuTLS server preference" "%SERVER_PRECEDENCE" + Gnutls.default_server_preference + +let test_gnutls_string_of_versions () = + Alcotest.(check string) + "GnuTLS string_of_versions TLS1.2+TLS1.3" "+VERS-TLS1.2:+VERS-TLS1.3" + (Gnutls.string_of_versions [TLS_1_2; TLS_1_3]) + +let test_gnutls_string_of_ciphers () = + Alcotest.(check string) + "GnuTLS string_of_ciphers AES128+AES256" "+AES-128-GCM:+AES-256-GCM" + (Gnutls.string_of_ciphers [AES_128_GCM; AES_256_GCM]) + +let test_gnutls_string_of_curves () = + Alcotest.(check string) + "GnuTLS string_of_curves secp384r1" "+GROUP-SECP384R1" + (Gnutls.string_of_curves [Secp384r1]) + +let test_gnutls_policy_no_server_pref () = + let policy = + { + versions= [TLS_1_2] + ; ciphers= [AES_256_GCM] + ; curves= [Secp384r1] + ; kex= [ECDHE_RSA] + ; server_preference= false + } + in + let expected = + "NONE:+VERS-TLS1.2:+AES-256-GCM:+AEAD:+ECDHE-RSA:+SIGN-ALL:+GROUP-SECP384R1:+COMP-NULL" + in + Alcotest.(check string) + "GnuTLS policy without server preference" expected + (Gnutls.string_of_policy policy) + +let test_gnutls_policy_tls13 () = + let policy = + { + versions= [TLS_1_2; TLS_1_3] + ; ciphers= [AES_256_GCM; AES_128_GCM] + ; curves= [Secp384r1] + ; kex= [ECDHE_RSA] + ; server_preference= true + } + in + let expected = + "NONE:+VERS-TLS1.2:+VERS-TLS1.3:+AES-256-GCM:+AES-128-GCM:+AEAD:+ECDHE-RSA:+SIGN-ALL:+GROUP-SECP384R1:+COMP-NULL:%SERVER_PRECEDENCE" + in + Alcotest.(check string) + "GnuTLS policy with TLS 1.3" expected + (Gnutls.string_of_policy policy) + +(* ---- OpenSSL tests ------------------------------------------------------ *) + +let test_openssl_default_ciphers () = + Alcotest.(check string) + "default OpenSSL ciphers" + "ECDHE-RSA-AES256-GCM-SHA384:ECDHE-RSA-AES128-GCM-SHA256" + Openssl.default_ciphers + +let test_openssl_default_version () = + Alcotest.(check string) + "default OpenSSL version" "TLSv1.2" Openssl.default_version + +let test_openssl_default_curve () = + Alcotest.(check string) + "default OpenSSL curve" "secp384r1" Openssl.default_curve + +let test_openssl_default_server_preference () = + Alcotest.(check string) + "default OpenSSL server preference" "CIPHER_SERVER_PREFERENCE" + Openssl.default_server_preference + +let test_openssl_string_of_ciphers () = + Alcotest.(check string) + "OpenSSL string_of_ciphers AES128 only" "ECDHE-RSA-AES128-GCM-SHA256" + (Openssl.string_of_ciphers [AES_128_GCM]) + +let test_openssl_string_of_curves () = + Alcotest.(check string) + "OpenSSL string_of_curves secp384r1" "secp384r1" + (Openssl.string_of_curves [Secp384r1]) + +let test_openssl_string_of_policy_raises () = + Alcotest.check_raises "OpenSSL string_of_policy raises" + (Failure "Not supported") (fun () -> + ignore + (Openssl.string_of_policy + { + versions= [TLS_1_2] + ; ciphers= [AES_256_GCM] + ; curves= [Secp384r1] + ; kex= [ECDHE_RSA] + ; server_preference= true + } + ) + ) + +(* ---- Test suite --------------------------------------------------------- *) + +let gnutls_tests = + [ + ("default_policy", `Quick, test_gnutls_default_policy) + ; ("default_ciphers", `Quick, test_gnutls_default_ciphers) + ; ("default_version", `Quick, test_gnutls_default_version) + ; ("default_curve", `Quick, test_gnutls_default_curve) + ; ("default_server_preference", `Quick, test_gnutls_default_server_preference) + ; ("string_of_versions", `Quick, test_gnutls_string_of_versions) + ; ("string_of_ciphers", `Quick, test_gnutls_string_of_ciphers) + ; ("string_of_curves", `Quick, test_gnutls_string_of_curves) + ; ("policy_no_server_preference", `Quick, test_gnutls_policy_no_server_pref) + ; ("policy_tls13", `Quick, test_gnutls_policy_tls13) + ] + +let openssl_tests = + [ + ("default_ciphers", `Quick, test_openssl_default_ciphers) + ; ("default_version", `Quick, test_openssl_default_version) + ; ("default_curve", `Quick, test_openssl_default_curve) + ; ("default_server_preference", `Quick, test_openssl_default_server_preference) + ; ("string_of_ciphers", `Quick, test_openssl_string_of_ciphers) + ; ("string_of_curves", `Quick, test_openssl_string_of_curves) + ; ("string_of_policy_raises", `Quick, test_openssl_string_of_policy_raises) + ] + +let tests = [("Gnutls", gnutls_tests); ("Openssl", openssl_tests)] + +let () = Alcotest.run "Tls_policy" tests diff --git a/ocaml/xapi-consts/test/test_tls_policy.mli b/ocaml/xapi-consts/test/test_tls_policy.mli new file mode 100644 index 00000000000..c32d2a7e66b --- /dev/null +++ b/ocaml/xapi-consts/test/test_tls_policy.mli @@ -0,0 +1,15 @@ +(* + * Copyright (c) Cloud Software Group, Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published + * by the Free Software Foundation; version 2.1 only. with the special + * exception on linking described in file LICENSE. + * + * This program 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 Lesser General Public License for more details. + *) + +val tests : unit Alcotest.test list diff --git a/ocaml/xapi-consts/tls_policy.ml b/ocaml/xapi-consts/tls_policy.ml new file mode 100644 index 00000000000..943b2358c95 --- /dev/null +++ b/ocaml/xapi-consts/tls_policy.ml @@ -0,0 +1,190 @@ +(* + * Copyright (C) Citrix Systems Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published + * by the Free Software Foundation; version 2.1 only. with the special + * exception on linking described in file LICENSE. + * + * This program 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 Lesser General Public License for more details. + *) + +type version = TLS_1_2 | TLS_1_3 + +type cipher = AES_128_GCM | AES_256_GCM + +type curve = Secp384r1 + +type kex = ECDHE_RSA + +type policy = { + versions: version list + ; ciphers: cipher list + ; curves: curve list + ; kex: kex list + ; server_preference: bool +} + +(* ---- Default policy ------------------------------------------- *) + +let default = + { + versions= [TLS_1_2] + ; ciphers= [AES_256_GCM; AES_128_GCM] + ; curves= [Secp384r1] + ; kex= [ECDHE_RSA] + ; server_preference= true + } + +(** Common interface both renderers implement. *) +module type Renderer = sig + val string_of_versions : version list -> string + (** Format-specific colon-joined version list from a version list. *) + + val string_of_ciphers : cipher list -> string + (** Format-specific colon-joined cipher list from a cipher list. *) + + val string_of_policy : policy -> string + (** Format-specific combined cipher suite string from a policy. *) + + val string_of_curves : curve list -> string + (** Format-specific colon-joined curve list from a curve list. *) + + val string_of_server_preference : bool -> string + (** Format-specific server-preference flag *) +end + +(* ---- GnuTLS renderer ---------------------------------------------------- *) + +module GnutlsImpl = struct + let string_of_version = function + | TLS_1_2 -> + "+VERS-TLS1.2" + | TLS_1_3 -> + "+VERS-TLS1.3" + + let string_of_cipher = function + | AES_128_GCM -> + "+AES-128-GCM" + | AES_256_GCM -> + "+AES-256-GCM" + + let string_of_versions versions = + List.map string_of_version versions |> String.concat ":" + + let string_of_ciphers ciphers = + List.map string_of_cipher ciphers |> String.concat ":" + + let string_of_curve = function Secp384r1 -> "+GROUP-SECP384R1" + + let string_of_curves curves = + List.map string_of_curve curves |> String.concat ":" + + let string_of_kex = function ECDHE_RSA -> "+ECDHE-RSA" + + let string_of_server_preference = function + | true -> + "%SERVER_PRECEDENCE" + | false -> + "" + + (** Build a GnuTLS priority string from a policy. + Example: + ["NONE:+VERS-TLS1.2:+AES-256-GCM:+AES-128-GCM:+AEAD:+ECDHE-RSA:+SIGN-ALL:+GROUP-SECP384R1:+COMP-NULL:%SERVER_PRECEDENCE"] + Suitable for Samba's [tls priority =] in [smb.conf]. *) + let string_of_policy {versions; ciphers; kex; curves; server_preference} = + (* GnuTLS priority token order (from the GnuTLS manual): + versions -> ciphers -> MACs -> KEX -> signatures -> groups -> compression -> flags *) + let is_aead = + List.exists (function AES_128_GCM | AES_256_GCM -> true) ciphers + in + let tokens = + List.map string_of_version versions + @ List.map string_of_cipher ciphers + @ ( if is_aead then + ["+AEAD"] + else + [] + ) + @ List.map string_of_kex kex + @ ["+SIGN-ALL"] + @ List.map string_of_curve curves + @ ["+COMP-NULL"] + @ + if server_preference then + ["%SERVER_PRECEDENCE"] + else + [] + in + Printf.sprintf "NONE:%s" (String.concat ":" tokens) +end + +(* ---- OpenSSL renderer --------------------------------------------------- *) + +module OpensslImpl = struct + (* OpenSSL TLS 1.2 suite name: ECDHE-RSA-CIPHER-HASH. + For GCM (AEAD) suites the hash is used only as the PRF: + AES-256-GCM -> SHA-384, AES-128-GCM -> SHA-256. *) + let string_of_cipher = function + | AES_256_GCM -> + "ECDHE-RSA-AES256-GCM-SHA384" + | AES_128_GCM -> + "ECDHE-RSA-AES128-GCM-SHA256" + + let string_of_version = function TLS_1_2 -> "TLSv1.2" | TLS_1_3 -> "TLSv1.3" + + let string_of_versions versions = + List.map string_of_version versions |> String.concat ":" + + let string_of_ciphers ciphers = + List.map string_of_cipher ciphers |> String.concat ":" + + let string_of_curve = function Secp384r1 -> "secp384r1" + + let string_of_curves curves = + List.map string_of_curve curves |> String.concat ":" + + let string_of_server_preference = function + | true -> + "CIPHER_SERVER_PREFERENCE" + | false -> + "" + + let string_of_policy _ = failwith "Not supported" +end + +(** Extends any [Renderer] with convenience values pre-applied to [default]. *) +module type RendererWithDefaults = sig + include Renderer + + val default_policy : unit -> string + + val default_ciphers : string + + val default_version : string + + val default_curve : string + + val default_server_preference : string +end + +module WithDefaults (R : Renderer) : RendererWithDefaults = struct + include R + + let default_policy () = R.string_of_policy default + + let default_ciphers = R.string_of_ciphers default.ciphers + + let default_version = R.string_of_versions default.versions + + let default_curve = R.string_of_curves default.curves + + let default_server_preference = + R.string_of_server_preference default.server_preference +end + +module Gnutls = WithDefaults (GnutlsImpl) +module Openssl = WithDefaults (OpensslImpl) diff --git a/ocaml/xapi-consts/tls_policy.mli b/ocaml/xapi-consts/tls_policy.mli new file mode 100644 index 00000000000..52c449e4eba --- /dev/null +++ b/ocaml/xapi-consts/tls_policy.mli @@ -0,0 +1,95 @@ +(* + * Copyright (C) Citrix Systems Inc. + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published + * by the Free Software Foundation; version 2.1 only. with the special + * exception on linking described in file LICENSE. + * + * This program 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 Lesser General Public License for more details. + *) + +(** TLS policy types and format-specific string renderers. + + Usage: + {[ + let () = print_endline (Tls_policy.Gnutls.default_policy ()) + let () = print_endline (Tls_policy.Openssl.default_policy ()) + let () = print_endline Tls_policy.Openssl.default_curve + (* or with a custom policy: *) + let my_policy = { ... } + let () = print_endline (Tls_policy.Openssl.string_of_policy my_policy) + ]} *) + +type version = TLS_1_2 | TLS_1_3 + +type cipher = + | AES_128_GCM (** AEAD; paired with SHA-256 in OpenSSL suite names *) + | AES_256_GCM (** AEAD; paired with SHA-384 in OpenSSL suite names *) + +type curve = Secp384r1 + +type kex = ECDHE_RSA + +type policy = { + versions: version list + ; ciphers: cipher list + ; curves: curve list (** Only the first curve is used for stunnel. *) + ; kex: kex list + ; server_preference: bool (** When [true], the server picks the cipher. *) +} + +(** Common interface both renderers implement. *) +module type Renderer = sig + val string_of_versions : version list -> string + (** Format-specific colon-joined version list from a version list. *) + + val string_of_ciphers : cipher list -> string + (** Format-specific colon-joined cipher list from a cipher list. *) + + val string_of_policy : policy -> string + (** Format-specific combined cipher suite string from a policy. *) + + val string_of_curves : curve list -> string + (** Format-specific colon-joined curve list from a curve list. *) + + val string_of_server_preference : bool -> string + (** Format-specific server-preference flag, or ["" ] if disabled. *) +end + +(** Extends [Renderer] with convenience values pre-applied to the default policy. *) +module type RendererWithDefaults = sig + include Renderer + + val default_policy : unit -> string + (** Format-specific combined cipher suite string for the default policy. + + This is a [unit -> string] function rather than a plain [string] value to + avoid eager evaluation at module initialisation time. OCaml evaluates + every top-level [let] in a functor body when the functor is applied, so a + plain [string] binding would call [string_of_policy] immediately — + crashing for renderers (e.g. [Openssl]) where [string_of_policy] raises. + The other [default_*] values are plain strings because their underlying + functions are defined for every renderer. *) + + val default_ciphers : string + (** Colon-joined cipher string for the default cipher list. *) + + val default_version : string + (** Colon-joined version string for the default version list. *) + + val default_curve : string + (** Colon-joined curve string for the default curve list. *) + + val default_server_preference : string + (** Server-preference string for the default policy. *) +end + +(** GnuTLS priority string renderer. *) +module Gnutls : RendererWithDefaults + +(** OpenSSL cipher list renderer. *) +module Openssl : RendererWithDefaults