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.
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 Hypervisor connection URI";
36 "-r", Arg.Set readonly, " Read-only connection";
41 " ^ program_name ^ " [options] [command]
44 " ^ program_name ^ " help
46 Full description of a single command:
47 " ^ program_name ^ " help command
51 let add_extra_arg, get_extra_args =
52 let extra_args = ref [] in
53 let add_extra_arg s = extra_args := s :: !extra_args in
54 let get_extra_args () = List.rev !extra_args in
55 add_extra_arg, get_extra_args
57 let () = Arg.parse argspec add_extra_arg usage_msg
59 let name = match !name with "" -> None | name -> Some name
60 let readonly = !readonly
61 let extra_args = get_extra_args ()
63 (* Read a whole file into memory and return it (as a string). *)
64 let rec input_file filename =
65 let chan = open_in_bin filename in
66 let data = input_all chan in
70 let buf = Buffer.create 16384 in
71 let tmpsize = 16384 in
72 let tmp = String.create tmpsize in
74 while n := input chan tmp 0 tmpsize; !n > 0 do
75 Buffer.add_substring buf tmp 0 !n;
79 (* Hypervisor connection. *)
80 type conn_t = No_connection | RO of Libvirt.ro C.t | RW of Libvirt.rw C.t
81 let conn = ref No_connection
83 let close_connection () =
94 (* Command helper functions.
96 * Each cmd<n> is a function that constructs a command.
97 * string string string ... <--- user types on the command line
99 * arg1 arg2 arg3 ... <--- conversion functions
102 * function f <--- work function
105 * print result <--- printing function
107 * (Note that cmd<n> function constructs and returns the above
108 * function, it isn't the function itself.)
110 * Example: If the function takes one parameter (an int) and
111 * returns a string to be printed, you would use:
113 * cmd1 print_endline f int_of_string
115 let cmd0 print fn = function (* Command with no args. *)
116 | [] -> print (fn ())
117 | _ -> failwith "incorrect number of arguments for function"
119 let cmd1 print fn arg1 = function (* Command with one arg. *)
120 | [str1] -> print (fn (arg1 str1))
121 | _ -> failwith "incorrect number of arguments for function"
123 let cmd2 print fn arg1 arg2 = function (* Command with 2 args. *)
124 | [str1; str2] -> print (fn (arg1 str1) (arg2 str2))
125 | _ -> failwith "incorrect number of arguments for function"
127 let cmd3 print fn arg1 arg2 arg3 = function (* Command with 3 args. *)
128 | [str1; str2; str3] -> print (fn (arg1 str1) (arg2 str2) (arg3 str3))
129 | _ -> failwith "incorrect number of arguments for function"
131 let cmd01 print fn arg1 = function (* Command with 0 or 1 arg. *)
132 | [] -> print (fn None)
133 | [str1] -> print (fn (Some (arg1 str1)))
134 | _ -> failwith "incorrect number of arguments for function"
136 let cmd12 print fn arg1 arg2 = function (* Command with 1 or 2 args. *)
137 | [str1] -> print (fn (arg1 str1) None)
138 | [str1; str2] -> print (fn (arg1 str1) (Some (arg2 str2)))
139 | _ -> failwith "incorrect number of arguments for function"
141 let cmdN print fn = (* Command with any number of args. *)
142 fun args -> print (fn args)
145 (* Get the connection or fail if we don't have one. *)
146 let rec get_full_connection () =
148 | No_connection -> failwith "not connected to the hypervisor"
149 | RO _ -> failwith "tried to do read-write operation on read-only hypervisor connection"
151 and get_readonly_connection () =
153 | No_connection -> failwith "not connected to the hypervisor"
155 | RW conn -> C.const conn
157 and with_full_connection fn =
158 fun () -> fn (get_full_connection ())
160 and with_readonly_connection fn =
161 fun () -> fn (get_readonly_connection ())
162 and arg_full_connection fn =
163 fun str -> fn (get_full_connection ()) str
164 and arg_readonly_connection fn =
165 fun str -> fn (get_readonly_connection ()) str
168 (* Parsing of command arguments. *)
169 let string_of_readonly = function
170 | "readonly" | "read-only" | "ro" -> true
171 | _ -> failwith "flag should be 'readonly'"
173 let string_of_string (str : string) = str in
174 let boolean_of_string = function
175 | "enable" | "enabled" | "on" | "1" | "true" -> true
176 | "disable" | "disabled" | "off" | "0" | "false" -> false
177 | _ -> failwith "setting should be 'on' or 'off'"
179 let domain_of_string conn str =
182 let id = int_of_string str in
183 D.lookup_by_id conn id
185 Failure "int_of_string" ->
186 if String.length str = Libvirt.uuid_string_length then
187 D.lookup_by_uuid_string conn str
189 D.lookup_by_name conn str
192 Libvirt.Virterror err ->
193 failwith ("domain " ^ str ^ ": not found. Additional info: " ^
194 Libvirt.Virterror.to_string err);
196 let network_of_string conn str =
198 if String.length str = Libvirt.uuid_string_length then
199 N.lookup_by_uuid_string conn str
201 N.lookup_by_name conn str
203 Libvirt.Virterror err ->
204 failwith ("network " ^ str ^ ": not found. Additional info: " ^
205 Libvirt.Virterror.to_string err);
207 let rec parse_sched_params = function
209 | [_] -> failwith "expected field value pairs, but got an odd number of arguments"
210 | field :: value :: rest ->
211 (* XXX We only support the UINT type at the moment. *)
212 (field, D.SchedFieldUInt32 (Int32.of_string value))
213 :: parse_sched_params rest
215 let cpumap_of_string str =
216 let c = get_readonly_connection () in
217 let info = C.get_node_info c in
219 String.make (C.cpumaplen (C.maxcpus_of_node_info info)) '\000' in
220 List.iter (C.use_cpu cpumap)
221 (List.map int_of_string (String.nsplit str ","));
225 (* Printing of command results. *)
226 let no_return _ = () in
227 let print_int i = print_endline (string_of_int i) in
228 let print_int64 i = print_endline (Int64.to_string i) in
229 let print_bool b = print_endline (string_of_bool b) in
230 let print_version v =
231 let major = v / 1000000 in
232 let minor = (v - major * 1000000) / 1000 in
233 let release = (v - major * 1000000 - minor * 1000) in
234 printf "%d.%d.%d\n" major minor release
236 let string_of_domain_state = function
237 | D.InfoNoState -> "unknown"
238 | D.InfoRunning -> "running"
239 | D.InfoBlocked -> "blocked"
240 | D.InfoPaused -> "paused"
241 | D.InfoShutdown -> "shutdown"
242 | D.InfoShutoff -> "shutoff"
243 | D.InfoCrashed -> "crashed"
245 let string_of_vcpu_state = function
246 | D.VcpuOffline -> "offline"
247 | D.VcpuRunning -> "running"
248 | D.VcpuBlocked -> "blocked"
250 let print_domain_array doms =
254 try sprintf "%d" (D.get_id dom)
255 with Libvirt.Virterror _ -> "" in
257 try sprintf "%s" (D.get_name dom)
258 with Libvirt.Virterror _ -> "" in
261 let { D.state = state } = D.get_info dom in
262 string_of_domain_state state
263 with Libvirt.Virterror _ -> "" in
264 printf "%5s %-30s %s\n" id name state
267 let print_network_array nets =
270 printf "%s\n" (N.get_name net)
273 let print_node_info info =
274 printf "model: %s\n" info.C.model;
275 printf "memory: %Ld K\n" info.C.memory;
276 printf "cpus: %d\n" info.C.cpus;
277 printf "mhz: %d\n" info.C.mhz;
278 printf "nodes: %d\n" info.C.nodes;
279 printf "sockets: %d\n" info.C.sockets;
280 printf "cores: %d\n" info.C.cores;
281 printf "threads: %d\n" info.C.threads;
283 let print_domain_state { D.state = state } =
284 print_endline (string_of_domain_state state)
286 let print_domain_info info =
287 printf "state: %s\n" (string_of_domain_state info.D.state);
288 printf "max_mem: %Ld K\n" info.D.max_mem;
289 printf "memory: %Ld K\n" info.D.memory;
290 printf "nr_virt_cpu: %d\n" info.D.nr_virt_cpu;
291 printf "cpu_time: %Ld ns\n" info.D.cpu_time;
293 let print_sched_param_array params =
298 | D.SchedFieldInt32 i -> printf " %ld\n" i
299 | D.SchedFieldUInt32 i -> printf " %lu\n" i
300 | D.SchedFieldInt64 i -> printf " %Ld\n" i
301 | D.SchedFieldUInt64 i -> printf " %Lu\n" i
302 | D.SchedFieldFloat f -> printf " %g\n" f
303 | D.SchedFieldBool b -> printf " %b\n" b
306 let print_vcpu_info (ncpus, vcpu_infos, cpumaps, maplen, maxcpus) =
307 for n = 0 to ncpus-1 do
308 printf "virtual CPU: %d\n" n;
309 printf " on physical CPU: %d\n" vcpu_infos.(n).D.cpu;
310 printf " current state: %s\n"
311 (string_of_vcpu_state vcpu_infos.(n).D.vcpu_state);
312 printf " CPU time: %Ld ns\n" vcpu_infos.(n).D.vcpu_time;
313 printf " CPU affinity: ";
314 for m = 0 to maxcpus-1 do
315 print_char (if C.cpu_usable cpumaps maplen n m then 'y' else '-')
320 let print_block_stats { D.rd_req = rd_req; rd_bytes = rd_bytes;
321 wr_req = wr_req; wr_bytes = wr_bytes;
323 if rd_req >= 0L then printf "read requests: %Ld\n" rd_req;
324 if rd_bytes >= 0L then printf "read bytes: %Ld\n" rd_bytes;
325 if wr_req >= 0L then printf "write requests: %Ld\n" wr_req;
326 if wr_bytes >= 0L then printf "write bytes: %Ld\n" wr_bytes;
327 if errs >= 0L then printf "errors: %Ld\n" errs;
328 and print_interface_stats { D.rx_bytes = rx_bytes; rx_packets = rx_packets;
329 rx_errs = rx_errs; rx_drop = rx_drop;
330 tx_bytes = tx_bytes; tx_packets = tx_packets;
331 tx_errs = tx_errs; tx_drop = tx_drop } =
332 if rx_bytes >= 0L then printf "rx bytes: %Ld\n" rx_bytes;
333 if rx_packets >= 0L then printf "rx packets: %Ld\n" rx_packets;
334 if rx_errs >= 0L then printf "rx errs: %Ld\n" rx_errs;
335 if rx_drop >= 0L then printf "rx dropped: %Ld\n" rx_drop;
336 if tx_bytes >= 0L then printf "tx bytes: %Ld\n" tx_bytes;
337 if tx_packets >= 0L then printf "tx packets: %Ld\n" tx_packets;
338 if tx_errs >= 0L then printf "tx errs: %Ld\n" tx_errs;
339 if tx_drop >= 0L then printf "tx dropped: %Ld\n" tx_drop;
342 (* List of commands. *)
345 cmd2 no_return D.attach_device
346 (arg_full_connection domain_of_string) input_file,
347 "Attach device to domain.";
349 cmd2 no_return D.set_autostart
350 (arg_full_connection domain_of_string) boolean_of_string,
351 "Set whether a domain autostarts at boot.";
353 cmd0 print_endline (with_readonly_connection C.get_capabilities),
354 "Returns capabilities of hypervisor/driver.";
356 cmd0 no_return close_connection,
357 "Close an existing hypervisor connection.";
360 (fun name readonly ->
363 | None | Some false -> conn := RW (C.connect ~name ())
364 | Some true -> conn := RO (C.connect_readonly ~name ())
365 ) string_of_string string_of_readonly,
366 "Open a new hypervisor connection.";
369 (fun xml -> D.create_linux (get_full_connection ()) xml) input_file,
370 "Create a domain from an XML file.";
373 (fun xml -> D.define_xml (get_full_connection ()) xml) input_file,
374 "Define (but don't start) a domain from an XML file.";
376 cmd2 no_return D.detach_device
377 (arg_full_connection domain_of_string) input_file,
378 "Detach device from domain.";
380 cmd1 no_return D.destroy (arg_full_connection domain_of_string),
383 cmd2 print_block_stats D.block_stats
384 (arg_readonly_connection domain_of_string) string_of_string,
385 "Display the block device statistics for a domain.";
387 cmd1 print_int D.get_id (arg_readonly_connection domain_of_string),
388 "Print the ID of a domain.";
390 cmd2 print_interface_stats D.interface_stats
391 (arg_readonly_connection domain_of_string) string_of_string,
392 "Display the network interface statistics for a domain.";
394 cmd1 print_domain_info D.get_info
395 (arg_readonly_connection domain_of_string),
396 "Print the domain info.";
398 cmd1 print_int64 D.get_max_memory
399 (arg_readonly_connection domain_of_string),
400 "Print the max memory (in kilobytes) of a domain.";
402 cmd1 print_int D.get_max_vcpus
403 (arg_readonly_connection domain_of_string),
404 "Print the max VCPUs of a domain.";
406 cmd1 print_endline D.get_name
407 (arg_readonly_connection domain_of_string),
408 "Print the name of a domain.";
410 cmd1 print_endline D.get_os_type
411 (arg_readonly_connection domain_of_string),
412 "Print the OS type of a domain.";
414 cmd1 print_domain_state D.get_info
415 (arg_readonly_connection domain_of_string),
416 "Print the domain state.";
418 cmd1 print_endline D.get_uuid_string
419 (arg_readonly_connection domain_of_string),
420 "Print the UUID of a domain.";
422 cmd2 no_return D.core_dump
423 (arg_full_connection domain_of_string) string_of_string,
424 "Core dump a domain to a file for analysis.";
426 cmd1 print_endline D.get_xml_desc
427 (arg_full_connection domain_of_string),
428 "Print the XML description of a domain.";
430 cmd1 print_bool D.get_autostart
431 (arg_readonly_connection domain_of_string),
432 "Print whether a domain autostarts at boot.";
434 cmd0 print_endline (with_readonly_connection C.get_hostname),
435 "Print the hostname.";
437 cmd0 print_domain_array
439 let c = get_readonly_connection () in
440 let n = C.num_of_domains c in
441 let domids = C.list_domains c n in
442 Array.map (D.lookup_by_id c) domids),
443 "List the running domains.";
445 cmd0 print_domain_array
447 let c = get_readonly_connection () in
448 let n = C.num_of_defined_domains c in
449 let domnames = C.list_defined_domains c n in
450 Array.map (D.lookup_by_name c) domnames),
451 "List the defined but not running domains.";
453 cmd0 no_return (fun () -> exit 0),
454 "Quit the interactive terminal.";
456 cmd0 print_int (fun () -> C.get_max_vcpus (get_readonly_connection ()) ()),
457 "Print the max VCPUs available.";
459 cmd2 no_return N.set_autostart
460 (arg_full_connection network_of_string) boolean_of_string,
461 "Set whether a network autostarts at boot.";
463 cmd1 print_endline N.get_bridge_name
464 (arg_readonly_connection network_of_string),
465 "Print the bridge name of a network.";
468 (fun xml -> N.create_xml (get_full_connection ()) xml) input_file,
469 "Create a network from an XML file.";
472 (fun xml -> N.define_xml (get_full_connection ()) xml) input_file,
473 "Define (but don't start) a network from an XML file.";
475 cmd1 no_return N.destroy (arg_full_connection network_of_string),
476 "Destroy a network.";
478 cmd1 print_endline N.get_xml_desc
479 (arg_full_connection network_of_string),
480 "Print the XML description of a network.";
482 cmd1 print_bool N.get_autostart
483 (arg_full_connection network_of_string),
484 "Print whether a network autostarts at boot.";
486 cmd0 print_network_array
488 let c = get_readonly_connection () in
489 let n = C.num_of_networks c in
490 let nets = C.list_networks c n in
491 Array.map (N.lookup_by_name c) nets),
492 "List the active networks.";
494 cmd0 print_network_array
496 let c = get_readonly_connection () in
497 let n = C.num_of_defined_networks c in
498 let nets = C.list_defined_networks c n in
499 Array.map (N.lookup_by_name c) nets),
500 "List the defined but inactive networks.";
502 cmd1 print_endline N.get_name
503 (arg_readonly_connection network_of_string),
504 "Print the name of a network.";
506 cmd1 no_return N.create
507 (arg_full_connection network_of_string),
508 "Start a previously defined inactive network.";
510 cmd1 no_return N.undefine
511 (arg_full_connection network_of_string),
512 "Undefine an inactive network.";
514 cmd1 print_endline N.get_uuid_string
515 (arg_readonly_connection network_of_string),
516 "Print the UUID of a network.";
518 cmd0 print_node_info (with_readonly_connection C.get_node_info),
519 "Print node information.";
521 cmd1 no_return D.reboot (arg_full_connection domain_of_string),
525 fun path -> D.restore (get_full_connection ()) path
527 "Restore a domain from the named file.";
529 cmd1 no_return D.resume (arg_full_connection domain_of_string),
532 cmd2 no_return D.save
533 (arg_full_connection domain_of_string) string_of_string,
534 "Save a domain to a file.";
536 cmd1 print_sched_param_array (
538 let n = snd (D.get_scheduler_type dom) in
539 D.get_scheduler_parameters dom n
540 ) (arg_readonly_connection domain_of_string),
541 "Get the current scheduler parameters for a domain.";
545 | [] -> failwith "expecting domain followed by field value pairs"
547 let conn = get_full_connection () in
548 let dom = domain_of_string conn dom in
549 let params = parse_sched_params pairs in
550 let params = Array.of_list params in
551 D.set_scheduler_parameters dom params
553 "Set the scheduler parameters for a domain.";
556 (fun dom -> fst (D.get_scheduler_type dom))
557 (arg_readonly_connection domain_of_string),
558 "Get the scheduler type.";
560 cmd2 no_return D.set_memory
561 (arg_full_connection domain_of_string) Int64.of_string,
562 "Set the memory used by the domain (in kilobytes).";
564 cmd2 no_return D.set_max_memory
565 (arg_full_connection domain_of_string) Int64.of_string,
566 "Set the maximum memory used by the domain (in kilobytes).";
568 cmd1 no_return D.shutdown
569 (arg_full_connection domain_of_string),
570 "Gracefully shutdown a domain.";
572 cmd1 no_return D.create
573 (arg_full_connection domain_of_string),
574 "Start a previously defined inactive domain.";
576 cmd1 no_return D.suspend
577 (arg_full_connection domain_of_string),
580 cmd0 print_endline (with_readonly_connection C.get_type),
581 "Print the driver name";
583 cmd1 no_return D.undefine
584 (arg_full_connection domain_of_string),
585 "Undefine an inactive domain.";
587 cmd0 print_endline (with_readonly_connection C.get_uri),
588 "Print the canonical URI.";
590 cmd1 print_vcpu_info (
592 let c = get_readonly_connection () in
593 let info = C.get_node_info c in
594 let dominfo = D.get_info dom in
595 let maxcpus = C.maxcpus_of_node_info info in
596 let maplen = C.cpumaplen maxcpus in
597 let maxinfo = dominfo.D.nr_virt_cpu in
598 let ncpus, vcpu_infos, cpumaps = D.get_vcpus dom maxinfo maplen in
599 ncpus, vcpu_infos, cpumaps, maplen, maxcpus
600 ) (arg_readonly_connection domain_of_string),
601 "Pin domain VCPU to a list of physical CPUs.";
603 cmd3 no_return D.pin_vcpu
604 (arg_full_connection domain_of_string) int_of_string cpumap_of_string,
605 "Pin domain VCPU to a list of physical CPUs.";
607 cmd2 no_return D.set_vcpus
608 (arg_full_connection domain_of_string) int_of_string,
609 "Set the number of virtual CPUs assigned to a domain.";
611 cmd0 print_version (with_readonly_connection C.get_version),
612 "Print the driver version";
617 | None -> (* List of commands. *)
620 fun (cmd, _, description) ->
621 sprintf "%-12s %s" cmd description
624 "\n\nUse '" ^ program_name ^ " help command' for help on a command."
626 | Some command -> (* Full description of one command. *)
628 let (command, _, description) =
629 List.find (fun (c, _, _) -> c = command) commands in
630 sprintf "%s %s\n\n%s" program_name command description
633 failwith ("help: " ^ command ^ ": command not found");
638 cmd01 print_endline help string_of_string,
639 "Print list of commands or full description of one command.";
642 (* Execute a command. *)
643 let do_command command args =
645 let (_, cmd, _) = List.find (fun (c, _, _) -> c = command) commands in
649 failwith (command ^ ": command not found");
654 (* Interactive mode. *)
655 let rec interactive_mode () =
658 | No_connection -> "mlvirsh(no connection)$ "
659 | RO _ -> "mlvirsh(ro)$ "
660 | RW _ -> "mlvirsh# " in
662 let command = read_line () in
663 (match String.nsplit command " " with
666 do_command command args
668 Gc.full_major (); (* Free up all unreachable domain and network objects. *)
671 (* Connect to hypervisor. Allow the connection to fail. *)
675 if readonly then RO (C.connect_readonly ?name ())
676 else RW (C.connect ?name ())
678 Libvirt.Virterror err ->
679 eprintf "%s: %s\n" program_name (Libvirt.Virterror.to_string err);
684 (* Execute the command on the command line, if there was one.
685 * Otherwise go into interactive mode.
687 (match extra_args with
689 do_command command args
691 try interactive_mode () with End_of_file -> ()
694 (* If we are connected to a hypervisor, close the connection. *)
697 (* A good way to find heap bugs: *)
700 | Libvirt.Virterror err ->
701 eprintf "%s: %s\n" program_name (Libvirt.Virterror.to_string err)
703 eprintf "%s: %s\n" program_name msg