From: Richard W.M. Jones Date: Mon, 16 Mar 2015 13:58:17 +0000 (+0000) Subject: mclu version 2 X-Git-Url: http://git.annexia.org/?p=mclu.git;a=commitdiff_plain;h=b29a837444aa5827b683bee5a7457fbb32305ae5;ds=sidebyside mclu version 2 --- diff --git a/.gitignore b/.gitignore index 13c72d6..e6546c1 100644 --- a/.gitignore +++ b/.gitignore @@ -1,16 +1,38 @@ *~ +*.1 +*.o +*.cmi +*.cmx +.depend Makefile Makefile.in +/.deps /aclocal.m4 /autom4te.cache +/compile /configure +/config.guess +/config.h +/config.h.in /config.log +/config.ml /config.status -/local* +/config.sub +/depcomp /install-sh +/libtool +/link.sh +/local* +/ltmain.sh /mclu-*.tar.gz /mclu +/m4/libtool.m4 +/m4/ltoptions.m4 +/m4/ltsugar.m4 +/m4/ltversion.m4 +/m4/lt~obsolete.m4 /missing /run +/stamp-h1 diff --git a/Makefile.am b/Makefile.am new file mode 100644 index 0000000..419189a --- /dev/null +++ b/Makefile.am @@ -0,0 +1,112 @@ +# mclu: Mini Cloud +# Copyright (C) 2014-2015 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. + +CLEANFILES = *~ *.cmi *.cmo *.cmx + +ACLOCAL_AMFLAGS = -I m4 + +EXTRA_DIST = \ + $(SOURCES_MLI) \ + $(SOURCES_ML) \ + templates/rawhide.sh + +# In alphabetical order. +SOURCES_MLI = \ + mclu_boot.mli \ + mclu_conf.mli \ + mclu_list.mli \ + mclu_onoff.mli \ + mclu_status.mli \ + parallel.mli \ + template.mli \ + utils.mli + +# These must appear in dependency order. +SOURCES_ML = \ + config.ml \ + utils.ml \ + parallel.ml \ + template.ml \ + mclu_conf.ml \ + mclu_list.ml \ + mclu_status.ml \ + mclu_onoff.ml \ + mclu_boot.ml \ + mclu.ml + +OCAMLPACKAGES = -package unix,pcre,libvirt +OCAMLFLAGS = -g -warn-error CDEFLMPSUVYZX-3 + +BOBJECTS = $(SOURCES_ML:.ml=.cmo) +XOBJECTS = $(BOBJECTS:.cmo=.cmx) +if !HAVE_OCAMLOPT +OBJECTS = $(BOBJECTS) +BEST = ocamlc +else +OBJECTS = $(XOBJECTS) +BEST = ocamlopt +endif + +bin_PROGRAMS = mclu +# Since there are no real C sources (at least, not yet) we have a +# token C file that is empty, just to keep automake happy. The real +# sources are *.ml files. +mclu_SOURCES = empty.c +mclu_DEPENDENCIES = $(OBJECTS) +mclu_LINK = \ + ./link.sh \ + $(OCAMLFIND) $(BEST) $(OCAMLFLAGS) $(OCAMLPACKAGES) \ + $(OBJECTS) -o $@ + +.mli.cmi: + $(OCAMLFIND) ocamlc $(OCAMLFLAGS) $(OCAMLPACKAGES) -c $< -o $@ +.ml.cmo: + $(OCAMLFIND) ocamlc $(OCAMLFLAGS) $(OCAMLPACKAGES) -c $< -o $@ +if HAVE_OCAMLOPT +.ml.cmx: + $(OCAMLFIND) ocamlopt $(OCAMLFLAGS) $(OCAMLPACKAGES) -c $< -o $@ +endif + +# Dependencies. +depend: .depend + +.depend: $(SOURCES_MLI) $(SOURCES_ML) + rm -f $@ $@-t + $(OCAMLFIND) ocamldep -I $(abs_srcdir) -I . $^ | \ + $(SED) 's/ *$$//' | \ + $(SED) -e :a -e '/ *\\$$/N; s/ *\\\n */ /; ta' | \ + $(SED) -e 's,$(abs_srcdir)/,$(builddir)/,g' | \ + sort > $@-t + mv $@-t $@ + +-include .depend + +DISTCLEANFILES = .depend +.PHONY: depend + +# Configuration file. +sysconf_DATA = mclu.conf + +# Documentation. +man_MANS = mclu.1 + +mclu.1: mclu.pod + $(POD2MAN) \ + -c "Virtualization Support" \ + --release "$(PACKAGE)-$(VERSION)" \ + $< > $@-t + mv $@-t $@ diff --git a/config.ml.in b/config.ml.in new file mode 100644 index 0000000..14fd2ba --- /dev/null +++ b/config.ml.in @@ -0,0 +1,33 @@ +(* mclu: Mini Cloud + * Copyright (C) 2014-2015 Red Hat Inc. + * @configure_input@ + * + * 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. + *) + +let maybe = function "no" -> None | s -> Some s + +let path_virt_builder = maybe "@VIRT_BUILDER@" +let path_virt_viewer = maybe "@VIRT_VIEWER@" +let path_wol = maybe "@WOL@" + +let package_name = "@PACKAGE_NAME@" +let package_version = "@PACKAGE_VERSION@" + +let prefix = "@prefix@" +let sysconfdir = "@sysconfdir@" + +(* Avoid stupid crap with datarootdir: *) +let pkgdatadir = "@prefix@/share/@PACKAGE_NAME@" diff --git a/configure.ac b/configure.ac new file mode 100644 index 0000000..aa2d694 --- /dev/null +++ b/configure.ac @@ -0,0 +1,83 @@ +# mclu: Mini Cloud +# Copyright (C) 2014-2015 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. + +AC_INIT([mclu],[2.0]) +AM_INIT_AUTOMAKE([foreign]) + +AC_CONFIG_MACRO_DIR([m4]) + +dnl Check for basic C environment. +AC_PROG_CC_STDC +AM_PROG_CC_C_O +AC_PROG_CPP + +AC_C_PROTOTYPES +test "x$U" != "x" && AC_MSG_ERROR([Compiler not ANSI compliant]) + +AC_PROG_INSTALL + +dnl Define GNU_SOURCE etc. +AC_USE_SYSTEM_EXTENSIONS + +dnl Need libtool for creating the shared library. +AC_PROG_LIBTOOL + +dnl Check for OCaml. +AC_PROG_OCAML +AS_IF([test "x$OCAMLOPT" = "xno"],[ + AC_MSG_ERROR([OCaml native compiler is required]) +]) +AC_PROG_FINDLIB +AS_IF([test "x$OCAMLFIND" = "xno"],[ + AC_MSG_ERROR([ocamlfind (findlib) is required]) +]) + +dnl OCaml packages (all required). +AC_CHECK_OCAML_PKG(pcre) +AS_IF([test "x$OCAML_PKG_pcre" = "xno"],[ + AC_MSG_ERROR([OCaml library 'pcre' is required]) +]) + +AC_CHECK_OCAML_PKG(libvirt) +AS_IF([test "x$OCAML_PKG_libvirt" = "xno"],[ + AC_MSG_ERROR([OCaml library 'ocaml-libvirt' is required]) +]) + +AM_CONDITIONAL([HAVE_OCAMLOPT], [test "x$OCAMLOPT" != "xno"]) + +dnl virt-builder (optional). +AC_PATH_PROG([VIRT_BUILDER],[virt-builder],[no]) + +dnl virt-viewer (optional). +AC_PATH_PROG([VIRT_VIEWER],[virt-viewer],[no]) + +dnl Wake-on-LAN client (optional). +AC_PATH_PROG([WOL],[wol],[no]) + +dnl Check for pod2man (from Perl, for the manual). +AC_CHECK_PROG([POD2MAN], [pod2man], [pod2man], [no]) +if test "x$POD2MAN" = "xno"; then + AC_MSG_ERROR([pod2man was not found. This is needed to build man pages.]) +fi + +dnl Produce output files. +AC_CONFIG_HEADERS([config.h]) +AC_CONFIG_FILES([Makefile config.ml]) +AC_CONFIG_FILES([link.sh], [chmod +x,-w link.sh]) +AC_CONFIG_FILES([run], [chmod +x,-w run]) + +AC_OUTPUT diff --git a/empty.c b/empty.c new file mode 100644 index 0000000..25ce68f --- /dev/null +++ b/empty.c @@ -0,0 +1,19 @@ +/* mclu: Mini Cloud + * Copyright (C) 2014-2015 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. + */ + +/* intentionally empty */ diff --git a/link.sh.in b/link.sh.in new file mode 100644 index 0000000..e1faa4c --- /dev/null +++ b/link.sh.in @@ -0,0 +1,21 @@ +# mclu: Mini Cloud +# @configure_input@ +# (C) Copyright 2014-2014 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., 675 Mass Ave, Cambridge, MA 02139, USA. + +# Hack automake to link binary properly. + +exec "$@" -linkpkg diff --git a/m4/ocaml.m4 b/m4/ocaml.m4 new file mode 100644 index 0000000..fddd6a0 --- /dev/null +++ b/m4/ocaml.m4 @@ -0,0 +1,217 @@ +dnl autoconf macros for OCaml +dnl +dnl Copyright © 2009 Richard W.M. Jones +dnl Copyright © 2009 Stefano Zacchiroli +dnl Copyright © 2000-2005 Olivier Andrieu +dnl Copyright © 2000-2005 Jean-Christophe Filliâtre +dnl Copyright © 2000-2005 Georges Mariano +dnl +dnl For documentation, please read the ocaml.m4 man page. + +AC_DEFUN([AC_PROG_OCAML], +[dnl + # checking for ocamlc + AC_CHECK_TOOL([OCAMLC],[ocamlc],[no]) + + if test "$OCAMLC" != "no"; then + OCAMLVERSION=`$OCAMLC -v | sed -n -e 's|.*version* *\(.*\)$|\1|p'` + AC_MSG_RESULT([OCaml version is $OCAMLVERSION]) + OCAMLLIB=`$OCAMLC -where 2>/dev/null || $OCAMLC -v|tail -1|cut -d ' ' -f 4` + AC_MSG_RESULT([OCaml library path is $OCAMLLIB]) + + AC_SUBST([OCAMLVERSION]) + AC_SUBST([OCAMLLIB]) + + # checking for ocamlopt + AC_CHECK_TOOL([OCAMLOPT],[ocamlopt],[no]) + OCAMLBEST=byte + if test "$OCAMLOPT" = "no"; then + AC_MSG_WARN([Cannot find ocamlopt; bytecode compilation only.]) + else + TMPVERSION=`$OCAMLOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` + if test "$TMPVERSION" != "$OCAMLVERSION" ; then + AC_MSG_RESULT([versions differs from ocamlc; ocamlopt discarded.]) + OCAMLOPT=no + else + OCAMLBEST=opt + fi + fi + + AC_SUBST([OCAMLBEST]) + + # checking for ocamlc.opt + AC_CHECK_TOOL([OCAMLCDOTOPT],[ocamlc.opt],[no]) + if test "$OCAMLCDOTOPT" != "no"; then + TMPVERSION=`$OCAMLCDOTOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` + if test "$TMPVERSION" != "$OCAMLVERSION" ; then + AC_MSG_RESULT([versions differs from ocamlc; ocamlc.opt discarded.]) + else + OCAMLC=$OCAMLCDOTOPT + fi + fi + + # checking for ocamlopt.opt + if test "$OCAMLOPT" != "no" ; then + AC_CHECK_TOOL([OCAMLOPTDOTOPT],[ocamlopt.opt],[no]) + if test "$OCAMLOPTDOTOPT" != "no"; then + TMPVERSION=`$OCAMLOPTDOTOPT -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' ` + if test "$TMPVERSION" != "$OCAMLVERSION" ; then + AC_MSG_RESULT([version differs from ocamlc; ocamlopt.opt discarded.]) + else + OCAMLOPT=$OCAMLOPTDOTOPT + fi + fi + fi + + AC_SUBST([OCAMLOPT]) + fi + + AC_SUBST([OCAMLC]) + + # checking for ocamldep + AC_CHECK_TOOL([OCAMLDEP],[ocamldep],[no]) + + # checking for ocamlmktop + AC_CHECK_TOOL([OCAMLMKTOP],[ocamlmktop],[no]) + + # checking for ocamlmklib + AC_CHECK_TOOL([OCAMLMKLIB],[ocamlmklib],[no]) + + # checking for ocamldoc + AC_CHECK_TOOL([OCAMLDOC],[ocamldoc],[no]) + + # checking for ocamlbuild + AC_CHECK_TOOL([OCAMLBUILD],[ocamlbuild],[no]) +]) + + +AC_DEFUN([AC_PROG_OCAMLLEX], +[dnl + # checking for ocamllex + AC_CHECK_TOOL([OCAMLLEX],[ocamllex],[no]) + if test "$OCAMLLEX" != "no"; then + AC_CHECK_TOOL([OCAMLLEXDOTOPT],[ocamllex.opt],[no]) + if test "$OCAMLLEXDOTOPT" != "no"; then + OCAMLLEX=$OCAMLLEXDOTOPT + fi + fi + AC_SUBST([OCAMLLEX]) +]) + +AC_DEFUN([AC_PROG_OCAMLYACC], +[dnl + AC_CHECK_TOOL([OCAMLYACC],[ocamlyacc],[no]) + AC_SUBST([OCAMLYACC]) +]) + + +AC_DEFUN([AC_PROG_CAMLP4], +[dnl + AC_REQUIRE([AC_PROG_OCAML])dnl + + # checking for camlp4 + AC_CHECK_TOOL([CAMLP4],[camlp4],[no]) + if test "$CAMLP4" != "no"; then + TMPVERSION=`$CAMLP4 -v 2>&1| sed -n -e 's|.*version *\(.*\)$|\1|p'` + if test "$TMPVERSION" != "$OCAMLVERSION" ; then + AC_MSG_RESULT([versions differs from ocamlc]) + CAMLP4=no + fi + fi + AC_SUBST([CAMLP4]) + + # checking for companion tools + AC_CHECK_TOOL([CAMLP4BOOT],[camlp4boot],[no]) + AC_CHECK_TOOL([CAMLP4O],[camlp4o],[no]) + AC_CHECK_TOOL([CAMLP4OF],[camlp4of],[no]) + AC_CHECK_TOOL([CAMLP4OOF],[camlp4oof],[no]) + AC_CHECK_TOOL([CAMLP4ORF],[camlp4orf],[no]) + AC_CHECK_TOOL([CAMLP4PROF],[camlp4prof],[no]) + AC_CHECK_TOOL([CAMLP4R],[camlp4r],[no]) + AC_CHECK_TOOL([CAMLP4RF],[camlp4rf],[no]) + AC_SUBST([CAMLP4BOOT]) + AC_SUBST([CAMLP4O]) + AC_SUBST([CAMLP4OF]) + AC_SUBST([CAMLP4OOF]) + AC_SUBST([CAMLP4ORF]) + AC_SUBST([CAMLP4PROF]) + AC_SUBST([CAMLP4R]) + AC_SUBST([CAMLP4RF]) +]) + + +AC_DEFUN([AC_PROG_FINDLIB], +[dnl + AC_REQUIRE([AC_PROG_OCAML])dnl + + # checking for ocamlfind + AC_CHECK_TOOL([OCAMLFIND],[ocamlfind],[no]) + AC_SUBST([OCAMLFIND]) +]) + + +dnl Thanks to Jim Meyering for working this next bit out for us. +dnl XXX We should define AS_TR_SH if it's not defined already +dnl (eg. for old autoconf). +AC_DEFUN([AC_CHECK_OCAML_PKG], +[dnl + AC_REQUIRE([AC_PROG_FINDLIB])dnl + + AC_MSG_CHECKING([for OCaml findlib package $1]) + + unset found + unset pkg + found=no + for pkg in $1 $2 ; do + if $OCAMLFIND query $pkg >/dev/null 2>/dev/null; then + AC_MSG_RESULT([found]) + AS_TR_SH([OCAML_PKG_$1])=$pkg + found=yes + break + fi + done + if test "$found" = "no" ; then + AC_MSG_RESULT([not found]) + AS_TR_SH([OCAML_PKG_$1])=no + fi + + AC_SUBST(AS_TR_SH([OCAML_PKG_$1])) +]) + + +AC_DEFUN([AC_CHECK_OCAML_MODULE], +[dnl + AC_MSG_CHECKING([for OCaml module $2]) + + cat > conftest.ml <&5 2>&5 ; then + found=yes + break + fi + done + + if test "$found" ; then + AC_MSG_RESULT([$$1]) + else + AC_MSG_RESULT([not found]) + $1=no + fi + AC_SUBST([$1]) +]) + + +dnl XXX Cross-compiling +AC_DEFUN([AC_CHECK_OCAML_WORD_SIZE], +[dnl + AC_MSG_CHECKING([for OCaml compiler word size]) + cat > conftest.ml < Config.sysconfdir // "mclu.conf" in + ref default + +let verbose = ref false + +let show_version () = + printf "%s %s\n" Config.package_name Config.package_version; + exit 0 + +let global_speclist = Arg.align [ + "--config-file", Arg.Set_string config_file, "FILE Set configuration file"; + "-f", Arg.Set_string config_file, "FILE Set configuration file"; + "-v", Arg.Set verbose, " Enable verbose/debugging messages"; + "--verbose", Arg.Set verbose, " Enable verbose/debugging messages"; + "-V", Arg.Unit show_version, " Display version and exit"; + "--version", Arg.Unit show_version, " Display version and exit"; +] +let speclist = ref global_speclist +let subcommand_run = ref (fun ~verbose _ -> assert false) +let anon_fun, get_anon_args = + let i = ref 0 in + let args = ref [] in + let anon_fun arg = + incr i; let i = !i in + if i = 1 then ( + match arg with + | "boot" -> + speclist := Mclu_boot.get_arg_speclist (); + subcommand_run := Mclu_boot.run + | "list" -> + speclist := Mclu_list.get_arg_speclist (); + subcommand_run := Mclu_list.run + | "off" -> + speclist := Mclu_onoff.get_arg_speclist (); + subcommand_run := Mclu_onoff.run ~on:false + | "on" -> + speclist := Mclu_onoff.get_arg_speclist (); + subcommand_run := Mclu_onoff.run ~on:true + | "status" -> + speclist := Mclu_status.get_arg_speclist (); + subcommand_run := Mclu_status.run + | _ -> + eprintf "mclu: unknown subcommand '%s' +For help, use mclu --help or read the mclu(1) man page.\n" arg; + exit 1 + ) + else + args := arg :: !args + in + let get_anon_args () = List.rev !args in + anon_fun, get_anon_args +let usage_msg = "\ +Usage: + mclu [-f mclu.conf] [--options] [list|status|boot|...] ... + +For more help, use mclu --help or read the mclu(1) man page. + +Options:" + +let () = + (* Parse the command line and subcommand arguments. *) + Arg.parse_dynamic speclist anon_fun usage_msg; + + (* Load the configuration file. *) + Mclu_conf.load_configuration !config_file; + + (* Run the subcommand. *) + let verbose = !verbose in + !subcommand_run ~verbose (get_anon_args ()) diff --git a/mclu.pod b/mclu.pod new file mode 100644 index 0000000..5c2a03f --- /dev/null +++ b/mclu.pod @@ -0,0 +1,187 @@ +=head1 NAME + + mclu - Mini Cloud, a tiny, sane cloud + +=head1 SUMMARY + +mclu [-f mclu.conf] [--options] [list|status|boot|...] [...] + +mclu --help + +=head1 DESCRIPTION + + + + + + +=head1 GLOBAL OPTIONS + +=over 4 + +=item B<--help> + +Display brief help message and exit. + +=item B<-f mclu.conf> + +=item B<--config-file mclu.conf> + +Specify the path to the configuration file. If this command option is +I given, then the environment variable C is used, +and if that environment variable is not set then C is +used. + +See also: L below. + +=item B<-v> + +=item B<--verbose> + +Enable verbose / debugging messages. + +=item B<-V> + +=item B<--version> + +Display version number and exit. + +=back + + + + +=head1 SUBCOMMANDS + +=over 4 + +=item B + +Boot (create) a new instance from B above. + +=back + +=head1 FILES + + + + +=head1 SEE ALSO + +L, +L + +=head1 AUTHORS + +Richard W.M. Jones + +=head1 COPYRIGHT + +(C) Copyright 2014-2015 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. diff --git a/mclu_boot.ml b/mclu_boot.ml new file mode 100644 index 0000000..6927363 --- /dev/null +++ b/mclu_boot.ml @@ -0,0 +1,265 @@ +(* mclu: Mini Cloud + * Copyright (C) 2014-2015 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. + *) + +(* Implement 'mclu boot'. *) + +module C = Libvirt.Connect +module D = Libvirt.Domain +module MS = Mclu_status + +open Printf + +open Utils + +let memory = ref 0L (* 0 = choose for me *) +let set_memory s = + try memory := bytes_of_human_size s + with Not_found -> + eprintf "mclu: don't understand --memory parameter '%s' +Try something like --memory 1G\n" s; + exit 1 +let vcpus = ref 0 (* 0 = choose for me *) + +let get_arg_speclist () = Arg.align [ + "--cpus", Arg.Set_int vcpus, "n Number of virtual CPUs"; + "--memory", Arg.String set_memory, "nnG Amount of RAM to give guest"; + "--ram", Arg.String set_memory, "nnG Amount of RAM to give guest"; + "--vcpus", Arg.Set_int vcpus, "n Number of virtual CPUs"; +] + +let boot ~verbose template name = + let templates = Template.templates () in + + (* Does the template exist? *) + let template_filename = + try List.assoc template templates + with Not_found -> + eprintf "mclu: template %s not found +Try `mclu list --templates' to list all known templates.\n" template; + exit 1 in + + (* Probe the template for various features. *) + let template_info = Template.probe ~verbose template_filename in + + (* Decide how much RAM we will give the guest. This affects our + * choice of node, so do it early. + *) + let memory = !memory in + let memory = + if memory > 0L then ( + (* User requested, just check it's above the minimum. *) + match template_info.Template.minimum_memory with + | None -> memory + | Some min when min > memory -> + eprintf "mclu: minimum memory for this template is %s\n" + (human_size min); + exit 1 + | Some _ -> memory + ) else ( + (* User didn't request any memory setting, use the recommended. *) + match template_info.Template.recommended_memory with + | Some memory -> memory + | None -> 4L *^ 1024L *^ 1024L *^ 1024L (* 4 GB *) + ) in + + (* Check what's running. *) + let summary = MS.node_guest_summary ~verbose () in + + (* Did the user request a specific host? If not, choose one. *) + let hostname, name = + match name_parse name with + | Some hostname, name -> hostname, name + | None, name -> + (* Choose the first host with enough free memory. *) + let nodes = List.filter ( + fun { MS.free_memory = free_memory } -> free_memory >= memory + ) summary in + match nodes with + | [] -> + eprintf "mclu: no node with enough free memory found +Try: `mclu status' and `mclu on '\n"; + exit 1 + | node :: _ -> + let hostname = + node.MS.node_status.MS.node.Mclu_conf.hostname in + hostname, name in + + (* Check there isn't a guest with this name running anywhere + * in the cluster already. + *) + List.iter ( + fun ({ MS.active_guests = guests } as node) -> + List.iter ( + fun { Mclu_list.dom_name = n } -> + if name = n then ( + let hostname = + node.MS.node_status.MS.node.Mclu_conf.hostname + in + eprintf "mclu: there is already a guest called '%s' (running on %s)\n" + name hostname; + exit 1 + ) + ) guests + ) summary; + + (* Convert hostname to a specific node, and check it is up. *) + let node = + try List.find ( + fun node -> + node.MS.node_status.MS.node.Mclu_conf.hostname = hostname + ) summary + with Not_found -> + eprintf "mclu: no node is called '%s'\n" hostname; + exit 1 in + if not node.MS.node_status.MS.node_on then ( + eprintf "mclu: node '%s' is switched off +Try: `mclu on %s'\n" hostname hostname; + exit 1 + ); + + (* Where we upload the template and image on remote. *) + let format, extension = "qcow2", "qcow2" in + let remote_filename = sprintf "/tmp/mclu%s.sh" (string_random8 ()) in + let remote_image = sprintf "/var/tmp/%s.%s" name extension in + + (* Get ready to generate the guest XML. *) + let vcpus = !vcpus in + let vcpus = + if vcpus > 0 then vcpus + else min 4 node.MS.node_status.MS.node_info.C.cpus in + let mac_addr = + sprintf "52:54:00:%02x:%02x:%02x" + (Random.int 256) (Random.int 256) (Random.int 256) in + + (* Generate the guest XML. XXX Quoting. *) + let xml = sprintf "\ + + %s + %Ld + %Ld + %d + + hvm + + + + + + + + + + + + + + destroy + restart + restart + +" name (memory /^ 1024L) (memory /^ 1024L) vcpus in + + let xml = xml ^ sprintf "\ + + + +" format remote_image in + let xml = xml ^ + match template_info.Template.disk_bus with + | Some "ide" -> + " \n" + | Some "virtio-scsi" | None -> + " \n" + | Some bus -> + eprintf "mclu: unknown disk-bus: %s\n" bus; + exit 1 in + let xml = xml ^ "\ + +" in + + let xml = xml ^ + if template_info.Template.disk_bus = Some "virtio-scsi" then + " \n" + else + "" in + + (* XXX Don't hard-code bridge name here. *) + let network_model = + match template_info with + | { Template.network_model = None } -> "virtio" + | { Template.network_model = Some d } -> d in + let xml = xml ^ sprintf "\ + + + + + +" mac_addr network_model in + + let xml = xml ^ "\ + + + + + + + + + +" in + + (* Copy the template to remote and build the guest. *) + let cmd = + sprintf "scp %s root@%s:%s" + (quote template_filename) (quote hostname) remote_filename in + if verbose then printf "%s\n%!" cmd; + if Sys.command cmd <> 0 then ( + eprintf "mclu: scp template to remote failed\n"; + exit 1 + ); + let cmd = + (* XXX Don't hard-code network_bridge here. *) + sprintf "ssh root@%s LIBGUESTFS_BACKEND_SETTINGS=network_bridge=br0 %s build %s %s %s" + (quote hostname) remote_filename + (quote template_info.Template.base_image) (quote remote_image) + format in + if verbose then printf "%s\n%!" cmd; + if Sys.command cmd <> 0 then ( + eprintf "mclu: remote build failed\n"; + exit 1 + ); + + (* Start the guest. *) + try + let conn = + let name = node.MS.node_status.MS.node.Mclu_conf.libvirt_uri in + C.connect ~name () in + let dom = D.create_xml conn xml [] in + printf "mclu: %s:%s started\n" hostname (D.get_name dom) + with Libvirt.Virterror msg -> + eprintf "mclu: %s: %s\n" hostname (Libvirt.Virterror.to_string msg); + exit 1 + +let run ~verbose = function + | [ template; name ] -> + boot ~verbose template name + | _ -> + eprintf "Usage: mclu boot