From f7d1a79773b8b04dfcd13c2dd2f6ae3b70d43663 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Sat, 21 Mar 2015 22:28:48 +0000 Subject: [PATCH 1/1] Implement 'mclu viewer' command to open the graphical console. --- Makefile.am | 2 ++ mclu.ml | 3 +++ mclu.pod | 4 ++++ mclu_viewer.ml | 42 ++++++++++++++++++++++++++++++++++++++++++ mclu_viewer.mli | 21 +++++++++++++++++++++ 5 files changed, 72 insertions(+) create mode 100644 mclu_viewer.ml create mode 100644 mclu_viewer.mli diff --git a/Makefile.am b/Makefile.am index 213df2d..0107cf0 100644 --- a/Makefile.am +++ b/Makefile.am @@ -33,6 +33,7 @@ SOURCES_MLI = \ mclu_list.mli \ mclu_onoff.mli \ mclu_status.mli \ + mclu_viewer.mli \ parallel.mli \ template.mli \ utils.mli @@ -50,6 +51,7 @@ SOURCES_ML = \ mclu_boot.ml \ mclu_destroy.ml \ mclu_console.ml \ + mclu_viewer.ml \ mclu.ml OCAMLPACKAGES = -package unix,pcre,libvirt diff --git a/mclu.ml b/mclu.ml index af54c5b..ff8103b 100644 --- a/mclu.ml +++ b/mclu.ml @@ -70,6 +70,9 @@ let anon_fun, get_anon_args = | "status" -> speclist := Mclu_status.get_arg_speclist (); subcommand_run := Mclu_status.run + | "viewer" -> + speclist := Mclu_viewer.get_arg_speclist (); + subcommand_run := Mclu_viewer.run | _ -> eprintf "mclu: unknown subcommand '%s' For help, use mclu --help or read the mclu(1) man page.\n" arg; diff --git a/mclu.pod b/mclu.pod index e5b028f..45b9bd5 100644 --- a/mclu.pod +++ b/mclu.pod @@ -134,6 +134,10 @@ for each host: Display the status of the cloud. This shows you which nodes are on and off, and the amount of resources used and free on each node. +=item B + +Open the graphical console of the guest (using L). + =back diff --git a/mclu_viewer.ml b/mclu_viewer.ml new file mode 100644 index 0000000..15036b7 --- /dev/null +++ b/mclu_viewer.ml @@ -0,0 +1,42 @@ +(* 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 viewer'. *) + +open Printf + +open Utils + +let get_arg_speclist () = [] + +let viewer ~verbose ?host name = + let node, name = Mclu_list.find_guest ~verbose name in + let uri = node.Mclu_conf.libvirt_uri in + + let cmd = sprintf "virt-viewer -c %s %s" (quote uri) (quote name) in + if verbose then printf "%s\n%!" cmd; + if Sys.command cmd <> 0 then ( + eprintf "mclu: %s: command failed\n" cmd; + exit 1 + ) + +let run ~verbose = function + | [ name ] -> viewer ~verbose name + | _ -> + eprintf "Usage: mclu viewer <[host:]name>\n"; + exit 1 diff --git a/mclu_viewer.mli b/mclu_viewer.mli new file mode 100644 index 0000000..46ae35e --- /dev/null +++ b/mclu_viewer.mli @@ -0,0 +1,21 @@ +(* 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. + *) + +val get_arg_speclist : unit -> (Arg.key * Arg.spec * Arg.doc) list + +val run : verbose:bool -> string list -> unit -- 1.8.3.1