Libguestfs - Mar 2014 - [PATCH 1/4] ocaml: Add Guestfs.Errno submodule exposing useful raw errno numbers.

For use when calling G.last_errno.
---
 generator/ocaml.ml | 15 +++++++++++++++
 ocaml/guestfs-c.c  |  8 ++++++++
 2 files changed, 23 insertions(+)

diff --git a/generator/ocaml.ml b/generator/ocaml.ml
index 78cff89..29a9eb6 100644
--- a/generator/ocaml.ml
+++ b/generator/ocaml.ml
@@ -121,10 +121,20 @@ val last_errno : t -> int
     (or [0] if there was no errno).  Note that the returned integer is the
     raw errno number, and it is {i not} related to the {!Unix.error} type.
 
+    Some raw errno numbers are exposed by the {!Guestfs.Errno} submodule,
+    and we can add more as required.
+
     [last_errno] can be overwritten by subsequent operations on a handle,
     so if you want to capture the errno correctly, you must call this
     in the {!Error} exception handler, before any other operation on [g]. *)
 
+(** The [Guestfs.Errno] submodule exposes some raw errno numbers,
+    which you can use to test the return value of {!Guestfs.last_errno}. *)
+
+module Errno : sig
+  val errno_ENOTSUP : int
+end
+
 ";
   generate_ocaml_structure_decls ();
 
@@ -253,6 +263,11 @@ external event_to_string : event list -> string
 
 external last_errno : t -> int = \"ocaml_guestfs_last_errno\"
 
+module Errno = struct
+  external enotsup : unit -> int = \"ocaml_guestfs_get_ENOTSUP\"
\"noalloc\"
+  let errno_ENOTSUP = enotsup ()
+end
+
 (* Give the exceptions names, so they can be raised from the C code. *)
 let ()    Callback.register_exception \"ocaml_guestfs_error\" (Error
\"\");
diff --git a/ocaml/guestfs-c.c b/ocaml/guestfs-c.c
index 98a9ba0..bd1ffb7 100644
--- a/ocaml/guestfs-c.c
+++ b/ocaml/guestfs-c.c
@@ -63,6 +63,7 @@ value ocaml_guestfs_set_event_callback (value gv, value
closure, value events);
 value ocaml_guestfs_delete_event_callback (value gv, value eh);
 value ocaml_guestfs_event_to_string (value events);
 value ocaml_guestfs_last_errno (value gv);
+value ocaml_guestfs_get_ENOTSUP (value unitv);
 
 /* Allocate handles and deal with finalization. */
 static void
@@ -438,3 +439,10 @@ ocaml_guestfs_last_errno (value gv)
   rv = Val_int (r);
   CAMLreturn (rv);
 }
+
+/* NB: "noalloc" function. */
+value
+ocaml_guestfs_get_ENOTSUP (value unitv)
+{
+  return Val_int (ENOTSUP);
+}
-- 
1.8.5.3

---
 src/launch-direct.c | 49 +++++++++++++++++++++++--------------------------
 1 file changed, 23 insertions(+), 26 deletions(-)

