List.flatten (
List.map (
fun pkg ->
- let files = ph.ph_list_files pkg in
+ let files = ph.ph_list_files ~use_installed pkg in
List.map (fun (filename, ft) -> filename, ft, pkg) files
) packages
) in
* original file from the package.
*)
else if config then (
- let outfile = ph.ph_get_file_from_package pkg path in
+ let outfile = ph.ph_get_file_from_package ~use_installed pkg path in
(* Note that the output config file might not be a regular file. *)
let statbuf = lstat outfile in
Don't remove temporary files and directories on exit. This is useful
for debugging.
+=item B<--use-installed>
+
+If packages are already installed, use the contents (from the local
+filesystem) instead of downloading them.
+
+Note that this can cause malformed appliances if local files have been
+changed from what was originally in the package. This is particularly
+a problem for configuration files.
+
+However this option is useful in some controlled situations: for
+example when using febootstrap inside a freshly installed chroot.
+
=item B<-v>
=item B<--verbose>
let outputdir = ref "."
let packages = ref []
let save_temps = ref false
+let use_installed = ref false
let verbose = ref false
let warnings = ref true
let yum_config = ref None
" Don't delete temporary files and directories on exit.";
"--save-temps", Arg.Set save_temps,
" Don't delete temporary files and directories on exit.";
+ "--use-installed", Arg.Set use_installed,
+ " Inspect already installed packages for determining contents.";
"-v", Arg.Set verbose,
" Enable verbose output";
"--verbose", Arg.Set verbose,
let outputdir = !outputdir
let packages = List.rev !packages
let save_temps = !save_temps
+let use_installed = !use_installed
let verbose = !verbose
let warnings = !warnings
let yum_config = !yum_config
val save_temps : bool
(** True if [--save-temps] was given on the command line. *)
+val use_installed : bool
+ (** True if [--use-installed] was given on the command line *)
+
val verbose : bool
(** True if [--verbose] was given on the command line.
See also {!debug}. *)
(* Create a temporary directory for use by all the functions in this file. *)
let tmpdir = tmpdir ()
+let installed_pkgs =
+ run_command_get_lines "dpkg-query --show --showformat='${Package}\\n'"
+
let debian_detect () =
file_exists "/etc/debian_version" &&
Config.aptitude <> "no" && Config.apt_cache <> "no" && Config.dpkg <> "no"
not (List.exists (fun re -> Str.string_match re name 0) excludes)
) pkgs in
+ let present_pkgs, download_pkgs = List.partition (
+ fun pkg -> List.exists ((=) pkg) installed_pkgs
+ ) pkgs in
+
+ debug "wanted packages (present / download): %s / %s\n"
+ (String.concat " " present_pkgs)
+ (String.concat " " download_pkgs);
+
(* Download the packages. *)
- let cmd =
- sprintf "umask 0000; cd %s && %s download %s"
- (Filename.quote tmpdir)
- Config.aptitude
- (String.concat " " (List.map Filename.quote pkgs)) in
- run_command cmd;
+ if (List.length download_pkgs > 0)
+ then (
+ let cmd =
+ sprintf "umask 0000; cd %s && %s download %s"
+ (Filename.quote tmpdir)
+ Config.aptitude
+ (String.concat " " (List.map Filename.quote download_pkgs)) in
+ run_command cmd
+ );
(* Find out what aptitude downloaded. *)
let files = Sys.readdir tmpdir in
- let pkgs = List.map (
+ let download_pkgs = List.map (
fun pkg ->
(* Look for 'pkg_*.deb' in the list of files. *)
let pre = pkg ^ "_" in
exit 1
with
Exit -> !r
- ) pkgs in
+ ) download_pkgs in
- List.sort compare pkgs
+ List.sort compare (List.append present_pkgs download_pkgs)
(* On Ubuntu 10.04 LTS, apt-cache depends --recurse is broken. It
* doesn't return the full list of dependencies. Therefore recurse
else
names
-let debian_list_files pkg =
+let debian_list_files_downloaded pkg =
debug "unpacking %s ..." pkg;
(* We actually need to extract the file in order to get the
files
+let debian_list_files_installed pkg =
+ debug "using installed package %s ..." pkg;
+ let cmd = sprintf "dpkg-query --listfiles %s" pkg in
+ let lines = run_command_get_lines cmd in
+ (* filter out lines not directly describing fs objects such as
+ "package diverts others to: /path/to/..." *)
+ let lines = List.filter (
+ fun l -> l.[0] = '/' && l.[1] != '.'
+ ) lines in
+ let files = List.map (
+ fun path ->
+ let statbuf = lstat path in
+ let is_dir = statbuf.st_kind = S_DIR in
+ let config = statbuf.st_kind = S_REG && string_prefix "/etc/" path in
+ let mode = statbuf.st_perm in
+ (path, { ft_dir = is_dir; ft_config = config; ft_mode = mode;
+ ft_ghost = false; ft_size = statbuf.st_size })
+ ) lines in
+ files
+
+let debian_list_files ?(use_installed=false) pkg =
+ if use_installed && List.exists ((=) pkg) installed_pkgs then
+ debian_list_files_installed pkg
+ else
+ debian_list_files_downloaded pkg
+
(* Easy because we already unpacked the archive above. *)
-let debian_get_file_from_package pkg file =
- tmpdir // pkg ^ ".d" // file
+let debian_get_file_from_package ?(use_installed=false) pkg file =
+ if use_installed && List.exists (fun p -> p = pkg) installed_pkgs then
+ file
+ else
+ tmpdir // pkg ^ ".d" // file
let () =
let ph = {
type package_handler = {
ph_detect : unit -> bool;
ph_resolve_dependencies_and_download : string list -> string list;
- ph_list_files : string -> (string * file_type) list;
- ph_get_file_from_package : string -> string -> string
+ ph_list_files : ?use_installed:bool -> string -> (string * file_type) list;
+ ph_get_file_from_package : ?use_installed:bool -> string -> string -> string
}
and file_type = {
ft_dir : bool;
Note this should also process the [excludes] list. *)
- ph_list_files : string -> (string * file_type) list;
+ ph_list_files : ?use_installed:bool -> string -> (string * file_type) list;
(** [ph_list_files pkg] lists the files and file metadata in the
package called [pkg] (a package file). *)
- ph_get_file_from_package : string -> string -> string;
+ ph_get_file_from_package : ?use_installed:bool -> string -> string -> string;
(** [ph_get_file_from_package pkg file] extracts the
single named file [file] from [pkg]. The path of the
extracted file is returned. *)
List.sort compare pkgs
-let pacman_list_files pkg =
+let pacman_list_files ?(use_installed=false) pkg =
+ if use_installed then
+ failwith "pacman driver doesn't support --use-installed";
+
debug "unpacking %s ..." pkg;
(* We actually need to extract the file in order to get the
files
(* Easy because we already unpacked the archive above. *)
-let pacman_get_file_from_package pkg file =
+let pacman_get_file_from_package ?(use_installed=false) pkg file =
+ if use_installed then
+ failwith "pacman driver doesn't support --use-installed";
+
tmpdir // pkg ^ ".d" // file
let () =
sprintf "%s/%s-%s-%s.%s.rpm" tmpdir name version release arch
) pkgs
-let rec yum_rpm_list_files pkg =
+let rec yum_rpm_list_files ?(use_installed=false) pkg =
+ if use_installed then
+ failwith "yum_rpm driver doesn't support --use-installed";
+
(* Run rpm -qlp with some extra magic. *)
let cmd =
sprintf "rpm -q --qf '[%%{FILENAMES} %%{FILEFLAGS:fflags} %%{FILEMODES} %%{FILESIZES}\\n]' -p %s"
files
-let yum_rpm_get_file_from_package pkg file =
+let yum_rpm_get_file_from_package ?(use_installed=false) pkg file =
+ if use_installed then
+ failwith "yum_rpm driver doesn't support --use-installed";
+
debug "extracting %s from %s ..." file (Filename.basename pkg);
let outfile = tmpdir // file in