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.
22 module C = Libvirt.Connect
23 module D = Libvirt.Domain
24 module N = Libvirt.Network
27 let program_name = Filename.basename Sys.executable_name
29 (* Parse arguments. *)
31 let readonly = ref false
33 let argspec = Arg.align [
34 "-c", Arg.Set_string name, "URI Hypervisor connection URI";
35 "-r", Arg.Set readonly, " Read-only connection";
40 " ^ program_name ^ " [options] [command]
43 " ^ program_name ^ " help
45 Full description of a single command:
46 " ^ program_name ^ " help command
50 let add_extra_arg, get_extra_args =
51 let extra_args = ref [] in
52 let add_extra_arg s = extra_args := s :: !extra_args in
53 let get_extra_args () = List.rev !extra_args in
54 add_extra_arg, get_extra_args
56 let () = Arg.parse argspec add_extra_arg usage_msg
58 let name = match !name with "" -> None | name -> Some name
59 let readonly = !readonly
60 let extra_args = get_extra_args ()
62 (* Read a whole file into memory and return it (as a string). *)
63 let rec input_file filename =
64 let chan = open_in_bin filename in
65 let data = input_all chan in
69 let buf = Buffer.create 16384 in
70 let tmpsize = 16384 in
71 let tmp = String.create tmpsize in
73 while n := input chan tmp 0 tmpsize; !n > 0 do
74 Buffer.add_substring buf tmp 0 !n;
78 (* Split a string at a separator.
79 * Functions copied from extlib Copyright (C) 2003 Nicolas Cannasse et al.
80 * to avoid the explicit dependency on extlib.
82 let str_find str sub =
83 let sublen = String.length sub in
88 let len = String.length str in
90 for i = 0 to len - sublen do
92 while String.unsafe_get str (i + !j) = String.unsafe_get sub !j do
94 if !j = sublen then begin found := i; raise Exit; end;
101 let str_split str sep =
102 let p = str_find str sep in
103 let len = String.length sep in
104 let slen = String.length str in
105 String.sub str 0 p, String.sub str (p + len) (slen - p - len)
107 let str_nsplit str sep =
110 let rec nsplit str sep =
112 let s1 , s2 = str_split str sep in
120 (* Hypervisor connection. *)
121 type conn_t = No_connection | RO of Libvirt.ro C.t | RW of Libvirt.rw C.t
122 let conn = ref No_connection
124 let close_connection () =
126 | No_connection -> ()
129 conn := No_connection
132 conn := No_connection
135 (* Command helper functions.
137 * Each cmd<n> is a function that constructs a command.
138 * string string string ... <--- user types on the command line
140 * arg1 arg2 arg3 ... <--- conversion functions
143 * function f <--- work function
146 * print result <--- printing function
148 * (Note that cmd<n> function constructs and returns the above
149 * function, it isn't the function itself.)
151 * Example: If the function takes one parameter (an int) and
152 * returns a string to be printed, you would use:
154 * cmd1 print_endline f int_of_string
156 let cmd0 print fn = function (* Command with no args. *)
157 | [] -> print (fn ())
158 | _ -> failwith "incorrect number of arguments for function"
160 let cmd1 print fn arg1 = function (* Command with one arg. *)
161 | [str1] -> print (fn (arg1 str1))
162 | _ -> failwith "incorrect number of arguments for function"
164 let cmd2 print fn arg1 arg2 = function (* Command with 2 args. *)
165 | [str1; str2] -> print (fn (arg1 str1) (arg2 str2))
166 | _ -> failwith "incorrect number of arguments for function"
168 let cmd3 print fn arg1 arg2 arg3 = function (* Command with 3 args. *)
169 | [str1; str2; str3] -> print (fn (arg1 str1) (arg2 str2) (arg3 str3))
170 | _ -> failwith "incorrect number of arguments for function"
172 let cmd01 print fn arg1 = function (* Command with 0 or 1 arg. *)
173 | [] -> print (fn None)
174 | [str1] -> print (fn (Some (arg1 str1)))
175 | _ -> failwith "incorrect number of arguments for function"
177 let cmd12 print fn arg1 arg2 = function (* Command with 1 or 2 args. *)
178 | [str1] -> print (fn (arg1 str1) None)
179 | [str1; str2] -> print (fn (arg1 str1) (Some (arg2 str2)))
180 | _ -> failwith "incorrect number of arguments for function"
182 let cmd012 print fn arg1 arg2 = function (* Command with 0, 1 or 2 args. *)
183 | [] -> print (fn None None)
184 | [str1] -> print (fn (Some (arg1 str1)) None)
185 | [str1; str2] -> print (fn (Some (arg1 str1)) (Some (arg2 str2)))
186 | _ -> failwith "incorrect number of arguments for function"
188 let cmdN print fn = (* Command with any number of args. *)
189 fun args -> print (fn args)
192 (* Get the connection or fail if we don't have one. *)
193 let rec get_full_connection () =
195 | No_connection -> failwith "not connected to the hypervisor"
196 | RO _ -> failwith "tried to do read-write operation on read-only hypervisor connection"
198 and get_readonly_connection () =
200 | No_connection -> failwith "not connected to the hypervisor"
202 | RW conn -> C.const conn
204 and with_full_connection fn =
205 fun () -> fn (get_full_connection ())
207 and with_readonly_connection fn =
208 fun () -> fn (get_readonly_connection ())
209 and arg_full_connection fn =
210 fun str -> fn (get_full_connection ()) str
211 and arg_readonly_connection fn =
212 fun str -> fn (get_readonly_connection ()) str
215 (* Parsing of command arguments. *)
216 let string_of_readonly = function
217 | "readonly" | "read-only" | "ro" -> true
218 | _ -> failwith "flag should be 'readonly'"
220 let string_of_string (str : string) = str in
221 let boolean_of_string = function
222 | "enable" | "enabled" | "on" | "1" | "true" -> true
223 | "disable" | "disabled" | "off" | "0" | "false" -> false
224 | _ -> failwith "setting should be 'on' or 'off'"
226 let domain_of_string conn str =
229 let id = int_of_string str in
230 D.lookup_by_id conn id
232 Failure "int_of_string" ->
233 if String.length str = Libvirt.uuid_string_length then
234 D.lookup_by_uuid_string conn str
236 D.lookup_by_name conn str
239 Libvirt.Virterror err ->
240 failwith ("domain " ^ str ^ ": not found. Additional info: " ^
241 Libvirt.Virterror.to_string err);
243 let network_of_string conn str =
245 if String.length str = Libvirt.uuid_string_length then
246 N.lookup_by_uuid_string conn str
248 N.lookup_by_name conn str
250 Libvirt.Virterror err ->
251 failwith ("network " ^ str ^ ": not found. Additional info: " ^
252 Libvirt.Virterror.to_string err);
254 let rec parse_sched_params = function
256 | [_] -> failwith "expected field value pairs, but got an odd number of arguments"
257 | field :: value :: rest ->
258 (* XXX We only support the UINT type at the moment. *)
259 (field, D.SchedFieldUInt32 (Int32.of_string value))
260 :: parse_sched_params rest
262 let cpumap_of_string str =
263 let c = get_readonly_connection () in
264 let info = C.get_node_info c in
266 String.make (C.cpumaplen (C.maxcpus_of_node_info info)) '\000' in
267 List.iter (C.use_cpu cpumap)
268 (List.map int_of_string (str_nsplit str ","));
272 (* Printing of command results. *)
273 let no_return _ = () in
274 let print_int i = print_endline (string_of_int i) in
275 let print_int64 i = print_endline (Int64.to_string i) in
276 let print_int64_array a = Array.iter print_int64 a in
277 let print_bool b = print_endline (string_of_bool b) in
278 let print_version v =
279 let major = v / 1000000 in
280 let minor = (v - major * 1000000) / 1000 in
281 let release = (v - major * 1000000 - minor * 1000) in
282 printf "%d.%d.%d\n" major minor release
284 let string_of_domain_state = function
285 | D.InfoNoState -> "unknown"
286 | D.InfoRunning -> "running"
287 | D.InfoBlocked -> "blocked"
288 | D.InfoPaused -> "paused"
289 | D.InfoShutdown -> "shutdown"
290 | D.InfoShutoff -> "shutoff"
291 | D.InfoCrashed -> "crashed"
293 let string_of_vcpu_state = function
294 | D.VcpuOffline -> "offline"
295 | D.VcpuRunning -> "running"
296 | D.VcpuBlocked -> "blocked"
298 let print_domain_array doms =
302 try sprintf "%d" (D.get_id dom)
303 with Libvirt.Virterror _ -> "" in
305 try sprintf "%s" (D.get_name dom)
306 with Libvirt.Virterror _ -> "" in
309 let { D.state = state } = D.get_info dom in
310 string_of_domain_state state
311 with Libvirt.Virterror _ -> "" in
312 printf "%5s %-30s %s\n" id name state
315 let print_network_array nets =
318 printf "%s\n" (N.get_name net)
321 let print_node_info info =
322 printf "model: %s\n" info.C.model;
323 printf "memory: %Ld K\n" info.C.memory;
324 printf "cpus: %d\n" info.C.cpus;
325 printf "mhz: %d\n" info.C.mhz;
326 printf "nodes: %d\n" info.C.nodes;
327 printf "sockets: %d\n" info.C.sockets;
328 printf "cores: %d\n" info.C.cores;
329 printf "threads: %d\n" info.C.threads;
331 let print_domain_state { D.state = state } =
332 print_endline (string_of_domain_state state)
334 let print_domain_info info =
335 printf "state: %s\n" (string_of_domain_state info.D.state);
336 printf "max_mem: %Ld K\n" info.D.max_mem;
337 printf "memory: %Ld K\n" info.D.memory;
338 printf "nr_virt_cpu: %d\n" info.D.nr_virt_cpu;
339 printf "cpu_time: %Ld ns\n" info.D.cpu_time;
341 let print_sched_param_array params =
346 | D.SchedFieldInt32 i -> printf " %ld\n" i
347 | D.SchedFieldUInt32 i -> printf " %lu\n" i
348 | D.SchedFieldInt64 i -> printf " %Ld\n" i
349 | D.SchedFieldUInt64 i -> printf " %Lu\n" i
350 | D.SchedFieldFloat f -> printf " %g\n" f
351 | D.SchedFieldBool b -> printf " %b\n" b
354 let print_vcpu_info (ncpus, vcpu_infos, cpumaps, maplen, maxcpus) =
355 for n = 0 to ncpus-1 do
356 printf "virtual CPU: %d\n" n;
357 printf " on physical CPU: %d\n" vcpu_infos.(n).D.cpu;
358 printf " current state: %s\n"
359 (string_of_vcpu_state vcpu_infos.(n).D.vcpu_state);
360 printf " CPU time: %Ld ns\n" vcpu_infos.(n).D.vcpu_time;
361 printf " CPU affinity: ";
362 for m = 0 to maxcpus-1 do
363 print_char (if C.cpu_usable cpumaps maplen n m then 'y' else '-')
368 let print_block_stats { D.rd_req = rd_req; rd_bytes = rd_bytes;
369 wr_req = wr_req; wr_bytes = wr_bytes;
371 if rd_req >= 0L then printf "read requests: %Ld\n" rd_req;
372 if rd_bytes >= 0L then printf "read bytes: %Ld\n" rd_bytes;
373 if wr_req >= 0L then printf "write requests: %Ld\n" wr_req;
374 if wr_bytes >= 0L then printf "write bytes: %Ld\n" wr_bytes;
375 if errs >= 0L then printf "errors: %Ld\n" errs;
376 and print_interface_stats { D.rx_bytes = rx_bytes; rx_packets = rx_packets;
377 rx_errs = rx_errs; rx_drop = rx_drop;
378 tx_bytes = tx_bytes; tx_packets = tx_packets;
379 tx_errs = tx_errs; tx_drop = tx_drop } =
380 if rx_bytes >= 0L then printf "rx bytes: %Ld\n" rx_bytes;
381 if rx_packets >= 0L then printf "rx packets: %Ld\n" rx_packets;
382 if rx_errs >= 0L then printf "rx errs: %Ld\n" rx_errs;
383 if rx_drop >= 0L then printf "rx dropped: %Ld\n" rx_drop;
384 if tx_bytes >= 0L then printf "tx bytes: %Ld\n" tx_bytes;
385 if tx_packets >= 0L then printf "tx packets: %Ld\n" tx_packets;
386 if tx_errs >= 0L then printf "tx errs: %Ld\n" tx_errs;
387 if tx_drop >= 0L then printf "tx dropped: %Ld\n" tx_drop;
390 (* List of commands. *)
393 cmd2 no_return D.attach_device
394 (arg_full_connection domain_of_string) input_file,
395 "Attach device to domain.";
397 cmd2 no_return D.set_autostart
398 (arg_full_connection domain_of_string) boolean_of_string,
399 "Set whether a domain autostarts at boot.";
401 cmd0 print_endline (with_readonly_connection C.get_capabilities),
402 "Returns capabilities of hypervisor/driver.";
404 cmd0 no_return close_connection,
405 "Close an existing hypervisor connection.";
408 (fun name readonly ->
411 | None | Some false -> conn := RW (C.connect ~name ())
412 | Some true -> conn := RO (C.connect_readonly ~name ())
413 ) string_of_string string_of_readonly,
414 "Open a new hypervisor connection.";
417 (fun xml -> D.create_linux (get_full_connection ()) xml) input_file,
418 "Create a domain from an XML file.";
421 (fun xml -> D.define_xml (get_full_connection ()) xml) input_file,
422 "Define (but don't start) a domain from an XML file.";
424 cmd2 no_return D.detach_device
425 (arg_full_connection domain_of_string) input_file,
426 "Detach device from domain.";
428 cmd1 no_return D.destroy (arg_full_connection domain_of_string),
431 cmd2 print_block_stats D.block_stats
432 (arg_readonly_connection domain_of_string) string_of_string,
433 "Display the block device statistics for a domain.";
435 cmd1 print_int D.get_id (arg_readonly_connection domain_of_string),
436 "Print the ID of a domain.";
438 cmd2 print_interface_stats D.interface_stats
439 (arg_readonly_connection domain_of_string) string_of_string,
440 "Display the network interface statistics for a domain.";
442 cmd1 print_domain_info D.get_info
443 (arg_readonly_connection domain_of_string),
444 "Print the domain info.";
446 cmd1 print_int64 D.get_max_memory
447 (arg_readonly_connection domain_of_string),
448 "Print the max memory (in kilobytes) of a domain.";
450 cmd1 print_int D.get_max_vcpus
451 (arg_readonly_connection domain_of_string),
452 "Print the max VCPUs of a domain.";
454 cmd1 print_endline D.get_name
455 (arg_readonly_connection domain_of_string),
456 "Print the name of a domain.";
458 cmd1 print_endline D.get_os_type
459 (arg_readonly_connection domain_of_string),
460 "Print the OS type of a domain.";
462 cmd1 print_domain_state D.get_info
463 (arg_readonly_connection domain_of_string),
464 "Print the domain state.";
466 cmd1 print_endline D.get_uuid_string
467 (arg_readonly_connection domain_of_string),
468 "Print the UUID of a domain.";
470 cmd2 no_return D.core_dump
471 (arg_full_connection domain_of_string) string_of_string,
472 "Core dump a domain to a file for analysis.";
474 cmd1 print_endline D.get_xml_desc
475 (arg_full_connection domain_of_string),
476 "Print the XML description of a domain.";
478 cmd012 print_int64_array (
480 let conn = get_readonly_connection () in
481 match start, max with
483 [| C.node_get_free_memory conn |]
484 | Some start, None ->
485 C.node_get_cells_free_memory conn start 1
486 | Some start, Some max ->
487 C.node_get_cells_free_memory conn start max
488 ) int_of_string int_of_string,
489 "Display free memory for machine, NUMA cell or range of cells";
491 cmd1 print_bool D.get_autostart
492 (arg_readonly_connection domain_of_string),
493 "Print whether a domain autostarts at boot.";
495 cmd0 print_endline (with_readonly_connection C.get_hostname),
496 "Print the hostname.";
498 cmd0 print_domain_array
500 let c = get_readonly_connection () in
501 let n = C.num_of_domains c in
502 let domids = C.list_domains c n in
503 Array.map (D.lookup_by_id c) domids),
504 "List the running domains.";
506 cmd0 print_domain_array
508 let c = get_readonly_connection () in
509 let n = C.num_of_defined_domains c in
510 let domnames = C.list_defined_domains c n in
511 Array.map (D.lookup_by_name c) domnames),
512 "List the defined but not running domains.";
514 cmd0 no_return (fun () -> exit 0),
515 "Quit the interactive terminal.";
517 cmd0 print_int (fun () -> C.get_max_vcpus (get_readonly_connection ()) ()),
518 "Print the max VCPUs available.";
520 cmd2 no_return N.set_autostart
521 (arg_full_connection network_of_string) boolean_of_string,
522 "Set whether a network autostarts at boot.";
524 cmd1 print_endline N.get_bridge_name
525 (arg_readonly_connection network_of_string),
526 "Print the bridge name of a network.";
529 (fun xml -> N.create_xml (get_full_connection ()) xml) input_file,
530 "Create a network from an XML file.";
533 (fun xml -> N.define_xml (get_full_connection ()) xml) input_file,
534 "Define (but don't start) a network from an XML file.";
536 cmd1 no_return N.destroy (arg_full_connection network_of_string),
537 "Destroy a network.";
539 cmd1 print_endline N.get_xml_desc
540 (arg_full_connection network_of_string),
541 "Print the XML description of a network.";
543 cmd1 print_bool N.get_autostart
544 (arg_full_connection network_of_string),
545 "Print whether a network autostarts at boot.";
547 cmd0 print_network_array
549 let c = get_readonly_connection () in
550 let n = C.num_of_networks c in
551 let nets = C.list_networks c n in
552 Array.map (N.lookup_by_name c) nets),
553 "List the active networks.";
555 cmd0 print_network_array
557 let c = get_readonly_connection () in
558 let n = C.num_of_defined_networks c in
559 let nets = C.list_defined_networks c n in
560 Array.map (N.lookup_by_name c) nets),
561 "List the defined but inactive networks.";
563 cmd1 print_endline N.get_name
564 (arg_readonly_connection network_of_string),
565 "Print the name of a network.";
567 cmd1 no_return N.create
568 (arg_full_connection network_of_string),
569 "Start a previously defined inactive network.";
571 cmd1 no_return N.undefine
572 (arg_full_connection network_of_string),
573 "Undefine an inactive network.";
575 cmd1 print_endline N.get_uuid_string
576 (arg_readonly_connection network_of_string),
577 "Print the UUID of a network.";
579 cmd0 print_node_info (with_readonly_connection C.get_node_info),
580 "Print node information.";
582 cmd1 no_return D.reboot (arg_full_connection domain_of_string),
586 fun path -> D.restore (get_full_connection ()) path
588 "Restore a domain from the named file.";
590 cmd1 no_return D.resume (arg_full_connection domain_of_string),
593 cmd2 no_return D.save
594 (arg_full_connection domain_of_string) string_of_string,
595 "Save a domain to a file.";
597 cmd1 print_sched_param_array (
599 let n = snd (D.get_scheduler_type dom) in
600 D.get_scheduler_parameters dom n
601 ) (arg_readonly_connection domain_of_string),
602 "Get the current scheduler parameters for a domain.";
606 | [] -> failwith "expecting domain followed by field value pairs"
608 let conn = get_full_connection () in
609 let dom = domain_of_string conn dom in
610 let params = parse_sched_params pairs in
611 let params = Array.of_list params in
612 D.set_scheduler_parameters dom params
614 "Set the scheduler parameters for a domain.";
617 (fun dom -> fst (D.get_scheduler_type dom))
618 (arg_readonly_connection domain_of_string),
619 "Get the scheduler type.";
621 cmd2 no_return D.set_memory
622 (arg_full_connection domain_of_string) Int64.of_string,
623 "Set the memory used by the domain (in kilobytes).";
625 cmd2 no_return D.set_max_memory
626 (arg_full_connection domain_of_string) Int64.of_string,
627 "Set the maximum memory used by the domain (in kilobytes).";
629 cmd1 no_return D.shutdown
630 (arg_full_connection domain_of_string),
631 "Gracefully shutdown a domain.";
633 cmd1 no_return D.create
634 (arg_full_connection domain_of_string),
635 "Start a previously defined inactive domain.";
637 cmd1 no_return D.suspend
638 (arg_full_connection domain_of_string),
641 cmd0 print_endline (with_readonly_connection C.get_type),
642 "Print the driver name";
644 cmd1 no_return D.undefine
645 (arg_full_connection domain_of_string),
646 "Undefine an inactive domain.";
648 cmd0 print_endline (with_readonly_connection C.get_uri),
649 "Print the canonical URI.";
651 cmd1 print_vcpu_info (
653 let c = get_readonly_connection () in
654 let info = C.get_node_info c in
655 let dominfo = D.get_info dom in
656 let maxcpus = C.maxcpus_of_node_info info in
657 let maplen = C.cpumaplen maxcpus in
658 let maxinfo = dominfo.D.nr_virt_cpu in
659 let ncpus, vcpu_infos, cpumaps = D.get_vcpus dom maxinfo maplen in
660 ncpus, vcpu_infos, cpumaps, maplen, maxcpus
661 ) (arg_readonly_connection domain_of_string),
662 "Pin domain VCPU to a list of physical CPUs.";
664 cmd3 no_return D.pin_vcpu
665 (arg_full_connection domain_of_string) int_of_string cpumap_of_string,
666 "Pin domain VCPU to a list of physical CPUs.";
668 cmd2 no_return D.set_vcpus
669 (arg_full_connection domain_of_string) int_of_string,
670 "Set the number of virtual CPUs assigned to a domain.";
672 cmd0 print_version (with_readonly_connection C.get_version),
673 "Print the driver version";
678 | None -> (* List of commands. *)
681 fun (cmd, _, description) ->
682 sprintf "%-12s %s" cmd description
685 "\n\nUse '" ^ program_name ^ " help command' for help on a command."
687 | Some command -> (* Full description of one command. *)
689 let (command, _, description) =
690 List.find (fun (c, _, _) -> c = command) commands in
691 sprintf "%s %s\n\n%s" program_name command description
694 failwith ("help: " ^ command ^ ": command not found");
699 cmd01 print_endline help string_of_string,
700 "Print list of commands or full description of one command.";
703 (* Execute a command. *)
704 let do_command command args =
706 let (_, cmd, _) = List.find (fun (c, _, _) -> c = command) commands in
710 failwith (command ^ ": command not found");
715 (* Interactive mode. *)
716 let rec interactive_mode () =
719 | No_connection -> "mlvirsh(no connection)$ "
720 | RO _ -> "mlvirsh(ro)$ "
721 | RW _ -> "mlvirsh# " in
723 let command = read_line () in
724 (match str_nsplit command " " with
727 do_command command args
729 Gc.full_major (); (* Free up all unreachable domain and network objects. *)
732 (* Connect to hypervisor. Allow the connection to fail. *)
736 if readonly then RO (C.connect_readonly ?name ())
737 else RW (C.connect ?name ())
739 Libvirt.Virterror err ->
740 eprintf "%s: %s\n" program_name (Libvirt.Virterror.to_string err);
745 (* Execute the command on the command line, if there was one.
746 * Otherwise go into interactive mode.
748 (match extra_args with
750 do_command command args
752 try interactive_mode () with End_of_file -> ()
755 (* If we are connected to a hypervisor, close the connection. *)
758 (* A good way to find heap bugs: *)
761 | Libvirt.Virterror err ->
762 eprintf "%s: %s\n" program_name (Libvirt.Virterror.to_string err)
764 eprintf "%s: %s\n" program_name msg