2 files changed, 50 insertions, 1 deletions

diff --git a/fsmgr.hs b/fsmgr.hs
index ca80f8a..a2ee87d 100644
--- a/fsmgr.hs
+++ b/fsmgr.hs
@@ -34,6 +34,7 @@ import           System.Posix.User          (getEffectiveUserID)
 noParent :: BaseImageSpecification -> Bool
 noParent (EmptyImageOfBytes _)     = True
 noParent (ParentImageConfigFile _) = False
+noParent (SeededImage _ _) = False
 
 dynamicNames :: FilePath -> FilePath
 dynamicNames = replace "$(karch)" uname . replace "$(debarch)" debarch
@@ -135,6 +136,20 @@ buildInitialImage DiskImageConfig{..} mountpoint out = do
       cmd_ "btrfstune -f -S0" [out]
       cmd_ "mkdir -p" [mountpoint]
       cmd_ "mount -t btrfs" [out] mountpoint
+
+    SeededImage n f -> do
+      let parent = "_build" </> f -<.> "btrfs"
+      need [parent]
+
+      -- allocate new image file
+      cmd_ "rm -f" [out]
+      cmd_ "truncate -s" [show n, out]
+      cmd_ "fallocate -l" [show n, out]
+
+      idempotentMountImage parent mountpoint
+
+      addImageToBtrfs out mountpoint
+
     EmptyImageOfBytes n -> do
       cmd_ "truncate -s" [show n] [out]
       cmd_ "mkfs.btrfs" [out]
@@ -150,6 +165,33 @@ buildInitialImage DiskImageConfig{..} mountpoint out = do
       cmd_ (Cwd mountpoint) "mkdir -p var/cache/debconf"
       cmd_ (Cwd mountpoint) "btrfs subvolume create var/cache/apt/archives"
 
+idempotentSetupLoopDev :: FilePath -> Action (Maybe String)
+idempotentSetupLoopDev imageFile = do
+  deleteLoopDev imageFile
+  cmd_ "losetup -f" imageFile
+  getLoopDev imageFile
+  where
+    deleteLoopDev = getLoopDev >=> mapM_ (cmd_ "losetup -d")
+
+    getLoopDev :: FilePath -> Action (Maybe String)
+    getLoopDev x = do
+      Stdout r <- cmd "losetup -n -O name -j" x
+      return $ guard (r /= "") >> Just r
+
+idempotentMountImage :: FilePath -> FilePath -> Action ()
+idempotentMountImage imageFile mountPoint = do
+  cmd_ "mkdir -p" [mountPoint]
+  mounted <- cmd "mountpoint -q" [mountPoint] <&> (== ExitSuccess)
+  when mounted $ cmd_ "umount" [mountPoint]
+  cmd_ "mount -o compress,ro -t btrfs" [imageFile, mountPoint]
+
+addImageToBtrfs :: FilePath -> FilePath -> Action ()
+addImageToBtrfs imageFile mountPoint = do
+  blockDevice <- idempotentSetupLoopDev imageFile <&>
+    fromMaybe (error "failed to set up loop device for " ++ imageFile)
+  cmd_ "btrfs device add" blockDevice mountPoint
+  cmd_ "mount -o remount,rw,compress" mountPoint
+
 ignoreErrors' :: IO () -> IO ()
 ignoreErrors' = flip catch (\(SomeException _) -> return ())
 
diff --git a/src/ConfigFile.hs b/src/ConfigFile.hs
index bc5e254..08aa914 100644
--- a/src/ConfigFile.hs
+++ b/src/ConfigFile.hs
@@ -48,6 +48,7 @@ data Patch            = Patch deriving (Show, Read)
 data BaseImageSpecification
   = EmptyImageOfBytes Int64
   | ParentImageConfigFile FilePath
+  | SeededImage Int64 FilePath
   deriving (Show, Read)
 
 data DiskImageConfig = DiskImageConfig {
@@ -60,6 +61,7 @@ data DiskImageConfig = DiskImageConfig {
 , chrootCommands    :: Vector Text
 , skelFiles         :: Vector Text
 , optionalSkelFiles :: Vector Text
+, newSeededImgSize  :: Maybe Int64
 } deriving (Show, Read)
 
 parsePackageName :: Text -> Package
@@ -77,7 +79,12 @@ diskImageConfigParser = object $
   <*> defaultField "chroot-commands" Vector.empty (array string)
   <*> defaultField "skel-files" Vector.empty (array string)
   <*> defaultField "skel-files-optional" Vector.empty (array string)
+  <*> optField "seedme" integer
+
+convSeeded :: DiskImageConfig -> DiskImageConfig
+convSeeded x@(DiskImageConfig (ParentImageConfigFile f) _ _ _ _ _ _ _ _ (Just size)) = x { initialImage = SeededImage size f }
+convSeeded x = x
 
 readCfg :: FilePath -> Action DiskImageConfig
-readCfg yaml = either error id . parse diskImageConfigParser . encodeUtf8 . pack <$> readFile' yaml
+readCfg yaml = either error convSeeded . parse diskImageConfigParser . encodeUtf8 . pack <$> readFile' yaml