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
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 (
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)>");
]
) 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";
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";
| 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;
* 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 _, _
) where
import Foreign
import Foreign.C
+import Foreign.C.Types
import IO
import Control.Exception
import Data.Typeable
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
| 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";
"
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.
(* 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;
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 ();