Correction to 366a86fb6097ab0f704443f0a6ae2addbc3745d5:
[libguestfs.git] / src / generator.ml
index 23738bd..d680d42 100755 (executable)
@@ -33,6 +33,7 @@
  *)
 
 #load "unix.cma";;
+#load "str.cma";;
 
 open Printf
 
@@ -1177,10 +1178,10 @@ This is the same as the C<statvfs(2)> system call.");
 
   ("tune2fs_l", (RHashtable "superblock", [String "device"]), 55, [],
    [], (* XXX test *)
-   "get ext2/ext3 superblock details",
+   "get ext2/ext3/ext4 superblock details",
    "\
-This returns the contents of the ext2 or ext3 filesystem superblock
-on C<device>.
+This returns the contents of the ext2, ext3 or ext4 filesystem
+superblock on C<device>.
 
 It is the same as running C<tune2fs -l device>.  See L<tune2fs(8)>
 manpage for more details.  The list of fields returned isn't
@@ -1435,6 +1436,184 @@ it to local file C<tarball>.
 
 To download an uncompressed tarball, use C<guestfs_tar_out>.");
 
+  ("mount_ro", (RErr, [String "device"; String "mountpoint"]), 73, [],
+   [InitBasicFS, TestLastFail (
+      [["umount"; "/"];
+       ["mount_ro"; "/dev/sda1"; "/"];
+       ["touch"; "/new"]]);
+    InitBasicFS, TestOutput (
+      [["write_file"; "/new"; "data"; "0"];
+       ["umount"; "/"];
+       ["mount_ro"; "/dev/sda1"; "/"];
+       ["cat"; "/new"]], "data")],
+   "mount a guest disk, read-only",
+   "\
+This is the same as the C<guestfs_mount> command, but it
+mounts the filesystem with the read-only (I<-o ro>) flag.");
+
+  ("mount_options", (RErr, [String "options"; String "device"; String "mountpoint"]), 74, [],
+   [],
+   "mount a guest disk with mount options",
+   "\
+This is the same as the C<guestfs_mount> command, but it
+allows you to set the mount options as for the
+L<mount(8)> I<-o> flag.");
+
+  ("mount_vfs", (RErr, [String "options"; String "vfstype"; String "device"; String "mountpoint"]), 75, [],
+   [],
+   "mount a guest disk with mount options and vfstype",
+   "\
+This is the same as the C<guestfs_mount> command, but it
+allows you to set both the mount options and the vfstype
+as for the L<mount(8)> I<-o> and I<-t> flags.");
+
+  ("debug", (RString "result", [String "subcmd"; StringList "extraargs"]), 76, [],
+   [],
+   "debugging and internals",
+   "\
+The C<guestfs_debug> command exposes some internals of
+C<guestfsd> (the guestfs daemon) that runs inside the
+qemu subprocess.
+
+There is no comprehensive help for this command.  You have
+to look at the file C<daemon/debug.c> in the libguestfs source
+to find out what you can do.");
+
+  ("lvremove", (RErr, [String "device"]), 77, [],
+   [InitEmpty, TestOutputList (
+      [["pvcreate"; "/dev/sda"];
+       ["vgcreate"; "VG"; "/dev/sda"];
+       ["lvcreate"; "LV1"; "VG"; "50"];
+       ["lvcreate"; "LV2"; "VG"; "50"];
+       ["lvremove"; "/dev/VG/LV1"];
+       ["lvs"]], ["/dev/VG/LV2"]);
+    InitEmpty, TestOutputList (
+      [["pvcreate"; "/dev/sda"];
+       ["vgcreate"; "VG"; "/dev/sda"];
+       ["lvcreate"; "LV1"; "VG"; "50"];
+       ["lvcreate"; "LV2"; "VG"; "50"];
+       ["lvremove"; "/dev/VG"];
+       ["lvs"]], []);
+    InitEmpty, TestOutputList (
+      [["pvcreate"; "/dev/sda"];
+       ["vgcreate"; "VG"; "/dev/sda"];
+       ["lvcreate"; "LV1"; "VG"; "50"];
+       ["lvcreate"; "LV2"; "VG"; "50"];
+       ["lvremove"; "/dev/VG"];
+       ["vgs"]], ["VG"])],
+   "remove an LVM logical volume",
+   "\
+Remove an LVM logical volume C<device>, where C<device> is
+the path to the LV, such as C</dev/VG/LV>.
+
+You can also remove all LVs in a volume group by specifying
+the VG name, C</dev/VG>.");
+
+  ("vgremove", (RErr, [String "vgname"]), 78, [],
+   [InitEmpty, TestOutputList (
+      [["pvcreate"; "/dev/sda"];
+       ["vgcreate"; "VG"; "/dev/sda"];
+       ["lvcreate"; "LV1"; "VG"; "50"];
+       ["lvcreate"; "LV2"; "VG"; "50"];
+       ["vgremove"; "VG"];
+       ["lvs"]], []);
+    InitEmpty, TestOutputList (
+      [["pvcreate"; "/dev/sda"];
+       ["vgcreate"; "VG"; "/dev/sda"];
+       ["lvcreate"; "LV1"; "VG"; "50"];
+       ["lvcreate"; "LV2"; "VG"; "50"];
+       ["vgremove"; "VG"];
+       ["vgs"]], [])],
+   "remove an LVM volume group",
+   "\
+Remove an LVM volume group C<vgname>, (for example C<VG>).
+
+This also forcibly removes all logical volumes in the volume
+group (if any).");
+
+  ("pvremove", (RErr, [String "device"]), 79, [],
+   [InitEmpty, TestOutputList (
+      [["pvcreate"; "/dev/sda"];
+       ["vgcreate"; "VG"; "/dev/sda"];
+       ["lvcreate"; "LV1"; "VG"; "50"];
+       ["lvcreate"; "LV2"; "VG"; "50"];
+       ["vgremove"; "VG"];
+       ["pvremove"; "/dev/sda"];
+       ["lvs"]], []);
+    InitEmpty, TestOutputList (
+      [["pvcreate"; "/dev/sda"];
+       ["vgcreate"; "VG"; "/dev/sda"];
+       ["lvcreate"; "LV1"; "VG"; "50"];
+       ["lvcreate"; "LV2"; "VG"; "50"];
+       ["vgremove"; "VG"];
+       ["pvremove"; "/dev/sda"];
+       ["vgs"]], []);
+    InitEmpty, TestOutputList (
+      [["pvcreate"; "/dev/sda"];
+       ["vgcreate"; "VG"; "/dev/sda"];
+       ["lvcreate"; "LV1"; "VG"; "50"];
+       ["lvcreate"; "LV2"; "VG"; "50"];
+       ["vgremove"; "VG"];
+       ["pvremove"; "/dev/sda"];
+       ["pvs"]], [])],
+   "remove an LVM physical volume",
+   "\
+This wipes a physical volume C<device> so that LVM will no longer
+recognise it.
+
+The implementation uses the C<pvremove> command which refuses to
+wipe physical volumes that contain any volume groups, so you have
+to remove those first.");
+
+  ("set_e2label", (RErr, [String "device"; String "label"]), 80, [],
+   [InitBasicFS, TestOutput (
+      [["set_e2label"; "/dev/sda1"; "testlabel"];
+       ["get_e2label"; "/dev/sda1"]], "testlabel")],
+   "set the ext2/3/4 filesystem label",
+   "\
+This sets the ext2/3/4 filesystem label of the filesystem on
+C<device> to C<label>.  Filesystem labels are limited to
+16 characters.
+
+You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2label>
+to return the existing label on a filesystem.");
+
+  ("get_e2label", (RString "label", [String "device"]), 81, [],
+   [],
+   "get the ext2/3/4 filesystem label",
+   "\
+This returns the ext2/3/4 filesystem label of the filesystem on
+C<device>.");
+
+  ("set_e2uuid", (RErr, [String "device"; String "uuid"]), 82, [],
+   [InitBasicFS, TestOutput (
+      [["set_e2uuid"; "/dev/sda1"; "a3a61220-882b-4f61-89f4-cf24dcc7297d"];
+       ["get_e2uuid"; "/dev/sda1"]], "a3a61220-882b-4f61-89f4-cf24dcc7297d");
+    InitBasicFS, TestOutput (
+      [["set_e2uuid"; "/dev/sda1"; "clear"];
+       ["get_e2uuid"; "/dev/sda1"]], "");
+    (* We can't predict what UUIDs will be, so just check the commands run. *)
+    InitBasicFS, TestRun (
+      [["set_e2uuid"; "/dev/sda1"; "random"]]);
+    InitBasicFS, TestRun (
+      [["set_e2uuid"; "/dev/sda1"; "time"]])],
+   "set the ext2/3/4 filesystem UUID",
+   "\
+This sets the ext2/3/4 filesystem UUID of the filesystem on
+C<device> to C<uuid>.  The format of the UUID and alternatives
+such as C<clear>, C<random> and C<time> are described in the
+L<tune2fs(8)> manpage.
+
+You can use either C<guestfs_tune2fs_l> or C<guestfs_get_e2uuid>
+to return the existing UUID of a filesystem.");
+
+  ("get_e2uuid", (RString "uuid", [String "device"]), 83, [],
+   [],
+   "get the ext2/3/4 filesystem UUID",
+   "\
+This returns the ext2/3/4 filesystem UUID of the filesystem on
+C<device>.");
+
 ]
 
 let all_functions = non_daemon_functions @ daemon_functions
@@ -2281,8 +2460,7 @@ check_state (guestfs_h *g, const char *caller)
       pr "struct %s_ctx {\n" shortname;
       pr "  /* This flag is set by the callbacks, so we know we've done\n";
       pr "   * the callbacks as expected, and in the right sequence.\n";
-      pr "   * 0 = not called, 1 = send called,\n";
-      pr "   * 1001 = reply called.\n";
+      pr "   * 0 = not called, 1 = reply_cb called.\n";
       pr "   */\n";
       pr "  int cb_sequence;\n";
       pr "  struct guestfs_message_header hdr;\n";
@@ -2308,6 +2486,13 @@ check_state (guestfs_h *g, const char *caller)
       pr "  guestfs_main_loop *ml = guestfs_get_main_loop (g);\n";
       pr "  struct %s_ctx *ctx = (struct %s_ctx *) data;\n" shortname shortname;
       pr "\n";
+      pr "  /* This should definitely not happen. */\n";
+      pr "  if (ctx->cb_sequence != 0) {\n";
+      pr "    ctx->cb_sequence = 9999;\n";
+      pr "    error (g, \"%%s: internal error: reply callback called twice\", \"%s\");\n" name;
+      pr "    return;\n";
+      pr "  }\n";
+      pr "\n";
       pr "  ml->main_loop_quit (ml, g);\n";
       pr "\n";
       pr "  if (!xdr_guestfs_message_header (xdr, &ctx->hdr)) {\n";
@@ -2340,7 +2525,7 @@ check_state (guestfs_h *g, const char *caller)
       );
 
       pr " done:\n";
-      pr "  ctx->cb_sequence = 1001;\n";
+      pr "  ctx->cb_sequence = 1;\n";
       pr "}\n\n";
 
       (* Generate the action stub. *)
@@ -2435,7 +2620,7 @@ check_state (guestfs_h *g, const char *caller)
       pr "  guestfs_set_reply_callback (g, %s_reply_cb, &ctx);\n" shortname;
       pr "  (void) ml->main_loop_run (ml, g);\n";
       pr "  guestfs_set_reply_callback (g, NULL, NULL);\n";
-      pr "  if (ctx.cb_sequence != 1001) {\n";
+      pr "  if (ctx.cb_sequence != 1) {\n";
       pr "    error (g, \"%%s reply failed, see earlier error messages\", \"%s\");\n" name;
       pr "    guestfs_set_ready (g);\n";
       pr "    return %s;\n" error_code;
@@ -2516,7 +2701,7 @@ and generate_daemon_actions_h () =
 and generate_daemon_actions () =
   generate_header CStyle GPLv2;
 
-  pr "#define _GNU_SOURCE // for strchrnul\n";
+  pr "#include <config.h>\n";
   pr "\n";
   pr "#include <stdio.h>\n";
   pr "#include <stdlib.h>\n";
@@ -2582,9 +2767,14 @@ and generate_daemon_actions () =
             | String n -> pr "  %s = args.%s;\n" n n
             | OptString n -> pr "  %s = args.%s ? *args.%s : NULL;\n" n n n
             | StringList n ->
-                pr "  args.%s.%s_val = realloc (args.%s.%s_val, sizeof (char *) * (args.%s.%s_len+1));\n" n n n n n n;
-                pr "  args.%s.%s_val[args.%s.%s_len] = NULL;\n" n n n n;
-                pr "  %s = args.%s.%s_val;\n" n n n
+                pr "  %s = realloc (args.%s.%s_val,\n" n n n;
+                pr "                sizeof (char *) * (args.%s.%s_len+1));\n" n n;
+                pr "  if (%s == NULL) {\n" n;
+                pr "    reply_with_perror (\"realloc\");\n";
+                pr "    goto done;\n";
+                pr "  }\n";
+                pr "  %s[args.%s.%s_len] = NULL;\n" n n n;
+                pr "  args.%s.%s_val = %s;\n" n n n;
             | Bool n -> pr "  %s = args.%s;\n" n n
             | Int n -> pr "  %s = args.%s;\n" n n
             | FileIn _ | FileOut _ -> ()
@@ -3714,7 +3904,7 @@ and generate_fish_completion () =
 
 #ifdef HAVE_LIBREADLINE
 
-static const char *commands[] = {
+static const char *const commands[] = {
 ";
 
   (* Get the commands and sort them, including the aliases. *)
@@ -3778,9 +3968,19 @@ and generate_fish_actions_pod () =
       fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags)
     ) all_functions_sorted in
 
+  let rex = Str.regexp "C<guestfs_\\([^>]+\\)>" in
+
   List.iter (
     fun (name, style, _, flags, _, _, longdesc) ->
-      let longdesc = replace_str longdesc "C<guestfs_" "C<" in
+      let longdesc =
+       Str.global_substitute rex (
+         fun s ->
+           let sub =
+             try Str.matched_group 1 s
+             with Not_found ->
+               failwithf "error substituting C<guestfs_...> in longdesc of function %s" name in
+           "C<" ^ replace_char sub '_' '-' ^ ">"
+       ) longdesc in
       let name = replace_char name '_' '-' in
       let alias =
        try find_map (function FishAlias n -> Some n | _ -> None) flags
@@ -4106,6 +4306,8 @@ copy_table (char * const * argv)
       pr "{\n";
 
       (match params with
+       | [p1; p2; p3; p4; p5] ->
+          pr "  CAMLparam5 (%s);\n" (String.concat ", " params)
        | p1 :: p2 :: p3 :: p4 :: p5 :: rest ->
           pr "  CAMLparam5 (%s);\n" (String.concat ", " [p1; p2; p3; p4; p5]);
           pr "  CAMLxparam%d (%s);\n"
@@ -4132,7 +4334,7 @@ copy_table (char * const * argv)
            pr "    %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
              n n
        | StringList n ->
-           pr "  char **%s = ocaml_guestfs_strings_val (%sv);\n" n n
+           pr "  char **%s = ocaml_guestfs_strings_val (g, %sv);\n" n n
        | Bool n ->
            pr "  int %s = Bool_val (%sv);\n" n n
        | Int n ->
@@ -4354,12 +4556,13 @@ XS_unpack_charPtrPtr (SV *arg) {
   AV *av;
   I32 i;
 
-  if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV) {
+  if (!arg || !SvOK (arg) || !SvROK (arg) || SvTYPE (SvRV (arg)) != SVt_PVAV)
     croak (\"array reference expected\");
-  }
 
   av = (AV *)SvRV (arg);
-  ret = (char **)malloc (av_len (av) + 1 + 1);
+  ret = malloc (av_len (av) + 1 + 1);
+  if (!ret)
+    croak (\"malloc failed\");
 
   for (i = 0; i <= av_len (av); i++) {
     SV **elem = av_fetch (av, i, 0);
@@ -5353,11 +5556,13 @@ static VALUE ruby_guestfs_close (VALUE gv)
            pr "  {\n";
            pr "    int i, len;\n";
            pr "    len = RARRAY_LEN (%sv);\n" n;
-           pr "    %s = malloc (sizeof (char *) * (len+1));\n" n;
+           pr "    %s = guestfs_safe_malloc (g, sizeof (char *) * (len+1));\n"
+             n;
            pr "    for (i = 0; i < len; ++i) {\n";
            pr "      VALUE v = rb_ary_entry (%sv, i);\n" n;
            pr "      %s[i] = StringValueCStr (v);\n" n;
            pr "    }\n";
+           pr "    %s[len] = NULL;\n" n;
            pr "  }\n";
        | Bool n
        | Int n ->
@@ -5736,14 +5941,14 @@ Java_com_redhat_et_libguestfs_GuestFS__1create
     return 0;
   }
   guestfs_set_error_handler (g, NULL, NULL);
-  return (jlong) g;
+  return (jlong) (long) g;
 }
 
 JNIEXPORT void JNICALL
 Java_com_redhat_et_libguestfs_GuestFS__1close
   (JNIEnv *env, jobject obj, jlong jg)
 {
-  guestfs_h *g = (guestfs_h *) jg;
+  guestfs_h *g = (guestfs_h *) (long) jg;
   guestfs_close (g);
 }
 
@@ -5784,7 +5989,7 @@ Java_com_redhat_et_libguestfs_GuestFS__1close
       ) (snd style);
       pr ")\n";
       pr "{\n";
-      pr "  guestfs_h *g = (guestfs_h *) jg;\n";
+      pr "  guestfs_h *g = (guestfs_h *) (long) jg;\n";
       let error_code, no_ret =
        match fst style with
        | RErr -> pr "  int r;\n"; "-1", ""
@@ -5872,7 +6077,7 @@ Java_com_redhat_et_libguestfs_GuestFS__1close
            pr "  %s = (*env)->GetStringUTFChars (env, j%s, NULL);\n" n n
        | StringList n ->
            pr "  %s_len = (*env)->GetArrayLength (env, j%s);\n" n n;
-           pr "  %s = malloc (sizeof (char *) * (%s_len+1));\n" n n;
+           pr "  %s = guestfs_safe_malloc (g, sizeof (char *) * (%s_len+1));\n" n n;
            pr "  for (i = 0; i < %s_len; ++i) {\n" n;
            pr "    jobject o = (*env)->GetObjectArrayElement (env, j%s, i);\n"
              n;