Add 'add_drive_ro' call. Fix up documentation. Plus a couple of minor code improvemen...
[libguestfs.git] / src / generator.ml
index 9e17d6e..bb3744e 100755 (executable)
@@ -130,9 +130,13 @@ can easily destroy all your data>."
 (* You can supply zero or as many tests as you want per API call.
  *
  * Note that the test environment has 3 block devices, of size 500MB,
- * 50MB and 10MB (respectively /dev/sda, /dev/sdb, /dev/sdc).
+ * 50MB and 10MB (respectively /dev/sda, /dev/sdb, /dev/sdc), and
+ * a fourth squashfs block device with some known files on it (/dev/sdd).
+ *
  * Note for partitioning purposes, the 500MB device has 63 cylinders.
  *
+ * The squashfs block device (/dev/sdd) comes from images/test.sqsh.
+ *
  * To be able to run the tests in a reasonable amount of time,
  * the virtual machine and block devices are reused between tests.
  * So don't try testing kill_subprocess :-x
@@ -370,7 +374,12 @@ 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>.
+
+Note that this call checks for the existence of C<filename>.  This
+stops you from specifying other types of drive which are supported
+by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
+the general C<guestfs_config> call instead.");
 
   ("add_cdrom", (RErr, [String "filename"]), -1, [FishAlias "cdrom"],
    [],
@@ -378,7 +387,33 @@ This is equivalent to the qemu parameter C<-drive file=filename>.");
    "\
 This function adds a virtual CD-ROM disk image to the guest.
 
-This is equivalent to the qemu parameter C<-cdrom filename>.");
+This is equivalent to the qemu parameter C<-cdrom filename>.
+
+Note that this call checks for the existence of C<filename>.  This
+stops you from specifying other types of drive which are supported
+by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
+the general C<guestfs_config> call instead.");
+
+  ("add_drive_ro", (RErr, [String "filename"]), -1, [FishAlias "add-ro"],
+   [],
+   "add a drive in snapshot mode (read-only)",
+   "\
+This adds a drive in snapshot mode, making it effectively
+read-only.
+
+Note that writes to the device are allowed, and will be seen for
+the duration of the guestfs handle, but they are written
+to a temporary file which is discarded as soon as the guestfs
+handle is closed.  We don't currently have any method to enable
+changes to be committed, although qemu can support this.
+
+This is equivalent to the qemu parameter
+C<-drive file=filename,snapshot=on>.
+
+Note that this call checks for the existence of C<filename>.  This
+stops you from specifying other types of drive which are supported
+by qemu such as C<nbd:> and C<http:> URLs.  To specify those, use
+the general C<guestfs_config> call instead.");
 
   ("config", (RErr, [String "qemuparam"; OptString "qemuvalue"]), -1, [],
    [],
@@ -659,7 +694,7 @@ should probably use C<guestfs_readdir> instead.");
 
   ("list_devices", (RStringList "devices", []), 7, [],
    [InitEmpty, Always, TestOutputList (
-      [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"])],
+      [["list_devices"]], ["/dev/sda"; "/dev/sdb"; "/dev/sdc"; "/dev/sdd"])],
    "list the block devices",
    "\
 List all the block devices.
@@ -1002,7 +1037,14 @@ Create a directory named C<path>.");
        ["is_dir"; "/new/foo"]];
     InitBasicFS, Always, TestOutputTrue
       [["mkdir_p"; "/new/foo/bar"];
-       ["is_dir"; "/new"]]],
+       ["is_dir"; "/new"]];
+    (* Regression tests for RHBZ#503133: *)
+    InitBasicFS, Always, TestRun
+      [["mkdir"; "/new"];
+       ["mkdir_p"; "/new"]];
+    InitBasicFS, Always, TestLastFail
+      [["touch"; "/new"];
+       ["mkdir_p"; "/new"]]],
    "create a directory and parents",
    "\
 Create a directory named C<path>, creating any parent directories
@@ -1562,7 +1604,7 @@ This uses the L<blockdev(8)> command.");
   ("upload", (RErr, [FileIn "filename"; String "remotefilename"]), 66, [],
    [InitBasicFS, Always, TestOutput (
       (* Pick a file from cwd which isn't likely to change. *)
-    [["upload"; "COPYING.LIB"; "/COPYING.LIB"];
+    [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
      ["checksum"; "md5"; "/COPYING.LIB"]], "e3eda01d9815f8d24aae2dbd89b68b06")],
    "upload a file from the local machine",
    "\
@@ -1576,7 +1618,7 @@ See also C<guestfs_download>.");
   ("download", (RErr, [String "remotefilename"; FileOut "filename"]), 67, [],
    [InitBasicFS, Always, TestOutput (
       (* Pick a file from cwd which isn't likely to change. *)
-    [["upload"; "COPYING.LIB"; "/COPYING.LIB"];
+    [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
      ["download"; "/COPYING.LIB"; "testdownload.tmp"];
      ["upload"; "testdownload.tmp"; "/upload"];
      ["checksum"; "md5"; "/upload"]], "e3eda01d9815f8d24aae2dbd89b68b06")],
@@ -1612,7 +1654,10 @@ See also C<guestfs_upload>, C<guestfs_cat>.");
        ["checksum"; "sha384"; "/new"]], "109bb6b5b6d5547c1ce03c7a8bd7d8f80c1cb0957f50c4f7fda04692079917e4f9cad52b878f3d8234e1a170b154b72d");
     InitBasicFS, Always, TestOutput (
       [["write_file"; "/new"; "test\n"; "0"];
-       ["checksum"; "sha512"; "/new"]], "0e3e75234abc68f4378a86b3f4b32a198ba301845b0cd6e50106e874345700cc6663a86c1ea125dc5e92be17c98f9a0f85ca9d5f595db2012f7cc3571945c123")],
+       ["checksum"; "sha512"; "/new"]], "0e3e75234abc68f4378a86b3f4b32a198ba301845b0cd6e50106e874345700cc6663a86c1ea125dc5e92be17c98f9a0f85ca9d5f595db2012f7cc3571945c123");
+    InitBasicFS, Always, TestOutput (
+      [["mount"; "/dev/sdd"; "/"];
+       ["checksum"; "md5"; "/known-3"]], "46d6ca27ee07cdc6fa99c2e138cc522c")],
    "compute MD5, SHAx or CRC checksum of file",
    "\
 This call computes the MD5, SHAx or CRC checksum of the
@@ -2373,6 +2418,14 @@ let statvfs_cols = [
   "namemax", `Int;
 ]
 
+(* Used for testing language bindings. *)
+type callt =
+  | CallString of string
+  | CallOptString of string option
+  | CallStringList of string list
+  | CallInt of int
+  | CallBool of bool
+
 (* Useful functions.
  * Note we don't want to use any external OCaml libraries which
  * makes this a bit harder than it should be.
@@ -3786,7 +3839,6 @@ int main (int argc, char *argv[])
 {
   char c = 0;
   int failed = 0;
-  const char *srcdir;
   const char *filename;
   int fd, i;
   int nr_tests, test_num = 0;
@@ -3888,6 +3940,11 @@ int main (int argc, char *argv[])
     exit (1);
   }
 
+  if (guestfs_add_drive_ro (g, \"../images/test.sqsh\") == -1) {
+    printf (\"guestfs_add_drive_ro ../images/test.sqsh FAILED\\n\");
+    exit (1);
+  }
+
   if (guestfs_launch (g) == -1) {
     printf (\"guestfs_launch FAILED\\n\");
     exit (1);
@@ -5395,13 +5452,19 @@ DESTROY (g)
       generate_call_args ~handle:"g" (snd style);
       pr "\n";
       pr "      guestfs_h *g;\n";
-      List.iter (
-       function
-       | String n | FileIn n | FileOut n -> pr "      char *%s;\n" n
-       | OptString n -> pr "      char *%s;\n" n
-       | StringList n -> pr "      char **%s;\n" n
-       | Bool n -> pr "      int %s;\n" n
-       | Int n -> pr "      int %s;\n" n
+      iteri (
+       fun i ->
+         function
+         | String n | FileIn n | FileOut n -> pr "      char *%s;\n" n
+         | OptString n ->
+             (* http://www.perlmonks.org/?node_id=554277
+              * Note that the implicit handle argument means we have
+              * to add 1 to the ST(x) operator.
+              *)
+             pr "      char *%s = SvOK(ST(%d)) ? SvPV_nolen(ST(%d)) : NULL;\n" n (i+1) (i+1)
+         | StringList n -> pr "      char **%s;\n" n
+         | Bool n -> pr "      int %s;\n" n
+         | Int n -> pr "      int %s;\n" n
       ) (snd style);
 
       let do_cleanups () =
@@ -6335,7 +6398,7 @@ static VALUE ruby_guestfs_close (VALUE gv)
            pr "    rb_raise (rb_eTypeError, \"expected string for parameter %%s of %%s\",\n";
            pr "              \"%s\", \"%s\");\n" n name
        | OptString n ->
-           pr "  const char *%s = StringValueCStr (%sv);\n" n n
+           pr "  const char *%s = !NIL_P (%sv) ? StringValueCStr (%sv) : NULL;\n" n n n
        | StringList n ->
            pr "  char **%s;" n;
            pr "  {\n";
@@ -6349,7 +6412,8 @@ static VALUE ruby_guestfs_close (VALUE gv)
            pr "    }\n";
            pr "    %s[len] = NULL;\n" n;
            pr "  }\n";
-       | Bool n
+       | Bool n ->
+           pr "  int %s = RTEST (%sv);\n" n n
        | Int n ->
            pr "  int %s = NUM2INT (%sv);\n" n n
       ) (snd style);
@@ -6863,10 +6927,14 @@ Java_com_redhat_et_libguestfs_GuestFS__1close
       List.iter (
        function
        | String n
-       | OptString n
        | FileIn n
        | FileOut n ->
            pr "  %s = (*env)->GetStringUTFChars (env, j%s, NULL);\n" n n
+       | OptString n ->
+           (* This is completely undocumented, but Java null becomes
+            * a NULL parameter.
+            *)
+           pr "  %s = j%s ? (*env)->GetStringUTFChars (env, j%s, NULL) : NULL;\n" n n n
        | StringList n ->
            pr "  %s_len = (*env)->GetArrayLength (env, j%s);\n" n n;
            pr "  %s = guestfs_safe_malloc (g, sizeof (char *) * (%s_len+1));\n" n n;
@@ -6890,10 +6958,12 @@ Java_com_redhat_et_libguestfs_GuestFS__1close
       List.iter (
        function
        | String n
-       | OptString n
        | FileIn n
        | FileOut n ->
            pr "  (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
+       | OptString n ->
+           pr "  if (j%s)\n" n;
+           pr "    (*env)->ReleaseStringUTFChars (env, j%s, %s);\n" n n
        | StringList n ->
            pr "  for (i = 0; i < %s_len; ++i) {\n" n;
            pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
@@ -7264,6 +7334,8 @@ print_strings (char * const* const argv)
       | Bool n -> pr "  printf (\"%%s\\n\", %s ? \"true\" : \"false\");\n" n
       | Int n -> pr "  printf (\"%%d\\n\", %s);\n" n
     ) (snd style);
+    pr "  /* Java changes stdout line buffering so we need this: */\n";
+    pr "  fflush (stdout);\n";
     pr "  return 0;\n";
     pr "}\n";
     pr "\n" in
@@ -7392,6 +7464,222 @@ print_strings (char * const* const argv)
       )
   ) tests
 
+and generate_ocaml_bindtests () =
+  generate_header OCamlStyle GPLv2;
+
+  pr "\
+let () =
+  let g = Guestfs.create () in
+";
+
+  let mkargs args =
+    String.concat " " (
+      List.map (
+       function
+       | CallString s -> "\"" ^ s ^ "\""
+       | CallOptString None -> "None"
+       | CallOptString (Some s) -> sprintf "(Some \"%s\")" s
+       | CallStringList xs ->
+           "[|" ^ String.concat ";" (List.map (sprintf "\"%s\"") xs) ^ "|]"
+       | CallInt i when i >= 0 -> string_of_int i
+       | CallInt i (* when i < 0 *) -> "(" ^ string_of_int i ^ ")"
+       | CallBool b -> string_of_bool b
+      ) args
+    )
+  in
+
+  generate_lang_bindtests (
+    fun f args -> pr "  Guestfs.%s g %s;\n" f (mkargs args)
+  );
+
+  pr "print_endline \"EOF\"\n"
+
+and generate_perl_bindtests () =
+  pr "#!/usr/bin/perl -w\n";
+  generate_header HashStyle GPLv2;
+
+  pr "\
+use strict;
+
+use Sys::Guestfs;
+
+my $g = Sys::Guestfs->new ();
+";
+
+  let mkargs args =
+    String.concat ", " (
+      List.map (
+       function
+       | CallString s -> "\"" ^ s ^ "\""
+       | CallOptString None -> "undef"
+       | CallOptString (Some s) -> sprintf "\"%s\"" s
+       | CallStringList xs ->
+           "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
+       | CallInt i -> string_of_int i
+       | CallBool b -> if b then "1" else "0"
+      ) args
+    )
+  in
+
+  generate_lang_bindtests (
+    fun f args -> pr "$g->%s (%s);\n" f (mkargs args)
+  );
+
+  pr "print \"EOF\\n\"\n"
+
+and generate_python_bindtests () =
+  generate_header HashStyle GPLv2;
+
+  pr "\
+import guestfs
+
+g = guestfs.GuestFS ()
+";
+
+  let mkargs args =
+    String.concat ", " (
+      List.map (
+       function
+       | CallString s -> "\"" ^ s ^ "\""
+       | CallOptString None -> "None"
+       | CallOptString (Some s) -> sprintf "\"%s\"" s
+       | CallStringList xs ->
+           "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
+       | CallInt i -> string_of_int i
+       | CallBool b -> if b then "1" else "0"
+      ) args
+    )
+  in
+
+  generate_lang_bindtests (
+    fun f args -> pr "g.%s (%s)\n" f (mkargs args)
+  );
+
+  pr "print \"EOF\"\n"
+
+and generate_ruby_bindtests () =
+  generate_header HashStyle GPLv2;
+
+  pr "\
+require 'guestfs'
+
+g = Guestfs::create()
+";
+
+  let mkargs args =
+    String.concat ", " (
+      List.map (
+       function
+       | CallString s -> "\"" ^ s ^ "\""
+       | CallOptString None -> "nil"
+       | CallOptString (Some s) -> sprintf "\"%s\"" s
+       | CallStringList xs ->
+           "[" ^ String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "]"
+       | CallInt i -> string_of_int i
+       | CallBool b -> string_of_bool b
+      ) args
+    )
+  in
+
+  generate_lang_bindtests (
+    fun f args -> pr "g.%s(%s)\n" f (mkargs args)
+  );
+
+  pr "print \"EOF\\n\"\n"
+
+and generate_java_bindtests () =
+  generate_header CStyle GPLv2;
+
+  pr "\
+import com.redhat.et.libguestfs.*;
+
+public class Bindtests {
+    public static void main (String[] argv)
+    {
+        try {
+            GuestFS g = new GuestFS ();
+";
+
+  let mkargs args =
+    String.concat ", " (
+      List.map (
+       function
+       | CallString s -> "\"" ^ s ^ "\""
+       | CallOptString None -> "null"
+       | CallOptString (Some s) -> sprintf "\"%s\"" s
+       | CallStringList xs ->
+           "new String[]{" ^
+             String.concat "," (List.map (sprintf "\"%s\"") xs) ^ "}"
+       | CallInt i -> string_of_int i
+       | CallBool b -> string_of_bool b
+      ) args
+    )
+  in
+
+  generate_lang_bindtests (
+    fun f args -> pr "            g.%s (%s);\n" f (mkargs args)
+  );
+
+  pr "
+            System.out.println (\"EOF\");
+        }
+        catch (Exception exn) {
+            System.err.println (exn);
+            System.exit (1);
+        }
+    }
+}
+"
+
+and generate_haskell_bindtests () =
+  () (* XXX Haskell bindings need to be fleshed out. *)
+
+(* Language-independent bindings tests - we do it this way to
+ * ensure there is parity in testing bindings across all languages.
+ *)
+and generate_lang_bindtests call =
+  call "test0" [CallString "abc"; CallOptString (Some "def");
+               CallStringList []; CallBool false;
+               CallInt 0; CallString "123"; CallString "456"];
+  call "test0" [CallString "abc"; CallOptString None;
+               CallStringList []; CallBool false;
+               CallInt 0; CallString "123"; CallString "456"];
+  call "test0" [CallString ""; CallOptString (Some "def");
+               CallStringList []; CallBool false;
+               CallInt 0; CallString "123"; CallString "456"];
+  call "test0" [CallString ""; CallOptString (Some "");
+               CallStringList []; CallBool false;
+               CallInt 0; CallString "123"; CallString "456"];
+  call "test0" [CallString "abc"; CallOptString (Some "def");
+               CallStringList ["1"]; CallBool false;
+               CallInt 0; CallString "123"; CallString "456"];
+  call "test0" [CallString "abc"; CallOptString (Some "def");
+               CallStringList ["1"; "2"]; CallBool false;
+               CallInt 0; CallString "123"; CallString "456"];
+  call "test0" [CallString "abc"; CallOptString (Some "def");
+               CallStringList ["1"]; CallBool true;
+               CallInt 0; CallString "123"; CallString "456"];
+  call "test0" [CallString "abc"; CallOptString (Some "def");
+               CallStringList ["1"]; CallBool false;
+               CallInt (-1); CallString "123"; CallString "456"];
+  call "test0" [CallString "abc"; CallOptString (Some "def");
+               CallStringList ["1"]; CallBool false;
+               CallInt (-2); CallString "123"; CallString "456"];
+  call "test0" [CallString "abc"; CallOptString (Some "def");
+               CallStringList ["1"]; CallBool false;
+               CallInt 1; CallString "123"; CallString "456"];
+  call "test0" [CallString "abc"; CallOptString (Some "def");
+               CallStringList ["1"]; CallBool false;
+               CallInt 2; CallString "123"; CallString "456"];
+  call "test0" [CallString "abc"; CallOptString (Some "def");
+               CallStringList ["1"]; CallBool false;
+               CallInt 4095; CallString "123"; CallString "456"];
+  call "test0" [CallString "abc"; CallOptString (Some "def");
+               CallStringList ["1"]; CallBool false;
+               CallInt 0; CallString ""; CallString ""]
+
+  (* XXX Add here tests of the return and error functions. *)
+
 let output_to filename =
   let filename_new = filename ^ ".new" in
   chan := open_out filename_new;
@@ -7489,6 +7777,10 @@ Run it from the top source directory using the command
   generate_ocaml_c ();
   close ();
 
+  let close = output_to "ocaml/bindtests.ml" in
+  generate_ocaml_bindtests ();
+  close ();
+
   let close = output_to "perl/Guestfs.xs" in
   generate_perl_xs ();
   close ();
@@ -7497,6 +7789,10 @@ Run it from the top source directory using the command
   generate_perl_pm ();
   close ();
 
+  let close = output_to "perl/bindtests.pl" in
+  generate_perl_bindtests ();
+  close ();
+
   let close = output_to "python/guestfs-py.c" in
   generate_python_c ();
   close ();
@@ -7505,10 +7801,18 @@ Run it from the top source directory using the command
   generate_python_py ();
   close ();
 
+  let close = output_to "python/bindtests.py" in
+  generate_python_bindtests ();
+  close ();
+
   let close = output_to "ruby/ext/guestfs/_guestfs.c" in
   generate_ruby_c ();
   close ();
 
+  let close = output_to "ruby/bindtests.rb" in
+  generate_ruby_bindtests ();
+  close ();
+
   let close = output_to "java/com/redhat/et/libguestfs/GuestFS.java" in
   generate_java_java ();
   close ();
@@ -7537,6 +7841,14 @@ Run it from the top source directory using the command
   generate_java_c ();
   close ();
 
+  let close = output_to "java/Bindtests.java" in
+  generate_java_bindtests ();
+  close ();
+
   let close = output_to "haskell/Guestfs.hs" in
   generate_haskell_hs ();
   close ();
+
+  let close = output_to "haskell/bindtests.hs" in
+  generate_haskell_bindtests ();
+  close ();