1 (* virsh-like command line tool.
2 (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc.
5 This program is free software; you can redistribute it and/or modify
6 it under the terms of the GNU General Public License as published by
7 the Free Software Foundation; either version 2 of the License, or
8 (at your option) any later version.
10 This program is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 GNU General Public License for more details.
15 You should have received a copy of the GNU General Public License
16 along with this program; if not, write to the Free Software
17 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
21 open Mlvirsh_gettext.Gettext
23 module C = Libvirt.Connect
24 module D = Libvirt.Domain
25 module N = Libvirt.Network
28 let program_name = Filename.basename Sys.executable_name
30 (* Parse arguments. *)
32 let readonly = ref false
34 let argspec = Arg.align [
35 "-c", Arg.Set_string name, "URI " ^ s_ "Hypervisor connection URI";
36 "-r", Arg.Set readonly, " " ^ s_ "Read-only connection";
40 sprintf (f_ "Synopsis:
41 %s [options] [command]
46 Full description of a single command:
50 program_name program_name program_name
52 let add_extra_arg, get_extra_args =
53 let extra_args = ref [] in
54 let add_extra_arg s = extra_args := s :: !extra_args in
55 let get_extra_args () = List.rev !extra_args in
56 add_extra_arg, get_extra_args
58 let () = Arg.parse argspec add_extra_arg usage_msg
60 let name = match !name with "" -> None | name -> Some name
61 let readonly = !readonly
62 let extra_args = get_extra_args ()
64 (* Read a whole file into memory and return it (as a string). *)
65 let rec input_file filename =
66 let chan = open_in_bin filename in
67 let data = input_all chan in
71 let buf = Buffer.create 16384 in
72 let tmpsize = 16384 in
73 let tmp = String.create tmpsize in
75 while n := input chan tmp 0 tmpsize; !n > 0 do
76 Buffer.add_substring buf tmp 0 !n;
80 (* Split a string at a separator.
81 * Functions copied from extlib Copyright (C) 2003 Nicolas Cannasse et al.
82 * to avoid the explicit dependency on extlib.
84 let str_find str sub =
85 let sublen = String.length sub in
90 let len = String.length str in
92 for i = 0 to len - sublen do
94 while String.unsafe_get str (i + !j) = String.unsafe_get sub !j do
96 if !j = sublen then begin found := i; raise Exit; end;
103 let str_split str sep =
104 let p = str_find str sep in
105 let len = String.length sep in
106 let slen = String.length str in
107 String.sub str 0 p, String.sub str (p + len) (slen - p - len)
109 let str_nsplit str sep =
112 let rec nsplit str sep =
114 let s1 , s2 = str_split str sep in
122 (* Hypervisor connection. *)
123 type conn_t = No_connection | RO of Libvirt.ro C.t | RW of Libvirt.rw C.t
124 let conn = ref No_connection
126 let close_connection () =
128 | No_connection -> ()
131 conn := No_connection
134 conn := No_connection
137 (* Command helper functions.
139 * Each cmd<n> is a function that constructs a command.
140 * string string string ... <--- user types on the command line
142 * arg1 arg2 arg3 ... <--- conversion functions
145 * function f <--- work function
148 * print result <--- printing function
150 * (Note that cmd<n> function constructs and returns the above
151 * function, it isn't the function itself.)
153 * Example: If the function takes one parameter (an int) and
154 * returns a string to be printed, you would use:
156 * cmd1 print_endline f int_of_string
158 let cmd0 print fn = function (* Command with no args. *)
159 | [] -> print (fn ())
160 | _ -> failwith (s_ "incorrect number of arguments for function")
162 let cmd1 print fn arg1 = function (* Command with one arg. *)
163 | [str1] -> print (fn (arg1 str1))
164 | _ -> failwith (s_ "incorrect number of arguments for function")
166 let cmd2 print fn arg1 arg2 = function (* Command with 2 args. *)
167 | [str1; str2] -> print (fn (arg1 str1) (arg2 str2))
168 | _ -> failwith (s_ "incorrect number of arguments for function")
170 let cmd3 print fn arg1 arg2 arg3 = function (* Command with 3 args. *)
171 | [str1; str2; str3] -> print (fn (arg1 str1) (arg2 str2) (arg3 str3))
172 | _ -> failwith (s_ "incorrect number of arguments for function")
174 let cmd01 print fn arg1 = function (* Command with 0 or 1 arg. *)
175 | [] -> print (fn None)
176 | [str1] -> print (fn (Some (arg1 str1)))
177 | _ -> failwith (s_ "incorrect number of arguments for function")
179 let cmd12 print fn arg1 arg2 = function (* Command with 1 or 2 args. *)
180 | [str1] -> print (fn (arg1 str1) None)
181 | [str1; str2] -> print (fn (arg1 str1) (Some (arg2 str2)))
182 | _ -> failwith (s_ "incorrect number of arguments for function")
184 let cmd012 print fn arg1 arg2 = function (* Command with 0, 1 or 2 args. *)
185 | [] -> print (fn None None)
186 | [str1] -> print (fn (Some (arg1 str1)) None)
187 | [str1; str2] -> print (fn (Some (arg1 str1)) (Some (arg2 str2)))
188 | _ -> failwith (s_ "incorrect number of arguments for function")
190 let cmdN print fn = (* Command with any number of args. *)
191 fun args -> print (fn args)
194 (* Get the connection or fail if we don't have one. *)
195 let rec get_full_connection () =
197 | No_connection -> failwith (s_ "not connected to the hypervisor")
198 | RO _ -> failwith (s_ "tried to do read-write operation on read-only hypervisor connection")
200 and get_readonly_connection () =
202 | No_connection -> failwith (s_ "not connected to the hypervisor")
204 | RW conn -> C.const conn
206 and with_full_connection fn =
207 fun () -> fn (get_full_connection ())
209 and with_readonly_connection fn =
210 fun () -> fn (get_readonly_connection ())
211 and arg_full_connection fn =
212 fun str -> fn (get_full_connection ()) str
213 and arg_readonly_connection fn =
214 fun str -> fn (get_readonly_connection ()) str
217 (* Parsing of command arguments. *)
218 let string_of_readonly = function
219 | "readonly" | "read-only" | "ro" -> true
220 | _ -> failwith (sprintf (f_ "flag should be '%s'") "readonly")
222 let string_of_string (str : string) = str in
223 let boolean_of_string = function
224 | "enable" | "enabled" | "on" | "1" | "true" -> true
225 | "disable" | "disabled" | "off" | "0" | "false" -> false
226 | _ -> failwith (sprintf (f_ "setting should be '%s' or '%s'") "on" "off")
228 let domain_of_string conn str =
231 let id = int_of_string str in
232 D.lookup_by_id conn id
234 Failure "int_of_string" ->
235 if String.length str = Libvirt.uuid_string_length then
236 D.lookup_by_uuid_string conn str
238 D.lookup_by_name conn str
241 Libvirt.Virterror err ->
242 failwith (sprintf (f_ "domain %s: not found. Additional info: %s")
243 str (Libvirt.Virterror.to_string err));
245 let network_of_string conn str =
247 if String.length str = Libvirt.uuid_string_length then
248 N.lookup_by_uuid_string conn str
250 N.lookup_by_name conn str
252 Libvirt.Virterror err ->
253 failwith (sprintf (f_ "network %s: not found. Additional info: %s")
254 str (Libvirt.Virterror.to_string err));
256 let rec parse_sched_params = function
258 | [_] -> failwith (s_ "expected field value pairs, but got an odd number of arguments")
259 | field :: value :: rest ->
260 (* XXX We only support the UINT type at the moment. *)
261 (field, D.SchedFieldUInt32 (Int32.of_string value))
262 :: parse_sched_params rest
264 let cpumap_of_string str =
265 let c = get_readonly_connection () in
266 let info = C.get_node_info c in
268 String.make (C.cpumaplen (C.maxcpus_of_node_info info)) '\000' in
269 List.iter (C.use_cpu cpumap)
270 (List.map int_of_string (str_nsplit str ","));
274 (* Printing of command results. *)
275 let no_return _ = () in
276 let print_int i = print_endline (string_of_int i) in
277 let print_int64 i = print_endline (Int64.to_string i) in
278 let print_int64_array a = Array.iter print_int64 a in
279 let print_bool b = print_endline (string_of_bool b) in
280 let print_version v =
281 let major = v / 1000000 in
282 let minor = (v - major * 1000000) / 1000 in
283 let release = (v - major * 1000000 - minor * 1000) in
284 printf "%d.%d.%d\n" major minor release
286 let string_of_domain_state = function
287 | D.InfoNoState -> s_ "unknown"
288 | D.InfoRunning -> s_ "running"
289 | D.InfoBlocked -> s_ "blocked"
290 | D.InfoPaused -> s_ "paused"
291 | D.InfoShutdown -> s_ "shutdown"
292 | D.InfoShutoff -> s_ "shutoff"
293 | D.InfoCrashed -> s_ "crashed"
295 let string_of_vcpu_state = function
296 | D.VcpuOffline -> s_ "offline"
297 | D.VcpuRunning -> s_ "running"
298 | D.VcpuBlocked -> s_ "blocked"
300 let print_domain_array doms =
304 try sprintf "%d" (D.get_id dom)
305 with Libvirt.Virterror _ -> "" in
307 try sprintf "%s" (D.get_name dom)
308 with Libvirt.Virterror _ -> "" in
311 let { D.state = state } = D.get_info dom in
312 string_of_domain_state state
313 with Libvirt.Virterror _ -> "" in
314 printf "%5s %-30s %s\n" id name state
317 let print_network_array nets =
320 printf "%s\n" (N.get_name net)
323 let print_node_info info =
324 let () = printf (f_ "model: %s\n") info.C.model in
325 let () = printf (f_ "memory: %Ld K\n") info.C.memory in
326 let () = printf (f_ "cpus: %d\n") info.C.cpus in
327 let () = printf (f_ "mhz: %d\n") info.C.mhz in
328 let () = printf (f_ "nodes: %d\n") info.C.nodes in
329 let () = printf (f_ "sockets: %d\n") info.C.sockets in
330 let () = printf (f_ "cores: %d\n") info.C.cores in
331 let () = printf (f_ "threads: %d\n") info.C.threads in
334 let print_domain_state { D.state = state } =
335 print_endline (string_of_domain_state state)
337 let print_domain_info info =
338 let () = printf (f_ "state: %s\n") (string_of_domain_state info.D.state) in
339 let () = printf (f_ "max_mem: %Ld K\n") info.D.max_mem in
340 let () = printf (f_ "memory: %Ld K\n") info.D.memory in
341 let () = printf (f_ "nr_virt_cpu: %d\n") info.D.nr_virt_cpu in
342 let () = printf (f_ "cpu_time: %Ld ns\n") info.D.cpu_time in
345 let print_sched_param_array params =
350 | D.SchedFieldInt32 i -> printf " %ld\n" i
351 | D.SchedFieldUInt32 i -> printf " %lu\n" i
352 | D.SchedFieldInt64 i -> printf " %Ld\n" i
353 | D.SchedFieldUInt64 i -> printf " %Lu\n" i
354 | D.SchedFieldFloat f -> printf " %g\n" f
355 | D.SchedFieldBool b -> printf " %b\n" b
358 let print_vcpu_info (ncpus, vcpu_infos, cpumaps, maplen, maxcpus) =
359 for n = 0 to ncpus-1 do
360 let () = printf (f_ "virtual CPU: %d\n") n in
361 let () = printf (f_ "\ton physical CPU: %d\n") vcpu_infos.(n).D.cpu in
362 let () = printf (f_ "\tcurrent state: %s\n")
363 (string_of_vcpu_state vcpu_infos.(n).D.vcpu_state) in
364 let () = printf (f_ "\tCPU time: %Ld ns\n") vcpu_infos.(n).D.vcpu_time in
365 print_string ("\t" ^ s_ "CPU affinity" ^ ": ");
366 for m = 0 to maxcpus-1 do
367 print_char (if C.cpu_usable cpumaps maplen n m then 'y' else '-')
372 let print_block_stats { D.rd_req = rd_req; rd_bytes = rd_bytes;
373 wr_req = wr_req; wr_bytes = wr_bytes;
375 if rd_req >= 0L then printf (f_ "read requests: %Ld\n") rd_req;
376 if rd_bytes >= 0L then printf (f_ "read bytes: %Ld\n") rd_bytes;
377 if wr_req >= 0L then printf (f_ "write requests: %Ld\n") wr_req;
378 if wr_bytes >= 0L then printf (f_ "write bytes: %Ld\n") wr_bytes;
379 if errs >= 0L then printf (f_ "errors: %Ld\n") errs;
380 and print_interface_stats { D.rx_bytes = rx_bytes; rx_packets = rx_packets;
381 rx_errs = rx_errs; rx_drop = rx_drop;
382 tx_bytes = tx_bytes; tx_packets = tx_packets;
383 tx_errs = tx_errs; tx_drop = tx_drop } =
384 if rx_bytes >= 0L then printf (f_ "rx bytes: %Ld\n") rx_bytes;
385 if rx_packets >= 0L then printf (f_ "rx packets: %Ld\n") rx_packets;
386 if rx_errs >= 0L then printf (f_ "rx errs: %Ld\n") rx_errs;
387 if rx_drop >= 0L then printf (f_ "rx dropped: %Ld\n") rx_drop;
388 if tx_bytes >= 0L then printf (f_ "tx bytes: %Ld\n") tx_bytes;
389 if tx_packets >= 0L then printf (f_ "tx packets: %Ld\n") tx_packets;
390 if tx_errs >= 0L then printf (f_ "tx errs: %Ld\n") tx_errs;
391 if tx_drop >= 0L then printf (f_ "tx dropped: %Ld\n") tx_drop;
394 (* List of commands. *)
397 cmd2 no_return D.attach_device
398 (arg_full_connection domain_of_string) input_file,
399 s_ "Attach device to domain.";
401 cmd2 no_return D.set_autostart
402 (arg_full_connection domain_of_string) boolean_of_string,
403 s_ "Set whether a domain autostarts at boot.";
405 cmd0 print_endline (with_readonly_connection C.get_capabilities),
406 s_ "Returns capabilities of hypervisor/driver.";
408 cmd0 no_return close_connection,
409 s_ "Close an existing hypervisor connection.";
412 (fun name readonly ->
415 | None | Some false -> conn := RW (C.connect ~name ())
416 | Some true -> conn := RO (C.connect_readonly ~name ())
417 ) string_of_string string_of_readonly,
418 s_ "Open a new hypervisor connection.";
421 (fun xml -> D.create_linux (get_full_connection ()) xml) input_file,
422 s_ "Create a domain from an XML file.";
425 (fun xml -> D.define_xml (get_full_connection ()) xml) input_file,
426 s_ "Define (but don't start) a domain from an XML file.";
428 cmd2 no_return D.detach_device
429 (arg_full_connection domain_of_string) input_file,
430 s_ "Detach device from domain.";
432 cmd1 no_return D.destroy (arg_full_connection domain_of_string),
433 s_ "Destroy a domain.";
435 cmd2 print_block_stats D.block_stats
436 (arg_readonly_connection domain_of_string) string_of_string,
437 s_ "Display the block device statistics for a domain.";
439 cmd1 print_int D.get_id (arg_readonly_connection domain_of_string),
440 s_ "Print the ID of a domain.";
442 cmd2 print_interface_stats D.interface_stats
443 (arg_readonly_connection domain_of_string) string_of_string,
444 s_ "Display the network interface statistics for a domain.";
446 cmd1 print_domain_info D.get_info
447 (arg_readonly_connection domain_of_string),
448 s_ "Print the domain info.";
450 cmd1 print_int64 D.get_max_memory
451 (arg_readonly_connection domain_of_string),
452 s_ "Print the max memory (in kilobytes) of a domain.";
454 cmd1 print_int D.get_max_vcpus
455 (arg_readonly_connection domain_of_string),
456 s_ "Print the max VCPUs of a domain.";
458 cmd1 print_endline D.get_name
459 (arg_readonly_connection domain_of_string),
460 s_ "Print the name of a domain.";
462 cmd1 print_endline D.get_os_type
463 (arg_readonly_connection domain_of_string),
464 s_ "Print the OS type of a domain.";
466 cmd1 print_domain_state D.get_info
467 (arg_readonly_connection domain_of_string),
468 s_ "Print the domain state.";
470 cmd1 print_endline D.get_uuid_string
471 (arg_readonly_connection domain_of_string),
472 s_ "Print the UUID of a domain.";
474 cmd2 no_return D.core_dump
475 (arg_full_connection domain_of_string) string_of_string,
476 s_ "Core dump a domain to a file for analysis.";
478 cmd1 print_endline D.get_xml_desc
479 (arg_full_connection domain_of_string),
480 s_ "Print the XML description of a domain.";
482 cmd012 print_int64_array (
484 let conn = get_readonly_connection () in
485 match start, max with
487 [| C.node_get_free_memory conn |]
488 | Some start, None ->
489 C.node_get_cells_free_memory conn start 1
490 | Some start, Some max ->
491 C.node_get_cells_free_memory conn start max
492 ) int_of_string int_of_string,
493 s_ "Display free memory for machine, NUMA cell or range of cells";
495 cmd1 print_bool D.get_autostart
496 (arg_readonly_connection domain_of_string),
497 s_ "Print whether a domain autostarts at boot.";
499 cmd0 print_endline (with_readonly_connection C.get_hostname),
500 s_ "Print the hostname.";
502 cmd0 print_domain_array
504 let c = get_readonly_connection () in
505 let n = C.num_of_domains c in
506 let domids = C.list_domains c n in
507 Array.map (D.lookup_by_id c) domids),
508 s_ "List the running domains.";
510 cmd0 print_domain_array
512 let c = get_readonly_connection () in
513 let n = C.num_of_defined_domains c in
514 let domnames = C.list_defined_domains c n in
515 Array.map (D.lookup_by_name c) domnames),
516 s_ "List the defined but not running domains.";
518 cmd0 no_return (fun () -> exit 0),
519 s_ "Quit the interactive terminal.";
521 cmd0 print_int (fun () -> C.get_max_vcpus (get_readonly_connection ()) ()),
522 s_ "Print the max VCPUs available.";
524 cmd2 no_return N.set_autostart
525 (arg_full_connection network_of_string) boolean_of_string,
526 s_ "Set whether a network autostarts at boot.";
528 cmd1 print_endline N.get_bridge_name
529 (arg_readonly_connection network_of_string),
530 s_ "Print the bridge name of a network.";
533 (fun xml -> N.create_xml (get_full_connection ()) xml) input_file,
534 s_ "Create a network from an XML file.";
537 (fun xml -> N.define_xml (get_full_connection ()) xml) input_file,
538 s_ "Define (but don't start) a network from an XML file.";
540 cmd1 no_return N.destroy (arg_full_connection network_of_string),
541 s_ "Destroy a network.";
543 cmd1 print_endline N.get_xml_desc
544 (arg_full_connection network_of_string),
545 s_ "Print the XML description of a network.";
547 cmd1 print_bool N.get_autostart
548 (arg_full_connection network_of_string),
549 s_ "Print whether a network autostarts at boot.";
551 cmd0 print_network_array
553 let c = get_readonly_connection () in
554 let n = C.num_of_networks c in
555 let nets = C.list_networks c n in
556 Array.map (N.lookup_by_name c) nets),
557 s_ "List the active networks.";
559 cmd0 print_network_array
561 let c = get_readonly_connection () in
562 let n = C.num_of_defined_networks c in
563 let nets = C.list_defined_networks c n in
564 Array.map (N.lookup_by_name c) nets),
565 s_ "List the defined but inactive networks.";
567 cmd1 print_endline N.get_name
568 (arg_readonly_connection network_of_string),
569 s_ "Print the name of a network.";
571 cmd1 no_return N.create
572 (arg_full_connection network_of_string),
573 s_ "Start a previously defined inactive network.";
575 cmd1 no_return N.undefine
576 (arg_full_connection network_of_string),
577 s_ "Undefine an inactive network.";
579 cmd1 print_endline N.get_uuid_string
580 (arg_readonly_connection network_of_string),
581 s_ "Print the UUID of a network.";
583 cmd0 print_node_info (with_readonly_connection C.get_node_info),
584 s_ "Print node information.";
586 cmd1 no_return D.reboot (arg_full_connection domain_of_string),
587 s_ "Reboot a domain.";
590 fun path -> D.restore (get_full_connection ()) path
592 s_ "Restore a domain from the named file.";
594 cmd1 no_return D.resume (arg_full_connection domain_of_string),
595 s_ "Resume a domain.";
597 cmd2 no_return D.save
598 (arg_full_connection domain_of_string) string_of_string,
599 s_ "Save a domain to a file.";
601 cmd1 print_sched_param_array (
603 let n = snd (D.get_scheduler_type dom) in
604 D.get_scheduler_parameters dom n
605 ) (arg_readonly_connection domain_of_string),
606 s_ "Get the current scheduler parameters for a domain.";
610 | [] -> failwith (s_ "expecting domain followed by field value pairs")
612 let conn = get_full_connection () in
613 let dom = domain_of_string conn dom in
614 let params = parse_sched_params pairs in
615 let params = Array.of_list params in
616 D.set_scheduler_parameters dom params
618 s_ "Set the scheduler parameters for a domain.";
621 (fun dom -> fst (D.get_scheduler_type dom))
622 (arg_readonly_connection domain_of_string),
623 s_ "Get the scheduler type.";
625 cmd2 no_return D.set_memory
626 (arg_full_connection domain_of_string) Int64.of_string,
627 s_ "Set the memory used by the domain (in kilobytes).";
629 cmd2 no_return D.set_max_memory
630 (arg_full_connection domain_of_string) Int64.of_string,
631 s_ "Set the maximum memory used by the domain (in kilobytes).";
633 cmd1 no_return D.shutdown
634 (arg_full_connection domain_of_string),
635 s_ "Gracefully shutdown a domain.";
637 cmd1 no_return D.create
638 (arg_full_connection domain_of_string),
639 s_ "Start a previously defined inactive domain.";
641 cmd1 no_return D.suspend
642 (arg_full_connection domain_of_string),
643 s_ "Suspend a domain.";
645 cmd0 print_endline (with_readonly_connection C.get_type),
646 s_ "Print the driver name";
648 cmd1 no_return D.undefine
649 (arg_full_connection domain_of_string),
650 s_ "Undefine an inactive domain.";
652 cmd0 print_endline (with_readonly_connection C.get_uri),
653 s_ "Print the canonical URI.";
655 cmd1 print_vcpu_info (
657 let c = get_readonly_connection () in
658 let info = C.get_node_info c in
659 let dominfo = D.get_info dom in
660 let maxcpus = C.maxcpus_of_node_info info in
661 let maplen = C.cpumaplen maxcpus in
662 let maxinfo = dominfo.D.nr_virt_cpu in
663 let ncpus, vcpu_infos, cpumaps = D.get_vcpus dom maxinfo maplen in
664 ncpus, vcpu_infos, cpumaps, maplen, maxcpus
665 ) (arg_readonly_connection domain_of_string),
666 s_ "Pin domain VCPU to a list of physical CPUs.";
668 cmd3 no_return D.pin_vcpu
669 (arg_full_connection domain_of_string) int_of_string cpumap_of_string,
670 s_ "Pin domain VCPU to a list of physical CPUs.";
672 cmd2 no_return D.set_vcpus
673 (arg_full_connection domain_of_string) int_of_string,
674 s_ "Set the number of virtual CPUs assigned to a domain.";
676 cmd0 print_version (with_readonly_connection C.get_version),
677 s_ "Print the driver version";
682 | None -> (* List of commands. *)
685 fun (cmd, _, description) ->
686 sprintf "%-12s %s" cmd description
690 (sprintf (f_ "Use '%s help command' for help on a command.")
693 | Some command -> (* Full description of one command. *)
695 let (command, _, description) =
696 List.find (fun (c, _, _) -> c = command) commands in
697 sprintf "%s %s\n\n%s" program_name command description
700 failwith (sprintf (f_ "help: %s: command not found") command);
705 cmd01 print_endline help string_of_string,
706 s_ "Print list of commands or full description of one command.";
709 (* Execute a command. *)
710 let do_command command args =
712 let (_, cmd, _) = List.find (fun (c, _, _) -> c = command) commands in
716 failwith (sprintf (f_ "%s: command not found") command);
721 (* Interactive mode. *)
722 let rec interactive_mode () =
725 | No_connection -> s_ "mlvirsh(no connection)" ^ "$ "
726 | RO _ -> s_ "mlvirsh(ro)" ^ "$ "
727 | RW _ -> s_ "mlvirsh" ^ "# " in
729 let command = read_line () in
730 (match str_nsplit command " " with
733 do_command command args
735 Gc.full_major (); (* Free up all unreachable domain and network objects. *)
738 (* Connect to hypervisor. Allow the connection to fail. *)
742 if readonly then RO (C.connect_readonly ?name ())
743 else RW (C.connect ?name ())
745 Libvirt.Virterror err ->
746 eprintf "%s: %s\n" program_name (Libvirt.Virterror.to_string err);
751 (* Execute the command on the command line, if there was one.
752 * Otherwise go into interactive mode.
754 (match extra_args with
756 do_command command args
758 try interactive_mode () with End_of_file -> ()
761 (* If we are connected to a hypervisor, close the connection. *)
764 (* A good way to find heap bugs: *)
767 | Libvirt.Virterror err ->
768 eprintf "%s: %s\n" program_name (Libvirt.Virterror.to_string err)
770 eprintf "%s: %s\n" program_name msg