From 378ed3be5e8fffbd45df785fee68b6862eb55398 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Thu, 1 Jan 2015 06:11:39 +0000 Subject: [PATCH] ocaml: Convert debug_logging example from C to OCaml. Continue gradual conversion of C examples to other languages. --- .gitignore | 1 + ocaml/examples/Makefile.am | 18 ++++++-- ocaml/examples/debug_logging.ml | 74 ++++++++++++++++++++++++++++++++ ocaml/examples/guestfs-ocaml.pod | 12 ++++-- 4 files changed, 97 insertions(+), 8 deletions(-) create mode 100644 ocaml/examples/debug_logging.ml diff --git a/.gitignore b/.gitignore index 59bcfc082..4c1b90c96 100644 --- a/.gitignore +++ b/.gitignore @@ -316,6 +316,7 @@ Makefile.in /ocaml/.depend /ocaml/dllmlguestfs.so /ocaml/examples/create_disk +/ocaml/examples/debug_logging /ocaml/examples/guestfs-ocaml.3 /ocaml/examples/inspect_vm /ocaml/examples/stamp-guestfs-ocaml.pod diff --git a/ocaml/examples/Makefile.am b/ocaml/examples/Makefile.am index de647fc1a..4955727e0 100644 --- a/ocaml/examples/Makefile.am +++ b/ocaml/examples/Makefile.am @@ -1,5 +1,5 @@ # libguestfs OCaml examples -# Copyright (C) 2010 Red Hat Inc. +# Copyright (C) 2010-2014 Red Hat Inc. # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by @@ -20,6 +20,7 @@ include $(top_srcdir)/subdir-rules.mk EXTRA_DIST = \ LICENSE \ create_disk.ml \ + debug_logging.ml \ inspect_vm.ml \ guestfs-ocaml.pod @@ -37,15 +38,16 @@ stamp-guestfs-ocaml.pod: guestfs-ocaml.pod create_disk.ml inspect_vm.ml --section 3 \ --man guestfs-ocaml.3 \ --html $(top_builddir)/html/guestfs-ocaml.3.html \ - --verbatim $(srcdir)/create_disk.ml:@EXAMPLE1@ \ - --verbatim $(srcdir)/inspect_vm.ml:@EXAMPLE2@ \ + --verbatim $(srcdir)/create_disk.ml:@CREATE_DISK@ \ + --verbatim $(srcdir)/inspect_vm.ml:@INSPECT_VM@ \ + --verbatim $(srcdir)/debug_logging.ml:@DEBUG_LOGGING@ \ --license examples \ $< touch $@ if HAVE_OCAML -noinst_SCRIPTS = create_disk inspect_vm +noinst_SCRIPTS = create_disk debug_logging inspect_vm OCAMLFINDFLAGS = -cclib -L$(top_builddir)/src/.libs @@ -54,6 +56,10 @@ create_disk: create_disk.ml $(OCAMLFIND) ocamlopt $(OCAMLFINDFLAGS) -package unix -linkpkg \ -warn-error A -I .. mlguestfs.cmxa $< -o $@ +debug_logging: debug_logging.ml + $(OCAMLFIND) ocamlopt $(OCAMLFINDFLAGS) -package unix -linkpkg \ + -warn-error A -I .. mlguestfs.cmxa $< -o $@ + inspect_vm: inspect_vm.ml $(OCAMLFIND) ocamlopt $(OCAMLFINDFLAGS) -package unix -linkpkg \ -warn-error A -I .. mlguestfs.cmxa $< -o $@ @@ -62,6 +68,10 @@ create_disk: create_disk.ml $(OCAMLFIND) ocamlc $(OCAMLFINDFLAGS) -package unix -linkpkg \ -warn-error A -I .. mlguestfs.cma -custom $< -o $@ +debug_logging: debug_logging.ml + $(OCAMLFIND) ocamlc $(OCAMLFINDFLAGS) -package unix -linkpkg \ + -warn-error A -I .. mlguestfs.cma -custom $< -o $@ + inspect_vm: inspect_vm.ml $(OCAMLFIND) ocamlc $(OCAMLFINDFLAGS) -package unix -linkpkg \ -warn-error A -I .. mlguestfs.cma -custom $< -o $@ diff --git a/ocaml/examples/debug_logging.ml b/ocaml/examples/debug_logging.ml new file mode 100644 index 000000000..5886ec6b1 --- /dev/null +++ b/ocaml/examples/debug_logging.ml @@ -0,0 +1,74 @@ +(* Example showing how to enable debugging, and capture it into any + * custom logging system. + *) + +(* Events we are interested in. This bitmask covers all trace and + * debug messages. + *) +let event_bitmask = [ + Guestfs.EVENT_LIBRARY; + Guestfs.EVENT_WARNING; + Guestfs.EVENT_APPLIANCE; + Guestfs.EVENT_TRACE +] + +let rec main () = + let g = new Guestfs.guestfs () in + + (* By default, debugging information is printed on stderr. To + * capture it somewhere else you have to set up an event handler + * which will be called back as debug messages are generated. To do + * this use the event API. + * + * For more information see EVENTS in guestfs(3). + *) + ignore (g#set_event_callback message_callback event_bitmask); + + (* This is how debugging is enabled: + * + * Setting the 'trace' flag in the handle means that each libguestfs + * call is logged (name, parameters, return). This flag is useful + * to see how libguestfs is being used by a program. + * + * Setting the 'verbose' flag enables a great deal of extra + * debugging throughout the system. This is useful if there is a + * libguestfs error which you don't understand. + * + * Note that you should set the flags early on after creating the + * handle. In particular if you set the verbose flag after launch + * then you won't see all messages. + * + * For more information see: + * http://libguestfs.org/guestfs-faq.1.html#debugging-libguestfs + * + * Error messages raised by APIs are *not* debugging information, + * and they are not affected by any of this. You may have to log + * them separately. + *) + g#set_trace true; + g#set_verbose true; + + (* Do some operations which will generate plenty of trace and debug + * messages. + *) + g#add_drive "/dev/null"; + g#launch (); + g#close () + +(* This function is called back by libguestfs whenever a trace or + * debug message is generated. + * + * For the classes of events we have registered above, 'array' and + * 'array_len' will not be meaningful. Only 'buf' and 'buf_len' will + * be interesting and these will contain the trace or debug message. + * + * This example simply redirects these messages to syslog, but + * obviously you could do something more advanced here. + *) +and message_callback g event event_handle buf array = + if String.length buf > 0 then ( + let event_name = Guestfs.event_to_string [event] in + Printf.printf "[%s] %S\n%!" event_name buf + ) + +let () = main () diff --git a/ocaml/examples/guestfs-ocaml.pod b/ocaml/examples/guestfs-ocaml.pod index f185914bc..523a60466 100644 --- a/ocaml/examples/guestfs-ocaml.pod +++ b/ocaml/examples/guestfs-ocaml.pod @@ -65,13 +65,17 @@ Calling any function/method on a closed handle raises C. The single parameter is the name of the function that you called. -=head1 EXAMPLE 1: CREATE A DISK IMAGE +=head1 EXAMPLE: CREATE A DISK IMAGE -@EXAMPLE1@ +@CREATE_DISK@ -=head1 EXAMPLE 2: INSPECT A VIRTUAL MACHINE DISK IMAGE +=head1 EXAMPLE: INSPECT A VIRTUAL MACHINE DISK IMAGE -@EXAMPLE2@ +@INSPECT_VM@ + +=head1 EXAMPLE: ENABLE DEBUGGING AND LOGGING + +@DEBUG_LOGGING@ =head1 SEE ALSO