Skip to content

Commit

Permalink
maintenance: apply ocamlformat
Browse files Browse the repository at this point in the history
Signed-off-by: Pau Ruiz Safont <[email protected]>
  • Loading branch information
psafont committed Oct 11, 2023
1 parent d6f1853 commit fb388e3
Show file tree
Hide file tree
Showing 4 changed files with 34 additions and 29 deletions.
2 changes: 1 addition & 1 deletion lib/bootloader.ml
Original file line number Diff line number Diff line change
Expand Up @@ -222,7 +222,7 @@ let sanity_check_path p =
(** Extract the default kernel using the -q option *)
let extract (task : Xenops_task.task_handle) ~bootloader ~disk
?(legacy_args = "") ?(extra_args = "") ?(pv_bootloader_args = "")
~vm:vm_uuid ~domid:domid () =
~vm:vm_uuid ~domid () =
(* Without this path, pygrub will fail: *)
Unixext.mkdir_rec "/var/run/xend/boot" 0o0755 ;
let bootloader_path, cmdline =
Expand Down
35 changes: 16 additions & 19 deletions lib/open_uri_https.ml
Original file line number Diff line number Diff line change
@@ -1,4 +1,3 @@

(* This code is usually in xcp-idl but we introduced a local copy here
to support https, which has a dependency on stunnel and would create
a circular dependency. *)
Expand All @@ -21,22 +20,22 @@ let with_open_uri uri f =
)
)
| Some "https" -> (
let process (s : Stunnel.t) =
finally
(fun () -> f Safe_resources.Unixfd.(!(s.Stunnel.fd)))
(fun () -> Stunnel.disconnect s)
in
match (Uri.host uri, Uri.port uri) with
| Some host, Some port ->
Stunnel.with_connect host port process
| Some host, None ->
Stunnel.with_connect host https_port process
| _, _ ->
failwith
(Printf.sprintf "Failed to parse host and port from URI: %s"
(Uri.to_string uri)
)
)
let process (s : Stunnel.t) =
finally
(fun () -> f Safe_resources.Unixfd.(!(s.Stunnel.fd)))
(fun () -> Stunnel.disconnect s)
in
match (Uri.host uri, Uri.port uri) with
| Some host, Some port ->
Stunnel.with_connect host port process
| Some host, None ->
Stunnel.with_connect host https_port process
| _, _ ->
failwith
(Printf.sprintf "Failed to parse host and port from URI: %s"
(Uri.to_string uri)
)
)
| Some "file" ->
let filename = Uri.path_and_query uri in
let sockaddr = Unix.ADDR_UNIX filename in
Expand All @@ -48,5 +47,3 @@ let with_open_uri uri f =
failwith (Printf.sprintf "Unsupported URI scheme: %s" x)
| None ->
failwith (Printf.sprintf "Failed to parse URI: %s" (Uri.to_string uri))


22 changes: 15 additions & 7 deletions lib/xcp_client_https.ml
Original file line number Diff line number Diff line change
Expand Up @@ -42,7 +42,9 @@ let switch_rpc ?timeout queue_name string_of_call response_of_string =
response_of_string
(get_ok
(Message_switch_unix.Protocol_unix.Client.rpc ~t ?timeout
~queue:queue_name ~body:(string_of_call call) ()))
~queue:queue_name ~body:(string_of_call call) ()
)
)

let split_colon str =
try
Expand Down Expand Up @@ -94,7 +96,8 @@ let http_rpc string_of_call response_of_string ?(srcstr = "unset")
| `Invalid x ->
failwith
(Printf.sprintf "Failed to read HTTP response from: %s (got '%s')"
(url ()) x)
(url ()) x
)
| `Ok response -> (
let body = Buffer.create 16 in
let reader = Response.make_body_reader response ic in
Expand All @@ -115,8 +118,10 @@ let http_rpc string_of_call response_of_string ?(srcstr = "unset")
| bad ->
failwith
(Printf.sprintf "Unexpected HTTP response code: %s"
(Cohttp.Code.string_of_status bad))
))
(Cohttp.Code.string_of_status bad)
)
)
)

let xml_http_rpc = http_rpc Xmlrpc.string_of_call Xmlrpc.response_of_string

Expand All @@ -129,9 +134,11 @@ let () =
| Xmlm.Error ((line, col), error) ->
Some
(Printf.sprintf "Xmlm.Error(%d:%d, \"%s\")" line col
(Xmlm.error_message error))
(Xmlm.error_message error)
)
| _ ->
None)
None
)

(* Use a binary 16-byte length to frame RPC messages *)
let binary_rpc string_of_call response_of_string ?(srcstr = "unset")
Expand All @@ -153,7 +160,8 @@ let binary_rpc string_of_call response_of_string ?(srcstr = "unset")
let (response : Rpc.response) =
response_of_string (Bytes.unsafe_to_string msg_buf)
in
response)
response
)

let json_binary_rpc =
binary_rpc Jsonrpc.string_of_call Jsonrpc.response_of_string
4 changes: 2 additions & 2 deletions xc/xenops_server_xen.ml
Original file line number Diff line number Diff line change
Expand Up @@ -2106,7 +2106,7 @@ module VM = struct
Bootloader.extract task ~bootloader:i.bootloader
~legacy_args:i.legacy_args ~extra_args:i.extra_args
~pv_bootloader_args:i.bootloader_args ~disk:dev
~vm:vm.Vm.id ~domid:domid ()
~vm:vm.Vm.id ~domid ()
in
kernel_to_cleanup := Some b ;
let builder_spec_info =
Expand Down Expand Up @@ -2150,7 +2150,7 @@ module VM = struct
Bootloader.extract task ~bootloader:i.bootloader
~legacy_args:i.legacy_args ~extra_args:i.extra_args
~pv_bootloader_args:i.bootloader_args ~disk:dev
~vm:vm.Vm.id ~domid:domid ()
~vm:vm.Vm.id ~domid ()
in
kernel_to_cleanup := Some b ;
let builder_spec_info =
Expand Down

0 comments on commit fb388e3

Please sign in to comment.