summaryrefslogtreecommitdiff
path: root/create-graph.ml
blob: c28b369150f1bf588760efe8c19651a75eab2c17 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
(**************************************************************************)
(*                                                                        *)
(*  Copyright (C) 2012 Johannes 'josch' Schauer <j.schauer@email.de>      *)
(*  Copyright (C) 2012 Pietro Abate <pietro.abate@pps.jussieu.fr>         *)
(*                                                                        *)
(*  This library is free software: you can redistribute it and/or modify  *)
(*  it under the terms of the GNU Lesser General Public License as        *)
(*  published by the Free Software Foundation, either version 3 of the    *)
(*  License, or (at your option) any later version.  A special linking    *)
(*  exception to the GNU Lesser General Public License applies to this    *)
(*  library, see the COPYING file for more information.                   *)
(**************************************************************************)

open! ExtLib
open Dose_common
open Dose_debian
open Dose_doseparse

#define __label __FILE__
let label =  __label ;;
include Util.Logging(struct let label = label end) ;;

let str_list_option ?(default=Some []) ?(metavar = "STRLST") =
  let sep = "," in
  let coerce s = ExtString.String.nsplit s sep in
  fun () ->
    OptParse.Opt.value_option metavar default coerce
    (fun _ s -> Printf.sprintf "Invalid String '%s'" s)

module IntSet = BootstrapCommon.IntSet
module StringSet = BootstrapCommon.StringSet

module Options = struct
  open OptParse

  let description = ("Given a repository of source packages and binary "^
    "packages, create the build graph and source graph for it")
  let usage = "%prog [options] Packages... Sources"

  let options = OptParser.make ~description ~usage
  include BootstrapCommon.MakeOptions(struct let options = options end)

  let available = StdOpt.str_option ()
  let custom_is_files = str_list_option ()
  let allowsrcmismatch = StdOpt.store_true ()
  let progress = StdOpt.store_true ()
  let timers = StdOpt.store_true ()
  let strongtype = StdOpt.store_true ()
  let closuretype = StdOpt.store_true ()
  let optgraph = StdOpt.store_true ()

  open OptParser ;;

  let prog_group = add_group options "Program specific options" in

  add options ~group:prog_group ~short_name:'A' ~long_name:"available"
    ~help:"List of available packages (arch:all, crossed...) in control file format" available;
  add options ~group:prog_group ~long_name:"custom-is" ~help:"list of files with dependencies that should not be part of the IS" custom_is_files;
  add options ~group:prog_group ~long_name:"allowsrcmismatch" ~help:("If a binary package is "^
    "without a source package but there is a source package of same name but "^ 
    "different version, match this binary package to that source package.") allowsrcmismatch;
  add options ~group:prog_group ~long_name:"progress" ~help:"print progress bars" progress;
  add options ~group:prog_group ~long_name:"timers" ~help:"print timing information" timers;
  add options ~group:prog_group ~long_name:"strongtype" ~help:"generate a strong build graph (only strong dependencies)" strongtype;
  add options ~group:prog_group ~long_name:"closuretype" ~help:"generate a dependency closure build graph (all dependency relationships)" closuretype;
  add options ~group:prog_group ~long_name:"optgraph" ~help:"generate installation sets with a minimum number of unavailable binary packages" optgraph;

  include StdOptions.InputOptions;;
  let default = List.filter (fun e -> not (List.mem e ["compare"; "checkonly"; "latest";"outfile";"inputtype"])) StdOptions.InputOptions.default_options in
  StdOptions.InputOptions.add_options ~default options ;;

  include StdOptions.DistribOptions;;
  let default = List.filter (fun e -> not (List.mem e ["deb-profiles"; "deb-builds-from"])) StdOptions.DistribOptions.default_options in
  StdOptions.DistribOptions.add_debian_options ~default options ;;
end

let main () =
  let posargs = OptParse.OptParser.parse_argv Options.options in
  StdDebug.enable_debug (OptParse.Opt.get Options.verbose);
  Util.Debug.disable "Depsolver_int";
  StdDebug.all_quiet (OptParse.Opt.get Options.quiet);
  StdDebug.enable_timers (OptParse.Opt.get Options.timers) ["build_graph"];
  StdDebug.enable_bars (OptParse.Opt.get Options.progress) ["build_graph"; "Strongdeps_int.main"];

  let options = Options.set_deb_options () in
  let hostarch = match options.Debcudf.host with None -> "" | Some s -> s in
  let buildarch = Option.get options.Debcudf.native in
  let foreignarchs = options.Debcudf.foreign in
  let noindep = options.Debcudf.drop_bd_indep in
  let custom_is_files = OptParse.Opt.get Options.custom_is_files in
  let allowsrcmismatch = OptParse.Opt.get Options.allowsrcmismatch in
  let strongtype = OptParse.Opt.get Options.strongtype in
  let closuretype = OptParse.Opt.get Options.closuretype in
  let optgraph = OptParse.Opt.get Options.optgraph in

  if strongtype && closuretype then
    fatal "cannot have --strongtype and --closuretype at the same time";

  if strongtype || closuretype then begin
    if List.length custom_is_files > 0 then
      fatal "cannot have --custom-is with --strongtype or --closuretype";
    if optgraph then
      fatal "cannot have --optgraph with --strongtype or --closuretype";
  end;

  let (binlist, (fgsrclist,bgsrclist), _) = BootstrapCommon.parse_packages ~noindep Options.parse_cmdline buildarch hostarch foreignarchs posargs in

  let tables = Debcudf.init_tables ~options (fgsrclist@bgsrclist@binlist) in
  let global_constraints = Debcudf.get_essential ~options tables in
  let fgsl = List.map (Debcudf.tocudf ?inst:None ~options tables) fgsrclist in
  let bgsl = List.map (Debcudf.tocudf ?inst:None ~options tables) bgsrclist in
  (* create a universe from foreground and background packages *)
  let pkglist = List.map (Debcudf.tocudf ?inst:None ~options tables) binlist in
  let universe = Cudf.load_universe (BootstrapCommon.unique [pkglist;fgsl;bgsl]) in

  (* read package list for available packages *)
  let availableset =
    if OptParse.Opt.is_set Options.available then
      BootstrapCommon.read_package_file ~archs:(buildarch::hostarch::foreignarchs) (Debcudf.tocudf ?inst:None ~options tables) (OptParse.Opt.get Options.available)
    else CudfAdd.Cudf_set.empty
  in
  let available pkg = CudfAdd.Cudf_set.mem pkg availableset in

  (* read custom_is_files for custom installation set instructions *)
  let custom_is_ht = BootstrapCommon.get_custom_is_ht buildarch custom_is_files in

  let module BG = BuildGraph.G in
  let module BGP = BuildGraph.Printer(struct let univ = universe end) in

  info "Generating Build Graph";

  let bg =
    if strongtype then begin
      BuildGraph.strong_graph ~global_constraints ~available ~allowmismatch:allowsrcmismatch universe fgsl
    end else if closuretype then begin
      BuildGraph.closure_graph ~global_constraints ~available ~allowmismatch:allowsrcmismatch universe fgsl
    end else begin
      (* create a buildgraph and a sourcegraph *)
      BuildGraph.dist_graph ~global_constraints ~available ~allowmismatch:allowsrcmismatch ~opt:optgraph custom_is_ht universe fgsl
    end
  in

  (* write out graphml *)
  info "Save Build Graph";
  BGP.print (Format.formatter_of_out_channel stdout) bg;
;;

main ();;