summaryrefslogtreecommitdiff
path: root/src/Propellor/Property/Qemu.hs
blob: a6e7e8497e878b8ec39e7bac11ae13e049fed1ea (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
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