Prevent 'n' being used as a parameter name.

[libguestfs.git] / src / generator.ml

diff --git a/src/generator.ml b/src/generator.ml
index f4b5605..aecb152 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 (


@@ -2129,7 +2131,13 @@ The returned strings are transcoded to UTF-8.");
   ("hexdump", (RString "dump", [String "path"]), 96, [ProtocolLimitWarning],
    [InitBasicFS, Always, TestOutput (
       [["write_file"; "/new"; "hello\nworld\n"; "12"];
   ("hexdump", (RString "dump", [String "path"]), 96, [ProtocolLimitWarning],
    [InitBasicFS, Always, TestOutput (
       [["write_file"; "/new"; "hello\nworld\n"; "12"];

-       ["hexdump"; "/new"]], "00000000  68 65 6c 6c 6f 0a 77 6f  72 6c 64 0a              |hello.world.|\n0000000c\n")],
+       ["hexdump"; "/new"]], "00000000  68 65 6c 6c 6f 0a 77 6f  72 6c 64 0a              |hello.world.|\n0000000c\n");
+    (* Test for RHBZ#501888c2 regression which caused large hexdump
+     * commands to segfault.
+     *)
+    InitBasicFS, Always, TestRun (
+      [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
+       ["hexdump"; "/100krandom"]])],

    "dump a file in hexadecimal",
    "\
 This runs C<hexdump -C> on the given C<path>.  The result is
    "dump a file in hexadecimal",
    "\
 This runs C<hexdump -C> on the given C<path>.  The result is


@@ -2165,7 +2173,7 @@ or data on the filesystem.");
 This resizes (expands or shrinks) an existing LVM physical
 volume to match the new size of the underlying device.");
 
 This resizes (expands or shrinks) an existing LVM physical
 volume to match the new size of the underlying device.");
 

-  ("sfdisk_N", (RErr, [String "device"; Int "n";
+  ("sfdisk_N", (RErr, [String "device"; Int "partnum";

                       Int "cyls"; Int "heads"; Int "sectors";
                       String "line"]), 99, [DangerWillRobinson],
    [],
                       Int "cyls"; Int "heads"; Int "sectors";
                       String "line"]), 99, [DangerWillRobinson],
    [],


@@ -2402,6 +2410,96 @@ 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)>");
+
+  ("wc_l", (RInt "lines", [String "path"]), 118, [],
+   [InitBasicFS, Always, TestOutputInt (
+      [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
+       ["wc_l"; "/10klines"]], 10000)],
+   "count lines in a file",
+   "\
+This command counts the lines in a file, using the
+C<wc -l> external command.");
+
+  ("wc_w", (RInt "words", [String "path"]), 119, [],
+   [InitBasicFS, Always, TestOutputInt (
+      [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
+       ["wc_w"; "/10klines"]], 10000)],
+   "count words in a file",
+   "\
+This command counts the words in a file, using the
+C<wc -w> external command.");
+
+  ("wc_c", (RInt "chars", [String "path"]), 120, [],
+   [InitBasicFS, Always, TestOutputInt (
+      [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
+       ["wc_c"; "/100kallspaces"]], 102400)],
+   "count characters in a file",
+   "\
+This command counts the characters in a file, using the
+C<wc -c> external command.");
+

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


@@ -2682,8 +2780,8 @@ let check_functions () =
          failwithf "%s has a param/ret called 'value', which causes conflicts in the OCaml bindings, use something like 'val' or a more descriptive name" name;
        if n = "int" || n = "char" || n = "short" || n = "long" then
          failwithf "%s has a param/ret which conflicts with a C type (eg. 'int', 'char' etc.)" name;
          failwithf "%s has a param/ret called 'value', which causes conflicts in the OCaml bindings, use something like 'val' or a more descriptive name" name;
        if n = "int" || n = "char" || n = "short" || n = "long" then
          failwithf "%s has a param/ret which conflicts with a C type (eg. 'int', 'char' etc.)" name;

-       if n = "i" then
-         failwithf "%s has a param/ret called 'i', which will cause some conflicts in the generated code" name;
+       if n = "i" || n = "n" then
+         failwithf "%s has a param/ret called 'i' or 'n', which will cause some conflicts in the generated code" name;

        if n = "argv" || n = "args" then
          failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" name
       in
        if n = "argv" || n = "args" then
          failwithf "%s has a param/ret called 'argv' or 'args', which will cause some conflicts in the generated code" name
       in


@@ -4089,6 +4187,9 @@ static int %s_skip (void)
 {
   const char *str;
 
 {
   const char *str;
 

+  str = getenv (\"TEST_ONLY\");
+  if (str)
+    return strstr (str, \"%s\") == NULL;

   str = getenv (\"SKIP_%s\");
   if (str && strcmp (str, \"1\") == 0) return 1;
   str = getenv (\"SKIP_TEST_%s\");
   str = getenv (\"SKIP_%s\");
   if (str && strcmp (str, \"1\") == 0) return 1;
   str = getenv (\"SKIP_TEST_%s\");


@@ -4096,7 +4197,7 @@ static int %s_skip (void)
   return 0;
 }
 
   return 0;
 }
 

-" test_name (String.uppercase test_name) (String.uppercase name);
+" test_name name (String.uppercase test_name) (String.uppercase name);

 
   (match prereq with
    | Disabled | Always -> ()
 
   (match prereq with
    | Disabled | Always -> ()


@@ -4112,7 +4213,7 @@ static int %s_skip (void)
 static int %s (void)
 {
   if (%s_skip ()) {
 static int %s (void)
 {
   if (%s_skip ()) {

-    printf (\"%%s skipped (reason: SKIP_TEST_* variable set)\\n\", \"%s\");
+    printf (\"%%s skipped (reason: environment variable set)\\n\", \"%s\");

     return 0;
   }
 
     return 0;
   }
 


@@ -6500,6 +6601,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 +6610,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;


@@ -7197,14 +7300,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 _, _


@@ -7233,6 +7333,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 +7397,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 +7405,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";


@@ -7739,7 +7842,38 @@ public class Bindtests {
 "
 
 and generate_haskell_bindtests () =
 "
 
 and generate_haskell_bindtests () =

-  () (* XXX Haskell bindings need to be fleshed out. *)
+  generate_header HaskellStyle GPLv2;
+
+  pr "\
+module Bindtests where
+import qualified Guestfs
+
+main = do
+  g <- Guestfs.create
+";
+
+  let mkargs args =
+    String.concat " " (
+      List.map (
+       function
+       | CallString s -> "\"" ^ s ^ "\""
+       | CallOptString None -> "Nothing"
+       | CallOptString (Some s) -> sprintf "(Just \"%s\")" s
+       | CallStringList xs ->
+           "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
+       | CallInt i when i < 0 -> "(" ^ string_of_int i ^ ")"
+       | CallInt i -> string_of_int i
+       | CallBool true -> "True"
+       | CallBool false -> "False"
+      ) args
+    )
+  in
+
+  generate_lang_bindtests (
+    fun f args -> pr "  Guestfs.%s g %s\n" f (mkargs args)
+  );
+
+  pr "  putStrLn \"EOF\"\n"

 
 (* Language-independent bindings tests - we do it this way to
  * ensure there is parity in testing bindings across all languages.
 
 (* Language-independent bindings tests - we do it this way to
  * ensure there is parity in testing bindings across all languages.


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


@@ -7956,6 +8103,10 @@ Run it from the top source directory using the command
   generate_haskell_hs ();
   close ();
 
   generate_haskell_hs ();
   close ();
 

-  let close = output_to "haskell/bindtests.hs" in
+  let close = output_to "haskell/Bindtests.hs" in

   generate_haskell_bindtests ();
   close ();
   generate_haskell_bindtests ();
   close ();

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