diff options
-rw-r--r-- | fsmgr.hs | 55 |
1 files changed, 30 insertions, 25 deletions
@@ -58,31 +58,36 @@ buildRoot DiskImageConfig{..} finalOut = do | |||
58 | cmd_ (Cwd mountpoint) "mkdir -p var/cache/debconf" | 58 | cmd_ (Cwd mountpoint) "mkdir -p var/cache/debconf" |
59 | cmd_ (Cwd mountpoint) "btrfs subvolume create var/cache/apt/archives" | 59 | cmd_ (Cwd mountpoint) "btrfs subvolume create var/cache/apt/archives" |
60 | -- TODO: catch errors and umount, rmdir mountpoint | 60 | -- TODO: catch errors and umount, rmdir mountpoint |
61 | {- 1. debconf -} | 61 | let (abortion :: IO ()) = do |
62 | forM_ debconfConfig $ | 62 | cmd_ "umount" [mountpoint] |
63 | readFile' >=> liftIO . appendFile (mountpoint </> "var/cache/debconf/config.dat") | 63 | cmd_ "rmdir" [mountpoint] |
64 | {- 2. dpkg installs -} | 64 | cmd_ "rm -f" [out] |
65 | let (debs, packageNames) = partitionPackages $ unpack . coerce <$> toList packages | 65 | handle' abortion $ do |
66 | when (noParent initialImage || not (null packageNames)) $ | 66 | {- 1. debconf -} |
67 | -- When there is no parent, selfstrap should install packages marked | 67 | forM_ debconfConfig $ |
68 | -- "Required" even if no packages are specified. When there is a parent, | 68 | readFile' >=> liftIO . appendFile (mountpoint </> "var/cache/debconf/config.dat") |
69 | -- assume that this has already happened. | 69 | {- 2. dpkg installs -} |
70 | cmd_ "selfstrap --skip-update" (("--unpack" `consWhen` unpackOnly) ["-t", mountpoint]) packageNames | 70 | let (debs, packageNames) = partitionPackages $ unpack . coerce <$> toList packages |
71 | forM_ debs $ \pkg -> do cmd_ "dpkg -i --root" [mountpoint, pkg] | 71 | when (noParent initialImage || not (null packageNames)) $ |
72 | {- 2.5. install apt package cache -} | 72 | -- When there is no parent, selfstrap should install packages marked |
73 | -- TODO | 73 | -- "Required" even if no packages are specified. When there is a parent, |
74 | {- 3. binaries -} | 74 | -- assume that this has already happened. |
75 | forM_ (unpack <$> binaries) $ \b -> do | 75 | cmd_ "selfstrap --skip-update" (("--unpack" `consWhen` unpackOnly) ["-t", mountpoint]) packageNames |
76 | p <- fromMaybe (fail $ "not found in ${PATH}: " ++ b) <$> liftIO (pathLocate b) | 76 | forM_ debs $ \pkg -> do cmd_ "dpkg -i --root" [mountpoint, pkg] |
77 | cmd_ "cp -L" [p] [mountpoint </> "usr/local/bin" </> b] | 77 | {- 2.5. install apt package cache -} |
78 | {- 4. custom setup commands -} | 78 | -- TODO |
79 | forM_ chrootCommands $ \c -> do | 79 | {- 3. binaries -} |
80 | cmd_ "chroot" [mountpoint] "/bin/sh -c" [unpack c] | 80 | forM_ (unpack <$> binaries) $ \b -> do |
81 | -- cleanup | 81 | p <- fromMaybe (fail $ "not found in ${PATH}: " ++ b) <$> liftIO (pathLocate b) |
82 | cmd_ "umount" [mountpoint] | 82 | cmd_ "cp -L" [p] [mountpoint </> "usr/local/bin" </> b] |
83 | cmd_ "rmdir" [mountpoint] | 83 | {- 4. custom setup commands -} |
84 | cmd_ "btrfstune -S1" [out] | 84 | forM_ chrootCommands $ \c -> do |
85 | cmd_ "mv" [out, finalOut] | 85 | cmd_ "chroot" [mountpoint] "/bin/sh -c" [unpack c] |
86 | -- cleanup | ||
87 | cmd_ "umount" [mountpoint] | ||
88 | cmd_ "rmdir" [mountpoint] | ||
89 | cmd_ "btrfstune -S1" [out] | ||
90 | cmd_ "mv" [out, finalOut] | ||
86 | 91 | ||
87 | partitionPackages :: [String] -> ([String], [String]) | 92 | partitionPackages :: [String] -> ([String], [String]) |
88 | partitionPackages = partition (elem '/') | 93 | partitionPackages = partition (elem '/') |