+(* rpmdepsize - visualize the size of RPM dependencies
+ * (C) Copyright 2009 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+ *
+ * Written by Richard W.M. Jones <rjones@redhat.com>
+ *)
+
+open Sexplib
+TYPE_CONV_PATH "."
+
+open ExtList
+open Unix
+open Printf
+
+(* This corresponds to the sexpr that we write out from the
+ * Python code. OCaml will type-check it.
+ *)
+type root_packages = string * packages
+and packages = pkg list
+and pkg = {
+ nevra : string; (* name-[epoch:]version-release.arch *)
+ name : string;
+ epoch : int;
+ version : string;
+ release : string;
+ arch : string;
+ size : int64; (* installed size, excl. dirs *)
+ deps : string list;
+}
+ with sexp
+
+(* Full dependency representation. This is actually a graph because
+ * it contains dependency loops. 'deps list' is a ref because we
+ * update it as we are building it.
+ *)
+type deps = Deps of pkg * deps list ref
+
+(* Final tree representation, loops removed, and everything we want to
+ * display stored in the nodes.
+ *)
+type tree = Tree of pkg * int64 * int64 * tree list
+
+module StringMap = Map.Make (String)
+let (+^) = Int64.add
+let sum = List.fold_left (+^) 0L
+let spaces n = String.make n ' '
+
+let () =
+ (* Run the Python program and read in the generated sexpr. *)
+ let cmd =
+ sprintf "./repodeps %s" (Filename.quote Sys.argv.(1)) in
+ let chan = open_process_in cmd in
+ ignore (input_line chan); (* drop "Loaded plugins" *)
+ let root, pkgs =
+ root_packages_of_sexp (Sexp.of_string (Std.input_all chan)) in
+ (match close_process_in chan with
+ | WEXITED 0 -> ()
+ | WEXITED i -> failwith (sprintf "command exited with status %d" i)
+ | WSIGNALED i | WSTOPPED i ->
+ failwith (sprintf "command stopped with signal %d" i)
+ );
+
+ (* Create the dependency graph, probably contains loops so beware. *)
+ let deps = List.map (fun pkg -> Deps (pkg, ref [])) pkgs in
+ let depsmap =
+ List.fold_left (
+ fun map (Deps (pkg, _) as deps) ->
+ StringMap.add pkg.nevra deps map
+ ) StringMap.empty deps in
+ List.iter (
+ fun (Deps (pkg, deps)) ->
+ let deps' = List.map (fun n -> StringMap.find n depsmap) pkg.deps in
+ deps := List.append !deps deps'
+ ) deps;
+
+ (* For each package, calculate the total installed size of the package,
+ * which includes all subpackages pulled in. So it's what would be
+ * installed if you did 'yum install foo'.
+ *)
+ let total pkg =
+ let seen = ref StringMap.empty in
+ let rec _total = function
+ | Deps (pkg, _) when StringMap.mem pkg.nevra !seen -> 0L
+ | Deps (pkg, { contents = children }) ->
+ seen := StringMap.add pkg.nevra true !seen;
+ pkg.size +^ sum (List.map _total children)
+ in
+ _total (StringMap.find pkg.nevra depsmap)
+ in
+ let totalsmap =
+ List.fold_left (
+ fun map pkg -> StringMap.add pkg.nevra (total pkg) map
+ ) StringMap.empty pkgs in
+
+ (* Create the final display tree. Each node is sorted so that
+ * children with the largest contribution come first (on the left).
+ * We remove packages which are already installed by earlier
+ * (leftward) packages. At each node we also store total size and
+ * size of the additional packages.
+ *)
+ let tree =
+ let seen = ref StringMap.empty in
+ let rec build_tree = function
+ | Deps (pkg, _) when StringMap.mem pkg.nevra !seen -> None
+ | Deps (pkg, { contents = children }) ->
+ (* Sort children by reverse total size. *)
+ let cmp (Deps (p1, _)) (Deps (p2, _)) =
+ let t1 = StringMap.find p1.nevra totalsmap in
+ let t2 = StringMap.find p2.nevra totalsmap in
+ compare t2 t1
+ in
+ let children = List.sort ~cmp children in
+ seen := StringMap.add pkg.nevra true !seen;
+ let children = List.filter_map build_tree children in
+ let total = StringMap.find pkg.nevra totalsmap in
+ let childadditional =
+ let rec sum_child_sizes = function
+ | Tree (pkg, _, _, children) ->
+ List.fold_left (
+ fun size child -> size +^ sum_child_sizes child
+ ) pkg.size children
+ in
+ sum_child_sizes (Tree (pkg, 0L, 0L, children)) in
+ Some (Tree (pkg, total, childadditional, children))
+ in
+ Option.get (build_tree (StringMap.find root depsmap)) in
+
+ (* Display tree. *)
+ let rec display ?(indent=0) = function
+ | Tree (pkg, total, childadditional, children) ->
+ printf "%s%s %Ld/%Ld/%Ld\n"
+ (spaces indent) pkg.nevra pkg.size childadditional total;
+ List.iter (display ~indent:(indent+2)) children
+ in
+ display tree