diff options
| author | Sean Whitton <spwhitton@spwhitton.name> | 2017-11-19 12:04:26 -0700 |
|---|---|---|
| committer | Sean Whitton <spwhitton@spwhitton.name> | 2017-11-19 12:04:26 -0700 |
| commit | 05e5308ee7cef99b24b4f9d9755e5488f8d92a39 (patch) | |
| tree | 256b8f20bddf0f0701a3247228f9c2dd77be6e64 /src/Propellor/Property/Qemu.hs | |
| parent | 38d039310e4db6ffaf5c8ca51c339421e6865eff (diff) | |
| parent | 12beba0367d14f9c52adf72dd36e9cf5a8e35761 (diff) | |
Merge branch 'master' of https://git.joeyh.name/git/propellor into sbuild-overhaul
Diffstat (limited to 'src/Propellor/Property/Qemu.hs')
| -rw-r--r-- | src/Propellor/Property/Qemu.hs | 49 |
1 files changed, 49 insertions, 0 deletions
diff --git a/src/Propellor/Property/Qemu.hs b/src/Propellor/Property/Qemu.hs new file mode 100644 index 00000000..f204a0e1 --- /dev/null +++ b/src/Propellor/Property/Qemu.hs @@ -0,0 +1,49 @@ +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. +-- +-- 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. +-- +-- 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 |
