Merge pull request #4852 from robhoes/https-upgrade

Enable HTTPS for storage migration on the source host

ocaml/libs/http-svr/http.ml

@@ -992,4 +992,6 @@ module Url = struct
 
   let auth_of (scheme, _) =
     match scheme with File _ -> None | Http {auth; _} -> auth
+
+  let set_ssl ssl = function Http h, d -> (Http {h with ssl}, d) | x -> x
 end

ocaml/libs/http-svr/http.mli

@@ -269,4 +269,6 @@ module Url : sig
   val get_query : t -> string
 
   val auth_of : t -> authorization option
+
+  val set_ssl : bool -> t -> t
 end

ocaml/xapi/xapi_host.ml

@@ -2552,7 +2552,10 @@ let migrate_receive ~__context ~host ~network ~options:_ =
                (Api_errors.interface_has_no_ip, [Ref.string_of pif])
             )
   ) ;
-  let scheme = if !Xapi_globs.migration_https_only then "https" else "http" in
+  (* Set the scheme to HTTP and let the migration source host decide whether to
+     switch to HTTPS instead, to avoid problems with source hosts that are not
+     able to do HTTPS migrations yet. *)
+  let scheme = "http" in
   let sm_url =
     Printf.sprintf "%s://%s/services/SM?session_id=%s" scheme
       (Http.Url.maybe_wrap_IPv6_literal ip)

ocaml/xapi/xapi_vm_migrate.ml

@@ -94,8 +94,14 @@ let use_compression options src dst =
       !Xapi_globs.migration_compression
 
 let remote_of_dest ~__context dest =
-  let master_url = List.assoc _master dest in
-  let xenops_url = List.assoc _xenops dest in
+  let maybe_set_https url =
+    if !Xapi_globs.migration_https_only then
+      Http.Url.(url |> of_string |> set_ssl true |> to_string)
+    else
+      url
+  in
+  let master_url = List.assoc _master dest |> maybe_set_https in
+  let xenops_url = List.assoc _xenops dest |> maybe_set_https in
   let session_id = Ref.of_string (List.assoc _session_id dest) in
   let remote_ip = get_ip_from_url xenops_url in
   let remote_master_ip = get_ip_from_url master_url in
@@ -111,12 +117,9 @@ let remote_of_dest ~__context dest =
   in
   let sm_url =
     let url = List.assoc _sm dest in
-    if Helpers.this_is_my_address ~__context remote_ip then
-      match Http.Url.of_string url with
-      | Http h, d ->
-          Http.Url.to_string (Http {h with Http.Url.ssl= false}, d)
-      | _ ->
-          url
+    (* Never use HTTPS for local SM calls *)
+    if not (Helpers.this_is_my_address ~__context remote_ip) then
+      maybe_set_https url
     else
       url
   in