Begin support for "seeded images."

A seeded image keeps its parent image as a read-only "seed" device that
joins the seeded image in a multi-device btrfs filesystem.  That means
that to mount such an image, the parent image must be made available as
a block device (e.g. using losetup, or dd to an existing block device
and run btfrs device scan).

Such support had been added to the Samizdat Makefile, but more
properly belongs here.

This is the sequence of commands used by sami.git's Makefile to
accomplish the effect:

  rm -f $@~tmp
  touch $@~tmp
  fallocate -l $(samizdat_btrfs_patch_size) $@~tmp
  test -d $@.mnt || mkdir $@.mnt
  ! mountpoint -q $@.mnt || umount $@.mnt
  mount -o compress,ro -t btrfs $< $@.mnt
  a=$(get_loop_dev); [ -z "$$a" ] || losetup -d $$a
  losetup -f $@~tmp
  btrfs device add $(get_loop_dev) $@.mnt
  mount -o compress,rw,remount $@.mnt

The Makefile also defines:

  get_loop_dev="$$(sudo losetup -n -O name -j $@~tmp)"

The same basic sequence is carried out here.

The config file format is modified so that to get a seeded image you
specify "seedme: <bytes>" where <bytes> is the size of the seeded image.

This feature is complete enough to create a seeded image (i.e., to
replace the Makefile), but children of a seeded image seem impossible
to work because there is no code yet to run losetup on seed images of
parents.  Thus it can be expected that deriving from a parent with a
seed will fail when fsmgr tries to mount the parent.

1 files changed, 42 insertions, 0 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 ())