X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=src%2Fgenerator.ml;h=27a75868744c5fbb6a29602713a7f6526a0c0376;hb=ad475104ec7fae456d3309cbf4261b893ed160bb;hp=51d32357296065c7015ee1397b331c4e9d831316;hpb=d3270cfadd3416bd9961a2c6fb1cc131c43979da;p=libguestfs.git

diff --git a/src/generator.ml b/src/generator.ml
index 51d3235..27a7586 100755
--- a/src/generator.ml
+++ b/src/generator.ml
@@ -2131,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
@@ -2167,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],
    [],
@@ -2442,6 +2448,181 @@ 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).");
+
+  ("initrd_list", (RStringList "filenames", [String "path"]), 128, [],
+   [InitBasicFS, Always, TestOutputList (
+      [["mount_vfs"; "ro"; "squashfs"; "/dev/sdd"; "/"];
+       ["initrd_list"; "/initrd"]], ["empty";"known-1";"known-2";"known-3"])],
+   "list files in an initrd",
+   "\
+This command lists out files contained in an initrd.
+
+The files are listed without any initial C</> character.  The
+files are listed in the order they appear (not necessarily
+alphabetical).  Directory names are listed as separate items.
+
+Old Linux kernels (2.4 and earlier) used a compressed ext2
+filesystem as initrd.  We I<only> support the newer initramfs
+format (compressed cpio files).");
+
+  ("mount_loop", (RErr, [String "file"; String "mountpoint"]), 129, [],
+   [],
+   "mount a file using the loop device",
+   "\
+This command lets you mount C<file> (a filesystem image
+in a file) on a mount point.  It is entirely equivalent to
+the command C<mount -o loop file mountpoint>.");
+
 ]
 
 let all_functions = non_daemon_functions @ daemon_functions
@@ -2722,8 +2903,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
@@ -4129,6 +4310,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\");
@@ -4136,7 +4320,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 -> ()
@@ -4152,7 +4336,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;
   }
 
@@ -7239,14 +7423,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 _, _
@@ -7275,6 +7456,7 @@ module Guestfs (
   ) where
 import Foreign
 import Foreign.C
+import Foreign.C.Types
 import IO
 import Control.Exception
 import Data.Typeable
@@ -7338,6 +7520,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
@@ -7345,17 +7528,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";
@@ -7781,7 +7965,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.
@@ -8011,7 +8226,7 @@ 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 ();