Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
20 changes: 3 additions & 17 deletions ocaml/xapi-idl/lib/observer_helpers.ml
Original file line number Diff line number Diff line change
Expand Up @@ -241,24 +241,10 @@ module Server (Impl : Server_impl) () = struct
let process call = Idl.Exn.server S.implementation call
end

let rec retry_econnrefused f =
try f () with
| Unix.Unix_error (Unix.ECONNREFUSED, "connect", _) ->
(* debug "Caught ECONNREFUSED; retrying in 5s"; *)
Thread.delay 5. ; retry_econnrefused f
| e ->
(* error "Caught %s: does the observer service need restarting?"
(Printexc.to_string e); *)
raise e

module Client = ObserverAPI (Idl.Exn.GenClient (struct
open Xcp_client

let rpc call =
retry_econnrefused (fun () ->
if !use_switch then
json_switch_rpc queue_name call
else
xml_http_rpc ~srcstr:(get_user_agent ()) ~dststr:queue_name uri call
Xcp_client.(
retry_and_switch_rpc call ~use_switch:!use_switch ~queue_name
~dststr:queue_name ~uri
)
end))
18 changes: 18 additions & 0 deletions ocaml/xapi-idl/lib/xcp_client.ml
Original file line number Diff line number Diff line change
Expand Up @@ -190,3 +190,21 @@ let binary_rpc string_of_call response_of_string ?(srcstr = "unset")

let json_binary_rpc =
binary_rpc Jsonrpc.string_of_call Jsonrpc.response_of_string

let rec retry_econnrefused f =
try f () with
| Unix.Unix_error (Unix.ECONNREFUSED, "connect", _) ->
(* debug "Caught ECONNREFUSED; retrying in 5s"; *)
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This was commented out when moved from xenops_server_xen.ml to Storage_client.ml (the commit I mentioned in the description.) I'm not sure if it was considered spammy or if we'd be interested in it? It's been commented out for 12 years... :P

Thread.delay 5. ; retry_econnrefused f
| e ->
(* error "Caught %s: does the service need restarting?"
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

We're raising the error anyway, so I don't know if this message adds any more context that we'd need?

(Printexc.to_string e); *)
raise e

let retry_and_switch_rpc call ~use_switch ~queue_name ~dststr ~uri =
retry_econnrefused (fun () ->
if use_switch then
json_switch_rpc queue_name call
else
xml_http_rpc ~srcstr:(get_user_agent ()) ~dststr uri call
)
22 changes: 4 additions & 18 deletions ocaml/xapi-idl/rrd/rrd_client.ml
Original file line number Diff line number Diff line change
Expand Up @@ -13,26 +13,12 @@
*)

open Rrd_interface
open Xcp_client

let rec retry_econnrefused f =
try f () with
| Unix.Unix_error (Unix.ECONNREFUSED, "connect", _) ->
(* debug "Caught ECONNREFUSED; retrying in 5s"; *)
Thread.delay 5. ; retry_econnrefused f
| e ->
(* error "Caught %s: does the rrd service need restarting?"
(Printexc.to_string e); *)
raise e

(* TODO: use_switch=false as the message switch doesn't handle raw HTTP very well *)
Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This was a TODO in the original code, but it's clearly never been TODONE.

let rpc call =
retry_econnrefused (fun () ->
(* TODO: the message switch doesn't handle raw HTTP very well *)
if (* !use_switch *) false then
json_switch_rpc !queue_name call
else
xml_http_rpc ~srcstr:(get_user_agent ()) ~dststr:"rrd" Rrd_interface.uri
call
Xcp_client.(
retry_and_switch_rpc call ~use_switch:false ~queue_name:!queue_name
~dststr:"rrd" ~uri
)

module Client = RPC_API (Idl.Exn.GenClient (struct let rpc = rpc end))
22 changes: 4 additions & 18 deletions ocaml/xapi-idl/storage/storage_client.ml
Original file line number Diff line number Diff line change
Expand Up @@ -13,25 +13,11 @@
*)

open Storage_interface
open Xcp_client

let rec retry_econnrefused f =
try f () with
| Unix.Unix_error (Unix.ECONNREFUSED, "connect", _) ->
(* debug "Caught ECONNREFUSED; retrying in 5s"; *)
Thread.delay 5. ; retry_econnrefused f
| e ->
(* error "Caught %s: does the storage service need restarting?"
(Printexc.to_string e); *)
raise e

module Client = Storage_interface.StorageAPI (Idl.Exn.GenClient (struct
module Client = StorageAPI (Idl.Exn.GenClient (struct
let rpc call =
retry_econnrefused (fun () ->
if !use_switch then
json_switch_rpc !queue_name call
else
xml_http_rpc ~srcstr:(get_user_agent ()) ~dststr:"storage"
Storage_interface.uri call
Xcp_client.(
retry_and_switch_rpc call ~use_switch:!use_switch ~queue_name:!queue_name
~dststr:"storage" ~uri
)
end))
Loading