Haskell bindings: Fix integer arguments.

[libguestfs.git] / src / generator.ml

diff --git a/src/generator.ml b/src/generator.ml
index f4b5605..07b8ef2 100755 (executable)
--- a/src/generator.ml
+++ b/src/generator.ml
@@ -373,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


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


@@ -2402,6 +2404,69 @@ 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.");
 
 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


@@ -6500,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";


@@ -6508,6 +6574,7 @@ static VALUE ruby_guestfs_close (VALUE gv)
            pr "  const char *%s = !NIL_P (%sv) ? StringValueCStr (%sv) : NULL;\n" n n n
        | StringList n ->
            pr "  char **%s;\n" n;
            pr "  const char *%s = !NIL_P (%sv) ? StringValueCStr (%sv) : NULL;\n" n n n
        | StringList 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;


@@ -7198,7 +7265,7 @@ and generate_haskell_hs () =
    *)
   let can_generate style =
     let check_no_bad_args =
    *)
   let can_generate style =
     let check_no_bad_args =

-      List.for_all (function Bool _ | Int _ -> false | _ -> true)
+      List.for_all (function Bool _ -> false | _ -> true)

     in
     match style with
     | RErr, args -> check_no_bad_args args
     in
     match style with
     | RErr, args -> check_no_bad_args args


@@ -7233,6 +7300,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


@@ -7296,6 +7364,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


@@ -7303,17 +7372,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 "(fromIntegral %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";


@@ -7787,6 +7857,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;


@@ -7959,3 +8042,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 ();