CP-310090 Stunnel lib: Expose unix socket path for TLS proxy

ocaml/libs/stunnel/stunnel.ml

@@ -202,11 +202,13 @@ let config_file ?(accept = None) config host port =
          )
        ; [debug_conf_of_env ()]
        ; ( match accept with
-         | Some (h, p) ->
+         | Some (`Local_host_port (h, p)) ->
              [
                "[client-proxy]"
              ; Printf.sprintf "accept=%s:%s" h (string_of_int p)
              ]
+         | Some (`Unix_socket_path path) ->
+             ["[client-proxy]"; Printf.sprintf "accept=%s" path]
          | None ->
              []
          )
@@ -387,12 +389,24 @@ let attempt_one_connect ?(use_fork_exec_helper = true)
     match data_channel with
     | `Local_host_port (h, p) ->
         (* The stunnel will listen on a local host and port *)
-        let config = config_file ~accept:(Some (h, p)) verify_cert host port in
+        let config =
+          config_file
+            ~accept:(Some (`Local_host_port (h, p)))
+            verify_cert host port
+        in
         start None config
     | `Unix_socket s ->
         (* The stunnel will listen on a UNIX socket *)
         let config = config_file verify_cert host port in
         start (Some s) config
+    | `Unix_socket_path path ->
+        (* The stunnel will listen on a UNIX socket path *)
+        let config =
+          config_file
+            ~accept:(Some (`Unix_socket_path path))
+            verify_cert host port
+        in
+        start None config
   in
   (* Tidy up any remaining unclosed fds *)
   match result with
@@ -462,7 +476,7 @@ let with_client_proxy_systemd_service ~verify_cert ~remote_host ~remote_port
   let cmd_path = stunnel_path () in
   let config =
     config_file
-      ~accept:(Some (local_host, local_port))
+      ~accept:(Some (`Local_host_port (local_host, local_port)))
       verify_cert remote_host remote_port
   in
   let stop () = ignore (Fe_systemctl.stop ~service) in
@@ -482,49 +496,187 @@ let with_client_proxy_systemd_service ~verify_cert ~remote_host ~remote_port
     )
     (fun () -> Unixext.unlink_safe conf_path)
 
-let check_verify_error line =
-  let sub_after i s =
-    let len = String.length s in
-    String.sub s i (len - i)
-  in
-  let split_1 c s =
-    match Astring.String.cut ~sep:c s with Some (x, _) -> x | None -> s
-  in
-  (* When verified with a mismatched certificate, one line of log from stunnel
-   * would look like:
-     SSL_connect: ssl/statem/statem_clnt.c:1889: error:0A000086:SSL routines::certificate verify failed
-   * in this case, Stunnel_verify_error can be raised with detailed error as
-   * reason if it can found in the log *)
-  if Astring.String.is_infix ~affix:"certificate verify failed" line then
-    match Astring.String.find_sub ~sub:"error:" line with
-    | Some e ->
-        raise
-          (Stunnel_verify_error
-             (split_1 "," (sub_after (e + String.length "error:") line))
-          )
-    | None ->
-        raise (Stunnel_verify_error "")
-  else if
-    Astring.String.is_infix ~affix:"No certificate or private key specified"
-      line
-  then
-    raise (Stunnel_verify_error "The specified certificate is corrupt")
-  else
-    ()
+let diagnose_failure st_proc =
+  let open Stunnel_log_scanner in
+  match
+    check_stunnel_logfile_from_position
+      (fun s -> !stunnel_logger s)
+      st_proc.logfile 0
+  with
+  | End _ | ScanFound _ ->
+      ()
+  | ScanError (Stunnel_error.Certificate_verify reason, _pos) ->
+      raise (Stunnel_verify_error reason)
+  | ScanError (Stunnel_error.Stunnel reason, _pos) ->
+      raise (Stunnel_error reason)
+
+module UnixSocketProxy = struct
+  (** Handle for a long-running stunnel proxy *)
+  type t = {
+      proxy_pid: pid
+    ; proxy_socket_path: string
+    ; proxy_logfile: string
+    ; mutable last_checked_position: int
+  }
 
