let main () =
let timer1 = Util.Timer.create "parsing" in
let timer2 = Util.Timer.create "conversion" in
let args = OptParse.OptParser.parse_argv Options.options in
Boilerplate.enable_debug (OptParse.Opt.get Options.verbose);
Boilerplate.enable_bars (OptParse.Opt.get Options.progress) [] ;
Boilerplate.enable_timers (OptParse.Opt.get Options.timers)
["parsing";"cudfio";"conversion";"solver";"solution"];
Boilerplate.all_quiet (OptParse.Opt.get Options.quiet);
if apt_get_cmdline <> "" then
debug "APT_GET_CUDF_CMDLINE=%s" apt_get_cmdline;
debug "CUDFSOLVERS=%s" solver_dir;
let (native_arch,foreign_archs) =
get_architectures
(OptParse.Opt.opt Options.native_arch)
(OptParse.Opt.opt Options.foreign_archs)
in
let solver =
if OptParse.Opt.is_set Options.solver then
OptParse.Opt.get Options.solver
else
Filename.basename(Sys.argv.(0))
in
let exec_pat = fst (parse_solver_spec (Filename.concat solver_dir solver)) in
let ch =
match args with
|[] -> (IO.input_channel stdin)
|file::_ -> Input.open_file file
in
Util.Timer.start timer1;
let archs = native_arch::foreign_archs in
let (request,pkglist) = Edsp.input_raw_ch ~archs ch in
let request =
match apt_get_cmdline with
|"" -> request
|_ -> begin
let apt_req = Apt.parse_request_apt apt_get_cmdline in
Edsp.from_apt_request native_arch {request with Edsp.install = []; remove = []} apt_req
end
in
Util.Timer.stop timer1 ();
if args <> [] then Input.close_ch ch;
Util.Timer.start timer2;
let tables = Debcudf.init_tables pkglist in
let default_preamble =
let l = List.map snd Edsp.extras_tocudf in
CudfAdd.add_properties Debcudf.preamble l
in
let univ = Hashtbl.create (2*(List.length pkglist)-1) in
let options = {
Debcudf.default_options with
Debcudf.native = native_arch;
Debcudf.foreign = foreign_archs }
in
let cudfpkglist =
List.filter_map (fun pkg ->
let p = Edsp.tocudf tables ~options pkg in
if not(Hashtbl.mem univ (p.Cudf.package,p.Cudf.version)) then begin
Hashtbl.add univ (p.Cudf.package,p.Cudf.version) pkg;
Some p
end else begin
warning "Duplicated package (same version, name and architecture) : (%s,%s,%s)"
pkg.Packages.name pkg.Packages.version pkg.Packages.architecture;
None
end
) pkglist
in
let cudfdump = Filename.temp_file "apt-cudf-universe" ".cudf" in
if OptParse.Opt.get Options.dump || OptParse.Opt.get Options.noop then begin
Printf.printf "Apt-cudf: dump cudf universe in %s\n" cudfdump;
let oc = open_out cudfdump in
Cudf_printer.pp_preamble oc default_preamble;
Printf.fprintf oc "\n";
Cudf_printer.pp_packages oc cudfpkglist;
close_out oc
end;
let universe =
try Cudf.load_universe cudfpkglist
with Cudf.Constraint_violation s ->
fatal "(CUDF) Malformed universe %s" s
in
let cudf_request = Edsp.requesttocudf tables universe request in
let cudf = (default_preamble,universe,cudf_request) in
Util.Timer.stop timer2 ();
if OptParse.Opt.get Options.dump || OptParse.Opt.get Options.noop then begin
Printf.printf "Apt-cudf: append cudf request to %s\n" cudfdump;
let oc = open_out_gen
[Open_wronly; Open_append; Open_creat; Open_text]
0o666 cudfdump
in
Printf.fprintf oc "\n";
Cudf_printer.pp_request oc cudf_request;
close_out oc
end;
if OptParse.Opt.get Options.noop then exit(0);
let cmdline_criteria = OptParse.Opt.opt Options.criteria in
let conffile = OptParse.Opt.get Options.conffile in
let criteria = choose_criteria ~criteria:cmdline_criteria ~conffile solver request in
OptParse.Opt.set Options.criteria criteria ;
let solpre,soluniv =
let explain = OptParse.Opt.get Options.explain in
match Algo.Depsolver.check_request ~cmd:exec_pat ~criteria ~explain cudf with
|Algo.Depsolver.Error s -> fatal "%s" s
|Algo.Depsolver.Unsat _ -> fatal "(UNSAT) No Solutions according to the give preferences"
|Algo.Depsolver.Sat s -> s
in
if OptParse.Opt.get Options.dump then begin
let cudfsol = Filename.temp_file "apt-cudf-solution" ".cudf" in
Printf.printf "Apt-cudf: dump cudf solution in %s\n" cudfsol;
let oc = open_out cudfsol in
Cudf_printer.pp_preamble oc default_preamble;
Printf.fprintf oc "\n";
Cudf_printer.pp_universe oc soluniv;
close_out oc
end;
let diff = CudfDiff.diff universe soluniv in
let empty = ref true in
Hashtbl.iter (fun pkgname s ->
let inst = s.CudfDiff.installed in
let rem = s.CudfDiff.removed in
match CudfAdd.Cudf_set.is_empty inst, CudfAdd.Cudf_set.is_empty rem with
|false,true -> begin
empty := false;
Format.printf "Install: %a@." pp_pkg (inst,univ)
end
|true,false -> begin
empty := false;
Format.printf "Remove: %a@." pp_pkg (rem,univ)
end
|false,false -> begin
empty := false;
Format.printf "Install: %a@." pp_pkg (inst,univ)
end
|true,true -> ()
) diff;
List.iter (fun (n,c) ->
try
let s = Hashtbl.find diff n in
if (CudfAdd.Cudf_set.is_empty s.CudfDiff.installed) then begin
List.iter (fun pkg ->
empty := false;
Format.printf "Install: %a@." pp_pkg ((CudfAdd.Cudf_set.singleton pkg),univ)
) (CudfAdd.who_provides soluniv (n,c))
end
with Not_found -> ()
) cudf_request.Cudf.install;
if OptParse.Opt.get Options.explain then begin
let (i,u,d,r) = CudfDiff.summary universe diff in
Format.printf "Summary: " ;
if i <> [] then
Format.printf "%d to install " (List.length i);
if r <> [] then
Format.printf "%d to remove " (List.length r);
if u <> [] then
Format.printf "%d to upgrade " (List.length u);
if d <> [] then
Format.printf "%d to downgrade " (List.length d);
Format.printf " @.";
if i <> [] then
Format.printf "Installed: %a@." pp_pkg_list (i,univ);
if r <> [] then
Format.printf "Removed: %a@." pp_pkg_list (r,univ);
if u <> [] then
Format.printf "Upgraded: %a@." pp_pkg_list_tran (u,univ);
if d <> [] then
Format.printf "Downgraded: %a@." pp_pkg_list_tran (d,univ);
end;
if !empty then
print_progress ~i:100 "No packages removed or installed";