From mboxrd@z Thu Jan 1 00:00:00 1970 From: Ian Campbell Subject: [PATCH 4 of 7] ocaml: resynchronise uuid library with xen-api-libs.hg Date: Thu, 18 Nov 2010 10:50:36 +0000 Message-ID: <05cf9251ac48e7abeabd.1290077436@zakaz.uk.xensource.com> References: Mime-Version: 1.0 Content-Type: text/plain; charset="us-ascii" Content-Transfer-Encoding: 7bit Return-path: In-Reply-To: List-Unsubscribe: , List-Post: List-Help: List-Subscribe: , Sender: xen-api-bounces-GuqFBffKawuULHF6PoxzQEEOCMrvLtNR@public.gmane.org Errors-To: xen-api-bounces-GuqFBffKawuULHF6PoxzQEEOCMrvLtNR@public.gmane.org To: xen-devel-GuqFBffKawuULHF6PoxzQEEOCMrvLtNR@public.gmane.org, xen-api-GuqFBffKawuULHF6PoxzQEEOCMrvLtNR@public.gmane.org Cc: Ian Campbell List-Id: xen-devel@lists.xenproject.org # HG changeset patch # User root-bi+AKbBUZKY6gyzm1THtWbp2dZbC/Bob@public.gmane.org # Date 1290077186 18000 # Node ID 05cf9251ac48e7abeabdcf3c5a164b276bf393e9 # Parent 11cc3e6d573937508df213c0127c1dbbbd61af30 ocaml: resynchronise uuid library with xen-api-libs.hg Signed-off-by: Ian Campbell diff -r 11cc3e6d5739 -r 05cf9251ac48 tools/ocaml/libs/uuid/uuid.ml --- a/tools/ocaml/libs/uuid/uuid.ml Thu Nov 18 05:46:26 2010 -0500 +++ b/tools/ocaml/libs/uuid/uuid.ml Thu Nov 18 05:46:26 2010 -0500 @@ -1,7 +1,5 @@ (* - * Copyright (C) 2006-2007 XenSource Ltd. - * Copyright (C) 2008 Citrix Ltd. - * Author Vincent Hanquez + * Copyright (C) 2006-2009 Citrix Systems Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published @@ -14,9 +12,7 @@ * GNU Lesser General Public License for more details. *) -(** Type-safe UUIDs. *) - -(** Internally, a UUID is simply a string. *) +(* Internally, a UUID is simply a string. *) type 'a t = string type cookie = string @@ -24,6 +20,8 @@ type cookie = string let of_string s = s let to_string s = s +let null = "" + (* deprecated: we don't need to duplicate the uuid prefix/suffix *) let uuid_of_string = of_string let string_of_uuid = to_string @@ -32,12 +30,34 @@ let string_of_cookie s = s let cookie_of_string s = s -(** FIXME: using /dev/random is too slow but using /dev/urandom is too - deterministic. *) -let dev_random = "/dev/urandom" +let dev_random = "/dev/random" +let dev_urandom = "/dev/urandom" -let read_random n = - let ic = open_in_bin dev_random in +let rnd_array n = + let fstbyte i = 0xff land i in + let sndbyte i = fstbyte (i lsr 8) in + let thdbyte i = sndbyte (i lsr 8) in + let rec rnd_list n acc = match n with + | 0 -> acc + | 1 -> + let b = fstbyte (Random.bits ()) in + b :: acc + | 2 -> + let r = Random.bits () in + let b1 = fstbyte r in + let b2 = sndbyte r in + b1 :: b2 :: acc + | n -> + let r = Random.bits () in + let b1 = fstbyte r in + let b2 = sndbyte r in + let b3 = thdbyte r in + rnd_list (n - 3) (b1 :: b2 :: b3 :: acc) + in + Array.of_list (rnd_list n []) + +let read_array dev n = + let ic = open_in_bin dev in try let result = Array.init n (fun _ -> input_byte ic) in close_in ic; @@ -52,30 +72,14 @@ let uuid_of_int_array uuid = uuid.(6) uuid.(7) uuid.(8) uuid.(9) uuid.(10) uuid.(11) uuid.(12) uuid.(13) uuid.(14) uuid.(15) -(** Return a new random UUID *) -let make_uuid() = uuid_of_int_array (read_random 16) +let make_uuid_prng () = uuid_of_int_array (rnd_array 16) +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 -(** Return a new random, big UUID (hopefully big and random enough to be - unguessable) *) let make_cookie() = - let bytes = Array.to_list (read_random 64) in + let bytes = Array.to_list (read_array dev_urandom 64) in String.concat "" (List.map (Printf.sprintf "%1x") bytes) -(* - let hexencode x = - let nibble x = - char_of_int (if x < 10 - then int_of_char '0' + x - else int_of_char 'a' + (x - 10)) in - let result = String.make (String.length x * 2) ' ' in - for i = 0 to String.length x - 1 do - let byte = int_of_char x.[i] in - result.[i * 2 + 0] <- nibble((byte lsr 4) land 15); - result.[i * 2 + 1] <- nibble((byte lsr 0) land 15); - done; - result in - let n = 64 in - hexencode (String.concat "" (List.map (fun x -> String.make 1 (char_of_int x)) (Array.to_list (read_n_random_bytes n)))) -*) let int_array_of_uuid s = try @@ -86,3 +90,10 @@ let int_array_of_uuid s = a10; a11; a12; a13; a14; a15; ]); Array.of_list !l with _ -> invalid_arg "Uuid.int_array_of_uuid" + +let is_uuid str = + try + Scanf.sscanf str + "%02x%02x%02x%02x-%02x%02x-%02x%02x-%02x%02x-%02x%02x%02x%02x%02x%02x" + (fun _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ -> true) + with _ -> false diff -r 11cc3e6d5739 -r 05cf9251ac48 tools/ocaml/libs/uuid/uuid.mli --- a/tools/ocaml/libs/uuid/uuid.mli Thu Nov 18 05:46:26 2010 -0500 +++ b/tools/ocaml/libs/uuid/uuid.mli Thu Nov 18 05:46:26 2010 -0500 @@ -1,7 +1,5 @@ (* - * Copyright (C) 2006-2007 XenSource Ltd. - * Copyright (C) 2008 Citrix Ltd. - * Author Vincent Hanquez + * Copyright (C) 2006-2009 Citrix Systems Inc. * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as published @@ -13,41 +11,56 @@ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU Lesser General Public License for more details. *) - (** Type-safe UUIDs. Probably need to refactor this; UUIDs are used in two places: - 1. to uniquely name things across the cluster - 2. as secure session IDs + + 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 referencing a value of type 'a. *) +(** A 128-bit UUID. Using phantom types ('a) to achieve the requires type-safety. *) type 'a t -(** A 512-bit UUID. *) +(** 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 from a string. *) +val of_string : string -> 'a t + +(** Marshal a UUID to a string. *) +val to_string : 'a t -> string + +(** A null UUID, as if such a thing actually existed. It turns out to be + * useful though. *) +val null : 'a t + +(** Deprecated alias for {! Uuid.of_string} *) +val uuid_of_string : string -> 'a t + +(** Deprecated alias for {! Uuid.to_string} *) +val string_of_uuid : 'a t -> string + +(** Convert an array to a UUID. *) +val uuid_of_int_array : int array -> 'a t + +(** Convert a UUID to an array. *) +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 -(** Create a fresh (unique!) UUID *) -val make_uuid : unit -> 'a t - -(** Create a fresh secure (bigger and hopefully unguessable) UUID *) val make_cookie : unit -> cookie -(** Create a type-safe UUID. *) -val of_string : string -> 'a t - -(** Marshal a UUID to a (type-unsafe) string. *) -val to_string : 'a t -> string - -(* deprecated alias for previous one *) -val uuid_of_string : string -> 'a t -val string_of_uuid : 'a t -> string - val cookie_of_string : string -> cookie val string_of_cookie : cookie -> string - -val uuid_of_int_array : int array -> 'a t - -val int_array_of_uuid : 'a t -> int array