2 * Copyright (C) 2009-2010 Red Hat Inc.
4 * This program is free software; you can redistribute it and/or modify
5 * it under the terms of the GNU General Public License as published by
6 * the Free Software Foundation; either version 2 of the License, or
7 * (at your option) any later version.
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
14 * You should have received a copy of the GNU General Public License
15 * along with this program; if not, write to the Free Software
16 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
22 open Febootstrap_package_handlers
23 open Febootstrap_utils
24 open Febootstrap_cmdline
26 (* Create a temporary directory for use by all the functions in this file. *)
27 let tmpdir = tmpdir ()
30 debug "%s %s" Config.package_name Config.package_version;
32 (* Instead of printing out warnings as we go along, accumulate them
33 * in lists and print them all out at the end.
35 let warn_unreadable = ref [] in
37 (* Determine which package manager this system uses. *)
39 let ph = get_package_handler () in
41 debug "selected package handler: %s" (get_package_handler_name ());
43 (* Not --names: check files exist. *)
44 if not names_mode then (
47 if not (file_exists pkg) then (
48 eprintf "febootstrap: %s: no such file (did you miss out the --names option?)\n" pkg;
54 (* --names: resolve the package list to a full list of package names
55 * (including dependencies).
59 let packages = ph.ph_resolve_dependencies_and_download packages in
60 debug "resolved packages: %s" (String.concat " " packages);
65 (* Get the list of files. *)
70 let files = ph.ph_list_files pkg in
71 List.map (fun (filename, ft) -> filename, ft, pkg) files
75 (* Sort and combine duplicate files. *)
77 let files = List.sort compare files in
79 let combine (name1, ft1, pkg1) (name2, ft2, pkg2) =
80 (* Rules for combining files. *)
81 if ft1.ft_config || ft2.ft_config then (
82 eprintf "febootstrap: error: %s is a config file which is listed in two packages (%s, %s)\n"
86 if (ft1.ft_dir || ft2.ft_dir) && (not (ft1.ft_dir && ft2.ft_dir)) then (
87 eprintf "febootstrap: error: %s appears as both directory and ordinary file (%s, %s)\n"
97 let rec loop = function
99 | (name1, _, _ as f1) :: (name2, _, _ as f2) :: fs when name1 = name2 ->
100 let f = combine f1 f2 in loop (f :: fs)
101 | f :: fs -> f :: loop fs
105 (* Because we may have excluded some packages, and also because of
106 * distribution packaging errors, it's not necessarily true that a
107 * directory is created before each file in that directory.
108 * Determine those missing directories and add them now.
111 let insert_dir, dir_seen =
112 let h = Hashtbl.create (List.length files) in
113 let insert_dir dir = Hashtbl.replace h dir true in
114 let dir_seen dir = Hashtbl.mem h dir in
119 fun (path, { ft_dir = is_dir }, _ as f) ->
124 let parent = Filename.dirname path in
125 if dir_seen parent then []
128 let newdir = (parent, { ft_dir = true; ft_config = false;
129 ft_ghost = false; ft_mode = 0o40755;
132 newdir :: loop parent
135 List.rev (f :: loop path)
137 List.flatten files in
140 debug "%d files and directories" (List.length files);
143 fun (name, { ft_dir = dir; ft_ghost = ghost; ft_config = config;
144 ft_mode = mode; ft_size = size }, pkg) ->
145 printf "%s [%s%s%s%o %d] from %s\n" name
146 (if dir then "dir " else "")
147 (if ghost then "ghost " else "")
148 (if config then "config " else "")
154 (* Split the list of files into ones for hostfiles and ones for base image. *)
155 let p_hmac = Str.regexp "^\\..*\\.hmac$" in
157 let hostfiles = ref []
158 and baseimgfiles = ref [] in
160 fun (path, {ft_dir = dir; ft_ghost = ghost; ft_config = config} ,_ as f) ->
161 let file = Filename.basename path in
163 (* Ignore boot files, kernel, kernel modules. Supermin appliances
164 * are booted from external kernel and initrd, and
165 * febootstrap-supermin-helper copies the host kernel modules.
166 * Note we want to keep the /boot and /lib/modules directory entries.
168 if string_prefix "/boot/" path then ()
169 else if string_prefix "/lib/modules/" path then ()
171 (* Always write directory names to both output files. *)
173 hostfiles := f :: !hostfiles;
174 baseimgfiles := f :: !baseimgfiles;
177 (* Timezone configuration is config, but copy it from host system. *)
178 else if path = "/etc/localtime" then
179 hostfiles := f :: !hostfiles
181 (* Ignore FIPS files (.*.hmac) (RHBZ#654638). *)
182 else if Str.string_match p_hmac file 0 then ()
184 (* Ghost files are created empty in the base image. *)
186 baseimgfiles := f :: !baseimgfiles
188 (* For config files we can't rely on the host-installed copy
189 * since the admin may have modified then. We have to get the
190 * original file from the package and put it in the base image.
193 baseimgfiles := f :: !baseimgfiles
195 (* Anything else comes from the host. *)
197 hostfiles := f :: !hostfiles
199 let hostfiles = List.rev !hostfiles
200 and baseimgfiles = List.rev !baseimgfiles in
202 (* Write hostfiles. *)
204 (* Regexps used below. *)
205 let p_ld_so = Str.regexp "^ld-[.0-9]+\\.so$" in
206 let p_libbfd = Str.regexp "^libbfd-.*\\.so$" in
207 let p_libgcc = Str.regexp "^libgcc_s-.*\\.so\\.\\([0-9]+\\)$" in
208 let p_libntfs3g = Str.regexp "^libntfs-3g\\.so\\..*$" in
209 let p_lib123so = Str.regexp "^lib\\(.*\\)-[-.0-9]+\\.so$" in
211 Str.regexp "^lib\\(.*\\)-[-.0-9]+\\.so\\.\\([0-9]+\\)\\." in
212 let p_libso123 = Str.regexp "^lib\\(.*\\)\\.so\\.\\([0-9]+\\)\\." in
213 let ntfs3g_once = ref false in
215 let chan = open_out (tmpdir // "hostfiles") in
217 fun (path, {ft_dir = is_dir; ft_ghost = ghost; ft_config = config;
218 ft_mode = mode }, _) ->
219 let dir = Filename.dirname path in
220 let file = Filename.basename path in
223 fprintf chan "%s\n" path
225 (* Warn about hostfiles which are unreadable by non-root. We
226 * won't be able to add those to the appliance at run time, but
227 * there's not much else we can do about it except get the
228 * distros to fix this nonsense.
230 else if mode land 0o004 = 0 then
231 warn_unreadable := path :: !warn_unreadable
233 (* Replace fixed numbers in some library names by wildcards. *)
234 else if Str.string_match p_ld_so file 0 then
235 fprintf chan "%s/ld-*.so\n" dir
237 (* Special case for libbfd. *)
238 else if Str.string_match p_libbfd file 0 then
239 fprintf chan "%s/libbfd-*.so\n" dir
241 (* Special case for libgcc_s-<gccversion>-<date>.so.N *)
242 else if Str.string_match p_libgcc file 0 then
243 fprintf chan "%s/libgcc_s-*.so.%s\n" dir (Str.matched_group 1 file)
245 (* Special case for libntfs-3g.so.* *)
246 else if Str.string_match p_libntfs3g file 0 then (
247 if not !ntfs3g_once then (
248 fprintf chan "%s/libntfs-3g.so.*\n" dir;
253 (* libfoo-1.2.3.so *)
254 else if Str.string_match p_lib123so file 0 then
255 fprintf chan "%s/lib%s-*.so\n" dir (Str.matched_group 1 file)
257 (* libfoo-1.2.3.so.123 (but NOT '*.so.N') *)
258 else if Str.string_match p_lib123so123 file 0 then
259 fprintf chan "%s/lib%s-*.so.%s.*\n" dir
260 (Str.matched_group 1 file) (Str.matched_group 2 file)
262 (* libfoo.so.1.2.3 (but NOT '*.so.N') *)
263 else if Str.string_match p_libso123 file 0 then
264 fprintf chan "%s/lib%s.so.%s.*\n" dir
265 (Str.matched_group 1 file) (Str.matched_group 2 file)
267 (* Anything else comes from the host. *)
269 fprintf chan "%s\n" path
275 * We have to create directories and copy files to tmpdir/root
276 * and then call out to cpio to construct the initrd.
278 let rootdir = tmpdir // "root" in
281 fun (path, { ft_dir = is_dir; ft_ghost = ghost; ft_config = config;
282 ft_mode = mode }, pkg) ->
283 (* Always write directory names to both output files. *)
285 (* Directory permissions are fixed up below. *)
286 if path <> "/" then mkdir (rootdir // path) 0o755
289 (* Ghost files are just touched with the correct perms. *)
291 let chan = open_out (rootdir // path) in
293 chmod (rootdir // path) (mode land 0o777 lor 0o400)
296 (* For config files we can't rely on the host-installed copy
297 * since the admin may have modified it. We have to get the
298 * original file from the package.
300 else if config then (
301 let outfile = ph.ph_get_file_from_package pkg path in
303 (* Note that the output config file might not be a regular file. *)
304 let statbuf = lstat outfile in
306 let destfile = rootdir // path in
308 (* Depending on the file type, copy it to destination. *)
309 match statbuf.st_kind with
311 (* Unreadable files (eg. /etc/gshadow). Make readable. *)
312 if statbuf.st_perm = 0 then chmod outfile 0o400;
315 (Filename.quote outfile) (Filename.quote destfile) in
317 chmod destfile (mode land 0o777 lor 0o400)
319 let link = readlink outfile in
320 symlink link destfile
321 | S_DIR -> assert false
326 eprintf "febootstrap: error: %s: don't know how to handle this type of file\n" path;
331 assert false (* should not be reached *)
334 (* Fix up directory permissions, in reverse order. Since we don't
335 * want to have a read-only directory that we can't write into above.
338 fun (path, { ft_dir = is_dir; ft_mode = mode }, _) ->
339 if is_dir then chmod (rootdir // path) (mode land 0o777 lor 0o700)
340 ) (List.rev baseimgfiles);
342 (* Construct the 'base.img' initramfs. Feed in the list of filenames
343 * partly because we conveniently have them, and partly because
344 * this results in a nice alphabetical ordering in the cpio file.
346 (*let cmd = sprintf "ls -lR %s" rootdir in
347 ignore (Sys.command cmd);*)
349 sprintf "(cd %s && cpio --quiet -o -0 -H newc) > %s"
350 rootdir (tmpdir // "base.img") in
351 let chan = open_process_out cmd in
352 List.iter (fun (path, _, _) -> fprintf chan ".%s\000" path) baseimgfiles;
353 let stat = close_process_out chan in
357 eprintf "febootstrap: command '%s' failed (returned %d), see earlier error messages\n" cmd i;
360 eprintf "febootstrap: command '%s' killed by signal %d" cmd i;
363 eprintf "febootstrap: command '%s' stopped by signal %d" cmd i;
367 (* Undo directory permissions, because rm -rf can't delete files in
368 * unreadable directories.
371 fun (path, { ft_dir = is_dir; ft_mode = mode }, _) ->
372 if is_dir then chmod (rootdir // path) 0o755
373 ) (List.rev baseimgfiles);
375 (* Print warnings. *)
377 (match !warn_unreadable with
380 eprintf "febootstrap: warning: some host files are unreadable by non-root\n";
381 eprintf "febootstrap: warning: get your distro to fix these files:\n";
383 (fun path -> eprintf "\t%s\n%!" path)
384 (List.sort compare paths)
388 (* Near-atomically copy files to the final output directory. *)
389 debug "writing %s ..." (outputdir // "base.img");
392 (Filename.quote (tmpdir // "base.img"))
393 (Filename.quote (outputdir // "base.img")) in
395 debug "writing %s ..." (outputdir // "hostfiles");
398 (Filename.quote (tmpdir // "hostfiles"))
399 (Filename.quote (outputdir // "hostfiles")) in