From mboxrd@z Thu Jan 1 00:00:00 1970 From: Vincent Hanquez Subject: [PATCH 04/10] add uuid ocaml bindings Date: Tue, 9 Mar 2010 14:41:09 +0000 Message-ID: <1268145675-10375-5-git-send-email-vincent.hanquez@eu.citrix.com> References: <1268145675-10375-1-git-send-email-vincent.hanquez@eu.citrix.com> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="------------1.7.0" Return-path: In-Reply-To: <1268145675-10375-1-git-send-email-vincent.hanquez@eu.citrix.com> List-Unsubscribe: , List-Post: List-Help: List-Subscribe: , Sender: xen-devel-bounces@lists.xensource.com Errors-To: xen-devel-bounces@lists.xensource.com To: xen-devel@lists.xensource.com Cc: Vincent Hanquez List-Id: xen-devel@lists.xenproject.org --------------1.7.0 Content-Type: text/plain; charset="UTF-8"; format=fixed Content-Transfer-Encoding: quoted-printable Signed-off-by: Vincent Hanquez --- tools/ocaml/libs/uuid/META.in | 4 ++ tools/ocaml/libs/uuid/Makefile | 26 ++++++++++++ tools/ocaml/libs/uuid/uuid.ml | 88 ++++++++++++++++++++++++++++++++++= ++++++ tools/ocaml/libs/uuid/uuid.mli | 53 ++++++++++++++++++++++++ 4 files changed, 171 insertions(+), 0 deletions(-) create mode 100644 tools/ocaml/libs/uuid/META.in create mode 100644 tools/ocaml/libs/uuid/Makefile create mode 100644 tools/ocaml/libs/uuid/uuid.ml create mode 100644 tools/ocaml/libs/uuid/uuid.mli --------------1.7.0 Content-Type: text/x-patch; name="0004-add-uuid-ocaml-bindings.patch" Content-Disposition: attachment; filename="0004-add-uuid-ocaml-bindings.patch" Content-Transfer-Encoding: quoted-printable diff --git a/tools/ocaml/libs/uuid/META.in b/tools/ocaml/libs/uuid/META.i= n new file mode 100644 index 0000000..f33c980 --- /dev/null +++ b/tools/ocaml/libs/uuid/META.in @@ -0,0 +1,4 @@ +version =3D "@VERSION@" +description =3D "Uuid - universal identifer" +archive(byte) =3D "uuid.cma" +archive(native) =3D "uuid.cmxa" diff --git a/tools/ocaml/libs/uuid/Makefile b/tools/ocaml/libs/uuid/Makef= ile new file mode 100644 index 0000000..8ddb0e2 --- /dev/null +++ b/tools/ocaml/libs/uuid/Makefile @@ -0,0 +1,26 @@ +TOPLEVEL=3D../.. +include $(TOPLEVEL)/common.make + +OBJS =3D uuid +INTF =3D $(foreach obj, $(OBJS),$(obj).cmi) +LIBS =3D uuid.cma uuid.cmxa + +all: $(INTF) $(LIBS) $(PROGRAMS) + +bins: $(PROGRAMS) + +libs: $(LIBS) + +uuid_OBJS =3D $(OBJS) +OCAML_NOC_LIBRARY =3D uuid + +.PHONY: install +install: $(LIBS) META + ocamlfind install -destdir $(DESTDIR)$(shell ocamlfind printconf destdi= r) -ldconf ignore uuid META $(INTF) $(LIBS) *.a *.cmx + +.PHONY: uninstall +uninstall: + ocamlfind remove uuid + +include $(TOPLEVEL)/Makefile.rules + diff --git a/tools/ocaml/libs/uuid/uuid.ml b/tools/ocaml/libs/uuid/uuid.m= l new file mode 100644 index 0000000..7c25247 --- /dev/null +++ b/tools/ocaml/libs/uuid/uuid.ml @@ -0,0 +1,88 @@ +(* + * Copyright (C) 2006-2007 XenSource Ltd. + * Copyright (C) 2008 Citrix Ltd. + * Author Vincent Hanquez + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as publis= hed + * by the Free Software Foundation; version 2.1 only. with the special + * exception on linking described in file LICENSE. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + *) + +(** Type-safe UUIDs. *) + +(** Internally, a UUID is simply a string. *) +type 'a t =3D string + +type cookie =3D string + +let of_string s =3D s +let to_string s =3D s + +(* deprecated: we don't need to duplicate the uuid prefix/suffix *) +let uuid_of_string =3D of_string +let string_of_uuid =3D to_string + +let string_of_cookie s =3D s + +let cookie_of_string s =3D s + +(** FIXME: using /dev/random is too slow but using /dev/urandom is too + deterministic. *) +let dev_random =3D "/dev/urandom" + +let read_random n =3D=20 + let ic =3D open_in_bin dev_random in + try + let result =3D Array.init n (fun _ -> input_byte ic) in + close_in ic; + result + with e -> + close_in ic; + raise e + +let uuid_of_int_array uuid =3D + Printf.sprintf "%02x%02x%02x%02x-%02x%02x-%02x%02x-%02x%02x-%02x%02x%0= 2x%02x%02x%02x" + uuid.(0) uuid.(1) uuid.(2) uuid.(3) uuid.(4) uuid.(5) + 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() =3D uuid_of_int_array (read_random 16) + +(** Return a new random, big UUID (hopefully big and random enough to be + unguessable) *) +let make_cookie() =3D + let bytes =3D Array.to_list (read_random 64) in + String.concat "" (List.map (Printf.sprintf "%1x") bytes) +(* + let hexencode x =3D=20 + let nibble x =3D + char_of_int (if x < 10=20 + then int_of_char '0' + x + else int_of_char 'a' + (x - 10)) in + let result =3D String.make (String.length x * 2) ' ' in + for i =3D 0 to String.length x - 1 do + let byte =3D 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 =3D 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 =3D + try + let l =3D ref [] in + Scanf.sscanf s "%02x%02x%02x%02x-%02x%02x-%02x%02x-%02x%02x-%02x%02x= %02x%02x%02x%02x" + (fun a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 a10 a11 a12 a13 a14 a15 -> + l :=3D [ a0; a1; a2; a3; a4; a5; a6; a7; a8; a9; + a10; a11; a12; a13; a14; a15; ]); + Array.of_list !l + with _ -> invalid_arg "Uuid.int_array_of_uuid" diff --git a/tools/ocaml/libs/uuid/uuid.mli b/tools/ocaml/libs/uuid/uuid.= mli new file mode 100644 index 0000000..3b4a937 --- /dev/null +++ b/tools/ocaml/libs/uuid/uuid.mli @@ -0,0 +1,53 @@ +(* + * Copyright (C) 2006-2007 XenSource Ltd. + * Copyright (C) 2008 Citrix Ltd. + * Author Vincent Hanquez + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as publis= hed + * by the Free Software Foundation; version 2.1 only. with the special + * exception on linking described in file LICENSE. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * 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 + There is the additional constraint that current Xen tools use=20 + a particular format of UUID (the 16 byte variety generated by fresh = ()) +*) + +(** A 128-bit UUID referencing a value of type 'a. *) +type 'a t + +(** A 512-bit UUID. *) +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 --------------1.7.0 Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit Content-Disposition: inline _______________________________________________ Xen-devel mailing list Xen-devel@lists.xensource.com http://lists.xensource.com/xen-devel --------------1.7.0--