* [PATCH 0 of 7] Ocaml related fixes/cleanups
@ 2011-09-29 21:17 Jon Ludlam
2011-09-29 21:17 ` [PATCH 1 of 7] [OCAML] Rename the ocamlfind packages Jon Ludlam
` (6 more replies)
0 siblings, 7 replies; 24+ messages in thread
From: Jon Ludlam @ 2011-09-29 21:17 UTC (permalink / raw)
To: xen-devel; +Cc: jonathan.ludlam
This patch series is mostly the same as that sent by Zheng Li some
time ago, but split into smaller chunks. It only relates to code
in the tools/ocaml subdir. The log and uuid packages are removed,
and most of the remaining packages renamed to avoid namespace
collisions when using ocamlfind. There are also some minor bugfixes
and a small cleanup of a makefile.
^ permalink raw reply [flat|nested] 24+ messages in thread* [PATCH 1 of 7] [OCAML] Rename the ocamlfind packages 2011-09-29 21:17 [PATCH 0 of 7] Ocaml related fixes/cleanups Jon Ludlam @ 2011-09-29 21:17 ` Jon Ludlam 2011-09-30 7:42 ` Ian Campbell 2011-09-29 21:17 ` [PATCH 2 of 7] [OCAML] Remove the uuid library Jon Ludlam ` (5 subsequent siblings) 6 siblings, 1 reply; 24+ messages in thread From: Jon Ludlam @ 2011-09-29 21:17 UTC (permalink / raw) To: xen-devel; +Cc: jonathan.ludlam ocamlfind does not support namespaces, so to avoid name clashes the ocamlfind package names have been changed. Note that this does not change the names of the actual modules themselves. xb becomes xenbus, xc becomes xenctrl, xl becomes xenlight, xs becomes xenstore, eventchn becomes xeneventchn. Signed-off-by: Jon Ludlam <jonathan.ludlam@eu.citrix.com> diff -r 7998217630e2 -r c5df5f625ee2 tools/ocaml/libs/eventchn/Makefile --- a/tools/ocaml/libs/eventchn/Makefile +++ b/tools/ocaml/libs/eventchn/Makefile @@ -24,12 +24,12 @@ .PHONY: install install: $(LIBS) META mkdir -p $(OCAMLDESTDIR) - ocamlfind remove -destdir $(OCAMLDESTDIR) eventchn - ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore eventchn META $(INTF) $(LIBS) *.a *.so *.cmx + ocamlfind remove -destdir $(OCAMLDESTDIR) xeneventchn + ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xeneventchn META $(INTF) $(LIBS) *.a *.so *.cmx .PHONY: uninstall uninstall: - ocamlfind remove -destdir $(OCAMLDESTDIR) eventchn + ocamlfind remove -destdir $(OCAMLDESTDIR) xeneventchn include $(TOPLEVEL)/Makefile.rules diff -r 7998217630e2 -r c5df5f625ee2 tools/ocaml/libs/xb/Makefile --- a/tools/ocaml/libs/xb/Makefile +++ b/tools/ocaml/libs/xb/Makefile @@ -36,11 +36,11 @@ .PHONY: install install: $(LIBS) META mkdir -p $(OCAMLDESTDIR) - ocamlfind remove -destdir $(OCAMLDESTDIR) xb - ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xb META $(INTF) $(LIBS) *.a *.so *.cmx + ocamlfind remove -destdir $(OCAMLDESTDIR) xenbus + ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xenbus META $(INTF) $(LIBS) *.a *.so *.cmx .PHONY: uninstall uninstall: - ocamlfind remove -destdir $(OCAMLDESTDIR) xb + ocamlfind remove -destdir $(OCAMLDESTDIR) xenbus include $(TOPLEVEL)/Makefile.rules diff -r 7998217630e2 -r c5df5f625ee2 tools/ocaml/libs/xc/Makefile --- a/tools/ocaml/libs/xc/Makefile +++ b/tools/ocaml/libs/xc/Makefile @@ -23,11 +23,11 @@ .PHONY: install install: $(LIBS) META mkdir -p $(OCAMLDESTDIR) - ocamlfind remove -destdir $(OCAMLDESTDIR) xc - ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xc META $(INTF) $(LIBS) *.a *.so *.cmx + ocamlfind remove -destdir $(OCAMLDESTDIR) xenctrl + ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xenctrl META $(INTF) $(LIBS) *.a *.so *.cmx .PHONY: uninstall uninstall: - ocamlfind remove -destdir $(OCAMLDESTDIR) xc + ocamlfind remove -destdir $(OCAMLDESTDIR) xenctrl include $(TOPLEVEL)/Makefile.rules diff -r 7998217630e2 -r c5df5f625ee2 tools/ocaml/libs/xl/Makefile --- a/tools/ocaml/libs/xl/Makefile +++ b/tools/ocaml/libs/xl/Makefile @@ -56,11 +56,11 @@ .PHONY: install install: $(LIBS) META mkdir -p $(OCAMLDESTDIR) - ocamlfind remove -destdir $(OCAMLDESTDIR) xl - ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xl META $(INTF) $(LIBS) *.a *.so *.cmx + ocamlfind remove -destdir $(OCAMLDESTDIR) xenlight + ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xenlight META $(INTF) $(LIBS) *.a *.so *.cmx .PHONY: uninstall uninstall: - ocamlfind remove -destdir $(OCAMLDESTDIR) xl + ocamlfind remove -destdir $(OCAMLDESTDIR) xenlight include $(TOPLEVEL)/Makefile.rules diff -r 7998217630e2 -r c5df5f625ee2 tools/ocaml/libs/xs/Makefile --- a/tools/ocaml/libs/xs/Makefile +++ b/tools/ocaml/libs/xs/Makefile @@ -26,12 +26,12 @@ .PHONY: install install: $(LIBS) META mkdir -p $(OCAMLDESTDIR) - ocamlfind remove -destdir $(OCAMLDESTDIR) xs - ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xs META $(INTF) xs.mli xst.mli xsraw.mli $(LIBS) *.a *.cmx + ocamlfind remove -destdir $(OCAMLDESTDIR) xenstore + ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xenstore META $(INTF) xs.mli xst.mli xsraw.mli $(LIBS) *.a *.cmx .PHONY: uninstall uninstall: - ocamlfind remove -destdir $(OCAMLDESTDIR) xs + ocamlfind remove -destdir $(OCAMLDESTDIR) xenstore include $(TOPLEVEL)/Makefile.rules ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: [PATCH 1 of 7] [OCAML] Rename the ocamlfind packages 2011-09-29 21:17 ` [PATCH 1 of 7] [OCAML] Rename the ocamlfind packages Jon Ludlam @ 2011-09-30 7:42 ` Ian Campbell 2011-09-30 12:19 ` Jonathan Ludlam 0 siblings, 1 reply; 24+ messages in thread From: Ian Campbell @ 2011-09-30 7:42 UTC (permalink / raw) To: Jon Ludlam; +Cc: xen-devel On Thu, 2011-09-29 at 22:17 +0100, Jon Ludlam wrote: > ocamlfind does not support namespaces, so to avoid > name clashes the ocamlfind package names have been > changed. Note that this does not change the names > of the actual modules themselves. So you do "ocamlfind xenbus" in your code but subsequently "import" xl.* (forgive my lack of actual ocaml syntax)? I'm happy with that if its acceptable practice in ocaml, but given it's "just" a sed invocation away should we bite the bullet and change the module name too? > xb becomes xenbus, xc becomes xenctrl, xl becomes xenlight, > xs becomes xenstore, eventchn becomes xeneventchn. The next patch removes uuid which by my count leaves just the mmap library, any plans for that one? > Signed-off-by: Jon Ludlam <jonathan.ludlam@eu.citrix.com> Acked-by: Ian Campbell <ian.campbell@citrix.com> > diff -r 7998217630e2 -r c5df5f625ee2 tools/ocaml/libs/eventchn/Makefile > --- a/tools/ocaml/libs/eventchn/Makefile > +++ b/tools/ocaml/libs/eventchn/Makefile > @@ -24,12 +24,12 @@ > .PHONY: install > install: $(LIBS) META > mkdir -p $(OCAMLDESTDIR) > - ocamlfind remove -destdir $(OCAMLDESTDIR) eventchn > - ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore eventchn META $(INTF) $(LIBS) *.a *.so *.cmx > + ocamlfind remove -destdir $(OCAMLDESTDIR) xeneventchn > + ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xeneventchn META $(INTF) $(LIBS) *.a *.so *.cmx > > .PHONY: uninstall > uninstall: > - ocamlfind remove -destdir $(OCAMLDESTDIR) eventchn > + ocamlfind remove -destdir $(OCAMLDESTDIR) xeneventchn > > include $(TOPLEVEL)/Makefile.rules > > diff -r 7998217630e2 -r c5df5f625ee2 tools/ocaml/libs/xb/Makefile > --- a/tools/ocaml/libs/xb/Makefile > +++ b/tools/ocaml/libs/xb/Makefile > @@ -36,11 +36,11 @@ > .PHONY: install > install: $(LIBS) META > mkdir -p $(OCAMLDESTDIR) > - ocamlfind remove -destdir $(OCAMLDESTDIR) xb > - ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xb META $(INTF) $(LIBS) *.a *.so *.cmx > + ocamlfind remove -destdir $(OCAMLDESTDIR) xenbus > + ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xenbus META $(INTF) $(LIBS) *.a *.so *.cmx > > .PHONY: uninstall > uninstall: > - ocamlfind remove -destdir $(OCAMLDESTDIR) xb > + ocamlfind remove -destdir $(OCAMLDESTDIR) xenbus > > include $(TOPLEVEL)/Makefile.rules > diff -r 7998217630e2 -r c5df5f625ee2 tools/ocaml/libs/xc/Makefile > --- a/tools/ocaml/libs/xc/Makefile > +++ b/tools/ocaml/libs/xc/Makefile > @@ -23,11 +23,11 @@ > .PHONY: install > install: $(LIBS) META > mkdir -p $(OCAMLDESTDIR) > - ocamlfind remove -destdir $(OCAMLDESTDIR) xc > - ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xc META $(INTF) $(LIBS) *.a *.so *.cmx > + ocamlfind remove -destdir $(OCAMLDESTDIR) xenctrl > + ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xenctrl META $(INTF) $(LIBS) *.a *.so *.cmx > > .PHONY: uninstall > uninstall: > - ocamlfind remove -destdir $(OCAMLDESTDIR) xc > + ocamlfind remove -destdir $(OCAMLDESTDIR) xenctrl > > include $(TOPLEVEL)/Makefile.rules > diff -r 7998217630e2 -r c5df5f625ee2 tools/ocaml/libs/xl/Makefile > --- a/tools/ocaml/libs/xl/Makefile > +++ b/tools/ocaml/libs/xl/Makefile > @@ -56,11 +56,11 @@ > .PHONY: install > install: $(LIBS) META > mkdir -p $(OCAMLDESTDIR) > - ocamlfind remove -destdir $(OCAMLDESTDIR) xl > - ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xl META $(INTF) $(LIBS) *.a *.so *.cmx > + ocamlfind remove -destdir $(OCAMLDESTDIR) xenlight > + ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xenlight META $(INTF) $(LIBS) *.a *.so *.cmx > > .PHONY: uninstall > uninstall: > - ocamlfind remove -destdir $(OCAMLDESTDIR) xl > + ocamlfind remove -destdir $(OCAMLDESTDIR) xenlight > > include $(TOPLEVEL)/Makefile.rules > diff -r 7998217630e2 -r c5df5f625ee2 tools/ocaml/libs/xs/Makefile > --- a/tools/ocaml/libs/xs/Makefile > +++ b/tools/ocaml/libs/xs/Makefile > @@ -26,12 +26,12 @@ > .PHONY: install > install: $(LIBS) META > mkdir -p $(OCAMLDESTDIR) > - ocamlfind remove -destdir $(OCAMLDESTDIR) xs > - ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xs META $(INTF) xs.mli xst.mli xsraw.mli $(LIBS) *.a *.cmx > + ocamlfind remove -destdir $(OCAMLDESTDIR) xenstore > + ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xenstore META $(INTF) xs.mli xst.mli xsraw.mli $(LIBS) *.a *.cmx > > .PHONY: uninstall > uninstall: > - ocamlfind remove -destdir $(OCAMLDESTDIR) xs > + ocamlfind remove -destdir $(OCAMLDESTDIR) xenstore > > include $(TOPLEVEL)/Makefile.rules > > > _______________________________________________ > Xen-devel mailing list > Xen-devel@lists.xensource.com > http://lists.xensource.com/xen-devel ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: [PATCH 1 of 7] [OCAML] Rename the ocamlfind packages 2011-09-30 7:42 ` Ian Campbell @ 2011-09-30 12:19 ` Jonathan Ludlam 2011-09-30 12:35 ` Ian Campbell 0 siblings, 1 reply; 24+ messages in thread From: Jonathan Ludlam @ 2011-09-30 12:19 UTC (permalink / raw) To: Ian Campbell; +Cc: xen-devel On 30 Sep 2011, at 08:42, Ian Campbell wrote: > On Thu, 2011-09-29 at 22:17 +0100, Jon Ludlam wrote: >> ocamlfind does not support namespaces, so to avoid >> name clashes the ocamlfind package names have been >> changed. Note that this does not change the names >> of the actual modules themselves. > > So you do "ocamlfind xenbus" in your code but subsequently "import" xl.* > (forgive my lack of actual ocaml syntax)? > > I'm happy with that if its acceptable practice in ocaml, but given it's > "just" a sed invocation away should we bite the bullet and change the > module name too? > It's not uncommon, e.g. the 'threads' package allows the use of the Thread, Mutex, Condition, Event and ThreadUnix modules, but not a 'Threads' one. Having said that, for the single module packages it would be slightly odd. The only thing that stopped me is that what I did involves a change in the makefiles of any ocaml project using the libs, whereas a renaming of the modules would require changing a lot more code. Being a bit ambivalent about the two approaches, I picked the one that was less noisy, though I'm willing to be persuaded otherwise. >> xb becomes xenbus, xc becomes xenctrl, xl becomes xenlight, >> xs becomes xenstore, eventchn becomes xeneventchn. > > The next patch removes uuid which by my count leaves just the mmap > library, any plans for that one? > We haven't quite figured out what to do with that one yet. It depends a little on whether anything else is using the module. More to follow :-) Jon ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: [PATCH 1 of 7] [OCAML] Rename the ocamlfind packages 2011-09-30 12:19 ` Jonathan Ludlam @ 2011-09-30 12:35 ` Ian Campbell 0 siblings, 0 replies; 24+ messages in thread From: Ian Campbell @ 2011-09-30 12:35 UTC (permalink / raw) To: Jonathan Ludlam; +Cc: xen-devel On Fri, 2011-09-30 at 13:19 +0100, Jonathan Ludlam wrote: > On 30 Sep 2011, at 08:42, Ian Campbell wrote: > > > On Thu, 2011-09-29 at 22:17 +0100, Jon Ludlam wrote: > >> ocamlfind does not support namespaces, so to avoid > >> name clashes the ocamlfind package names have been > >> changed. Note that this does not change the names > >> of the actual modules themselves. > > > > So you do "ocamlfind xenbus" in your code but subsequently "import" xl.* > > (forgive my lack of actual ocaml syntax)? > > > > I'm happy with that if its acceptable practice in ocaml, but given it's > > "just" a sed invocation away should we bite the bullet and change the > > module name too? > > > > It's not uncommon, e.g. the 'threads' package allows the use of the > Thread, Mutex, Condition, Event and ThreadUnix modules, but not a > 'Threads' one. Having said that, for the single module packages it > would be slightly odd. The only thing that stopped me is that what I > did involves a change in the makefiles of any ocaml project using the > libs, whereas a renaming of the modules would require changing a lot > more code. Being a bit ambivalent about the two approaches, I picked > the one that was less noisy, though I'm willing to be persuaded > otherwise. Thanks -- seems reasonable. I'm don't see any reason to try and persuade you any further ;-) > > >> xb becomes xenbus, xc becomes xenctrl, xl becomes xenlight, > >> xs becomes xenstore, eventchn becomes xeneventchn. > > > > The next patch removes uuid which by my count leaves just the mmap > > library, any plans for that one? > > > > We haven't quite figured out what to do with that one yet. It depends > a little on whether anything else is using the module. More to > follow :-) Great! ^ permalink raw reply [flat|nested] 24+ messages in thread
* [PATCH 2 of 7] [OCAML] Remove the uuid library 2011-09-29 21:17 [PATCH 0 of 7] Ocaml related fixes/cleanups Jon Ludlam 2011-09-29 21:17 ` [PATCH 1 of 7] [OCAML] Rename the ocamlfind packages Jon Ludlam @ 2011-09-29 21:17 ` Jon Ludlam 2011-09-30 7:45 ` Ian Campbell 2011-09-29 21:17 ` [PATCH 3 of 7] [OCAML] Remove log library from tools/ocaml/libs Jon Ludlam ` (4 subsequent siblings) 6 siblings, 1 reply; 24+ messages in thread From: Jon Ludlam @ 2011-09-29 21:17 UTC (permalink / raw) To: xen-devel; +Cc: jonathan.ludlam The library was only minimally used, and was really rather redundant. Signed-off-by: Zheng Li <zheng.li@eu.citrix.com> Acked-by: Jon Ludlam <jonathan.ludlam@eu.citrix.com> diff -r c5df5f625ee2 -r 42cdb34ec175 tools/ocaml/libs/Makefile --- a/tools/ocaml/libs/Makefile +++ b/tools/ocaml/libs/Makefile @@ -2,7 +2,7 @@ include $(XEN_ROOT)/tools/Rules.mk SUBDIRS= \ - uuid mmap \ + mmap \ log xc eventchn \ xb xs xl diff -r c5df5f625ee2 -r 42cdb34ec175 tools/ocaml/libs/uuid/META.in --- a/tools/ocaml/libs/uuid/META.in +++ /dev/null @@ -1,4 +0,0 @@ -version = "@VERSION@" -description = "Uuid - universal identifer" -archive(byte) = "uuid.cma" -archive(native) = "uuid.cmxa" diff -r c5df5f625ee2 -r 42cdb34ec175 tools/ocaml/libs/uuid/Makefile --- a/tools/ocaml/libs/uuid/Makefile +++ /dev/null @@ -1,29 +0,0 @@ -TOPLEVEL=$(CURDIR)/../.. -XEN_ROOT=$(TOPLEVEL)/../.. -include $(TOPLEVEL)/common.make - -OBJS = uuid -INTF = $(foreach obj, $(OBJS),$(obj).cmi) -LIBS = uuid.cma uuid.cmxa - -all: $(INTF) $(LIBS) $(PROGRAMS) - -bins: $(PROGRAMS) - -libs: $(LIBS) - -uuid_OBJS = $(OBJS) -OCAML_NOC_LIBRARY = uuid - -.PHONY: install -install: $(LIBS) META - mkdir -p $(OCAMLDESTDIR) - ocamlfind remove -destdir $(OCAMLDESTDIR) uuid - ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore uuid META $(INTF) $(LIBS) *.a *.cmx - -.PHONY: uninstall -uninstall: - ocamlfind remove -destdir $(OCAMLDESTDIR) uuid - -include $(TOPLEVEL)/Makefile.rules - diff -r c5df5f625ee2 -r 42cdb34ec175 tools/ocaml/libs/uuid/uuid.ml --- a/tools/ocaml/libs/uuid/uuid.ml +++ /dev/null @@ -1,100 +0,0 @@ -(* - * Copyright (C) 2006-2010 Citrix Systems Inc. - * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com> - * - * 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 - * 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. - *) - -(* Internally, a UUID is simply a string. *) -type 'a t = string - -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 - -let string_of_cookie s = s - -let cookie_of_string s = s - -let dev_random = "/dev/random" -let dev_urandom = "/dev/urandom" - -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; - result - with e -> - close_in ic; - raise e - -let uuid_of_int_array uuid = - Printf.sprintf "%02x%02x%02x%02x-%02x%02x-%02x%02x-%02x%02x-%02x%02x%02x%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) - -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 - -let make_cookie() = - let bytes = Array.to_list (read_array dev_urandom 64) in - String.concat "" (List.map (Printf.sprintf "%1x") bytes) - -let int_array_of_uuid s = - try - let l = 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 := [ 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" - -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 c5df5f625ee2 -r 42cdb34ec175 tools/ocaml/libs/uuid/uuid.mli --- a/tools/ocaml/libs/uuid/uuid.mli +++ /dev/null @@ -1,67 +0,0 @@ -(* - * Copyright (C) 2006-2010 Citrix Systems Inc. - * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com> - * - * 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 - * 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: - + 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 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 - -val make_cookie : unit -> cookie - -val cookie_of_string : string -> cookie - -val string_of_cookie : cookie -> string diff -r c5df5f625ee2 -r 42cdb34ec175 tools/ocaml/libs/xb/Makefile --- a/tools/ocaml/libs/xb/Makefile +++ b/tools/ocaml/libs/xb/Makefile @@ -31,7 +31,7 @@ %.mli: %.ml $(E) " MLI $@" - $(Q)$(OCAMLC) -i $< $o + $(Q)$(OCAMLC) $(OCAMLCFLAGS) -i $< $o .PHONY: install install: $(LIBS) META diff -r c5df5f625ee2 -r 42cdb34ec175 tools/ocaml/libs/xc/META.in --- a/tools/ocaml/libs/xc/META.in +++ b/tools/ocaml/libs/xc/META.in @@ -1,5 +1,5 @@ version = "@VERSION@" description = "Xen Control Interface" -requires = "mmap,uuid" +requires = "unix,mmap" archive(byte) = "xc.cma" archive(native) = "xc.cmxa" diff -r c5df5f625ee2 -r 42cdb34ec175 tools/ocaml/libs/xc/Makefile --- a/tools/ocaml/libs/xc/Makefile +++ b/tools/ocaml/libs/xc/Makefile @@ -3,7 +3,7 @@ include $(TOPLEVEL)/common.make CFLAGS += -I../mmap $(CFLAGS_libxenctrl) $(CFLAGS_libxenguest) -OCAMLINCLUDE += -I ../mmap -I ../uuid +OCAMLINCLUDE += -I ../mmap OBJS = xc INTF = xc.cmi diff -r c5df5f625ee2 -r 42cdb34ec175 tools/ocaml/libs/xc/xc.ml --- a/tools/ocaml/libs/xc/xc.ml +++ b/tools/ocaml/libs/xc/xc.ml @@ -118,14 +118,23 @@ external _domain_create: handle -> int32 -> domain_create_flag list -> int array -> domid = "stub_xc_domain_create" +let int_array_of_uuid_string s = + try + 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 -> + [| a0; a1; a2; a3; a4; a5; a6; a7; + a8; a9; a10; a11; a12; a13; a14; a15 |]) + with _ -> invalid_arg ("Xc.int_array_of_uuid_string: " ^ s) + let domain_create handle n flags uuid = - _domain_create handle n flags (Uuid.int_array_of_uuid uuid) + _domain_create handle n flags (int_array_of_uuid_string uuid) external _domain_sethandle: handle -> domid -> int array -> unit = "stub_xc_domain_sethandle" let domain_sethandle handle n uuid = - _domain_sethandle handle n (Uuid.int_array_of_uuid uuid) + _domain_sethandle handle n (int_array_of_uuid_string uuid) external domain_max_vcpus: handle -> domid -> int -> unit = "stub_xc_domain_max_vcpus" diff -r c5df5f625ee2 -r 42cdb34ec175 tools/ocaml/libs/xc/xc.mli --- a/tools/ocaml/libs/xc/xc.mli +++ b/tools/ocaml/libs/xc/xc.mli @@ -74,12 +74,8 @@ external is_fake : unit -> bool = "stub_xc_interface_is_fake" external interface_close : handle -> unit = "stub_xc_interface_close" val with_intf : (handle -> 'a) -> 'a -external _domain_create : handle -> int32 -> domain_create_flag list -> int array -> domid - = "stub_xc_domain_create" -val domain_create : handle -> int32 -> domain_create_flag list -> 'a Uuid.t -> domid -external _domain_sethandle : handle -> domid -> int array -> unit - = "stub_xc_domain_sethandle" -val domain_sethandle : handle -> domid -> 'a Uuid.t -> unit +val domain_create : handle -> int32 -> domain_create_flag list -> string -> domid +val domain_sethandle : handle -> domid -> string -> unit external domain_max_vcpus : handle -> domid -> int -> unit = "stub_xc_domain_max_vcpus" external domain_pause : handle -> domid -> unit = "stub_xc_domain_pause" diff -r c5df5f625ee2 -r 42cdb34ec175 tools/ocaml/xenstored/Makefile --- a/tools/ocaml/xenstored/Makefile +++ b/tools/ocaml/xenstored/Makefile @@ -5,7 +5,6 @@ OCAMLINCLUDE += \ -I $(OCAML_TOPLEVEL)/libs/log \ -I $(OCAML_TOPLEVEL)/libs/xb \ - -I $(OCAML_TOPLEVEL)/libs/uuid \ -I $(OCAML_TOPLEVEL)/libs/mmap \ -I $(OCAML_TOPLEVEL)/libs/xc \ -I $(OCAML_TOPLEVEL)/libs/eventchn @@ -34,7 +33,6 @@ INTF = symbol.cmi trie.cmi XENSTOREDLIBS = \ unix.cmxa \ - $(OCAML_TOPLEVEL)/libs/uuid/uuid.cmxa \ -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/mmap $(OCAML_TOPLEVEL)/libs/mmap/mmap.cmxa \ -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/log $(OCAML_TOPLEVEL)/libs/log/log.cmxa \ -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/eventchn $(OCAML_TOPLEVEL)/libs/eventchn/eventchn.cmxa \ ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: [PATCH 2 of 7] [OCAML] Remove the uuid library 2011-09-29 21:17 ` [PATCH 2 of 7] [OCAML] Remove the uuid library Jon Ludlam @ 2011-09-30 7:45 ` Ian Campbell 2011-09-30 12:21 ` Jonathan Ludlam 0 siblings, 1 reply; 24+ messages in thread From: Ian Campbell @ 2011-09-30 7:45 UTC (permalink / raw) To: Jon Ludlam; +Cc: xen-devel On Thu, 2011-09-29 at 22:17 +0100, Jon Ludlam wrote: > diff -r c5df5f625ee2 -r 42cdb34ec175 tools/ocaml/libs/xc/META.in > --- a/tools/ocaml/libs/xc/META.in > +++ b/tools/ocaml/libs/xc/META.in > @@ -1,5 +1,5 @@ > version = "@VERSION@" > description = "Xen Control Interface" > -requires = "mmap,uuid" > +requires = "unix,mmap" > archive(byte) = "xc.cma" > archive(native) = "xc.cmxa" Is the addition of unix here really part of removing uuid? I don't see any additional use of unix arising from the change. xc does seem to use unix already so the change is probably correct, just not really part of this change. I'd be happier if it went in separately, but: Acked-by: Ian Campbell <ian.campbell@citrix.com> > diff -r c5df5f625ee2 -r 42cdb34ec175 tools/ocaml/libs/xc/Makefile > --- a/tools/ocaml/libs/xc/Makefile > +++ b/tools/ocaml/libs/xc/Makefile > @@ -3,7 +3,7 @@ > include $(TOPLEVEL)/common.make > > CFLAGS += -I../mmap $(CFLAGS_libxenctrl) $(CFLAGS_libxenguest) > -OCAMLINCLUDE += -I ../mmap -I ../uuid > +OCAMLINCLUDE += -I ../mmap > > OBJS = xc > INTF = xc.cmi > diff -r c5df5f625ee2 -r 42cdb34ec175 tools/ocaml/libs/xc/xc.ml > --- a/tools/ocaml/libs/xc/xc.ml > +++ b/tools/ocaml/libs/xc/xc.ml > @@ -118,14 +118,23 @@ > external _domain_create: handle -> int32 -> domain_create_flag list -> int array -> domid > = "stub_xc_domain_create" > > +let int_array_of_uuid_string s = > + try > + 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 -> > + [| a0; a1; a2; a3; a4; a5; a6; a7; > + a8; a9; a10; a11; a12; a13; a14; a15 |]) > + with _ -> invalid_arg ("Xc.int_array_of_uuid_string: " ^ s) > + > let domain_create handle n flags uuid = > - _domain_create handle n flags (Uuid.int_array_of_uuid uuid) > + _domain_create handle n flags (int_array_of_uuid_string uuid) > > external _domain_sethandle: handle -> domid -> int array -> unit > = "stub_xc_domain_sethandle" > > let domain_sethandle handle n uuid = > - _domain_sethandle handle n (Uuid.int_array_of_uuid uuid) > + _domain_sethandle handle n (int_array_of_uuid_string uuid) > > external domain_max_vcpus: handle -> domid -> int -> unit > = "stub_xc_domain_max_vcpus" > diff -r c5df5f625ee2 -r 42cdb34ec175 tools/ocaml/libs/xc/xc.mli > --- a/tools/ocaml/libs/xc/xc.mli > +++ b/tools/ocaml/libs/xc/xc.mli > @@ -74,12 +74,8 @@ > external is_fake : unit -> bool = "stub_xc_interface_is_fake" > external interface_close : handle -> unit = "stub_xc_interface_close" > val with_intf : (handle -> 'a) -> 'a > -external _domain_create : handle -> int32 -> domain_create_flag list -> int array -> domid > - = "stub_xc_domain_create" > -val domain_create : handle -> int32 -> domain_create_flag list -> 'a Uuid.t -> domid > -external _domain_sethandle : handle -> domid -> int array -> unit > - = "stub_xc_domain_sethandle" > -val domain_sethandle : handle -> domid -> 'a Uuid.t -> unit > +val domain_create : handle -> int32 -> domain_create_flag list -> string -> domid > +val domain_sethandle : handle -> domid -> string -> unit > external domain_max_vcpus : handle -> domid -> int -> unit > = "stub_xc_domain_max_vcpus" > external domain_pause : handle -> domid -> unit = "stub_xc_domain_pause" > diff -r c5df5f625ee2 -r 42cdb34ec175 tools/ocaml/xenstored/Makefile > --- a/tools/ocaml/xenstored/Makefile > +++ b/tools/ocaml/xenstored/Makefile > @@ -5,7 +5,6 @@ > OCAMLINCLUDE += \ > -I $(OCAML_TOPLEVEL)/libs/log \ > -I $(OCAML_TOPLEVEL)/libs/xb \ > - -I $(OCAML_TOPLEVEL)/libs/uuid \ > -I $(OCAML_TOPLEVEL)/libs/mmap \ > -I $(OCAML_TOPLEVEL)/libs/xc \ > -I $(OCAML_TOPLEVEL)/libs/eventchn > @@ -34,7 +33,6 @@ > INTF = symbol.cmi trie.cmi > XENSTOREDLIBS = \ > unix.cmxa \ > - $(OCAML_TOPLEVEL)/libs/uuid/uuid.cmxa \ > -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/mmap $(OCAML_TOPLEVEL)/libs/mmap/mmap.cmxa \ > -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/log $(OCAML_TOPLEVEL)/libs/log/log.cmxa \ > -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/eventchn $(OCAML_TOPLEVEL)/libs/eventchn/eventchn.cmxa \ > > _______________________________________________ > Xen-devel mailing list > Xen-devel@lists.xensource.com > http://lists.xensource.com/xen-devel ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: [PATCH 2 of 7] [OCAML] Remove the uuid library 2011-09-30 7:45 ` Ian Campbell @ 2011-09-30 12:21 ` Jonathan Ludlam 2011-09-30 12:36 ` Ian Campbell 0 siblings, 1 reply; 24+ messages in thread From: Jonathan Ludlam @ 2011-09-30 12:21 UTC (permalink / raw) To: Ian Campbell; +Cc: xen-devel On 30 Sep 2011, at 08:45, Ian Campbell wrote: > On Thu, 2011-09-29 at 22:17 +0100, Jon Ludlam wrote: >> diff -r c5df5f625ee2 -r 42cdb34ec175 tools/ocaml/libs/xc/META.in >> --- a/tools/ocaml/libs/xc/META.in >> +++ b/tools/ocaml/libs/xc/META.in >> @@ -1,5 +1,5 @@ >> version = "@VERSION@" >> description = "Xen Control Interface" >> -requires = "mmap,uuid" >> +requires = "unix,mmap" >> archive(byte) = "xc.cma" >> archive(native) = "xc.cmxa" > > Is the addition of unix here really part of removing uuid? I don't see > any additional use of unix arising from the change. > No, you're correct - it's a bugfix in the dependencies. I can prepare it as a separate patch, if you want? > xc does seem to use unix already so the change is probably correct, just > not really part of this change. I'd be happier if it went in separately, > but: > > Acked-by: Ian Campbell <ian.campbell@citrix.com> ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: [PATCH 2 of 7] [OCAML] Remove the uuid library 2011-09-30 12:21 ` Jonathan Ludlam @ 2011-09-30 12:36 ` Ian Campbell 0 siblings, 0 replies; 24+ messages in thread From: Ian Campbell @ 2011-09-30 12:36 UTC (permalink / raw) To: Jonathan Ludlam; +Cc: xen-devel On Fri, 2011-09-30 at 13:21 +0100, Jonathan Ludlam wrote: > On 30 Sep 2011, at 08:45, Ian Campbell wrote: > > > On Thu, 2011-09-29 at 22:17 +0100, Jon Ludlam wrote: > >> diff -r c5df5f625ee2 -r 42cdb34ec175 tools/ocaml/libs/xc/META.in > >> --- a/tools/ocaml/libs/xc/META.in > >> +++ b/tools/ocaml/libs/xc/META.in > >> @@ -1,5 +1,5 @@ > >> version = "@VERSION@" > >> description = "Xen Control Interface" > >> -requires = "mmap,uuid" > >> +requires = "unix,mmap" > >> archive(byte) = "xc.cma" > >> archive(native) = "xc.cmxa" > > > > Is the addition of unix here really part of removing uuid? I don't see > > any additional use of unix arising from the change. > > > > No, you're correct - it's a bugfix in the dependencies. I can prepare it as a separate patch, if you want? I you need to resend the series anyway you may as well I suppose, but if not then its not a big deal for me at least. Ian. > > > xc does seem to use unix already so the change is probably correct, just > > not really part of this change. I'd be happier if it went in separately, > > but: > > > > Acked-by: Ian Campbell <ian.campbell@citrix.com> > ^ permalink raw reply [flat|nested] 24+ messages in thread
* [PATCH 3 of 7] [OCAML] Remove log library from tools/ocaml/libs 2011-09-29 21:17 [PATCH 0 of 7] Ocaml related fixes/cleanups Jon Ludlam 2011-09-29 21:17 ` [PATCH 1 of 7] [OCAML] Rename the ocamlfind packages Jon Ludlam 2011-09-29 21:17 ` [PATCH 2 of 7] [OCAML] Remove the uuid library Jon Ludlam @ 2011-09-29 21:17 ` Jon Ludlam 2011-09-30 7:46 ` Ian Campbell 2011-09-29 21:17 ` [PATCH 4 of 7] [OCAML] Fix a problem with ocaml xenstored Jon Ludlam ` (3 subsequent siblings) 6 siblings, 1 reply; 24+ messages in thread From: Jon Ludlam @ 2011-09-29 21:17 UTC (permalink / raw) To: xen-devel; +Cc: jonathan.ludlam The only user was oxenstored, which has had the relevant bits merged in. Signed-off-by: Zheng Li <zheng.li@eu.citrix.com> Acked-by: Jon Ludlam <jonathan.ludlam@eu.citrix.com> diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/libs/Makefile --- a/tools/ocaml/libs/Makefile +++ b/tools/ocaml/libs/Makefile @@ -3,7 +3,7 @@ SUBDIRS= \ mmap \ - log xc eventchn \ + xc eventchn \ xb xs xl .PHONY: all diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/libs/log/META.in --- a/tools/ocaml/libs/log/META.in +++ /dev/null @@ -1,5 +0,0 @@ -version = "@VERSION@" -description = "Log - logging library" -requires = "unix" -archive(byte) = "log.cma" -archive(native) = "log.cmxa" diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/libs/log/Makefile --- a/tools/ocaml/libs/log/Makefile +++ /dev/null @@ -1,44 +0,0 @@ -TOPLEVEL=$(CURDIR)/../.. -XEN_ROOT=$(TOPLEVEL)/../.. -include $(TOPLEVEL)/common.make - -OBJS = syslog log logs -INTF = log.cmi logs.cmi syslog.cmi -LIBS = log.cma log.cmxa - -all: $(INTF) $(LIBS) $(PROGRAMS) - -bins: $(PROGRAMS) - -libs: $(LIBS) - -log.cmxa: libsyslog_stubs.a $(foreach obj,$(OBJS),$(obj).cmx) - $(call mk-caml-lib-native, $@, -cclib -lsyslog_stubs, $(foreach obj,$(OBJS),$(obj).cmx)) - -log.cma: $(foreach obj,$(OBJS),$(obj).cmo) - $(call mk-caml-lib-bytecode, $@, -dllib dllsyslog_stubs.so -cclib -lsyslog_stubs, $(foreach obj,$(OBJS),$(obj).cmo)) - -syslog_stubs.a: syslog_stubs.o - $(call mk-caml-stubs, $@, $+) - -libsyslog_stubs.a: syslog_stubs.o - $(call mk-caml-lib-stubs, $@, $+) - -logs.mli : logs.ml - $(OCAMLC) -i $(OCAMLCFLAGS) $< > $@ - -syslog.mli : syslog.ml - $(OCAMLC) -i $< > $@ - -.PHONY: install -install: $(LIBS) META - mkdir -p $(OCAMLDESTDIR) - ocamlfind remove -destdir $(OCAMLDESTDIR) log - ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore log META $(INTF) $(LIBS) *.a *.so *.cmx - -.PHONY: uninstall -uninstall: - ocamlfind remove -destdir $(OCAMLDESTDIR) log - -include $(TOPLEVEL)/Makefile.rules - diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/libs/log/log.ml --- a/tools/ocaml/libs/log/log.ml +++ /dev/null @@ -1,258 +0,0 @@ -(* - * Copyright (C) 2006-2007 XenSource Ltd. - * Copyright (C) 2008 Citrix Ltd. - * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com> - * - * 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 - * 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. - *) - -open Printf - -exception Unknown_level of string - -type stream_type = Stderr | Stdout | File of string - -type stream_log = { - ty : stream_type; - channel : out_channel option ref; -} - -type level = Debug | Info | Warn | Error - -type output = - | Stream of stream_log - | String of string list ref - | Syslog of string - | Nil - -let int_of_level l = - match l with Debug -> 0 | Info -> 1 | Warn -> 2 | Error -> 3 - -let string_of_level l = - match l with Debug -> "debug" | Info -> "info" - | Warn -> "warn" | Error -> "error" - -let level_of_string s = - match s with - | "debug" -> Debug - | "info" -> Info - | "warn" -> Warn - | "error" -> Error - | _ -> raise (Unknown_level s) - -let mkdir_safe dir perm = - try Unix.mkdir dir perm with _ -> () - -let mkdir_rec dir perm = - let rec p_mkdir dir = - let p_name = Filename.dirname dir in - if p_name = "/" || p_name = "." then - () - else ( - p_mkdir p_name; - mkdir_safe dir perm - ) in - p_mkdir dir - -type t = { output: output; mutable level: level; } - -let make output level = { output = output; level = level; } - -let make_stream ty channel = - Stream {ty=ty; channel=ref channel; } - -(** open a syslog logger *) -let opensyslog k level = - make (Syslog k) level - -(** open a stderr logger *) -let openerr level = - if (Unix.stat "/dev/stderr").Unix.st_kind <> Unix.S_CHR then - failwith "/dev/stderr is not a valid character device"; - make (make_stream Stderr (Some (open_out "/dev/stderr"))) level - -let openout level = - if (Unix.stat "/dev/stdout").Unix.st_kind <> Unix.S_CHR then - failwith "/dev/stdout is not a valid character device"; - make (make_stream Stdout (Some (open_out "/dev/stdout"))) level - - -(** open a stream logger - returning the channel. *) -(* This needs to be separated from 'openfile' so we can reopen later *) -let doopenfile filename = - if Filename.is_relative filename then - None - else ( - try - mkdir_rec (Filename.dirname filename) 0o700; - Some (open_out_gen [ Open_append; Open_creat ] 0o600 filename) - with _ -> None - ) - -(** open a stream logger - returning the output type *) -let openfile filename level = - make (make_stream (File filename) (doopenfile filename)) level - -(** open a nil logger *) -let opennil () = - make Nil Error - -(** open a string logger *) -let openstring level = - make (String (ref [""])) level - -(** try to reopen a logger *) -let reopen t = - match t.output with - | Nil -> t - | Syslog k -> Syslog.close (); opensyslog k t.level - | Stream s -> ( - match (s.ty,!(s.channel)) with - | (File filename, Some c) -> close_out c; s.channel := (try doopenfile filename with _ -> None); t - | _ -> t) - | String _ -> t - -(** close a logger *) -let close t = - match t.output with - | Nil -> () - | Syslog k -> Syslog.close (); - | Stream s -> ( - match !(s.channel) with - | Some c -> close_out c; s.channel := None - | None -> ()) - | String _ -> () - -(** create a string representating the parameters of the logger *) -let string_of_logger t = - match t.output with - | Nil -> "nil" - | Syslog k -> sprintf "syslog:%s" k - | String _ -> "string" - | Stream s -> - begin - match s.ty with - | File f -> sprintf "file:%s" f - | Stderr -> "stderr" - | Stdout -> "stdout" - end - -(** parse a string to a logger *) -let logger_of_string s : t = - match s with - | "nil" -> opennil () - | "stderr" -> openerr Debug - | "stdout" -> openout Debug - | "string" -> openstring Debug - | _ -> - let split_in_2 s = - try - let i = String.index s ':' in - String.sub s 0 (i), - String.sub s (i + 1) (String.length s - i - 1) - with _ -> - failwith "logger format error: expecting string:string" - in - let k, s = split_in_2 s in - match k with - | "syslog" -> opensyslog s Debug - | "file" -> openfile s Debug - | _ -> failwith "unknown logger type" - -let validate s = - match s with - | "nil" -> () - | "stderr" -> () - | "stdout" -> () - | "string" -> () - | _ -> - let split_in_2 s = - try - let i = String.index s ':' in - String.sub s 0 (i), - String.sub s (i + 1) (String.length s - i - 1) - with _ -> - failwith "logger format error: expecting string:string" - in - let k, s = split_in_2 s in - match k with - | "syslog" -> () - | "file" -> ( - try - let st = Unix.stat s in - if st.Unix.st_kind <> Unix.S_REG then - failwith "logger file is a directory"; - () - with Unix.Unix_error (Unix.ENOENT, _, _) -> () - ) - | _ -> failwith "unknown logger" - -(** change a logger level to level *) -let set t level = t.level <- level - -let gettimestring () = - let time = Unix.gettimeofday () in - let tm = Unix.localtime time in - let msec = time -. (floor time) in - sprintf "%d%.2d%.2d %.2d:%.2d:%.2d.%.3d|" (1900 + tm.Unix.tm_year) - (tm.Unix.tm_mon + 1) tm.Unix.tm_mday - tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec - (int_of_float (1000.0 *. msec)) - -(*let extra_hook = ref (fun x -> x)*) - -let output t ?(key="") ?(extra="") priority (message: string) = - let construct_string withtime = - (*let key = if key = "" then [] else [ key ] in - let extra = if extra = "" then [] else [ extra ] in - let items = - (if withtime then [ gettimestring () ] else []) - @ [ sprintf "%5s" (string_of_level priority) ] @ extra @ key @ [ message ] in -(* let items = !extra_hook items in*) - String.concat " " items*) - Printf.sprintf "[%s%s|%s] %s" - (if withtime then gettimestring () else "") (string_of_level priority) extra message - in - (* Keep track of how much we write out to streams, so that we can *) - (* log-rotate at appropriate times *) - let write_to_stream stream = - let string = (construct_string true) in - try - fprintf stream "%s\n%!" string - with _ -> () (* Trap exception when we fail to write log *) - in - - if String.length message > 0 then - match t.output with - | Syslog k -> - let sys_prio = match priority with - | Debug -> Syslog.Debug - | Info -> Syslog.Info - | Warn -> Syslog.Warning - | Error -> Syslog.Err in - Syslog.log Syslog.Daemon sys_prio ((construct_string false) ^ "\n") - | Stream s -> ( - match !(s.channel) with - | Some c -> write_to_stream c - | None -> ()) - | Nil -> () - | String s -> (s := (construct_string true)::!s) - -let log t level (fmt: ('a, unit, string, unit) format4): 'a = - let b = (int_of_level t.level) <= (int_of_level level) in - (* ksprintf is the preferred name for kprintf, but the former - * is not available in OCaml 3.08.3 *) - Printf.kprintf (if b then output t level else (fun _ -> ())) fmt - -let debug t (fmt: ('a , unit, string, unit) format4) = log t Debug fmt -let info t (fmt: ('a , unit, string, unit) format4) = log t Info fmt -let warn t (fmt: ('a , unit, string, unit) format4) = log t Warn fmt -let error t (fmt: ('a , unit, string, unit) format4) = log t Error fmt diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/libs/log/log.mli --- a/tools/ocaml/libs/log/log.mli +++ /dev/null @@ -1,55 +0,0 @@ -(* - * Copyright (C) 2006-2007 XenSource Ltd. - * Copyright (C) 2008 Citrix Ltd. - * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com> - * - * 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 - * 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. - *) - -exception Unknown_level of string -type level = Debug | Info | Warn | Error - -type stream_type = Stderr | Stdout | File of string -type stream_log = { - ty : stream_type; - channel : out_channel option ref; -} -type output = - Stream of stream_log - | String of string list ref - | Syslog of string - | Nil -val int_of_level : level -> int -val string_of_level : level -> string -val level_of_string : string -> level -val mkdir_safe : string -> Unix.file_perm -> unit -val mkdir_rec : string -> Unix.file_perm -> unit -type t = { output : output; mutable level : level; } -val make : output -> level -> t -val opensyslog : string -> level -> t -val openerr : level -> t -val openout : level -> t -val openfile : string -> level -> t -val opennil : unit -> t -val openstring : level -> t -val reopen : t -> t -val close : t -> unit -val string_of_logger : t -> string -val logger_of_string : string -> t -val validate : string -> unit -val set : t -> level -> unit -val gettimestring : unit -> string -val output : t -> ?key:string -> ?extra:string -> level -> string -> unit -val log : t -> level -> ('a, unit, string, unit) format4 -> 'a -val debug : t -> ('a, unit, string, unit) format4 -> 'a -val info : t -> ('a, unit, string, unit) format4 -> 'a -val warn : t -> ('a, unit, string, unit) format4 -> 'a -val error : t -> ('a, unit, string, unit) format4 -> 'a diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/libs/log/logs.ml --- a/tools/ocaml/libs/log/logs.ml +++ /dev/null @@ -1,197 +0,0 @@ -(* - * Copyright (C) 2006-2007 XenSource Ltd. - * Copyright (C) 2008 Citrix Ltd. - * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com> - * - * 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 - * 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 keylogger = -{ - mutable debug: string list; - mutable info: string list; - mutable warn: string list; - mutable error: string list; - no_default: bool; -} - -(* map all logger strings into a logger *) -let __all_loggers = Hashtbl.create 10 - -(* default logger that everything that doesn't have a key in __lop_mapping get send *) -let __default_logger = { debug = []; info = []; warn = []; error = []; no_default = false } - -(* - * This describe the mapping between a name to a keylogger. - * a keylogger contains a list of logger string per level of debugging. - * Example: "xenops", debug -> [ "stderr"; "/var/log/xensource.log" ] - * "xapi", error -> [] - * "xapi", debug -> [ "/var/log/xensource.log" ] - * "xenops", info -> [ "syslog" ] - *) -let __log_mapping = Hashtbl.create 32 - -let get_or_open logstring = - if Hashtbl.mem __all_loggers logstring then - Hashtbl.find __all_loggers logstring - else - let t = Log.logger_of_string logstring in - Hashtbl.add __all_loggers logstring t; - t - -(** create a mapping entry for the key "name". - * all log level of key "name" default to "logger" logger. - * a sensible default is put "nil" as a logger and reopen a specific level to - * the logger you want to. - *) -let add key logger = - let kl = { - debug = logger; - info = logger; - warn = logger; - error = logger; - no_default = false; - } in - Hashtbl.add __log_mapping key kl - -let get_by_level keylog level = - match level with - | Log.Debug -> keylog.debug - | Log.Info -> keylog.info - | Log.Warn -> keylog.warn - | Log.Error -> keylog.error - -let set_by_level keylog level logger = - match level with - | Log.Debug -> keylog.debug <- logger - | Log.Info -> keylog.info <- logger - | Log.Warn -> keylog.warn <- logger - | Log.Error -> keylog.error <- logger - -(** set a specific key|level to the logger "logger" *) -let set key level logger = - if not (Hashtbl.mem __log_mapping key) then - add key []; - - let keylog = Hashtbl.find __log_mapping key in - set_by_level keylog level logger - -(** set default logger *) -let set_default level logger = - set_by_level __default_logger level logger - -(** append a logger to the list *) -let append key level logger = - if not (Hashtbl.mem __log_mapping key) then - add key []; - let keylog = Hashtbl.find __log_mapping key in - let loggers = get_by_level keylog level in - set_by_level keylog level (loggers @ [ logger ]) - -(** append a logger to the default list *) -let append_default level logger = - let loggers = get_by_level __default_logger level in - set_by_level __default_logger level (loggers @ [ logger ]) - -(** reopen all logger open *) -let reopen () = - Hashtbl.iter (fun k v -> - Hashtbl.replace __all_loggers k (Log.reopen v)) __all_loggers - -(** reclaim close all logger open that are not use by any other keys *) -let reclaim () = - let list_sort_uniq l = - let oldprev = ref "" and prev = ref "" in - List.fold_left (fun a k -> - oldprev := !prev; - prev := k; - if k = !oldprev then a else k :: a) [] - (List.sort compare l) - in - let flatten_keylogger v = - list_sort_uniq (v.debug @ v.info @ v.warn @ v.error) in - let oldkeys = Hashtbl.fold (fun k v a -> k :: a) __all_loggers [] in - let usedkeys = Hashtbl.fold (fun k v a -> - (flatten_keylogger v) @ a) - __log_mapping (flatten_keylogger __default_logger) in - let usedkeys = list_sort_uniq usedkeys in - - List.iter (fun k -> - if not (List.mem k usedkeys) then ( - begin try - Log.close (Hashtbl.find __all_loggers k) - with - Not_found -> () - end; - Hashtbl.remove __all_loggers k - )) oldkeys - -(** clear a specific key|level *) -let clear key level = - try - let keylog = Hashtbl.find __log_mapping key in - set_by_level keylog level []; - reclaim () - with Not_found -> - () - -(** clear a specific default level *) -let clear_default level = - set_default level []; - reclaim () - -(** reset all the loggers to the specified logger *) -let reset_all logger = - Hashtbl.clear __log_mapping; - set_default Log.Debug logger; - set_default Log.Warn logger; - set_default Log.Error logger; - set_default Log.Info logger; - reclaim () - -(** log a fmt message to the key|level logger specified in the log mapping. - * if the logger doesn't exist, assume nil logger. - *) -let log key level ?(extra="") (fmt: ('a, unit, string, unit) format4): 'a = - let keylog = - if Hashtbl.mem __log_mapping key then - let keylog = Hashtbl.find __log_mapping key in - if keylog.no_default = false && - get_by_level keylog level = [] then - __default_logger - else - keylog - else - __default_logger in - let loggers = get_by_level keylog level in - match loggers with - | [] -> Printf.kprintf ignore fmt - | _ -> - let l = List.fold_left (fun acc logger -> - try get_or_open logger :: acc - with _ -> acc - ) [] loggers in - let l = List.rev l in - - (* ksprintf is the preferred name for kprintf, but the former - * is not available in OCaml 3.08.3 *) - Printf.kprintf (fun s -> - List.iter (fun t -> Log.output t ~key ~extra level s) l) fmt - -(* define some convenience functions *) -let debug t ?extra (fmt: ('a , unit, string, unit) format4) = - log t Log.Debug ?extra fmt -let info t ?extra (fmt: ('a , unit, string, unit) format4) = - log t Log.Info ?extra fmt -let warn t ?extra (fmt: ('a , unit, string, unit) format4) = - log t Log.Warn ?extra fmt -let error t ?extra (fmt: ('a , unit, string, unit) format4) = - log t Log.Error ?extra fmt diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/libs/log/logs.mli --- a/tools/ocaml/libs/log/logs.mli +++ /dev/null @@ -1,46 +0,0 @@ -(* - * Copyright (C) 2006-2007 XenSource Ltd. - * Copyright (C) 2008 Citrix Ltd. - * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com> - * - * 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 - * 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 keylogger = { - mutable debug : string list; - mutable info : string list; - mutable warn : string list; - mutable error : string list; - no_default : bool; -} -val __all_loggers : (string, Log.t) Hashtbl.t -val __default_logger : keylogger -val __log_mapping : (string, keylogger) Hashtbl.t -val get_or_open : string -> Log.t -val add : string -> string list -> unit -val get_by_level : keylogger -> Log.level -> string list -val set_by_level : keylogger -> Log.level -> string list -> unit -val set : string -> Log.level -> string list -> unit -val set_default : Log.level -> string list -> unit -val append : string -> Log.level -> string -> unit -val append_default : Log.level -> string -> unit -val reopen : unit -> unit -val reclaim : unit -> unit -val clear : string -> Log.level -> unit -val clear_default : Log.level -> unit -val reset_all : string list -> unit -val log : - string -> - Log.level -> ?extra:string -> ('a, unit, string, unit) format4 -> 'a -val debug : string -> ?extra:string -> ('a, unit, string, unit) format4 -> 'a -val info : string -> ?extra:string -> ('a, unit, string, unit) format4 -> 'a -val warn : string -> ?extra:string -> ('a, unit, string, unit) format4 -> 'a -val error : string -> ?extra:string -> ('a, unit, string, unit) format4 -> 'a diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/libs/log/syslog.ml --- a/tools/ocaml/libs/log/syslog.ml +++ /dev/null @@ -1,26 +0,0 @@ -(* - * Copyright (C) 2006-2007 XenSource Ltd. - * Copyright (C) 2008 Citrix Ltd. - * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com> - * - * 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 - * 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 level = Emerg | Alert | Crit | Err | Warning | Notice | Info | Debug -type options = Cons | Ndelay | Nowait | Odelay | Perror | Pid -type facility = Auth | Authpriv | Cron | Daemon | Ftp | Kern - | Local0 | Local1 | Local2 | Local3 - | Local4 | Local5 | Local6 | Local7 - | Lpr | Mail | News | Syslog | User | Uucp - -(* external init : string -> options list -> facility -> unit = "stub_openlog" *) -external log : facility -> level -> string -> unit = "stub_syslog" -external close : unit -> unit = "stub_closelog" diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/libs/log/syslog.mli --- a/tools/ocaml/libs/log/syslog.mli +++ /dev/null @@ -1,41 +0,0 @@ -(* - * Copyright (C) 2006-2007 XenSource Ltd. - * Copyright (C) 2008 Citrix Ltd. - * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com> - * - * 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 - * 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 level = Emerg | Alert | Crit | Err | Warning | Notice | Info | Debug -type options = Cons | Ndelay | Nowait | Odelay | Perror | Pid -type facility = - Auth - | Authpriv - | Cron - | Daemon - | Ftp - | Kern - | Local0 - | Local1 - | Local2 - | Local3 - | Local4 - | Local5 - | Local6 - | Local7 - | Lpr - | Mail - | News - | Syslog - | User - | Uucp -external log : facility -> level -> string -> unit = "stub_syslog" -external close : unit -> unit = "stub_closelog" diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/libs/log/syslog_stubs.c --- a/tools/ocaml/libs/log/syslog_stubs.c +++ /dev/null @@ -1,75 +0,0 @@ -/* - * Copyright (C) 2006-2007 XenSource Ltd. - * Copyright (C) 2008 Citrix Ltd. - * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com> - * - * 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 - * 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. - */ - -#include <syslog.h> -#include <caml/mlvalues.h> -#include <caml/memory.h> -#include <caml/alloc.h> -#include <caml/custom.h> - -static int __syslog_level_table[] = { - LOG_EMERG, LOG_ALERT, LOG_CRIT, LOG_ERR, LOG_WARNING, - LOG_NOTICE, LOG_INFO, LOG_DEBUG -}; - -/* -static int __syslog_options_table[] = { - LOG_CONS, LOG_NDELAY, LOG_NOWAIT, LOG_ODELAY, LOG_PERROR, LOG_PID -}; -*/ - -static int __syslog_facility_table[] = { - LOG_AUTH, LOG_AUTHPRIV, LOG_CRON, LOG_DAEMON, LOG_FTP, LOG_KERN, - LOG_LOCAL0, LOG_LOCAL1, LOG_LOCAL2, LOG_LOCAL3, - LOG_LOCAL4, LOG_LOCAL5, LOG_LOCAL6, LOG_LOCAL7, - LOG_LPR | LOG_MAIL | LOG_NEWS | LOG_SYSLOG | LOG_USER | LOG_UUCP -}; - -/* According to the openlog manpage the 'openlog' call may take a reference - to the 'ident' string and keep it long-term. This means we cannot just pass in - an ocaml string which is under the control of the GC. Since we aren't actually - calling this function we can just comment it out for the time-being. */ -/* -value stub_openlog(value ident, value option, value facility) -{ - CAMLparam3(ident, option, facility); - int c_option; - int c_facility; - - c_option = caml_convert_flag_list(option, __syslog_options_table); - c_facility = __syslog_facility_table[Int_val(facility)]; - openlog(String_val(ident), c_option, c_facility); - CAMLreturn(Val_unit); -} -*/ - -value stub_syslog(value facility, value level, value msg) -{ - CAMLparam3(facility, level, msg); - int c_facility; - - c_facility = __syslog_facility_table[Int_val(facility)] - | __syslog_level_table[Int_val(level)]; - syslog(c_facility, "%s", String_val(msg)); - CAMLreturn(Val_unit); -} - -value stub_closelog(value unit) -{ - CAMLparam1(unit); - closelog(); - CAMLreturn(Val_unit); -} diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/xenstored/Makefile --- a/tools/ocaml/xenstored/Makefile +++ b/tools/ocaml/xenstored/Makefile @@ -3,7 +3,6 @@ include $(OCAML_TOPLEVEL)/common.make OCAMLINCLUDE += \ - -I $(OCAML_TOPLEVEL)/libs/log \ -I $(OCAML_TOPLEVEL)/libs/xb \ -I $(OCAML_TOPLEVEL)/libs/mmap \ -I $(OCAML_TOPLEVEL)/libs/xc \ @@ -34,7 +33,6 @@ XENSTOREDLIBS = \ unix.cmxa \ -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/mmap $(OCAML_TOPLEVEL)/libs/mmap/mmap.cmxa \ - -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/log $(OCAML_TOPLEVEL)/libs/log/log.cmxa \ -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/eventchn $(OCAML_TOPLEVEL)/libs/eventchn/eventchn.cmxa \ -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xc $(OCAML_TOPLEVEL)/libs/xc/xc.cmxa \ -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xb $(OCAML_TOPLEVEL)/libs/xb/xb.cmxa \ diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/xenstored/connection.ml --- a/tools/ocaml/xenstored/connection.ml +++ b/tools/ocaml/xenstored/connection.ml @@ -232,3 +232,8 @@ Printf.fprintf chan "watch,%d,%s,%s\n" domid (Utils.hexify path) (Utils.hexify token) ) (list_watches con); | None -> () + +let debug con = + let domid = get_domstr con in + let watches = List.map (fun (path, token) -> Printf.sprintf "watch %s: %s %s\n" domid path token) (list_watches con) in + String.concat "" watches diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/xenstored/connections.ml --- a/tools/ocaml/xenstored/connections.ml +++ b/tools/ocaml/xenstored/connections.ml @@ -15,7 +15,7 @@ * GNU Lesser General Public License for more details. *) -let debug fmt = Logs.debug "general" fmt +let debug fmt = Logging.debug "connections" fmt type t = { mutable anonymous: Connection.t list; @@ -165,3 +165,8 @@ ); (List.length cons.anonymous, !nb_ops_anon, !nb_watchs_anon, Hashtbl.length cons.domains, !nb_ops_dom, !nb_watchs_dom) + +let debug cons = + let anonymous = List.map Connection.debug cons.anonymous in + let domains = Hashtbl.fold (fun _ con accu -> Connection.debug con :: accu) cons.domains [] in + String.concat "" (domains @ anonymous) diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/xenstored/disk.ml --- a/tools/ocaml/xenstored/disk.ml +++ b/tools/ocaml/xenstored/disk.ml @@ -17,7 +17,7 @@ let enable = ref false let xs_daemon_database = "/var/run/xenstored/db" -let error = Logs.error "general" +let error fmt = Logging.error "disk" fmt (* unescape utils *) exception Bad_escape diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/xenstored/domain.ml --- a/tools/ocaml/xenstored/domain.ml +++ b/tools/ocaml/xenstored/domain.ml @@ -16,7 +16,7 @@ open Printf -let debug fmt = Logs.debug "general" fmt +let debug fmt = Logging.debug "domain" fmt type t = { diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/xenstored/domains.ml --- a/tools/ocaml/xenstored/domains.ml +++ b/tools/ocaml/xenstored/domains.ml @@ -14,6 +14,8 @@ * GNU Lesser General Public License for more details. *) +let debug fmt = Logging.debug "domains" fmt + type domains = { eventchn: Event.t; table: (Xc.domid, Domain.t) Hashtbl.t; @@ -35,7 +37,7 @@ try let info = Xc.domain_getinfo xc id in if info.Xc.shutdown || info.Xc.dying then ( - Logs.debug "general" "Domain %u died (dying=%b, shutdown %b -- code %d)" + debug "Domain %u died (dying=%b, shutdown %b -- code %d)" id info.Xc.dying info.Xc.shutdown info.Xc.shutdown_code; if info.Xc.dying then dead_dom := id :: !dead_dom @@ -43,7 +45,7 @@ notify := true; ) with Xc.Error _ -> - Logs.debug "general" "Domain %u died -- no domain info" id; + debug "Domain %u died -- no domain info" id; dead_dom := id :: !dead_dom; ) doms.table; List.iter (fun id -> diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/xenstored/logging.ml --- a/tools/ocaml/xenstored/logging.ml +++ b/tools/ocaml/xenstored/logging.ml @@ -17,21 +17,122 @@ open Stdext open Printf -let error fmt = Logs.error "general" fmt -let info fmt = Logs.info "general" fmt -let debug fmt = Logs.debug "general" fmt -let access_log_file = ref "/var/log/xenstored-access.log" -let access_log_nb_files = ref 20 -let access_log_nb_lines = ref 13215 -let activate_access_log = ref true +(* Logger common *) -(* maximal size of the lines in xenstore-acces.log file *) -let line_size = 180 +type logger = + { stop: unit -> unit; + restart: unit -> unit; + rotate: unit -> unit; + write: 'a. ('a, unit, string, unit) format4 -> 'a } -let log_read_ops = ref false -let log_transaction_ops = ref false -let log_special_ops = ref false +let truncate_line nb_chars line = + if String.length line > nb_chars - 1 then + let len = max (nb_chars - 1) 2 in + let dst_line = String.create len in + String.blit line 0 dst_line 0 (len - 2); + dst_line.[len-2] <- '.'; + dst_line.[len-1] <- '.'; + dst_line + else line + +let log_rotate ref_ch log_file log_nb_files = + let file n = sprintf "%s.%i" log_file n in + let log_files = + let rec aux accu n = + if n >= log_nb_files then accu + else + if n = 1 && Sys.file_exists log_file + then aux [log_file,1] 2 + else + let file = file (n-1) in + if Sys.file_exists file then + aux ((file, n) :: accu) (n+1) + else accu in + aux [] 1 in + List.iter (fun (f, n) -> Unix.rename f (file n)) log_files; + close_out !ref_ch; + ref_ch := open_out log_file + +let make_logger log_file log_nb_files log_nb_lines log_nb_chars post_rotate = + let channel = ref (open_out_gen [Open_append; Open_creat] 0o644 log_file) in + let counter = ref 0 in + let stop() = + try flush !channel; close_out !channel + with _ -> () in + let restart() = + stop(); + channel := open_out_gen [Open_append; Open_creat] 0o644 log_file in + let rotate() = + log_rotate channel log_file log_nb_files; + (post_rotate (): unit); + counter := 0 in + let output s = + let s = if log_nb_chars > 0 then truncate_line log_nb_chars s else s in + let s = s ^ "\n" in + output_string !channel s; + flush !channel; + incr counter; + if !counter > log_nb_lines then rotate() in + { stop=stop; restart=restart; rotate=rotate; write = fun fmt -> Printf.ksprintf output fmt } + + +(* Xenstored logger *) + +exception Unknown_level of string + +type level = Debug | Info | Warn | Error | Null + +let int_of_level = function + | Debug -> 0 | Info -> 1 | Warn -> 2 + | Error -> 3 | Null -> max_int + +let string_of_level = function + | Debug -> "debug" | Info -> "info" | Warn -> "warn" + | Error -> "error" | Null -> "null" + +let level_of_string = function + | "debug" -> Debug | "info" -> Info | "warn" -> Warn + | "error" -> Error | "null" -> Null | s -> raise (Unknown_level s) + +let string_of_date () = + let time = Unix.gettimeofday () in + let tm = Unix.gmtime time in + let msec = time -. (floor time) in + sprintf "%d%.2d%.2dT%.2d:%.2d:%.2d.%.3dZ" + (1900 + tm.Unix.tm_year) (tm.Unix.tm_mon + 1) tm.Unix.tm_mday + tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec + (int_of_float (1000.0 *. msec)) + +let xenstored_log_file = ref "/var/log/xenstored.log" +let xenstored_log_level = ref Null +let xenstored_log_nb_files = ref 10 +let xenstored_log_nb_lines = ref 13215 +let xenstored_log_nb_chars = ref (-1) +let xenstored_logger = ref (None: logger option) + +let init_xenstored_log () = + if !xenstored_log_level <> Null && !xenstored_log_nb_files > 0 then + let logger = + make_logger + !xenstored_log_file !xenstored_log_nb_files !xenstored_log_nb_lines + !xenstored_log_nb_chars ignore in + xenstored_logger := Some logger + +let xenstored_logging level key (fmt: (_,_,_,_) format4) = + match !xenstored_logger with + | Some logger when int_of_level level >= int_of_level !xenstored_log_level -> + let date = string_of_date() in + let level = string_of_level level in + logger.write ("[%s|%5s|%s] " ^^ fmt) date level key + | _ -> Printf.ksprintf ignore fmt + +let debug key = xenstored_logging Debug key +let info key = xenstored_logging Info key +let warn key = xenstored_logging Warn key +let error key = xenstored_logging Error key + +(* Access logger *) type access_type = | Coalesce @@ -41,38 +142,10 @@ | Endconn | XbOp of Xb.Op.operation -type access = - { - fd: out_channel ref; - counter: int ref; - write: tid:int -> con:string -> ?data:string -> access_type -> unit; - } - -let string_of_date () = - let time = Unix.gettimeofday () in - let tm = Unix.localtime time in - let msec = time -. (floor time) in - sprintf "%d%.2d%.2d %.2d:%.2d:%.2d.%.3d" (1900 + tm.Unix.tm_year) - (tm.Unix.tm_mon + 1) - tm.Unix.tm_mday - tm.Unix.tm_hour - tm.Unix.tm_min - tm.Unix.tm_sec - (int_of_float (1000.0 *. msec)) - -let fill_with_space n s = - if String.length s < n - then - let r = String.make n ' ' in - String.blit s 0 r 0 (String.length s); - r - else - s - let string_of_tid ~con tid = if tid = 0 - then fill_with_space 12 (sprintf "%s" con) - else fill_with_space 12 (sprintf "%s.%i" con tid) + then sprintf "%-12s" con + else sprintf "%-12s" (sprintf "%s.%i" con tid) let string_of_access_type = function | Coalesce -> "coalesce " @@ -109,41 +182,9 @@ | Xb.Op.Error -> "error " | Xb.Op.Watchevent -> "w event " - + (* | x -> Xb.Op.to_string x - -let file_exists file = - try - Unix.close (Unix.openfile file [Unix.O_RDONLY] 0o644); - true - with _ -> - false - -let log_rotate fd = - let file n = sprintf "%s.%i" !access_log_file n in - let log_files = - let rec aux accu n = - if n >= !access_log_nb_files - then accu - else if n = 1 && file_exists !access_log_file - then aux [!access_log_file,1] 2 - else - let file = file (n-1) in - if file_exists file - then aux ((file,n) :: accu) (n+1) - else accu - in - aux [] 1 - in - let rec rename = function - | (f,n) :: t when n < !access_log_nb_files -> - Unix.rename f (file n); - rename t - | _ -> () - in - rename log_files; - close_out !fd; - fd := open_out !access_log_file + *) let sanitize_data data = let data = String.copy data in @@ -154,86 +195,67 @@ done; String.escaped data -let make save_to_disk = - let fd = ref (open_out_gen [Open_append; Open_creat] 0o644 !access_log_file) in - let counter = ref 0 in - { - fd = fd; - counter = counter; - write = - if not !activate_access_log || !access_log_nb_files = 0 - then begin fun ~tid ~con ?data _ -> () end - else fun ~tid ~con ?(data="") access_type -> - let s = Printf.sprintf "[%s] %s %s %s\n" (string_of_date()) (string_of_tid ~con tid) - (string_of_access_type access_type) (sanitize_data data) in - let s = - if String.length s > line_size - then begin - let s = String.sub s 0 line_size in - s.[line_size-3] <- '.'; - s.[line_size-2] <- '.'; - s.[line_size-1] <- '\n'; - s - end else - s - in - incr counter; - output_string !fd s; - flush !fd; - if !counter > !access_log_nb_lines - then begin - log_rotate fd; - save_to_disk (); - counter := 0; - end - } +let activate_access_log = ref true +let access_log_file = ref "/var/log/xenstored-access.log" +let access_log_nb_files = ref 20 +let access_log_nb_lines = ref 13215 +let access_log_nb_chars = ref 180 +let access_log_read_ops = ref false +let access_log_transaction_ops = ref false +let access_log_special_ops = ref false +let access_logger = ref None -let access : (access option) ref = ref None -let init aal save_to_disk = - activate_access_log := aal; - access := Some (make save_to_disk) +let init_access_log post_rotate = + if !access_log_nb_files > 0 then + let logger = + make_logger + !access_log_file !access_log_nb_files !access_log_nb_lines + !access_log_nb_chars post_rotate in + access_logger := Some logger -let write_access_log ~con ~tid ?data access_type = +let access_logging ~con ~tid ?(data="") access_type = try - maybe (fun a -> a.write access_type ~con ~tid ?data) !access + maybe + (fun logger -> + let date = string_of_date() in + let tid = string_of_tid ~con tid in + let access_type = string_of_access_type access_type in + let data = sanitize_data data in + logger.write "[%s] %s %s %s" date tid access_type data) + !access_logger with _ -> () -let new_connection = write_access_log Newconn -let end_connection = write_access_log Endconn +let new_connection = access_logging Newconn +let end_connection = access_logging Endconn let read_coalesce ~tid ~con data = - if !log_read_ops - then write_access_log Coalesce ~tid ~con ~data:("read "^data) -let write_coalesce data = write_access_log Coalesce ~data:("write "^data) -let conflict = write_access_log Conflict -let commit = write_access_log Commit + if !access_log_read_ops + then access_logging Coalesce ~tid ~con ~data:("read "^data) +let write_coalesce data = access_logging Coalesce ~data:("write "^data) +let conflict = access_logging Conflict +let commit = access_logging Commit let xb_op ~tid ~con ~ty data = - let print = - match ty with - | Xb.Op.Read | Xb.Op.Directory | Xb.Op.Getperms -> !log_read_ops + let print = match ty with + | Xb.Op.Read | Xb.Op.Directory | Xb.Op.Getperms -> !access_log_read_ops | Xb.Op.Transaction_start | Xb.Op.Transaction_end -> false (* transactions are managed below *) | Xb.Op.Introduce | Xb.Op.Release | Xb.Op.Getdomainpath | Xb.Op.Isintroduced | Xb.Op.Resume -> - !log_special_ops - | _ -> true - in - if print - then write_access_log ~tid ~con ~data (XbOp ty) + !access_log_special_ops + | _ -> true in + if print then access_logging ~tid ~con ~data (XbOp ty) let start_transaction ~tid ~con = - if !log_transaction_ops && tid <> 0 - then write_access_log ~tid ~con (XbOp Xb.Op.Transaction_start) + if !access_log_transaction_ops && tid <> 0 + then access_logging ~tid ~con (XbOp Xb.Op.Transaction_start) let end_transaction ~tid ~con = - if !log_transaction_ops && tid <> 0 - then write_access_log ~tid ~con (XbOp Xb.Op.Transaction_end) + if !access_log_transaction_ops && tid <> 0 + then access_logging ~tid ~con (XbOp Xb.Op.Transaction_end) let xb_answer ~tid ~con ~ty data = let print = match ty with - | Xb.Op.Error when data="ENOENT " -> !log_read_ops - | Xb.Op.Error -> !log_special_ops + | Xb.Op.Error when String.startswith "ENOENT" data -> !access_log_read_ops + | Xb.Op.Error -> true | Xb.Op.Watchevent -> true - | _ -> false - in - if print - then write_access_log ~tid ~con ~data (XbOp ty) + | _ -> false in + if print then access_logging ~tid ~con ~data (XbOp ty) diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/xenstored/perms.ml --- a/tools/ocaml/xenstored/perms.ml +++ b/tools/ocaml/xenstored/perms.ml @@ -15,6 +15,8 @@ * GNU Lesser General Public License for more details. *) +let info fmt = Logging.info "perms" fmt + open Stdext let activate = ref true @@ -145,16 +147,16 @@ in match perm, request with | NONE, _ -> - Logs.info "io" "Permission denied: Domain %d has no permission" domainid; + info "Permission denied: Domain %d has no permission" domainid; false | RDWR, _ -> true | READ, READ -> true | WRITE, WRITE -> true | READ, _ -> - Logs.info "io" "Permission denied: Domain %d has read only access" domainid; + info "Permission denied: Domain %d has read only access" domainid; false | WRITE, _ -> - Logs.info "io" "Permission denied: Domain %d has write only access" domainid; + info "Permission denied: Domain %d has write only access" domainid; false in if !activate diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/xenstored/process.ml --- a/tools/ocaml/xenstored/process.ml +++ b/tools/ocaml/xenstored/process.ml @@ -14,6 +14,9 @@ * GNU Lesser General Public License for more details. *) +let error fmt = Logging.error "process" fmt +let info fmt = Logging.info "process" fmt + open Printf open Stdext @@ -79,7 +82,7 @@ (* packets *) let do_debug con t domains cons data = - if not !allow_debug + if not (Connection.is_dom0 con) && not !allow_debug then None else try match split None '\000' data with | "print" :: msg :: _ -> @@ -89,6 +92,9 @@ let domid = int_of_string domid in let quota = (Store.get_quota t.Transaction.store) in Some (Quota.to_string quota domid ^ "\000") + | "watches" :: _ -> + let watches = Connections.debug cons in + Some (watches ^ "\000") | "mfn" :: domid :: _ -> let domid = int_of_string domid in let con = Connections.find_domain cons domid in @@ -357,8 +363,7 @@ in input_handle_error ~cons ~doms ~fct ~ty ~con ~t ~rid ~data; with exn -> - Logs.error "general" "process packet: %s" - (Printexc.to_string exn); + error "process packet: %s" (Printexc.to_string exn); Connection.send_error con tid rid "EIO" let write_access_log ~ty ~tid ~con ~data = @@ -372,7 +377,7 @@ let packet = Connection.pop_in con in let tid, rid, ty, data = Xb.Packet.unpack packet in (* As we don't log IO, do not call an unnecessary sanitize_data - Logs.info "io" "[%s] -> [%d] %s \"%s\"" + info "[%s] -> [%d] %s \"%s\"" (Connection.get_domstr con) tid (Xb.Op.to_string ty) (sanitize_data data); *) process_packet ~store ~cons ~doms ~con ~tid ~rid ~ty ~data; @@ -386,7 +391,7 @@ let packet = Connection.peek_output con in let tid, rid, ty, data = Xb.Packet.unpack packet in (* As we don't log IO, do not call an unnecessary sanitize_data - Logs.info "io" "[%s] <- %s \"%s\"" + info "[%s] <- %s \"%s\"" (Connection.get_domstr con) (Xb.Op.to_string ty) (sanitize_data data);*) write_answer_log ~ty ~tid ~con ~data; diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/xenstored/quota.ml --- a/tools/ocaml/xenstored/quota.ml +++ b/tools/ocaml/xenstored/quota.ml @@ -18,7 +18,7 @@ exception Data_too_big exception Transaction_opened -let warn fmt = Logs.warn "general" fmt +let warn fmt = Logging.warn "quota" fmt let activate = ref true let maxent = ref (10000) let maxsize = ref (4096) diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/xenstored/store.ml --- a/tools/ocaml/xenstored/store.ml +++ b/tools/ocaml/xenstored/store.ml @@ -83,7 +83,7 @@ let check_owner node connection = if not (Perms.check_owner connection node.perms) then begin - Logs.info "io" "Permission denied: Domain %d not owner" (get_owner node); + Logging.info "store|node" "Permission denied: Domain %d not owner" (get_owner node); raise Define.Permission_denied; end diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/xenstored/xenstored.conf --- a/tools/ocaml/xenstored/xenstored.conf +++ b/tools/ocaml/xenstored/xenstored.conf @@ -22,9 +22,14 @@ # Activate filed base backend persistant = false -# Logs -log = error;general;file:/var/log/xenstored.log -log = warn;general;file:/var/log/xenstored.log -log = info;general;file:/var/log/xenstored.log +# Xenstored logs +# xenstored-log-file = /var/log/xenstored.log +# xenstored-log-level = null +# xenstored-log-nb-files = 10 -# log = debug;io;file:/var/log/xenstored-io.log +# Xenstored access logs +# access-log-file = /var/log/xenstored-access.log +# access-log-nb-lines = 13215 +# acesss-log-nb-chars = 180 +# access-log-special-ops = false + diff -r 42cdb34ec175 -r 734cb0807357 tools/ocaml/xenstored/xenstored.ml --- a/tools/ocaml/xenstored/xenstored.ml +++ b/tools/ocaml/xenstored/xenstored.ml @@ -18,7 +18,10 @@ open Printf open Parse_arg open Stdext -open Logging + +let error fmt = Logging.error "xenstored" fmt +let debug fmt = Logging.debug "xenstored" fmt +let info fmt = Logging.info "xenstored" fmt (*------------ event klass processors --------------*) let process_connection_fds store cons domains rset wset = @@ -64,7 +67,8 @@ () let sighup_handler _ = - try Logs.reopen (); info "Log re-opened" with _ -> () + maybe (fun logger -> logger.Logging.restart()) !Logging.xenstored_logger; + maybe (fun logger -> logger.Logging.restart()) !Logging.access_logger let config_filename cf = match cf.config_file with @@ -75,26 +79,6 @@ let parse_config filename = let pidfile = ref default_pidfile in - let set_log s = - let ls = String.split ~limit:3 ';' s in - let level, key, logger = match ls with - | [ level; key; logger ] -> level, key, logger - | _ -> failwith "format mismatch: expecting 3 arguments" in - - let loglevel = match level with - | "debug" -> Log.Debug - | "info" -> Log.Info - | "warn" -> Log.Warn - | "error" -> Log.Error - | s -> failwith (sprintf "Unknown log level: %s" s) in - - (* if key is empty, append to the default logger *) - let append = - if key = "" then - Logs.append_default - else - Logs.append key in - append loglevel logger in let options = [ ("merge-activate", Config.Set_bool Transaction.do_coalesce); ("perms-activate", Config.Set_bool Perms.activate); @@ -104,14 +88,20 @@ ("quota-maxentity", Config.Set_int Quota.maxent); ("quota-maxsize", Config.Set_int Quota.maxsize); ("test-eagain", Config.Set_bool Transaction.test_eagain); - ("log", Config.String set_log); ("persistant", Config.Set_bool Disk.enable); + ("xenstored-log-file", Config.Set_string Logging.xenstored_log_file); + ("xenstored-log-level", Config.String + (fun s -> Logging.xenstored_log_level := Logging.level_of_string s)); + ("xenstored-log-nb-files", Config.Set_int Logging.xenstored_log_nb_files); + ("xenstored-log-nb-lines", Config.Set_int Logging.xenstored_log_nb_lines); + ("xenstored-log-nb-chars", Config.Set_int Logging.xenstored_log_nb_chars); ("access-log-file", Config.Set_string Logging.access_log_file); ("access-log-nb-files", Config.Set_int Logging.access_log_nb_files); ("access-log-nb-lines", Config.Set_int Logging.access_log_nb_lines); - ("access-log-read-ops", Config.Set_bool Logging.log_read_ops); - ("access-log-transactions-ops", Config.Set_bool Logging.log_transaction_ops); - ("access-log-special-ops", Config.Set_bool Logging.log_special_ops); + ("access-log-nb-chars", Config.Set_int Logging.access_log_nb_chars); + ("access-log-read-ops", Config.Set_bool Logging.access_log_read_ops); + ("access-log-transactions-ops", Config.Set_bool Logging.access_log_transaction_ops); + ("access-log-special-ops", Config.Set_bool Logging.access_log_special_ops); ("allow-debug", Config.Set_bool Process.allow_debug); ("pid-file", Config.Set_string pidfile); ] in begin try Config.read filename options (fun _ _ -> raise Not_found) @@ -223,9 +213,6 @@ end let _ = - printf "Xen Storage Daemon, version %d.%d\n%!" - Define.xenstored_major Define.xenstored_minor; - let cf = do_argv in let pidfile = if Sys.file_exists (config_filename cf) then @@ -249,13 +236,13 @@ in if cf.daemonize then - Unixext.daemonize (); + Unixext.daemonize () + else + printf "Xen Storage Daemon, version %d.%d\n%!" + Define.xenstored_major Define.xenstored_minor; (try Unixext.pidfile_write pidfile with _ -> ()); - info "Xen Storage Daemon, version %d.%d" - Define.xenstored_major Define.xenstored_minor; - (* for compatilibity with old xenstored *) begin match cf.pidfile with | Some pidfile -> Unixext.pidfile_write pidfile @@ -293,7 +280,14 @@ Sys.set_signal Sys.sigusr1 (Sys.Signal_handle (fun i -> sigusr1_handler store)); Sys.set_signal Sys.sigpipe Sys.Signal_ignore; - Logging.init cf.activate_access_log (fun () -> DB.to_file store cons "/var/run/xenstored/db"); + Logging.init_xenstored_log(); + if cf.activate_access_log then begin + let post_rotate () = DB.to_file store cons "/var/run/xenstored/db" in + Logging.init_access_log post_rotate + end; + + info "Xen Storage Daemon, version %d.%d" + Define.xenstored_major Define.xenstored_minor; let spec_fds = (match rw_sock with None -> [] | Some x -> [ x ]) @ ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: [PATCH 3 of 7] [OCAML] Remove log library from tools/ocaml/libs 2011-09-29 21:17 ` [PATCH 3 of 7] [OCAML] Remove log library from tools/ocaml/libs Jon Ludlam @ 2011-09-30 7:46 ` Ian Campbell 0 siblings, 0 replies; 24+ messages in thread From: Ian Campbell @ 2011-09-30 7:46 UTC (permalink / raw) To: Jon Ludlam; +Cc: xen-devel On Thu, 2011-09-29 at 22:17 +0100, Jon Ludlam wrote: > The only user was oxenstored, which has had the relevant bits > merged in. > > Signed-off-by: Zheng Li <zheng.li@eu.citrix.com> > Acked-by: Jon Ludlam <jonathan.ludlam@eu.citrix.com> Acked-by: Ian Campbell <ian.campbell@citrix.com> ^ permalink raw reply [flat|nested] 24+ messages in thread
* [PATCH 4 of 7] [OCAML] Fix a problem with ocaml xenstored 2011-09-29 21:17 [PATCH 0 of 7] Ocaml related fixes/cleanups Jon Ludlam ` (2 preceding siblings ...) 2011-09-29 21:17 ` [PATCH 3 of 7] [OCAML] Remove log library from tools/ocaml/libs Jon Ludlam @ 2011-09-29 21:17 ` Jon Ludlam 2011-09-30 7:49 ` Ian Campbell 2011-09-29 21:17 ` [PATCH 5 of 7] [OCAML] Minor makefile cleanup Jon Ludlam ` (2 subsequent siblings) 6 siblings, 1 reply; 24+ messages in thread From: Jon Ludlam @ 2011-09-29 21:17 UTC (permalink / raw) To: xen-devel; +Cc: jonathan.ludlam Have xenstored trigger an @introduceDomain event even if the introduce call tries to introduce an already existing domain. Signed-off-by: Thomas Gazagnaire <thomas@ocamlpro.com> Acked-by: Jon Ludlam <jonathan.ludlam@eu.citrix.com> diff -r 734cb0807357 -r b6022a18ebb0 tools/ocaml/xenstored/process.ml --- a/tools/ocaml/xenstored/process.ml +++ b/tools/ocaml/xenstored/process.ml @@ -168,9 +168,10 @@ | _ -> raise Invalid_Cmd_Args; in let dom = - if Domains.exist domains domid then + if Domains.exist domains domid then begin + Connections.fire_spec_watches cons "@introduceDomain"; Domains.find domains domid - else try + end else try let ndom = Xc.with_intf (fun xc -> Domains.create xc domains domid mfn port) in Connections.add_domain cons ndom; ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: [PATCH 4 of 7] [OCAML] Fix a problem with ocaml xenstored 2011-09-29 21:17 ` [PATCH 4 of 7] [OCAML] Fix a problem with ocaml xenstored Jon Ludlam @ 2011-09-30 7:49 ` Ian Campbell 2011-09-30 12:22 ` Jonathan Ludlam 0 siblings, 1 reply; 24+ messages in thread From: Ian Campbell @ 2011-09-30 7:49 UTC (permalink / raw) To: Jon Ludlam; +Cc: xen-devel On Thu, 2011-09-29 at 22:17 +0100, Jon Ludlam wrote: > Have xenstored trigger an @introduceDomain event even if the > introduce call tries to introduce an already existing domain. The C daemon doesn't appear to behave this way. It would be nice to explain why this change is necessary. > Signed-off-by: Thomas Gazagnaire <thomas@ocamlpro.com> > Acked-by: Jon Ludlam <jonathan.ludlam@eu.citrix.com> > > diff -r 734cb0807357 -r b6022a18ebb0 tools/ocaml/xenstored/process.ml > --- a/tools/ocaml/xenstored/process.ml > +++ b/tools/ocaml/xenstored/process.ml > @@ -168,9 +168,10 @@ > | _ -> raise Invalid_Cmd_Args; > in > let dom = > - if Domains.exist domains domid then > + if Domains.exist domains domid then begin > + Connections.fire_spec_watches cons "@introduceDomain"; > Domains.find domains domid > - else try > + end else try > let ndom = Xc.with_intf (fun xc -> > Domains.create xc domains domid mfn port) in > Connections.add_domain cons ndom; > > _______________________________________________ > Xen-devel mailing list > Xen-devel@lists.xensource.com > http://lists.xensource.com/xen-devel ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: [PATCH 4 of 7] [OCAML] Fix a problem with ocaml xenstored 2011-09-30 7:49 ` Ian Campbell @ 2011-09-30 12:22 ` Jonathan Ludlam 2011-09-30 12:50 ` Ian Campbell 0 siblings, 1 reply; 24+ messages in thread From: Jonathan Ludlam @ 2011-09-30 12:22 UTC (permalink / raw) To: Ian Campbell; +Cc: xen-devel Ah, that's a shame. I was hoping this was a bugfix to the ocaml xenstored and that the C version already did this. Unfortunately the patch here went in to XenServer a couple of years ago, and Thomas, who made the change, has since left. I'll dig into this and see why we depend upon it. Jon On 30 Sep 2011, at 08:49, Ian Campbell wrote: > On Thu, 2011-09-29 at 22:17 +0100, Jon Ludlam wrote: >> Have xenstored trigger an @introduceDomain event even if the >> introduce call tries to introduce an already existing domain. > > The C daemon doesn't appear to behave this way. It would be nice to > explain why this change is necessary. > >> Signed-off-by: Thomas Gazagnaire <thomas@ocamlpro.com> >> Acked-by: Jon Ludlam <jonathan.ludlam@eu.citrix.com> >> >> diff -r 734cb0807357 -r b6022a18ebb0 tools/ocaml/xenstored/process.ml >> --- a/tools/ocaml/xenstored/process.ml >> +++ b/tools/ocaml/xenstored/process.ml >> @@ -168,9 +168,10 @@ >> | _ -> raise Invalid_Cmd_Args; >> in >> let dom = >> - if Domains.exist domains domid then >> + if Domains.exist domains domid then begin >> + Connections.fire_spec_watches cons "@introduceDomain"; >> Domains.find domains domid >> - else try >> + end else try >> let ndom = Xc.with_intf (fun xc -> >> Domains.create xc domains domid mfn port) in >> Connections.add_domain cons ndom; >> >> _______________________________________________ >> Xen-devel mailing list >> Xen-devel@lists.xensource.com >> http://lists.xensource.com/xen-devel > > ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: [PATCH 4 of 7] [OCAML] Fix a problem with ocaml xenstored 2011-09-30 12:22 ` Jonathan Ludlam @ 2011-09-30 12:50 ` Ian Campbell 2011-09-30 13:24 ` Jonathan Ludlam 0 siblings, 1 reply; 24+ messages in thread From: Ian Campbell @ 2011-09-30 12:50 UTC (permalink / raw) To: Jonathan Ludlam; +Cc: xen-devel On Fri, 2011-09-30 at 13:22 +0100, Jonathan Ludlam wrote: > Ah, that's a shame. I was hoping this was a bugfix to the ocaml > xenstored and that the C version already did this. Unfortunately the > patch here went in to XenServer a couple of years ago, and Thomas, who > made the change, has since left. I'll dig into this and see why we > depend upon it. Seems to be CA-30927 which was "internal shutdown doesn't work anymore after VM.checkpoint": The bugs comes from the fact that xal always assume that suspended domains are or will be soon dead. However, for VM.checkpoint that assumptions is false, as the VM is suspended, snapshoted, and then resumed, without destroying the domain. Thomas said in that ticket: I fixed this issue by: * teach to xal how to handle dead domains for suspended reasons which become suddenly alive * when resuming a domain, use the xenstore introduce call * modify xenstore to generates a @introduceDomain event even if the introduced domain does not exists I believe nobody care to see too many @introduceDomain event, so that will not change anything. My fix modifies the code path taken by VM.suspend, but that should be safe because xapi destroys properly the domain after suspending it. (I think he meant _does_ exist in the third bullet). In his commit message he said: Teach xal what to do with dead domains which become alive again. Needed to modify xenstored as well in order to trigger a @introduceDomain event even if the introduce call tries to introduce an already existing domain. That will kick-up xal in case when resuming the domain. I think possibly the right fix would have been to have xal kick-up itself. That said spurious @introduceDomain watches are pretty harmless (as he suggests) since they have no context, the recipient has to go and check it's idea of the world vs the real state to know what happened an the answer "nothing" is not a big deal... Ian. > > Jon > > On 30 Sep 2011, at 08:49, Ian Campbell wrote: > > > On Thu, 2011-09-29 at 22:17 +0100, Jon Ludlam wrote: > >> Have xenstored trigger an @introduceDomain event even if the > >> introduce call tries to introduce an already existing domain. > > > > The C daemon doesn't appear to behave this way. It would be nice to > > explain why this change is necessary. > > > >> Signed-off-by: Thomas Gazagnaire <thomas@ocamlpro.com> > >> Acked-by: Jon Ludlam <jonathan.ludlam@eu.citrix.com> > >> > >> diff -r 734cb0807357 -r b6022a18ebb0 tools/ocaml/xenstored/process.ml > >> --- a/tools/ocaml/xenstored/process.ml > >> +++ b/tools/ocaml/xenstored/process.ml > >> @@ -168,9 +168,10 @@ > >> | _ -> raise Invalid_Cmd_Args; > >> in > >> let dom = > >> - if Domains.exist domains domid then > >> + if Domains.exist domains domid then begin > >> + Connections.fire_spec_watches cons "@introduceDomain"; > >> Domains.find domains domid > >> - else try > >> + end else try > >> let ndom = Xc.with_intf (fun xc -> > >> Domains.create xc domains domid mfn port) in > >> Connections.add_domain cons ndom; > >> > >> _______________________________________________ > >> Xen-devel mailing list > >> Xen-devel@lists.xensource.com > >> http://lists.xensource.com/xen-devel > > > > > ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: [PATCH 4 of 7] [OCAML] Fix a problem with ocaml xenstored 2011-09-30 12:50 ` Ian Campbell @ 2011-09-30 13:24 ` Jonathan Ludlam 0 siblings, 0 replies; 24+ messages in thread From: Jonathan Ludlam @ 2011-09-30 13:24 UTC (permalink / raw) To: Ian Campbell; +Cc: xen-devel On 30 Sep 2011, at 13:50, Ian Campbell wrote: > > On Fri, 2011-09-30 at 13:22 +0100, Jonathan Ludlam wrote: >> Ah, that's a shame. I was hoping this was a bugfix to the ocaml >> xenstored and that the C version already did this. Unfortunately the >> patch here went in to XenServer a couple of years ago, and Thomas, who >> made the change, has since left. I'll dig into this and see why we >> depend upon it. > > Seems to be CA-30927 which was "internal shutdown doesn't work anymore > after VM.checkpoint": > > The bugs comes from the fact that xal always assume that > suspended domains are or will be soon dead. > > However, for VM.checkpoint that assumptions is false, as the VM > is suspended, snapshoted, and then resumed, without destroying > the domain. > > Thomas said in that ticket: > > I fixed this issue by: > * teach to xal how to handle dead domains for suspended > reasons which become suddenly alive > * when resuming a domain, use the xenstore introduce call > * modify xenstore to generates a @introduceDomain event > even if the introduced domain does not exists > > I believe nobody care to see too many @introduceDomain event, so > that will not change anything. My fix modifies the code path > taken by VM.suspend, but that should be safe because xapi > destroys properly the domain after suspending it. > > (I think he meant _does_ exist in the third bullet). In his commit > message he said: > > Teach xal what to do with dead domains which become alive again. > > Needed to modify xenstored as well in order to trigger a > @introduceDomain event even if the introduce call tries to > introduce an already existing domain. That will kick-up xal in > case when resuming the domain. > > I think possibly the right fix would have been to have xal kick-up > itself. That said spurious @introduceDomain watches are pretty harmless > (as he suggests) since they have no context, the recipient has to go and > check it's idea of the world vs the real state to know what happened an > the answer "nothing" is not a big deal... > I think you're right that the fix should go into xal. Please don't commit this particular patch; we'll keep it in our patch queue until we can fix it properly in xapi. Jon > Ian. > > >> >> Jon >> >> On 30 Sep 2011, at 08:49, Ian Campbell wrote: >> >>> On Thu, 2011-09-29 at 22:17 +0100, Jon Ludlam wrote: >>>> Have xenstored trigger an @introduceDomain event even if the >>>> introduce call tries to introduce an already existing domain. >>> >>> The C daemon doesn't appear to behave this way. It would be nice to >>> explain why this change is necessary. >>> >>>> Signed-off-by: Thomas Gazagnaire <thomas@ocamlpro.com> >>>> Acked-by: Jon Ludlam <jonathan.ludlam@eu.citrix.com> >>>> >>>> diff -r 734cb0807357 -r b6022a18ebb0 tools/ocaml/xenstored/process.ml >>>> --- a/tools/ocaml/xenstored/process.ml >>>> +++ b/tools/ocaml/xenstored/process.ml >>>> @@ -168,9 +168,10 @@ >>>> | _ -> raise Invalid_Cmd_Args; >>>> in >>>> let dom = >>>> - if Domains.exist domains domid then >>>> + if Domains.exist domains domid then begin >>>> + Connections.fire_spec_watches cons "@introduceDomain"; >>>> Domains.find domains domid >>>> - else try >>>> + end else try >>>> let ndom = Xc.with_intf (fun xc -> >>>> Domains.create xc domains domid mfn port) in >>>> Connections.add_domain cons ndom; >>>> >>>> _______________________________________________ >>>> Xen-devel mailing list >>>> Xen-devel@lists.xensource.com >>>> http://lists.xensource.com/xen-devel >>> >>> >> > > ^ permalink raw reply [flat|nested] 24+ messages in thread
* [PATCH 5 of 7] [OCAML] Minor makefile cleanup 2011-09-29 21:17 [PATCH 0 of 7] Ocaml related fixes/cleanups Jon Ludlam ` (3 preceding siblings ...) 2011-09-29 21:17 ` [PATCH 4 of 7] [OCAML] Fix a problem with ocaml xenstored Jon Ludlam @ 2011-09-29 21:17 ` Jon Ludlam 2011-09-30 7:51 ` Ian Campbell 2011-09-29 21:17 ` [PATCH 6 of 7] [OCAML] Fix 2 bit-twiddling bugs and an off-by-one Jon Ludlam 2011-09-29 21:17 ` [PATCH 7 of 7] [OCAML] Small improvement to the ocaml xenctrl library Jon Ludlam 6 siblings, 1 reply; 24+ messages in thread From: Jon Ludlam @ 2011-09-29 21:17 UTC (permalink / raw) To: xen-devel; +Cc: jonathan.ludlam Signed-off-by: Zheng Li <zheng.li@eu.citrix.com> Acked-by: Jon Ludlam <jonathan.ludlam@eu.citrix.com> diff -r b6022a18ebb0 -r 48d4f312d069 tools/ocaml/Makefile.rules --- a/tools/ocaml/Makefile.rules +++ b/tools/ocaml/Makefile.rules @@ -52,20 +52,20 @@ mk-caml-lib-native = $(call quiet-command, $(OCAMLOPT) $(OCAMLOPTFLAGS) -a -o $1 $2 $3,MLA,$1) mk-caml-lib-bytecode = $(call quiet-command, $(OCAMLC) $(OCAMLCFLAGS) -a -o $1 $2 $3,MLA,$1) -mk-caml-stubs = $(call quiet-command, $(OCAMLMKLIB) -o `basename $1 .a` $2,MKLIB,$1) +mk-caml-stubs = $(call quiet-command, $(OCAMLMKLIB) $(LIBS_$(1)) -o $(1)_stubs $2,MKLIB,$1) mk-caml-lib-stubs = \ - $(call quiet-command, $(AR) rcs $1 $2 && $(OCAMLMKLIB) -o `basename $1 .a | sed -e 's/^lib//'` $2,MKLIB,$1) + $(call quiet-command, $(AR) rcs lib$(1)_stubs.a $2 && $(OCAMLMKLIB) $(LIBS_$(1)) -o $(1)_stubs $2,MKLIB,$1) # define a library target <name>.cmxa and <name>.cma define OCAML_LIBRARY_template $(1).cmxa: lib$(1)_stubs.a $(foreach obj,$($(1)_OBJS),$(obj).cmx) $(call mk-caml-lib-native,$$@, -cclib -l$(1)_stubs $(foreach lib,$(LIBS_$(1)),-cclib $(lib)), $(foreach obj,$($(1)_OBJS),$(obj).cmx)) $(1).cma: $(foreach obj,$($(1)_OBJS),$(obj).cmo) - $(call mk-caml-lib-bytecode,$$@, -dllib dll$(1)_stubs.so -cclib -l$(1)_stubs, $$+) + $(call mk-caml-lib-bytecode,$$@, -dllib dll$(1)_stubs.so -cclib -l$(1)_stubs $(foreach lib,$(LIBS_$(1)),-cclib $(lib)), $$+) $(1)_stubs.a: $(foreach obj,$$($(1)_C_OBJS),$(obj).o) - $(call mk-caml-stubs,$$@, $$+) + $(call mk-caml-stubs,$(1), $$+) lib$(1)_stubs.a: $(foreach obj,$($(1)_C_OBJS),$(obj).o) - $(call mk-caml-lib-stubs,$$@, $$+) + $(call mk-caml-lib-stubs,$(1), $$+) endef define OCAML_NOC_LIBRARY_template diff -r b6022a18ebb0 -r 48d4f312d069 tools/ocaml/libs/eventchn/Makefile --- a/tools/ocaml/libs/eventchn/Makefile +++ b/tools/ocaml/libs/eventchn/Makefile @@ -8,7 +8,7 @@ INTF = $(foreach obj, $(OBJS),$(obj).cmi) LIBS = eventchn.cma eventchn.cmxa -LIBS_evtchn = $(LDLIBS_libxenctrl) +LIBS_eventchn = -L$(XEN_ROOT)/tools/libxc -lxenctrl all: $(INTF) $(LIBS) $(PROGRAMS) ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: [PATCH 5 of 7] [OCAML] Minor makefile cleanup 2011-09-29 21:17 ` [PATCH 5 of 7] [OCAML] Minor makefile cleanup Jon Ludlam @ 2011-09-30 7:51 ` Ian Campbell 2011-09-30 16:43 ` Zheng Li 0 siblings, 1 reply; 24+ messages in thread From: Ian Campbell @ 2011-09-30 7:51 UTC (permalink / raw) To: Jon Ludlam; +Cc: xen-devel What does the cleanup actually do? On Thu, 2011-09-29 at 22:17 +0100, Jon Ludlam wrote: > diff -r b6022a18ebb0 -r 48d4f312d069 tools/ocaml/libs/eventchn/Makefile > --- a/tools/ocaml/libs/eventchn/Makefile > +++ b/tools/ocaml/libs/eventchn/Makefile > @@ -8,7 +8,7 @@ > INTF = $(foreach obj, $(OBJS),$(obj).cmi) > LIBS = eventchn.cma eventchn.cmxa > > -LIBS_evtchn = $(LDLIBS_libxenctrl) > +LIBS_eventchn = -L$(XEN_ROOT)/tools/libxc -lxenctrl This should continue using LDLIBS_libxenctrl unless there is a good reason not too. > > all: $(INTF) $(LIBS) $(PROGRAMS) > > > _______________________________________________ > Xen-devel mailing list > Xen-devel@lists.xensource.com > http://lists.xensource.com/xen-devel ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: [PATCH 5 of 7] [OCAML] Minor makefile cleanup 2011-09-30 7:51 ` Ian Campbell @ 2011-09-30 16:43 ` Zheng Li 0 siblings, 0 replies; 24+ messages in thread From: Zheng Li @ 2011-09-30 16:43 UTC (permalink / raw) To: xen-devel; +Cc: Ian Campbell, Jonathan Ludlam Hello, On 30/09/2011 08:51, Ian Campbell wrote: > What does the cleanup actually do? IIRC, the patch meant to do 2 things: * A small improvement (in two occasions) E.g., for make rule lib$(1)_stubs.a: $(foreach obj,$($(1)_C_OBJS),$(obj).o) substitute the action part from $(call mk-caml-lib-stubs,$$@, $$+) to $(call mk-caml-lib-stubs,$(1), $$+) i.e. pass part of the target's name as the argument to mk-caml-lib-stubs instead of the whole name, so that we can avoid calling basename and sed later on to recover the sub string. I.e., from $(call quiet-command, $(AR) rcs $1 $2 && $(OCAMLMKLIB) -o `basename $1 .a | sed -e 's/^lib//'` $2,MKLIB,$1) to $(call quiet-command, $(AR) rcs lib$(1)_stubs.a $2 && $(OCAMLMKLIB) $(LIBS_$(1)) -o $(1)_stubs $2,MKLIB,$1) * Some correction on linking parameters for bytecode mode compilation IIRC, it's this line that changed from $(call mk-caml-lib-bytecode,$$@, -dllib dll$(1)_stubs.so -cclib -l$(1)_stubs, $$+) to $(call mk-caml-lib-bytecode,$$@, -dllib dll$(1)_stubs.so -cclib -l$(1)_stubs $(foreach lib,$(LIBS_$(1)),-cclib $(lib)), $$+) The former was able to produce bytecode as well, but there would be problem in dynamic loading the generated bytecode (e.g. in OCaml toplevel). The later version should work fine with the toplevel. >> -LIBS_evtchn = $(LDLIBS_libxenctrl) >> +LIBS_eventchn = -L$(XEN_ROOT)/tools/libxc -lxenctrl > > This should continue using LDLIBS_libxenctrl unless there is a good > reason not too. I think you are right. They are identical, only the name in the first line needs fixing, and using predefined $(LDLIBS_libxenctrl) is certainly better. The change dated back before your Makefile refactoring after Xen-4.1 and was probably a result of mix up during rebase. Cheers -- Zheng ^ permalink raw reply [flat|nested] 24+ messages in thread
* [PATCH 6 of 7] [OCAML] Fix 2 bit-twiddling bugs and an off-by-one 2011-09-29 21:17 [PATCH 0 of 7] Ocaml related fixes/cleanups Jon Ludlam ` (4 preceding siblings ...) 2011-09-29 21:17 ` [PATCH 5 of 7] [OCAML] Minor makefile cleanup Jon Ludlam @ 2011-09-29 21:17 ` Jon Ludlam 2011-09-30 7:53 ` Ian Campbell 2011-09-29 21:17 ` [PATCH 7 of 7] [OCAML] Small improvement to the ocaml xenctrl library Jon Ludlam 6 siblings, 1 reply; 24+ messages in thread From: Jon Ludlam @ 2011-09-29 21:17 UTC (permalink / raw) To: xen-devel; +Cc: jonathan.ludlam The bit bugs are in ocaml vcpu affinity calls, and the off-by-one error is in the ocaml console ring code Signed-off-by: Zheng Li <zheng.li@eu.citrix.com> Acked-by: Jon Ludlam <jonathan.ludlam@eu.citrix.com> diff -r 48d4f312d069 -r 05ac32c3956c tools/ocaml/libs/xc/xc_stubs.c --- a/tools/ocaml/libs/xc/xc_stubs.c +++ b/tools/ocaml/libs/xc/xc_stubs.c @@ -430,7 +430,7 @@ for (i=0; i<len; i++) { if (Bool_val(Field(cpumap, i))) - c_cpumap[i/8] |= i << (i&7); + c_cpumap[i/8] |= 1 << (i&7); } retval = xc_vcpu_setaffinity(_H(xch), _D(domid), Int_val(vcpu), c_cpumap); @@ -466,7 +466,7 @@ ret = caml_alloc(len, 0); for (i=0; i<len; i++) { - if (c_cpumap[i%8] & 1 << (i&7)) + if (c_cpumap[i/8] & 1 << (i&7)) Store_field(ret, i, Val_true); else Store_field(ret, i, Val_false); @@ -523,7 +523,7 @@ CAMLprim value stub_xc_readconsolering(value xch) { - unsigned int size = RING_SIZE; + unsigned int size = RING_SIZE - 1; char *ring_ptr = ring; CAMLparam1(xch); ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: [PATCH 6 of 7] [OCAML] Fix 2 bit-twiddling bugs and an off-by-one 2011-09-29 21:17 ` [PATCH 6 of 7] [OCAML] Fix 2 bit-twiddling bugs and an off-by-one Jon Ludlam @ 2011-09-30 7:53 ` Ian Campbell 0 siblings, 0 replies; 24+ messages in thread From: Ian Campbell @ 2011-09-30 7:53 UTC (permalink / raw) To: Jon Ludlam; +Cc: xen-devel On Thu, 2011-09-29 at 22:17 +0100, Jon Ludlam wrote: > The bit bugs are in ocaml vcpu affinity calls, and the off-by-one > error is in the ocaml console ring code > > Signed-off-by: Zheng Li <zheng.li@eu.citrix.com> > Acked-by: Jon Ludlam <jonathan.ludlam@eu.citrix.com> Acked-by: Ian Campbell <ian.campbell@citrix.com> ^ permalink raw reply [flat|nested] 24+ messages in thread
* [PATCH 7 of 7] [OCAML] Small improvement to the ocaml xenctrl library 2011-09-29 21:17 [PATCH 0 of 7] Ocaml related fixes/cleanups Jon Ludlam ` (5 preceding siblings ...) 2011-09-29 21:17 ` [PATCH 6 of 7] [OCAML] Fix 2 bit-twiddling bugs and an off-by-one Jon Ludlam @ 2011-09-29 21:17 ` Jon Ludlam 2011-09-30 7:54 ` Ian Campbell 6 siblings, 1 reply; 24+ messages in thread From: Jon Ludlam @ 2011-09-29 21:17 UTC (permalink / raw) To: xen-devel; +Cc: jonathan.ludlam Add a new field 'max_nr_cpus' to the physinfo type in the ocaml xc bindings Signed-off-by: Zheng Li <zheng.li@eu.citrix.com> diff -r 05ac32c3956c -r abf14d22106a tools/ocaml/libs/xc/xc.ml --- a/tools/ocaml/libs/xc/xc.ml +++ b/tools/ocaml/libs/xc/xc.ml @@ -70,6 +70,7 @@ scrub_pages : nativeint; (* XXX hw_cap *) capabilities : physinfo_cap_flag list; + max_nr_cpus : int; } type version = diff -r 05ac32c3956c -r abf14d22106a tools/ocaml/libs/xc/xc.mli --- a/tools/ocaml/libs/xc/xc.mli +++ b/tools/ocaml/libs/xc/xc.mli @@ -52,6 +52,7 @@ free_pages : nativeint; scrub_pages : nativeint; capabilities : physinfo_cap_flag list; + max_nr_cpus : int; (** compile-time max possible number of nr_cpus *) } type version = { major : int; minor : int; extra : string; } type compile_info = { diff -r 05ac32c3956c -r abf14d22106a tools/ocaml/libs/xc/xc_stubs.c --- a/tools/ocaml/libs/xc/xc_stubs.c +++ b/tools/ocaml/libs/xc/xc_stubs.c @@ -534,6 +534,7 @@ if (retval) failwith_xc(_H(xch)); + ring[size] = '\0'; CAMLreturn(caml_copy_string(ring)); } @@ -573,7 +574,7 @@ } } - physinfo = caml_alloc_tuple(9); + physinfo = caml_alloc_tuple(10); Store_field(physinfo, 0, Val_int(c_physinfo.threads_per_core)); Store_field(physinfo, 1, Val_int(c_physinfo.cores_per_socket)); Store_field(physinfo, 2, Val_int(c_physinfo.nr_cpus)); @@ -583,6 +584,7 @@ Store_field(physinfo, 6, caml_copy_nativeint(c_physinfo.free_pages)); Store_field(physinfo, 7, caml_copy_nativeint(c_physinfo.scrub_pages)); Store_field(physinfo, 8, cap_list); + Store_field(physinfo, 9, Val_int(c_physinfo.max_cpu_id + 1)); CAMLreturn(physinfo); } ^ permalink raw reply [flat|nested] 24+ messages in thread
* Re: [PATCH 7 of 7] [OCAML] Small improvement to the ocaml xenctrl library 2011-09-29 21:17 ` [PATCH 7 of 7] [OCAML] Small improvement to the ocaml xenctrl library Jon Ludlam @ 2011-09-30 7:54 ` Ian Campbell 0 siblings, 0 replies; 24+ messages in thread From: Ian Campbell @ 2011-09-30 7:54 UTC (permalink / raw) To: Jon Ludlam; +Cc: xen-devel On Thu, 2011-09-29 at 22:17 +0100, Jon Ludlam wrote: > Add a new field 'max_nr_cpus' to the physinfo type in the ocaml xc bindings > > Signed-off-by: Zheng Li <zheng.li@eu.citrix.com> Acked-by: Ian Campbell <ian.campbell@citrix.com> > > diff -r 05ac32c3956c -r abf14d22106a tools/ocaml/libs/xc/xc.ml > --- a/tools/ocaml/libs/xc/xc.ml > +++ b/tools/ocaml/libs/xc/xc.ml > @@ -70,6 +70,7 @@ > scrub_pages : nativeint; > (* XXX hw_cap *) > capabilities : physinfo_cap_flag list; > + max_nr_cpus : int; > } > > type version = > diff -r 05ac32c3956c -r abf14d22106a tools/ocaml/libs/xc/xc.mli > --- a/tools/ocaml/libs/xc/xc.mli > +++ b/tools/ocaml/libs/xc/xc.mli > @@ -52,6 +52,7 @@ > free_pages : nativeint; > scrub_pages : nativeint; > capabilities : physinfo_cap_flag list; > + max_nr_cpus : int; (** compile-time max possible number of nr_cpus *) > } > type version = { major : int; minor : int; extra : string; } > type compile_info = { > diff -r 05ac32c3956c -r abf14d22106a tools/ocaml/libs/xc/xc_stubs.c > --- a/tools/ocaml/libs/xc/xc_stubs.c > +++ b/tools/ocaml/libs/xc/xc_stubs.c > @@ -534,6 +534,7 @@ > > if (retval) > failwith_xc(_H(xch)); > + > ring[size] = '\0'; > CAMLreturn(caml_copy_string(ring)); > } > @@ -573,7 +574,7 @@ > } > } > > - physinfo = caml_alloc_tuple(9); > + physinfo = caml_alloc_tuple(10); > Store_field(physinfo, 0, Val_int(c_physinfo.threads_per_core)); > Store_field(physinfo, 1, Val_int(c_physinfo.cores_per_socket)); > Store_field(physinfo, 2, Val_int(c_physinfo.nr_cpus)); > @@ -583,6 +584,7 @@ > Store_field(physinfo, 6, caml_copy_nativeint(c_physinfo.free_pages)); > Store_field(physinfo, 7, caml_copy_nativeint(c_physinfo.scrub_pages)); > Store_field(physinfo, 8, cap_list); > + Store_field(physinfo, 9, Val_int(c_physinfo.max_cpu_id + 1)); > > CAMLreturn(physinfo); > } > > _______________________________________________ > Xen-devel mailing list > Xen-devel@lists.xensource.com > http://lists.xensource.com/xen-devel ^ permalink raw reply [flat|nested] 24+ messages in thread
[parent not found: <patchbomb.1317742227@snoosnoo2.uk.xensource.com>]
* [PATCH 5 of 7] [OCAML] Minor makefile cleanup [not found] <patchbomb.1317742227@snoosnoo2.uk.xensource.com> @ 2011-10-04 15:30 ` Jon Ludlam 0 siblings, 0 replies; 24+ messages in thread From: Jon Ludlam @ 2011-10-04 15:30 UTC (permalink / raw) To: xen-devel; +Cc: jonathan.ludlam Signed-off-by: Zheng Li <zheng.li@eu.citrix.com> Acked-by: Jon Ludlam <jonathan.ludlam@eu.citrix.com> diff -r b6d1deac6ca2 -r 875d9c54a1cd tools/ocaml/Makefile.rules --- a/tools/ocaml/Makefile.rules +++ b/tools/ocaml/Makefile.rules @@ -52,20 +52,20 @@ mk-caml-lib-native = $(call quiet-command, $(OCAMLOPT) $(OCAMLOPTFLAGS) -a -o $1 $2 $3,MLA,$1) mk-caml-lib-bytecode = $(call quiet-command, $(OCAMLC) $(OCAMLCFLAGS) -a -o $1 $2 $3,MLA,$1) -mk-caml-stubs = $(call quiet-command, $(OCAMLMKLIB) -o `basename $1 .a` $2,MKLIB,$1) +mk-caml-stubs = $(call quiet-command, $(OCAMLMKLIB) $(LIBS_$(1)) -o $(1)_stubs $2,MKLIB,$1) mk-caml-lib-stubs = \ - $(call quiet-command, $(AR) rcs $1 $2 && $(OCAMLMKLIB) -o `basename $1 .a | sed -e 's/^lib//'` $2,MKLIB,$1) + $(call quiet-command, $(AR) rcs lib$(1)_stubs.a $2 && $(OCAMLMKLIB) $(LIBS_$(1)) -o $(1)_stubs $2,MKLIB,$1) # define a library target <name>.cmxa and <name>.cma define OCAML_LIBRARY_template $(1).cmxa: lib$(1)_stubs.a $(foreach obj,$($(1)_OBJS),$(obj).cmx) $(call mk-caml-lib-native,$$@, -cclib -l$(1)_stubs $(foreach lib,$(LIBS_$(1)),-cclib $(lib)), $(foreach obj,$($(1)_OBJS),$(obj).cmx)) $(1).cma: $(foreach obj,$($(1)_OBJS),$(obj).cmo) - $(call mk-caml-lib-bytecode,$$@, -dllib dll$(1)_stubs.so -cclib -l$(1)_stubs, $$+) + $(call mk-caml-lib-bytecode,$$@, -dllib dll$(1)_stubs.so -cclib -l$(1)_stubs $(foreach lib,$(LIBS_$(1)),-cclib $(lib)), $$+) $(1)_stubs.a: $(foreach obj,$$($(1)_C_OBJS),$(obj).o) - $(call mk-caml-stubs,$$@, $$+) + $(call mk-caml-stubs,$(1), $$+) lib$(1)_stubs.a: $(foreach obj,$($(1)_C_OBJS),$(obj).o) - $(call mk-caml-lib-stubs,$$@, $$+) + $(call mk-caml-lib-stubs,$(1), $$+) endef define OCAML_NOC_LIBRARY_template diff -r b6d1deac6ca2 -r 875d9c54a1cd tools/ocaml/libs/eventchn/Makefile --- a/tools/ocaml/libs/eventchn/Makefile +++ b/tools/ocaml/libs/eventchn/Makefile @@ -8,7 +8,7 @@ INTF = $(foreach obj, $(OBJS),$(obj).cmi) LIBS = eventchn.cma eventchn.cmxa -LIBS_evtchn = $(LDLIBS_libxenctrl) +LIBS_eventchn = $(LDLIBS_libxenctrl) all: $(INTF) $(LIBS) $(PROGRAMS) ^ permalink raw reply [flat|nested] 24+ messages in thread
end of thread, other threads:[~2011-10-04 15:30 UTC | newest]
Thread overview: 24+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2011-09-29 21:17 [PATCH 0 of 7] Ocaml related fixes/cleanups Jon Ludlam
2011-09-29 21:17 ` [PATCH 1 of 7] [OCAML] Rename the ocamlfind packages Jon Ludlam
2011-09-30 7:42 ` Ian Campbell
2011-09-30 12:19 ` Jonathan Ludlam
2011-09-30 12:35 ` Ian Campbell
2011-09-29 21:17 ` [PATCH 2 of 7] [OCAML] Remove the uuid library Jon Ludlam
2011-09-30 7:45 ` Ian Campbell
2011-09-30 12:21 ` Jonathan Ludlam
2011-09-30 12:36 ` Ian Campbell
2011-09-29 21:17 ` [PATCH 3 of 7] [OCAML] Remove log library from tools/ocaml/libs Jon Ludlam
2011-09-30 7:46 ` Ian Campbell
2011-09-29 21:17 ` [PATCH 4 of 7] [OCAML] Fix a problem with ocaml xenstored Jon Ludlam
2011-09-30 7:49 ` Ian Campbell
2011-09-30 12:22 ` Jonathan Ludlam
2011-09-30 12:50 ` Ian Campbell
2011-09-30 13:24 ` Jonathan Ludlam
2011-09-29 21:17 ` [PATCH 5 of 7] [OCAML] Minor makefile cleanup Jon Ludlam
2011-09-30 7:51 ` Ian Campbell
2011-09-30 16:43 ` Zheng Li
2011-09-29 21:17 ` [PATCH 6 of 7] [OCAML] Fix 2 bit-twiddling bugs and an off-by-one Jon Ludlam
2011-09-30 7:53 ` Ian Campbell
2011-09-29 21:17 ` [PATCH 7 of 7] [OCAML] Small improvement to the ocaml xenctrl library Jon Ludlam
2011-09-30 7:54 ` Ian Campbell
[not found] <patchbomb.1317742227@snoosnoo2.uk.xensource.com>
2011-10-04 15:30 ` [PATCH 5 of 7] [OCAML] Minor makefile cleanup Jon Ludlam
This is an external index of several public inboxes, see mirroring instructions on how to clone and mirror all data and code used by this external index.