Merge pull request xapi-project#3019 from sharady/CA-249668

CA-249668: For SXM if remote network is unreachable then raise an API error instead of internal_error.

Author: thomassa

ocaml/idl/datamodel.ml

@@ -505,6 +505,9 @@ let _ =
   error Api_errors.cannot_contact_host ["host"]
     ~doc:"Cannot forward messages because the host cannot be contacted.  The host may be switched off or there may be network connectivity problems." ();
 
+  error Api_errors.tls_connection_failed ["address"; "port"]
+    ~doc:"Cannot contact the other host using TLS on the specified address and port" ();
+
   error Api_errors.uuid_invalid [ "type"; "uuid" ]
     ~doc:"The uuid you supplied was invalid." ();
   error Api_errors.object_nolonger_exists []

ocaml/xapi-consts/api_errors.ml

@@ -42,6 +42,7 @@ let session_invalid = "SESSION_INVALID"
 let change_password_rejected = "CHANGE_PASSWORD_REJECTED"
 let user_is_not_local_superuser = "USER_IS_NOT_LOCAL_SUPERUSER"
 let cannot_contact_host = "CANNOT_CONTACT_HOST"
+let tls_connection_failed = "TLS_CONNECTION_FAILED"
 let not_supported_during_upgrade = "NOT_SUPPORTED_DURING_UPGRADE"
 
 let handle_invalid = "HANDLE_INVALID"

ocaml/xapi/importexport.ml

@@ -257,27 +257,31 @@ let remote_metadata_export_import ~__context ~rpc ~session_id ~remote_address ~r
                ] ~keep_alive:false
                Http.Put remote_import_request in
            debug "Piping HTTP %s to %s" (Http.Request.to_string get) (Http.Request.to_string put);
-           with_transport (Unix Xapi_globs.unix_domain_socket)
-             (with_http get
-                (fun (r, ifd) ->
-                   debug "Content-length: %s" (Stdext.Opt.default "None" (Stdext.Opt.map Int64.to_string r.Http.Response.content_length));
-                   let put = { put with Http.Request.content_length = r.Http.Response.content_length } in
-                   debug "Connecting to %s:%d" remote_address !Xapi_globs.https_port;
-                   (* Spawn a cached stunnel instance. Otherwise, once metadata tranmission completes, the connection
-                      between local xapi and stunnel will be closed immediately, and the new spawned stunnel instance
-                      will be revoked, this might cause the remote stunnel gets partial metadata xml file, and the
-                      ripple effect is that remote xapi fails to parse metadata xml file. Using a cached stunnel can
-                      not always avoid the problem since any cached stunnel entry might be evicted. However, it is
-                      unlikely to happen in practice because the cache size is large enough.*)
-                   with_transport (SSL (SSL.make ~use_stunnel_cache:true (), remote_address, !Xapi_globs.https_port))
-                     (with_http put
-                        (fun (_, ofd) ->
+           begin try
+               with_transport (Unix Xapi_globs.unix_domain_socket)
+                 (with_http get
+                   (fun (r, ifd) ->
+                     debug "Content-length: %s" (Stdext.Opt.default "None" (Stdext.Opt.map Int64.to_string r.Http.Response.content_length));
+                     let put = { put with Http.Request.content_length = r.Http.Response.content_length } in
+                     debug "Connecting to %s:%d" remote_address !Xapi_globs.https_port;
+                     (* Spawn a cached stunnel instance. Otherwise, once metadata tranmission completes, the connection
+                        between local xapi and stunnel will be closed immediately, and the new spawned stunnel instance
+                        will be revoked, this might cause the remote stunnel gets partial metadata xml file, and the
+                        ripple effect is that remote xapi fails to parse metadata xml file. Using a cached stunnel can
+                        not always avoid the problem since any cached stunnel entry might be evicted. However, it is
+                        unlikely to happen in practice because the cache size is large enough.*)
+                     with_transport (SSL (SSL.make ~use_stunnel_cache:true (), remote_address, !Xapi_globs.https_port))
+                       (with_http put
+                         (fun (_, ofd) ->
                            let (n: int64) = Stdext.Unixext.copy_file ?limit:r.Http.Response.content_length ifd ofd in
                            debug "Written %Ld bytes" n
-                        )
-                     )
-                )
-             );
+                         )
+                       )
+                   )
+                 )
+             with Xmlrpc_client.Stunnel_connection_failed ->
+               raise (Api_errors.Server_error(Api_errors.tls_connection_failed, [remote_address; (string_of_int !Xapi_globs.https_port)]))
+           end;
            (* Wait for remote task to succeed or fail *)
            Cli_util.wait_for_task_completion rpc session_id remote_task;
            match Client.Task.get_status rpc session_id remote_task with