X-Git-Url: http://git.annexia.org/?p=libguestfs.git;a=blobdiff_plain;f=src%2Fgenerator.ml;h=5885ff3f91f7f2924ed2f73814e25316b1217455;hp=f4b56050da377384b45d20f67917d21f0351773b;hb=9a92446bcad09b492dee42dd5950bac67073fbea;hpb=3eab7260a5e36ce6da0dff39456eb9100a13222b

diff --git a/src/generator.ml b/src/generator.ml
index f4b5605..5885ff3 100755
--- 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).
 
-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
@@ -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
-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 (
@@ -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"; "/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
@@ -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.");
 
-  ("sfdisk_N", (RErr, [String "device"; Int "n";
+  ("sfdisk_N", (RErr, [String "device"; Int "partnum";
 		       Int "cyls"; Int "heads"; Int "sectors";
 		       String "line"]), 99, [DangerWillRobinson],
    [],
@@ -2402,6 +2410,195 @@ 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)>");
+
+  ("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.");
+
+  ("head", (RStringList "lines", [String "path"]), 121, [ProtocolLimitWarning],
+   [InitBasicFS, Always, TestOutputList (
+      [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
+       ["head"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz";"3abcdefghijklmnopqrstuvwxyz";"4abcdefghijklmnopqrstuvwxyz";"5abcdefghijklmnopqrstuvwxyz";"6abcdefghijklmnopqrstuvwxyz";"7abcdefghijklmnopqrstuvwxyz";"8abcdefghijklmnopqrstuvwxyz";"9abcdefghijklmnopqrstuvwxyz"])],
+   "return first 10 lines of a file",
+   "\
+This command returns up to the first 10 lines of a file as
+a list of strings.");
+
+  ("head_n", (RStringList "lines", [Int "nrlines"; String "path"]), 122, [ProtocolLimitWarning],
+   [InitBasicFS, Always, TestOutputList (
+      [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
+       ["head_n"; "3"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz"]);
+    InitBasicFS, Always, TestOutputList (
+      [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
+       ["head_n"; "-9997"; "/10klines"]], ["0abcdefghijklmnopqrstuvwxyz";"1abcdefghijklmnopqrstuvwxyz";"2abcdefghijklmnopqrstuvwxyz"]);
+    InitBasicFS, Always, TestOutputList (
+      [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
+       ["head_n"; "0"; "/10klines"]], [])],
+   "return first N lines of a file",
+   "\
+If the parameter C<nrlines> is a positive number, this returns the first
+C<nrlines> lines of the file C<path>.
+
+If the parameter C<nrlines> is a negative number, this returns lines
+from the file C<path>, excluding the last C<nrlines> lines.
+
+If the parameter C<nrlines> is zero, this returns an empty list.");
+
+  ("tail", (RStringList "lines", [String "path"]), 123, [ProtocolLimitWarning],
+   [InitBasicFS, Always, TestOutputList (
+      [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
+       ["tail"; "/10klines"]], ["9990abcdefghijklmnopqrstuvwxyz";"9991abcdefghijklmnopqrstuvwxyz";"9992abcdefghijklmnopqrstuvwxyz";"9993abcdefghijklmnopqrstuvwxyz";"9994abcdefghijklmnopqrstuvwxyz";"9995abcdefghijklmnopqrstuvwxyz";"9996abcdefghijklmnopqrstuvwxyz";"9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"])],
+   "return last 10 lines of a file",
+   "\
+This command returns up to the last 10 lines of a file as
+a list of strings.");
+
+  ("tail_n", (RStringList "lines", [Int "nrlines"; String "path"]), 124, [ProtocolLimitWarning],
+   [InitBasicFS, Always, TestOutputList (
+      [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
+       ["tail_n"; "3"; "/10klines"]], ["9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"]);
+    InitBasicFS, Always, TestOutputList (
+      [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
+       ["tail_n"; "-9998"; "/10klines"]], ["9997abcdefghijklmnopqrstuvwxyz";"9998abcdefghijklmnopqrstuvwxyz";"9999abcdefghijklmnopqrstuvwxyz"]);
+    InitBasicFS, Always, TestOutputList (
+      [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
+       ["tail_n"; "0"; "/10klines"]], [])],
+   "return last N lines of a file",
+   "\
+If the parameter C<nrlines> is a positive number, this returns the last
+C<nrlines> lines of the file C<path>.
+
+If the parameter C<nrlines> is a negative number, this returns lines
+from the file C<path>, starting with the C<-nrlines>th line.
+
+If the parameter C<nrlines> is zero, this returns an empty list.");
+
+  ("df", (RString "output", []), 125, [],
+   [], (* XXX Tricky to test because it depends on the exact format
+	* of the 'df' command and other imponderables.
+	*)
+   "report file system disk space usage",
+   "\
+This command runs the C<df> command to report disk space used.
+
+This command is mostly useful for interactive sessions.  It
+is I<not> intended that you try to parse the output string.
+Use C<statvfs> from programs.");
+
+  ("df_h", (RString "output", []), 126, [],
+   [], (* XXX Tricky to test because it depends on the exact format
+	* of the 'df' command and other imponderables.
+	*)
+   "report file system disk space usage (human readable)",
+   "\
+This command runs the C<df -h> command to report disk space used
+in human-readable format.
+
+This command is mostly useful for interactive sessions.  It
+is I<not> intended that you try to parse the output string.
+Use C<statvfs> from programs.");
+
+  ("du", (RInt64 "sizekb", [String "path"]), 127, [],
+   [InitBasicFS, Always, TestOutputInt (
+      [["mkdir"; "/p"];
+       ["du"; "/p"]], 1 (* ie. 1 block, so depends on ext3 blocksize *))],
+   "estimate file space usage",
+   "\
+This command runs the C<du -s> command to estimate file space
+usage for C<path>.
+
+C<path> can be a file or a directory.  If C<path> is a directory
+then the estimate includes the contents of the directory and all
+subdirectories (recursively).
+
+The result is the estimated size in I<kilobytes>
+(ie. units of 1024 bytes).");
+
 ]
 
 let all_functions = non_daemon_functions @ daemon_functions
@@ -2682,8 +2879,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;
-	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
@@ -4089,6 +4286,9 @@ static int %s_skip (void)
 {
   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\");
@@ -4096,7 +4296,7 @@ static int %s_skip (void)
   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 -> ()
@@ -4112,7 +4312,7 @@ static int %s_skip (void)
 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;
   }
 
@@ -6500,6 +6700,7 @@ static VALUE ruby_guestfs_close (VALUE gv)
       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";
@@ -6508,6 +6709,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 "  Check_Type (%sv, T_ARRAY);\n" n;
 	    pr "  {\n";
 	    pr "    int i, len;\n";
 	    pr "    len = RARRAY_LEN (%sv);\n" n;
@@ -7197,14 +7399,11 @@ and generate_haskell_hs () =
    * 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
-    | RErr, args -> check_no_bad_args args
-    | RBool _, _
+    | RErr, _
     | RInt _, _
-    | RInt64 _, _
+    | RInt64 _, _ -> true
+    | RBool _, _
     | RConstString _, _
     | RString _, _
     | RStringList _, _
@@ -7233,6 +7432,7 @@ module Guestfs (
   ) where
 import Foreign
 import Foreign.C
+import Foreign.C.Types
 import IO
 import Control.Exception
 import Data.Typeable
@@ -7296,6 +7496,7 @@ last_error h = do
 	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
@@ -7303,17 +7504,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
-	  | 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);
+	(* 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
-	  (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";
@@ -7739,7 +7941,38 @@ public class 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.
@@ -7787,6 +8020,19 @@ and generate_lang_bindtests call =
 
   (* 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;
@@ -7956,6 +8202,10 @@ Run it from the top source directory using the command
   generate_haskell_hs ();
   close ();
 
-  let close = output_to "haskell/bindtests.hs" in
+  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 ();