ocaml: Translate C examples into OCaml and include documentation.

.gitignore

@@ -116,6 +116,7 @@ haskell/Guestfs.hs
 html/guestfish.1.html
 html/guestfs.3.html
 html/guestfs-examples.3.html
+html/guestfs-ocaml.3.html
 html/guestmount.1.html
 html/recipes.html
 html/virt-cat.1.html
@@ -198,7 +199,10 @@ missing
 ocaml/bindtests
 ocaml/bindtests.ml
 ocaml/dllmlguestfs.so
-ocaml/examples/lvs
+ocaml/examples/create_disk
+ocaml/examples/guestfs-ocaml.3
+ocaml/examples/inspect_vm
+ocaml/examples/stamp-guestfs-ocaml.pod
 ocaml/guestfs_c_actions.c
 ocaml/guestfs_inspector.ml
 ocaml/guestfs_inspector.mli

Makefile.am

@@ -103,6 +103,7 @@ html/recipes.html: $(wildcard recipes/*.sh) $(wildcard recipes/*.html) $(wildcar
 HTMLFILES = \
 	html/guestfs.3.html \
 	html/guestfs-examples.3.html \
+	html/guestfs-ocaml.3.html \
 	html/guestfish.1.html \
 	html/guestmount.1.html \
 	html/virt-cat.1.html \

ocaml/examples/LICENSE

@@ -1,9 +1,2 @@
-All the examples in the ocaml/examples/ subdirectory may be freely
-copied without any restrictions.
-
-The files 'Throbber.png' and 'Throbber.gif' come from the source to
-Firefox, and you should check the Firefox license before
-redistributing those files.
-
-The files 'xmllight_loader.ml' and 'xmllight_loader.mli' come from
-http://yquem.inria.fr/~frisch/ocamlcduce/samples/xmllight/
+All the examples in the 'ocaml/examples' subdirectory may be freely
+copied, modified and distributed without any restrictions.

ocaml/examples/Makefile.am

@@ -1,16 +1,56 @@
-EXTRA_DIST = \
-	LICENSE README \
-	lvs.ml
+# libguestfs OCaml examples
+# Copyright (C) 2010 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
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 
-CLEANFILES = throbber.ml *.cmi *.cmo *.cmx *.o lvs
+EXTRA_DIST = \
+	LICENSE \
+	create_disk.ml \
+	inspect_vm.ml \
+	guestfs-ocaml.pod
+
+CLEANFILES = \
+	*.cmi *.cmo *.cmx *.o create_disk inspect_vm \
+	stamp-guestfs-ocaml.pod
+
+man_MANS = guestfs-ocaml.3
+noinst_DATA = $(top_builddir)/html/guestfs-ocaml.3.html
+
+guestfs-ocaml.3 $(top_builddir)/html/guestfs-ocaml.3.html: stamp-guestfs-ocaml.pod
+
+stamp-guestfs-ocaml.pod: guestfs-ocaml.pod create_disk.ml inspect_vm.ml
+	$(top_srcdir)/podwrapper.sh \
+	  --section 3 \
+	  --man guestfs-ocaml.3 \
+	  --html $(top_builddir)/html/guestfs-ocaml.3.html \
+	  --verbatim create_disk.ml:@EXAMPLE1@ \
+	  --verbatim inspect_vm.ml:@EXAMPLE2@ \
+	  $<
+	touch $@
 
 if HAVE_OCAML
 
-noinst_SCRIPTS = lvs
+noinst_SCRIPTS = create_disk inspect_vm
 
 OCAMLFINDFLAGS = -cclib -L$(top_builddir)/src/.libs
 
-lvs:	lvs.ml
+create_disk: create_disk.ml
+	$(OCAMLFIND) ocamlopt $(OCAMLFINDFLAGS) -package unix -linkpkg \
+          -warn-error A -I .. mlguestfs.cmxa $< -o $@
+
+inspect_vm: inspect_vm.ml
 	$(OCAMLFIND) ocamlopt $(OCAMLFINDFLAGS) \
           -warn-error A -I .. mlguestfs.cmxa $< -o $@
 

ocaml/examples/README

@@ -1,9 +0,0 @@
-This directory contains various example programs which use the OCaml
-Guestfs bindings to the libguestfs API.
-
-As they are examples, these are licensed so they can be freely copied
-and used without any restrictions.
-
-Tips:
-
-(1) To enable verbose messages, set environment variable LIBGUESTFS_DEBUG=1

ocaml/examples/create_disk.ml

@@ -0,0 +1,73 @@
+(* Example showing how to create a disk image. *)
+
+open Unix
+open Printf
+
+let output = "disk.img"
+
+let () =
+  let g = new Guestfs.guestfs () in
+
+  (* Create a raw-format sparse disk image, 512 MB in size. *)
+  let fd = openfile output [O_WRONLY;O_CREAT;O_TRUNC;O_NOCTTY] 0o666 in
+  ftruncate fd (512 * 1024 * 1024);
+  close fd;
+
+  (* Set the trace flag so that we can see each libguestfs call. *)
+  g#set_trace true;
+
+  (* Set the autosync flag so that the disk will be synchronized
+   * automatically when the libguestfs handle is closed.
+   *)
+  g#set_autosync true;
+
+  (* Attach the disk image to libguestfs. *)
+  g#add_drive_opts ~format:"raw" ~readonly:false output;
+
+  (* Run the libguestfs back-end. *)
+  g#launch ();
+
+  (* Get the list of devices.  Because we only added one drive
+   * above, we expect that this list should contain a single
+   * element.
+   *)
+  let devices = g#list_devices () in
+  if Array.length devices <> 1 then
+    failwith "error: expected a single device from list-devices";
+
+  (* Partition the disk as one single MBR partition. *)
+  g#part_disk devices.(0) "mbr";
+
+  (* Get the list of partitions.  We expect a single element, which
+   * is the partition we have just created.
+   *)
+  let partitions = g#list_partitions () in
+  if Array.length partitions <> 1 then
+    failwith "error: expected a single partition from list-partitions";
+
+  (* Create a filesystem on the partition. *)
+  g#mkfs "ext4" partitions.(0);
+
+  (* Now mount the filesystem so that we can add files. *)
+  g#mount_options "" partitions.(0) "/";
+
+  (* Create some files and directories. *)
+  g#touch "/empty";
+  let message = "Hello, world\n" in
+  g#write "/hello" message;
+  g#mkdir "/foo";
+
+  (* This one uploads the local file /etc/resolv.conf into
+   * the disk image.
+   *)
+  g#upload "/etc/resolv.conf" "/foo/resolv.conf";
+
+  (* Because 'autosync' was set (above) we can just close the handle
+   * and the disk contents will be synchronized.  You can also do
+   * this manually by calling g#umount_all and g#sync.
+   *
+   * Note also that handles are automatically closed if they are
+   * reaped by the garbage collector.  You only need to call close
+   * if you want to close the handle right away.
+   *)
+  g#close ()

ocaml/examples/guestfs-ocaml.pod

@@ -0,0 +1,108 @@
+=encoding utf8
+
+=head1 NAME
+
+guestfs-ocaml - How to use libguestfs from OCaml
+
+=head1 SYNOPSIS
+
+Module style:
+
+ let g = Guestfs.create () in
+ Guestfs.add_drive_opts g ~format:"raw" ~readonly:true "disk.img";
+ Guestfs.launch g;
+
+Object-oriented style:
+
+ let g = new Guestfs.guestfs () in
+ g#add_drive_opts ~format:"raw" ~readonly:true "disk.img";
+ g#launch ();
+
+ ocamlfind opt prog.ml -package guestfs -linkpkg -o prog
+or:
+ ocamlopt -I +guestfs mlguestfs.cmxa prog.ml -o prog
+
+=head1 DESCRIPTION
+
+This manual page documents how to call libguestfs from the OCaml
+programming language.  This page just documents the differences from
+the C API and gives some examples.  If you are not familiar with using
+libguestfs, you also need to read L<guestfs(3)>.
+
+=head2 PROGRAMMING STYLES
+
+There are two different programming styles supported by the OCaml
+bindings.  You can use a module style, with each C function mapped to
+an OCaml function:
+
+ int guestfs_set_verbose (guestfs_h *g, int flag);
+
+becomes:
+
+ val Guestfs.set_verbose : Guestfs.t -> bool -> unit
+
+Alternately you can use an object-oriented style, calling methods
+on the class C<Guestfs.guestfs>:
+
+ method set_verbose : bool -> unit
+
+The object-oriented style is usually briefer, and the minor performance
+penalty isn't noticable in the general overhead of performing
+libguestfs functions.
+
+=head2 CLOSING THE HANDLE
+
+The handle is closed when it is reaped by the garbage collector.
+Because libguestfs handles include a lot of state, it is also
+possible to close (and hence free) them explicitly by calling
+C<Guestfs.close> or the C<#close> method.
+
+=head2 EXCEPTIONS
+
+Errors from libguestfs functions are mapped into the C<Guestfs.Error>
+exception.  This has a single parameter which is the error message (a
+string).
+
+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
+
+@EXAMPLE1@
+
+=head1 EXAMPLE 2: INSPECT A VIRTUAL MACHINE DISK IMAGE
+
+@EXAMPLE2@
+
+=head1 SEE ALSO
+
+L<guestfs(3)>,
+L<guestfs-examples(3)>,
+L<http://libguestfs.org/>,
+L<http://caml.inria.fr/>.
+
+=head1 AUTHORS
+
+Richard W.M. Jones (C<rjones at redhat dot com>)
+
+=head1 COPYRIGHT
+
+Copyright (C) 2010 Red Hat Inc. L<http://libguestfs.org/>
+
+The examples in this manual page may be freely copied, modified and
+distributed without any restrictions.
+
+This library 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; either
+version 2 of the License, or (at your option) any later version.
+
+This library 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.
+
+You should have received a copy of the GNU Lesser General Public
+License along with this library; if not, write to the Free Software
+Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA

ocaml/examples/inspect_vm.ml

@@ -0,0 +1,58 @@
+(* Example showing how to inspect a virtual machine disk. *)
+
+open Printf
+
+let disk =
+  if Array.length Sys.argv = 2 then
+    Sys.argv.(1)
+  else
+    failwith "usage: inspect_vm disk.img"
+
+let () =
+  let g = new Guestfs.guestfs () in
+
+  (* Attach the disk image read-only to libguestfs. *)
+  g#add_drive_opts (*~format:"raw"*) ~readonly:true disk;
+
+  (* Run the libguestfs back-end. *)
+  g#launch ();
+
+  (* Ask libguestfs to inspect for operating systems. *)
+  let roots = g#inspect_os () in
+  if Array.length roots = 0 then
+    failwith "inspect_vm: no operating systems found";
+
+  Array.iter (
+    fun root ->
+      printf "Root device: %s\n" root;
+
+      (* Print basic information about the operating system. *)
+      printf "  Product name: %s\n" (g#inspect_get_product_name root);
+      printf "  Version:      %d.%d\n"
+        (g#inspect_get_major_version root)
+        (g#inspect_get_minor_version root);
+      printf "  Type:         %s\n" (g#inspect_get_type root);
+      printf "  Distro:       %s\n" (g#inspect_get_distro root);
+
+      (* Mount up the disks, like guestfish -i.
+       *
+       * Sort keys by length, shortest first, so that we end up
+       * mounting the filesystems in the correct order.
+       *)
+      let mps = g#inspect_get_mountpoints root in
+      let cmp (a,_) (b,_) =
+        compare (String.length a) (String.length b) in
+      let mps = List.sort cmp mps in
+      List.iter (fun (mp, dev) -> g#mount_ro dev mp) mps;
+
+      (* If /etc/issue.net file exists, print up to 3 lines. *)
+      let filename = "/etc/issue.net" in
+      if g#is_file filename then (
+        printf "--- %s ---\n" filename;
+        let lines = g#head_n 3 filename in
+        Array.iter print_endline lines
+      );
+
+      (* Unmount everything. *)
+      g#umount_all ()
+  ) roots

ocaml/examples/lvs.ml

@@ -1,25 +0,0 @@
-(* An example using the OCaml bindings. *)
-
-open Printf
-
-let () =
-  if Array.length Sys.argv <= 1 || not (Sys.file_exists Sys.argv.(1)) then (
-    eprintf "Usage: lvs guest.img\n";
-    exit 1
-  );
-
-  let h = Guestfs.create () in
-  Guestfs.add_drive_opts h ~format:"raw" Sys.argv.(1);
-  Guestfs.launch h;
-
-  let pvs = Guestfs.pvs h in
-  printf "PVs found: [ %s ]\n" (String.concat "; " (Array.to_list pvs));
-
-  let vgs = Guestfs.vgs h in
-  printf "VGs found: [ %s ]\n" (String.concat "; " (Array.to_list vgs));
-
-  let lvs = Guestfs.lvs h in
-  printf "LVs found: [ %s ]\n" (String.concat "; " (Array.to_list lvs));
-
-  (* Helps to find any allocation errors. *)
-  Gc.compact ()

src/guestfs.pod

@@ -657,7 +657,7 @@ with libguestfs.
 
 =item B<OCaml>
 
-For documentation see the file C<guestfs.mli>.
+For documentation see L<guestfs-ocaml(3)>.
 
 =item B<Perl>
 
@@ -2087,6 +2087,7 @@ enough.
 =head1 SEE ALSO
 
 L<guestfs-examples(3)>,
+L<guestfs-ocaml(3)>,
 L<guestfish(1)>,
 L<guestmount(1)>,
 L<virt-cat(1)>,