run losetup on parent seed images

currently using some rather brutal force here

1 files changed, 8 insertions, 0 deletions

diff --git a/fsmgr.hs b/fsmgr.hs
index 2f3e0f5..65797c4 100644
--- a/fsmgr.hs
+++ b/fsmgr.hs
@@ -106,6 +106,8 @@ buildRoot config@DiskImageConfig{..} finalOut = do
     writeFileChanged (finalOut -<.> "pkgs.txt") pkgList
     {- 5. create a backup snapshot -}
     cmd_ "umount" [mountpoint]
+
+    setupLoopDevices out
     cmd_ "mount -t btrfs -o subvol=/" [out, mountpoint]
     ignoreErrors $ cmd_ (EchoStderr False) "btrfs subvolume delete" [mountpoint </> "root~orig"]
     cmd_ "btrfs subvolume snapshot -r" [mountpoint </> "root", mountpoint </> "root~orig"]
@@ -116,6 +118,12 @@ buildRoot config@DiskImageConfig{..} finalOut = do
     cmd_ "btrfstune -S1" [out]
     cmd_ "mv" [out, finalOut]
 
+setupLoopDevices :: FilePath -> Action ()
+setupLoopDevices out = do
+  (Stdout devices) <- cmd "sh -c" ["if [ -e \"$0\" ]; then cat \"$0\"; fi ", out -<.> "devices.txt"]
+  cmd_ "losetup -D"
+  forM_ (lines devices) $ \d -> cmd_ "losetup -f" [d]
+
 absPath :: MonadIO m => FilePath -> m FilePath
 absPath f@('/':_) = return f
 absPath f = do