X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=src%2Fgenerator.ml;h=85344aaea98d84bd0fdc974c66d818f95e0e0f41;hb=fee26ee231d22481a93176b29a9629c780b45dc3;hp=8892de5df92168dc87023284e5393e7d4acc2d5c;hpb=84fc760439e82e6b3616abd0d1f9bd7d7eb01ec0;p=libguestfs.git

diff --git a/src/generator.ml b/src/generator.ml
index 8892de5..85344aa 100755
--- a/src/generator.ml
+++ b/src/generator.ml
@@ -136,6 +136,7 @@ and argt =
   | String of string	(* const char *name, cannot be NULL *)
   | Device of string	(* /dev device name, cannot be NULL *)
   | Pathname of string	(* file name, cannot be NULL *)
+  | Dev_or_Path of string (* /dev device name or Pathname, cannot be NULL *)
   | OptString of string	(* const char *name, may be NULL *)
   | StringList of string(* list of strings (each string cannot be NULL) *)
   | Bool of string	(* boolean *)
@@ -855,7 +856,7 @@ Note that this function cannot correctly handle binary files
 as end of string).  For those you need to use the C<guestfs_read_file>
 or C<guestfs_download> functions which have a more complex interface.");
 
-  ("ll", (RString "listing", [String "directory"]), 5, [],
+  ("ll", (RString "listing", [Pathname "directory"]), 5, [],
    [], (* XXX Tricky to test because it depends on the exact format
         * of the 'ls -l' command, which changes between F10 and F11.
         *)
@@ -867,7 +868,7 @@ there is no cwd) in the format of 'ls -la'.
 This command is mostly useful for interactive sessions.  It
 is I<not> intended that you try to parse the output string.");
 
-  ("ls", (RStringList "listing", [String "directory"]), 6, [],
+  ("ls", (RStringList "listing", [Pathname "directory"]), 6, [],
    [InitBasicFS, Always, TestOutputList (
       [["touch"; "/new"];
        ["touch"; "/newer"];
@@ -1477,7 +1478,7 @@ Some internal mounts are not unmounted by this call.");
 This command removes all LVM logical volumes, volume groups
 and physical volumes.");
 
-  ("file", (RString "description", [Pathname "path"]), 49, [],
+  ("file", (RString "description", [Dev_or_Path "path"]), 49, [],
    [InitSquashFS, Always, TestOutput (
       [["file"; "/empty"]], "empty");
     InitSquashFS, Always, TestOutput (
@@ -1801,7 +1802,7 @@ C<filename> can also be a named pipe.
 
 See also C<guestfs_download>.");
 
-  ("download", (RErr, [String "remotefilename"; FileOut "filename"]), 67, [],
+  ("download", (RErr, [Dev_or_Path "remotefilename"; FileOut "filename"]), 67, [],
    [InitBasicFS, Always, TestOutput (
       (* Pick a file from cwd which isn't likely to change. *)
       [["upload"; "../COPYING.LIB"; "/COPYING.LIB"];
@@ -1909,7 +1910,7 @@ I<gzip compressed> tar file) into C<directory>.
 
 To upload an uncompressed tarball, use C<guestfs_tar_in>.");
 
-  ("tgz_out", (RErr, [String "directory"; FileOut "tarball"]), 72, [],
+  ("tgz_out", (RErr, [Pathname "directory"; FileOut "tarball"]), 72, [],
    [],
    "pack directory into compressed tarball",
    "\
@@ -2169,7 +2170,7 @@ See also: C<guestfs_scrub_device>.");
 This command installs GRUB (the Grand Unified Bootloader) on
 C<device>, with the root directory being C<root>.");
 
-  ("cp", (RErr, [String "src"; String "dest"]), 87, [],
+  ("cp", (RErr, [Pathname "src"; Pathname "dest"]), 87, [],
    [InitBasicFS, Always, TestOutput (
       [["write_file"; "/old"; "file content"; "0"];
        ["cp"; "/old"; "/new"];
@@ -2188,7 +2189,7 @@ C<device>, with the root directory being C<root>.");
 This copies a file from C<src> to C<dest> where C<dest> is
 either a destination filename or destination directory.");
 
-  ("cp_a", (RErr, [String "src"; String "dest"]), 88, [],
+  ("cp_a", (RErr, [Pathname "src"; Pathname "dest"]), 88, [],
    [InitBasicFS, Always, TestOutput (
       [["mkdir"; "/olddir"];
        ["mkdir"; "/newdir"];
@@ -2200,7 +2201,7 @@ either a destination filename or destination directory.");
 This copies a file or directory from C<src> to C<dest>
 recursively using the C<cp -a> command.");
 
-  ("mv", (RErr, [String "src"; String "dest"]), 89, [],
+  ("mv", (RErr, [Pathname "src"; Pathname "dest"]), 89, [],
    [InitBasicFS, Always, TestOutput (
       [["write_file"; "/old"; "file content"; "0"];
        ["mv"; "/old"; "/new"];
@@ -2594,7 +2595,7 @@ 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, [],
+  ("scrub_file", (RErr, [Pathname "file"]), 115, [],
    [InitBasicFS, Always, TestRun (
       [["write_file"; "/file"; "content"; "0"];
        ["scrub_file"; "/file"]])],
@@ -2608,7 +2609,7 @@ 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, [],
+  ("scrub_freespace", (RErr, [Pathname "dir"]), 116, [],
    [], (* XXX needs testing *)
    "scrub (securely wipe) free space",
    "\
@@ -2621,8 +2622,7 @@ containing C<dir>.
 It is an interface to the L<scrub(1)> program.  See that
 manual page for more details.");
 
-(* FIXME: make this a WritableString? *)
-  ("mkdtemp", (RString "dir", [String "template"]), 117, [],
+  ("mkdtemp", (RString "dir", [Pathname "template"]), 117, [],
    [InitBasicFS, Always, TestRun (
       [["mkdir"; "/tmp"];
        ["mkdtemp"; "/tmp/tmpXXXXXX"]])],
@@ -2776,7 +2776,7 @@ Old Linux kernels (2.4 and earlier) used a compressed ext2
 filesystem as initrd.  We I<only> support the newer initramfs
 format (compressed cpio files).");
 
-  ("mount_loop", (RErr, [String "file"; String "mountpoint"]), 129, [],
+  ("mount_loop", (RErr, [Pathname "file"; Pathname "mountpoint"]), 129, [],
    [],
    "mount a file using the loop device",
    "\
@@ -2882,7 +2882,7 @@ See also L<umask(2)>, C<guestfs_mknod>, C<guestfs_mkdir>.
 
 This call returns the previous umask.");
 
-  ("readdir", (RStructList ("entries", "dirent"), [String "dir"]), 138, [],
+  ("readdir", (RStructList ("entries", "dirent"), [Pathname "dir"]), 138, [],
    [],
    "read directories entries",
    "\
@@ -3278,7 +3278,7 @@ This command disables the libguestfs appliance swap
 device or partition named C<device>.
 See C<guestfs_swapon_device>.");
 
-  ("swapon_file", (RErr, [String "file"]), 172, [],
+  ("swapon_file", (RErr, [Pathname "file"]), 172, [],
    [InitBasicFS, Always, TestRun (
       [["fallocate"; "/swap"; "8388608"];
        ["mkswap_file"; "/swap"];
@@ -3289,7 +3289,7 @@ See C<guestfs_swapon_device>.");
 This command enables swap to a file.
 See C<guestfs_swapon_device> for other notes.");
 
-  ("swapoff_file", (RErr, [String "file"]), 173, [],
+  ("swapoff_file", (RErr, [Pathname "file"]), 173, [],
    [], (* XXX tested by swapon_file *)
    "disable swap on file",
    "\
@@ -3645,6 +3645,64 @@ let java_structs = [
   "inotify_event", "INotifyEvent";
 ]
 
+(* What structs are actually returned. *)
+type rstructs_used_t = RStructOnly | RStructListOnly | RStructAndList
+
+(* Returns a list of RStruct/RStructList structs that are returned
+ * by any function.  Each element of returned list is a pair:
+ *
+ * (structname, RStructOnly)
+ *    == there exists function which returns RStruct (_, structname)
+ * (structname, RStructListOnly)
+ *    == there exists function which returns RStructList (_, structname)
+ * (structname, RStructAndList)
+ *    == there are functions returning both RStruct (_, structname)
+ *                                      and RStructList (_, structname)
+ *)
+let rstructs_used =
+  (* ||| is a "logical OR" for rstructs_used_t *)
+  let (|||) a b =
+    match a, b with
+    | RStructAndList, _
+    | _, RStructAndList -> RStructAndList
+    | RStructOnly, RStructListOnly
+    | RStructListOnly, RStructOnly -> RStructAndList
+    | RStructOnly, RStructOnly -> RStructOnly
+    | RStructListOnly, RStructListOnly -> RStructListOnly
+  in
+
+  let h = Hashtbl.create 13 in
+
+  (* if elem->oldv exists, update entry using ||| operator,
+   * else just add elem->newv to the hash
+   *)
+  let update elem newv =
+    try  let oldv = Hashtbl.find h elem in
+         Hashtbl.replace h elem (newv ||| oldv)
+    with Not_found -> Hashtbl.add h elem newv
+  in
+
+  List.iter (
+    fun (_, style, _, _, _, _, _) ->
+      match fst style with
+      | RStruct (_, structname) -> update structname RStructOnly
+      | RStructList (_, structname) -> update structname RStructListOnly
+      | _ -> ()
+  ) all_functions;
+
+  (* return key->values as a list of (key,value) *)
+  Hashtbl.fold (fun key value xs -> (key, value) :: xs) h []
+
+(* debug:
+let () =
+  List.iter (
+    function
+    | sn, RStructOnly -> printf "%s RStructOnly\n" sn
+    | sn, RStructListOnly -> printf "%s RStructListOnly\n" sn
+    | sn, RStructAndList -> printf "%s RStructAndList\n" sn
+  ) rstructs_used
+*)
+
 (* Used for testing language bindings. *)
 type callt =
   | CallString of string
@@ -3783,7 +3841,7 @@ let mapi f xs =
   loop 0 xs
 
 let name_of_argt = function
-  | Pathname n | Device n | String n | OptString n | StringList n | Bool n | Int n
+  | Pathname n | Device n | Dev_or_Path n | String n | OptString n | StringList n | Bool n | Int n
   | FileIn n | FileOut n -> n
 
 let java_name_of_struct typ =
@@ -4170,7 +4228,7 @@ and generate_xdr () =
            pr "struct %s_args {\n" name;
            List.iter (
              function
-             | Pathname n | Device n | String n -> pr "  string %s<>;\n" n
+             | Pathname n | Device n | Dev_or_Path n | String n -> pr "  string %s<>;\n" n
              | OptString n -> pr "  str *%s;\n" n
              | StringList n -> pr "  str %s<>;\n" n
              | Bool n -> pr "  bool %s;\n" n
@@ -4531,7 +4589,7 @@ check_state (guestfs_h *g, const char *caller)
        | args ->
            List.iter (
              function
-             | Pathname n | Device n | String n ->
+             | Pathname n | Device n | Dev_or_Path n | String n ->
                  pr "  args.%s = (char *) %s;\n" n n
              | OptString n ->
                  pr "  args.%s = %s ? (char **) &%s : NULL;\n" n n n
@@ -4736,9 +4794,9 @@ and generate_daemon_actions () =
            pr "  struct guestfs_%s_args args;\n" name;
            List.iter (
              function
-             | Device n -> pr "  const char *%s;\n" n
+             | Device n | Dev_or_Path n
              | Pathname n
-             | String n
+             | String n -> ()
              | OptString n -> pr "  char *%s;\n" n
              | StringList n -> pr "  char **%s;\n" n
              | Bool n -> pr "  int %s;\n" n
@@ -4757,15 +4815,21 @@ and generate_daemon_actions () =
            pr "    reply_with_error (\"%%s: daemon failed to decode procedure arguments\", \"%s\");\n" name;
            pr "    return;\n";
            pr "  }\n";
+           let pr_args n =
+             pr "  char *%s = args.%s;\n" n n
+           in
            List.iter (
              function
              | Pathname n ->
-                 pr "  %s = args.%s;\n" n n;
+                 pr_args n;
                  pr "  ABS_PATH (%s, goto done);\n" n;
-	     | Device n ->
-                 pr "  %s = args.%s;\n" n n;
+             | Device n ->
+                 pr_args n;
                  pr "  RESOLVE_DEVICE (%s, goto done);" n;
-             | String n -> pr "  %s = args.%s;\n" n n
+             | Dev_or_Path n ->
+                 pr_args n;
+                 pr "  REQUIRE_ROOT_OR_RESOLVE_DEVICE (%s, goto done);" n;
+             | String n -> pr_args n
              | OptString n -> pr "  %s = args.%s ? *args.%s : NULL;\n" n n n
              | StringList n ->
                  pr "  %s = realloc (args.%s.%s_val,\n" n n n;
@@ -5678,6 +5742,7 @@ and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
         | OptString n, "NULL" -> ()
         | Pathname n, arg
         | Device n, arg
+        | Dev_or_Path n, arg
         | String n, arg
         | OptString n, arg ->
             pr "    const char *%s = \"%s\";\n" n (c_quote arg);
@@ -5726,7 +5791,7 @@ and generate_test_command_call ?(expect_error = false) ?test test_name cmd =
         function
         | OptString _, "NULL" -> pr ", NULL"
         | Pathname n, _
-        | Device n, _
+        | Device n, _ | Dev_or_Path n, _
         | String n, _
         | OptString n, _ ->
             pr ", %s" n
@@ -5976,7 +6041,7 @@ and generate_fish_cmds () =
       List.iter (
         function
         | Pathname n
-        | Device n
+        | Device n | Dev_or_Path n
         | String n
         | OptString n
         | FileIn n
@@ -5998,7 +6063,7 @@ and generate_fish_cmds () =
         fun i ->
           function
           | Pathname name
-          | Device name | String name -> pr "  %s = argv[%d];\n" name i
+          | Device name | Dev_or_Path name | String name -> pr "  %s = argv[%d];\n" name i
           | OptString name ->
               pr "  %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n"
                 name i i
@@ -6231,7 +6296,7 @@ and generate_fish_actions_pod () =
       pr " %s" name;
       List.iter (
         function
-        | Pathname n | Device n | String n -> pr " %s" n
+        | Pathname n | Device n | Dev_or_Path n | String n -> pr " %s" n
         | OptString n -> pr " %s" n
         | StringList n -> pr " '%s ...'" n
         | Bool _ -> pr " true|false"
@@ -6298,7 +6363,7 @@ and generate_prototype ?(extern = true) ?(static = false) ?(semicolon = true)
     List.iter (
       function
       | Pathname n
-      | Device n
+      | Device n | Dev_or_Path n
       | String n
       | OptString n ->
           next ();
@@ -6561,7 +6626,7 @@ copy_table (char * const * argv)
       List.iter (
         function
         | Pathname n
-        | Device n
+        | Device n | Dev_or_Path n
         | String n
         | FileIn n
         | FileOut n ->
@@ -6614,7 +6679,7 @@ copy_table (char * const * argv)
         function
         | StringList n ->
             pr "  ocaml_guestfs_free_strings (%s);\n" n;
-        | Pathname _ | Device _ | String _ | OptString _ | Bool _ | Int _
+        | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _ | Bool _ | Int _
         | FileIn _ | FileOut _ -> ()
       ) (snd style);
 
@@ -6698,7 +6763,7 @@ and generate_ocaml_prototype ?(is_external = false) name style =
   pr "%s : t -> " name;
   List.iter (
     function
-    | Pathname _ | Device _ | String _ | FileIn _ | FileOut _ -> pr "string -> "
+    | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _ -> pr "string -> "
     | OptString _ -> pr "string option -> "
     | StringList _ -> pr "string array -> "
     | Bool _ -> pr "bool -> "
@@ -6843,8 +6908,7 @@ DESTROY (g)
       iteri (
         fun i ->
           function
-	  (* FIXME: ? *)
-          | Pathname n | Device n | String n | FileIn n | FileOut n ->
+          | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
               pr "      char *%s;\n" n
           | OptString n ->
               (* http://www.perlmonks.org/?node_id=554277
@@ -6860,7 +6924,7 @@ DESTROY (g)
       let do_cleanups () =
         List.iter (
           function
-          | Pathname _ | Device _ | String _ | OptString _ | Bool _ | Int _
+          | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _ | Bool _ | Int _
           | FileIn _ | FileOut _ -> ()
           | StringList n -> pr "      free (%s);\n" n
         ) (snd style)
@@ -7232,7 +7296,7 @@ and generate_perl_prototype name style =
       if !comma then pr ", ";
       comma := true;
       match arg with
-      | Pathname n | Device n | String n
+      | Pathname n | Device n | Dev_or_Path n | String n
       | OptString n | Bool n | Int n | FileIn n | FileOut n ->
           pr "$%s" n
       | StringList n ->
@@ -7381,6 +7445,21 @@ py_guestfs_close (PyObject *self, PyObject *args)
 
 ";
 
+  let emit_put_list_function typ =
+    pr "static PyObject *\n";
+    pr "put_%s_list (struct guestfs_%s_list *%ss)\n" typ typ typ;
+    pr "{\n";
+    pr "  PyObject *list;\n";
+    pr "  int i;\n";
+    pr "\n";
+    pr "  list = PyList_New (%ss->len);\n" typ;
+    pr "  for (i = 0; i < %ss->len; ++i)\n" typ;
+    pr "    PyList_SetItem (list, i, put_%s (&%ss->val[i]));\n" typ typ;
+    pr "  return list;\n";
+    pr "};\n";
+    pr "\n"
+  in
+
   (* Structures, turned into Python dictionaries. *)
   List.iter (
     fun (typ, cols) ->
@@ -7437,20 +7516,17 @@ py_guestfs_close (PyObject *self, PyObject *args)
       pr "};\n";
       pr "\n";
 
-      pr "static PyObject *\n";
-      pr "put_%s_list (struct guestfs_%s_list *%ss)\n" typ typ typ;
-      pr "{\n";
-      pr "  PyObject *list;\n";
-      pr "  int i;\n";
-      pr "\n";
-      pr "  list = PyList_New (%ss->len);\n" typ;
-      pr "  for (i = 0; i < %ss->len; ++i)\n" typ;
-      pr "    PyList_SetItem (list, i, put_%s (&%ss->val[i]));\n" typ typ;
-      pr "  return list;\n";
-      pr "};\n";
-      pr "\n"
   ) structs;
 
+  (* Emit a put_TYPE_list function definition only if that function is used. *)
+  List.iter (
+    function
+    | typ, (RStructListOnly | RStructAndList) ->
+        (* generate the function for typ *)
+        emit_put_list_function typ
+    | typ, _ -> () (* empty *)
+  ) rstructs_used;
+
   (* Python wrapper functions. *)
   List.iter (
     fun (name, style, _, _, _, _, _) ->
@@ -7480,7 +7556,7 @@ py_guestfs_close (PyObject *self, PyObject *args)
 
       List.iter (
         function
-        | Pathname n | Device n | String n | FileIn n | FileOut n ->
+        | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n ->
             pr "  const char *%s;\n" n
         | OptString n -> pr "  const char *%s;\n" n
         | StringList n ->
@@ -7496,7 +7572,7 @@ py_guestfs_close (PyObject *self, PyObject *args)
       pr "  if (!PyArg_ParseTuple (args, (char *) \"O";
       List.iter (
         function
-        | Pathname _ | Device _ | String _ | FileIn _ | FileOut _ -> pr "s"
+        | Pathname _ | Device _ | Dev_or_Path _ | String _ | FileIn _ | FileOut _ -> pr "s"
         | OptString _ -> pr "z"
         | StringList _ -> pr "O"
         | Bool _ -> pr "i" (* XXX Python has booleans? *)
@@ -7506,7 +7582,7 @@ py_guestfs_close (PyObject *self, PyObject *args)
       pr "                         &py_g";
       List.iter (
         function
-        | Pathname n | Device n | String n | FileIn n | FileOut n -> pr ", &%s" n
+        | Pathname n | Device n | Dev_or_Path n | String n | FileIn n | FileOut n -> pr ", &%s" n
         | OptString n -> pr ", &%s" n
         | StringList n -> pr ", &py_%s" n
         | Bool n -> pr ", &%s" n
@@ -7519,7 +7595,7 @@ py_guestfs_close (PyObject *self, PyObject *args)
       pr "  g = get_handle (py_g);\n";
       List.iter (
         function
-        | Pathname _ | Device _ | String _
+        | Pathname _ | Device _ | Dev_or_Path _ | String _
         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
         | StringList n ->
             pr "  %s = get_string_list (py_%s);\n" n n;
@@ -7534,7 +7610,7 @@ py_guestfs_close (PyObject *self, PyObject *args)
 
       List.iter (
         function
-        | Pathname _ | Device _ | String _
+        | Pathname _ | Device _ | Dev_or_Path _ | String _
         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
         | StringList n ->
             pr "  free (%s);\n" n
@@ -7843,7 +7919,7 @@ static VALUE ruby_guestfs_close (VALUE gv)
 
       List.iter (
         function
-        | Pathname n | Device n | String n | FileIn n | FileOut n ->
+        | Pathname n | Device n | Dev_or_Path n | 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;
@@ -7895,7 +7971,7 @@ static VALUE ruby_guestfs_close (VALUE gv)
 
       List.iter (
         function
-        | Pathname _ | Device _ | String _
+        | Pathname _ | Device _ | Dev_or_Path _ | String _
         | FileIn _ | FileOut _ | OptString _ | Bool _ | Int _ -> ()
         | StringList n ->
             pr "  free (%s);\n" n
@@ -8207,7 +8283,7 @@ and generate_java_prototype ?(public=false) ?(privat=false) ?(native=false)
 
       match arg with
       | Pathname n
-      | Device n
+      | Device n | Dev_or_Path n
       | String n
       | OptString n
       | FileIn n
@@ -8326,7 +8402,7 @@ Java_com_redhat_et_libguestfs_GuestFS__1close
       List.iter (
         function
         | Pathname n
-        | Device n
+        | Device n | Dev_or_Path n
         | String n
         | OptString n
         | FileIn n
@@ -8379,7 +8455,7 @@ Java_com_redhat_et_libguestfs_GuestFS__1close
       List.iter (
         function
         | Pathname n
-        | Device n
+        | Device n | Dev_or_Path n
         | String n
         | OptString n
         | FileIn n
@@ -8409,7 +8485,7 @@ Java_com_redhat_et_libguestfs_GuestFS__1close
       List.iter (
         function
         | Pathname n
-        | Device n
+        | Device n | Dev_or_Path n
         | String n
         | FileIn n
         | FileOut n ->
@@ -8442,7 +8518,7 @@ Java_com_redhat_et_libguestfs_GuestFS__1close
       List.iter (
         function
         | Pathname n
-        | Device n
+        | Device n | Dev_or_Path n
         | String n
         | FileIn n
         | FileOut n ->
@@ -8717,7 +8793,7 @@ last_error h = do
           function
           | FileIn n
           | FileOut n
-          | Pathname n | Device n | String n -> pr "withCString %s $ \\%s -> " n n
+          | Pathname n | Device n | Dev_or_Path 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 _ | Int _ -> ()
@@ -8729,7 +8805,7 @@ last_error h = do
             | Bool n -> sprintf "(fromBool %s)" n
             | Int n -> sprintf "(fromIntegral %s)" n
             | FileIn n | FileOut n
-            | Pathname n | Device n | String n | OptString n | StringList n -> n
+            | Pathname n | Device n | Dev_or_Path n | String n | OptString n | StringList n -> n
           ) (snd style) in
         pr "withForeignPtr h (\\p -> c_%s %s)\n" name
           (String.concat " " ("p" :: args));
@@ -8779,7 +8855,7 @@ and generate_haskell_prototype ~handle ?(hs = false) style =
   List.iter (
     fun arg ->
       (match arg with
-       | Pathname _ | Device _ | String _ -> pr "%s" string
+       | Pathname _ | Device _ | Dev_or_Path _ | String _ -> pr "%s" string
        | OptString _ -> if hs then pr "Maybe String" else pr "CString"
        | StringList _ -> if hs then pr "[String]" else pr "Ptr CString"
        | Bool _ -> pr "%s" bool
@@ -8855,7 +8931,7 @@ print_strings (char * const* const argv)
     List.iter (
       function
       | Pathname n
-      | Device n
+      | Device n | Dev_or_Path n
       | String n
       | FileIn n
       | FileOut n -> pr "  printf (\"%%s\\n\", %s);\n" n