rpmdepsize.ml

   1 (* rpmdepsize - visualize the size of RPM dependencies
   2  * (C) Copyright 2009 Red Hat Inc.
   3  *
   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.
   8  *
   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.
  13  *
  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.
  17  *
  18  * Written by Richard W.M. Jones <rjones@redhat.com>
  19  *)
  20
  21 open Sexplib
  22 TYPE_CONV_PATH "."
  23
  24 open ExtList
  25 open Unix
  26 open Printf
  27
  28 (* This corresponds to the sexpr that we write out from the
  29  * Python code.  OCaml will type-check it.
  30  *)
  31 type root_packages = string * packages
  32 and packages = pkg list
  33 and pkg = {
  34   nevra : string;                       (* name-[epoch:]version-release.arch *)
  35   name : string;
  36   epoch : int;
  37   version : string;
  38   release : string;
  39   arch : string;
  40   size : int64;                         (* installed size, excl. dirs *)
  41   deps : string list;
  42 }
  43  with sexp
  44
  45 (* Full dependency representation.  This is actually a graph because
  46  * it contains dependency loops.  'deps list' is a ref because we
  47  * update it as we are building it.
  48  *)
  49 type deps = Deps of pkg * deps list ref
  50
  51 (* Final tree representation, loops removed, and everything we want to
  52  * display stored in the nodes.
  53  *)
  54 type tree = Tree of pkg * int64 * int64 * tree list
  55
  56 module StringMap = Map.Make (String)
  57 let (+^) = Int64.add
  58 let sum = List.fold_left (+^) 0L
  59 let spaces n = String.make n ' '
  60
  61 let () =
  62   (* Run the Python program and read in the generated sexpr. *)
  63   let cmd =
  64     sprintf "./repodeps %s" (Filename.quote Sys.argv.(1)) in
  65   let chan = open_process_in cmd in
  66   ignore (input_line chan); (* drop "Loaded plugins" *)
  67   let root, pkgs =
  68     root_packages_of_sexp (Sexp.of_string (Std.input_all chan)) in
  69   (match close_process_in chan with
  70    | WEXITED 0 -> ()
  71    | WEXITED i -> failwith (sprintf "command exited with status %d" i)
  72    | WSIGNALED i | WSTOPPED i ->
  73        failwith (sprintf "command stopped with signal %d" i)
  74   );
  75
  76   (* Create the dependency graph, probably contains loops so beware. *)
  77   let deps = List.map (fun pkg -> Deps (pkg, ref [])) pkgs in
  78   let depsmap =
  79     List.fold_left (
  80       fun map (Deps (pkg, _) as deps) ->
  81         StringMap.add pkg.nevra deps map
  82     ) StringMap.empty deps in
  83   List.iter (
  84     fun (Deps (pkg, deps)) ->
  85       let deps' = List.map (fun n -> StringMap.find n depsmap) pkg.deps in
  86       deps := List.append !deps deps'
  87   ) deps;
  88
  89   (* For each package, calculate the total installed size of the package,
  90    * which includes all subpackages pulled in.  So it's what would be
  91    * installed if you did 'yum install foo'.
  92    *)
  93   let total pkg =
  94     let seen = ref StringMap.empty in
  95     let rec _total = function
  96       | Deps (pkg, _) when StringMap.mem pkg.nevra !seen -> 0L
  97       | Deps (pkg, { contents = children }) ->
  98           seen := StringMap.add pkg.nevra true !seen;
  99           pkg.size +^ sum (List.map _total children)
 100     in
 101     _total (StringMap.find pkg.nevra depsmap)
 102   in
 103   let totalsmap =
 104     List.fold_left (
 105       fun map pkg -> StringMap.add pkg.nevra (total pkg) map
 106     ) StringMap.empty pkgs in
 107
 108   (* Create the final display tree.  Each node is sorted so that
 109    * children with the largest contribution come first (on the left).
 110    * We remove packages which are already installed by earlier
 111    * (leftward) packages.  At each node we also store total size and
 112    * size of the additional packages.
 113    *)
 114   let tree =
 115     let seen = ref StringMap.empty in
 116     let rec build_tree = function
 117       | Deps (pkg, _) when StringMap.mem pkg.nevra !seen -> None
 118       | Deps (pkg, { contents = children }) ->
 119           (* Sort children by reverse total size. *)
 120           let cmp (Deps (p1, _)) (Deps (p2, _)) =
 121             let t1 = StringMap.find p1.nevra totalsmap in
 122             let t2 = StringMap.find p2.nevra totalsmap in
 123             compare t2 t1
 124           in
 125           let children = List.sort ~cmp children in
 126           seen := StringMap.add pkg.nevra true !seen;
 127           let children = List.filter_map build_tree children in
 128           let total = StringMap.find pkg.nevra totalsmap in
 129           let childadditional =
 130             let rec sum_child_sizes = function
 131               | Tree (pkg, _, _, children) ->
 132                   List.fold_left (
 133                     fun size child -> size +^ sum_child_sizes child
 134                   ) pkg.size children
 135             in
 136             sum_child_sizes (Tree (pkg, 0L, 0L, children)) in
 137           Some (Tree (pkg, total, childadditional, children))
 138     in
 139     Option.get (build_tree (StringMap.find root depsmap)) in
 140
 141   (* Display tree. *)
 142   let rec display ?(indent=0) = function
 143     | Tree (pkg, total, childadditional, children) ->
 144         printf "%s%s %Ld/%Ld/%Ld\n"
 145           (spaces indent) pkg.nevra pkg.size childadditional total;
 146         List.iter (display ~indent:(indent+2)) children
 147   in
 148   display tree