#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
C<$major.$minor.$release$extra>
I<Note:> Don't use this call to test for availability
-of features. Distro backports makes this unreliable.");
+of features. Distro backports makes this unreliable. Use
+C<guestfs_available> instead.");
("set_selinux", (RErr, [Bool "selinux"]), -1, [FishAlias "selinux"],
[InitNone, Always, TestOutputTrue (
To fill a file with zero bytes (sparsely), it is
much more efficient to use C<guestfs_truncate_size>.");
+ ("available", (RErr, [StringList "groups"]), 216, [],
+ [],
+ "test availability of some parts of the API",
+ "\
+This command is used to check the availability of some
+groups of libguestfs functions which not all builds of
+libguestfs will be able to provide.
+
+The precise libguestfs function groups that may be checked by this
+command are listed in L<guestfs(3)/AVAILABILITY>.
+
+The argument C<groups> is a list of API group names, eg:
+C<[\"inotify\", \"part\"]> would check for the availability of
+the C<guestfs_inotify_*> functions and C<guestfs_part_*>
+(partition editing) functions.
+
+The command returns no error if I<all> requested groups are available.
+
+It returns an error if one or more of the requested
+groups is unavailable.
+
+If an unknown group name is included in the
+list of C<groups> then an error is always returned.
+
+I<Notes:>
+
+=over 4
+
+=item *
+
+You must call C<guestfs_launch> before calling this function.
+The reason is because we don't know what function groups are
+supported by the appliance/daemon until it is running and can
+be queried.
+
+=item *
+
+If a group of functions is available, this does not necessarily
+mean that they will work. You still have to check for errors
+when calling individual API functions even if they are
+available.
+
+=item *
+
+It is usually the job of distro packagers to build
+complete functionality into the libguestfs appliance.
+Upstream libguestfs, if built from source with all
+requirements satisfied, will support everything.
+
+=item *
+
+This call was added in version C<1.0.80>. In previous
+versions of libguestfs all you could do would be to speculatively
+execute a command to find out if the daemon implemented it.
+See also C<guestfs_version>.
+
+=back");
+
]
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. *)
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) =
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;
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.Unix_error (err, _, _) ->
- eprintf "%s: %s\n" msg (Unix.error_message err)
+ | Unix_error (err, _, _) ->
+ eprintf "%s: %s\n" msg (error_message err)
| exn ->
eprintf "%s: %s\n" msg (Printexc.to_string exn)
(* Main program. *)
let () =
let lock_fd =
- try Unix.openfile "HACKING" [Unix.O_RDWR] 0
+ try openfile "HACKING" [O_RDWR] 0
with
- | Unix.Unix_error (Unix.ENOENT, _, _) ->
+ | Unix_error (ENOENT, _, _) ->
eprintf "\
You are probably running this from the wrong directory.
Run it from the top source directory using the command
* one to finish. Note the lock is released implicitly when the
* program exits.
*)
- (try Unix.lockf lock_fd Unix.F_LOCK 1
+ (try lockf lock_fd F_LOCK 1
with exn ->
perror "lock: HACKING" exn;
exit 1);
git.annexia.org / libguestfs.git / blobdiff