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