X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=src%2Fgenerator.ml;h=3a25c5707ec9eb10c4b5797130440d694a69545b;hb=29842da1379ece83eae98ee786b475ae161f1687;hp=b8add4c0362244316a8628e6aafe16992bdbf162;hpb=2eb19f526164a978c373a760deb30854d56b62ce;p=libguestfs.git diff --git a/src/generator.ml b/src/generator.ml old mode 100755 new mode 100644 index b8add4c..3a25c57 --- a/src/generator.ml +++ b/src/generator.ml @@ -835,6 +835,32 @@ The default is disabled."); "\ Return the direct appliance mode flag."); + ("set_recovery_proc", (RErr, [Bool "recoveryproc"]), -1, [FishAlias "recovery-proc"], + [InitNone, Always, TestOutputTrue ( + [["set_recovery_proc"; "true"]; + ["get_recovery_proc"]])], + "enable or disable the recovery process", + "\ +If this is called with the parameter C then +C does not create a recovery process. The +purpose of the recovery process is to stop runaway qemu +processes in the case where the main program aborts abruptly. + +This only has any effect if called before C, +and the default is true. + +About the only time when you would want to disable this is +if the main process will fork itself into the background +(\"daemonize\" itself). In this case the recovery process +thinks that the main program has disappeared and so kills +qemu, which is not very helpful."); + + ("get_recovery_proc", (RBool "recoveryproc", []), -1, [], + [], + "get recovery process enabled flag", + "\ +Return the recovery process enabled flag."); + ] (* daemon_functions are any functions which cause some action @@ -3783,6 +3809,90 @@ Only numeric uid and gid are supported. If you want to use names, you will need to locate and parse the password file yourself (Augeas support makes this relatively easy)."); + ("lstatlist", (RStructList ("statbufs", "stat"), [Pathname "path"; StringList "names"]), 204, [], + [], (* XXX *) + "lstat on multiple files", + "\ +This call allows you to perform the C operation +on multiple files, where all files are in the directory C. +C is the list of files from this directory. + +On return you get a list of stat structs, with a one-to-one +correspondence to the C list. If any name did not exist +or could not be lstat'd, then the C field of that structure +is set to C<-1>. + +This call is intended for programs that want to efficiently +list a directory contents without making many round-trips. +See also C for a similarly efficient call +for getting extended attributes. Very long directory listings +might cause the protocol message size to be exceeded, causing +this call to fail. The caller must split up such requests +into smaller groups of names."); + + ("lxattrlist", (RStructList ("xattrs", "xattr"), [Pathname "path"; StringList "names"]), 205, [], + [], (* XXX *) + "lgetxattr on multiple files", + "\ +This call allows you to get the extended attributes +of multiple files, where all files are in the directory C. +C is the list of files from this directory. + +On return you get a flat list of xattr structs which must be +interpreted sequentially. The first xattr struct always has a zero-length +C. C in this struct is zero-length +to indicate there was an error doing C for this +file, I is a C string which is a decimal number +(the number of following attributes for this file, which could +be C<\"0\">). Then after the first xattr struct are the +zero or more attributes for the first named file. +This repeats for the second and subsequent files. + +This call is intended for programs that want to efficiently +list a directory contents without making many round-trips. +See also C for a similarly efficient call +for getting standard stats. Very long directory listings +might cause the protocol message size to be exceeded, causing +this call to fail. The caller must split up such requests +into smaller groups of names."); + + ("readlinklist", (RStringList "links", [Pathname "path"; StringList "names"]), 206, [], + [], (* XXX *) + "readlink on multiple files", + "\ +This call allows you to do a C operation +on multiple files, where all files are in the directory C. +C is the list of files from this directory. + +On return you get a list of strings, with a one-to-one +correspondence to the C list. Each string is the +value of the symbol link. + +If the C operation fails on any name, then +the corresponding result string is the empty string C<\"\">. +However the whole operation is completed even if there +were C errors, and so you can call this +function with names where you don't know if they are +symbolic links already (albeit slightly less efficient). + +This call is intended for programs that want to efficiently +list a directory contents without making many round-trips. +Very long directory listings might cause the protocol +message size to be exceeded, causing +this call to fail. The caller must split up such requests +into smaller groups of names."); + + ("pread", (RBufferOut "content", [Pathname "path"; Int "count"; Int64 "offset"]), 207, [ProtocolLimitWarning], + [InitISOFS, Always, TestOutputBuffer ( + [["pread"; "/known-4"; "1"; "3"]], "\n")], + "read part of a file", + "\ +This command lets you read part of a file. It reads C +bytes of the file, starting at C, from file C. + +This may read fewer bytes than requested. For further details +see the L system call."); + ] let all_functions = non_daemon_functions @ daemon_functions @@ -4578,7 +4688,7 @@ and generate_xdr () = List.iter ( function | Pathname n | Device n | Dev_or_Path n | String n -> - pr " string %s<>;\n" n + pr " string %s<>;\n" n | OptString n -> pr " str *%s;\n" n | StringList n | DeviceList n -> pr " str %s<>;\n" n | Bool n -> pr " bool %s;\n" n @@ -6320,11 +6430,11 @@ and generate_fish_cmds () = else "" in pr " if ("; - pr "strcasecmp (cmd, \"%s\") == 0" name; + pr "STRCASEEQ (cmd, \"%s\")" name; if name <> name2 then - pr " || strcasecmp (cmd, \"%s\") == 0" name2; + pr " || STRCASEEQ (cmd, \"%s\")" name2; if name <> alias then - pr " || strcasecmp (cmd, \"%s\") == 0" alias; + pr " || STRCASEEQ (cmd, \"%s\")" alias; pr ")\n"; pr " pod2text (\"%s\", _(\"%s\"), %S);\n" name2 shortdesc @@ -6471,11 +6581,11 @@ and generate_fish_cmds () = function | Device name | String name -> - pr " %s = argv[%d];\n" name i + pr " %s = argv[%d];\n" name i | Pathname name | Dev_or_Path name -> - pr " %s = resolve_win_path (argv[%d]);\n" name i; - pr " if (%s == NULL) return -1;\n" name + pr " %s = resolve_win_path (argv[%d]);\n" name i; + pr " if (%s == NULL) return -1;\n" name | OptString name -> pr " %s = strcmp (argv[%d], \"\") != 0 ? argv[%d] : NULL;\n" name i i @@ -6582,11 +6692,11 @@ and generate_fish_cmds () = try find_map (function FishAlias n -> Some n | _ -> None) flags with Not_found -> name in pr " if ("; - pr "strcasecmp (cmd, \"%s\") == 0" name; + pr "STRCASEEQ (cmd, \"%s\")" name; if name <> name2 then - pr " || strcasecmp (cmd, \"%s\") == 0" name2; + pr " || STRCASEEQ (cmd, \"%s\")" name2; if name <> alias then - pr " || strcasecmp (cmd, \"%s\") == 0" alias; + pr " || STRCASEEQ (cmd, \"%s\")" alias; pr ")\n"; pr " return run_%s (cmd, argc, argv);\n" name; pr " else\n"; @@ -6853,12 +6963,21 @@ type t exception Error of string (** This exception is raised when there is an error. *) +exception Handle_closed of string +(** This exception is raised if you use a {!Guestfs.t} handle + after calling {!close} on it. The string is the name of + the function. *) + val create : unit -> t +(** Create a {!Guestfs.t} handle. *) 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. *) +(** Close the {!Guestfs.t} handle and free up all resources used + by it immediately. + + Handles are closed by the garbage collector when they become + unreferenced, but callers can call this in order to provide + predictable cleanup. *) "; generate_ocaml_structure_decls (); @@ -6869,7 +6988,7 @@ val close : t -> unit generate_ocaml_prototype name style; pr "(** %s *)\n" shortdesc; pr "\n" - ) all_functions + ) all_functions_sorted (* Generate the OCaml bindings implementation. *) and generate_ocaml_ml () = @@ -6877,12 +6996,17 @@ and generate_ocaml_ml () = pr "\ type t + exception Error of string +exception Handle_closed of string + external create : unit -> t = \"ocaml_guestfs_create\" external close : t -> unit = \"ocaml_guestfs_close\" +(* Give the exceptions names, so they can be raised from the C code. *) let () = - Callback.register_exception \"ocaml_guestfs_error\" (Error \"\") + Callback.register_exception \"ocaml_guestfs_error\" (Error \"\"); + Callback.register_exception \"ocaml_guestfs_closed\" (Handle_closed \"\") "; @@ -6892,7 +7016,7 @@ let () = List.iter ( fun (name, style, _, _, _, shortdesc, _) -> generate_ocaml_prototype ~is_external:true name style; - ) all_functions + ) all_functions_sorted (* Generate the OCaml bindings C implementation. *) and generate_ocaml_c () = @@ -7028,6 +7152,12 @@ copy_table (char * const * argv) (* The wrappers. *) List.iter ( fun (name, style, _, _, _, _, _) -> + pr "/* Automatically generated wrapper for function\n"; + pr " * "; + generate_ocaml_prototype name style; + pr " */\n"; + pr "\n"; + let params = "gv" :: List.map (fun arg -> name_of_argt arg ^ "v") (snd style) in @@ -7037,6 +7167,7 @@ copy_table (char * const * argv) pr "/* Emit prototype to appease gcc's -Wmissing-prototypes. */\n"; pr "CAMLprim value ocaml_guestfs_%s (value %s" name (List.hd params); List.iter (pr ", value %s") (List.tl params); pr ");\n"; + pr "\n"; pr "CAMLprim value\n"; pr "ocaml_guestfs_%s (value %s" name (List.hd params); @@ -7062,7 +7193,7 @@ copy_table (char * const * argv) 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 " ocaml_guestfs_raise_closed (\"%s\");\n" name; pr "\n"; List.iter ( @@ -7124,7 +7255,7 @@ copy_table (char * const * argv) | StringList n | DeviceList n -> pr " ocaml_guestfs_free_strings (%s);\n" n; | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _ - | Bool _ | Int _ | Int64 _ + | Bool _ | Int _ | Int64 _ | FileIn _ | FileOut _ -> () ) (snd style); @@ -7186,7 +7317,7 @@ copy_table (char * const * argv) pr "}\n"; pr "\n" ) - ) all_functions + ) all_functions_sorted and generate_ocaml_structure_decls () = List.iter ( @@ -7375,7 +7506,7 @@ DESTROY (g) List.iter ( function | Pathname _ | Device _ | Dev_or_Path _ | String _ | OptString _ - | Bool _ | Int _ | Int64 _ + | Bool _ | Int _ | Int64 _ | FileIn _ | FileOut _ -> () | StringList n | DeviceList n -> pr " free (%s);\n" n ) (snd style) @@ -8029,8 +8160,8 @@ py_guestfs_close (PyObject *self, PyObject *args) | Bool _ -> pr "i" (* XXX Python has booleans? *) | Int _ -> pr "i" | Int64 _ -> pr "L" (* XXX Whoever thought it was a good idea to - * emulate C's int/long/long long in Python? - *) + * emulate C's int/long/long long in Python? + *) ) (snd style); pr ":guestfs_%s\",\n" name; pr " &py_g"; @@ -8998,7 +9129,7 @@ Java_com_redhat_et_libguestfs_GuestFS__1close pr " free (%s);\n" n | Bool n | Int n - | Int64 n -> () + | Int64 n -> () ) (snd style); (* Check for errors. *) @@ -9186,6 +9317,12 @@ module Guestfs ( pr " ) where + +-- Unfortunately some symbols duplicate ones already present +-- in Prelude. We don't know which, so we hard-code a list +-- here. +import Prelude hiding (truncate) + import Foreign import Foreign.C import Foreign.C.Types