Don't pass use_installed to every package handler function.
[febootstrap.git] / src / febootstrap_debian.ml
1 (* febootstrap 3
2  * Copyright (C) 2009-2011 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 get_installed_pkgs =
32   let pkgs = ref None in
33   let rec f () =
34     match !pkgs with
35     | None ->
36       pkgs :=
37         Some (run_command_get_lines
38                 "dpkg-query --show --showformat='${Package}\\n'");
39       f ()
40     | Some pkgs -> pkgs
41   in
42   f
43
44 let debian_detect () =
45   file_exists "/etc/debian_version" &&
46     Config.aptitude <> "no" && Config.apt_cache <> "no" && Config.dpkg <> "no"
47
48 let debian_init () =
49   ()
50
51 let rec debian_resolve_dependencies_and_download names =
52   let cmd =
53     sprintf "%s depends --recurse -i %s | grep -v '^[<[:space:]]'"
54       Config.apt_cache
55       (String.concat " " (List.map Filename.quote names)) in
56   let pkgs = run_command_get_lines cmd in
57   let pkgs =
58     if Config.apt_cache_depends_recurse_broken then
59       workaround_broken_apt_cache_depends_recurse (sort_uniq pkgs)
60     else
61       pkgs in
62
63   (* Exclude packages matching [--exclude] regexps on the command line. *)
64   let pkgs =
65     List.filter (
66       fun name ->
67         not (List.exists (fun re -> Str.string_match re name 0) excludes)
68     ) pkgs in
69
70   let present_pkgs, download_pkgs = List.partition (
71     fun pkg -> List.exists ((=) pkg) (get_installed_pkgs ())
72   ) pkgs in
73
74   debug "wanted packages (present / download): %s / %s\n"
75     (String.concat " " present_pkgs)
76     (String.concat " " download_pkgs);
77
78   (* Download the packages. *)
79   if (List.length download_pkgs > 0)
80   then (
81     let cmd =
82       sprintf "umask 0000; cd %s && %s download %s"
83         (Filename.quote tmpdir)
84         Config.aptitude
85         (String.concat " " (List.map Filename.quote download_pkgs)) in
86     run_command cmd
87   );
88
89   (* Find out what aptitude downloaded. *)
90   let files = Sys.readdir tmpdir in
91
92   let download_pkgs = List.map (
93     fun pkg ->
94       (* Look for 'pkg_*.deb' in the list of files. *)
95       let pre = pkg ^ "_" in
96       let r = ref "" in
97       try
98         for i = 0 to Array.length files - 1 do
99           if string_prefix pre files.(i) then (
100             r := files.(i);
101             files.(i) <- "";
102             raise Exit
103           )
104         done;
105         eprintf "febootstrap: aptitude: error: no file was downloaded corresponding to package %s\n" pkg;
106         exit 1
107       with
108           Exit -> !r
109   ) download_pkgs in
110
111   List.sort compare (List.append present_pkgs download_pkgs)
112
113 (* On Ubuntu 10.04 LTS, apt-cache depends --recurse is broken.  It
114  * doesn't return the full list of dependencies.  Therefore recurse
115  * into these dependencies one by one until we reach a fixpoint.
116  *)
117 and workaround_broken_apt_cache_depends_recurse names =
118   debug "workaround for broken 'apt-cache depends --recurse' command:\n  %s"
119     (String.concat " " names);
120
121   let names' =
122     List.map (
123       fun name ->
124         let cmd =
125           sprintf "%s depends --recurse -i %s | grep -v '^[<[:space:]]'"
126             Config.apt_cache (Filename.quote name) in
127         run_command_get_lines cmd
128     ) names in
129   let names' = List.flatten names' in
130   let names' = sort_uniq names' in
131   if names <> names' then
132     workaround_broken_apt_cache_depends_recurse names'
133   else
134     names
135
136 let debian_list_files_downloaded pkg =
137   debug "unpacking %s ..." pkg;
138
139   (* We actually need to extract the file in order to get the
140    * information about modes etc.
141    *)
142   let pkgdir = tmpdir // pkg ^ ".d" in
143   mkdir pkgdir 0o755;
144   let cmd =
145     sprintf "umask 0000; dpkg-deb --fsys-tarfile %s | (cd %s && tar xf -)"
146       (tmpdir // pkg) pkgdir in
147   run_command cmd;
148
149   let cmd = sprintf "cd %s && find ." pkgdir in
150   let lines = run_command_get_lines cmd in
151
152   let files = List.map (
153     fun path ->
154       assert (path.[0] = '.');
155       (* No leading '.' *)
156       let path =
157         if path = "." then "/"
158         else String.sub path 1 (String.length path - 1) in
159
160       (* Find out what it is and get the canonical filename. *)
161       let statbuf = lstat (pkgdir // path) in
162       let is_dir = statbuf.st_kind = S_DIR in
163
164       (* No per-file metadata like in RPM, but we can synthesize it
165        * from the path.
166        *)
167       let config = statbuf.st_kind = S_REG && string_prefix "/etc/" path in
168
169       let mode = statbuf.st_perm in
170
171       (path, { ft_dir = is_dir; ft_config = config; ft_mode = mode;
172                ft_ghost = false; ft_size = statbuf.st_size })
173   ) lines in
174
175   files
176
177 let debian_list_files_installed pkg =
178   debug "using installed package %s ..." pkg;
179   let cmd = sprintf "dpkg-query --listfiles %s" pkg in
180   let lines = run_command_get_lines cmd in
181   (* filter out lines not directly describing fs objects such as
182      "package diverts others to: /path/to/..." *)
183   let lines = List.filter (
184     fun l -> l.[0] = '/' && l.[1] != '.'
185   ) lines in
186   let files = List.map (
187     fun path ->
188       let statbuf = lstat path in
189       let is_dir = statbuf.st_kind = S_DIR in
190       let config = statbuf.st_kind = S_REG && string_prefix "/etc/" path in
191       let mode = statbuf.st_perm in
192       (path, { ft_dir = is_dir; ft_config = config; ft_mode = mode;
193                ft_ghost = false; ft_size = statbuf.st_size })
194   ) lines in
195   files
196
197 let debian_list_files pkg =
198   if use_installed && List.exists ((=) pkg) (get_installed_pkgs ()) then
199     debian_list_files_installed pkg
200   else
201     debian_list_files_downloaded pkg
202
203 (* Easy because we already unpacked the archive above. *)
204 let debian_get_file_from_package pkg file =
205   if use_installed && List.exists (fun p -> p = pkg) (get_installed_pkgs ())
206   then
207     file
208   else
209     tmpdir // pkg ^ ".d" // file
210
211 let () =
212   let ph = {
213     ph_detect = debian_detect;
214     ph_init = debian_init;
215     ph_resolve_dependencies_and_download =
216       debian_resolve_dependencies_and_download;
217     ph_list_files = debian_list_files;
218     ph_get_file_from_package = debian_get_file_from_package;
219   } in
220   register_package_handler "debian" ph