[Pkg-libvirt-commits] [libguestfs] 151/384: ocaml: Convert debug_logging example from C to OCaml.
Hilko Bengen
bengen at moszumanska.debian.org
Sun Mar 29 16:56:29 UTC 2015
This is an automated email from the git hooks/post-receive script.
bengen pushed a commit to branch experimental
in repository libguestfs.
commit 378ed3be5e8fffbd45df785fee68b6862eb55398
Author: Richard W.M. Jones <rjones at redhat.com>
Date: Thu Jan 1 06:11:39 2015 +0000
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(-)
diff --git a/.gitignore b/.gitignore
index 59bcfc0..4c1b90c 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 de647fc..4955727 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 0000000..5886ec6
--- /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 f185914..523a604 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<Guestfs.Handle_closed>. 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
- at EXAMPLE1@
+ at CREATE_DISK@
-=head1 EXAMPLE 2: INSPECT A VIRTUAL MACHINE DISK IMAGE
+=head1 EXAMPLE: INSPECT A VIRTUAL MACHINE DISK IMAGE
- at EXAMPLE2@
+ at INSPECT_VM@
+
+=head1 EXAMPLE: ENABLE DEBUGGING AND LOGGING
+
+ at DEBUG_LOGGING@
=head1 SEE ALSO
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-libvirt/libguestfs.git
More information about the Pkg-libvirt-commits
mailing list