CA-85761: distinguish between unguessable UUIDs ("secure") and only u…

…nique UUIDs ("insecure")

Whenever we want a UUID which is only unique, but predictable, we use
  Uuid.insecure ()

Whenever we want a UUID which is both unique and unpredictable, we use
  Uuid.secure ()

Mark Uuid.make_uuid as deprecated.

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

forking_executioner/fe_main.ml

@@ -6,7 +6,7 @@ open Fe_debug
 
 let setup sock cmdargs id_to_fd_map syslog_stdout env =
   let fd_sock_path = Printf.sprintf "/var/xapi/forker/fd_%s" 
-    (Uuid.to_string (Uuid.make_uuid ())) in
+    (Uuid.to_string (Uuid.insecure ())) in
   let fd_sock = Fecomms.open_unix_domain_sock () in
   Unixext.unlink_safe fd_sock_path;
   debug "About to bind to %s" fd_sock_path;

http-svr/xmlrpc_client.ml

@@ -50,7 +50,7 @@ let write_to_log x = StunnelDebug.debug "%s" (String.strip String.isspace x)
     closed or left in some other inconsistent state. *)
 let check_reusable (x: Unix.file_descr) =
 	let msg_name = "system.isAlive" in
-	let msg_uuid = Uuid.string_of_uuid (Uuid.make_uuid ()) in
+	let msg_uuid = Uuid.string_of_uuid (Uuid.insecure ()) in
 	(* This is for backward compatability *)
 	let msg_func = Printf.sprintf "%s:%s" msg_name msg_uuid in
 	let msg_param = [ XMLRPC.To.string msg_uuid ] in

mlvm/vg.ml

@@ -242,7 +242,7 @@ let dev_path_of_dm_name dm_name =
     Printf.sprintf "/dev/mapper/%s" dm_name
 
 let lv_activate_internal name dm_map dereference_table use_tmp dev =
-  let realname = if use_tmp then (Uuid.to_string (Uuid.make_uuid ())) else name in
+  let realname = if use_tmp then (Uuid.to_string (Uuid.insecure ())) else name in
   let nod = dev_path_of_dm_name realname in
   debug (Printf.sprintf "Using dm_name=%s (use_tmp=%b)" realname use_tmp);
   if not !Constants.dummy_mode then begin

stdext/fe_test.ml

@@ -48,7 +48,7 @@ let one x =
   (*Printf.fprintf stderr "named_fds = %d\n" x.named_fds;
   Printf.fprintf stderr "extra = %d\n" x.extra;*)
   let fd = Unix.stdin in
-  let make_names n = List.map (fun _ -> Uuid.to_string (Uuid.make_uuid ())) (mkints n) in
+  let make_names n = List.map (fun _ -> Uuid.to_string (Uuid.insecure ())) (mkints n) in
   let names = make_names x.named_fds in
   let cmdline_names = irrelevant_strings @ names @ names in
   let number_of_extra = x.extra in

stdext/filenameext.ml

@@ -17,7 +17,7 @@ let temp_file_in_dir otherfile =
   let base_dir = Filename.dirname otherfile in
   let rec keep_trying () = 
     try 
-      let uuid = Uuid.to_string (Uuid.make_uuid ()) in
+      let uuid = Uuid.to_string (Uuid.insecure ()) in
       let newfile = base_dir ^ "/" ^ uuid in
       Unix.close (Unix.openfile newfile [Unix.O_CREAT; Unix.O_TRUNC; Unix.O_EXCL] 0o600);
       newfile

stdext/forkhelpers.ml

@@ -97,9 +97,9 @@ let safe_close_and_exec ?env stdin stdout stderr (fds: (string * Unix.file_descr
     (cmd: string) (args: string list) =
 
   let sock = Fecomms.open_unix_domain_sock_client "/var/xapi/forker/main" in
-  let stdinuuid = Uuid.to_string (Uuid.make_uuid ()) in
-  let stdoutuuid = Uuid.to_string (Uuid.make_uuid ()) in
-  let stderruuid = Uuid.to_string (Uuid.make_uuid ()) in
+  let stdinuuid = Uuid.to_string (Uuid.insecure ()) in
+  let stdoutuuid = Uuid.to_string (Uuid.insecure ()) in
+  let stderruuid = Uuid.to_string (Uuid.insecure ()) in
 
   let fds_to_close = ref [] in
 

stunnel/stunnel.ml

@@ -176,7 +176,7 @@ let attempt_one_connect ?unique_id ?(use_fork_exec_helper = true)
       None, None, [], (if extended_diagnosis then "-v" :: args else args)
     end else begin
       let config_out, config_in = Unix.pipe () in
-      let config_out_uuid = Uuid.to_string (Uuid.make_uuid ()) in
+      let config_out_uuid = Uuid.to_string (Uuid.insecure ()) in
       let config_out_fd = 
         string_of_int (Unixext.int_of_file_descr config_out) in
       fds_needed := config_out :: !fds_needed;

uuid/uuid.ml

@@ -71,6 +71,9 @@ let make_uuid_urnd () = uuid_of_int_array (read_array dev_urandom 16)
 let make_uuid_rnd () = uuid_of_int_array (read_array dev_random 16)
 let make_uuid = make_uuid_urnd
 
+let secure = make_uuid_urnd
+let insecure = make_uuid_prng
+
 let int_array_of_uuid s =
   try
     let l = ref [] in

uuid/uuid.mli

@@ -20,8 +20,16 @@
 (** A 128-bit UUID.  Using phantom types ('a) to achieve the requires type-safety. *)
 type 'a t
 
-(** Create a fresh UUID *)
-val make_uuid : unit -> 'a t
+(** Create a UUID which may be guessable. This function is cheap and should be used
+    wherever possible. *)
+val insecure : unit -> 'a t
+
+(** Create a UUID which is unguessable. This function is expensive and should only
+    be used where necessary. *)
+val secure : unit -> 'a t
+
+(** Deprecated alias for {! Uuid.secure} *)
+(* val make_uuid : unit -> 'a t*)
 
 (** Create a UUID from a string. *)
 val of_string : string -> 'a t