Improve cert check error

Signed-off-by: Changlei Li <changlei.li@cloud.com>

Author: changlei-li

ocaml/libs/stunnel/stunnel.ml

@@ -23,7 +23,7 @@ exception Stunnel_binary_missing
 
 exception Stunnel_error of string
 
-exception Stunnel_verify_error of string
+exception Stunnel_verify_error of string list
 
 let crl_path = "/etc/stunnel/crls"
 
@@ -138,7 +138,7 @@ type t = {
 }
 
 type stunnel_error =
-  | Certificate_verify of string
+  | Certificate_verify of string list
   | Stunnel of string
   | Unknown of string
 
@@ -489,14 +489,7 @@ 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
+let check_verify_error cert_errors line =
   (* 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
@@ -505,17 +498,14 @@ let check_verify_error line =
   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))
-          )
+        raise (Stunnel_verify_error cert_errors)
     | None ->
-        raise (Stunnel_verify_error "")
+        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")
+    raise (Stunnel_verify_error ["The specified certificate is corrupt"])
   else
     ()
 
@@ -524,9 +514,12 @@ let check_error s line =
     raise (Stunnel_error s)
 
 let check_stunnel_logfile logfile =
+  let cert_errors = ref [] in
   let check_line line =
     !stunnel_logger line ;
-    check_verify_error line ;
+    if Astring.String.is_infix ~affix:"CERT:" line then
+      cert_errors := line :: !cert_errors ;
+    check_verify_error !cert_errors line ;
     check_error "Connection refused" line ;
     check_error "No host resolved" line ;
     check_error "No route to host" line ;
@@ -540,8 +533,8 @@ let check_stunnel_status logfile =
   match check_stunnel_logfile logfile with
   | () ->
       Ok ()
-  | exception Stunnel_verify_error reason ->
-      Error (Certificate_verify reason)
+  | exception Stunnel_verify_error r ->
+      Error (Certificate_verify r)
   | exception Stunnel_error reason ->
       Error (Stunnel reason)
   | exception exn ->

ocaml/libs/stunnel/stunnel.mli

@@ -17,7 +17,7 @@ exception Stunnel_binary_missing
 
 exception Stunnel_error of string
 
-exception Stunnel_verify_error of string
+exception Stunnel_verify_error of string list
 
 val crl_path : string
 
@@ -56,7 +56,7 @@ type t = {
 }
 
 type stunnel_error =
-  | Certificate_verify of string
+  | Certificate_verify of string list
   | Stunnel of string
   | Unknown of string
 

ocaml/xapi/remote_requests.ml

@@ -211,5 +211,5 @@ let send_test_post ~__context ~host ~port ~body =
   with
   | Timed_out ->
       raise (Api_errors.Server_error (Api_errors.wlb_timeout, ["30.0"]))
-  | Stunnel.Stunnel_verify_error reason ->
-      raise (Api_errors.Server_error (Api_errors.ssl_verify_error, [reason]))
+  | Stunnel.Stunnel_verify_error reasons ->
+      raise (Api_errors.Server_error (Api_errors.ssl_verify_error, reasons))

ocaml/xapi/repository.ml

@@ -312,8 +312,8 @@ let sync ~__context ~self ~token ~token_id ~username ~password =
   with
   | Api_errors.Server_error (_, _) as e ->
       raise e
-  | Stunnel.Stunnel_verify_error reason ->
-      raise (Api_errors.Server_error (Api_errors.ssl_verify_error, [reason]))
+  | Stunnel.Stunnel_verify_error reasons ->
+      raise (Api_errors.Server_error (Api_errors.ssl_verify_error, reasons))
   | e ->
       error "Failed to sync with remote YUM repository: %s"
         (ExnHelper.string_of_exn e) ;

ocaml/xapi/workload_balancing.ml

@@ -56,8 +56,8 @@ let raise_timeout timeout =
   raise
     (Api_errors.Server_error (Api_errors.wlb_timeout, [string_of_float timeout]))
 
-let raise_verify_error reason =
-  raise (Api_errors.Server_error (Api_errors.ssl_verify_error, [reason]))
+let raise_verify_error reasons =
+  raise (Api_errors.Server_error (Api_errors.ssl_verify_error, reasons))
 
 let raise_authentication_failed () =
   raise (Api_errors.Server_error (Api_errors.wlb_authentication_failed, []))
@@ -344,8 +344,8 @@ let wlb_request ~__context ~host ~port ~auth ~meth ~params ~handler ~enable_log
       raise_connection_reset ()
   | Xmlrpc_client.Connection_reset ->
       raise_connection_reset ()
-  | Stunnel.Stunnel_verify_error reason ->
-      raise_verify_error reason
+  | Stunnel.Stunnel_verify_error reasons ->
+      raise_verify_error reasons
   | Stunnel.Stunnel_error error_msg as exc -> (
     match error_msg with
     | "Connection refused" ->