helper: Don't fail if objects are created in a symlinked dir (RHBZ#698089).
[febootstrap.git] / febootstrap_debian.ml
1 (* febootstrap 3
2  * Copyright (C) 2009-2010 Red Hat Inc.
3  *
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.
8  *
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.
13  *
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
17  *)
18
19 (* Debian support. *)
20
21 open Unix
22 open Printf
23
24 open Febootstrap_package_handlers
25 open Febootstrap_utils
26 open Febootstrap_cmdline
27
28 (* Create a temporary directory for use by all the functions in this file. *)
29 let tmpdir = tmpdir ()
30
31 let debian_detect () =
32   file_exists "/etc/debian_version" &&
33     Config.aptitude <> "no" && Config.dpkg <> "no"
34
35 let debian_resolve_dependencies_and_download names =
36   let cmd =
37     sprintf "apt-cache depends --recurse -i %s | grep -v '^[<[:space:]]'"
38       (String.concat " " (List.map Filename.quote names)) in
39   let pkgs = run_command_get_lines cmd in
40
41   (* Exclude packages matching [--exclude] regexps on the command line. *)
42   let pkgs =
43     List.filter (
44       fun name ->
45         not (List.exists (fun re -> Str.string_match re name 0) excludes)
46     ) pkgs in
47
48   (* Download the packages. *)
49   let cmd =
50     sprintf "cd %s && aptitude download %s"
51       (Filename.quote tmpdir)
52       (String.concat " " (List.map Filename.quote pkgs)) in
53   run_command cmd;
54
55   (* Find out what aptitude downloaded. *)
56   let files = Sys.readdir tmpdir in
57
58   let pkgs = List.map (
59     fun pkg ->
60       (* Look for 'pkg_*.deb' in the list of files. *)
61       let pre = pkg ^ "_" in
62       let r = ref "" in
63       try
64         for i = 0 to Array.length files - 1 do
65           if string_prefix pre files.(i) then (
66             r := files.(i);
67             files.(i) <- "";
68             raise Exit
69           )
70         done;
71         eprintf "febootstrap: aptitude: error: no file was downloaded corresponding to package %s\n" pkg;
72         exit 1
73       with
74           Exit -> !r
75   ) pkgs in
76
77   List.sort compare pkgs
78
79 let debian_list_files pkg =
80   debug "unpacking %s ..." pkg;
81
82   (* We actually need to extract the file in order to get the
83    * information about modes etc.
84    *)
85   let pkgdir = tmpdir // pkg ^ ".d" in
86   mkdir pkgdir 0o755;
87   let cmd =
88     sprintf "dpkg-deb --fsys-tarfile %s | (cd %s && tar xf -)"
89       (tmpdir // pkg) pkgdir in
90   run_command cmd;
91
92   let cmd = sprintf "cd %s && find ." pkgdir in
93   let lines = run_command_get_lines cmd in
94
95   let files = List.map (
96     fun path ->
97       assert (path.[0] = '.');
98       (* No leading '.' *)
99       let path =
100         if path = "." then "/"
101         else String.sub path 1 (String.length path - 1) in
102
103       (* Find out what it is and get the canonical filename. *)
104       let statbuf = lstat (pkgdir // path) in
105       let is_dir = statbuf.st_kind = S_DIR in
106
107       (* No per-file metadata like in RPM, but we can synthesize it
108        * from the path.
109        *)
110       let config = statbuf.st_kind = S_REG && string_prefix "/etc/" path in
111
112       let mode = statbuf.st_perm in
113
114       (path, { ft_dir = is_dir; ft_config = config; ft_mode = mode;
115                ft_ghost = false; ft_size = statbuf.st_size })
116   ) lines in
117
118   files
119
120 (* Easy because we already unpacked the archive above. *)
121 let debian_get_file_from_package pkg file =
122   tmpdir // pkg ^ ".d" // file
123
124 let () =
125   let ph = {
126     ph_detect = debian_detect;
127     ph_resolve_dependencies_and_download =
128       debian_resolve_dependencies_and_download;
129     ph_list_files = debian_list_files;
130     ph_get_file_from_package = debian_get_file_from_package;
131   } in
132   register_package_handler "debian" ph