diff --git a/src/launch-direct.c b/src/launch-direct.c
index 3d478c7..0f6e2fc 100644
--- a/src/launch-direct.c
+++ b/src/launch-direct.c
@@ -1417,46 +1417,43 @@ guestfs___discard_possible (guestfs_h *g, struct drive
*drv,
    */
   bool qemu16 = qemu_version >= 1006000;
 
-  if (!qemu15) {
-    error (g, _("discard cannot be enabled on this drive: "
-                "qemu < 1.5"));
-    return false;
-  }
+  if (!qemu15)
+    NOT_SUPPORTED (g, false,
+                   _("discard cannot be enabled on this drive: "
+                     "qemu < 1.5"));
 
   /* If it's an overlay, discard is not possible (on the underlying
    * file).  This has probably been caught earlier since we already
    * checked that the drive is !readonly.  Nevertheless ...
    */
-  if (drv->overlay) {
-    error (g, _("discard cannot be enabled on this drive: "
-                "the drive has a read-only overlay"));
-    return false;
-  }
+  if (drv->overlay)
+    NOT_SUPPORTED (g, false,
+                   _("discard cannot be enabled on this drive: "
+                     "the drive has a read-only overlay"));
 
   /* Look at the source format. */
   if (drv->src.format == NULL) {
     /* We could autodetect the format, but we don't ... yet. XXX */
-    error (g, _("discard cannot be enabled on this drive: "
-                "you have to specify the format of the file"));
-    return false;
+    NOT_SUPPORTED (g, false,
+                   _("discard cannot be enabled on this drive: "
+                     "you have to specify the format of the file"));
   }
   else if (STREQ (drv->src.format, "raw"))
     /* OK */ ;
   else if (STREQ (drv->src.format, "qcow2")) {
-    if (!qemu16) {
-      error (g, _("discard cannot be enabled on this drive: "
-                  "qemu < 1.6 cannot do discard on qcow2 files"));
-    return false;
-    }
+    if (!qemu16)
+      NOT_SUPPORTED (g, false,
+                     _("discard cannot be enabled on this drive: "
+                       "qemu < 1.6 cannot do discard on qcow2
files"));
   }
   else {
     /* It's possible in future other formats will support discard, but
      * currently (qemu 1.7) none of them do.
      */
-    error (g, _("discard cannot be enabled on this drive: "
-                "qemu does not support discard for '%s' format
files"),
-           drv->src.format);
-    return false;
+    NOT_SUPPORTED (g, false,
+                   _("discard cannot be enabled on this drive: "
+                     "qemu does not support discard for '%s'
format files"),
+                   drv->src.format);
   }
 
   switch (drv->src.protocol) {
@@ -1476,10 +1473,10 @@ guestfs___discard_possible (guestfs_h *g, struct drive
*drv,
   case drive_protocol_https:
   case drive_protocol_ssh:
   case drive_protocol_tftp:
-    error (g, _("discard cannot be enabled on this drive: "
-                "protocol '%s' does not support discard"),
-           guestfs___drive_protocol_to_string (drv->src.protocol));
-    return false;
+    NOT_SUPPORTED (g, -1,
+                   _("discard cannot be enabled on this drive: "
+                     "protocol '%s' does not support
discard"),
+                   guestfs___drive_protocol_to_string (drv->src.protocol));
   }
 
   return true;
-- 
1.8.5.3

---
 mllib/common_utils.ml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/mllib/common_utils.ml b/mllib/common_utils.ml
index de3bd40..094ef10 100644
--- a/mllib/common_utils.ml
+++ b/mllib/common_utils.ml
@@ -187,7 +187,7 @@ let make_message_function ~quiet fs    in
   ksprintf p fs
 
-let error ~prog fs +let error ~prog ?(exit_code = 1) fs    let display str     
wrap ~chan:stderr (sprintf (f_"%s: error: %s") prog str);
     prerr_newline ();
@@ -196,7 +196,7 @@ let error ~prog fs        (sprintf (f_"%s: If reporting
bugs, run %s with debugging enabled (-v) and include the complete output.")
          prog prog);
     prerr_newline ();
-    exit 1
+    exit exit_code
   in
   ksprintf display fs
 
-- 
1.8.5.3

Also skip the test in this case instead of failing.
---
 sparsify/cmdline.ml                     |  2 +-
 sparsify/in_place.ml                    | 13 ++++++++++++-
 sparsify/test-virt-sparsify-in-place.sh |  8 +++++++-
 sparsify/virt-sparsify.pod              | 19 +++++++++++++++++++
 4 files changed, 39 insertions(+), 3 deletions(-)

diff --git a/sparsify/cmdline.ml b/sparsify/cmdline.ml
index d25e9e9..c96de57 100644
--- a/sparsify/cmdline.ml
+++ b/sparsify/cmdline.ml
@@ -24,7 +24,7 @@ open Common_gettext.Gettext
 open Common_utils
 
 let prog = Filename.basename Sys.executable_name
-let error fs = error ~prog fs
+let error ?exit_code fs = error ~prog ?exit_code fs
 
 type mode_t  | Mode_copying of string * check_t * bool * string option * string
option
diff --git a/sparsify/in_place.ml b/sparsify/in_place.ml
index 9f46ad3..624f676 100644
--- a/sparsify/in_place.ml
+++ b/sparsify/in_place.ml
@@ -28,12 +28,23 @@ module G = Guestfs
 open Common_utils
 open Cmdline
 
-let run disk format ignores machine_readable quiet verbose trace zeroes +let
rec run disk format ignores machine_readable quiet verbose trace zeroes    (*
Connect to libguestfs. *)
   let g = new G.guestfs () in
   if trace then g#set_trace true;
   if verbose then g#set_verbose true;
 
+  try
+    perform g disk format ignores machine_readable quiet zeroes
+  with
+    G.Error msg as exn ->
+      if g#last_errno () = G.Errno.errno_ENOTSUP then (
+        (* for exit code 3, see man page *)
+        error ~exit_code:3 (f_"discard/trim is not supported: %s")
msg;
+      )
+      else raise exn
+
+and perform g disk format ignores machine_readable quiet zeroes    (* XXX
Current limitation of the API.  Can remove this hunk in future. *)
   let format      match format with
diff --git a/sparsify/test-virt-sparsify-in-place.sh
b/sparsify/test-virt-sparsify-in-place.sh
index 56311a0..dd32963 100755
--- a/sparsify/test-virt-sparsify-in-place.sh
+++ b/sparsify/test-virt-sparsify-in-place.sh
@@ -49,7 +49,13 @@ EOF
 
 size_before=$(du -s test-virt-sparsify-in-place.img | awk '{print $1}')
 
-$VG ./virt-sparsify --debug-gc --in-place test-virt-sparsify-in-place.img
+$VG ./virt-sparsify --debug-gc --in-place test-virt-sparsify-in-place.img || {
+    if [ "$?" -eq 3 ]; then
+        echo "$0: discard not supported in virt-sparsify"
+        exit 77
+    fi
+    exit 1
+}
 
 size_after=$(du -s test-virt-sparsify-in-place.img | awk '{print $1}')
 
diff --git a/sparsify/virt-sparsify.pod b/sparsify/virt-sparsify.pod
index c12a15f..de07439 100644
--- a/sparsify/virt-sparsify.pod
+++ b/sparsify/virt-sparsify.pod
@@ -381,6 +381,25 @@ temporary space are B<not> required.
 
 For other environment variables, see L<guestfs(3)/ENVIRONMENT VARIABLES>.
 
+=head1 EXIT STATUS
+
+This program returns 0 if the operation completed without errors.
+(This doesn't necessarily mean that space could be freed up.)
+
+A non-zero exit code indicates an error.
+
+If the exit code is C<3> and the I<--in-place> option was used,
that
+indicates that discard support is not available in libguestfs, so
+copying mode must be used instead.
+
+=over 4
+
+=item 0
+
+successful exit
+
+=back
+
 =head1 SEE ALSO
 
 L<virt-filesystems(1)>,
-- 
1.8.5.3

On Mon, Mar 17, 2014 at 12:32:25PM +0000, Richard W.M. Jones
wrote:
> +
> +=over 4
> +
> +=item 0
> +
> +successful exit
> +
> +=back
Sorry, this part should be deleted.

Rich.

-- 
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
virt-top is 'top' for virtual machines.  Tiny program with many
powerful monitoring features, net stats, disk stats, logging, etc.
http://people.redhat.com/~rjones/virt-top