CA-85761: distinguish between unguessable Uuid.ts and Uuid.ts which are merely unique

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

@@ -15,8 +15,6 @@
 (* Internally, a UUID is simply a string. *)
 type 'a t = string
 
-type cookie = string
-
 let of_string s = s
 let to_string s = s
 
@@ -26,10 +24,6 @@ let null = ""
 let uuid_of_string = of_string
 let string_of_uuid = to_string
 
-let string_of_cookie s = s
-
-let cookie_of_string s = s
-
 let dev_random = "/dev/random"
 let dev_urandom = "/dev/urandom"
 
@@ -77,9 +71,8 @@ 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 make_cookie() =
-  let bytes = Array.to_list (read_array dev_urandom 64) in
-  String.concat "" (List.map (Printf.sprintf "%1x") bytes)
+let secure = make_uuid_urnd
+let insecure = make_uuid_prng
 
 let int_array_of_uuid s =
   try

uuid/uuid.mli

@@ -15,21 +15,21 @@
     Probably need to refactor this; UUIDs are used in two places:
     + to uniquely name things across the cluster
     + as secure session IDs
-
-    There is the additional constraint that current Xen tools use 
-    a particular format of UUID (the 16 byte variety generated by fresh ())
-
-	Also, cookies aren't UUIDs and should be put somewhere else.
 *)
 
 (** 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
-val make_uuid_prng : unit -> 'a t
-val make_uuid_urnd : unit -> 'a t
-val make_uuid_rnd : 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
@@ -55,12 +55,3 @@ val int_array_of_uuid : 'a t -> int array
 
 (** Check whether a string is a UUID. *)
 val is_uuid : string -> bool
-
-(** A 512-bit cookie. *)
-type cookie
-
-val make_cookie : unit -> cookie
-
-val cookie_of_string : string -> cookie
-
-val string_of_cookie : cookie -> string