7:44 a.m.
Hi, I tried to rewrite virt-rescue from C to OCaml.
Goals were feature parity with C implementation, smaller codebase and
hopefully better maintainability. I still don't know if I've covered
everything right. So, please check it out.
PS: my git send-email seems to be broken, so I'm sending it from thunderbird
Thanks!
maros
9:31 a.m.
On Friday, 19 August 2016 14:44:44 CEST Maros Zatko wrote:
Hi, I tried to rewrite virt-rescue from C to OCaml.
Goals were feature parity with C implementation, smaller codebase and
hopefully better maintainability. I still don't know if I've covered
everything right. So, please check it out.
A first review follows; most probably I'm missing more stuff, but at
least we can start improving this first version.
Also, we should decide whether it's ok for this tool to be considered
optional, since OCaml is not a mandatory dependency for libguestfs:
currently it's always built (since it's in C), but it will not be when
OCaml is not available/used. Not a problem on my side, but needs to be
said clearly :)
Makefile.am | 3 +-
docs/C_SOURCE_FILES | 2 +-
rescue/Makefile.am | 147 +++++++++-----
rescue/dummy.c | 2 +
rescue/rescue.c | 527 -------------------------------------------------
rescue/rescue.ml | 226 +++++++++++++++++++++
rescue/virt-rescue.pod | 17 ++
7 files changed, 344 insertions(+), 580 deletions(-)
create mode 100644 rescue/dummy.c
delete mode 100644 rescue/rescue.c
create mode 100644 rescue/rescue.ml
Most probably there should be changes in po/POTFILES and po/POTFILES-ml,
so make sure to include them too in the patch.
diff --git a/Makefile.am b/Makefile.am
index 4b5babb..d39884c 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -94,7 +94,7 @@ SUBDIRS += test-tool
SUBDIRS += fish
# virt-tools in C.
-SUBDIRS += align cat diff df edit format inspector make-fs rescue
+SUBDIRS += align cat diff df edit format inspector make-fs
if HAVE_P2V
SUBDIRS += p2v
endif
@@ -150,6 +150,7 @@ SUBDIRS += \
dib \
get-kernel \
resize \
+ rescue \
sparsify \
sysprep \
v2v
diff --git a/docs/C_SOURCE_FILES b/docs/C_SOURCE_FILES
index 3db4db3..4d961bf 100644
--- a/docs/C_SOURCE_FILES
+++ b/docs/C_SOURCE_FILES
@@ -205,7 +205,7 @@ p2v/whole-file.c
php/extension/guestfs_php.c
python/guestfs-py-byhand.c
python/guestfs-py.c
-rescue/rescue.c
+rescue/dummy.c
resize/dummy.c
ruby/ext/guestfs/_guestfs.c
sparsify/dummy.c
diff --git a/rescue/Makefile.am b/rescue/Makefile.am
index 1568730..e377cbf 100644
--- a/rescue/Makefile.am
+++ b/rescue/Makefile.am
@@ -1,5 +1,5 @@
-# libguestfs virt-rescue
-# Copyright (C) 2010-2016 Red Hat Inc.
+# libguestfs virt-rescue tool
+# Copyright (C) 2015 Red Hat Inc.
Unneeded change.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
@@ -18,55 +18,92 @@
include $(top_srcdir)/subdir-rules.mk
EXTRA_DIST = \
- test-virt-rescue.pl \
This file seems lost here.
+ $(SOURCES_MLI) $(SOURCES_ML) $(SOURCES_C) \
test-virt-rescue-docs.sh \
- test-virt-rescue-suggest.sh \
Ditto.
- virt-rescue.pod
+ virt-rescue.pod
Indentation change.
-CLEANFILES = \
- stamp-virt-rescue.pod \
- virt-rescue.1
+CLEANFILES = *~ *.annot *.cmi *.cmo *.cmx *.cmxa *.o virt-rescue
-bin_PROGRAMS = virt-rescue
+SOURCES_MLI = \
+ rescue.mli
There is no rescue.mli in the patch (and most probably is not needed).
-SHARED_SOURCE_FILES = \
- ../fish/config.c \
- ../fish/domain.c \
- ../fish/inspect.c \
- ../fish/keys.c \
- ../fish/options.h \
- ../fish/options.c \
- ../fish/uri.h \
- ../fish/uri.c
+SOURCES_ML = \
+ rescue.ml
-virt_rescue_SOURCES = \
- $(SHARED_SOURCE_FILES) \
- rescue.c
+SOURCES_C = \
+ dummy.c
-virt_rescue_CPPFLAGS = \
- -DCOMPILING_VIRT_RESCUE=1 \
- -DGUESTFS_WARN_DEPRECATED=1 \
- -DLOCALEBASEDIR=\""$(datadir)/locale"\" \
- -I$(top_srcdir)/src -I$(top_builddir)/src \
- -I$(top_srcdir)/fish \
- -I$(srcdir)/../gnulib/lib -I../gnulib/lib
+bin_PROGRAMS =
+if HAVE_OCAML
+
+bin_PROGRAMS += virt-rescue
+
+virt_rescue_SOURCES = $(SOURCES_C)
+virt_rescue_CPPFLAGS = \
+ -I. \
+ -I$(top_builddir) \
+ -I$(top_srcdir)/gnulib/lib -I$(top_builddir)/gnulib/lib \
+ -I$(shell $(OCAMLC) -where) \
+ -I$(top_srcdir)/gnulib/lib \
+ -I$(top_srcdir)/src
virt_rescue_CFLAGS = \
- $(WARN_CFLAGS) $(WERROR_CFLAGS) \
- $(LIBCONFIG_CFLAGS) \
- $(LIBXML2_CFLAGS)
-
-virt_rescue_LDADD = \
- $(LIBCONFIG_LIBS) \
- $(top_builddir)/src/libutils.la \
- $(top_builddir)/src/libguestfs.la \
+ -pthread \
+ $(WARN_CFLAGS) $(WERROR_CFLAGS)
+
+BOBJECTS = \
+ $(SOURCES_ML:.ml=.cmo)
+XOBJECTS = $(BOBJECTS:.cmo=.cmx)
+
+# -I $(top_builddir)/src/.libs is a hack which forces corresponding -L
+# option to be passed to gcc, so we don't try linking against an
+# installed copy of libguestfs.
+OCAMLPACKAGES = \
+ -package str,unix \
+ -I $(top_builddir)/src/.libs \
+ -I $(top_builddir)/gnulib/lib/.libs \
+ -I $(top_builddir)/ocaml \
+ -I $(top_builddir)/mllib
+if HAVE_OCAML_PKG_GETTEXT
+OCAMLPACKAGES += -package gettext-stub
+endif
+
+OCAMLCLIBS = \
+ -pthread -lpthread \
+ -lutils \
$(LIBXML2_LIBS) \
- $(LIBVIRT_LIBS) \
- $(LTLIBINTL) \
- ../gnulib/lib/libgnu.la
+ $(LIBINTL) \
+ -lgnu
+
+OCAMLFLAGS = $(OCAML_FLAGS) $(OCAML_WARN_ERROR)
+
+if !HAVE_OCAMLOPT
+OBJECTS = $(BOBJECTS)
+else
+OBJECTS = $(XOBJECTS)
+endif
+
+OCAMLLINKFLAGS = mlguestfs.$(MLARCHIVE) mllib.$(MLARCHIVE) $(LINK_CUSTOM_OCAMLC_ONLY)
+
+virt_rescue_DEPENDENCIES = \
+ $(OBJECTS) \
+ ../mllib/mllib.$(MLARCHIVE) \
+ $(top_srcdir)/ocaml-link.sh
+virt_rescue_LINK = \
+ $(top_srcdir)/ocaml-link.sh -cclib '$(OCAMLCLIBS)' -- \
+ $(OCAMLFIND) $(BEST) $(OCAMLFLAGS) $(OCAMLPACKAGES) $(OCAMLLINKFLAGS) \
+ $(OBJECTS) -o $@
+
+# Tests.
+
+TESTS_ENVIRONMENT = $(top_builddir)/run --test
+
+TESTS = test-virt-rescue-docs.sh
test-virt-rescue.pl and test-virt-rescue-suggest.sh are missing
(see the lost "if ENABLE_APPLIANCE" block).
# Manual pages and HTML files for the website.
+
man_MANS = virt-rescue.1
+
noinst_DATA = $(top_builddir)/website/virt-rescue.1.html
virt-rescue.1 $(top_builddir)/website/virt-rescue.1.html: stamp-virt-rescue.pod
@@ -76,22 +113,30 @@ stamp-virt-rescue.pod: virt-rescue.pod
--man virt-rescue.1 \
--html $(top_builddir)/website/virt-rescue.1.html \
--license GPLv2+ \
- --warning ro-option \
+ --warning safe \
Unintended change.
$<
touch $@
-# Tests.
+CLEANFILES += \
+ stamp-virt-rescue.pod \
+ virt-rescue.1
-TESTS_ENVIRONMENT = $(top_builddir)/run --test
+# Dependencies.
+depend: .depend
+
+.depend: $(wildcard $(abs_srcdir)/*.mli) $(wildcard $(abs_srcdir)/*.ml)
+ rm -f $@ $@-t
+ $(OCAMLFIND) ocamldep -I ../ocaml -I $(abs_srcdir) -I $(abs_top_builddir)/mllib $^ | \
+ $(SED) 's/ *$$//' | \
+ $(SED) -e :a -e '/ *\\$$/N; s/ *\\\n */ /; ta' | \
+ $(SED) -e 's,$(abs_srcdir)/,$(builddir)/,g' | \
+ sort > $@-t
+ mv $@-t $@
+
+-include .depend
-TESTS = \
- test-virt-rescue-docs.sh
+endif
-if ENABLE_APPLIANCE
-TESTS += \
- test-virt-rescue.pl \
- test-virt-rescue-suggest.sh
-endif ENABLE_APPLIANCE
+DISTCLEANFILES = .depend
-check-valgrind:
- $(MAKE) TESTS="test-virt-rescue-suggest.sh" VG="$(top_builddir)/run
@VG@" check
+.PHONY: depend docs
diff --git a/rescue/dummy.c b/rescue/dummy.c
new file mode 100644
index 0000000..ebab619
--- /dev/null
+++ b/rescue/dummy.c
@@ -0,0 +1,2 @@
+/* Dummy source, to be used for OCaml-based tools with no C sources. */
+enum { foo = 1 };
diff --git a/rescue/rescue.c b/rescue/rescue.c
deleted file mode 100644
index 37b82f6..0000000
--- a/rescue/rescue.c
+++ /dev/null
@@ -1,527 +0,0 @@
[...]
diff --git a/rescue/rescue.ml b/rescue/rescue.ml
new file mode 100644
index 0000000..053627b
--- /dev/null
+++ b/rescue/rescue.ml
@@ -0,0 +1,226 @@
+(* virt-rescue
+ * Copyright (C) 2009-2016 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License along
+ * with this program; if not, write to the Free Software Foundation, Inc.,
+ * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
+ *)
+
+open Common_utils
+open Common_gettext.Gettext
+open Getopt.OptionName
+
+open Unix
Most probably there is no need to open Unix.
+open Printf
+
+module G = Guestfs
+
+let () = Random.self_init ()
Not a bad idea, but most probably not needed either, since rand & co
are not used in virt-rescue.
+
+let parse_args () =
+ let images = ref [] in
+ let append = ref "" in
+ let libvirturi = ref "" in
+ let domain = ref "" in
+ let format = ref "" in
+ let memsize = ref 0 in
+ let network = ref false in
+ let readonly = ref false in
+ let readwrite = ref false in
+ let scratch = ref 0 in
+ let selinux = ref false in
+ let smp = ref 1 in
+ let suggest = ref false in
+
+ let argspec = [
+ [S 'a'; L"add"], Getopt.String (s_"image ", (fun s ->
push_front s images)), s_"Add image";
+ [L"append"], Getopt.Set_string (s_"kernelopts", append),
s_"Append kernel options";
+ [S 'c'; L"connect"], Getopt.Set_string (s_"uri",
libvirturi), s_"Specify libvirt URI for -d option";
+ [S 'd'; L"domain"], Getopt.Set_string (s_"domain",
domain), s_"Add disks from libvirt guest";
+ [L"format"], Getopt.Set_string (s_"format", format),
s_"Force disk format for -a option";
+ [S 'm'; L"memsize"], Getopt.Set_int (s_"MB", memsize),
s_"Set memory size in megabytes";
+ [L"network"], Getopt.Set network, s_"Enable network";
+ [S 'r'; L"ro"], Getopt.Set readonly, s_"Access
read-only";
+ [L"scratch"], Getopt.Set_int (s_"N", scratch), s_"Add
scratch disks(s)";
+ [L"selinux"], Getopt.Set selinux, s_"For backwards compat only, does
nothing";
In your code it does something :) Make it really do nothing:
[L"selinux"], Getopt.Unit (fun () -> ()), s_"For backwards compat
only, does nothing";
+ [L"smp"], Getopt.Set_int (s_"N", smp),
s_"Set SMP CPU count";
+ [L"suggest"], Getopt.Set suggest, s_"Suggest mount commands for this
guest";
+ [S 'w'; L"rw"], Getopt.Set readwrite, s_"Mount
read-write"
+ ] in
+ let anon_fun x = () in
An empty function here does not do much -- the Getopt allow to specify
no anon_fun, and thus rejecting non-options parameters.
OTOH, virt-rescue supports disks as arguments (old syntax that predates
-a/--add), so the OCaml version must support them too.
+ let usage_msg =
+ sprintf (f_"\
+%s: Run a rescue shell on a virtual machine
+Copyright (C) 2009-2016 Red Hat Inc.
+Usage:\n") prog in
+ let opthandle = create_standard_options argspec ~anon_fun usage_msg in
+ Getopt.parse opthandle;
+
+ (* Dereference args *)
+ let images = !images in
+ let append = !append in
"append" here could become an option as well (like "libvirturi" the
line below this), so it can be passed later to set_append using "may".
+ let libvirturi = match !libvirturi with "" -> None |
s -> Some s in
+ let domain = !domain in
+ let format = match !format with "" -> None | str -> Some str in
+ let memsize = !memsize in
+ let network = !network in
+ let readonly = !readonly in
+ let readwrite = !readwrite in
+ let scratch = !scratch in
+ let selinux = !selinux in
+ let smp = !smp in
+ let suggest = !suggest in
I feel there's something missing here compared to what other tools do --
please check (and possibly use) the approach done e.g. in virt-customize
w.r.t. add/domain/libvirturi/memsize/network/smp/format.
+ if domain = "" && images = [] then
+ failwith "you must specify at least one -a or -d option.";
+
+ if readwrite && readonly then
+ failwith "cannot mix --ro and --rw options";
+
+ images, append, libvirturi, domain, format, memsize, network, readonly,
+ scratch, selinux, smp, suggest
Here a struct with all the options could be used, just like Rich did
few months ago in all the OCaml tools; even if virt-rescue is not that
big, it will help the readability a bit.
+
+let perform_rescue images append libvirturi domain format memsize network readonly
scratch
+ selinux smp suggest =
+ let g = open_guestfs () in
+ if not (domain = "") then (
if domain <> "" then
+ print_string ("domain: " ^ domain);
Extra debug?
+ ignore (g#add_domain ~readonly ?libvirturi domain)
+ ) else (
+ List.iter (g#add_drive ?format ~readonly) images
+ );
This code is basically the same also in perform_suggestion later on;
my suggestion would be to do this in main, before calling this function
or perform_suggestion.
+ g#set_direct true;
+
+ if selinux then
+ g#set_selinux selinux;
+ if smp > 1 then
+ g#set_smp smp;
+ if network then
+ g#set_network network;
+ if memsize > 0 then
+ g#set_memsize memsize;
+
+ for i = 0 to scratch do
+ g#add_drive_scratch 10737418240_L;
+ done;
+
+ (* Set backend to direct *)
+ if (String.is_prefix (g#get_backend ()) "libvirt") then (
+ g#set_backend "direct";
+
+ if not (String.is_prefix (g#get_backend ()) "direct") then (
+ let s = sprintf "Could not set direct backend. Got %s instead"
(g#get_backend ()) in
+ failwith s;
+ );
+ );
+
+ g#set_append (Some append);
+
+ (* We expect launch to fail so let's ignore error *)
+ try
+ g#launch ();
+ with (Guestfs.Error s) -> ();
No need for "s" (not used), so just "_".
+
+ g#shutdown ();
+ g#close ()
+
+let is_mountable (fs,_) = (not (fs = "swap")) && (not (fs =
"unknown"))
Boolean math: !A && !B == !(A || B)
Even better, you can use a match for this:
let is_mountable = function
| "swap" | "unknown" -> false
| _ -> true
+
+let suggestion_for_fs (p, t) =
+ printf "# %s has type '%s'\n" p t;
+ if is_mountable (p, t) then
+ printf "mount %s /sysroot\n" p;
+ print_newline ()
+
+let inspection_for_fs g p =
+ let os_type = g#inspect_get_type p in
+ let distro = g#inspect_get_distro p in
+ let product_name = g#inspect_get_product_name p in
+ let major = g#inspect_get_major_version p in
+ let minor = g#inspect_get_minor_version p in
+ let os_type = match os_type with
+ "" -> "unknown"
+ | _ -> os_type in
+ let distro = match distro with
+ "" -> "unknown"
+ | _ -> distro in
I don't think neither inspect_get_type nor inspect_get_distro will ever
return an empty string, that would be a bug ("unknown" is used when
nothing known is detected).
+ printf ("# %s is the root of a %s operating system\n
+# type: %s, distro: %s, version: %d.%d\n
+# %s\n\n") p os_type os_type distro major minor product_name;
+
+ let mps = g#inspect_get_mountpoints p in
+ if mps = [] then failwith "empty mountpoints"
failwith -> error (with translated message), so there is a clear error
message for the user.
+ else (
+ let mps = List.sort (fun (a,b) (c,d) -> compare (compare a c) (compare b d)) mps
in
+ List.iter (fun (m, p) -> printf "mount %s /sysroot%s\n" p m) mps;
+ );
+
+ if os_type = "linux" then (
+ printf ("mount --rbind /dev /sysroot/dev\n");
+ printf ("mount --rbind /proc /sysroot/proc\n");
+ printf ("mount --rbind /sys /sysroot/sys\n");
+ printf ("\n");
+ printf ("cd /sysroot\n");
+ printf ("chroot /sysroot\n");
printf doesn't need round brackets.
+ )
+
+let perform_suggestion images libvirturi domain format scratch =
+ let g = open_guestfs () in
+ if not (domain = "") then (
+ ignore (g#add_domain ~readonly:true domain ?libvirturi)
+ ) else (
+ List.iter (g#add_drive ?format ~readonly:true) images
+ );
+
+ for i = 0 to scratch do
+ g#add_drive_scratch 10737418240_L;
+ done;
+
+ g#launch ();
+
+ let rootfs = g#inspect_os () in
+ if Array.length rootfs = 0 then
if rootfs = [||] then
+ failwith "No root fs found";
Like above wrt using "error".
+ if rootfs.(0) = "" then (
+ let fses = g#list_filesystems () in
+ let fs_count = List.fold_left (fun x y -> x + if y then 1 else 0) 0 (List.map
is_mountable fses) in
+ if fs_count = 0 then (
+ print_string ("This disk contains no mountable filesystems that we
recognize.\n\n"
+ ^ "However you can still use virt-rescue on the disk image, to try to
mount\n"
+ ^ "filesystems that are not recognized by libguestfs, or to create
partitions,\n"
+ ^ "logical volumes and filesystems on a blank disk.\n");
+ ) else (
+ print_string ("This disk contains one or more filesystems, but we don't
recognize any\n"
+ ^ "operating system. You can use these mount commands in virt-rescue
(at the\n"
+ ^ "><rescue> prompt) to mount these filesystems.\n\n");
+ List.iter suggestion_for_fs fses;
+ )
+ ) else (
+ print_string ("This disk contains one or more operating systems. You can use
these mount\n"
+ ^ "commands in virt-rescue (at the ><rescue> prompt) to mount the
filesystems.\n\n");
+ Array.iter (inspection_for_fs g) rootfs
Like above wrt using "error" for all the print_string commands above.
Thanks,
--
Pino Toscano
3011
days inactive
3017
days old
1 comments
2 participants
participants (2)
-
Maros Zatko -
Pino Toscano