1 (* rpmdepsize - visualize the size of RPM dependencies
2 * (C) Copyright 2009 Red Hat Inc.
4 * This program is free software; you can redistribute it and/or modify
5 * it under the terms of the GNU General Public License as published by
6 * the Free Software Foundation; either version 2 of the License, or
7 * (at your option) any later version.
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
14 * You should have received a copy of the GNU General Public License
15 * along with this program; if not, write to the Free Software
16 * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
18 * Written by Richard W.M. Jones <rjones@redhat.com>
30 (* This corresponds to the sexpr that we write out from the
31 * Python code. OCaml will type-check it.
33 type root_packages = string * packages
34 and packages = pkg list
36 nevra : string; (* name-[epoch:]version-release.arch *)
42 size : int64; (* installed size, excl. dirs *)
47 (* Full dependency representation. This is actually a graph because
48 * it contains dependency loops. 'deps list' is a ref because we
49 * update it as we are building it.
51 type deps = Deps of pkg * deps list ref
53 (* Final tree representation, loops removed, and everything we want to
54 * display stored in the nodes.
56 type tree = Tree of pkg * int64 * int64 * GDraw.color * tree list
58 module StringMap = Map.Make (String)
60 let sum = List.fold_left (+^) 0L
61 let spaces n = String.make n ' '
63 (* Python has privileged access to the yum repodata, so we have to use
64 * this Python snippet to pull the data that we need out. This is the
65 * part of the program that takes ages to run, because Python is as
66 * slow as a fat snake that's just eaten a huge lunch. We can't help that.
75 basepkg = yb.pkgSack.returnPackages (patterns=[sys.argv[1]])[0]
76 deps = dict ({basepkg:False})
78 # Recursively find all the dependencies.
82 for pkg in deps.keys():
83 if deps[pkg] == False:
86 for r in pkg.requires:
87 ps = yb.whatProvides (r[0], r[1], r[2])
88 best = yb._bestPackageFromList (ps.returnPackages ())
89 if best.name != pkg.name:
90 deps[pkg].append (best)
91 if not deps.has_key (best):
93 deps[pkg] = yum.misc.unique (deps[pkg])
95 # Get the data out of python as fast as possible so we can
96 # use a serious language for analysis of the tree.
97 print \"(%s (\" % basepkg
98 for pkg in deps.keys():
99 print \"((nevra %s) (name %s) (epoch %s) (version %s) (release %s) (arch %s) (size %s)\" % (pkg, pkg.name, pkg.epoch, pkg.version, pkg.release, pkg.arch, pkg.installedsize)
104 sys.stdout.write (\"))\") # suppress trailing newline"
107 printf "getting repository information (this can take a few seconds ...)\n%!";
109 (* Run the Python program and read in the generated sexpr. *)
111 sprintf "python -c %s %s"
112 (Filename.quote repoquery_py) (Filename.quote Sys.argv.(1)) in
113 let chan = open_process_in cmd in
114 ignore (input_line chan); (* drop "Loaded plugins" *)
116 root_packages_of_sexp (Sexp.of_string (Std.input_all chan)) in
117 (match close_process_in chan with
119 | WEXITED i -> failwith (sprintf "command exited with status %d" i)
120 | WSIGNALED i | WSTOPPED i ->
121 failwith (sprintf "command stopped with signal %d" i)
124 (* Create the dependency graph, probably contains loops so beware. *)
125 let deps = List.map (fun pkg -> Deps (pkg, ref [])) pkgs in
128 fun map (Deps (pkg, _) as deps) ->
129 StringMap.add pkg.nevra deps map
130 ) StringMap.empty deps in
132 fun (Deps (pkg, deps)) ->
133 let deps' = List.map (fun n -> StringMap.find n depsmap) pkg.deps in
134 deps := List.append !deps deps'
137 (* For each package, calculate the total installed size of the package,
138 * which includes all subpackages pulled in. So it's what would be
139 * installed if you did 'yum install foo'.
142 let seen = ref StringMap.empty in
143 let rec _total = function
144 | Deps (pkg, _) when StringMap.mem pkg.nevra !seen -> 0L
145 | Deps (pkg, { contents = children }) ->
146 seen := StringMap.add pkg.nevra true !seen;
147 pkg.size +^ sum (List.map _total children)
149 _total (StringMap.find pkg.nevra depsmap)
153 fun map pkg -> StringMap.add pkg.nevra (total pkg) map
154 ) StringMap.empty pkgs in
156 (* Create the final display tree. Each node is sorted so that
157 * children with the largest contribution come first (on the left).
158 * We remove packages which are already installed by earlier
159 * (leftward) packages. At each node we also store total size and
160 * size of the additional packages.
163 let seen = ref StringMap.empty in
164 let rec build_tree = function
165 | Deps (pkg, _) when StringMap.mem pkg.nevra !seen -> None
166 | Deps (pkg, { contents = children }) ->
167 (* Sort children by reverse total size. *)
168 let cmp (Deps (p1, _)) (Deps (p2, _)) =
169 let t1 = StringMap.find p1.nevra totalsmap in
170 let t2 = StringMap.find p2.nevra totalsmap in
173 let children = List.sort ~cmp children in
174 seen := StringMap.add pkg.nevra true !seen;
175 let children = List.filter_map build_tree children in
176 let total = StringMap.find pkg.nevra totalsmap in
178 let rec sum_child_sizes = function
179 | Tree (pkg, _, _, _, children) ->
181 fun size child -> size +^ sum_child_sizes child
184 sum_child_sizes (Tree (pkg, 0L, 0L, `WHITE, children)) in
185 Some (Tree (pkg, total, increm, `WHITE, children))
187 Option.get (build_tree (StringMap.find root depsmap)) in
190 let rec display ?(indent=0) = function
191 | Tree (pkg, total, increm, _, children) ->
192 printf "%s%s %Ld/%Ld/%Ld\n%!"
193 (spaces indent) pkg.nevra pkg.size increm total;
194 List.iter (display ~indent:(indent+2)) children
199 (* Max depth of the tree. *)
201 let rec depth = function
202 | Tree (pkg, _, _, _, children) ->
203 List.fold_left (fun d c -> max d (1 + depth c)) 1 children
207 (* Allocate a colour to each node in the tree based on its parent. The
208 * single top node is always light grey. The second level nodes are
212 let Tree (pkg, total, increm, _, level2) = tree in
218 `RGB (55000, 55000, 0);
219 `RGB (0, 55000, 55000);
221 let rec colour_level2 cols = function
223 | Tree (pkg, total, increm, _, level3) :: level2 ->
224 let col, cols = match cols with
225 | [] -> List.hd pcols, List.tl pcols
226 | col :: cols -> col, cols in
227 let level3 = colour_level3 col (List.length level3) 0 level3 in
228 Tree (pkg, total, increm, col, level3)
229 :: colour_level2 cols level2
230 and colour_level3 col n i = function
232 | Tree (pkg, total, increm, _, leveln) :: level3 ->
233 let col = scale_colour col n i in
234 let leveln = colour_level3 col (List.length leveln) 0 leveln in
235 Tree (pkg, total, increm, col, leveln)
236 :: colour_level3 col n (i+1) level3
237 and scale_colour col n i =
238 let r, g, b = match col with
239 | `RGB (r, g, b) -> float r, float g, float b
240 | _ -> assert false in
241 let i = float i and n = float n in
242 let scale = 0.8 +. i/.(5.*.n) in
243 let r = r *. scale in
244 let g = g *. scale in
245 let b = b *. scale in
246 `RGB (int_of_float r, int_of_float g, int_of_float b)
248 colour_level2 pcols level2 in
249 Tree (pkg, total, increm, `RGB (55000, 55000, 55000), level2) in
251 (* Open the window. *)
252 let title = root ^ " - Fedora RPM dependency size viewer" in
254 GWindow.window ~width:800 ~height:600 ~title ~allow_shrink:true () in
256 ignore (window#connect#destroy ~callback:GMain.quit);
258 let da = GMisc.drawing_area ~packing:window#add () in
260 let draw = new GDraw.drawable da#misc#window in
262 (* Pango contexts used to draw large and small text. *)
263 let pango_large_context = da#misc#create_pango_context in
264 pango_large_context#set_font_description (Pango.Font.from_string "Sans 12");
265 let pango_small_context = da#misc#create_pango_context in
266 pango_small_context#set_font_description (Pango.Font.from_string "Sans 8");
269 (* Get the canvas size and fill the background with white. *)
270 let width, height = draw#size in
271 draw#set_background `WHITE;
272 draw#set_foreground `WHITE;
273 draw#rectangle ~x:0 ~y:0 ~width ~height ~filled:true ();
275 (* Calculate the scales so we can fit everything into the window. *)
276 let Tree (_, top_total, top_increm, _, _) = tree in
277 assert (top_total = top_increm);
278 let rowheight = float height /. float depth in
279 let scale = float width /. Int64.to_float top_increm in
281 (* Now draw the tree. *)
282 let rec draw_tree y x = function
283 | Tree (pkg, total, increm, colour, children) ->
284 (* Draw pkg at (x, y). *)
285 let width = scale *. Int64.to_float increm in
286 let pkgsizewidth = scale *. Int64.to_float pkg.size in
287 draw_pkg x y width pkgsizewidth rowheight colour pkg total increm;
289 (* Draw the children of pkg at (i, y + rowheight), where
290 * i starts as x and increments for each child.
292 let y = y +. rowheight in
293 let rec loop x = function
295 | child :: children ->
297 let Tree (_, _, increm, _, _) = child in
298 let childwidth = scale *. Int64.to_float increm in
299 loop (x +. childwidth) children
303 (* Draw a single package. *)
304 and draw_pkg x y width pkgsizewidth height colour pkg total increm =
305 let x = int_of_float x in
306 let y = int_of_float y in
307 let width = int_of_float width in
308 let pkgsizewidth = int_of_float pkgsizewidth in
309 let height = int_of_float height in
312 draw_pkg_outline x y width pkgsizewidth height colour;
313 draw_pkg_label x y width height colour pkg total increm
315 else if width >= 4 then
316 draw_pkg_narrow x y width height colour
319 and draw_pkg_outline x y width pkgsizewidth height colour =
320 draw#set_foreground colour;
321 draw#rectangle ~x:(x+2) ~y:(y+2)
322 ~width:(width-4) ~height:(height-4)
324 if pkgsizewidth > 2 then (
325 draw#set_foreground (darken colour);
326 draw#rectangle ~x:(x+2) ~y:(y+2)
327 ~width:(pkgsizewidth-2) ~height:(height-4)
329 draw#set_foreground (choose_contrasting_colour colour);
330 draw#set_line_attributes ~style:`ON_OFF_DASH ();
331 draw#line (x+pkgsizewidth) (y+2) (x+pkgsizewidth) (y+height-2);
332 draw#set_line_attributes ~style:`SOLID ()
334 draw#set_foreground (`BLACK);
335 draw#rectangle ~x:(x+2) ~y:(y+2)
336 ~width:(width-4) ~height:(height-4)
339 and draw_pkg_label x y width height colour pkg total increm =
340 (* How to write text in a drawing area, in case it's not
341 * obvious, which it certainly is not:
342 * http://www.math.nagoya-u.ac.jp/~garrigue/soft/olabl/lablgtk-list/120.txt
345 let txt = pango_large_context#create_layout in
346 Pango.Layout.set_text txt (
348 Package: %.1f%% %s (%Ld bytes)
349 Incremental: %.1f%% %s (%Ld bytes)
350 Total: %.1f%% %s (%Ld bytes)" pkg.nevra
351 (display_percent pkg.size) (display_size pkg.size) pkg.size
352 (display_percent increm) (display_size increm) increm
353 (display_percent total) (display_size total) total
358 let txt = pango_small_context#create_layout in
359 Pango.Layout.set_text txt (
361 Package: %.1f%% %s (%Ld bytes)
362 Incremental: %.1f%% %s (%Ld bytes)
363 Total: %.1f%% %s (%Ld bytes)" pkg.nevra
364 (display_percent pkg.size) (display_size pkg.size) pkg.size
365 (display_percent increm) (display_size increm) increm
366 (display_percent total) (display_size total) total
371 let txt = pango_small_context#create_layout in
372 Pango.Layout.set_text txt (
374 Pkg: %.1f%% %s (%Ld bytes)
375 Incr: %.1f%% %s (%Ld bytes)
376 Tot: %.1f%% %s (%Ld bytes)" pkg.name
377 (display_percent pkg.size) (display_size pkg.size) pkg.size
378 (display_percent increm) (display_size increm) increm
379 (display_percent total) (display_size total) total
384 let txt = pango_small_context#create_layout in
385 Pango.Layout.set_text txt (
389 Tot: %.1f%% %s" pkg.name
390 (display_percent pkg.size) (display_size pkg.size)
391 (display_percent increm) (display_size increm)
392 (display_percent total) (display_size total)
397 let txt = pango_small_context#create_layout in
398 Pango.Layout.set_text txt (
399 sprintf "%s\nPkg: %.1f%%\nIncr: %.1f%%\nTot: %.1f%%"
401 (display_percent pkg.size)
402 (display_percent increm)
403 (display_percent total)
408 let txt = pango_small_context#create_layout in
409 Pango.Layout.set_text txt (
410 sprintf "%s Pkg: %.1f%% %s Incr: %.1f%% %s Tot: %.1f%% %s" pkg.name
411 (display_percent pkg.size) (display_size pkg.size)
412 (display_percent increm) (display_size increm)
413 (display_percent total) (display_size total)
418 let txt = pango_small_context#create_layout in
419 Pango.Layout.set_text txt (
420 sprintf "%s %.1f%% %.1f%% %.1f%%" pkg.name
421 (display_percent pkg.size)
422 (display_percent increm)
423 (display_percent total)
428 let txt = pango_small_context#create_layout in
429 Pango.Layout.set_text txt (
430 sprintf "%s" pkg.name
434 let txts = [ txt1; txt2; txt3; txt4; txt5; txt6; txt7; txt8 ] in
436 let fore = choose_contrasting_colour colour in
438 let rec loop = function
441 let txt = Lazy.force txt in
442 let { Pango.width = txtwidth;
443 Pango.height = txtheight } =
444 Pango.Layout.get_pixel_extent txt in
445 (* Now with added fudge-factor. *)
446 if width >= txtwidth + 8 && height >= txtheight + 8 then
447 draw#put_layout ~x:(x+4) ~y:(y+4) ~fore txt
452 and draw_pkg_narrow x y width height colour =
453 draw#set_foreground colour;
454 draw#rectangle ~x:(x+2) ~y:(y+2)
455 ~width:(width-4) ~height:(height-4) ~filled:true ()
457 and choose_contrasting_colour = function
459 if r + g + b > 98304 then `BLACK else `WHITE
462 and darken = function
464 `RGB (r * 9 / 10, g * 9 / 10, b * 9 / 10)
467 and display_percent bytes =
468 100. *. Int64.to_float bytes /. Int64.to_float top_total
470 and display_size bytes =
471 if bytes > 104_857L then
472 sprintf "%.1f MB" (Int64.to_float bytes /. 1_048_576.)
473 else if bytes > 102L then
474 sprintf "%.1f KB" (Int64.to_float bytes /. 1_024.)
478 draw_tree 0. 0. tree;
480 (* Return false because this is a Gtk event handler. *)
483 ignore (da#event#connect#expose ~callback:repaint);