1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
|
{- dfsbuild: CD image builder
Copyright (c) 2006 John Goerzen
Please see COPYRIGHT for more details
-}
module Actions where
import Actions.ConfigFiles
import Utils
import qualified Actions.Mirror
import System.Posix.Directory
import System.Posix.Files
import MissingH.Str
import MissingH.Cmd
import MissingH.Path
import MissingH.Path.FilePath
import MissingH.Path.Glob
import Control.Monad
import Control.Exception
import Data.List
import MissingH.ConfigParser
import MissingH.IO.HVFS
import System.Directory hiding (createDirectory)
import qualified Actions.ConfigFiles
import qualified Bootloader
run env =
do im "Running."
mainRunner env
mainRunner env =
do state <- getState env
dm $ "Processing at state " ++ show state
shouldContinue <- case state of
Fresh -> do mapM_ (createDirectory `flip` 0o755)
[targetdir env, targetdir env ++ "/opt",
targetdir env ++ "/opt/dfsruntime"]
writeFile ((targetdir env) ++ "/opt/dfsruntime/marker") (marker env)
finished Initialized
Initialized -> -- Now download all suites we'll be using
do dlMirrors env
finished Mirrored
Mirrored -> -- Bootstrap the CD image
do cdebootstrap env
finished Bootstrapped
Bootstrapped -> -- Time to install shared files
do installlib env
finished LibsInstalled
LibsInstalled -> -- Install additional packages
do installpkgs env
finished Installed
Installed -> -- Time to install debs
do installdebs env
finished DebsInstalled
DebsInstalled -> -- Handle config files
do Actions.ConfigFiles.writeCfgFiles env
Actions.ConfigFiles.fixRc env
Actions.ConfigFiles.writeBuildInfo env
finished CfgHandled
CfgHandled -> -- Prepare init
do prepinit env
finished InitPrepped
InitPrepped -> -- Prepare the ramdisk
do preprd env
finished RDPrepped
RDPrepped -> -- Install kernels
do installKernels env
finished KernelsInstalled
KernelsInstalled -> -- Make the ramdisk
do safeSystem "mkcramfs" [(targetdir env) ++ "/opt/initrd",
(targetdir env) ++ "/boot/initrd.dfs"]
recursiveRemove SystemFS $ (targetdir env) ++ "/opt/initrd"
finished RamdiskBuilt
RamdiskBuilt -> -- Install the bootloader
do (isoargs, blfunc) <- Bootloader.install env
preprtrd env
compress env
isoname <- mkiso env isoargs
blfunc isoname
-- FINISHED!
return False
if shouldContinue
then mainRunner env
else dm $ "mainRunner finished."
where finished state = do saveState env state
return True
dlMirrors env =
do let suites = splitWs $ eget env "dlrepos"
Actions.Mirror.mirrorToWorkdir env suites
cdebootstrap env =
do im $ "Bootstrapping into " ++ targetdir env
-- cdebootstrap has issues when Release.gpg isn't there. Sigh.
safeSystem "find" [wdir env ++ "/mirror/dists", "-name", "Release",
"-exec", "touch", "{}.gpg", ";"]
safeSystem "cdebootstrap" $ debugargs ++
[eget env "suite", (targetdir env),
"file://" ++ (wdir env) ++ "/mirror"]
dm $ "Saving sources.list"
writeFile ((targetdir env) ++ "/etc/apt/sources.list") $
"deb " ++ (eget env "mirror") ++ " " ++ (eget env "suite")
++ " main\n"
dm $ "Moving mirror to /opt/packages on target"
rename ((wdir env) ++ "/mirror")
((targetdir env) ++ "/opt/packages")
where debugargs = if isDebugging env
then ["--debug", "-v"]
else ["-q"]
installpkgs env =
do im "Installing additional packages."
-- Set debconf priority to critical so that user doesn't get prompted
safeSystem "chroot" [targetdir env, "/bin/bash", "-c",
"echo \"debconf\tdebconf/priority\tselect\tcritical\" | debconf-set-selections"]
-- Copy resolv.conf so apt-get update/install works
safeSystem "cp" ["/etc/resolv.conf", targetdir env ++ "/etc"]
-- Update the cache
safeSystem "chroot" [targetdir env, "apt-get", "update"]
-- Prepare for kernel images
writeFile (targetdir env ++ "/etc/kernel-img.conf") kernelimgconf
-- Install the requisite initramfs tools
safeSystem "chroot" [targetdir env, "apt-get", "-y",
"--allow-unauthenticated", "install",
"initramfs-tools"]
-- And the ramfs support
safeSystem "cp" [libdir env ++ "/dfs-initramfs-hook",
targetdir env ++ "/usr/share/initramfs-tools/hooks/dfs"]
safeSystem "cp" [libdir env ++ "/dfs-initramfs-script",
targetdir env ++ "/usr/share/initramfs-tools/scripts/local-top/dfs"]
mapM_ (\x -> setFileMode ((targetdir env) ++ x) 0o755)
["/usr/share/initramfs-tools/hooks/dfs",
"/usr/share/initramfs-tools/scripts/local-top/dfs"]
-- Now do apt-get
safeSystem "chroot" $
[targetdir env, "apt-get", "-y", "--allow-unauthenticated", "install"] ++ pkgs
safeSystem "chroot" [targetdir env, "apt-get", "clean"]
-- preprtrd will require busybox-static, but earlier
-- packages need just busybox. So we download the .deb
-- and unpack it manually later. Sigh.
safeSystem "chroot" [targetdir env, "apt-get", "-d", "-y",
"--allow-unauthenticated", "install",
"busybox-static"]
safeSystem "chroot" [targetdir env, "sh", "-c",
"for FILE in /etc/pam.d/*; do grep -v securetty $FILE > $FILE.tmp; mv $FILE.tmp $FILE; done"]
-- And remove the resolv.conf again
removeFile (targetdir env ++ "/etc/resolv.conf")
where pkgs = splitWs (eget env "packages")
installlib env =
do im "Installing runtime library files."
-- Copy the runtime boot files
mapM_ (\x ->
safeSystem "cp" ["-rL", libdir ++ "/" ++ x,
(targetdir env) ++ "/opt/dfsruntime/"])
["home.html", "dfs_startup_funcs"]
-- Set modes
createDirectory ((targetdir env) ++ "/opt/dfsruntime/doc") 0o755
mapM_ (\x ->
safeSystem "cp" ["-r", docdir ++ "/" ++ x,
(targetdir env) ++ "/opt/dfsruntime/doc/"])
["dfs.txt.gz", "html/"]
mapM_ (\x -> do safeSystem "cp" ["-r", libdir ++ "/" ++ x,
(targetdir env) ++ "/usr/local/bin/"]
setFileMode ((targetdir env) ++ "/usr/local/bin/" ++ x)
0o755
) ["dfshelp", "dfshints", "dfsbuildinfo"]
where docdir = eget env "docdir"
libdir = eget env "libdir"
installdebs env =
do case get (cp env) (defaultArch env) "installdebs" of
Left _ -> return ()
Right debs ->
do im "Installing debs..."
safeSystem "dpkg" $ ["--root=" ++ (targetdir env), "-i"] ++
splitWs debs
case get (cp env) (defaultArch env) "unpackdebs" of
Left _ -> return ()
Right debs ->
do let deblist = splitWs debs
if deblist /= []
then do im "Unpacking .debs..."
createDirectory realtmpdir 0o755
mapM_ (\x -> safeSystem "cp" ["-v", x,
realtmpdir ++ "/"])
deblist
let debnames = map (\x -> chroottmpdir ++ "/" ++
(snd . splitFileName $ x)) deblist
safeSystem "chroot" $
[(targetdir env), "dpkg", "--force-depends",
"--force-conflicts", "--force-overwrite",
"--force-architecture", "--unpack"] ++ debnames
recursiveRemove SystemFS realtmpdir
else im "Not unpacking .debs since none listed in unpackdebs option"
safeSystem "sh" ["-c", "chroot " ++ (targetdir env) ++ " dpkg -l > " ++
(wdir env) ++ "/pkglist.txt"]
where
chroottmpdir = "/insttmp"
realtmpdir = (targetdir env) ++ chroottmpdir
prepinit env =
do im "Configuring init..."
rename (targetdir env ++ "/sbin/init")
(targetdir env ++ "/sbin/init.real")
safeSystem "cp" ["-v", libdir env ++ "/startup",
targetdir env ++ "/sbin/init"]
setFileMode (targetdir env ++ "/sbin/init") 0o755
preprd env =
do im "Preparing directory for ramdisk..."
createDirectory ((targetdir env) ++ "/tmp/busybox") 0o755
chr ["sh", "-c", "dpkg -x /var/cache/apt/archives/busybox-static*.deb /tmp/busybox"]
createDirectory ((targetdir env) ++ "/opt/initrd") 0o755
mapM_ (\x -> createDirectory ((targetdir env) ++ "/opt/initrd/" ++ x) 0o755)
["bin", "lib", "sbin", "proc", "usr", "usr/sbin", "usr/bin",
"realroot", "sys"]
chr ["sh", "-c", "cp -dv /lib/ld-* /opt/initrd/lib/"]
chr ["sh", "-c", "cp -v /lib/libc.so* /opt/initrd/lib/"]
chr ["cp", "-v", "/tmp/busybox/bin/busybox", "/opt/initrd/bin/"]
chr ["sh", "-c", "rm -r /tmp/busybox /var/cache/apt/archives/busybox-static*.deb"]
chr ["cp", "-v", "/usr/sbin/chroot", "/opt/initrd/usr/sbin/"]
chr ["cp", "-v", "/sbin/pivot_root", "/opt/initrd/sbin/"]
chr ["cp", "-r", "/dev", "/opt/initrd/"]
handle (\_ -> return ()) (removeLink ((targetdir env) ++ "/opt/initrd/linuxrc"))
safeSystem "cp" [(eget env "libdir") ++ "/linuxrc",
(targetdir env) ++ "/opt/initrd/sbin/init"]
setFileMode ((targetdir env) ++ "/opt/initrd/sbin/init") 0o755
safeSystem "cp" [eget env "libdir" ++ "/dfs_startup_funcs",
targetdir env ++ "/opt/initrd"]
writeFile ((targetdir env) ++ "/opt/initrd/marker") (marker env)
createSymbolicLink "busybox" (targetdir env ++ "/opt/initrd/bin/sh")
where chr args = safeSystem "chroot" $ ((targetdir env) : args)
installKernels env =
do dm "Installing kernels..."
case get (cp env) (defaultArch env) "kernels" of
Left _ -> return ()
Right k ->
do kernfiles <- mapM glob (splitWs k)
mapM_ (\x -> safeSystem "cp" ["-v", x, targetdir env ++ "/boot/"]) (concat kernfiles)
case get (cp env) (defaultArch env) "modules" of
Left _ -> return ()
Right m ->
do modfiles <- mapM glob (splitWs m)
mapM_ (\x -> safeSystem "cp" ["-vr", x, targetdir env ++ "/lib/modules/"]) (concat modfiles)
preprtrd env =
do im "Preparing run-time ramdisk"
createDirectory (targetdir env ++ "/opt/dfsruntime/runtimemnt") 0o755
let rdpath = targetdir env ++ "/opt/dfsruntime/runtimerd"
createDirectory rdpath 0o755
rdfiles <- mapM glob (splitWs . eget env $ "ramdisk_files")
mapM_ (cpfile2rd rdpath) (concat rdfiles)
where cpfile2rd rdpath f =
do let src = targetdir env ++ f
let dest = rdpath ++ f
let destdir = fst . splitFileName $ dest
dde <- doesDirectoryExist destdir
unless (dde)
(safeSystem "mkdir" ["-p", destdir])
handle (\_ -> return ())
(rename src dest)
createSymbolicLink ("/opt/dfsruntime/runtimemnt" ++ f) src
compress env =
case egetbool env "compress" of
False -> im "No image compression requested"
True -> reallycompress env
reallycompress env =
do im "Compressing image. This may take some time..."
let noncom = wdir env ++ "/noncom"
createDirectory noncom 0o755
noncomfiles <- filterM (\x -> vDoesExist SystemFS (targetdir env ++ x))
(splitWs (eget env "dontcompress"))
let noncommap = zip noncomfiles (map show [(0::Int)..])
mapM_ (preserve noncom) noncommap
safeSystem "mkzftree" [targetdir env, wdir env ++ "/zftree"]
recursiveRemove SystemFS (targetdir env)
rename (wdir env ++ "/zftree") (targetdir env)
mapM_ (restore noncom) noncommap
where preserve noncom (orig, tmp) =
do im $ "Not compressing " ++ orig
rename (targetdir env ++ orig) (noncom ++ "/" ++ tmp)
restore noncom (orig, tmp) =
rename (noncom ++ "/" ++ tmp) (targetdir env ++ orig)
mkiso env isoargs =
do im "Preparing ISO image"
let isofile = wdir env ++ "/image.iso"
let compressopts = if egetbool env "compress" then ["-z"] else []
safeSystem "mkisofs" $ compressopts ++ isoargs ++
["-pad", "-R", "-o", isofile, targetdir env]
return isofile
|
