(** Debhelper wrapper functions *) (** capture stdout and stderr of a command, raise exception on failure. *) let filter_command errfn outfn s = let (output, input, errors) = Unix.open_process_full s (Unix.environment ()) in let outdescr = Unix.descr_of_in_channel output and errdescr = Unix.descr_of_in_channel errors in Unix.set_nonblock outdescr; Unix.set_nonblock errdescr; (* Read lines from stderr until eof or it would block, then do the same for stdout *) let stderreof = ref false and stdouteof = ref false in while not !stderreof || not !stdouteof do if not !stderreof then begin try while true do errfn (input_line errors) done with End_of_file -> stderreof := true | Sys_blocked_io -> () end; if not !stdouteof then begin try while true do outfn (input_line output) done with End_of_file -> stdouteof := true | Sys_blocked_io -> () end; done; match Unix.close_process_full (output, input, errors) with Unix.WEXITED 0 -> () | Unix.WEXITED n -> raise (Failure (s ^ " -> " ^ (string_of_int n))) | Unix.WSTOPPED n -> raise (Failure (s ^ " stopped: " ^ (string_of_int n))) | Unix.WSIGNALED n -> raise (Failure (s ^ " signaled: " ^ (string_of_int n))) exception Unimplemented of string (** Shared and common debhelper options *) type option = All (* common *) | Arch (* shared *) | AutoDest (* common *) | CleanUp (* extra (ocaml only) *) | DestDir of string (* dh_builddeb *) | DirsOnly (* dh_clean *) | DryRun (* common *) | Exclude of string (* common *) | Filename of string (* dh_builddeb *) | IncludeConffiles (* dh_md5sums *) | Indep (* shared *) | Keep (* dh_clean, dh_installchangelogs *) | LdPath of string list (* dh_shlibdeps *) | LibPackage of string (* dh_shlibdeps *) | ListMissing (* common *) | MainPackage of string (* shared *) | Major of string (* dh_makeshlibs *) | NoAct (* shared *) | NoPackage of string (* shared *) | NoScripts (* dh_makeshlibs, dh_installdocs, dh_installmodules, dh_installcatalogs *) | Package of string (* shared *) | Params of string (* dh_builddeb, dh_gencontrol, dh_shlibdeps *) | SameArch (* shared *) | SourceDir of string (* common *) | TmpDir of string (* shared *) | Verbose of int (* shared *) | VersionInfo of string (* dh_makeshlibs *) let string_of_option = function All -> "-A" | Arch -> "-a" | AutoDest -> "--autodest" | CleanUp -> "" | DestDir s -> "--destdir=" ^ s | DirsOnly -> "--dirs-only" | DryRun -> "-n" | Exclude s -> "-X" ^ s | Filename s -> "--filename=" ^ s | IncludeConffiles -> "--include-conffiles" | Indep -> "-i" | Keep -> "--keep" | LdPath l -> "-l" ^ (String.concat ":" l) | LibPackage s -> "-L" ^ s | ListMissing -> "--list-missing" | MainPackage s -> "--mainpackage=" ^ s | Major s -> "-m" ^ s | NoAct -> "--no-act" | NoPackage s -> "-N" ^ s | NoScripts -> "--noscripts" | Package s -> "-p" ^ s | Params s -> "-u'" ^ s ^ "'" | SameArch -> "-s" | SourceDir s -> "--sourcedir=" ^ s | TmpDir s -> "-P" ^ s | Verbose n -> if n >= 1 then "-v" else "" | VersionInfo s -> "-V" ^ s let global_options = ref [] let string_of_options options = String.concat " " (List.map string_of_option (options @ !global_options)) let verbosity options = let verboselist = List.filter (fun x -> match x with Verbose _ -> true | _ -> false) (options @ !global_options) in match verboselist with [] -> 0 | Verbose n :: _ -> n | _ -> raise (Failure "List.filter failure") (** Run a command and add a prefix to its output *) let command ?(verbose=0) s = if verbose >= 0 then prerr_endline ("* " ^ s); let f = if verbose >= 1 then fun line -> prerr_endline ("** " ^ line) else fun line -> () in filter_command f f s let argument_command exec dhopts args = let cmd = String.concat " " ([exec; string_of_options dhopts] @ args) in command ~verbose:(verbosity dhopts) cmd let standard_command exec dhopts = argument_command exec dhopts [] let builddeb ?(dhopts=[]) () = standard_command "dh_builddeb" dhopts let clean ?(dhopts=[]) files = argument_command "dh_clean" dhopts files let compress ?(dhopts=[]) files = argument_command "dh_compress" dhopts files let fixperms ?(dhopts=[]) () = standard_command "dh_fixperms" dhopts let gencontrol ?(dhopts=[]) () = standard_command "dh_gencontrol" dhopts (** Represents the lines of a dh_install input file. *) type item = File of string | Filedir of string * string let install ?(dhopts=[]) (inputs : (string * item list) list) = let verbose = verbosity dhopts in let path package = "debian/" ^ package ^ ".install" in List.iter (fun (package, items) -> let chan = open_out (path package) in List.iter (function File path -> Printf.fprintf chan "%s\n" path | Filedir (path, dir) -> Printf.fprintf chan "%s %s\n" path dir) items; close_out chan) inputs; let cmd = "dh_install " ^ (string_of_options dhopts) in command ~verbose:verbose cmd; if List.mem CleanUp dhopts then List.iter (fun (package, items) -> command ~verbose:verbose ("rm -f " ^ (path package))) inputs let installcatalogs ?(dhopts=[]) () = standard_command "dh_installcatalogs" dhopts let installchangelogs ?(dhopts=[]) upstream = argument_command "dh_installchangelogs" dhopts (match upstream with None -> [] | Some x -> [x]) let installcron ?(dhopts=[]) ?(d=("", "")) ?(daily="") ?(weekly="") ?(monthly="") = raise (Unimplemented "installcron") let installdeb ?(dhopts=[]) ?(preinst=[]) ?(postinst=[]) ?(postrm=[]) ?(prerm=[]) ?(shlibs=[]) ?(conffiles=[]) () = let verbose = verbosity dhopts in let inputs = ["preinst", preinst; "postinst", postinst; "postrm", postrm; "prerm", prerm; "shlibs", shlibs; "conffiles", conffiles] in let iter f = List.iter (fun (suffix, files) -> (List.iter (fun (package, text) -> f suffix package text) files)) inputs in iter (fun suffix package text -> let chan = open_out ("debian/" ^ package ^ "." ^ suffix) in output_string chan text; close_out chan); standard_command "dh_installdeb" dhopts; if List.mem CleanUp dhopts then iter (fun suffix package text -> command ~verbose:verbose ("rm -f debian/" ^ package ^ "." ^ suffix)) let installdebconf ?(dhopts=[]) () = raise (Unimplemented "installdebconf") let installdefoma ?(dhopts=[]) () = raise (Unimplemented "installdefoma") let installdirs ?(dhopts=[]) dirs = argument_command "dh_installdirs" dhopts dirs let installdocs ?(dhopts=[]) files = argument_command "dh_installdocs" dhopts files let installemacsen ?(dhopts=[]) () = raise (Unimplemented "installemacsen") let installexamples ?(dhopts=[]) files = argument_command "dh_installexamples" dhopts files let installinfo ?(dhopts=[]) () = raise (Unimplemented "installinfo") let installinit ?(dhopts=[]) () = raise (Unimplemented "installinit") let installlogrotate ?(dhopts=[]) () = raise (Unimplemented "installlogrotate") let installman ?(dhopts=[]) manpages = argument_command "dh_installman" dhopts manpages let installmenu ?(dhopts=[]) () = raise (Unimplemented "installmenu") let installmime ?(dhopts=[]) () = raise (Unimplemented "installmime") let installmodules ?(dhopts=[]) () = standard_command "dh_installmodules" dhopts let installpam ?(dhopts=[]) () = raise (Unimplemented "installpam") let installwm ?(dhopts=[]) () = raise (Unimplemented "installwm") let installxfonts ?(dhopts=[]) () = raise (Unimplemented "installxfonts") let link ?(dhopts=[]) links = argument_command "dh_installexamples" dhopts (List.map (fun (source, dest) -> source ^ " " ^ dest) links) let listpackages ?(dhopts=[]) () = let cmd = String.concat " " (["dh_listpackages"; (string_of_options dhopts)]) in let chan = Unix.open_process_in cmd in let names = ref [] in let rec loop () = try names := (input_line chan) :: !names; loop () with End_of_file -> ignore (Unix.close_process_in chan); List.rev !names in loop () let makeshlibs ?(dhopts=[]) () = standard_command "dh_makeshlibs" dhopts let md5sums ?(dhopts=[]) () = standard_command "dh_md5sums" dhopts let movefiles ?(dhopts=[]) () = raise (Unimplemented "movefiles") let ocamlld ?(dhopts=[]) () = raise (Unimplemented "ocamlld") let perl ?(dhopts=[]) () = raise (Unimplemented "perl") let python ?(dhopts=[]) () = raise (Unimplemented "python") let shlibdeps ?(dhopts=[]) () = standard_command "dh_shlibdeps" dhopts let strip ?(dhopts=[]) () = standard_command "dh_strip" dhopts let suidregister ?(dhopts=[]) () = raise (Unimplemented "suidregister") let testdir ?(dhopts=[]) files = argument_command "dh_testdir" dhopts files let testroot ?(dhopts=[]) () = standard_command "dh_testroot" dhopts let testversion ?(dhopts=[]) () = raise (Unimplemented "testversion") let undocumented ?(dhopts=[]) () = raise (Unimplemented "undocumented")