Add .gitignore file for git.
[virt-df.git] / virt-df / virt_df_main.ml
1 (* 'df' command for virtual domains.
2    (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc.
3    http://libvirt.org/
4
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.
9
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.
14
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.
18  *)
19
20 open Printf
21 open ExtList
22
23 module C = Libvirt.Connect
24 module D = Libvirt.Domain
25
26 open Int63.Operators
27
28 open Virt_df_gettext.Gettext
29 open Virt_df
30
31 let disk_block_size = ~^512
32
33 (* A libvirt-backed block device. *)
34 class libvirt_device dom name path blocksize =
35   (* Size is never really used. *)
36   let size = ~^0 in
37 object (self)
38   inherit Diskimage.device
39   method read offset len =
40     let offset = Int63.to_int64 offset in
41     let len = Int63.to_int len in
42     let str = String.make len '\000' in
43     ignore (D.block_peek dom path offset len str 0);
44     str
45   method size = size
46   method name = name
47   method blocksize = blocksize
48   method map_block _ = []
49   method contiguous offset = size -^ offset
50   method close () = ()
51   initializer
52     (* Check that access is possible - throws a virterror if not. *)
53     D.block_peek dom path 0L 0 "" 0
54 end
55
56 let () =
57   (* Command line argument parsing. *)
58   let set_uri = function "" -> uri := None | u -> uri := Some u in
59
60   let version () =
61     printf "virt-df %s\n" Virt_df_version.version;
62
63     let major, minor, release =
64       let v, _ = Libvirt.get_version () in
65       v / 1_000_000, (v / 1_000) mod 1_000, v mod 1_000 in
66     printf "libvirt %d.%d.%d\n" major minor release;
67     exit 0
68   in
69
70   let test_mode filename = test_files := filename :: !test_files in
71
72   let argspec = Arg.align [
73     "-a", Arg.Set all,
74       " " ^ s_ "Show all domains (default: only active domains)";
75     "--all", Arg.Set all,
76       " " ^ s_ "Show all domains (default: only active domains)";
77     "-c", Arg.String set_uri,
78       "uri " ^ s_ "Connect to URI";
79     "--connect", Arg.String set_uri,
80       "uri " ^ s_ "Connect to URI";
81     "--csv", Arg.Set csv_mode,
82       " " ^ s_ "Write results in CSV format";
83     "--debug", Arg.Set Diskimage.debug,
84       " " ^ s_ "Debug mode (default: false)";
85     "-h", Arg.Set human,
86       " " ^ s_ "Print sizes in human-readable format";
87     "--human-readable", Arg.Set human,
88       " " ^ s_ "Print sizes in human-readable format";
89     "-i", Arg.Set inodes,
90       " " ^ s_ "Show inodes instead of blocks";
91     "--inodes", Arg.Set inodes,
92       " " ^ s_ "Show inodes instead of blocks";
93     "-t", Arg.String test_mode,
94       "dev " ^ s_ "(Test mode) Display contents of block device or file";
95     "--version", Arg.Unit version,
96       " " ^ s_ "Display version and exit";
97   ] in
98
99   let anon_fun str =
100     raise (Arg.Bad (sprintf (f_ "%s: unknown parameter") str)) in
101   let usage_msg = s_ "virt-df : like 'df', shows disk space used in guests
102
103 SUMMARY
104   virt-df [-options]
105
106 OPTIONS" in
107
108   Arg.parse argspec anon_fun usage_msg;
109
110   (* Set up CSV support. *)
111   let csv_write =
112     if not !csv_mode then
113       fun _ -> assert false (* Should never happen. *)
114     else
115       match !csv_write with
116       | None ->
117           prerr_endline (s_ "CSV is not supported in this build of virt-df");
118           exit 1
119       | Some csv_write ->
120           csv_write stdout
121   in
122
123   let doms =
124     if !test_files = [] then (
125       let xmls =
126         (* Connect to the hypervisor. *)
127         let conn =
128           let name = !uri in
129           try C.connect ?name ()
130           with
131             Libvirt.Virterror err ->
132               prerr_endline (Libvirt.Virterror.to_string err);
133               (* If non-root and no explicit connection URI, print a warning. *)
134               if Unix.geteuid () <> 0 && name = None then (
135                 print_endline (s_ "NB: If you want to monitor a local Xen hypervisor, you usually need to be root");
136               );
137               exit 1 in
138
139         let xmls =
140           try
141             (* Get the list of active & inactive domains. *)
142             let doms =
143               let nr_active_doms = C.num_of_domains conn in
144               let active_doms =
145                 Array.to_list (C.list_domains conn nr_active_doms) in
146               let active_doms =
147                 List.map (D.lookup_by_id conn) active_doms in
148               if not !all then
149                 active_doms
150               else (
151                 let nr_inactive_doms = C.num_of_defined_domains conn in
152                 let inactive_doms =
153                   Array.to_list
154                     (C.list_defined_domains conn nr_inactive_doms) in
155                 let inactive_doms =
156                   List.map (D.lookup_by_name conn) inactive_doms in
157                 active_doms @ inactive_doms
158               ) in
159
160             (* Get their XML. *)
161             let xmls = List.map (fun dom -> dom, D.get_xml_desc dom) doms in
162
163             (* Parse the XML. *)
164             let xmls = List.map (fun (dom, xml) ->
165                                    dom, Xml.parse_string xml) xmls in
166
167             xmls
168           with
169             Libvirt.Virterror err ->
170               prerr_endline (Libvirt.Virterror.to_string err);
171               exit 1 in
172         xmls in
173
174       (* Grr.. Need to use a library which has XPATH support (or cduce). *)
175       List.map (
176         fun (dom, xml) ->
177           let nodes, domain_attrs =
178             match xml with
179             | Xml.Element ("domain", attrs, children) -> children, attrs
180             | _ -> failwith (s_ "get_xml_desc didn't return <domain/>") in
181
182           (*let domid =
183             try Some (int_of_string (List.assoc "id" domain_attrs))
184             with Not_found -> None in*)
185
186           let rec loop = function
187             | [] ->
188                 failwith (s_ "get_xml_desc returned no <name> node in XML")
189             | Xml.Element ("name", _, [Xml.PCData name]) :: _ -> name
190             | Xml.Element ("name", _, _) :: _ ->
191                 failwith (s_ "get_xml_desc returned strange <name> node")
192             | _ :: rest -> loop rest
193           in
194           let name = loop nodes in
195
196           let devices =
197             let devices =
198               List.filter_map (
199                 function
200                 | Xml.Element ("devices", _, devices) -> Some devices
201                 | _ -> None
202               ) nodes in
203             List.concat devices in
204
205           let rec target_dev_of = function
206             | [] -> None
207             | Xml.Element ("target", attrs, _) :: rest ->
208                 (try Some (List.assoc "dev" attrs)
209                  with Not_found -> target_dev_of rest)
210             | _ :: rest -> target_dev_of rest
211           in
212
213           let rec source_file_of = function
214             | [] -> None
215             | Xml.Element ("source", attrs, _) :: rest ->
216                 (try Some (List.assoc "file" attrs)
217                  with Not_found -> source_file_of rest)
218             | _ :: rest -> source_file_of rest
219           in
220
221           let rec source_dev_of = function
222             | [] -> None
223             | Xml.Element ("source", attrs, _) :: rest ->
224                 (try Some (List.assoc "dev" attrs)
225                  with Not_found -> source_dev_of rest)
226             | _ :: rest -> source_dev_of rest
227           in
228
229           let disks =
230             List.filter_map (
231               function
232               | Xml.Element ("disk", attrs, children) ->
233                   (*let typ =
234                     try Some (List.assoc "type" attrs)
235                     with Not_found -> None in*)
236                   let device =
237                     try Some (List.assoc "device" attrs)
238                     with Not_found -> None in
239                   let source =
240                     match source_file_of children with
241                     | (Some _) as source -> source
242                     | None -> source_dev_of children in
243                   let target = target_dev_of children in
244
245                   (* We only care about devices where we have
246                    * source and target.  Ignore CD-ROM devices.
247                    *)
248                   (match source, target, device with
249                    | _, _, Some "cdrom" -> None (* ignore CD-ROMs *)
250                    | Some source, Some target, _ -> Some (target, source)
251                    | _ -> None (* ignore anything else *)
252                   )
253
254               | _ -> None
255             ) devices in
256
257           let disks = List.filter_map (
258             fun (name, path) ->
259               try Some (name, new libvirt_device dom name path disk_block_size)
260               with Libvirt.Virterror err ->
261                 eprintf "%s: %s\n" name (Libvirt.Virterror.to_string err);
262                 None
263           ) disks in
264
265           name, disks
266       ) xmls
267     ) else (
268       (* In test mode (-t option) the user can pass one or more
269        * block devices or filenames (containing partitions/filesystems/etc)
270        * which we use for testing virt-df itself.  We create fake domains
271        * from these.
272        *)
273       List.filter_map (
274         fun filename ->
275           try Some (filename,
276                     ["hda",
277                      new Diskimage.block_device filename disk_block_size])
278           with Unix.Unix_error (err, func, param) ->
279             eprintf "%s:%s: %s\n" func param (Unix.error_message err);
280             None
281       ) !test_files
282     ) in
283
284   (* Convert these to Diskimage library 'machine's. *)
285   let machines = List.map (
286     fun (name, disks) -> Diskimage.open_machine_from_devices name disks
287   ) doms in
288
289   (* Scan them. *)
290   let machines = List.map Diskimage.scan_machine machines in
291
292   (*----------------------------------------------------------------------*)
293   (* Now print the results. *)
294
295   (* Print the title. *)
296   let () =
297     let total, used, avail =
298       match !inodes, !human with
299       | false, false -> s_ "1K-blocks", s_ "Used", s_ "Available"
300       | false, true -> s_ "Size", s_ "Used", s_ "Available"
301       | true, _ -> s_ "Inodes", s_ "IUse", s_ "IFree" in
302     if not !csv_mode then
303       printf "%-32s %10s %10s %10s %s\n%!"
304         (s_ "Filesystem") total used avail (s_ "Type")
305     else
306       csv_write [ "Filesystem"; total; used; avail; "Type" ] in
307
308   let printable_size bytes =
309     if bytes < ~^1024 *^ ~^1024 then
310       sprintf "%s bytes" (Int63.to_string bytes)
311     else if bytes < ~^1024 *^ ~^1024 *^ ~^1024 then
312       sprintf "%.1f MiB" (Int63.to_float (bytes /^ ~^1024) /. 1024.)
313     else
314       sprintf "%.1f GiB" (Int63.to_float (bytes /^ ~^1024 /^ ~^1024) /. 1024.)
315   in
316
317   (* HOF to iterate over filesystems. *)
318   let iter_over_filesystems machines
319       (f : Diskimage.machine -> ?disk:Diskimage.disk -> ?partno:int ->
320         Diskimage.device -> Diskimage.filesystem ->
321         unit) =
322     List.iter (
323       fun ({ Diskimage.m_disks = disks;
324              m_lv_filesystems = filesystems } as dom) ->
325         (* Ordinary filesystems found on disks & partitions. *)
326         List.iter (
327           function
328           | ({ Diskimage.d_content = `Filesystem fs; d_dev = dev } as disk) ->
329               f dom ~disk (dev :> Diskimage.device) fs
330           | ({ Diskimage.d_content = `Partitions partitions } as disk) ->
331               List.iteri (
332                 fun i ->
333                   function
334                   | { Diskimage.part_content = `Filesystem fs;
335                       part_dev = dev } ->
336                       f dom ~disk ~partno:(i+1) dev fs
337                   | _ -> ()
338               ) partitions.Diskimage.parts
339           | _ -> ()
340         ) disks;
341         (* LV filesystems. *)
342         List.iter (
343           fun ({Diskimage.lv_dev = dev}, fs) -> f dom dev fs
344         ) filesystems
345     ) machines
346   in
347
348   (* Printable name is like "domain:hda" or "domain:hda1". *)
349   let printable_name machine ?disk ?partno dev =
350     let m_name = machine.Diskimage.m_name in
351     (* Get the disk name (eg. "hda") from the domain XML, if
352      * we have it, otherwise use the device name (eg. for LVM).
353      *)
354     let disk_name =
355       match disk with
356       | None -> dev#name
357       | Some disk -> disk.Diskimage.d_name
358     in
359     match partno with
360     | None ->
361         m_name ^ ":" ^ disk_name
362     | Some partno ->
363         m_name ^ ":" ^ disk_name ^ string_of_int partno
364   in
365
366   (* Print stats for each recognized filesystem. *)
367   let print_stats machine ?disk ?partno dev fs =
368     let name = printable_name machine ?disk ?partno dev in
369     printf "%-32s " name;
370
371     let {
372       Diskimage.fs_blocksize = fs_blocksize;
373       fs_blocks_total = fs_blocks_total;
374       fs_is_swap = fs_is_swap;
375       fs_blocks_reserved = fs_blocks_reserved;
376       fs_blocks_avail = fs_blocks_avail;
377       fs_blocks_used = fs_blocks_used;
378       fs_inodes_total = fs_inodes_total;
379       fs_inodes_reserved = fs_inodes_reserved;
380       fs_inodes_avail = fs_inodes_avail;
381       fs_inodes_used = fs_inodes_used
382     } = fs in
383
384     let fs_name = Diskimage.name_of_filesystem fs in
385
386     if fs_is_swap then (
387       (* Swap partition. *)
388       if not !human then
389         printf "%10s                       %s\n"
390           (Int63.to_string (fs_blocksize *^ fs_blocks_total /^ ~^1024))
391           fs_name
392       else
393         printf "%10s                       %s\n"
394           (printable_size (fs_blocksize *^ fs_blocks_total))
395           fs_name
396     ) else (
397       (* Ordinary filesystem. *)
398       if not !inodes then (             (* Block display. *)
399         (* 'df' doesn't count the restricted blocks. *)
400         let blocks_total = fs_blocks_total -^ fs_blocks_reserved in
401         let blocks_avail = fs_blocks_avail -^ fs_blocks_reserved in
402         let blocks_avail = if blocks_avail < ~^0 then ~^0 else blocks_avail in
403
404         if not !human then (            (* Display 1K blocks. *)
405           printf "%10s %10s %10s %s\n"
406             (Int63.to_string (blocks_total *^ fs_blocksize /^ ~^1024))
407             (Int63.to_string (fs_blocks_used *^ fs_blocksize /^ ~^1024))
408             (Int63.to_string (blocks_avail *^ fs_blocksize /^ ~^1024))
409             fs_name
410         ) else (                        (* Human-readable blocks. *)
411           printf "%10s %10s %10s %s\n"
412             (printable_size (blocks_total *^ fs_blocksize))
413             (printable_size (fs_blocks_used *^ fs_blocksize))
414             (printable_size (blocks_avail *^ fs_blocksize))
415             fs_name
416         )
417       ) else (                          (* Inodes display. *)
418         printf "%10s %10s %10s %s\n"
419           (Int63.to_string fs_inodes_total)
420           (Int63.to_string fs_inodes_used)
421           (Int63.to_string fs_inodes_avail)
422           fs_name
423       )
424     )
425   in
426
427   (* Alternate version of print_stats which writes to a CSV file.
428    * We ignore the human-readable option because we assume that
429    * the data will be post-processed by something.
430    *)
431   let print_stats_csv machine ?disk ?partno dev fs =
432     let name = printable_name machine ?disk ?partno dev in
433
434     let {
435       Diskimage.fs_blocksize = fs_blocksize;
436       fs_blocks_total = fs_blocks_total;
437       fs_is_swap = fs_is_swap;
438       fs_blocks_reserved = fs_blocks_reserved;
439       fs_blocks_avail = fs_blocks_avail;
440       fs_blocks_used = fs_blocks_used;
441       fs_inodes_total = fs_inodes_total;
442       fs_inodes_reserved = fs_inodes_reserved;
443       fs_inodes_avail = fs_inodes_avail;
444       fs_inodes_used = fs_inodes_used
445     } = fs in
446
447     let fs_name = Diskimage.name_of_filesystem fs in
448
449     let row =
450       if fs_is_swap then
451         (* Swap partition. *)
452         [ Int63.to_string (fs_blocksize *^ fs_blocks_total /^ ~^1024);
453           ""; "" ]
454       else (
455         (* Ordinary filesystem. *)
456         if not !inodes then (           (* 1K block display. *)
457           (* 'df' doesn't count the restricted blocks. *)
458           let blocks_total = fs_blocks_total -^ fs_blocks_reserved in
459           let blocks_avail = fs_blocks_avail -^ fs_blocks_reserved in
460           let blocks_avail = if blocks_avail < ~^0 then ~^0 else blocks_avail in
461
462           [ Int63.to_string (blocks_total *^ fs_blocksize /^ ~^1024);
463             Int63.to_string (fs_blocks_used *^ fs_blocksize /^ ~^1024);
464             Int63.to_string (blocks_avail *^ fs_blocksize /^ ~^1024) ]
465         ) else (                        (* Inodes display. *)
466           [ Int63.to_string fs_inodes_total;
467             Int63.to_string fs_inodes_used;
468             Int63.to_string fs_inodes_avail ]
469         )
470       ) in
471
472     let row = name :: row @ [fs_name] in
473     csv_write row
474   in
475
476   iter_over_filesystems machines
477     (if not !csv_mode then print_stats else print_stats_csv)