4:47 p.m.
---
src/build.ml | 48 ++++++++++++++++++++++++++----------------------
src/chroot.ml | 12 +++++++-----
src/dpkg.ml | 16 +++++++++++++++-
src/ext2.ml | 8 +++++++-
4 files changed, 55 insertions(+), 29 deletions(-)
diff --git a/src/build.ml b/src/build.ml
index 9225184..0e2893d 100644
--- a/src/build.ml
+++ b/src/build.ml
@@ -106,11 +106,7 @@ let rec build debug
*)
let files = get_all_files packages in
let files =
- filter_map (
- function
- | { ft_config = false; ft_path = path } -> Some path
- | { ft_config = true } -> None
- ) files in
+ List.filter (fun file -> not file.ft_config) files in
if debug >= 1 then
printf "supermin: build: %d files\n%!" (List.length files);
@@ -120,9 +116,11 @@ let rec build debug
*)
let files =
List.filter (
- fun path ->
- try ignore (lstat path); true
- with Unix_error (err, fn, _) -> false
+ fun file ->
+ try ignore (lstat file.ft_source_path); true
+ with Unix_error (err, fn, _) ->
+ try ignore (lstat file.ft_path); true
+ with Unix_error (err, fn, _) -> false
) files in
if debug >= 1 then
@@ -139,9 +137,9 @@ let rec build debug
else (
let fn_flags = [FNM_NOESCAPE] in
List.filter (
- fun path ->
+ fun file ->
List.for_all (
- fun pattern -> not (fnmatch pattern path fn_flags)
+ fun pattern -> not (fnmatch pattern file.ft_path fn_flags)
) appliance.excludefiles
) files
) in
@@ -159,7 +157,9 @@ let rec build debug
) appliance.hostfiles in
let hostfiles = List.map Array.to_list hostfiles in
let hostfiles = List.flatten hostfiles in
- files @ hostfiles
+ files @ (List.map
+ (fun path -> {ft_path = path; ft_source_path = path; ft_config =
false})
+ hostfiles)
) in
if debug >= 1 then
@@ -326,7 +326,8 @@ and isalnum = function
* symlink.
*)
and munge files =
- let files = List.sort compare files in
+ let files =
+ List.sort (fun f1 f2 -> compare f1.ft_path f2.ft_path) files in
let rec stat_is_dir dir =
try (stat dir).st_kind = S_DIR with Unix_error _ -> false
@@ -345,21 +346,21 @@ and munge files =
let rec loop = function
| [] -> []
- | "/" :: rest ->
+ | root :: rest when root.ft_path = "/" ->
(* This is just to avoid a corner-case in subsequent rules. *)
loop rest
- | dir :: rest when stat_is_dir dir && dir_seen dir ->
+ | dir :: rest when stat_is_dir dir.ft_path && dir_seen dir.ft_path ->
dir :: loop rest
- | dir :: rest when is_lnk_to_dir dir ->
- insert_dir dir;
+ | dir :: rest when is_lnk_to_dir dir.ft_path ->
+ insert_dir dir.ft_path;
(* Symlink to a directory. Insert the target directory before
* if we've not seen it yet.
*)
- let target = readlink dir in
- let parent = Filename.dirname dir in
+ let target = readlink dir.ft_path in
+ let parent = Filename.dirname dir.ft_path in
(* Make the target an absolute path. *)
let target =
if String.length target < 1 || target.[0] <> '/' then
@@ -367,24 +368,27 @@ and munge files =
else
target in
if not (dir_seen target) then
+ let target = {ft_path = target; ft_source_path = target; ft_config = false} in
loop (target :: dir :: rest)
else
dir :: loop rest
- | dir :: rest when stat_is_dir dir ->
- insert_dir dir;
+ | dir :: rest when stat_is_dir dir.ft_path ->
+ insert_dir dir.ft_path;
(* Have we seen the parent? *)
- let parent = Filename.dirname dir in
+ let parent = Filename.dirname dir.ft_path in
if not (dir_seen parent) then
+ let parent = {ft_path = parent; ft_source_path = parent; ft_config = false} in
loop (parent :: dir :: rest)
else
dir :: loop rest
| file :: rest ->
(* Have we seen this parent directory before? *)
- let dir = Filename.dirname file in
+ let dir = Filename.dirname file.ft_path in
if not (dir_seen dir) then
+ let dir = {ft_path = dir; ft_source_path = dir; ft_config = false} in
loop (dir :: file :: rest)
else
file :: loop rest
diff --git a/src/chroot.ml b/src/chroot.ml
index 1e1ddb2..b5c1e53 100644
--- a/src/chroot.ml
+++ b/src/chroot.ml
@@ -20,13 +20,15 @@ open Unix
open Printf
open Utils
+open Package_handler
let build_chroot debug files outputdir =
List.iter (
- fun path ->
+ fun file ->
try
+ let path = file.ft_source_path in
let st = lstat path in
- let opath = outputdir // path in
+ let opath = outputdir // file.ft_path in
match st.st_kind with
| S_DIR ->
(* Note we fix up the permissions of directories in a second
@@ -65,9 +67,9 @@ let build_chroot debug files outputdir =
(* Second pass: fix up directory permissions in reverse. *)
let dirs = filter_map (
- fun path ->
- let st = lstat path in
- if st.st_kind = S_DIR then Some (path, st) else None
+ fun file ->
+ let st = lstat file.ft_source_path in
+ if st.st_kind = S_DIR then Some (file.ft_path, st) else None
) files in
List.iter (
fun (path, st) ->
diff --git a/src/dpkg.ml b/src/dpkg.ml
index 234bb63..efc8123 100644
--- a/src/dpkg.ml
+++ b/src/dpkg.ml
@@ -155,6 +155,17 @@ let dpkg_get_all_requires pkgs =
loop pkgs
let dpkg_get_all_files pkgs =
+ let cmd = sprintf "%s --list" Config.dpkg_divert in
+ let lines = run_command_get_lines cmd in
+ let diversions = Hashtbl.create (List.length lines) in
+ List.iter (
+ fun line ->
+ let items = string_split " " line in
+ match items with
+ | ["diversion"; "of"; path; "to"; real_path;
"by"; pkg] ->
+ Hashtbl.add diversions path real_path
+ | _ -> ()
+ ) lines;
let cmd =
sprintf "%s --listfiles %s | grep '^/' | grep -v '^/.$' | sort
-u"
Config.dpkg_query
@@ -166,7 +177,10 @@ let dpkg_get_all_files pkgs =
let config =
try string_prefix "/etc/" path && (lstat path).st_kind = S_REG
with Unix_error _ -> false in
- { ft_path = path; ft_source_path = path; ft_config = config }
+ let source_path =
+ try Hashtbl.find diversions path
+ with Not_found -> path in
+ { ft_path = path; ft_source_path = source_path; ft_config = config }
) lines
let dpkg_download_all_packages pkgs dir =
diff --git a/src/ext2.ml b/src/ext2.ml
index 701f52e..ccaa81f 100644
--- a/src/ext2.ml
+++ b/src/ext2.ml
@@ -21,6 +21,7 @@ open Printf
open Utils
open Ext2fs
+open Package_handler
(* The ext2 image that we build always has a fixed size, and we 'hope'
* that the files fit in (otherwise we'll get an error). Note that
@@ -66,7 +67,12 @@ let build_ext2 debug basedir files modpath kernel_version appliance =
printf "supermin: ext2: copying files from host filesystem\n%!";
(* Copy files from host filesystem. *)
- List.iter (fun path -> ext2fs_copy_file_from_host fs path path) files;
+ List.iter (fun file ->
+ if file_exists file.ft_source_path then
+ ext2fs_copy_file_from_host fs file.ft_source_path file.ft_path
+ else
+ ext2fs_copy_file_from_host fs file.ft_path file.ft_path
+ ) files;
if debug >= 1 then
printf "supermin: ext2: copying kernel modules\n%!";
--
1.9.0