Enable HTTPS for storage migration on the source

This is currently set on the destination, in host.migrate_receive.
However, all recent changes to make HTTPS migration work were on the
source host. Migration is allowed from older to newer software versions,
so it is possible that the destination is HTTPS capable, while the
source is not. This may result in the source receiving HTTPS URLs, which
is cannot handle, breaking this upgrade case.

Instead, let the source decide whether to switch to HTTPS or not,
depending on the config key (to be made the default later).

Signed-off-by: Rob Hoes <[email protected]>

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