-let check_error s line =
-  if Astring.String.is_infix ~affix:s line then raise (Stunnel_error s)
+  let socket_path handle = handle.proxy_socket_path
+
+  (** Generate a unique UNIX socket path for the stunnel proxy *)
+  let generate_socket_path ~remote_host ~remote_port =
+    let uuid = Uuidx.(to_string (make ())) in
+    Printf.sprintf "/tmp/stunnel-proxy-%s-%d-%s.sock" remote_host remote_port
+      uuid
+
+  let diagnose handle =
+    let start_pos = handle.last_checked_position in
+    let open Stunnel_log_scanner in
+    match
+      check_stunnel_logfile_from_position
+        (fun s -> !stunnel_logger s)
+        handle.proxy_logfile start_pos
+    with
+    | End pos | ScanFound pos ->
+        handle.last_checked_position <- pos ;
+        Ok ()
+    | ScanError (e, pos) ->
+        handle.last_checked_position <- pos ;
+        Error e
+
+  let wait_for_init_done logfile =
+    let open Stunnel_log_scanner in
+    let check_line = check_configuration_success >>= check_stunnel_error in
+    check_stunnel_log_until_found_or_error logfile check_line 1.0 3 0
+    |> function
+    | Stunnel_log_scanner.ScanFound pos ->
+        Ok pos
+    | Stunnel_log_scanner.ScanError (e, _pos) ->
+        Error e
+    | Stunnel_log_scanner.End _ ->
+        Error (Stunnel_error.Stunnel "Unexpected end of log file")
+
+  let start ~verify_cert ~remote_host ~remote_port ?unix_socket_path
+      ?socket_mode () =
+    let ( let* ) = Result.bind in
+    let open Stunnel_error in
+    let unix_socket_path =
+      match unix_socket_path with
+      | Some path ->
+          path
+      | None ->
+          generate_socket_path ~remote_host ~remote_port
+    in
+    Unixext.unlink_safe unix_socket_path ;
+    let write_to_log = D.debug "%s: %s" __FUNCTION__ in
+    let* pid, logfile =
+      try
+        attempt_one_connect ~write_to_log ~extended_diagnosis:true
+          (`Unix_socket_path unix_socket_path) verify_cert remote_host
+          remote_port
+        |> Result.ok
+      with
+      | Stunnel_initialisation_failed ->
+          Error (Stunnel "stunnel initialisation failed")
+      | Stunnel_error reason ->
+          Error (Stunnel reason)
+      | Stunnel_verify_error reason ->
+          Error (Certificate_verify reason)
+      | exn ->
+          Error (Certificate_verify (Printexc.to_string exn))
+    in
+    let clean_up () =
+      disconnect_with_pid ~wait:false ~force:true pid ;
+      Unixext.unlink_safe unix_socket_path ;
+      Unixext.unlink_safe logfile
+    in
+    let* pos =
+      wait_for_init_done logfile
+      |> Result.map_error (fun e ->
+          D.error "%s: stunnel init failed" __FUNCTION__ ;
+          clean_up () ;
+          e
+      )
+    in
+    let* () =
+      if Sys.file_exists unix_socket_path then (
+        D.debug "%s: unix socket %s created" __FUNCTION__ unix_socket_path ;
+        Ok ()
+      ) else (
+        D.error "%s: unix socket %s not created" __FUNCTION__ unix_socket_path ;
+        clean_up () ;
+        Error (Stunnel "stunnel failed to create unix socket")
+      )
+    in
+    Option.iter
+      (fun mode ->
+        D.debug "chmod %s to %o" unix_socket_path mode ;
+        Unix.chmod unix_socket_path mode
+      )
+      socket_mode ;
+    D.debug "%s: started stunnel proxy (pid:%d):%s -> %s:%d log: %s"
+      __FUNCTION__ (getpid pid) unix_socket_path remote_host remote_port logfile ;
+
+    let handle =
+      {
+        proxy_pid= pid
+      ; proxy_socket_path= unix_socket_path
+      ; proxy_logfile= logfile
+      ; last_checked_position= pos
+      }
+    in
+    Ok handle
+
+  let stop handle =
+    disconnect_with_pid ~wait:false ~force:true handle.proxy_pid ;
+    Unixext.unlink_safe handle.proxy_socket_path ;
+    Unixext.unlink_safe handle.proxy_logfile ;
+    D.debug "%s: stopped stunnel proxy (pid:%d):%s" __FUNCTION__
+      (getpid handle.proxy_pid) handle.proxy_socket_path
+
+  let with_proxy ~verify_cert ~remote_host ~remote_port ?unix_socket_path
+      ?socket_mode f =
+    match
+      start ~verify_cert ~remote_host ~remote_port ?unix_socket_path
+        ?socket_mode ()
+    with
+    | Error _ as e ->
+        e
+    | Ok handle ->
+        let finally = Xapi_stdext_pervasives.Pervasiveext.finally in
+        finally (fun () -> f handle) (fun () -> stop handle)
+end
 
-let diagnose_failure st_proc =
-  let check_line line =
-    !stunnel_logger line ;
-    check_verify_error line ;
-    check_error "Connection refused" line ;
-    check_error "No host resolved" line ;
-    check_error "No route to host" line ;
-    check_error "Invalid argument" line
-  in
-  Unixext.readfile_line check_line st_proc.logfile
+(** Fetch the server certificate from a remote host.
+    Uses openssl s_client to connect and retrieve the certificate in PEM format.
+    This is useful for TOFU (Trust-On-First-Use) scenarios. *)
+let fetch_server_cert ~remote_host ~remote_port =
+  try
+    let openssl = !Constants.openssl_path in
+    (* First get the certificate with s_client *)
+    let s_client_args =
+      [
+        "s_client"
+      ; "-connect"
+      ; Printf.sprintf "%s:%d" remote_host remote_port
+      ; "-showcerts"
+      ]
+    in
+    let cert_output, _ =
+      Forkhelpers.execute_command_get_output_send_stdin openssl s_client_args ""
+    in
+    (* Then parse it with x509 to get PEM format *)
+    let x509_args = ["x509"; "-outform"; "PEM"] in
+    let pem_output, _ =
+      Forkhelpers.execute_command_get_output_send_stdin openssl x509_args
+        cert_output
+    in
+    if
+      String.length pem_output > 0
+      && Astring.String.is_infix ~affix:"BEGIN CERTIFICATE" pem_output
+    then
+      Some (String.trim pem_output)
+    else
+      None
+  with _ -> None
 
 (* If we reach here the whole stunnel log should have been gone through
    (possibly printed/logged somewhere. No necessity to raise an exception,

ocaml/libs/stunnel/stunnel.mli

@@ -99,3 +99,79 @@ val with_client_proxy_systemd_service :
   -> service:string
   -> (unit -> 'a)
   -> 'a
+
+module UnixSocketProxy : sig
+  (** Handle for a long-running stunnel proxy that exposes TLS connection
+      via a UNIX socket file. *)
+  type t
+
+  val socket_path : t -> string
+  (** Get the UNIX socket file path for connecting to the proxy.
+      Use this path with HTTP clients (curl, urllib, etc.) to send traffic
+      through the TLS tunnel. *)
+
+  val start :
+       verify_cert:verification_config option
+    -> remote_host:string
+    -> remote_port:int
+    -> ?unix_socket_path:string
+    -> ?socket_mode:int
+    -> unit
+    -> (t, Stunnel_error.t) result
+  (** Start a long-running stunnel proxy listening on a UNIX socket.
+      Returns [Ok handle] if stunnel starts successfully. The handle MUST be
+      stopped with [stop] when no longer needed.
+      Returns [Error] if stunnel fails to start, initialize.
+      If [unix_socket_path] is not provided, a unique path will be generated
+      automatically in /tmp with the format:
+      stunnel-proxy-{host}-{port}-{uuid}.sock
+      If [socket_mode] is provided (e.g., [~socket_mode:0o666]), the socket
+      file permissions will be set accordingly after creation using chmod.
+
+      Use example:
+      let stunnel_proxy =
+        Stunnel.UnixSocketProxy.start ~verify_cert ~remote_host ~remote_port ()
+      in
+      match stunnel_proxy with
+      | Error e -> (* handle error *)
+      | Ok proxy_handle ->
+          let socket_path = Stunnel.UnixSocketProxy.socket_path proxy_handle in
+          (* use socket_path with HTTP clients *)
+          ...
+          Stunnel.UnixSocketProxy.diagnose proxy_handle |> function
+          | Ok () -> (* all good *)
+          | Error err -> (* handle connection errors *)
+          ...
+          Stunnel.UnixSocketProxy.stop proxy_handle (* clean up when done *)
+      *)
+
+  val stop : t -> unit
+  (** Stop a running stunnel proxy and clean up resources.
+      This kills the stunnel process and removes the socket and log files. *)
+
+  val diagnose : t -> (unit, Stunnel_error.t) result
+  (** Diagnose the status of a running stunnel proxy by checking its logfile.
+      Only checks NEW log entries since the last call to [diagnose] (or since
+      [start] if never called). This allows efficient monitoring of connection
+      failures that occur after the initial certificate verification.
+      Returns [Ok ()] if no new errors found, [Error] with details otherwise. *)
+
+  val with_proxy :
+       verify_cert:verification_config option
+    -> remote_host:string
+    -> remote_port:int
+    -> ?unix_socket_path:string
+    -> ?socket_mode:int
+    -> (t -> ('a, Stunnel_error.t) result)
+    -> ('a, Stunnel_error.t) result
+  (** Start a proxy, execute a function with it, and automatically stop it.
+      The proxy is guaranteed to be stopped even if the function raises an exception.
+      If [unix_socket_path] is not provided, a unique path will be generated.
+      If [socket_mode] is provided, stunnel will set the socket file permissions.
+      This is the preferred way for short-lived proxies. *)
+end
+
+val fetch_server_cert : remote_host:string -> remote_port:int -> string option
+(** Fetch the server certificate from a remote host.
+    Uses openssl s_client to connect and retrieve the certificate in PEM format.
+    This is useful for TOFU (Trust-On-First-Use) scenarios. *)

ocaml/libs/stunnel/stunnel_client.ml

@@ -35,3 +35,25 @@ let appliance () = get_verification_config Stunnel.appliance
 
 let external_host cert_file =
   Stunnel.external_host cert_file |> get_verification_config
+
+let construct_cert_verification ~purpose =
+  let open Stunnel in
+  let base_dir = "/etc/trusted-certs" in
+  let pinned_pem = Printf.sprintf "%s/pinned-bundle-%s.pem" base_dir purpose in
+  let chain_pem = Printf.sprintf "%s/ca-bundle-%s.pem" base_dir purpose in
+  let general_pem = Printf.sprintf "%s/ca-bundle-general.pem" base_dir in
+  match
+    ( Sys.file_exists pinned_pem
+    , Sys.file_exists chain_pem
+    , Sys.file_exists general_pem
+    )
+  with
+  | true, _, _ ->
+      Some {sni= None; verify= VerifyPeer; cert_bundle_path= pinned_pem}
+  | false, true, _ ->
+      Some {sni= None; verify= CheckHost; cert_bundle_path= chain_pem}
+  | false, false, true ->
+      Some {sni= None; verify= CheckHost; cert_bundle_path= general_pem}
+  | false, false, false ->
+      D.debug "%s: No cert bundle found for purpose %s" __FUNCTION__ purpose ;
+      None

ocaml/libs/stunnel/stunnel_client.mli

@@ -21,3 +21,6 @@ val pool : unit -> Stunnel.verification_config option
 val appliance : unit -> Stunnel.verification_config option
 
 val external_host : string -> Stunnel.verification_config option
+
+val construct_cert_verification :
+  purpose:string -> Stunnel.verification_config option