From 22bad99dc00df153aaefe3b5445116b142294504 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Thu, 16 Nov 2017 14:17:33 -0400
Subject: Debootstrap.built now supports bootstrapping chroots for foreign OS's

This commit was sponsored by Ethan Aubin.
---
 src/Propellor/Property/Qemu.hs | 47 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 47 insertions(+)
 create mode 100644 src/Propellor/Property/Qemu.hs

(limited to 'src/Propellor/Property/Qemu.hs')

diff --git a/src/Propellor/Property/Qemu.hs b/src/Propellor/Property/Qemu.hs
new file mode 100644
index 00000000..4d9e8b1f
--- /dev/null
+++ b/src/Propellor/Property/Qemu.hs
@@ -0,0 +1,47 @@
+module Propellor.Property.Qemu where
+
+import Propellor.Base
+import qualified Propellor.Property.Apt as Apt
+
+-- | Installs qemu user mode emulation binaries, built statically,
+-- which allow foreign binaries to run directly.
+foreignBinariesEmulated :: RevertableProperty Linux Linux
+foreignBinariesEmulated = (setup <!> cleanup)
+	`describe` "foreign binary emulation"
+  where
+	setup = Apt.installed p `pickOS` unsupportedOS
+	cleanup = Apt.removed p `pickOS` unsupportedOS
+	p = ["qemu-user-static"]
+
+-- | Removes qemu user mode emulation binary for the host CPU.
+-- This binary is copied into a chroot by qemu-debootstrap, and is not
+-- part of any package.
+--
+-- Note that removing the binary will prevent using the chroot on the host
+-- system.
+removeHostEmulationBinary :: Property DebianLike
+removeHostEmulationBinary = tightenTargets $ 
+	scriptProperty ["rm -f /usr/bin/qemu-*-static"]
+		`assume` MadeChange
+
+-- | Check if the given System supports an Architecture.
+--
+-- For example, on Debian, X86_64 supports X86_32, and vice-versa.
+supportsArch :: System -> Architecture -> Bool
+supportsArch (System os a) b
+	| a == b = True
+	| otherwise = case os of
+		Debian _ _ -> debianlike
+		Buntish _ -> debianlike
+		-- don't know about other OS's
+		_ -> False
+  where
+	debianlike =
+		let l = 
+			[ (X86_64, X86_32)
+			, (ARMHF, ARMEL)
+			, (PPC, PPC64)
+			, (SPARC, SPARC64)
+			, (S390, S390X)
+			]
+		in elem (a, b) l || elem (b, a) l
-- 
cgit v1.3-2-g0d8e


From a8dacb76dec5cfa9514d7638987ca52b675c9251 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Fri, 17 Nov 2017 13:55:49 -0400
Subject: clean up qemu emulation binary when finalizing disk image

This commit was sponsored by Denis Dzyubenko on Patreon.
---
 src/Propellor/Property/DiskImage.hs | 5 ++++-
 src/Propellor/Property/Qemu.hs      | 8 +++++---
 2 files changed, 9 insertions(+), 4 deletions(-)

(limited to 'src/Propellor/Property/Qemu.hs')

diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs
index e9c9d0d4..69a4b188 100644
--- a/src/Propellor/Property/DiskImage.hs
+++ b/src/Propellor/Property/DiskImage.hs
@@ -27,6 +27,7 @@ import qualified Propellor.Property.Chroot as Chroot
 import qualified Propellor.Property.Grub as Grub
 import qualified Propellor.Property.File as File
 import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.Qemu as Qemu
 import Propellor.Property.Parted
 import Propellor.Property.Fstab (SwapPartition(..), genFstab)
 import Propellor.Property.Partition
@@ -368,7 +369,9 @@ imageFinalized final img mnts mntopts devs (PartTable _ parts) =
 		liftIO $ mountall top
 		liftIO $ writefstab top
 		liftIO $ allowservices top
-		ensureProperty w $ final img top devs
+		ensureProperty w $ 
+			Qemu.removeHostEmulationBinary top
+				`before` final img top devs
 
 	-- Ordered lexographically by mount point, so / comes before /usr
 	-- comes before /usr/local
diff --git a/src/Propellor/Property/Qemu.hs b/src/Propellor/Property/Qemu.hs
index 4d9e8b1f..f204a0e1 100644
--- a/src/Propellor/Property/Qemu.hs
+++ b/src/Propellor/Property/Qemu.hs
@@ -19,9 +19,11 @@ foreignBinariesEmulated = (setup <!> cleanup)
 --
 -- Note that removing the binary will prevent using the chroot on the host
 -- system.
-removeHostEmulationBinary :: Property DebianLike
-removeHostEmulationBinary = tightenTargets $ 
-	scriptProperty ["rm -f /usr/bin/qemu-*-static"]
+--
+-- The FilePath is the path to the top of the chroot.
+removeHostEmulationBinary :: FilePath -> Property Linux
+removeHostEmulationBinary top = tightenTargets $ 
+	scriptProperty ["rm -f " ++ top ++ "/usr/bin/qemu-*-static"]
 		`assume` MadeChange
 
 -- | Check if the given System supports an Architecture.
-- 
cgit v1.3-2-g0d8e