summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Propellor/Property/DiskImage.hs11
-rw-r--r--src/Propellor/Property/Grub.hs62
-rw-r--r--src/Propellor/Property/Mount.hs2
-rw-r--r--src/Propellor/Property/Parted.hs23
-rw-r--r--src/Propellor/Property/Sbuild.hs15
-rw-r--r--src/Propellor/Property/SiteSpecific/JoeySites.hs2
-rw-r--r--src/Propellor/Types/Bootloader.hs7
7 files changed, 89 insertions, 33 deletions
diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs
index 1f4f8118..24459476 100644
--- a/src/Propellor/Property/DiskImage.hs
+++ b/src/Propellor/Property/DiskImage.hs
@@ -17,7 +17,7 @@ module Propellor.Property.DiskImage (
imageRebuiltFor,
imageBuiltFrom,
imageExists,
- Grub.BIOS(..),
+ GrubTarget(..),
) where
import Propellor.Base
@@ -221,7 +221,7 @@ imageBuilt' rebuild img mkchroot tabletype partspec =
-- installed.
final = case fromInfo (containerInfo chroot) of
[] -> unbootable "no bootloader is installed"
- [GrubInstalled] -> grubFinalized
+ [GrubInstalled grubtarget] -> grubFinalized grubtarget
[UbootInstalled p] -> ubootFinalized p
[FlashKernelInstalled] -> flashKernelFinalized
[UbootInstalled p, FlashKernelInstalled] ->
@@ -454,9 +454,10 @@ unbootable msg = \_ _ _ -> property desc $ do
where
desc = "image is not bootable"
-grubFinalized :: Finalization
-grubFinalized _img mnt loopdevs = Grub.bootsMounted mnt wholediskloopdev
- `describe` "disk image boots using grub"
+grubFinalized :: GrubTarget -> Finalization
+grubFinalized grubtarget _img mnt loopdevs =
+ Grub.bootsMounted mnt wholediskloopdev grubtarget
+ `describe` "disk image boots using grub"
where
-- It doesn't matter which loopdev we use; all
-- come from the same disk image, and it's the loop dev
diff --git a/src/Propellor/Property/Grub.hs b/src/Propellor/Property/Grub.hs
index d0516dc8..5cb9077d 100644
--- a/src/Propellor/Property/Grub.hs
+++ b/src/Propellor/Property/Grub.hs
@@ -1,4 +1,15 @@
-module Propellor.Property.Grub where
+module Propellor.Property.Grub (
+ GrubDevice,
+ OSDevice,
+ GrubTarget(..),
+ installed,
+ mkConfig,
+ installed',
+ boots,
+ bootsMounted,
+ TimeoutSecs,
+ chainPVGrub
+) where
import Propellor.Base
import qualified Propellor.Property.File as File
@@ -14,40 +25,36 @@ type GrubDevice = String
-- | Eg, \"\/dev/sda\"
type OSDevice = String
-type TimeoutSecs = Int
-
--- | Types of machines that grub can boot.
-data BIOS = PC | EFI64 | EFI32 | Coreboot | Xen
-
-- | Installs the grub package. This does not make grub be used as the
-- bootloader.
--
-- This includes running update-grub, unless it's run in a chroot.
-installed :: BIOS -> Property (HasInfo + DebianLike)
-installed bios = installed' bios
+installed :: GrubTarget -> Property (HasInfo + DebianLike)
+installed grubtarget = installed' grubtarget
`onChange` (check (not <$> inChroot) mkConfig)
--- Run update-grub, to generate the grub boot menu. It will be
+-- | Run update-grub, to generate the grub boot menu. It will be
-- automatically updated when kernel packages are installed.
mkConfig :: Property DebianLike
mkConfig = tightenTargets $ cmdProperty "update-grub" []
`assume` MadeChange
-- | Installs grub; does not run update-grub.
-installed' :: BIOS -> Property (HasInfo + DebianLike)
-installed' bios = setInfoProperty aptinstall
- (toInfo [GrubInstalled])
+installed' :: GrubTarget -> Property (HasInfo + DebianLike)
+installed' grubtarget = setInfoProperty aptinstall
+ (toInfo [GrubInstalled grubtarget])
`describe` "grub package installed"
where
aptinstall = Apt.installed [debpkg]
- debpkg = case bios of
+ debpkg = case grubtarget of
PC -> "grub-pc"
EFI64 -> "grub-efi-amd64"
EFI32 -> "grub-efi-ia32"
Coreboot -> "grub-coreboot"
Xen -> "grub-xen"
--- | Installs grub onto a device, so the system can boot from that device.
+-- | Installs grub onto a device's boot loader,
+-- so the system can boot from that device.
--
-- You may want to install grub to multiple devices; eg for a system
-- that uses software RAID.
@@ -57,9 +64,24 @@ installed' bios = setInfoProperty aptinstall
-- to arrange for this property to only run once, by eg making it be run
-- onChange after OS.cleanInstallOnce.
boots :: OSDevice -> Property Linux
-boots dev = tightenTargets $ cmdProperty "grub-install" [dev]
- `assume` MadeChange
- `describe` ("grub boots " ++ dev)
+boots dev = property' ("grub boots " ++ dev) $ \w -> do
+ grubtarget <- askInfo
+ let ps = case grubtarget of
+ [GrubInstalled t] -> [targetParam t]
+ _ -> []
+ ensureProperty w $
+ cmdProperty "grub-install" (ps ++ [dev])
+ `assume` MadeChange
+
+targetParam :: GrubTarget -> String
+targetParam t = "--target=" ++ case t of
+ PC -> "i386-pc"
+ EFI32 -> "i386-efi"
+ EFI64 -> "x86_64-efi"
+ Coreboot -> "i386-coreboot"
+ Xen -> "x86_64-xen"
+
+type TimeoutSecs = Int
-- | Use PV-grub chaining to boot
--
@@ -95,8 +117,8 @@ chainPVGrub rootdev bootdev timeout = combineProperties desc $ props
-- at a particular directory. The OSDevice should be the underlying disk
-- device that grub will be installed to (generally a whole disk,
-- not a partition).
-bootsMounted :: FilePath -> OSDevice -> Property Linux
-bootsMounted mnt wholediskdev = combineProperties desc $ props
+bootsMounted :: FilePath -> OSDevice -> GrubTarget -> Property Linux
+bootsMounted mnt wholediskdev grubtarget = combineProperties desc $ props
-- remove mounts that are done below to make sure the right thing
-- gets mounted
& cleanupmounts
@@ -112,7 +134,7 @@ bootsMounted mnt wholediskdev = combineProperties desc $ props
& inchroot "update-grub" []
`assume` MadeChange
& check haveosprober (inchroot "chmod" ["+x", osprober])
- & inchroot "grub-install" [wholediskdev]
+ & inchroot "grub-install" [targetParam grubtarget, wholediskdev]
`assume` MadeChange
& cleanupmounts
-- sync all buffered changes out to the disk in case it's
diff --git a/src/Propellor/Property/Mount.hs b/src/Propellor/Property/Mount.hs
index e8f3f092..71f1733e 100644
--- a/src/Propellor/Property/Mount.hs
+++ b/src/Propellor/Property/Mount.hs
@@ -151,4 +151,4 @@ unmountBelow d = do
submnts <- mountPointsBelow d
-- sort so sub-mounts are unmounted before the mount point
-- containing them
- forM_ (sort submnts) umountLazy
+ forM_ (reverse (sort submnts)) umountLazy
diff --git a/src/Propellor/Property/Parted.hs b/src/Propellor/Property/Parted.hs
index 38c55b93..97cf815e 100644
--- a/src/Propellor/Property/Parted.hs
+++ b/src/Propellor/Property/Parted.hs
@@ -85,8 +85,8 @@ calcPartedParamsSize (PartTable tabletype alignment parts) =
[ "mkpart"
, pval (partType p)
, pval (partFs p)
- , partpos startpos
- , partpos endpos
+ , partposexact startpos
+ , partposfuzzy endpos
] ++ case partName p of
Just n -> ["name", show partnum, n]
Nothing -> []
@@ -95,14 +95,29 @@ calcPartedParamsSize (PartTable tabletype alignment parts) =
in calcparts (partnum+1) endpos ps
(c ++ mkpart partnum startpos (endpos-1) p : map (mkflag partnum) (partFlags p))
calcparts _ endpos [] c = (c, endpos)
- partpos n
- | n > 0 = val n ++ "B"
+
+ -- Exact partition position value for parted.
+ -- For alignment to work, the start of a partition must be
+ -- specified exactly.
+ partposexact n
+ | n > 0 = show n ++ "B"
-- parted can't make partitions smaller than 1MB;
-- avoid failure in edge cases
| otherwise = "1MB"
+
+ -- Fuzzy partition position valie for parted.
+ -- This is used to specify the end of the partition,
+ -- parted takes the "MB" as license to slightly reduce the
+ -- partition size when something about the partition table
+ -- does not allow the partition to end exactly at the position.
+ partposfuzzy n
+ | n > 0 = show (fromIntegral n / 1000000 :: Double) ++ "MB"
+ | otherwise = "1MB"
+
-- Location of the start of the first partition,
-- leaving space for the partition table, and aligning.
firstpos = align partitionTableOverhead
+
align = alignTo alignment
-- | Runs parted on a disk with the specified parameters.
diff --git a/src/Propellor/Property/Sbuild.hs b/src/Propellor/Property/Sbuild.hs
index d323ee67..8cc2e3be 100644
--- a/src/Propellor/Property/Sbuild.hs
+++ b/src/Propellor/Property/Sbuild.hs
@@ -48,6 +48,14 @@ To take advantage of the piuparts and autopkgtest support, add to your
>
> $autopkgtest_root_args = "";
> $autopkgtest_opts = ["--", "schroot", "%r-%a-sbuild"];
+
+On Debian jessie hosts, you should ensure that sbuild and autopkgtest come from
+the same suite. This is because the autopkgtest binary changed its name between
+jessie and stretch. If you have not installed backports of sbuild or
+autopkgtest, you don't need to do anything. But if you have installed either
+package from jessie-backports (with Propellor or otherwise), you should install
+the other from jessie-backports, too.
+
-}
module Propellor.Property.Sbuild (
@@ -376,6 +384,13 @@ ccachePrepared = propertyList "sbuild group ccache configured" $ props
--
-- You probably want a custom ~/.sbuildrc on your workstation, but
-- this property is handy for quickly setting up build boxes.
+--
+-- On Debian jessie hosts, you should ensure that sbuild and autopkgtest come
+-- from the same suite. This is because the autopkgtest binary changed its name
+-- between jessie and stretch. If you have not installed backports of sbuild or
+-- autopkgtest, you don't need to do anything. But if you have installed either
+-- package from jessie-backports (with Propellor or otherwise), you should
+-- install the other from jessie-backports, too.
userConfig :: User -> Property DebianLike
userConfig user@(User u) = go
`requires` usableBy user
diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs
index 03e9c3f7..019d2209 100644
--- a/src/Propellor/Property/SiteSpecific/JoeySites.hs
+++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs
@@ -646,7 +646,7 @@ dkimInstalled = go `onChange` Service.restarted "opendkim"
& Apt.serviceInstalledRunning "opendkim"
& File.dirExists "/etc/mail"
& File.hasPrivContent "/etc/mail/dkim.key" (Context "kitenet.net")
- & File.ownerGroup "/etc/mail/dkim.key" (User "opendkim") (Group "opendkim")
+ & File.ownerGroup "/etc/mail/dkim.key" (User "root") (Group "root")
& "/etc/default/opendkim" `File.containsLine`
"SOCKET=\"inet:8891@localhost\""
`onChange`
diff --git a/src/Propellor/Types/Bootloader.hs b/src/Propellor/Types/Bootloader.hs
index fd929d7e..65117bd2 100644
--- a/src/Propellor/Types/Bootloader.hs
+++ b/src/Propellor/Types/Bootloader.hs
@@ -7,13 +7,16 @@ import Propellor.Types.Info
-- | Boot loader installed on a host.
data BootloaderInstalled
- = GrubInstalled
+ = GrubInstalled GrubTarget
| FlashKernelInstalled
| UbootInstalled (FilePath -> FilePath -> Property Linux)
deriving (Typeable)
+-- | Platforms that grub can boot.
+data GrubTarget = PC | EFI64 | EFI32 | Coreboot | Xen
+
instance Show BootloaderInstalled where
- show GrubInstalled = "GrubInstalled"
+ show (GrubInstalled _) = "GrubInstalled"
show FlashKernelInstalled = "FlashKernelInstalled"
show (UbootInstalled _) = "UbootInstalled"