    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 :: RevertableProperty Linux Linux
    foreignBinariesEmulated = (Property Linux
    setup Property Linux -> Property Linux -> RevertableProperty Linux Linux
    forall setupmetatypes undometatypes.
    Property setupmetatypes
    -> Property undometatypes
    -> RevertableProperty setupmetatypes undometatypes
    <!> Property Linux
    cleanup)
    	RevertableProperty Linux Linux
    -> Desc -> RevertableProperty Linux Linux
    forall p. IsProp p => p -> Desc -> p
    `describe` "foreign binary emulation"
      where
    	setup :: Property Linux
    setup = [Desc] -> Property DebianLike
    Apt.installed [Desc]
    p Property DebianLike
    -> Property
         (MetaTypes
            '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
    -> Property Linux
    forall k ka kb (c :: k) (a :: ka) (b :: kb).
    (HasCallStack, SingKind 'KProxy, SingKind 'KProxy,
     DemoteRep 'KProxy ~ [MetaType], DemoteRep 'KProxy ~ [MetaType],
     SingI c) =>
    Property (MetaTypes a)
    -> Property (MetaTypes b) -> Property (MetaTypes c)
    `pickOS` Property
      (MetaTypes
         '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
    unsupportedOS
    	cleanup :: Property Linux
    cleanup = [Desc] -> Property DebianLike
    Apt.removed [Desc]
    p Property DebianLike
    -> Property
         (MetaTypes
            '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
    -> Property Linux
    forall k ka kb (c :: k) (a :: ka) (b :: kb).
    (HasCallStack, SingKind 'KProxy, SingKind 'KProxy,
     DemoteRep 'KProxy ~ [MetaType], DemoteRep 'KProxy ~ [MetaType],
     SingI c) =>
    Property (MetaTypes a)
    -> Property (MetaTypes b) -> Property (MetaTypes c)
    `pickOS` Property
      (MetaTypes
         '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
    unsupportedOS
    	p :: [Desc]
    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 :: Desc -> Property Linux
    removeHostEmulationBinary top :: Desc
    top = Property
      (MetaTypes
         '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
    -> Property Linux
    forall (p :: * -> *) (untightened :: [MetaType])
           (tightened :: [MetaType]).
    (TightenTargets p, TightenTargetsAllowed untightened tightened,
     SingI tightened) =>
    p (MetaTypes untightened) -> p (MetaTypes tightened)
    tightenTargets (Property
       (MetaTypes
          '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
             'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
     -> Property Linux)
    -> Property
         (MetaTypes
            '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
    -> Property Linux
    forall a b. (a -> b) -> a -> b
    $
    	[Desc]
    -> UncheckedProperty
         (MetaTypes
            '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
    scriptProperty ["rm -f " Desc -> Desc -> Desc
    forall a. [a] -> [a] -> [a]
    ++ Desc
    top Desc -> Desc -> Desc
    forall a. [a] -> [a] -> [a]
    ++ "/usr/bin/qemu-*-static"]
    		UncheckedProperty
      (MetaTypes
         '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
    -> Result
    -> Property
         (MetaTypes
            '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
    forall (p :: * -> *) i.
    Checkable p i =>
    p i -> Result -> Property i
    `assume` Result
    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 -> Architecture -> Bool
    supportsArch (System os :: Distribution
    os a :: Architecture
    a) b :: Architecture
    b
    	| Architecture
    a Architecture -> Architecture -> Bool
    forall a. Eq a => a -> a -> Bool
    == Architecture
    b = Bool
    True
    	| Bool
    otherwise = case Distribution
    os of
    		Debian _ _ -> Bool
    debianlike
    		Buntish _ -> Bool
    debianlike
    		-- don't know about other OS's
    		_ -> Bool
    False
      where
    	debianlike :: Bool
    debianlike =
    		let l :: [(Architecture, Architecture)]
    l =
    			[ (Architecture
    X86_64, Architecture
    X86_32)
    			, (Architecture
    ARMHF, Architecture
    ARMEL)
    			, (Architecture
    PPC, Architecture
    PPC64)
    			, (Architecture
    SPARC, Architecture
    SPARC64)
    			, (Architecture
    S390, Architecture
    S390X)
    			]
    		in (Architecture, Architecture)
    -> [(Architecture, Architecture)] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    elem (Architecture
    a, Architecture
    b) [(Architecture, Architecture)]
    l Bool -> Bool -> Bool
    || (Architecture, Architecture)
    -> [(Architecture, Architecture)] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    elem (Architecture
    b, Architecture
    a) [(Architecture, Architecture)]
    l