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
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
|
(**************************************************************************)
(* *)
(* 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 Datatypes_t
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 StringSet = BootstrapCommon.StringSet
module IntSet = BootstrapCommon.IntSet
module Options = struct
open OptParse
let usage = "%prog [options] --deb-native-arch=ARCH buildgraph srcgraph Packages Sources"
let description = "output statistics in JSON format"
let options = OptParser.make ~description ~ usage
include BootstrapCommon.MakeOptions(struct let options = options end)
let cycle_length = StdOpt.int_option ~default:2 ()
let cycle_length_fas = StdOpt.int_option ~default:8 ()
let remove_weak = StdOpt.str_option ()
let remove_reduced = str_list_option ()
let sapsb = StdOpt.store_true ()
let allowsrcmismatch = StdOpt.store_true ()
let available = StdOpt.str_option ()
open OptParser ;;
let prog_group = add_group options "Program specific options" in
add options ~group:prog_group ~long_name:"max-length" ~help:"maximum length of found cycles (default=2)" cycle_length;
add options ~group:prog_group ~long_name:"max-length-fas" ~help:"maximum length of found cycles for fas search (default=4)" cycle_length_fas;
add options ~group:prog_group ~long_name:"remove-weak" ~help:"path to list of weak build dependencies" remove_weak;
add options ~group:prog_group ~long_name:"sapsb" ~help:"calculate strong articulation points and strong bridges" sapsb;
add options ~group:prog_group ~long_name:"remove-reduced" ~help:"remove droppable build dependencies supplied by comma separated list of reduced dep files" remove_reduced;
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:"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;
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-ignore-essential"; "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";
Util.Warning.disable "Sources"; (* disable MismatchSrc warnings as exception is caught *)
StdDebug.all_quiet (OptParse.Opt.get Options.quiet);
let maxlengthfas = OptParse.Opt.get Options.cycle_length_fas in
let maxlength = OptParse.Opt.get Options.cycle_length in
let reduced_deps_files = OptParse.Opt.get Options.remove_reduced in
let allowsrcmismatch = OptParse.Opt.get Options.allowsrcmismatch in
let options = Options.set_deb_options () in
let noindep = options.Debcudf.drop_bd_indep in
let buildarch = Option.get options.Debcudf.native in
let hostarch = match options.Debcudf.host with None -> "" | Some s -> s in
let foreignarchs = options.Debcudf.foreign in
let bgf, sgf, posargs = match posargs with
| bgf::sgf::l -> bgf,sgf,l
| _ -> fatal "you must provide buildgraph, srcgraph, Packages and Sources"
in
let (binlist, (fgsrclist,bgsrclist), _) = BootstrapCommon.parse_packages ~noindep Options.parse_cmdline buildarch hostarch foreignarchs posargs in
let tables = Debcudf.init_tables (fgsrclist@bgsrclist@binlist) 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
let pkglist = List.map (Debcudf.tocudf ?inst:None ~options tables) binlist in
let universe = Cudf.load_universe (BootstrapCommon.unique [pkglist;fgsl;bgsl]) in
let module BG = BuildGraph.G in
let module SG = SrcGraph.G in
let ic = open_in bgf in
let bg = BuildGraph.from_ic universe buildarch ic in
close_in ic;
let ic = open_in sgf in
let sg = SrcGraph.from_ic universe buildarch ic in
close_in ic;
(* 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 module BGE = BuildGraphExtras.Make(struct let univ = universe end) in
let module BGS = BuildGraphStats.Make(struct let univ = universe end) in
let module SGE = SrcGraphExtras.Make(struct let univ = universe end) in
let module SGS = SrcGraphStats.Make(struct let univ = universe end) in
let binset = BootstrapCommon.get_bin_packages (BootstrapCommon.srcbin_table ~available:availableset ~allowmismatch:allowsrcmismatch universe) in
let type1, type2, type3 = SGS.self_cycles binset sg in
let srcpkglist = BGE.srcpkglist_of_g bg in
let weak_file =
if OptParse.Opt.is_set Options.remove_weak then
OptParse.Opt.get Options.remove_weak
else
""
in
let reduced_deps_ht, weak_deps_set = BootstrapCommon.get_reduced_deps_ht ~weak_file (OptParse.Opt.is_set Options.remove_weak) (buildarch::foreignarchs) srcpkglist reduced_deps_files in
BGE.remove_build_deps reduced_deps_ht bg;
let scc = List.filter_map (function [] | [_] -> None | s -> Some (BuildGraph.Oper.subgraph bg s)) (BuildGraph.Comp.scc_list bg) in
(* cudf to debian binary/source converter shorthands *)
let c2b = BootstrapCommon.debbintriplet_of_cudfpkg in
let c2s = BootstrapCommon.debsrctuple_of_cudfpkg in
let c2bl = List.map c2b in
let c2sl = List.map c2s in
let result = {
srcgraph = {
snr_vertex = SG.nb_vertex sg;
snr_edges = SG.nb_edges sg;
type1cycles = List.map (fun (pkg, d1, d2) -> (c2s pkg, c2bl d1, c2bl d2)) type1;
type2cycles = List.map (fun (pkg, d1, d2) -> (c2s pkg, c2bl d1, c2bl d2)) type2;
type3cycles = List.map (fun (pkg, deps) -> (c2s pkg, c2bl deps)) type3;
};
buildgraph = {
bnr_vertex = BG.nb_vertex bg;
bnr_edges = BG.nb_edges bg;
sccs = List.map (fun sg ->
let cycles, cycleedge = if maxlength > 0 then begin
let cycles = BuildGraph.Cycles.johnson ~maxlength sg in
cycles, (BGS.edges_in_most_cycles sg cycles)
end else [], [] in
let fas = if maxlengthfas > 0 then begin
let ht_fas = Hashtbl.create (BG.nb_edges sg) in
BuildGraph.EdgeSet.iter (fun (src,_,pkg) ->
Hashtbl.replace ht_fas src (pkg::(Hashtbl.find_default ht_fas src []))
) (BGE.calculate_fas ~maxlength:maxlengthfas sg);
Hashtbl.fold (fun k v acc -> (k,v)::acc) ht_fas []
end else [] in
let sap, sb = if OptParse.Opt.get Options.sapsb then begin
let sap = BuildGraph.Utils.find_strong_articulation_points sg in
let sb = BuildGraph.Utils.find_strong_bridges sg in
sap, sb
end else [], [] in
{
sg_vertex = BG.nb_vertex sg;
sg_edges = BG.nb_edges sg;
cycles = List.map BGE.variantlist_of_vlist cycles;
cycleedge = List.map (fun ((v1,_,v2),c) -> ((BGE.variant_of_vertex v1), (BGE.variant_of_vertex v2)), c) cycleedge;
builddeps = List.map (fun (p,deps) -> c2s p, c2bl deps) (BGS.min_builddep sg);
ratio_source = List.map (fun (s,b,n,o) -> c2s s, b, c2bl n, c2sl o) (BGS.ratio_source sg);
ratio_binary = List.map (fun (b,s,o) -> c2b b, s, c2sl o) (BGS.ratio_binary sg);
weak = List.map (fun (pkg, deps) -> c2s pkg, c2bl deps) (BGS.only_weak_missing weak_deps_set sg);
srcbinstats = List.map (fun (v,s,p) -> (BGE.variant_of_vertex v), s, p) (BGS.get_src_bin_stats sg);
fas = List.map (fun (p,deps) -> c2s (BGE.pkg_of_vertex p), c2bl (BGE.pkglist_of_vlist deps)) fas;
sap = List.map (fun (p,i) -> (BGE.variant_of_vertex p), i) sap;
sb = List.map (fun ((v1,_,v2),i) -> (BGE.variant_of_vertex v1, BGE.variant_of_vertex v2), i) sb;
}
) scc;
};
} in
(* we let this program output un-prettified JSON because to prettify we'd
* have to store the JSON data in a string which easily exceeds the maximum
* OCaml string length on 32 bit systems. Instead, the output of this program
* can be piped to ydump to prettify it.
*
* https://github.com/mjambon/atdgen/issues/43
* *)
let buf = Buffer.create 1000 in
Datatypes_j.write_stats buf result;
Buffer.output_buffer stdout buf;
;;
main ();;
|
