[http] add Http_svr.bind_retry

This function attempts to bind an address to a socket, retrying on
(hopefully temporary) failure.

Signed-off-by: David Scott <dave.scott@eu.citrix.com>

http-svr/http_svr.ml

@@ -509,6 +509,28 @@ let bind ?(listen_backlog=128) sockaddr name =
     Unix.close sock;
     raise e
 
+let bind_retry ?(listen_backlog=128) sockaddr =
+	let description = match sockaddr with
+		| Unix.ADDR_INET(ip, port) -> Printf.sprintf "INET %s:%d" (Unix.string_of_inet_addr ip) port
+		| Unix.ADDR_UNIX path -> Printf.sprintf "UNIX %s" path in
+	(* Sometimes we see failures which we hope are transient. If this
+	   happens then we'll retry a couple of times before failing. *)
+	let result = ref None in
+	let start = Unix.gettimeofday () in
+	let timeout = 30.0 in (* 30s *)
+	while !result = None && (Unix.gettimeofday () -. start < timeout) do
+		try
+			result := Some (bind ~listen_backlog sockaddr description);
+		with Unix.Unix_error(code, _, _) ->
+			debug "While binding %s: %s" description (Unix.error_message code);
+			Thread.delay 5.
+	done;
+	match !result with
+		| None -> failwith (Printf.sprintf "Repeatedly failed to bind: %s" description)
+		| Some s ->
+			info "Successfully bound socket to: %s" description;
+			s
+
 (* Maps sockets to Server_io.server records *)
 let socket_table = Hashtbl.create 10
 

http-svr/http_svr.mli

@@ -62,6 +62,9 @@ type socket
 
 val bind : ?listen_backlog:int -> Unix.sockaddr -> string -> socket
 
+(* [bind_retry]: like [bind] but will catch (possibly transient exceptions) and retry *)
+val bind_retry : ?listen_backlog:int -> Unix.sockaddr -> socket
+
 val start : 'a Server.t -> socket -> unit
 
 val handle_one : 'a Server.t -> Unix.file_descr -> 'a -> Http.Request.t -> bool