ocaml: Convert debug_logging example from C to OCaml.

Continue gradual conversion of C examples to other languages.

.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

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 $@

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 ()

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
 
-@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