[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