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 :: RevertableProperty Linux Linux
foreignBinariesEmulated = (Property Linux
setup forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property Linux
cleanup)
	forall p. IsProp p => p -> Desc -> p
`describe` Desc
"foreign binary emulation"
  where
	setup :: Property Linux
setup = [Desc] -> Property DebianLike
Apt.installed [Desc]
p 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 UnixLike
unsupportedOS
	cleanup :: Property Linux
cleanup = [Desc] -> Property DebianLike
Apt.removed [Desc]
p 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 UnixLike
unsupportedOS
	p :: [Desc]
p = [Desc
"qemu-user-static"]

-- | 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 Distribution
os Architecture
a) Architecture
b
	| Architecture
a forall a. Eq a => a -> a -> Bool
== Architecture
b = Bool
True
	| Bool
otherwise = case Distribution
os of
		Debian DebianKernel
_ DebianSuite
_ -> Bool
debianlike
		Buntish Desc
_ -> Bool
debianlike
		-- don't know about other OS's
		Distribution
_ -> 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 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Architecture
a, Architecture
b) [(Architecture, Architecture)]
l Bool -> Bool -> Bool
|| forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Architecture
b, Architecture
a) [(Architecture, Architecture)]
l