module Propellor.Property.Qemu where
import Propellor.Base
import qualified Propellor.Property.Apt as Apt
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` Desc
"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 = [Desc
"qemu-user-static"]
removeHostEmulationBinary :: FilePath -> Property Linux
removeHostEmulationBinary :: Desc -> Property Linux
removeHostEmulationBinary 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 [Desc
"rm -f " Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
top Desc -> Desc -> Desc
forall a. [a] -> [a] -> [a]
++ Desc
"/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
supportsArch :: System -> Architecture -> Bool
supportsArch :: System -> Architecture -> Bool
supportsArch (System Distribution
os Architecture
a) 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 DebianKernel
_ DebianSuite
_ -> Bool
debianlike
Buntish Desc
_ -> Bool
debianlike
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 (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