let main () =
let timer1 = Util.Timer.create "parsing" in
let timer2 = Util.Timer.create "conversion" in
let timer3 = Util.Timer.create "cudfio" in
let timer4 = Util.Timer.create "solver" in
let timer5 = Util.Timer.create "solution" 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);
let (native_arch,foreign_archs) =
get_architectures
(OptParse.Opt.opt Options.native_arch)
(OptParse.Opt.get Options.foreign_arch)
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 interpolate_solver_pat exec cudf_in cudf_out pref =
let _, exec = String.replace ~str:exec ~sub:"$in" ~by:cudf_in in
let _, exec = String.replace ~str:exec ~sub:"$out" ~by:cudf_out in
let _, exec = String.replace ~str:exec ~sub:"$pref" ~by:pref in
exec
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
|_ ->
let apt_req = Apt.parse_request_apt apt_get_cmdline in
Edsp.from_apt_request {request with Edsp.install = []; remove = []} apt_req
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 ->
print_error "(CUDF) Malformed universe %s" s;
in
let cudf_request = make_request tables universe native_arch 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 tmpdir = mktmpdir "tmp.apt-cudf.XXXXXXXXXX" in
at_exit (fun () -> rmtmpdir tmpdir);
let solver_in = Filename.concat tmpdir "in-cudf" in
Unix.mkfifo solver_in 0o600;
let solver_out = Filename.concat tmpdir "out-cudf" in
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
let cmd = interpolate_solver_pat exec_pat solver_in solver_out criteria in
debug "%s" cmd;
let env = Unix.environment () in
let (cin,cout,cerr) = Unix.open_process_full cmd env in
Util.Timer.start timer3;
let solver_in_fd = Unix.openfile solver_in [Unix.O_WRONLY ; Unix.O_SYNC] 0 in
let oc = Unix.out_channel_of_descr solver_in_fd in
Cudf_printer.pp_cudf oc cudf;
close_out oc ;
Util.Timer.stop timer3 ();
Util.Timer.start timer4;
let lines_cin = input_all_lines [] cin in
let lines = input_all_lines lines_cin cerr in
let stat = Unix.close_process_full (cin,cout,cerr) in
begin match stat with
|Unix.WEXITED 0 -> ()
|Unix.WEXITED i -> print_error "command '%s' failed with code %d" cmd i
|Unix.WSIGNALED i -> print_error "command '%s' killed by signal %d" cmd i
|Unix.WSTOPPED i -> print_error "command '%s' stopped by signal %d" cmd i
end;
info "%s" cmd;
debug "\n%s" (String.concat "\n" lines);
Util.Timer.stop timer4 ();
Util.Timer.start timer5;
if not(Sys.file_exists solver_out) then
print_error "(CRASH) Solution file not found"
else if check_fail solver_out then
print_error "(UNSAT) No Solutions according to the give preferences"
else begin
try begin
let solpre,soluniv =
if (Unix.stat solver_out).Unix.st_size <> 0 then
let cudf_parser = Cudf_parser.from_file solver_out in
try Cudf_parser.load_solution cudf_parser universe with
|Cudf_parser.Parse_error _
|Cudf.Constraint_violation _ as exn ->
print_error "(CRASH) Solution file contains an invalid solution"
else print_error "(CRASH) Solution file is empty"
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;
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"
end with Cudf.Constraint_violation s ->
print_error "(CUDF) Malformed solution: %s" s
end;
Util.Timer.stop timer5 ();
Sys.remove solver_in;
Sys.remove solver_out