OCaml bindings compile.

[libguestfs.git] / src / generator.ml

diff --git a/src/generator.ml b/src/generator.ml
index 8d1dc04..95a0985 100755 (executable)
--- a/src/generator.ml
+++ b/src/generator.ml
@@ -32,9 +32,15 @@ and ret =
      * indication, ie. 0 or -1.
      *)
   | Err
      * indication, ie. 0 or -1.
      *)
   | Err

-    (* "RString" and "RStringList" require special treatment because
-     * the caller must free them.
+    (* "RBool" is a bool return value which can be true/false or
+     * -1 for error.

      *)
      *)

+  | RBool of string
+    (* "RConstString" is a string that refers to a constant value.
+     * Try to avoid using this.
+     *)
+  | RConstString of string
+    (* "RString" and "RStringList" are caller-frees. *)

   | RString of string
   | RStringList of string
     (* LVM PVs, VGs and LVs. *)
   | RString of string
   | RStringList of string
     (* LVM PVs, VGs and LVs. *)


@@ -48,10 +54,130 @@ and args =
   | P2 of argt * argt
 and argt =
   | String of string   (* const char *name, cannot be NULL *)
   | P2 of argt * argt
 and argt =
   | String of string   (* const char *name, cannot be NULL *)

+  | OptString of string        (* const char *name, may be NULL *)
+  | Bool of string     (* boolean *)
+
+type flags =
+  | ProtocolLimitWarning  (* display warning about protocol size limits *)
+  | FishAlias of string          (* provide an alias for this cmd in guestfish *)
+  | FishAction of string  (* call this function in guestfish *)
+  | NotInFish            (* do not export via guestfish *)
+
+(* Note about long descriptions: When referring to another
+ * action, use the format C<guestfs_other> (ie. the full name of
+ * the C function).  This will be replaced as appropriate in other
+ * language bindings.
+ *
+ * Apart from that, long descriptions are just perldoc paragraphs.
+ *)
+
+let non_daemon_functions = [
+  ("launch", (Err, P0), -1, [FishAlias "run"; FishAction "launch"],
+   "launch the qemu subprocess",
+   "\
+Internally libguestfs is implemented by running a virtual machine
+using L<qemu(1)>.
+
+You should call this after configuring the handle
+(eg. adding drives) but before performing any actions.");
+
+  ("wait_ready", (Err, P0), -1, [NotInFish],
+   "wait until the qemu subprocess launches",
+   "\
+Internally libguestfs is implemented by running a virtual machine
+using L<qemu(1)>.
+
+You should call this after C<guestfs_launch> to wait for the launch
+to complete.");
+
+  ("kill_subprocess", (Err, P0), -1, [],
+   "kill the qemu subprocess",
+   "\
+This kills the qemu subprocess.  You should never need to call this.");
+
+  ("add_drive", (Err, P1 (String "filename")), -1, [FishAlias "add"],
+   "add an image to examine or modify",
+   "\
+This function adds a virtual machine disk image C<filename> to the
+guest.  The first time you call this function, the disk appears as IDE
+disk 0 (C</dev/sda>) in the guest, the second time as C</dev/sdb>, and
+so on.
+
+You don't necessarily need to be root when using libguestfs.  However
+you obviously do need sufficient permissions to access the filename
+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>.");
+
+  ("add_cdrom", (Err, P1 (String "filename")), -1, [FishAlias "cdrom"],
+   "add a CD-ROM disk image to examine",
+   "\
+This function adds a virtual CD-ROM disk image to the guest.
+
+This is equivalent to the qemu parameter C<-cdrom filename>.");
+
+  ("config", (Err, P2 (String "qemuparam", OptString "qemuvalue")), -1, [],
+   "add qemu parameters",
+   "\
+This can be used to add arbitrary qemu command line parameters
+of the form C<-param value>.  Actually it's not quite arbitrary - we
+prevent you from setting some parameters which would interfere with
+parameters that we use.
+
+The first character of C<param> string must be a C<-> (dash).
+
+C<value> can be NULL.");
+
+  ("set_path", (Err, P1 (String "path")), -1, [FishAlias "path"],
+   "set the search path",
+   "\
+Set the path that libguestfs searches for kernel and initrd.img.
+
+The default is C<$libdir/guestfs> unless overridden by setting
+C<LIBGUESTFS_PATH> environment variable.
+
+The string C<path> is stashed in the libguestfs handle, so the caller
+must make sure it remains valid for the lifetime of the handle.
+
+Setting C<path> to C<NULL> restores the default path.");
+
+  ("get_path", (RConstString "path", P0), -1, [],
+   "get the search path",
+   "\
+Return the current search path.

 
 

-type flags = ProtocolLimitWarning
+This is always non-NULL.  If it wasn't set already, then this will
+return the default path.");
+
+  ("set_autosync", (Err, P1 (Bool "autosync")), -1, [FishAlias "autosync"],
+   "set autosync mode",
+   "\
+If C<autosync> is true, this enables autosync.  Libguestfs will make a
+best effort attempt to run C<guestfs_sync> when the handle is closed
+(also if the program exits without closing handles).");
+
+  ("get_autosync", (RBool "autosync", P0), -1, [],
+   "get autosync mode",
+   "\
+Get the autosync flag.");
+
+  ("set_verbose", (Err, P1 (Bool "verbose")), -1, [FishAlias "verbose"],
+   "set verbose mode",
+   "\
+If C<verbose> is true, this turns on verbose messages (to C<stderr>).
+
+Verbose messages are disabled unless the environment variable
+C<LIBGUESTFS_DEBUG> is defined and set to C<1>.");
+
+  ("get_verbose", (RBool "verbose", P0), -1, [],
+   "get verbose mode",
+   "\
+This returns the verbose messages flag.")
+]

 
 

-let functions = [
+let daemon_functions = [

   ("mount", (Err, P2 (String "device", String "mountpoint")), 1, [],
    "mount a guest disk at a position in the filesystem",
    "\
   ("mount", (Err, P2 (String "device", String "mountpoint")), 1, [],
    "mount a guest disk at a position in the filesystem",
    "\


@@ -79,7 +205,7 @@ This syncs the disk, so that any writes are flushed through to the
 underlying disk image.
 
 You should always call this if you have modified a disk image, before
 underlying disk image.
 
 You should always call this if you have modified a disk image, before

-calling C<guestfs_close>.");
+closing the handle.");

 
   ("touch", (Err, P1 (String "path")), 3, [],
    "update file timestamps or create a new file",
 
   ("touch", (Err, P1 (String "path")), 3, [],
    "update file timestamps or create a new file",


@@ -122,8 +248,7 @@ should probably use C<guestfs_readdir> instead.");
    "\
 List all the block devices.
 
    "\
 List all the block devices.
 

-The full block device names are returned, eg. C</dev/sda>
-");
+The full block device names are returned, eg. C</dev/sda>");

 
   ("list_partitions", (RStringList "partitions", P0), 8, [],
    "list the partitions",
 
   ("list_partitions", (RStringList "partitions", P0), 8, [],
    "list the partitions",


@@ -135,25 +260,66 @@ The full partition device names are returned, eg. C</dev/sda1>
 This does not return logical volumes.  For that you will need to
 call C<guestfs_lvs>.");
 
 This does not return logical volumes.  For that you will need to
 call C<guestfs_lvs>.");
 

-  ("pvs", (RPVList "physvols", P0), 9, [],
+  ("pvs", (RStringList "physvols", P0), 9, [],
+   "list the LVM physical volumes (PVs)",
+   "\
+List all the physical volumes detected.  This is the equivalent
+of the L<pvs(8)> command.
+
+This returns a list of just the device names that contain
+PVs (eg. C</dev/sda2>).
+
+See also C<guestfs_pvs_full>.");
+
+  ("vgs", (RStringList "volgroups", P0), 10, [],
+   "list the LVM volume groups (VGs)",
+   "\
+List all the volumes groups detected.  This is the equivalent
+of the L<vgs(8)> command.
+
+This returns a list of just the volume group names that were
+detected (eg. C<VolGroup00>).
+
+See also C<guestfs_vgs_full>.");
+
+  ("lvs", (RStringList "logvols", P0), 11, [],
+   "list the LVM logical volumes (LVs)",
+   "\
+List all the logical volumes detected.  This is the equivalent
+of the L<lvs(8)> command.
+
+This returns a list of the logical volume device names
+(eg. C</dev/VolGroup00/LogVol00>).
+
+See also C<guestfs_lvs_full>.");
+
+  ("pvs_full", (RPVList "physvols", P0), 12, [],

    "list the LVM physical volumes (PVs)",
    "\
 List all the physical volumes detected.  This is the equivalent
    "list the LVM physical volumes (PVs)",
    "\
 List all the physical volumes detected.  This is the equivalent

-of the L<pvs(8)> command.");
+of the L<pvs(8)> command.  The \"full\" version includes all fields.");

 
 

-  ("vgs", (RVGList "volgroups", P0), 10, [],
+  ("vgs_full", (RVGList "volgroups", P0), 13, [],

    "list the LVM volume groups (VGs)",
    "\
 List all the volumes groups detected.  This is the equivalent
    "list the LVM volume groups (VGs)",
    "\
 List all the volumes groups detected.  This is the equivalent

-of the L<vgs(8)> command.");
+of the L<vgs(8)> command.  The \"full\" version includes all fields.");

 
 

-  ("lvs", (RLVList "logvols", P0), 11, [],
+  ("lvs_full", (RLVList "logvols", P0), 14, [],

    "list the LVM logical volumes (LVs)",
    "\
 List all the logical volumes detected.  This is the equivalent
    "list the LVM logical volumes (LVs)",
    "\
 List all the logical volumes detected.  This is the equivalent

-of the L<lvs(8)> command.");
+of the L<lvs(8)> command.  The \"full\" version includes all fields.");

 ]
 
 ]
 

+let all_functions = non_daemon_functions @ daemon_functions
+
+(* In some places we want the functions to be displayed sorted
+ * alphabetically, so this is useful:
+ *)
+let all_functions_sorted =
+  List.sort (fun (n1,_,_,_,_,_) (n2,_,_,_,_,_) -> compare n1 n2) all_functions
+

 (* Column names and types from LVM PVs/VGs/LVs. *)
 let pv_cols = [
   "pv_name", `String;
 (* Column names and types from LVM PVs/VGs/LVs. *)
 let pv_cols = [
   "pv_name", `String;


@@ -217,15 +383,13 @@ let lv_cols = [
   "modules", `String;
 ]
 
   "modules", `String;
 ]
 

-(* In some places we want the functions to be displayed sorted
- * alphabetically, so this is useful:
+(* Useful functions.
+ * Note we don't want to use any external OCaml libraries which
+ * makes this a bit harder than it should be.

  *)
  *)

-let sorted_functions =
-  List.sort (fun (n1,_,_,_,_,_) (n2,_,_,_,_,_) -> compare n1 n2) functions
-
-(* Useful functions. *)

 let failwithf fs = ksprintf failwith fs
 let failwithf fs = ksprintf failwith fs

-let replace s c1 c2 =
+
+let replace_char s c1 c2 =

   let s2 = String.copy s in
   let r = ref false in
   for i = 0 to String.length s2 - 1 do
   let s2 = String.copy s in
   let r = ref false in
   for i = 0 to String.length s2 - 1 do


@@ -236,6 +400,50 @@ let replace s c1 c2 =
   done;
   if not !r then s else s2
 
   done;
   if not !r then s else s2
 

+let rec find s sub =
+  let len = String.length s in
+  let sublen = String.length sub in
+  let rec loop i =
+    if i <= len-sublen then (
+      let rec loop2 j =
+       if j < sublen then (
+         if s.[i+j] = sub.[j] then loop2 (j+1)
+         else -1
+       ) else
+         i (* found *)
+      in
+      let r = loop2 0 in
+      if r = -1 then loop (i+1) else r
+    ) else
+      -1 (* not found *)
+  in
+  loop 0
+
+let rec replace_str s s1 s2 =
+  let len = String.length s in
+  let sublen = String.length s1 in
+  let i = find s s1 in
+  if i = -1 then s
+  else (
+    let s' = String.sub s 0 i in
+    let s'' = String.sub s (i+sublen) (len-i-sublen) in
+    s' ^ s2 ^ replace_str s'' s1 s2
+  )
+
+let rec find_map f = function
+  | [] -> raise Not_found
+  | x :: xs ->
+      match f x with
+      | Some y -> y
+      | None -> find_map f xs
+
+let iteri f xs =
+  let rec loop i = function
+    | [] -> ()
+    | x :: xs -> f i x; loop (i+1) xs
+  in
+  loop 0 xs
+

 (* 'pr' prints to the current output file. *)
 let chan = ref stdout
 let pr fs = ksprintf (output_string !chan) fs
 (* 'pr' prints to the current output file. *)
 let chan = ref stdout
 let pr fs = ksprintf (output_string !chan) fs


@@ -260,14 +468,29 @@ let nr_args = function | P0 -> 0 | P1 _ -> 1 | P2 _ -> 2
 (* Check function names etc. for consistency. *)
 let check_functions () =
   List.iter (
 (* Check function names etc. for consistency. *)
 let check_functions () =
   List.iter (

-    fun (name, _, _, _, _, _) ->
+    fun (name, _, _, _, _, longdesc) ->

       if String.contains name '-' then
       if String.contains name '-' then

-       failwithf "Function name '%s' should not contain '-', use '_' instead."
-         name
-  ) functions;
+       failwithf "function name '%s' should not contain '-', use '_' instead."
+         name;
+      if longdesc.[String.length longdesc-1] = '\n' then
+       failwithf "long description of %s should not end with \\n." name
+  ) all_functions;
+
+  List.iter (
+    fun (name, _, proc_nr, _, _, _) ->
+      if proc_nr <= 0 then
+       failwithf "daemon function %s should have proc_nr > 0" name
+  ) daemon_functions;
+
+  List.iter (
+    fun (name, _, proc_nr, _, _, _) ->
+      if proc_nr <> -1 then
+       failwithf "non-daemon function %s should have proc_nr -1" name
+  ) non_daemon_functions;

 
   let proc_nrs =
 
   let proc_nrs =

-    List.map (fun (name, _, proc_nr, _, _, _) -> name, proc_nr) functions in
+    List.map (fun (name, _, proc_nr, _, _, _) -> name, proc_nr)
+      daemon_functions in

   let proc_nrs =
     List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
   let rec loop = function
   let proc_nrs =
     List.sort (fun (_,nr1) (_,nr2) -> compare nr1 nr2) proc_nrs in
   let rec loop = function


@@ -347,6 +570,11 @@ and generate_actions_pod () =
       (match fst style with
        | Err ->
           pr "This function returns 0 on success or -1 on error.\n\n"
       (match fst style with
        | Err ->
           pr "This function returns 0 on success or -1 on error.\n\n"

+       | RBool _ ->
+          pr "This function returns a C truth value on success or -1 on error.\n\n"
+       | RConstString _ ->
+          pr "This function returns a string or NULL on error.
+The string is owned by the guest handle and must I<not> be freed.\n\n"

        | RString _ ->
           pr "This function returns a string or NULL on error.
 I<The caller must free the returned string after use>.\n\n"
        | RString _ ->
           pr "This function returns a string or NULL on error.
 I<The caller must free the returned string after use>.\n\n"


@@ -368,7 +596,7 @@ I<The caller must call C<guestfs_free_lvm_lv_list> after use.>.\n\n"
        pr "Because of the message protocol, there is a transfer limit 
 of somewhere between 2MB and 4MB.  To transfer large files you should use
 FTP.\n\n";
        pr "Because of the message protocol, there is a transfer limit 
 of somewhere between 2MB and 4MB.  To transfer large files you should use
 FTP.\n\n";

-  ) sorted_functions
+  ) all_functions_sorted

 
 and generate_structs_pod () =
   (* LVM structs documentation. *)
 
 and generate_structs_pod () =
   (* LVM structs documentation. *)


@@ -433,7 +661,7 @@ and generate_xdr () =
   ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
 
   List.iter (
   ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
 
   List.iter (

-    fun (shortname, style, _, _, _, _) ->
+    fun(shortname, style, _, _, _, _) ->

       let name = "guestfs_" ^ shortname in
       pr "/* %s */\n\n" name;
       (match snd style with
       let name = "guestfs_" ^ shortname in
       pr "/* %s */\n\n" name;
       (match snd style with


@@ -443,11 +671,19 @@ and generate_xdr () =
           iter_args (
             function
             | String name -> pr "  string %s<>;\n" name
           iter_args (
             function
             | String name -> pr "  string %s<>;\n" name

+            | OptString name -> pr "  string *%s<>;\n" name
+            | Bool name -> pr "  bool %s;\n" name

           ) args;
           pr "};\n\n"
       );
       (match fst style with
           ) args;
           pr "};\n\n"
       );
       (match fst style with

-       | Err -> () 
+       | Err -> ()
+       | RBool n ->
+          pr "struct %s_ret {\n" name;
+          pr "  bool %s;\n" n;
+          pr "};\n\n"
+       | RConstString _ ->
+          failwithf "RConstString cannot be returned from a daemon function"

        | RString n ->
           pr "struct %s_ret {\n" name;
           pr "  string %s<>;\n" n;
        | RString n ->
           pr "struct %s_ret {\n" name;
           pr "  string %s<>;\n" n;


@@ -469,14 +705,14 @@ and generate_xdr () =
           pr "  guestfs_lvm_int_lv_list %s;\n" n;
           pr "};\n\n"
       );
           pr "  guestfs_lvm_int_lv_list %s;\n" n;
           pr "};\n\n"
       );

-  ) functions;
+  ) daemon_functions;

 
   (* Table of procedure numbers. *)
   pr "enum guestfs_procedure {\n";
   List.iter (
     fun (shortname, _, proc_nr, _, _, _) ->
       pr "  GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr
 
   (* Table of procedure numbers. *)
   pr "enum guestfs_procedure {\n";
   List.iter (
     fun (shortname, _, proc_nr, _, _, _) ->
       pr "  GUESTFS_PROC_%s = %d,\n" (String.uppercase shortname) proc_nr

-  ) functions;
+  ) daemon_functions;

   pr "  GUESTFS_PROC_dummy\n"; (* so we don't have a "hanging comma" *)
   pr "};\n";
   pr "\n";
   pr "  GUESTFS_PROC_dummy\n"; (* so we don't have a "hanging comma" *)
   pr "};\n";
   pr "\n";


@@ -569,7 +805,7 @@ and generate_actions_h () =
       let name = "guestfs_" ^ shortname in
       generate_prototype ~single_line:true ~newline:true ~handle:"handle"
        name style
       let name = "guestfs_" ^ shortname in
       generate_prototype ~single_line:true ~newline:true ~handle:"handle"
        name style

-  ) functions
+  ) all_functions

 
 (* Generate the client-side dispatch stubs. *)
 and generate_client_actions () =
 
 (* Generate the client-side dispatch stubs. *)
 and generate_client_actions () =


@@ -587,7 +823,10 @@ and generate_client_actions () =
       pr "  struct guestfs_message_error err;\n";
       (match fst style with
        | Err -> ()
       pr "  struct guestfs_message_error err;\n";
       (match fst style with
        | Err -> ()

-       | RString _ | RStringList _ | RPVList _ | RVGList _ | RLVList _ ->
+       | RConstString _ ->
+          failwithf "RConstString cannot be returned from a daemon function"
+       | RBool _ | RString _ | RStringList _
+       | RPVList _ | RVGList _ | RLVList _ ->

           pr "  struct %s_ret ret;\n" name
       );
       pr "};\n\n";
           pr "  struct %s_ret ret;\n" name
       );
       pr "};\n\n";


@@ -611,7 +850,10 @@ and generate_client_actions () =
 
       (match fst style with
        | Err -> ()
 
       (match fst style with
        | Err -> ()

-       | RString _ | RStringList _ | RPVList _ | RVGList _ | RLVList _ ->
+       | RConstString _ ->
+          failwithf "RConstString cannot be returned from a daemon function"
+       | RBool _ | RString _ | RStringList _
+       | RPVList _ | RVGList _ | RLVList _ ->

            pr "  if (!xdr_%s_ret (xdr, &rv->ret)) {\n" name;
            pr "    error (g, \"%s: failed to parse reply\");\n" name;
            pr "    return;\n";
            pr "  if (!xdr_%s_ret (xdr, &rv->ret)) {\n" name;
            pr "    error (g, \"%s: failed to parse reply\");\n" name;
            pr "    return;\n";


@@ -629,7 +871,9 @@ and generate_client_actions () =
 
       let error_code =
        match fst style with
 
       let error_code =
        match fst style with

-       | Err -> "-1"
+       | Err | RBool _ -> "-1"
+       | RConstString _ ->
+           failwithf "RConstString cannot be returned from a daemon function"

        | RString _ | RStringList _ | RPVList _ | RVGList _ | RLVList _ ->
            "NULL" in
 
        | RString _ | RStringList _ | RPVList _ | RVGList _ | RLVList _ ->
            "NULL" in
 


@@ -660,7 +904,12 @@ and generate_client_actions () =
        | args ->
           iter_args (
             function
        | args ->
           iter_args (
             function

-            | String name -> pr "  args.%s = (char *) %s;\n" name name
+            | String name ->
+                pr "  args.%s = (char *) %s;\n" name name
+            | OptString name ->
+                pr "  args.%s = %s ? *%s : NULL;\n" name name name
+            | Bool name ->
+                pr "  args.%s = %s;\n" name name

           ) args;
           pr "  serial = dispatch (g, GUESTFS_PROC_%s,\n"
             (String.uppercase shortname);
           ) args;
           pr "  serial = dispatch (g, GUESTFS_PROC_%s,\n"
             (String.uppercase shortname);


@@ -696,11 +945,17 @@ and generate_client_actions () =
 
       (match fst style with
        | Err -> pr "  return 0;\n"
 
       (match fst style with
        | Err -> pr "  return 0;\n"

+       | RBool n -> pr "  return rv.ret.%s;\n" n
+       | RConstString _ ->
+          failwithf "RConstString cannot be returned from a daemon function"

        | RString n ->
           pr "  return rv.ret.%s; /* caller will free */\n" n
        | RStringList n ->
           pr "  /* caller will free this, but we need to add a NULL entry */\n";
        | RString n ->
           pr "  return rv.ret.%s; /* caller will free */\n" n
        | RStringList n ->
           pr "  /* caller will free this, but we need to add a NULL entry */\n";

-          pr "  rv.ret.%s.%s_val = safe_realloc (g, rv.ret.%s.%s_val, rv.ret.%s.%s_len + 1);\n" n n n n n n;
+          pr "  rv.ret.%s.%s_val =" n n;
+          pr "    safe_realloc (g, rv.ret.%s.%s_val,\n" n n;
+          pr "                  sizeof (char *) * (rv.ret.%s.%s_len + 1));\n"
+            n n;

           pr "  rv.ret.%s.%s_val[rv.ret.%s.%s_len] = NULL;\n" n n n n;
           pr "  return rv.ret.%s.%s_val;\n" n n
        | RPVList n ->
           pr "  rv.ret.%s.%s_val[rv.ret.%s.%s_len] = NULL;\n" n n n n;
           pr "  return rv.ret.%s.%s_val;\n" n n
        | RPVList n ->


@@ -715,7 +970,7 @@ and generate_client_actions () =
       );
 
       pr "}\n\n"
       );
 
       pr "}\n\n"

-  ) functions
+  ) daemon_functions

 
 (* Generate daemon/actions.h. *)
 and generate_daemon_actions_h () =
 
 (* Generate daemon/actions.h. *)
 and generate_daemon_actions_h () =


@@ -726,9 +981,9 @@ and generate_daemon_actions_h () =
 
   List.iter (
     fun (name, style, _, _, _, _) ->
 
   List.iter (
     fun (name, style, _, _, _, _) ->

-      generate_prototype
-       ~single_line:true ~newline:true ~in_daemon:true ("do_" ^ name) style;
-  ) functions
+       generate_prototype
+         ~single_line:true ~newline:true ~in_daemon:true ("do_" ^ name) style;
+  ) daemon_functions

 
 (* Generate the server-side stubs. *)
 and generate_daemon_actions () =
 
 (* Generate the server-side stubs. *)
 and generate_daemon_actions () =


@@ -757,6 +1012,9 @@ and generate_daemon_actions () =
       let error_code =
        match fst style with
        | Err -> pr "  int r;\n"; "-1"
       let error_code =
        match fst style with
        | Err -> pr "  int r;\n"; "-1"

+       | RBool _ -> pr "  int r;\n"; "-1"
+       | RConstString _ ->
+           failwithf "RConstString cannot be returned from a daemon function"

        | RString _ -> pr "  char *r;\n"; "NULL"
        | RStringList _ -> pr "  char **r;\n"; "NULL"
        | RPVList _ -> pr "  guestfs_lvm_int_pv_list *r;\n"; "NULL"
        | RString _ -> pr "  char *r;\n"; "NULL"
        | RStringList _ -> pr "  char **r;\n"; "NULL"
        | RPVList _ -> pr "  guestfs_lvm_int_pv_list *r;\n"; "NULL"


@@ -769,7 +1027,9 @@ and generate_daemon_actions () =
           pr "  struct guestfs_%s_args args;\n" name;
           iter_args (
             function
           pr "  struct guestfs_%s_args args;\n" name;
           iter_args (
             function

-            | String name -> pr "  const char *%s;\n" name
+            | String name
+            | OptString name -> pr "  const char *%s;\n" name
+            | Bool name -> pr "  int %s;\n" name

           ) args
       );
       pr "\n";
           ) args
       );
       pr "\n";


@@ -786,6 +1046,8 @@ and generate_daemon_actions () =
           iter_args (
             function
             | String name -> pr "  %s = args.%s;\n" name name
           iter_args (
             function
             | String name -> pr "  %s = args.%s;\n" name name

+            | OptString name -> pr "  %s = args.%s;\n" name name (* XXX? *)
+            | Bool name -> pr "  %s = args.%s;\n" name name

           ) args;
           pr "\n"
       );
           ) args;
           pr "\n"
       );


@@ -801,6 +1063,12 @@ and generate_daemon_actions () =
 
       (match fst style with
        | Err -> pr "  reply (NULL, NULL);\n"
 
       (match fst style with
        | Err -> pr "  reply (NULL, NULL);\n"

+       | RBool n ->
+          pr "  struct guestfs_%s_ret ret;\n" name;
+          pr "  ret.%s = r;\n" n;
+          pr "  reply ((xdrproc_t) &xdr_guestfs_%s_ret, (char *) &ret);\n" name
+       | RConstString _ ->
+          failwithf "RConstString cannot be returned from a daemon function"

        | RString n ->
           pr "  struct guestfs_%s_ret ret;\n" name;
           pr "  ret.%s = r;\n" n;
        | RString n ->
           pr "  struct guestfs_%s_ret ret;\n" name;
           pr "  ret.%s = r;\n" n;


@@ -830,7 +1098,7 @@ and generate_daemon_actions () =
       );
 
       pr "}\n\n";
       );
 
       pr "}\n\n";

-  ) functions;
+  ) daemon_functions;

 
   (* Dispatch function. *)
   pr "void dispatch_incoming_message (XDR *xdr_in)\n";
 
   (* Dispatch function. *)
   pr "void dispatch_incoming_message (XDR *xdr_in)\n";


@@ -839,10 +1107,10 @@ and generate_daemon_actions () =
 
   List.iter (
     fun (name, style, _, _, _, _) ->
 
   List.iter (
     fun (name, style, _, _, _, _) ->

-      pr "    case GUESTFS_PROC_%s:\n" (String.uppercase name);
-      pr "      %s_stub (xdr_in);\n" name;
-      pr "      break;\n"
-  ) functions;
+       pr "    case GUESTFS_PROC_%s:\n" (String.uppercase name);
+       pr "      %s_stub (xdr_in);\n" name;
+       pr "      break;\n"
+  ) daemon_functions;

 
   pr "    default:\n";
   pr "      reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";
 
   pr "    default:\n";
   pr "      reply_with_error (\"dispatch_incoming_message: unknown procedure number %%d\", proc_nr);\n";


@@ -1019,6 +1287,15 @@ and generate_daemon_actions () =
 and generate_fish_cmds () =
   generate_header CStyle GPLv2;
 
 and generate_fish_cmds () =
   generate_header CStyle GPLv2;
 

+  let all_functions =
+    List.filter (
+      fun (_, _, _, flags, _, _) -> not (List.mem NotInFish flags)
+    ) all_functions in
+  let all_functions_sorted =
+    List.filter (
+      fun (_, _, _, flags, _, _) -> not (List.mem NotInFish flags)
+    ) all_functions_sorted in
+

   pr "#include <stdio.h>\n";
   pr "#include <stdlib.h>\n";
   pr "#include <string.h>\n";
   pr "#include <stdio.h>\n";
   pr "#include <stdlib.h>\n";
   pr "#include <string.h>\n";


@@ -1034,11 +1311,11 @@ and generate_fish_cmds () =
   pr "  printf (\"    %%-16s     %%s\\n\", \"Command\", \"Description\");\n";
   pr "  list_builtin_commands ();\n";
   List.iter (
   pr "  printf (\"    %%-16s     %%s\\n\", \"Command\", \"Description\");\n";
   pr "  list_builtin_commands ();\n";
   List.iter (

-    fun (name, _, _, _, shortdesc, _) ->
-      let name = replace name '_' '-' in
+    fun (name, _, _, flags, shortdesc, _) ->
+      let name = replace_char name '_' '-' in

       pr "  printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
        name shortdesc
       pr "  printf (\"%%-20s %%s\\n\", \"%s\", \"%s\");\n"
        name shortdesc

-  ) sorted_functions;
+  ) all_functions_sorted;

   pr "  printf (\"    Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
   pr "}\n";
   pr "\n";
   pr "  printf (\"    Use -h <cmd> / help <cmd> to show detailed help for a command.\\n\");\n";
   pr "}\n";
   pr "\n";


@@ -1048,7 +1325,11 @@ and generate_fish_cmds () =
   pr "{\n";
   List.iter (
     fun (name, style, _, flags, shortdesc, longdesc) ->
   pr "{\n";
   List.iter (
     fun (name, style, _, flags, shortdesc, longdesc) ->

-      let name2 = replace name '_' '-' in
+      let name2 = replace_char name '_' '-' in
+      let alias =
+       try find_map (function FishAlias n -> Some n | _ -> None) flags
+       with Not_found -> name in
+      let longdesc = replace_str longdesc "C<guestfs_" "C<" in

       let synopsis =
        match snd style with
        | P0 -> name2
       let synopsis =
        match snd style with
        | P0 -> name2


@@ -1057,7 +1338,7 @@ and generate_fish_cmds () =
              name2 (
                String.concat "> <" (
                  map_args (function
              name2 (
                String.concat "> <" (
                  map_args (function

-                           | String n -> n) args
+                           | String n | OptString n | Bool n -> n) args

                )
              ) in
 
                )
              ) in
 


@@ -1068,16 +1349,23 @@ of somewhere between 2MB and 4MB.  To transfer large files you should use
 FTP."
        else "" in
 
 FTP."
        else "" in
 

+      let describe_alias =
+       if name <> alias then
+         sprintf "\n\nYou can use '%s' as an alias for this command." alias
+       else "" in
+

       pr "  if (";
       pr "strcasecmp (cmd, \"%s\") == 0" name;
       if name <> name2 then
        pr " || strcasecmp (cmd, \"%s\") == 0" name2;
       pr "  if (";
       pr "strcasecmp (cmd, \"%s\") == 0" name;
       if name <> name2 then
        pr " || strcasecmp (cmd, \"%s\") == 0" name2;

+      if name <> alias then
+       pr " || strcasecmp (cmd, \"%s\") == 0" alias;

       pr ")\n";
       pr "    pod2text (\"%s - %s\", %S);\n"
        name2 shortdesc
       pr ")\n";
       pr "    pod2text (\"%s - %s\", %S);\n"
        name2 shortdesc

-       (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings);
+       (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);

       pr "  else\n"
       pr "  else\n"

-  ) functions;
+  ) all_functions;

   pr "    display_builtin_command (cmd);\n";
   pr "}\n";
   pr "\n";
   pr "    display_builtin_command (cmd);\n";
   pr "}\n";
   pr "\n";


@@ -1123,11 +1411,13 @@ FTP."
 
   (* run_<action> actions *)
   List.iter (
 
   (* run_<action> actions *)
   List.iter (

-    fun (name, style, _, _, _, _) ->
+    fun (name, style, _, flags, _, _) ->

       pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
       pr "{\n";
       (match fst style with
       pr "static int run_%s (const char *cmd, int argc, char *argv[])\n" name;
       pr "{\n";
       (match fst style with

-       | Err -> pr "  int r;\n"
+       | Err
+       | RBool _ -> pr "  int r;\n"
+       | RConstString _ -> pr "  const char *r;\n"

        | RString _ -> pr "  char *r;\n"
        | RStringList _ -> pr "  char **r;\n"
        | RPVList _ -> pr "  struct guestfs_lvm_pv_list *r;\n"
        | RString _ -> pr "  char *r;\n"
        | RStringList _ -> pr "  char **r;\n"
        | RPVList _ -> pr "  struct guestfs_lvm_pv_list *r;\n"


@@ -1137,6 +1427,8 @@ FTP."
       iter_args (
        function
        | String name -> pr "  const char *%s;\n" name
       iter_args (
        function
        | String name -> pr "  const char *%s;\n" name

+       | OptString name -> pr "  const char *%s;\n" name
+       | Bool name -> pr "  int %s;\n" name

       ) (snd style);
 
       (* Check and convert parameters. *)
       ) (snd style);
 
       (* Check and convert parameters. *)


@@ -1151,19 +1443,35 @@ FTP."
        fun i ->
          function
          | String name -> pr "  %s = argv[%d];\n" name i
        fun i ->
          function
          | String name -> pr "  %s = argv[%d];\n" name i

+         | OptString name ->
+             pr "  %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
+               name i i
+         | Bool name ->
+             pr "  %s = is_true (argv[%d]) ? 1 : 0;\n" name i

       ) (snd style);
 
       (* Call C API function. *)
       ) (snd style);
 
       (* Call C API function. *)

-      pr "  r = guestfs_%s " name;
+      let fn =
+       try find_map (function FishAction n -> Some n | _ -> None) flags
+       with Not_found -> sprintf "guestfs_%s" name in
+      pr "  r = %s " fn;

       generate_call_args ~handle:"g" style;
       pr ";\n";
 
       (* Check return value for errors and display command results. *)
       (match fst style with
        | Err -> pr "  return r;\n"
       generate_call_args ~handle:"g" style;
       pr ";\n";
 
       (* Check return value for errors and display command results. *)
       (match fst style with
        | Err -> pr "  return r;\n"

+       | RBool _ ->
+          pr "  if (r == -1) return -1;\n";
+          pr "  if (r) printf (\"true\\n\"); else printf (\"false\\n\");\n";
+          pr "  return 0;\n"
+       | RConstString _ ->
+          pr "  if (r == NULL) return -1;\n";
+          pr "  printf (\"%%s\\n\", r);\n";
+          pr "  return 0;\n"

        | RString _ ->
           pr "  if (r == NULL) return -1;\n";
        | RString _ ->
           pr "  if (r == NULL) return -1;\n";

-          pr "  printf (\"%%s\", r);\n";
+          pr "  printf (\"%%s\\n\", r);\n";

           pr "  free (r);\n";
           pr "  return 0;\n"
        | RStringList _ ->
           pr "  free (r);\n";
           pr "  return 0;\n"
        | RStringList _ ->


@@ -1189,22 +1497,27 @@ FTP."
       );
       pr "}\n";
       pr "\n"
       );
       pr "}\n";
       pr "\n"

-  ) functions;
+  ) all_functions;

 
   (* run_action function *)
   pr "int run_action (const char *cmd, int argc, char *argv[])\n";
   pr "{\n";
   List.iter (
 
   (* run_action function *)
   pr "int run_action (const char *cmd, int argc, char *argv[])\n";
   pr "{\n";
   List.iter (

-    fun (name, _, _, _, _, _) ->
-      let name2 = replace name '_' '-' in
+    fun (name, _, _, flags, _, _) ->
+      let name2 = replace_char name '_' '-' in
+      let alias =
+       try find_map (function FishAlias n -> Some n | _ -> None) flags
+       with Not_found -> name in

       pr "  if (";
       pr "strcasecmp (cmd, \"%s\") == 0" name;
       if name <> name2 then
        pr " || strcasecmp (cmd, \"%s\") == 0" name2;
       pr "  if (";
       pr "strcasecmp (cmd, \"%s\") == 0" name;
       if name <> name2 then
        pr " || strcasecmp (cmd, \"%s\") == 0" name2;

+      if name <> alias then
+       pr " || strcasecmp (cmd, \"%s\") == 0" alias;

       pr ")\n";
       pr "    return run_%s (cmd, argc, argv);\n" name;
       pr "  else\n";
       pr ")\n";
       pr "    return run_%s (cmd, argc, argv);\n" name;
       pr "  else\n";

-  ) functions;
+  ) all_functions;

   pr "    {\n";
   pr "      fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
   pr "      return -1;\n";
   pr "    {\n";
   pr "      fprintf (stderr, \"%%s: unknown command\\n\", cmd);\n";
   pr "      return -1;\n";


@@ -1213,6 +1526,38 @@ FTP."
   pr "}\n";
   pr "\n"
 
   pr "}\n";
   pr "\n"
 

+(* Generate the POD documentation for guestfish. *)
+and generate_fish_actions_pod () =
+  let all_functions_sorted =
+    List.filter (
+      fun (_, _, _, flags, _, _) -> not (List.mem NotInFish flags)
+    ) all_functions_sorted in
+
+  List.iter (
+    fun (name, style, _, flags, _, longdesc) ->
+      let longdesc = replace_str longdesc "C<guestfs_" "C<" in
+      let name = replace_char name '_' '-' in
+      let alias =
+       try find_map (function FishAlias n -> Some n | _ -> None) flags
+       with Not_found -> name in
+
+      pr "=head2 %s" name;
+      if name <> alias then
+       pr " | %s" alias;
+      pr "\n";
+      pr "\n";
+      pr " %s" name;
+      iter_args (
+       function
+       | String n -> pr " %s" n
+       | OptString n -> pr " %s" n
+       | Bool _ -> pr " true|false"
+      ) (snd style);
+      pr "\n";
+      pr "\n";
+      pr "%s\n\n" longdesc
+  ) all_functions_sorted
+

 (* Generate a C function prototype. *)
 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
     ?(single_line = false) ?(newline = false) ?(in_daemon = false)
 (* Generate a C function prototype. *)
 and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
     ?(single_line = false) ?(newline = false) ?(in_daemon = false)


@@ -1221,6 +1566,8 @@ and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
   if static then pr "static ";
   (match fst style with
    | Err -> pr "int "
   if static then pr "static ";
   (match fst style with
    | Err -> pr "int "

+   | RBool _ -> pr "int "
+   | RConstString _ -> pr "const char *"

    | RString _ -> pr "char *"
    | RStringList _ -> pr "char **"
    | RPVList _ ->
    | RString _ -> pr "char *"
    | RStringList _ -> pr "char **"
    | RPVList _ ->


@@ -1248,6 +1595,8 @@ and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
   iter_args (
     function
     | String name -> next (); pr "const char *%s" name
   iter_args (
     function
     | String name -> next (); pr "const char *%s" name

+    | OptString name -> next (); pr "const char *%s" name
+    | Bool name -> next (); pr "int %s" name

   ) (snd style);
   pr ")";
   if semicolon then pr ";";
   ) (snd style);
   pr ")";
   if semicolon then pr ";";


@@ -1267,9 +1616,633 @@ and generate_call_args ?handle style =
       comma := true;
       match arg with
       | String name -> pr "%s" name
       comma := true;
       match arg with
       | String name -> pr "%s" name

+      | OptString name -> pr "%s" name
+      | Bool name -> pr "%s" name

   ) (snd style);
   pr ")"
 
   ) (snd style);
   pr ")"
 

+(* Generate the OCaml bindings interface. *)
+and generate_ocaml_mli () =
+  generate_header OCamlStyle LGPLv2;
+
+  pr "\
+(** For API documentation you should refer to the C API
+    in the guestfs(3) manual page.  The OCaml API uses almost
+    exactly the same calls. *)
+
+type t
+(** A [guestfs_h] handle. *)
+
+exception Error of string
+(** This exception is raised when there is an error. *)
+
+val create : unit -> t
+
+val close : t -> unit
+(** Handles are closed by the garbage collector when they become
+    unreferenced, but callers can also call this in order to
+    provide predictable cleanup. *)
+
+";
+  generate_ocaml_lvm_structure_decls ();
+
+  (* The actions. *)
+  List.iter (
+    fun (name, style, _, _, shortdesc, _) ->
+      generate_ocaml_prototype name style;
+      pr "(** %s *)\n" shortdesc;
+      pr "\n"
+  ) all_functions
+
+(* Generate the OCaml bindings implementation. *)
+and generate_ocaml_ml () =
+  generate_header OCamlStyle LGPLv2;
+
+  pr "\
+type t
+exception Error of string
+external create : unit -> t = \"ocaml_guestfs_create\"
+external close : t -> unit = \"ocaml_guestfs_close\"
+
+let () =
+  Callback.register_exception \"ocaml_guestfs_error\" (Error \"\")
+
+";
+
+  generate_ocaml_lvm_structure_decls ();
+
+  (* The actions. *)
+  List.iter (
+    fun (name, style, _, _, shortdesc, _) ->
+      generate_ocaml_prototype ~is_external:true name style;
+  ) all_functions
+
+(* Generate the OCaml bindings C implementation. *)
+and generate_ocaml_c () =
+  generate_header CStyle LGPLv2;
+
+  pr "#include <stdio.h>\n";
+  pr "#include <stdlib.h>\n";
+  pr "#include <string.h>\n";
+  pr "\n";
+  pr "#include <caml/config.h>\n";
+  pr "#include <caml/alloc.h>\n";
+  pr "#include <caml/callback.h>\n";
+  pr "#include <caml/fail.h>\n";
+  pr "#include <caml/memory.h>\n";
+  pr "#include <caml/mlvalues.h>\n";
+  pr "#include <caml/signals.h>\n";
+  pr "\n";
+  pr "#include <guestfs.h>\n";
+  pr "\n";
+  pr "#include \"guestfs_c.h\"\n";
+  pr "\n";
+
+  (* LVM struct copy functions. *)
+  List.iter (
+    fun (typ, cols) ->
+      let has_optpercent_col =
+       List.exists (function (_, `OptPercent) -> true | _ -> false) cols in
+
+      pr "static CAMLprim value\n";
+      pr "copy_lvm_%s (const struct guestfs_lvm_%s *%s)\n" typ typ typ;
+      pr "{\n";
+      pr "  CAMLparam0 ();\n";
+      if has_optpercent_col then
+       pr "  CAMLlocal3 (rv, v, v2);\n"
+      else
+       pr "  CAMLlocal2 (rv, v);\n";
+      pr "\n";
+      pr "  rv = caml_alloc (%d, 0);\n" (List.length cols);
+      iteri (
+       fun i col ->
+         (match col with
+          | name, `String ->
+              pr "  v = caml_copy_string (%s->%s);\n" typ name
+          | name, `UUID ->
+              pr "  v = caml_alloc_string (32);\n";
+              pr "  memcpy (String_val (v), %s->%s, 32);\n" typ name
+          | name, `Bytes
+          | name, `Int ->
+              pr "  v = caml_copy_int64 (%s->%s);\n" typ name
+          | name, `OptPercent ->
+              pr "  if (%s->%s >= 0) { /* Some %s */\n" typ name name;
+              pr "    v2 = caml_copy_double (%s->%s);\n" typ name;
+              pr "    v = caml_alloc (1, 0);\n";
+              pr "    Store_field (v, 0, v2);\n";
+              pr "  } else /* None */\n";
+              pr "    v = Val_int (0);\n";
+         );
+         pr "  Store_field (rv, %d, v);\n" i
+      ) cols;
+      pr "  CAMLreturn (rv);\n";
+      pr "}\n";
+      pr "\n";
+
+      pr "static CAMLprim value\n";
+      pr "copy_lvm_%s_list (const struct guestfs_lvm_%s_list *%ss)\n"
+       typ typ typ;
+      pr "{\n";
+      pr "  CAMLparam0 ();\n";
+      pr "  CAMLlocal2 (rv, v);\n";
+      pr "  int i;\n";
+      pr "\n";
+      pr "  if (%ss->len == 0)\n" typ;
+      pr "    CAMLreturn (Atom (0));\n";
+      pr "  else {\n";
+      pr "    rv = caml_alloc (%ss->len, 0);\n" typ;
+      pr "    for (i = 0; i < %ss->len; ++i) {\n" typ;
+      pr "      v = copy_lvm_%s (&%ss->val[i]);\n" typ typ;
+      pr "      caml_modify (&Field (rv, i), v);\n";
+      pr "    }\n";
+      pr "    CAMLreturn (rv);\n";
+      pr "  }\n";
+      pr "}\n";
+      pr "\n";
+  ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols];
+
+  List.iter (
+    fun (name, style, _, _, _, _) ->
+      pr "CAMLprim value\n";
+      pr "ocaml_guestfs_%s (value gv" name;
+      iter_args (
+       function
+       | String n | OptString n | Bool n -> pr ", value %sv" n
+      ) (snd style);
+      pr ")\n";
+      pr "{\n";
+      pr "  CAMLparam%d (gv" (1 + (nr_args (snd style)));
+      iter_args (
+       function
+       | String n | OptString n | Bool n -> pr ", %sv" n
+      ) (snd style);
+      pr ");\n";
+      pr "  CAMLlocal1 (rv);\n";
+      pr "\n";
+
+      pr "  guestfs_h *g = Guestfs_val (gv);\n";
+      pr "  if (g == NULL)\n";
+      pr "    caml_failwith (\"%s: used handle after closing it\");\n" name;
+      pr "\n";
+
+      iter_args (
+       function
+       | String n ->
+           pr "  const char *%s = String_val (%sv);\n" n n
+       | OptString n ->
+           pr "  const char *%s =\n" n;
+           pr "    %sv != Val_int (0) ? String_val (Field (%sv, 0)) : NULL;\n"
+             n n
+       | Bool n ->
+           pr "  int %s = Bool_val (%sv);\n" n n
+      ) (snd style);
+      let error_code =
+       match fst style with
+       | Err -> pr "  int r;\n"; "-1"
+       | RBool _ -> pr "  int r;\n"; "-1"
+       | RConstString _ -> pr "  const char *r;\n"; "NULL"
+       | RString _ -> pr "  char *r;\n"; "NULL"
+       | RStringList _ ->
+           pr "  int i;\n";
+           pr "  char **r;\n";
+           "NULL"
+       | RPVList _ ->
+           pr "  struct guestfs_lvm_pv_list *r;\n";
+           "NULL"
+       | RVGList _ ->
+           pr "  struct guestfs_lvm_vg_list *r;\n";
+           "NULL"
+       | RLVList _ ->
+           pr "  struct guestfs_lvm_lv_list *r;\n";
+           "NULL" in
+      pr "\n";
+
+      pr "  caml_enter_blocking_section ();\n";
+      pr "  r = guestfs_%s " name;
+      generate_call_args ~handle:"g" style;
+      pr ";\n";
+      pr "  caml_leave_blocking_section ();\n";
+      pr "  if (r == %s)\n" error_code;
+      pr "    ocaml_guestfs_raise_error (g, \"%s\");\n" name;
+      pr "\n";
+
+      (match fst style with
+       | Err -> pr "  rv = Val_unit;\n"
+       | RBool _ -> pr "  rv = r ? Val_true : Val_false;\n"
+       | RConstString _ -> pr "  rv = caml_copy_string (r);\n"
+       | RString _ ->
+          pr "  rv = caml_copy_string (r);\n";
+          pr "  free (r);\n"
+       | RStringList _ ->
+          pr "  rv = caml_copy_string_array ((const char **) r);\n";
+          pr "  for (i = 0; r[i] != NULL; ++i) free (r[i]);\n";
+          pr "  free (r);\n"
+       | RPVList _ ->
+          pr "  rv = copy_lvm_pv_list (r);\n";
+          pr "  guestfs_free_lvm_pv_list (r);\n";
+       | RVGList _ ->
+          pr "  rv = copy_lvm_vg_list (r);\n";
+          pr "  guestfs_free_lvm_vg_list (r);\n";
+       | RLVList _ ->
+          pr "  rv = copy_lvm_lv_list (r);\n";
+          pr "  guestfs_free_lvm_lv_list (r);\n";
+      );
+
+      pr "  CAMLreturn (rv);\n";
+      pr "}\n";
+      pr "\n"
+  ) all_functions
+
+and generate_ocaml_lvm_structure_decls () =
+  List.iter (
+    fun (typ, cols) ->
+      pr "type lvm_%s = {\n" typ;
+      List.iter (
+       function
+       | name, `String -> pr "  %s : string;\n" name
+       | name, `UUID -> pr "  %s : string;\n" name
+       | name, `Bytes -> pr "  %s : int64;\n" name
+       | name, `Int -> pr "  %s : int64;\n" name
+       | name, `OptPercent -> pr "  %s : float option;\n" name
+      ) cols;
+      pr "}\n";
+      pr "\n"
+  ) ["pv", pv_cols; "vg", vg_cols; "lv", lv_cols]
+
+and generate_ocaml_prototype ?(is_external = false) name style =
+  if is_external then pr "external " else pr "val ";
+  pr "%s : t -> " name;
+  iter_args (
+    function
+    | String _ -> pr "string -> "
+    | OptString _ -> pr "string option -> "
+    | Bool _ -> pr "bool -> "
+  ) (snd style);
+  (match fst style with
+   | Err -> pr "unit" (* all errors are turned into exceptions *)
+   | RBool _ -> pr "bool"
+   | RConstString _ -> pr "string"
+   | RString _ -> pr "string"
+   | RStringList _ -> pr "string array"
+   | RPVList _ -> pr "lvm_pv array"
+   | RVGList _ -> pr "lvm_vg array"
+   | RLVList _ -> pr "lvm_lv array"
+  );
+  if is_external then pr " = \"ocaml_guestfs_%s\"" name;
+  pr "\n"
+
+(* Generate Perl xs code, a sort of crazy variation of C with macros. *)
+and generate_perl_xs () =
+  generate_header CStyle LGPLv2;
+
+  pr "\
+#include \"EXTERN.h\"
+#include \"perl.h\"
+#include \"XSUB.h\"
+
+#include <guestfs.h>
+
+#ifndef PRId64
+#define PRId64 \"lld\"
+#endif
+
+static SV *
+my_newSVll(long long val) {
+#ifdef USE_64_BIT_ALL
+  return newSViv(val);
+#else
+  char buf[100];
+  int len;
+  len = snprintf(buf, 100, \"%%\" PRId64, val);
+  return newSVpv(buf, len);
+#endif
+}
+
+#ifndef PRIu64
+#define PRIu64 \"llu\"
+#endif
+
+static SV *
+my_newSVull(unsigned long long val) {
+#ifdef USE_64_BIT_ALL
+  return newSVuv(val);
+#else
+  char buf[100];
+  int len;
+  len = snprintf(buf, 100, \"%%\" PRIu64, val);
+  return newSVpv(buf, len);
+#endif
+}
+
+/* XXX Not thread-safe, and in general not safe if the caller is
+ * issuing multiple requests in parallel (on different guestfs
+ * handles).  We should use the guestfs_h handle passed to the
+ * error handle to distinguish these cases.
+ */
+static char *last_error = NULL;
+
+static void
+error_handler (guestfs_h *g,
+              void *data,
+              const char *msg)
+{
+  if (last_error != NULL) free (last_error);
+  last_error = strdup (msg);
+}
+
+MODULE = Sys::Guestfs  PACKAGE = Sys::Guestfs
+
+guestfs_h *
+_create ()
+   CODE:
+      RETVAL = guestfs_create ();
+      if (!RETVAL)
+        croak (\"could not create guestfs handle\");
+      guestfs_set_error_handler (RETVAL, error_handler, NULL);
+ OUTPUT:
+      RETVAL
+
+void
+DESTROY (g)
+      guestfs_h *g;
+ PPCODE:
+      guestfs_close (g);
+
+";
+
+  List.iter (
+    fun (name, style, _, _, _, _) ->
+      (match fst style with
+       | Err -> pr "void\n"
+       | RBool _ -> pr "SV *\n"
+       | RConstString _ -> pr "SV *\n"
+       | RString _ -> pr "SV *\n"
+       | RStringList _
+       | RPVList _ | RVGList _ | RLVList _ ->
+          pr "void\n" (* all lists returned implictly on the stack *)
+      );
+      (* Call and arguments. *)
+      pr "%s " name;
+      generate_call_args ~handle:"g" style;
+      pr "\n";
+      pr "      guestfs_h *g;\n";
+      iter_args (
+       function
+       | String n -> pr "      char *%s;\n" n
+       | OptString n -> pr "      char *%s;\n" n
+       | Bool n -> pr "      int %s;\n" n
+      ) (snd style);
+      (* Code. *)
+      (match fst style with
+       | Err ->
+          pr " PPCODE:\n";
+          pr "      if (guestfs_%s " name;
+          generate_call_args ~handle:"g" style;
+          pr " == -1)\n";
+          pr "        croak (\"%s: %%s\", last_error);\n" name
+       | RConstString n ->
+          pr "PREINIT:\n";
+          pr "      const char *%s;\n" n;
+          pr "   CODE:\n";
+          pr "      %s = guestfs_%s " n name;
+          generate_call_args ~handle:"g" style;
+          pr ";\n";
+          pr "      if (%s == NULL)\n" n;
+          pr "        croak (\"%s: %%s\", last_error);\n" name;
+          pr "      RETVAL = newSVpv (%s, 0);\n" n;
+          pr " OUTPUT:\n";
+          pr "      RETVAL\n"
+       | RString n ->
+          pr "PREINIT:\n";
+          pr "      char *%s;\n" n;
+          pr "   CODE:\n";
+          pr "      %s = guestfs_%s " n name;
+          generate_call_args ~handle:"g" style;
+          pr ";\n";
+          pr "      if (%s == NULL)\n" n;
+          pr "        croak (\"%s: %%s\", last_error);\n" name;
+          pr "      RETVAL = newSVpv (%s, 0);\n" n;
+          pr "      free (%s);\n" n;
+          pr " OUTPUT:\n";
+          pr "      RETVAL\n"
+       | RBool n ->
+          pr "PREINIT:\n";
+          pr "      int %s;\n" n;
+          pr "   CODE:\n";
+          pr "      %s = guestfs_%s " n name;
+          generate_call_args ~handle:"g" style;
+          pr ";\n";
+          pr "      if (%s == -1)\n" n;
+          pr "        croak (\"%s: %%s\", last_error);\n" name;
+          pr "      RETVAL = newSViv (%s);\n" n;
+          pr " OUTPUT:\n";
+          pr "      RETVAL\n"
+       | RStringList n ->
+          pr "PREINIT:\n";
+          pr "      char **%s;\n" n;
+          pr "      int i, n;\n";
+          pr " PPCODE:\n";
+          pr "      %s = guestfs_%s " n name;
+          generate_call_args ~handle:"g" style;
+          pr ";\n";
+          pr "      if (%s == NULL)\n" n;
+          pr "        croak (\"%s: %%s\", last_error);\n" name;
+          pr "      for (n = 0; %s[n] != NULL; ++n) /**/;\n" n;
+          pr "      EXTEND (SP, n);\n";
+          pr "      for (i = 0; i < n; ++i) {\n";
+          pr "        PUSHs (sv_2mortal (newSVpv (%s[i], 0)));\n" n;
+          pr "        free (%s[i]);\n" n;
+          pr "      }\n";
+          pr "      free (%s);\n" n;
+       | RPVList n ->
+          generate_perl_lvm_code "pv" pv_cols name style n;
+       | RVGList n ->
+          generate_perl_lvm_code "vg" vg_cols name style n;
+       | RLVList n ->
+          generate_perl_lvm_code "lv" lv_cols name style n;
+      );
+      pr "\n"
+  ) all_functions
+
+and generate_perl_lvm_code typ cols name style n =
+  pr "PREINIT:\n";
+  pr "      struct guestfs_lvm_%s_list *%s;\n" typ n;
+  pr "      int i;\n";
+  pr "      HV *hv;\n";
+  pr " PPCODE:\n";
+  pr "      %s = guestfs_%s " n name;
+  generate_call_args ~handle:"g" style;
+  pr ";\n";
+  pr "      if (%s == NULL)\n" n;
+  pr "        croak (\"%s: %%s\", last_error);\n" name;
+  pr "      EXTEND (SP, %s->len);\n" n;
+  pr "      for (i = 0; i < %s->len; ++i) {\n" n;
+  pr "        hv = newHV ();\n";
+  List.iter (
+    function
+    | name, `String ->
+       pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 0), 0);\n"
+         name (String.length name) n name
+    | name, `UUID ->
+       pr "        (void) hv_store (hv, \"%s\", %d, newSVpv (%s->val[i].%s, 32), 0);\n"
+         name (String.length name) n name
+    | name, `Bytes ->
+       pr "        (void) hv_store (hv, \"%s\", %d, my_newSVull (%s->val[i].%s), 0);\n"
+         name (String.length name) n name
+    | name, `Int ->
+       pr "        (void) hv_store (hv, \"%s\", %d, my_newSVll (%s->val[i].%s), 0);\n"
+         name (String.length name) n name
+    | name, `OptPercent ->
+       pr "        (void) hv_store (hv, \"%s\", %d, newSVnv (%s->val[i].%s), 0);\n"
+         name (String.length name) n name
+  ) cols;
+  pr "        PUSHs (sv_2mortal ((SV *) hv));\n";
+  pr "      }\n";
+  pr "      guestfs_free_lvm_%s_list (%s);\n" typ n
+
+(* Generate Sys/Guestfs.pm. *)
+and generate_perl_pm () =
+  generate_header HashStyle LGPLv2;
+
+  pr "\
+=pod
+
+=head1 NAME
+
+Sys::Guestfs - Perl bindings for libguestfs
+
+=head1 SYNOPSIS
+
+ use Sys::Guestfs;
+ 
+ my $h = Sys::Guestfs->new ();
+ $h->add_drive ('guest.img');
+ $h->launch ();
+ $h->wait_ready ();
+ $h->mount ('/dev/sda1', '/');
+ $h->touch ('/hello');
+ $h->sync ();
+
+=head1 DESCRIPTION
+
+The C<Sys::Guestfs> module provides a Perl XS binding to the
+libguestfs API for examining and modifying virtual machine
+disk images.
+
+Amongst the things this is good for: making batch configuration
+changes to guests, getting disk used/free statistics (see also:
+virt-df), migrating between virtualization systems (see also:
+virt-p2v), performing partial backups, performing partial guest
+clones, cloning guests and changing registry/UUID/hostname info, and
+much else besides.
+
+Libguestfs uses Linux kernel and qemu code, and can access any type of
+guest filesystem that Linux and qemu can, including but not limited
+to: ext2/3/4, btrfs, FAT and NTFS, LVM, many different disk partition
+schemes, qcow, qcow2, vmdk.
+
+Libguestfs provides ways to enumerate guest storage (eg. partitions,
+LVs, what filesystem is in each LV, etc.).  It can also run commands
+in the context of the guest.  Also you can access filesystems over FTP.
+
+=head1 ERRORS
+
+All errors turn into calls to C<croak> (see L<Carp(3)>).
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
+package Sys::Guestfs;
+
+use strict;
+use warnings;
+
+require XSLoader;
+XSLoader::load ('Sys::Guestfs');
+
+=item $h = Sys::Guestfs->new ();
+
+Create a new guestfs handle.
+
+=cut
+
+sub new {
+  my $proto = shift;
+  my $class = ref ($proto) || $proto;
+
+  my $self = Sys::Guestfs::_create ();
+  bless $self, $class;
+  return $self;
+}
+
+";
+
+  (* Actions.  We only need to print documentation for these as
+   * they are pulled in from the XS code automatically.
+   *)
+  List.iter (
+    fun (name, style, _, flags, _, longdesc) ->
+      let longdesc = replace_str longdesc "C<guestfs_" "C<$h-E<gt>" in
+      pr "=item ";
+      generate_perl_prototype name style;
+      pr "\n\n";
+      pr "%s\n\n" longdesc;
+      if List.mem ProtocolLimitWarning flags then
+       pr "Because of the message protocol, there is a transfer limit 
+of somewhere between 2MB and 4MB.  To transfer large files you should use
+FTP.\n\n";
+  ) all_functions_sorted;
+
+  (* End of file. *)
+  pr "\
+=cut
+
+1;
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (C) 2009 Red Hat Inc.
+
+=head1 LICENSE
+
+Please see the file COPYING.LIB for the full license.
+
+=head1 SEE ALSO
+
+L<guestfs(3)>, L<guestfish(1)>.
+
+=cut
+"
+
+and generate_perl_prototype name style =
+  (match fst style with
+   | Err -> ()
+   | RBool n
+   | RConstString n
+   | RString n -> pr "$%s = " n
+   | RStringList n
+   | RPVList n
+   | RVGList n
+   | RLVList n -> pr "@%s = " n
+  );
+  pr "$h->%s (" name;
+  let comma = ref false in
+  iter_args (
+    fun arg ->
+      if !comma then pr ", ";
+      comma := true;
+      match arg with
+      | String n -> pr "%s" n
+      | OptString n -> pr "%s" n
+      | Bool n -> pr "%s" n
+  ) (snd style);
+  pr ");"
+

 let output_to filename =
   let filename_new = filename ^ ".new" in
   chan := open_out filename_new;
 let output_to filename =
   let filename_new = filename ^ ".new" in
   chan := open_out filename_new;


@@ -1319,4 +2292,28 @@ let () =
 
   let close = output_to "guestfs-actions.pod" in
   generate_actions_pod ();
 
   let close = output_to "guestfs-actions.pod" in
   generate_actions_pod ();

-  close ()
+  close ();
+
+  let close = output_to "guestfish-actions.pod" in
+  generate_fish_actions_pod ();
+  close ();
+
+  let close = output_to "ocaml/guestfs.mli" in
+  generate_ocaml_mli ();
+  close ();
+
+  let close = output_to "ocaml/guestfs.ml" in
+  generate_ocaml_ml ();
+  close ();
+
+  let close = output_to "ocaml/guestfs_c_actions.c" in
+  generate_ocaml_c ();
+  close ();
+
+  let close = output_to "perl/Guestfs.xs" in
+  generate_perl_xs ();
+  close ();
+
+  let close = output_to "perl/lib/Sys/Guestfs.pm" in
+  generate_perl_pm ();
+  close ();