let main () =
let resource_prefix =
match Filename.basename(Sys.argv.(0)) with
|"debcheck"|"dose-debcheck" -> "deb://"
|"eclipsecheck"|"dose-eclipsecheck" -> "eclipse://"
|"rpmcheck"|"dose-rpmcheck" -> "synth://"
|"cudfcheck"|"dose-cudfcheck" -> "cudf://"
|_ -> ""
in
let add_resource_prefix = List.map (function s -> resource_prefix^s) in
let posargs = OptParse.OptParser.parse_argv Options.options in
Boilerplate.enable_debug (OptParse.Opt.get Options.verbose);
Boilerplate.enable_timers (OptParse.Opt.get Options.timers) ["Solver"];
Boilerplate.enable_bars (OptParse.Opt.get Options.progress)
["Depsolver_int.univcheck";"Depsolver_int.init_solver"] ;
Boilerplate.all_quiet (OptParse.Opt.get Options.quiet);
let default_arch = OptParse.Opt.opt Options.architecture in
let fg =
if posargs = [] && resource_prefix <> "" then
add_resource_prefix ("-"::(OptParse.Opt.get Options.foreground))
else
add_resource_prefix (posargs@(OptParse.Opt.get Options.foreground))
in
let bg = add_resource_prefix (OptParse.Opt.get Options.background) in
let (preamble,pkgll,from_cudf,to_cudf) = Boilerplate.load_list ~default_arch [fg;bg] in
let (fg_pkglist, bg_pkglist) = match pkgll with [fg;bg] -> (fg,bg) | _ -> assert false in
let fg_pkglist =
if OptParse.Opt.get Options.latest then
let h = Hashtbl.create (List.length fg_pkglist) in
List.iter (fun p ->
try
let q = Hashtbl.find h p.Cudf.package in
if (CudfAdd.compare p q) > 0 then
Hashtbl.replace h p.Cudf.package p
else ()
with Not_found -> Hashtbl.add h p.Cudf.package p
) fg_pkglist;
Hashtbl.fold (fun _ v acc -> v::acc) h []
else
fg_pkglist
in
let universe =
let s = CudfAdd.to_set (fg_pkglist @ bg_pkglist) in
Cudf.load_universe (CudfAdd.Cudf_set.elements s)
in
let universe_size = Cudf.universe_size universe in
if OptParse.Opt.is_set Options.checkonly &&
OptParse.Opt.is_set Options.coinst then
fatal "--checkonly and --coinst cannot be speficied together";
let checklist =
if OptParse.Opt.is_set Options.checkonly then begin
info "--checkonly specified, consider all packages as background packages";
List.flatten (
List.map (function
|(p,None) -> Cudf.lookup_packages universe p
|(p,Some(c,v)) ->
let filter = Some(c,snd(to_cudf (p,v))) in
Cudf.lookup_packages ~filter universe p
) (OptParse.Opt.get Options.checkonly)
)
end else []
in
let coinstlist =
if OptParse.Opt.is_set Options.coinst then begin
info "--coinst specified, consider all packages as background packages";
List.map (function
|(p,None) -> Cudf.lookup_packages universe p
|(p,Some(c,v)) ->
let filter = Some(c,snd(to_cudf (p,v))) in
Cudf.lookup_packages ~filter universe p
) (OptParse.Opt.get Options.coinst)
end else []
in
let pp pkg =
let (p,v) = from_cudf (pkg.Cudf.package,pkg.Cudf.version) in
let l =
List.filter_map (fun k ->
try Some(k,Cudf.lookup_package_property pkg k)
with Not_found -> None
) ["architecture";"source";"sourcenumber"]
in (p,v,l)
in
info "Solving..." ;
let failure = OptParse.Opt.get Options.failures in
let success = OptParse.Opt.get Options.successes in
let explain = OptParse.Opt.get Options.explain in
let summary = OptParse.Opt.get Options.summary in
let fmt =
if OptParse.Opt.is_set Options.outfile then
let oc = open_out (OptParse.Opt.get Options.outfile) in
Format.formatter_of_out_channel oc
else
Format.std_formatter
in
let results = Diagnostic.default_result universe_size in
if OptParse.Opt.is_set Options.architecture then
Format.fprintf fmt "architecture: %s@." (OptParse.Opt.get Options.architecture);
if failure || success then Format.fprintf fmt "@[<v 1>report:@,";
let callback d =
if summary then Diagnostic.collect results d ;
Diagnostic.fprintf ~pp ~failure ~success ~explain fmt d
in
Util.Timer.start timer;
let number_broken =
if OptParse.Opt.is_set Options.coinst then
let rl = Depsolver.edos_coinstall_prod universe coinstlist in
let number_broken_tuples =
List.length (List.filter (fun r -> not (Diagnostic.is_solution r)) rl)
and number_checks = List.length rl
in begin
ignore(Util.Timer.stop timer ());
List.iter callback rl;
if failure || success then Format.fprintf fmt "@]@.";
Format.fprintf fmt "total-packages: %d@." universe_size;
Format.fprintf fmt "total-tuples: %d@." number_checks;
Format.fprintf fmt "broken-tuples: %d@." number_broken_tuples;
number_broken_tuples
end
else begin
let number_broken_packages =
if OptParse.Opt.is_set Options.checkonly then
Depsolver.listcheck ~callback universe checklist
else begin
if bg_pkglist = [] then
Depsolver.univcheck ~callback universe
else
Depsolver.listcheck ~callback universe fg_pkglist
end
in
ignore(Util.Timer.stop timer ());
if failure || success then Format.fprintf fmt "@]@.";
let fn = List.length fg_pkglist in
let bn = List.length bg_pkglist in
let nb,nf =
let cl = List.length checklist in
if cl != 0 then ((fn + bn) - cl,cl) else (bn,fn)
in
Format.fprintf fmt "background-packages: %d@." nb;
Format.fprintf fmt "foreground-packages: %d@." nf;
Format.fprintf fmt "total-packages: %d@." universe_size;
Format.fprintf fmt "broken-packages: %d@." number_broken_packages;
if summary then
Format.fprintf fmt "@[%a@]@." (Diagnostic.pp_summary ~pp ()) results;
number_broken_packages
end
in
if number_broken > 0 then exit(1);