#load "unix.cma";;
#load "str.cma";;
+open Unix
open Printf
type style = ret * args
(* Generate a random UUID (used in tests). *)
let uuidgen () =
- let chan = Unix.open_process_in "uuidgen" in
+ let chan = open_process_in "uuidgen" in
let uuid = input_line chan in
- (match Unix.close_process_in chan with
- | Unix.WEXITED 0 -> ()
- | Unix.WEXITED _ ->
+ (match close_process_in chan with
+ | WEXITED 0 -> ()
+ | WEXITED _ ->
failwith "uuidgen: process exited with non-zero status"
- | Unix.WSIGNALED _ | Unix.WSTOPPED _ ->
+ | WSIGNALED _ | WSTOPPED _ ->
failwith "uuidgen: process signalled or stopped by signal"
);
uuid
("pread", (RBufferOut "content", [Pathname "path"; Int "count"; Int64 "offset"]), 207, [ProtocolLimitWarning],
[InitISOFS, Always, TestOutputBuffer (
- [["pread"; "/known-4"; "1"; "3"]], "\n")],
+ [["pread"; "/known-4"; "1"; "3"]], "\n");
+ InitISOFS, Always, TestOutputBuffer (
+ [["pread"; "/empty"; "0"; "100"]], "")],
"read part of a file",
"\
This command lets you read part of a file. It reads C<count>
values are possible, although unusual. See C<guestfs_part_init>
for a full list.");
+ ("fill", (RErr, [Int "c"; Int "len"; Pathname "path"]), 215, [],
+ [InitBasicFS, Always, TestOutputBuffer (
+ [["fill"; "0x63"; "10"; "/test"];
+ ["read_file"; "/test"]], "cccccccccc")],
+ "fill a file with octets",
+ "\
+This command creates a new file called C<path>. The initial
+content of the file is C<len> octets of C<c>, where C<c>
+must be a number in the range C<[0..255]>.
+
+To fill a file with zero bytes (sparsely), it is
+much more efficient to use C<guestfs_truncate_size>.");
+
]
let all_functions = non_daemon_functions @ daemon_functions
) all_functions
(* 'pr' prints to the current output file. *)
-let chan = ref stdout
+let chan = ref Pervasives.stdout
let pr fs = ksprintf (output_string !chan) fs
(* Generate a header block in a number of standard styles. *)
#include <inttypes.h>
#include \"guestfs.h\"
+#include \"guestfs-internal.h\"
#include \"guestfs-internal-actions.h\"
#include \"guestfs_protocol.h\"
#define error guestfs_error
//#define perrorf guestfs_perrorf
-//#define safe_malloc guestfs_safe_malloc
+#define safe_malloc guestfs_safe_malloc
#define safe_realloc guestfs_safe_realloc
//#define safe_strdup guestfs_safe_strdup
#define safe_memdup guestfs_safe_memdup
pr " /* caller will free this */\n";
pr " return safe_memdup (g, &ret.%s, sizeof (ret.%s));\n" n n
| RBufferOut n ->
- pr " *size_r = ret.%s.%s_len;\n" n n;
- pr " return ret.%s.%s_val; /* caller will free */\n" n n
+ pr " /* RBufferOut is tricky: If the buffer is zero-length, then\n";
+ pr " * _val might be NULL here. To make the API saner for\n";
+ pr " * callers, we turn this case into a unique pointer (using\n";
+ pr " * malloc(1)).\n";
+ pr " */\n";
+ pr " if (ret.%s.%s_len > 0) {\n" n n;
+ pr " *size_r = ret.%s.%s_len;\n" n n;
+ pr " return ret.%s.%s_val; /* caller will free */\n" n n;
+ pr " } else {\n";
+ pr " free (ret.%s.%s_val);\n" n n;
+ pr " char *p = safe_malloc (g, 1);\n";
+ pr " *size_r = ret.%s.%s_len;\n" n n;
+ pr " return p;\n";
+ pr " }\n";
);
pr "}\n\n"
| RStruct (_, typ) -> pr " guestfs_int_%s *r;\n" typ; "NULL"
| RStructList (_, typ) -> pr " guestfs_int_%s_list *r;\n" typ; "NULL"
| RBufferOut _ ->
- pr " size_t size;\n";
+ pr " size_t size = 1;\n";
pr " char *r;\n";
"NULL" in
generate_c_call_args (fst style, args');
pr ";\n";
- pr " if (r == %s)\n" error_code;
- pr " /* do_%s has already called reply_with_error */\n" name;
- pr " goto done;\n";
- pr "\n";
+ (match fst style with
+ | RErr | RInt _ | RInt64 _ | RBool _
+ | RConstString _ | RConstOptString _
+ | RString _ | RStringList _ | RHashtable _
+ | RStruct (_, _) | RStructList (_, _) ->
+ pr " if (r == %s)\n" error_code;
+ pr " /* do_%s has already called reply_with_error */\n" name;
+ pr " goto done;\n";
+ pr "\n"
+ | RBufferOut _ ->
+ pr " /* size == 0 && r == NULL could be a non-error case (just\n";
+ pr " * an ordinary zero-length buffer), so be careful ...\n";
+ pr " */\n";
+ pr " if (size == 1 && r == %s)\n" error_code;
+ pr " /* do_%s has already called reply_with_error */\n" name;
+ pr " goto done;\n";
+ pr "\n"
+ );
(* If there are any FileOut parameters, then the impl must
* send its own reply.
#include <fcntl.h>
#include \"guestfs.h\"
+#include \"guestfs-internal.h\"
static guestfs_h *g;
static int suppress_error = 0;
g = guestfs_create ();
if (g == NULL) {
printf (\"guestfs_create FAILED\\n\");
- exit (1);
+ exit (EXIT_FAILURE);
}
guestfs_set_error_handler (g, print_error, NULL);
fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
if (fd == -1) {
perror (filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (lseek (fd, %d, SEEK_SET) == -1) {
perror (\"lseek\");
close (fd);
unlink (filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (write (fd, &c, 1) == -1) {
perror (\"write\");
close (fd);
unlink (filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (close (fd) == -1) {
perror (filename);
unlink (filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (guestfs_add_drive (g, filename) == -1) {
printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
filename = \"test2.img\";
fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
if (fd == -1) {
perror (filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (lseek (fd, %d, SEEK_SET) == -1) {
perror (\"lseek\");
close (fd);
unlink (filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (write (fd, &c, 1) == -1) {
perror (\"write\");
close (fd);
unlink (filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (close (fd) == -1) {
perror (filename);
unlink (filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (guestfs_add_drive (g, filename) == -1) {
printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
filename = \"test3.img\";
fd = open (filename, O_WRONLY|O_CREAT|O_NOCTTY|O_NONBLOCK|O_TRUNC, 0666);
if (fd == -1) {
perror (filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (lseek (fd, %d, SEEK_SET) == -1) {
perror (\"lseek\");
close (fd);
unlink (filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (write (fd, &c, 1) == -1) {
perror (\"write\");
close (fd);
unlink (filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (close (fd) == -1) {
perror (filename);
unlink (filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (guestfs_add_drive (g, filename) == -1) {
printf (\"guestfs_add_drive %%s FAILED\\n\", filename);
- exit (1);
+ exit (EXIT_FAILURE);
}
if (guestfs_add_drive_ro (g, \"../images/test.iso\") == -1) {
printf (\"guestfs_add_drive_ro ../images/test.iso FAILED\\n\");
- exit (1);
+ exit (EXIT_FAILURE);
}
if (guestfs_launch (g) == -1) {
printf (\"guestfs_launch FAILED\\n\");
- exit (1);
+ exit (EXIT_FAILURE);
}
/* Set a timeout in case qemu hangs during launch (RHBZ#505329). */
pr " if (n_failed > 0) {\n";
pr " printf (\"***** %%lu / %%d tests FAILED *****\\n\", n_failed, nr_tests);\n";
- pr " exit (1);\n";
+ pr " exit (EXIT_FAILURE);\n";
pr " }\n";
pr "\n";
- pr " exit (0);\n";
+ pr " exit (EXIT_SUCCESS);\n";
pr "}\n"
and generate_one_test name i (init, prereq, test) =
match snd style with
| [] -> name2
| args ->
- sprintf "%s <%s>"
- name2 (String.concat "> <" (List.map name_of_argt args)) in
+ sprintf "%s %s"
+ name2 (String.concat " " (List.map name_of_argt args)) in
let warnings =
if List.mem ProtocolLimitWarning flags then
pr ")\n";
pr " pod2text (\"%s\", _(\"%s\"), %S);\n"
name2 shortdesc
- (" " ^ synopsis ^ "\n\n" ^ longdesc ^ warnings ^ describe_alias);
+ ("=head1 SYNOPSIS\n\n " ^ synopsis ^ "\n\n" ^
+ "=head1 DESCRIPTION\n\n" ^
+ longdesc ^ warnings ^ describe_alias);
pr " else\n"
) all_functions;
pr " display_builtin_command (cmd);\n";
fprintf chan "=head1 %s\n\n%s\n" name longdesc;
close_out chan;
let cmd = sprintf "pod2text -w %d %s" width (Filename.quote filename) in
- let chan = Unix.open_process_in cmd in
+ let chan = open_process_in cmd in
let lines = ref [] in
let rec loop i =
let line = input_line chan in
loop (i+1)
) in
let lines = try loop 1 with End_of_file -> List.rev !lines in
- Unix.unlink filename;
- (match Unix.close_process_in chan with
- | Unix.WEXITED 0 -> ()
- | Unix.WEXITED i ->
+ unlink filename;
+ (match close_process_in chan with
+ | WEXITED 0 -> ()
+ | WEXITED i ->
failwithf "pod2text: process exited with non-zero status (%d)" i
- | Unix.WSIGNALED i | Unix.WSTOPPED i ->
+ | WSIGNALED i | WSTOPPED i ->
failwithf "pod2text: process signalled or stopped by signal %d" i
);
Hashtbl.add pod2text_memo key lines;
#include <string.h>
#include \"guestfs.h\"
+#include \"guestfs-internal.h\"
#include \"guestfs-internal-actions.h\"
#include \"guestfs_protocol.h\"
chan := open_out filename_new;
let close () =
close_out !chan;
- chan := stdout;
+ chan := Pervasives.stdout;
(* Is the new file different from the current file? *)
if Sys.file_exists filename && files_equal filename filename_new then
- Unix.unlink filename_new (* same, so skip it *)
+ unlink filename_new (* same, so skip it *)
else (
(* different, overwrite old one *)
- (try Unix.chmod filename 0o644 with Unix.Unix_error _ -> ());
- Unix.rename filename_new filename;
- Unix.chmod filename 0o444;
+ (try chmod filename 0o644 with Unix_error _ -> ());
+ rename filename_new filename;
+ chmod filename 0o444;
printf "written %s\n%!" filename;
)
in
close
+let perror msg = function
+ | Unix_error (err, _, _) ->
+ eprintf "%s: %s\n" msg (error_message err)
+ | exn ->
+ eprintf "%s: %s\n" msg (Printexc.to_string exn)
+
(* Main program. *)
let () =
- check_functions ();
-
- if not (Sys.file_exists "HACKING") then (
- eprintf "\
+ let lock_fd =
+ try openfile "HACKING" [O_RDWR] 0
+ with
+ | Unix_error (ENOENT, _, _) ->
+ eprintf "\
You are probably running this from the wrong directory.
Run it from the top source directory using the command
src/generator.ml
";
- exit 1
- );
+ exit 1
+ | exn ->
+ perror "open: HACKING" exn;
+ exit 1 in
+
+ (* Acquire a lock so parallel builds won't try to run the generator
+ * twice at the same time. Subsequent builds will wait for the first
+ * one to finish. Note the lock is released implicitly when the
+ * program exits.
+ *)
+ (try lockf lock_fd F_LOCK 1
+ with exn ->
+ perror "lock: HACKING" exn;
+ exit 1);
+
+ check_functions ();
let close = output_to "src/guestfs_protocol.x" in
generate_xdr ();