Merge pull request #106 from rokstrnisa/rrdd

Rrdd-related changes to xen-api-libs.

http-svr/test_client.ml

@@ -22,9 +22,7 @@ let with_connection ip port f =
 		(fun () -> Unix.close s)
 
 let with_stunnel ip port =
-	let done_init = ref false in
 	fun f ->
-		if not !done_init then Stunnel.init_stunnel_path ();
 		let s = Stunnel.connect ~use_fork_exec_helper:false ~extended_diagnosis:false ip port in
 		let fd = s.Stunnel.fd in
 		finally

log/debug.ml

@@ -168,8 +168,11 @@ module Debugger = functor(Brand: BRAND) -> struct
 				msg
 			) fmt
 
-  let log_backtrace () =
-    let backtrace = Backtrace.get_backtrace () in
-    debug "%s" (String.escaped backtrace)
+	let log_backtrace () =
+		let backtrace = Backtrace.get_backtrace () in
+		debug "%s" (String.escaped backtrace)
+
+	let log_and_ignore_exn f =
+		try f () with _ -> log_backtrace ()
 
 end

log/debug.mli

@@ -72,5 +72,7 @@ sig
 	val audit : ?raw:bool -> ('a, unit, string, string) format4 -> 'a
 
 	val log_backtrace : unit -> unit
+
+	val log_and_ignore_exn : (unit -> unit) -> unit
 end
 

stdext/hashtblext.ml

@@ -29,6 +29,12 @@ let add_empty tbl k v =
 let add_list tbl l =
 	List.iter (fun (k, v) -> Hashtbl.add tbl k v) l
 
+let remove_other_keys tbl valid_keys =
+	let keys = fold_keys tbl in
+	let maybe_remove k =
+		if not (List.mem k valid_keys) then Hashtbl.remove tbl k in
+	List.iter maybe_remove keys
+
 let of_list l =
 	let tbl = Hashtbl.create (List.length l) in
 	add_list tbl l;

stdext/hashtblext.mli

@@ -71,5 +71,6 @@ module Hashtbl :
     val fold_values : ('a, 'b) Hashtbl.t -> 'b list
     val add_empty : ('a, 'b) Hashtbl.t -> 'a -> 'b -> unit
     val add_list : ('a, 'b) Hashtbl.t -> ('a * 'b) list -> unit
+    val remove_other_keys : ('a, 'b) Hashtbl.t -> 'a list -> unit
     val of_list : ('a * 'b) list -> ('a, 'b) Hashtbl.t
   end

stdext/opt.ml

@@ -53,6 +53,12 @@ let is_boxed = function
 	| Some _ -> true
 	| None -> false
 
+let is_some = is_boxed
+
+let is_none = function
+	| Some _ -> false
+	| None -> true
+
 let to_list = function
 	| Some x -> [x]
 	| None -> []

stdext/opt.mli

@@ -18,6 +18,8 @@ val map : ('a -> 'b) -> 'a option -> 'b option
 val default : 'a -> 'a option -> 'a
 val unbox : 'a option -> 'a
 val is_boxed : 'a option -> bool
+val is_some : 'a option -> bool
+val is_none : 'a option -> bool
 val to_list : 'a option -> 'a list
 val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b option -> 'a
 val fold_right : ('a -> 'b -> 'b) -> 'a option -> 'b -> 'b

stdext/unixext.ml

@@ -127,6 +127,9 @@ let with_file file mode perms f =
 
 let file_lines_fold f start file_path = with_input_channel file_path (lines_fold f start)
 
+let read_lines ~(path : string) : string list =
+	List.rev (file_lines_fold (fun acc line -> line::acc) [] path)
+
 let file_lines_iter f = file_lines_fold (fun () line -> ignore(f line)) ()
 
 let readfile_line = file_lines_iter

stdext/unixext.mli

@@ -37,6 +37,9 @@ val lines_iter : (string -> unit) -> in_channel -> unit
 starting value [start]. *)
 val file_lines_fold : ('a -> string -> 'a) -> 'a -> string -> 'a
 
+(** [read_lines path] returns a list of lines in the file at [path]. *)
+val read_lines : path:string -> string list
+
 (** Applies function [f] to every line in the file at [file_path]. *)
 val file_lines_iter : (string -> unit) -> string -> unit
 

stunnel/stunnel.ml

@@ -32,31 +32,33 @@ let cached_stunnel_path = ref None
 let stunnel_logger = ref ignore
 
 let init_stunnel_path () =
-  try cached_stunnel_path := Some (Unix.getenv "XE_STUNNEL")
-  with Not_found ->
-    if !use_new_stunnel then
-      cached_stunnel_path := Some new_stunnel_path
-    else (
-      let choices = ["/opt/xensource/libexec/stunnel/stunnel";
-		     "/usr/sbin/stunnel4";
-		     "/usr/sbin/stunnel";
-		     "/usr/bin/stunnel4";
-		     "/usr/bin/stunnel";
-		    ] in
-      let rec choose l =
-        match l with
-	    [] -> raise Stunnel_binary_missing
-	  | (p::ps) ->
-	      try Unix.access p [Unix.X_OK]; p
-	      with _ -> choose ps in
-      let path = choose choices in
-      cached_stunnel_path := Some path
-    )
+	try cached_stunnel_path := Some (Unix.getenv "XE_STUNNEL")
+	with Not_found ->
+		if !use_new_stunnel then
+			cached_stunnel_path := Some new_stunnel_path
+		else (
+			let choices = [
+				"/opt/xensource/libexec/stunnel/stunnel";
+				"/usr/sbin/stunnel4";
+				"/usr/sbin/stunnel";
+				"/usr/bin/stunnel4";
+				"/usr/bin/stunnel";
+			] in
+			let rec choose l =
+				match l with
+				| [] -> raise Stunnel_binary_missing
+				| p::ps ->
+					try Unix.access p [Unix.X_OK]; p
+					with _ -> choose ps
+			in
+			let path = choose choices in
+			cached_stunnel_path := Some path
+		)
 
-let stunnel_path() =
-  match !cached_stunnel_path with
-    | Some p -> p 
-    | None -> raise Stunnel_binary_missing
+let stunnel_path () =
+	if Opt.is_none !cached_stunnel_path then
+		init_stunnel_path ();
+	Opt.unbox !cached_stunnel_path
 
 module Unsafe = struct
   (** These functions are not safe in a multithreaded program *)

stunnel/stunnel.mli

@@ -19,20 +19,17 @@ exception Stunnel_verify_error of string
 val certificate_path : string
 val crl_path : string
 
-val use_new_stunnel : bool ref
-val init_stunnel_path : unit -> unit
-
-type pid = 
+type pid =
   | StdFork of int (** we forked and exec'ed. This is the pid *)
   | FEFork of Forkhelpers.pidty (** the forkhelpers module did it for us. *)
   | Nopid
 
 val getpid: pid -> int
 
 (** Represents an active stunnel connection *)
-type t = { mutable pid: pid; 
-	   fd: Unix.file_descr; 
-	   host: string; 
+type t = { mutable pid: pid;
+	   fd: Unix.file_descr;
+	   host: string;
 	   port: int;
 	   connected_time: float; (** time when the connection opened, for 'early retirement' *)
 	   unique_id: int option;