    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.
    --
    -- Note that this is not necessary after qemu 2.12~rc3+dfsg-1.
    -- See http://bugs.debian.org/868030
    -- It's currently always done to support older versions, but
    -- could be skipped with the newer version.
    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