support for debconf

1 files changed, 20 insertions, 8 deletions

diff --git a/fsmgr.hs b/fsmgr.hs
index 68def93..626f79f 100644
--- a/fsmgr.hs
+++ b/fsmgr.hs
@@ -55,7 +55,7 @@ data BaseImageSpecification
 data DiskImageConfig = DiskImageConfig {
   initialImage   :: BaseImageSpecification
 , packages       :: Set Package
--- , debconfConfig :: DebconfConfig
+, debconfConfig  :: Maybe FilePath
 , unpackOnly     :: Bool
 , binaries       :: Vector Text
 , chrootCommands :: Vector Text
@@ -69,7 +69,7 @@ diskImageConfigParser = object $
   DiskImageConfig
   <$> field "parent" ((EmptyImageOfBytes <$> integer) <> (ParentImageConfigFile . unpack <$> string))
   <*> (Set.fromList . toList . fmap parsePackageName <$> defaultField "packages" Vector.empty (array string))
-  -- <*> pure (DebconfConfig "")
+  <*> (fmap unpack <$> optField "debconf" string)
   <*> defaultField "unpack-only" False bool
   <*> defaultField "binaries" Vector.empty (array string)
   <*> defaultField "chroot-commands" Vector.empty (array string)
@@ -77,6 +77,10 @@ diskImageConfigParser = object $
 readCfg :: FilePath -> Action DiskImageConfig
 readCfg yaml = either error id . parse diskImageConfigParser . encodeUtf8 . pack <$> readFile' yaml
 
+noParent :: BaseImageSpecification -> Bool
+noParent (EmptyImageOfBytes _)     = True
+noParent (ParentImageConfigFile _) = False
+
 buildRoot :: DiskImageConfig -> FilePath -> Action ()
 buildRoot DiskImageConfig{..} finalOut = do
   let out        = finalOut <.> "tmp"
@@ -102,20 +106,28 @@ buildRoot DiskImageConfig{..} finalOut = do
       cmd_ "mount -t btrfs" [out, mountpoint]
 
       cmd_ (Cwd mountpoint) "mkdir -p var/cache/apt"
+      cmd_ (Cwd mountpoint) "mkdir -p var/cache/debconf"
       cmd_ (Cwd mountpoint) "btrfs subvolume create var/cache/apt/archives"
-
   -- TODO: catch errors and umount, rmdir mountpoint
+  {- 1. debconf -}
+  forM_ debconfConfig $
+    readFile' >=> liftIO . appendFile (mountpoint </> "var/cache/debconf/config.dat")
+  {- 2. dpkg installs -}
   let (debs, packageNames) = partitionPackages $ unpack . coerce <$> toList packages
-  -- TODO: don't even run seflstrap when packageNames is null and a parent image exists
-  cmd_ "selfstrap --skip-update"
-    (("--unpack" `consWhen` unpackOnly) ["-t", mountpoint]) packageNames
+  when (noParent initialImage || not (null packageNames)) $
+    -- When there is no parent, selfstrap should install packages marked
+    -- "Required" even if no packages are specified. When there is a parent,
+    -- assume that this has already happened.
+    cmd_ "selfstrap --skip-update" (("--unpack" `consWhen` unpackOnly) ["-t", mountpoint]) packageNames
+  forM_ debs $ \pkg -> do cmd_ "dpkg -i --root" [mountpoint, pkg]
+  {- 3. binaries -}
   forM_ (unpack <$> binaries) $ \b -> do
     p <- fromMaybe (fail $ "not found in ${PATH}: " ++ b) <$> liftIO (pathLocate b)
     cmd_ "cp -L" [p] [mountpoint </> "usr/local/bin" </> b]
-  forM_ debs $ \pkg -> do
-    cmd_ "dpkg -i --root" [mountpoint, pkg]
+  {- 4. custom setup commands -}
   forM_ chrootCommands $ \c -> do
     cmd_ "chroot" [mountpoint] "/bin/sh -c" [unpack c]
+  -- cleanup
   cmd_ "umount" [mountpoint]
   cmd_ "rmdir" [mountpoint]
   cmd_ "btrfstune -S1" [out]