Haskell bindings: Int and Int64 return types.

[libguestfs.git] / src / generator.ml

diff --git a/src/generator.ml b/src/generator.ml
index c4f2851..9c0632e 100755 (executable)
--- a/src/generator.ml
+++ b/src/generator.ml
@@ -143,13 +143,6 @@ can easily destroy all your data>."
  *
  * Between each test we blockdev-setrw, umount-all, lvm-remove-all.
  *
  *
  * Between each test we blockdev-setrw, umount-all, lvm-remove-all.
  *

- * If the appliance is running an older Linux kernel (eg. RHEL 5) then
- * devices are named /dev/hda etc.  To cope with this, the test suite
- * adds some hairly logic to detect this case, and then automagically
- * replaces all strings which match "/dev/sd.*" with "/dev/hd.*".
- * When writing test cases you shouldn't have to worry about this
- * difference.
- *

  * Don't assume anything about the previous contents of the block
  * devices.  Use 'Init*' to create some initial scenarios.
  *
  * Don't assume anything about the previous contents of the block
  * devices.  Use 'Init*' to create some initial scenarios.
  *


@@ -380,7 +373,7 @@ for whatever operations you want to perform (ie. read access if you
 just want to read the image or write access if you want to modify the
 image).
 
 just want to read the image or write access if you want to modify the
 image).
 

-This is equivalent to the qemu parameter C<-drive file=filename>.
+This is equivalent to the qemu parameter C<-drive file=filename,cache=off>.

 
 Note that this call checks for the existence of C<filename>.  This
 stops you from specifying other types of drive which are supported
 
 Note that this call checks for the existence of C<filename>.  This
 stops you from specifying other types of drive which are supported


@@ -1377,7 +1370,9 @@ or compatible processor architecture).
 The single parameter is an argv-style list of arguments.
 The first element is the name of the program to run.
 Subsequent elements are parameters.  The list must be
 The single parameter is an argv-style list of arguments.
 The first element is the name of the program to run.
 Subsequent elements are parameters.  The list must be

-non-empty (ie. must contain a program name).
+non-empty (ie. must contain a program name).  Note that
+the command runs directly, and is I<not> invoked via
+the shell (see C<guestfs_sh>).

 
 The return value is anything printed to I<stdout> by
 the command.
 
 The return value is anything printed to I<stdout> by
 the command.


@@ -1445,7 +1440,9 @@ locations.");
    "run a command, returning lines",
    "\
 This is the same as C<guestfs_command>, but splits the
    "run a command, returning lines",
    "\
 This is the same as C<guestfs_command>, but splits the

