1 (* virsh-like command line tool.
2 (C) Copyright 2007-2008 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";
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 cmd4 print fn arg1 arg2 arg3 arg4 = function (* Command with 4 args. *)
175 | [str1; str2; str3; str4] ->
176 print (fn (arg1 str1) (arg2 str2) (arg3 str3) (arg4 str4))
177 | _ -> failwith (s_"incorrect number of arguments for function")
179 let cmd01 print fn arg1 = function (* Command with 0 or 1 arg. *)
180 | [] -> print (fn None)
181 | [str1] -> print (fn (Some (arg1 str1)))
182 | _ -> failwith (s_"incorrect number of arguments for function")
184 let cmd12 print fn arg1 arg2 = function (* Command with 1 or 2 args. *)
185 | [str1] -> print (fn (arg1 str1) None)
186 | [str1; str2] -> print (fn (arg1 str1) (Some (arg2 str2)))
187 | _ -> failwith (s_"incorrect number of arguments for function")
189 let cmd012 print fn arg1 arg2 = function (* Command with 0, 1 or 2 args. *)
190 | [] -> print (fn None None)
191 | [str1] -> print (fn (Some (arg1 str1)) None)
192 | [str1; str2] -> print (fn (Some (arg1 str1)) (Some (arg2 str2)))
193 | _ -> failwith (s_"incorrect number of arguments for function")
195 let cmdN print fn = (* Command with any number of args. *)
196 fun args -> print (fn args)
199 (* Get the connection or fail if we don't have one. *)
200 let rec get_full_connection () =
202 | No_connection -> failwith (s_"not connected to the hypervisor")
203 | RO _ -> failwith (s_"tried to do read-write operation on read-only hypervisor connection")
205 and get_readonly_connection () =
207 | No_connection -> failwith (s_"not connected to the hypervisor")
209 | RW conn -> C.const conn
211 and with_full_connection fn =
212 fun () -> fn (get_full_connection ())
214 and with_readonly_connection fn =
215 fun () -> fn (get_readonly_connection ())
216 and arg_full_connection fn =
217 fun str -> fn (get_full_connection ()) str
218 and arg_readonly_connection fn =
219 fun str -> fn (get_readonly_connection ()) str
222 (* Parsing of command arguments. *)
223 let string_of_readonly = function
224 | "readonly" | "read-only" | "ro" -> true
225 | _ -> failwith (sprintf (f_"flag should be '%s'") "readonly")
227 let string_of_string (str : string) = str in
228 let boolean_of_string = function
229 | "enable" | "enabled" | "on" | "1" | "true" -> true
230 | "disable" | "disabled" | "off" | "0" | "false" -> false
231 | _ -> failwith (sprintf (f_"setting should be '%s' or '%s'") "on" "off")
233 let domain_of_string conn str =
236 let id = int_of_string str in
237 D.lookup_by_id conn id
239 Failure "int_of_string" ->
240 if String.length str = Libvirt.uuid_string_length then
241 D.lookup_by_uuid_string conn str
243 D.lookup_by_name conn str
246 Libvirt.Virterror err ->
247 failwith (sprintf (f_"domain %s: not found. Additional info: %s")
248 str (Libvirt.Virterror.to_string err));
250 let network_of_string conn str =
252 if String.length str = Libvirt.uuid_string_length then
253 N.lookup_by_uuid_string conn str
255 N.lookup_by_name conn str
257 Libvirt.Virterror err ->
258 failwith (sprintf (f_"network %s: not found. Additional info: %s")
259 str (Libvirt.Virterror.to_string err));
261 let rec parse_sched_params = function
263 | [_] -> failwith (s_"expected field value pairs, but got an odd number of arguments")
264 | field :: value :: rest ->
265 (* XXX We only support the UINT type at the moment. *)
266 (field, D.SchedFieldUInt32 (Int32.of_string value))
267 :: parse_sched_params rest
269 let cpumap_of_string str =
270 let c = get_readonly_connection () in
271 let info = C.get_node_info c in
273 String.make (C.cpumaplen (C.maxcpus_of_node_info info)) '\000' in
274 List.iter (C.use_cpu cpumap)
275 (List.map int_of_string (str_nsplit str ","));
279 (* Printing of command results. *)
280 let no_return _ = () in
281 let print_int i = print_endline (string_of_int i) in
282 let print_int64 i = print_endline (Int64.to_string i) in
283 let print_int64_array a = Array.iter print_int64 a in
284 let print_bool b = print_endline (string_of_bool b) in
285 let print_version v =
286 let major = v / 1000000 in
287 let minor = (v - major * 1000000) / 1000 in
288 let release = (v - major * 1000000 - minor * 1000) in
289 printf "%d.%d.%d\n" major minor release
291 let string_of_domain_state = function
292 | D.InfoNoState -> s_"unknown"
293 | D.InfoRunning -> s_"running"
294 | D.InfoBlocked -> s_"blocked"
295 | D.InfoPaused -> s_"paused"
296 | D.InfoShutdown -> s_"shutdown"
297 | D.InfoShutoff -> s_"shutoff"
298 | D.InfoCrashed -> s_"crashed"
300 let string_of_vcpu_state = function
301 | D.VcpuOffline -> s_"offline"
302 | D.VcpuRunning -> s_"running"
303 | D.VcpuBlocked -> s_"blocked"
305 let print_domain_array doms =
309 try sprintf "%d" (D.get_id dom)
310 with Libvirt.Virterror _ -> "" in
312 try sprintf "%s" (D.get_name dom)
313 with Libvirt.Virterror _ -> "" in
316 let { D.state = state } = D.get_info dom in
317 string_of_domain_state state
318 with Libvirt.Virterror _ -> "" in
319 printf "%5s %-30s %s\n" id name state
322 let print_network_array nets =
325 printf "%s\n" (N.get_name net)
328 let print_node_info info =
329 let () = printf (f_"model: %s\n") info.C.model in
330 let () = printf (f_"memory: %Ld K\n") info.C.memory in
331 let () = printf (f_"cpus: %d\n") info.C.cpus in
332 let () = printf (f_"mhz: %d\n") info.C.mhz in
333 let () = printf (f_"nodes: %d\n") info.C.nodes in
334 let () = printf (f_"sockets: %d\n") info.C.sockets in
335 let () = printf (f_"cores: %d\n") info.C.cores in
336 let () = printf (f_"threads: %d\n") info.C.threads in
339 let print_domain_state { D.state = state } =
340 print_endline (string_of_domain_state state)
342 let print_domain_info info =
343 let () = printf (f_"state: %s\n") (string_of_domain_state info.D.state) in
344 let () = printf (f_"max_mem: %Ld K\n") info.D.max_mem in
345 let () = printf (f_"memory: %Ld K\n") info.D.memory in
346 let () = printf (f_"nr_virt_cpu: %d\n") info.D.nr_virt_cpu in
347 let () = printf (f_"cpu_time: %Ld ns\n") info.D.cpu_time in
350 let print_sched_param_array params =
355 | D.SchedFieldInt32 i -> printf " %ld\n" i
356 | D.SchedFieldUInt32 i -> printf " %lu\n" i
357 | D.SchedFieldInt64 i -> printf " %Ld\n" i
358 | D.SchedFieldUInt64 i -> printf " %Lu\n" i
359 | D.SchedFieldFloat f -> printf " %g\n" f
360 | D.SchedFieldBool b -> printf " %b\n" b
363 let print_vcpu_info (ncpus, vcpu_infos, cpumaps, maplen, maxcpus) =
364 for n = 0 to ncpus-1 do
365 let () = printf (f_"virtual CPU: %d\n") n in
366 let () = printf (f_"\ton physical CPU: %d\n") vcpu_infos.(n).D.cpu in
367 let () = printf (f_"\tcurrent state: %s\n")
368 (string_of_vcpu_state vcpu_infos.(n).D.vcpu_state) in
369 let () = printf (f_"\tCPU time: %Ld ns\n") vcpu_infos.(n).D.vcpu_time in
370 print_string ("\t" ^ s_"CPU affinity" ^ ": ");
371 for m = 0 to maxcpus-1 do
372 print_char (if C.cpu_usable cpumaps maplen n m then 'y' else '-')
377 let print_block_stats { D.rd_req = rd_req; rd_bytes = rd_bytes;
378 wr_req = wr_req; wr_bytes = wr_bytes;
380 if rd_req >= 0L then printf (f_"read requests: %Ld\n") rd_req;
381 if rd_bytes >= 0L then printf (f_"read bytes: %Ld\n") rd_bytes;
382 if wr_req >= 0L then printf (f_"write requests: %Ld\n") wr_req;
383 if wr_bytes >= 0L then printf (f_"write bytes: %Ld\n") wr_bytes;
384 if errs >= 0L then printf (f_"errors: %Ld\n") errs;
385 and print_interface_stats { D.rx_bytes = rx_bytes; rx_packets = rx_packets;
386 rx_errs = rx_errs; rx_drop = rx_drop;
387 tx_bytes = tx_bytes; tx_packets = tx_packets;
388 tx_errs = tx_errs; tx_drop = tx_drop } =
389 if rx_bytes >= 0L then printf (f_"rx bytes: %Ld\n") rx_bytes;
390 if rx_packets >= 0L then printf (f_"rx packets: %Ld\n") rx_packets;
391 if rx_errs >= 0L then printf (f_"rx errs: %Ld\n") rx_errs;
392 if rx_drop >= 0L then printf (f_"rx dropped: %Ld\n") rx_drop;
393 if tx_bytes >= 0L then printf (f_"tx bytes: %Ld\n") tx_bytes;
394 if tx_packets >= 0L then printf (f_"tx packets: %Ld\n") tx_packets;
395 if tx_errs >= 0L then printf (f_"tx errs: %Ld\n") tx_errs;
396 if tx_drop >= 0L then printf (f_"tx dropped: %Ld\n") tx_drop;
399 (* Help for domain, network parameters. *)
400 let dom_help = s_"dom", s_"domain ID or name" in
401 let net_help = s_"net", s_"network ID or name" in
402 let readonly_help = s_"readonly|ro", s_"if given, connect read-only" in
404 (* List of commands. *)
407 cmd2 no_return D.attach_device
408 (arg_full_connection domain_of_string) input_file,
409 s_"Attach device to domain.",
410 [dom_help; s_"file",s_"XML file describing device"];
412 cmd2 no_return D.set_autostart
413 (arg_full_connection domain_of_string) boolean_of_string,
414 s_"Set whether a domain autostarts at boot.",
415 [dom_help; "on|off",s_"new autostart status of domain"];
417 cmd0 print_endline (with_readonly_connection C.get_capabilities),
418 s_"Returns capabilities of hypervisor/driver.",
421 cmd0 no_return close_connection,
422 s_"Close an existing hypervisor connection.",
426 (fun name readonly ->
429 | None | Some false -> conn := RW (C.connect ~name ())
430 | Some true -> conn := RO (C.connect_readonly ~name ())
431 ) string_of_string string_of_readonly,
432 s_"Open a new hypervisor connection.",
433 [s_"uri", s_"connection URI"; readonly_help];
436 (fun xml -> D.create_linux (get_full_connection ()) xml) input_file,
437 s_"Create a domain from an XML file.",
438 [s_"file",s_"domain XML file"];
441 (fun xml -> D.define_xml (get_full_connection ()) xml) input_file,
442 s_"Define (but don't start) a domain from an XML file.",
443 [s_"file",s_"domain XML file"];
445 cmd2 no_return D.detach_device
446 (arg_full_connection domain_of_string) input_file,
447 s_"Detach device from domain.",
448 [dom_help; s_"file",s_"XML file describing device"];
450 cmd1 no_return D.destroy (arg_full_connection domain_of_string),
451 s_"Destroy a domain.",
455 (fun dom path offset size ->
456 let buf = String.create size in
457 D.block_peek dom path offset size buf 0;
459 (arg_readonly_connection domain_of_string)
460 string_of_string Int64.of_string int_of_string,
461 s_"Peek into a block device of a domain.",
462 [dom_help; s_"path",s_"Path to block device";
463 s_"offset",s_"Offset in device"; s_"size",s_"Size in bytes to read"];
465 cmd2 print_block_stats D.block_stats
466 (arg_readonly_connection domain_of_string) string_of_string,
467 s_"Display the block device statistics for a domain.",
468 [dom_help; s_"path",s_"Path to block device"];
470 cmd1 print_int D.get_id (arg_readonly_connection domain_of_string),
471 s_"Print the ID of a domain.",
474 cmd2 print_interface_stats D.interface_stats
475 (arg_readonly_connection domain_of_string) string_of_string,
476 s_"Display the network interface statistics for a domain.",
477 [dom_help; s_"path",s_"Path or name of network interface"];
479 cmd1 print_domain_info D.get_info
480 (arg_readonly_connection domain_of_string),
481 s_"Print the domain info.",
484 cmd1 print_int64 D.get_max_memory
485 (arg_readonly_connection domain_of_string),
486 s_"Print the max memory (in kilobytes) of a domain.",
489 cmd1 print_int D.get_max_vcpus
490 (arg_readonly_connection domain_of_string),
491 s_"Print the max VCPUs of a domain.",
495 (fun dom offset size ->
496 let buf = String.create size in
497 D.memory_peek dom [D.Virtual] offset size buf 0;
499 (arg_readonly_connection domain_of_string)
500 Int64.of_string int_of_string,
501 s_"Peek into memory of a device.",
502 [dom_help; s_"offset",s_"Offset in memory";
503 s_"size",s_"Size in bytes to read"];
505 cmd1 print_endline D.get_name
506 (arg_readonly_connection domain_of_string),
507 s_"Print the name of a domain.",
510 cmd1 print_endline D.get_os_type
511 (arg_readonly_connection domain_of_string),
512 s_"Print the OS type of a domain.",
515 cmd1 print_domain_state D.get_info
516 (arg_readonly_connection domain_of_string),
517 s_"Print the domain state.",
520 cmd1 print_endline D.get_uuid_string
521 (arg_readonly_connection domain_of_string),
522 s_"Print the UUID of a domain.",
525 cmd2 no_return D.core_dump
526 (arg_full_connection domain_of_string) string_of_string,
527 s_"Core dump a domain to a file for analysis.",
528 [dom_help; s_"file",s_"Output filename"];
530 cmd1 print_endline D.get_xml_desc
531 (arg_full_connection domain_of_string),
532 s_"Print the XML description of a domain.",
535 cmd012 print_int64_array (
537 let conn = get_readonly_connection () in
538 match start, max with
540 [| C.node_get_free_memory conn |]
541 | Some start, None ->
542 C.node_get_cells_free_memory conn start 1
543 | Some start, Some max ->
544 C.node_get_cells_free_memory conn start max
545 ) int_of_string int_of_string,
546 s_"Display free memory for machine, NUMA cell or range of cells",
547 [s_"start",s_"Start cell (optional)";
548 s_"max",s_"Maximum cells to display (optional)"];
550 cmd1 print_bool D.get_autostart
551 (arg_readonly_connection domain_of_string),
552 s_"Print whether a domain autostarts at boot.",
555 cmd0 print_endline (with_readonly_connection C.get_hostname),
556 s_"Print the hostname.",
559 cmd0 print_domain_array
561 let c = get_readonly_connection () in
562 let n = C.num_of_domains c in
563 let domids = C.list_domains c n in
564 Array.map (D.lookup_by_id c) domids),
565 s_"List the running domains.",
568 cmd0 print_domain_array
570 let c = get_readonly_connection () in
571 let n = C.num_of_defined_domains c in
572 let domnames = C.list_defined_domains c n in
573 Array.map (D.lookup_by_name c) domnames),
574 s_"List the defined but not running domains.",
577 cmd0 no_return (fun () -> exit 0),
578 s_"Quit the interactive terminal.",
582 (fun () -> C.get_max_vcpus (get_readonly_connection ()) ()),
583 s_"Print the max VCPUs available.",
586 cmd2 no_return N.set_autostart
587 (arg_full_connection network_of_string) boolean_of_string,
588 s_"Set whether a network autostarts at boot.",
589 [net_help; "on|off", s_"new autostart status of network"];
591 cmd1 print_endline N.get_bridge_name
592 (arg_readonly_connection network_of_string),
593 s_"Print the bridge name of a network.",
597 (fun xml -> N.create_xml (get_full_connection ()) xml) input_file,
598 s_"Create a network from an XML file.",
599 [s_"file",s_"XML file describing network"];
602 (fun xml -> N.define_xml (get_full_connection ()) xml) input_file,
603 s_"Define (but don't start) a network from an XML file.",
604 [s_"file",s_"XML file describing network"];
606 cmd1 no_return N.destroy (arg_full_connection network_of_string),
607 s_"Destroy a network.",
610 cmd1 print_endline N.get_xml_desc
611 (arg_full_connection network_of_string),
612 s_"Print the XML description of a network.",
615 cmd1 print_bool N.get_autostart
616 (arg_full_connection network_of_string),
617 s_"Print whether a network autostarts at boot.",
620 cmd0 print_network_array
622 let c = get_readonly_connection () in
623 let n = C.num_of_networks c in
624 let nets = C.list_networks c n in
625 Array.map (N.lookup_by_name c) nets),
626 s_"List the active networks.",
629 cmd0 print_network_array
631 let c = get_readonly_connection () in
632 let n = C.num_of_defined_networks c in
633 let nets = C.list_defined_networks c n in
634 Array.map (N.lookup_by_name c) nets),
635 s_"List the defined but inactive networks.",
638 cmd1 print_endline N.get_name
639 (arg_readonly_connection network_of_string),
640 s_"Print the name of a network.",
643 cmd1 no_return N.create
644 (arg_full_connection network_of_string),
645 s_"Start a previously defined inactive network.",
648 cmd1 no_return N.undefine
649 (arg_full_connection network_of_string),
650 s_"Undefine an inactive network.",
653 cmd1 print_endline N.get_uuid_string
654 (arg_readonly_connection network_of_string),
655 s_"Print the UUID of a network.",
658 cmd0 print_node_info (with_readonly_connection C.get_node_info),
659 s_"Print node information.",
662 cmd1 no_return D.reboot (arg_full_connection domain_of_string),
663 s_"Reboot a domain.",
667 fun path -> D.restore (get_full_connection ()) path
669 s_"Restore a domain from the named file.",
670 [dom_help; s_"file",s_"Domain image file"];
672 cmd1 no_return D.resume (arg_full_connection domain_of_string),
673 s_"Resume a domain.",
676 cmd2 no_return D.save
677 (arg_full_connection domain_of_string) string_of_string,
678 s_"Save a domain to a file.",
679 [dom_help; s_"file",s_"Domain image file"];
681 cmd1 print_sched_param_array (
683 let n = snd (D.get_scheduler_type dom) in
684 D.get_scheduler_parameters dom n
685 ) (arg_readonly_connection domain_of_string),
686 s_"Get the current scheduler parameters for a domain.",
691 | [] -> failwith (s_"expecting domain followed by field value pairs")
693 let conn = get_full_connection () in
694 let dom = domain_of_string conn dom in
695 let params = parse_sched_params pairs in
696 let params = Array.of_list params in
697 D.set_scheduler_parameters dom params
699 s_"Set the scheduler parameters for a domain.",
703 (fun dom -> fst (D.get_scheduler_type dom))
704 (arg_readonly_connection domain_of_string),
705 s_"Get the scheduler type.",
708 cmd2 no_return D.set_memory
709 (arg_full_connection domain_of_string) Int64.of_string,
710 s_"Set the memory used by the domain (in kilobytes).",
711 [dom_help; s_"mem",s_"memory to use (in KB)"];
713 cmd2 no_return D.set_max_memory
714 (arg_full_connection domain_of_string) Int64.of_string,
715 s_"Set the maximum memory used by the domain (in kilobytes).",
716 [dom_help; s_"mem",s_"maximum memory to use (in KB)"];
718 cmd1 no_return D.shutdown
719 (arg_full_connection domain_of_string),
720 s_"Gracefully shutdown a domain.",
723 cmd1 no_return D.create
724 (arg_full_connection domain_of_string),
725 s_"Start a previously defined inactive domain.",
728 cmd1 no_return D.suspend
729 (arg_full_connection domain_of_string),
730 s_"Suspend a domain.",
733 cmd0 print_endline (with_readonly_connection C.get_type),
734 s_"Print the driver name",
737 cmd1 no_return D.undefine
738 (arg_full_connection domain_of_string),
739 s_"Undefine an inactive domain.",
742 cmd0 print_endline (with_readonly_connection C.get_uri),
743 s_"Print the canonical URI.",
746 cmd1 print_vcpu_info (
748 let c = get_readonly_connection () in
749 let info = C.get_node_info c in
750 let dominfo = D.get_info dom in
751 let maxcpus = C.maxcpus_of_node_info info in
752 let maplen = C.cpumaplen maxcpus in
753 let maxinfo = dominfo.D.nr_virt_cpu in
754 let ncpus, vcpu_infos, cpumaps = D.get_vcpus dom maxinfo maplen in
755 ncpus, vcpu_infos, cpumaps, maplen, maxcpus
756 ) (arg_readonly_connection domain_of_string),
757 s_"Pin domain VCPU to a list of physical CPUs.",
760 cmd3 no_return D.pin_vcpu
761 (arg_full_connection domain_of_string) int_of_string cpumap_of_string,
762 s_"Pin domain VCPU to a list of physical CPUs.",
763 [dom_help; s_"vcpu",s_"Virtual CPU number";
764 s_"pcpus",s_"Comma-separated list of physical CPUs"];
766 cmd2 no_return D.set_vcpus
767 (arg_full_connection domain_of_string) int_of_string,
768 s_"Set the number of virtual CPUs assigned to a domain.",
769 [dom_help; s_"nrvcpus",s_"Number of virtual CPUs"];
771 cmd0 print_version (with_readonly_connection C.get_version),
772 s_"Print the driver version",
778 | None -> (* List of commands. *)
781 fun (cmd, _, description, _) ->
782 sprintf "%-16s %s" cmd description
786 sprintf (f_"Use '%s help command' for help on a command.")
789 | Some command -> (* Full description of one command. *)
791 let command, _, description, args =
792 List.find (fun (c, _, _, _) -> c = command) commands in
794 let arg_names = String.concat " " (List.map fst args) in
798 fun (name, help) -> sprintf " %-12s %s\n" name help
801 sprintf "%s %s %s\n\n%s\n\n%s"
802 program_name command arg_names description args
805 sprintf (f_"help: %s: command not found\n") command;
810 cmd01 print_string help string_of_string,
811 s_"Print list of commands or full description of one command.",
812 [s_"cmd",s_"Show help for 'mlvirsh cmd' (optional)"];
815 (* Execute a command. *)
816 let do_command command args =
819 List.find (fun (c, _, _, _) -> c = command) commands in
823 failwith (sprintf (f_"%s: command not found") command);
828 (* Interactive mode. *)
829 let rec interactive_mode () =
832 | No_connection -> s_"mlvirsh(no connection)" ^ "$ "
833 | RO _ -> s_"mlvirsh(ro)" ^ "$ "
834 | RW _ -> s_"mlvirsh" ^ "# " in
836 let command = read_line () in
837 (match str_nsplit command " " with
840 do_command command args
842 Gc.full_major (); (* Free up all unreachable domain and network objects. *)
845 (* Connect to hypervisor. Allow the connection to fail. *)
849 if readonly then RO (C.connect_readonly ?name ())
850 else RW (C.connect ?name ())
852 Libvirt.Virterror err ->
853 eprintf "%s: %s\n" program_name (Libvirt.Virterror.to_string err);
858 (* Execute the command on the command line, if there was one.
859 * Otherwise go into interactive mode.
861 (match extra_args with
863 do_command command args
865 try interactive_mode () with End_of_file -> ()
868 (* If we are connected to a hypervisor, close the connection. *)
871 (* A good way to find heap bugs: *)
874 | Libvirt.Virterror err ->
875 eprintf "%s: %s\n" program_name (Libvirt.Virterror.to_string err)
877 eprintf "%s: %s\n" program_name msg