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
|
{- dfsbuild: CD image builder
Copyright (c) 2006 John Goerzen
Please see COPYRIGHT for more details
-}
module Actions.ConfigFiles where
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.Glob
import MissingH.Path.FilePath
import Control.Monad
import MissingH.ConfigParser
import MissingH.IO.HVFS
import System.Time
import Text.Printf
getDate =
getClockTime >>= toCalendarTime >>= (return . calendarTimeToString)
buildinfo env =
do return $ "This is a Debian From Scratch (DFS) live CD made by dfsbuild" ++
"\n\nName: " ++ eget env "name" ++
"\nVersion: " ++ eget env "version" ++
"\nBuilder: " ++ eget env "builder" ++
"\nPreparation Date: " ++ datestr env ++ "\n"
writeBuildInfo env =
buildinfo env >>=
(writeFile ((targetdir env) ++ "/opt/dfsruntime/buildinfo"))
getidstring :: DFSEnv -> String
getidstring env =
printf "DFS: %s %s (%s)" (eget env "name") (eget env "version")
(datestr env)
writeCfgFiles env =
do bi <- buildinfo env
writeit appendFile "/etc/issue" ("\n" ++ bi ++ "\n")
case options (cp env) "appendfiles" of
Left _ -> return ()
Right files ->
mapM_ (\fn -> writeit appendFile fn (esget env "appendfiles" fn))
files
case options (cp env) "createfiles" of
Left _ -> return ()
Right files ->
mapM_ (\fn -> writeit writeFile fn (esget env "createfiles" fn))
files
case options (cp env) "symlinks" of
Left _ -> return ()
Right files ->
mapM_ (\from -> do dm $ "Symlinking " ++ from
createSymbolicLink (esget env "symlinks" from)
((targetdir env) ++ from)
) files
case get (cp env) (defaultArch env) "deletefiles" of
Left _ -> return ()
Right files ->
do delfiles <- mapM glob (splitWs files)
mapM_ deleteit (map ((targetdir env) ++) $ concat delfiles)
case get (cp env) (defaultArch env) "makedirs" of
Left _ -> return ()
Right files ->
mapM_ (\fn -> createDirectory ((targetdir env) ++ fn) 0o755)
(splitWs files)
where writeit func fn info =
func ((targetdir env) ++ fn) (info ++ "\n")
fixRc env =
do recursiveRemove SystemFS ((targetdir env) ++ "/etc/rc2.d")
safeSystem "cp" ["-r", targetdir env ++ "/etc/rc1.d",
targetdir env ++ "/etc/rc2.d"]
cpfiles <- glob $ targetdir env ++ "/etc/rc3.d/*logd*"
safeSystem "cp" $ ["-r"] ++ cpfiles ++ [targetdir env ++ "/etc/rc2.d/"]
rmfiles <- glob $ targetdir env ++ "/etc/rc2.d/S*single"
mapM_ deleteit rmfiles
kernelimgconf =
"do_symlinks = no\n\
\do_bootloader = no\n\
\do_bootfloppy = no\n\
\do_initrd = yes\n\
\warn_initrd = yes\n"
|