-result into a list of lines.");
+result into a list of lines.
+
+See also: C<guestfs_sh_lines>");

 
   ("stat", (RStat "statbuf", [String "path"]), 52, [],
    [InitBasicFS, Always, TestOutputStruct (
 
   ("stat", (RStat "statbuf", [String "path"]), 52, [],
    [InitBasicFS, Always, TestOutputStruct (


@@ -1662,7 +1659,10 @@ See also C<guestfs_upload>, C<guestfs_cat>.");
       [["write_file"; "/new"; "test\n"; "0"];
        ["checksum"; "sha512"; "/new"]], "0e3e75234abc68f4378a86b3f4b32a198ba301845b0cd6e50106e874345700cc6663a86c1ea125dc5e92be17c98f9a0f85ca9d5f595db2012f7cc3571945c123");
     InitBasicFS, Always, TestOutput (
       [["write_file"; "/new"; "test\n"; "0"];
        ["checksum"; "sha512"; "/new"]], "0e3e75234abc68f4378a86b3f4b32a198ba301845b0cd6e50106e874345700cc6663a86c1ea125dc5e92be17c98f9a0f85ca9d5f595db2012f7cc3571945c123");
     InitBasicFS, Always, TestOutput (

-      [["mount"; "/dev/sdd"; "/"];
+      (* RHEL 5 thinks this is an HFS+ filesystem unless we give
+       * the type explicitly.
+       *)
+      [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];

        ["checksum"; "md5"; "/known-3"]], "46d6ca27ee07cdc6fa99c2e138cc522c")],
    "compute MD5, SHAx or CRC checksum of file",
    "\
        ["checksum"; "md5"; "/known-3"]], "46d6ca27ee07cdc6fa99c2e138cc522c")],
    "compute MD5, SHAx or CRC checksum of file",
    "\


@@ -1982,7 +1982,9 @@ This command writes zeroes over the first few blocks of C<device>.
 
 How many blocks are zeroed isn't specified (but it's I<not> enough
 to securely wipe the device).  It should be sufficient to remove
 
 How many blocks are zeroed isn't specified (but it's I<not> enough
 to securely wipe the device).  It should be sufficient to remove

-any partition tables, filesystem superblocks and so on.");
+any partition tables, filesystem superblocks and so on.
+
+See also: C<guestfs_scrub_device>.");

 
   ("grub_install", (RErr, [String "root"; String "device"]), 86, [],
    [InitBasicFS, Always, TestOutputTrue (
 
   ("grub_install", (RErr, [String "root"; String "device"]), 86, [],
    [InitBasicFS, Always, TestOutputTrue (


@@ -2347,6 +2349,124 @@ The return value is an integer which C<0> if the operation
 would succeed, or some non-zero value documented in the
 L<ntfs-3g.probe(8)> manual page.");
 
 would succeed, or some non-zero value documented in the
 L<ntfs-3g.probe(8)> manual page.");
 

+  ("sh", (RString "output", [String "command"]), 111, [],
+   [], (* XXX needs tests *)
+   "run a command via the shell",
+   "\
+This call runs a command from the guest filesystem via the
+guest's C</bin/sh>.
+
+This is like C<guestfs_command>, but passes the command to:
+
+ /bin/sh -c \"command\"
+
+Depending on the guest's shell, this usually results in
+wildcards being expanded, shell expressions being interpolated
+and so on.
+
+All the provisos about C<guestfs_command> apply to this call.");
+
+  ("sh_lines", (RStringList "lines", [String "command"]), 112, [],
+   [], (* XXX needs tests *)
+   "run a command via the shell returning lines",
+   "\
+This is the same as C<guestfs_sh>, but splits the result
+into a list of lines.
+
+See also: C<guestfs_command_lines>");
+
+  ("glob_expand", (RStringList "paths", [String "pattern"]), 113, [],
+   [InitBasicFS, Always, TestOutputList (
+      [["mkdir_p"; "/a/b/c"];
+       ["touch"; "/a/b/c/d"];
+       ["touch"; "/a/b/c/e"];
+       ["glob_expand"; "/a/b/c/*"]], ["/a/b/c/d"; "/a/b/c/e"]);
+    InitBasicFS, Always, TestOutputList (
+      [["mkdir_p"; "/a/b/c"];
+       ["touch"; "/a/b/c/d"];
+       ["touch"; "/a/b/c/e"];
+       ["glob_expand"; "/a/*/c/*"]], ["/a/b/c/d"; "/a/b/c/e"]);
+    InitBasicFS, Always, TestOutputList (
+      [["mkdir_p"; "/a/b/c"];
+       ["touch"; "/a/b/c/d"];
+       ["touch"; "/a/b/c/e"];
+       ["glob_expand"; "/a/*/x/*"]], [])],
+   "expand a wildcard path",
+   "\
+This command searches for all the pathnames matching
+C<pattern> according to the wildcard expansion rules
+used by the shell.
+
+If no paths match, then this returns an empty list
+(note: not an error).
+
+It is just a wrapper around the C L<glob(3)> function
+with flags C<GLOB_MARK|GLOB_BRACE>.
+See that manual page for more details.");
+
+  ("scrub_device", (RErr, [String "device"]), 114, [DangerWillRobinson],
+   [InitNone, Always, TestRun (        (* use /dev/sdc because it's smaller *)
+      [["scrub_device"; "/dev/sdc"]])],
+   "scrub (securely wipe) a device",
+   "\
+This command writes patterns over C<device> to make data retrieval
+more difficult.
+
+It is an interface to the L<scrub(1)> program.  See that
+manual page for more details.");
+
+  ("scrub_file", (RErr, [String "file"]), 115, [],
+   [InitBasicFS, Always, TestRun (
+      [["write_file"; "/file"; "content"; "0"];
+       ["scrub_file"; "/file"]])],
+   "scrub (securely wipe) a file",
+   "\
+This command writes patterns over a file to make data retrieval
+more difficult.
+
+The file is I<removed> after scrubbing.
+
+It is an interface to the L<scrub(1)> program.  See that
+manual page for more details.");
+
+  ("scrub_freespace", (RErr, [String "dir"]), 116, [],
+   [], (* XXX needs testing *)
+   "scrub (securely wipe) free space",
+   "\
+This command creates the directory C<dir> and then fills it
+with files until the filesystem is full, and scrubs the files
+as for C<guestfs_scrub_file>, and deletes them.
+The intention is to scrub any free space on the partition
+containing C<dir>.
+
+It is an interface to the L<scrub(1)> program.  See that
+manual page for more details.");
+
+  ("mkdtemp", (RString "dir", [String "template"]), 117, [],
+   [InitBasicFS, Always, TestRun (
+      [["mkdir"; "/tmp"];
+       ["mkdtemp"; "/tmp/tmpXXXXXX"]])],
+   "create a temporary directory",
+   "\
+This command creates a temporary directory.  The
+C<template> parameter should be a full pathname for the
+temporary directory name with the final six characters being
+\"XXXXXX\".
+
+For example: \"/tmp/myprogXXXXXX\" or \"/Temp/myprogXXXXXX\",
+the second one being suitable for Windows filesystems.
+
+The name of the temporary directory that was created
+is returned.
+
+The temporary directory is created with mode 0700
+and is owned by root.
+
+The caller is responsible for deleting the temporary
+directory and its contents after use.
+
+See also: L<mkdtemp(3)>");
+

 ]
 
 let all_functions = non_daemon_functions @ daemon_functions
 ]
 
 let all_functions = non_daemon_functions @ daemon_functions


@@ -3631,7 +3751,7 @@ and generate_daemon_actions () =
   ) daemon_functions;
 
   pr "    default:\n";
   ) daemon_functions;
 
   pr "    default:\n";

-  pr "      reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
+  pr "      reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d, set LIBGUESTFS_PATH to point to the matching libguestfs appliance directory\", proc_nr);\n";

   pr "  }\n";
   pr "}\n";
   pr "\n";
   pr "  }\n";
   pr "}\n";
   pr "\n";


@@ -3984,11 +4104,18 @@ int main (int argc, char *argv[])
     printf (\"guestfs_launch FAILED\\n\");
     exit (1);
   }
     printf (\"guestfs_launch FAILED\\n\");
     exit (1);
   }

+
+  /* Set a timeout in case qemu hangs during launch (RHBZ#505329). */
+  alarm (600);
+

   if (guestfs_wait_ready (g) == -1) {
     printf (\"guestfs_wait_ready FAILED\\n\");
     exit (1);
   }
 
   if (guestfs_wait_ready (g) == -1) {
     printf (\"guestfs_wait_ready FAILED\\n\");
     exit (1);
   }
 

+  /* Cancel previous alarm. */
+  alarm (0);
+

   nr_tests = %d;
 
 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024) nr_tests;
   nr_tests = %d;
 
 " (500 * 1024 * 1024) (50 * 1024 * 1024) (10 * 1024 * 1024) nr_tests;


@@ -4800,6 +4927,8 @@ generator (const char *text, int state)
     len = strlen (text);
   }
 
     len = strlen (text);
   }
 

+  rl_attempted_completion_over = 1;
+

   while ((name = commands[index]) != NULL) {
     index++;
     if (strncasecmp (name, text, len) == 0)
   while ((name = commands[index]) != NULL) {
     index++;
     if (strncasecmp (name, text, len) == 0)


@@ -4816,8 +4945,12 @@ char **do_completion (const char *text, int start, int end)
   char **matches = NULL;
 
 #ifdef HAVE_LIBREADLINE
   char **matches = NULL;
 
 #ifdef HAVE_LIBREADLINE

+  rl_completion_append_character = ' ';
+

   if (start == 0)
     matches = rl_completion_matches (text, generator);
   if (start == 0)
     matches = rl_completion_matches (text, generator);

+  else if (complete_dest_paths)
+    matches = rl_completion_matches (text, complete_dest_paths_generator);

 #endif
 
   return matches;
 #endif
 
   return matches;


@@ -6432,6 +6565,7 @@ static VALUE ruby_guestfs_close (VALUE gv)
       List.iter (
        function
        | String n | FileIn n | FileOut n ->
       List.iter (
        function
        | String n | FileIn n | FileOut n ->

+           pr "  Check_Type (%sv, T_STRING);\n" n;

            pr "  const char *%s = StringValueCStr (%sv);\n" n n;
            pr "  if (!%s)\n" n;
            pr "    rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
            pr "  const char *%s = StringValueCStr (%sv);\n" n n;
            pr "  if (!%s)\n" n;
            pr "    rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";


@@ -6439,7 +6573,8 @@ static VALUE ruby_guestfs_close (VALUE gv)
        | OptString n ->
            pr "  const char *%s = !NIL_P (%sv) ? StringValueCStr (%sv) : NULL;\n" n n n
        | StringList n ->
        | OptString n ->
            pr "  const char *%s = !NIL_P (%sv) ? StringValueCStr (%sv) : NULL;\n" n n n
        | StringList n ->

-           pr "  char **%s;" n;
+           pr "  char **%s;\n" n;
+           pr "  Check_Type (%sv, T_ARRAY);\n" n;

            pr "  {\n";
            pr "    int i, len;\n";
            pr "    len = RARRAY_LEN (%sv);\n" n;
            pr "  {\n";
            pr "    int i, len;\n";
            pr "    len = RARRAY_LEN (%sv);\n" n;


@@ -7129,14 +7264,11 @@ and generate_haskell_hs () =
    * at the moment.  Please help out!
    *)
   let can_generate style =
    * at the moment.  Please help out!
    *)
   let can_generate style =

-    let check_no_bad_args =
-      List.for_all (function Bool _ | Int _ -> false | _ -> true)
-    in

     match style with
     match style with

-    | RErr, args -> check_no_bad_args args
-    | RBool _, _
+    | RErr, _

     | RInt _, _
     | RInt _, _

-    | RInt64 _, _
+    | RInt64 _, _ -> true
+    | RBool _, _

     | RConstString _, _
     | RString _, _
     | RStringList _, _
     | RConstString _, _
     | RString _, _
     | RStringList _, _


@@ -7165,6 +7297,7 @@ module Guestfs (
   ) where
 import Foreign
 import Foreign.C
   ) where
 import Foreign
 import Foreign.C

+import Foreign.C.Types

 import IO
 import Control.Exception
 import Data.Typeable
 import IO
 import Control.Exception
 import Data.Typeable


@@ -7228,6 +7361,7 @@ last_error h = do
        pr "%s %s = do\n" name
          (String.concat " " ("h" :: List.map name_of_argt (snd style)));
        pr "  r <- ";
        pr "%s %s = do\n" name
          (String.concat " " ("h" :: List.map name_of_argt (snd style)));
        pr "  r <- ";

+       (* Convert pointer arguments using with* functions. *)

        List.iter (
          function
          | FileIn n
        List.iter (
          function
          | FileIn n


@@ -7235,17 +7369,18 @@ last_error h = do
          | String n -> pr "withCString %s $ \\%s -> " n n
          | OptString n -> pr "maybeWith withCString %s $ \\%s -> " n n
          | StringList n -> pr "withMany withCString %s $ \\%s -> withArray0 nullPtr %s $ \\%s -> " n n n n
          | String n -> pr "withCString %s $ \\%s -> " n n
          | OptString n -> pr "maybeWith withCString %s $ \\%s -> " n n
          | StringList n -> pr "withMany withCString %s $ \\%s -> withArray0 nullPtr %s $ \\%s -> " n n n n

-         | Bool n ->
-             (* XXX this doesn't work *)
-             pr "      let\n";
-             pr "        %s = case %s of\n" n n;
-             pr "          False -> 0\n";
-             pr "          True -> 1\n";
-             pr "      in fromIntegral %s $ \\%s ->\n" n n
-         | Int n -> pr "fromIntegral %s $ \\%s -> " n n
+         | Bool _ | Int _ -> ()

        ) (snd style);
        ) (snd style);

+       (* Convert integer arguments. *)
+       let args =
+         List.map (
+           function
+           | Bool n -> sprintf "(fromBool %s)" n
+           | Int n -> sprintf "(fromIntegral %s)" n
+           | FileIn n | FileOut n | String n | OptString n | StringList n -> n
+         ) (snd style) in

        pr "withForeignPtr h (\\p -> c_%s %s)\n" name
        pr "withForeignPtr h (\\p -> c_%s %s)\n" name

-         (String.concat " " ("p" :: List.map name_of_argt (snd style)));
+         (String.concat " " ("p" :: args));

        (match fst style with
         | RErr | RInt _ | RInt64 _ | RBool _ ->
             pr "  if (r == -1)\n";
        (match fst style with
         | RErr | RInt _ | RInt64 _ | RBool _ ->
             pr "  if (r == -1)\n";


@@ -7719,6 +7854,19 @@ and generate_lang_bindtests call =
 
   (* XXX Add here tests of the return and error functions. *)
 
 
   (* XXX Add here tests of the return and error functions. *)
 

+(* This is used to generate the src/MAX_PROC_NR file which
+ * contains the maximum procedure number, a surrogate for the
+ * ABI version number.  See src/Makefile.am for the details.
+ *)
+and generate_max_proc_nr () =
+  let proc_nrs = List.map (
+    fun (_, _, proc_nr, _, _, _, _) -> proc_nr
+  ) daemon_functions in
+
+  let max_proc_nr = List.fold_left max 0 proc_nrs in
+
+  pr "%d\n" max_proc_nr
+

 let output_to filename =
   let filename_new = filename ^ ".new" in
   chan := open_out filename_new;
 let output_to filename =
   let filename_new = filename ^ ".new" in
   chan := open_out filename_new;


@@ -7891,3 +8039,7 @@ Run it from the top source directory using the command
   let close = output_to "haskell/bindtests.hs" in
   generate_haskell_bindtests ();
   close ();
   let close = output_to "haskell/bindtests.hs" in
   generate_haskell_bindtests ();
   close ();

+
+  let close = output_to "src/MAX_PROC_NR" in
+  generate_max_proc_nr ();
+  close ();