    -- | Disk image generation.
    --
    -- This module is designed to be imported unqualified.

    {-# LANGUAGE TypeFamilies #-}

    module Propellor.Property.DiskImage (
    	-- * Partition specification
    	module Propellor.Property.DiskImage.PartSpec,
    	-- * Properties
    	DiskImage(..),
    	RawDiskImage(..),
    	VirtualBoxPointer(..),
    	imageBuilt,
    	imageRebuilt,
    	imageBuiltFor,
    	imageRebuiltFor,
    	imageBuiltFrom,
    	imageExists,
    	imageChrootNotPresent,
    	GrubTarget(..),
    	noBootloader,
    ) where

    import Propellor.Base
    import Propellor.Property.DiskImage.PartSpec
    import Propellor.Property.Chroot (Chroot)
    import Propellor.Property.Chroot.Util (removeChroot)
    import Propellor.Property.Mount
    import qualified Propellor.Property.Chroot as Chroot
    import qualified Propellor.Property.Service as Service
    import qualified Propellor.Property.Grub as Grub
    import qualified Propellor.Property.File as File
    import qualified Propellor.Property.Apt as Apt
    import qualified Propellor.Property.FlashKernel as FlashKernel
    import Propellor.Property.Parted
    import Propellor.Property.Fstab (SwapPartition(..), genFstab)
    import Propellor.Property.Partition
    import Propellor.Property.Rsync
    import Propellor.Types.Info
    import Propellor.Types.Bootloader
    import Propellor.Container
    import Utility.Path
    import Utility.DataUnits

    import Data.List (isPrefixOf, isInfixOf, sortBy, unzip4)
    import Data.Function (on)
    import qualified Data.Map.Strict as M
    import qualified Data.ByteString.Lazy as L
    import System.Posix.Files

    -- | Type class of disk image formats.
    class DiskImage d where
    	-- | Get the location where the raw disk image should be stored.
    	rawDiskImage :: d -> RawDiskImage
    	-- | Describe the disk image (for display to the user)
    	describeDiskImage :: d -> String
    	-- | Convert the raw disk image file in the
    	-- `rawDiskImage` location into the desired disk image format.
    	-- For best efficiency, the raw disk imasge file should be left
    	-- unchanged on disk.
    	buildDiskImage :: d -> RevertableProperty DebianLike Linux

    -- | A raw disk image, that can be written directly out to a disk.
    newtype RawDiskImage = RawDiskImage FilePath

    instance DiskImage RawDiskImage where
    	rawDiskImage :: RawDiskImage -> RawDiskImage
    rawDiskImage = RawDiskImage -> RawDiskImage
    forall a. a -> a
    id
    	describeDiskImage :: RawDiskImage -> MountPoint
    describeDiskImage (RawDiskImage MountPoint
    f) = MountPoint
    f
    	buildDiskImage :: RawDiskImage -> RevertableProperty DebianLike Linux
    buildDiskImage (RawDiskImage MountPoint
    _) = Property DebianLike
    forall {k} (t :: k). SingI t => Property (MetaTypes t)
    doNothing Property DebianLike
    -> Property Linux -> RevertableProperty DebianLike Linux
    forall setupmetatypes undometatypes.
    Property setupmetatypes
    -> Property undometatypes
    -> RevertableProperty setupmetatypes undometatypes
    <!> Property Linux
    forall {k} (t :: k). SingI t => Property (MetaTypes t)
    doNothing

    -- | A virtualbox .vmdk file, which contains a pointer to the raw disk
    -- image. This can be built very quickly.
    newtype VirtualBoxPointer = VirtualBoxPointer FilePath

    instance DiskImage VirtualBoxPointer where
    	rawDiskImage :: VirtualBoxPointer -> RawDiskImage
    rawDiskImage (VirtualBoxPointer MountPoint
    f) = MountPoint -> RawDiskImage
    RawDiskImage (MountPoint -> RawDiskImage) -> MountPoint -> RawDiskImage
    forall a b. (a -> b) -> a -> b
    $
    		MountPoint -> MountPoint
    dropExtension MountPoint
    f MountPoint -> MountPoint -> MountPoint
    forall a. [a] -> [a] -> [a]
    ++ MountPoint
    ".img"
    	describeDiskImage :: VirtualBoxPointer -> MountPoint
    describeDiskImage (VirtualBoxPointer MountPoint
    f) = MountPoint
    f
    	buildDiskImage :: VirtualBoxPointer -> RevertableProperty DebianLike Linux
    buildDiskImage (VirtualBoxPointer MountPoint
    vmdkfile) = (CombinedType
      (CombinedType (Property UnixLike) (Property DebianLike))
      (Property UnixLike)
    Property DebianLike
    setup Property DebianLike
    -> Property Linux -> RevertableProperty DebianLike Linux
    forall setupmetatypes undometatypes.
    Property setupmetatypes
    -> Property undometatypes
    -> RevertableProperty setupmetatypes undometatypes
    <!> Property Linux
    cleanup)
    		RevertableProperty DebianLike Linux
    -> MountPoint -> RevertableProperty DebianLike Linux
    forall p. IsProp p => p -> MountPoint -> p
    `describe` (MountPoint
    vmdkfile MountPoint -> MountPoint -> MountPoint
    forall a. [a] -> [a] -> [a]
    ++ MountPoint
    " built")
    	  where
    		setup :: CombinedType
      (CombinedType (Property UnixLike) (Property DebianLike))
      (Property UnixLike)
    setup = MountPoint -> [MountPoint] -> UncheckedProperty UnixLike
    cmdProperty MountPoint
    "VBoxManage"
    			[ MountPoint
    "internalcommands", MountPoint
    "createrawvmdk"
    			, MountPoint
    "-filename", MountPoint
    vmdkfile
    			, MountPoint
    "-rawdisk", MountPoint
    diskimage
    			]
    			UncheckedProperty UnixLike -> MountPoint -> Property UnixLike
    forall (p :: * -> *) i.
    Checkable p i =>
    p i -> MountPoint -> Property i
    `changesFile` MountPoint
    vmdkfile
    			Property UnixLike
    -> Property UnixLike
    -> CombinedType (Property UnixLike) (Property UnixLike)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `onChange` MountPoint -> FileMode -> Property UnixLike
    File.mode MountPoint
    vmdkfile ([FileMode] -> FileMode
    combineModes (FileMode
    ownerWriteMode FileMode -> [FileMode] -> [FileMode]
    forall a. a -> [a] -> [a]
    : [FileMode]
    readModes))
    			Property UnixLike
    -> Property DebianLike
    -> CombinedType (Property UnixLike) (Property DebianLike)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `requires` [MountPoint] -> Property DebianLike
    Apt.installed [MountPoint
    "virtualbox"]
    			CombinedType (Property UnixLike) (Property DebianLike)
    -> Property UnixLike
    -> CombinedType
         (CombinedType (Property UnixLike) (Property DebianLike))
         (Property UnixLike)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `requires` MountPoint -> Property UnixLike
    File.notPresent MountPoint
    vmdkfile
    		cleanup :: Property Linux
    cleanup = Property UnixLike -> Property Linux
    forall (untightened :: [MetaType]) (tightened :: [MetaType]).
    (TightenTargetsAllowed untightened tightened, SingI tightened) =>
    Property (MetaTypes untightened) -> Property (MetaTypes tightened)
    forall (p :: * -> *) (untightened :: [MetaType])
           (tightened :: [MetaType]).
    (TightenTargets p, TightenTargetsAllowed untightened tightened,
     SingI tightened) =>
    p (MetaTypes untightened) -> p (MetaTypes tightened)
    tightenTargets (Property UnixLike -> Property Linux)
    -> Property UnixLike -> Property Linux
    forall a b. (a -> b) -> a -> b
    $ MountPoint -> Property UnixLike
    File.notPresent MountPoint
    vmdkfile
    		RawDiskImage MountPoint
    diskimage = VirtualBoxPointer -> RawDiskImage
    forall d. DiskImage d => d -> RawDiskImage
    rawDiskImage (MountPoint -> VirtualBoxPointer
    VirtualBoxPointer MountPoint
    vmdkfile)

    -- | Creates a bootable disk image.
    --
    -- First the specified Chroot is set up, and its properties are satisfied.
    --
    -- Then, the disk image is set up, and the chroot is copied into the
    -- appropriate partition(s) of it.
    --
    -- The partitions default to being sized just large enough to fit the files
    -- from the chroot. You can use `addFreeSpace` to make them a bit larger
    -- than that, or `setSize` to use a fixed size.
    --
    -- Note that the disk image file is reused if it already exists,
    -- to avoid expensive IO to generate a new one. And, it's updated in-place,
    -- so its contents are undefined during the build process.
    --
    -- Note that the `Service.noServices` property is automatically added to the
    -- chroot while the disk image is being built, which should prevent any
    -- daemons that are included from being started on the system that is
    -- building the disk image.
    --
    -- Example use:
    --
    -- > import Propellor.Property.DiskImage
    -- > import Propellor.Property.Chroot
    -- >
    -- > foo = host "foo.example.com" $ props
    -- > 	& imageBuilt (RawDiskImage "/srv/diskimages/disk.img") mychroot
    -- >		MSDOS
    -- >		[ partition EXT2 `mountedAt` "/boot"
    -- >			`setFlag` BootFlag
    -- >		, partition EXT4 `mountedAt` "/"
    -- >			`addFreeSpace` MegaBytes 100
    -- >			`mountOpt` errorReadonly
    -- >		, swapPartition (MegaBytes 256)
    -- >		]
    -- >  where
    -- >	mychroot d = debootstrapped mempty d $ props
    -- >		& osDebian Unstable X86_64
    -- >		& Apt.installed ["linux-image-amd64"]
    -- >		& Grub.installed PC
    -- >		& User.hasPassword (User "root")
    -- >		& User.accountFor (User "demo")
    -- > 		& User.hasPassword (User "demo")
    -- >		& User.hasDesktopGroups (User "demo")
    -- > 		& ...
    imageBuilt :: DiskImage d => d -> (FilePath -> Chroot) -> TableType -> [PartSpec ()] -> RevertableProperty (HasInfo + DebianLike) Linux
    imageBuilt :: forall d.
    DiskImage d =>
    d
    -> (MountPoint -> Chroot)
    -> TableType
    -> [PartSpec ()]
    -> RevertableProperty (HasInfo + DebianLike) Linux
    imageBuilt = Bool
    -> d
    -> (MountPoint -> Chroot)
    -> TableType
    -> [PartSpec ()]
    -> RevertableProperty (HasInfo + DebianLike) Linux
    forall d.
    DiskImage d =>
    Bool
    -> d
    -> (MountPoint -> Chroot)
    -> TableType
    -> [PartSpec ()]
    -> RevertableProperty (HasInfo + DebianLike) Linux
    imageBuilt' Bool
    False

    -- | Like 'imageBuilt', but the chroot is deleted and rebuilt from scratch
    -- each time. This is more expensive, but useful to ensure reproducible
    -- results when the properties of the chroot have been changed.
    imageRebuilt :: DiskImage d => d -> (FilePath -> Chroot) -> TableType -> [PartSpec ()] -> RevertableProperty (HasInfo + DebianLike) Linux
    imageRebuilt :: forall d.
    DiskImage d =>
    d
    -> (MountPoint -> Chroot)
    -> TableType
    -> [PartSpec ()]
    -> RevertableProperty (HasInfo + DebianLike) Linux
    imageRebuilt = Bool
    -> d
    -> (MountPoint -> Chroot)
    -> TableType
    -> [PartSpec ()]
    -> RevertableProperty (HasInfo + DebianLike) Linux
    forall d.
    DiskImage d =>
    Bool
    -> d
    -> (MountPoint -> Chroot)
    -> TableType
    -> [PartSpec ()]
    -> RevertableProperty (HasInfo + DebianLike) Linux
    imageBuilt' Bool
    True

    -- | Create a bootable disk image for a Host.
    --
    -- This works just like 'imageBuilt', but partition table is
    -- determined by looking at the Host's 'hasPartitionTableType',
    -- `hasPartition', and 'adjustPartition' properties.
    --
    -- For example:
    --
    -- > foo :: Host
    -- > foo = host "foo.example.com" $ props
    -- >	& imageBuiltFor bar
    -- >		(RawDiskImage "/srv/diskimages/bar-disk.img")
    -- >		(Debootstrapped mempty)
    -- >
    -- > bar :: Host
    -- > bar = host "bar.example.com" $ props
    -- >	& hasPartiton
    -- >		( partition EXT2
    -- >		`mountedAt` "/boot"
    -- >		`partLocation` Beginning
    -- >		`addFreeSpace` MegaBytes 150
    -- >		)
    -- >	& hasPartiton
    -- >		( partition EXT4
    -- >		`mountedAt` "/"
    -- >		`addFreeSpace` MegaBytes 500
    -- >		)
    -- >	& osDebian Unstable X86_64
    -- >	& Apt.installed ["linux-image-amd64"]
    -- >	& Grub.installed PC
    -- >	& hasPassword (User "root")
    imageBuiltFor :: (DiskImage d, Chroot.ChrootBootstrapper bootstrapper) => Host -> d -> bootstrapper -> RevertableProperty (HasInfo + DebianLike) Linux
    imageBuiltFor :: forall d bootstrapper.
    (DiskImage d, ChrootBootstrapper bootstrapper) =>
    Host
    -> d
    -> bootstrapper
    -> RevertableProperty (HasInfo + DebianLike) Linux
    imageBuiltFor = Bool
    -> Host
    -> d
    -> bootstrapper
    -> RevertableProperty (HasInfo + DebianLike) Linux
    forall d bootstrapper.
    (DiskImage d, ChrootBootstrapper bootstrapper) =>
    Bool
    -> Host
    -> d
    -> bootstrapper
    -> RevertableProperty (HasInfo + DebianLike) Linux
    imageBuiltFor' Bool
    False

    -- | Like 'imageBuiltFor', but the chroot is deleted and rebuilt from
    -- scratch each time.
    imageRebuiltFor :: (DiskImage d, Chroot.ChrootBootstrapper bootstrapper) => Host -> d -> bootstrapper -> RevertableProperty (HasInfo + DebianLike) Linux
    imageRebuiltFor :: forall d bootstrapper.
    (DiskImage d, ChrootBootstrapper bootstrapper) =>
    Host
    -> d
    -> bootstrapper
    -> RevertableProperty (HasInfo + DebianLike) Linux
    imageRebuiltFor = Bool
    -> Host
    -> d
    -> bootstrapper
    -> RevertableProperty (HasInfo + DebianLike) Linux
    forall d bootstrapper.
    (DiskImage d, ChrootBootstrapper bootstrapper) =>
    Bool
    -> Host
    -> d
    -> bootstrapper
    -> RevertableProperty (HasInfo + DebianLike) Linux
    imageBuiltFor' Bool
    False

    imageBuiltFor' :: (DiskImage d, Chroot.ChrootBootstrapper bootstrapper) => Bool -> Host -> d -> bootstrapper -> RevertableProperty (HasInfo + DebianLike) Linux
    imageBuiltFor' :: forall d bootstrapper.
    (DiskImage d, ChrootBootstrapper bootstrapper) =>
    Bool
    -> Host
    -> d
    -> bootstrapper
    -> RevertableProperty (HasInfo + DebianLike) Linux
    imageBuiltFor' Bool
    rebuild Host
    h d
    d bootstrapper
    bs =
    	Bool
    -> d
    -> (MountPoint -> Chroot)
    -> TableType
    -> [PartSpec ()]
    -> RevertableProperty (HasInfo + DebianLike) Linux
    forall d.
    DiskImage d =>
    Bool
    -> d
    -> (MountPoint -> Chroot)
    -> TableType
    -> [PartSpec ()]
    -> RevertableProperty (HasInfo + DebianLike) Linux
    imageBuilt' Bool
    rebuild d
    d (Host -> bootstrapper -> MountPoint -> Chroot
    forall bootstrapper.
    ChrootBootstrapper bootstrapper =>
    Host -> bootstrapper -> MountPoint -> Chroot
    Chroot.hostChroot Host
    h bootstrapper
    bs) TableType
    tt [PartSpec ()]
    pil
      where
    	PartTableSpec TableType
    tt [PartSpec ()]
    pil = PartInfo -> PartTableSpec
    toPartTableSpec (Info -> PartInfo
    forall v. IsInfo v => Info -> v
    fromInfo (Host -> Info
    hostInfo Host
    h))

    imageBuilt' :: DiskImage d => Bool -> d -> (FilePath -> Chroot) -> TableType -> [PartSpec ()] -> RevertableProperty (HasInfo + DebianLike) Linux
    imageBuilt' :: forall d.
    DiskImage d =>
    Bool
    -> d
    -> (MountPoint -> Chroot)
    -> TableType
    -> [PartSpec ()]
    -> RevertableProperty (HasInfo + DebianLike) Linux
    imageBuilt' Bool
    rebuild d
    img MountPoint -> Chroot
    mkchroot TableType
    tabletype [PartSpec ()]
    partspec =
    	d
    -> MountPoint
    -> TableType
    -> Finalization
    -> [PartSpec ()]
    -> RevertableProperty (HasInfo + DebianLike) Linux
    forall d.
    DiskImage d =>
    d
    -> MountPoint
    -> TableType
    -> Finalization
    -> [PartSpec ()]
    -> RevertableProperty (HasInfo + DebianLike) Linux
    imageBuiltFrom d
    img MountPoint
    chrootdir TableType
    tabletype Finalization
    final [PartSpec ()]
    partspec
    		RevertableProperty
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
      Linux
    -> RevertableProperty
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux])
         Linux
    -> CombinedType
         (RevertableProperty
            (MetaTypes
               '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
            Linux)
         (RevertableProperty
            (MetaTypes
               '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux])
            Linux)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `requires` Chroot -> RevertableProperty (HasInfo + Linux) Linux
    Chroot.provisioned Chroot
    chroot
    		CombinedType
      (RevertableProperty
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
         Linux)
      (RevertableProperty
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux])
         Linux)
    -> RevertableProperty Linux UnixLike
    -> CombinedType
         (CombinedType
            (RevertableProperty
               (MetaTypes
                  '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
               Linux)
            (RevertableProperty
               (MetaTypes
                  '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                     'Targeting 'OSArchLinux])
               Linux))
         (RevertableProperty Linux UnixLike)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `requires` (Property Linux
    cleanrebuild Property Linux
    -> Property UnixLike -> RevertableProperty Linux UnixLike
    forall setupmetatypes undometatypes.
    Property setupmetatypes
    -> Property undometatypes
    -> RevertableProperty setupmetatypes undometatypes
    <!> (Property UnixLike
    forall {k} (t :: k). SingI t => Property (MetaTypes t)
    doNothing :: Property UnixLike))
    		RevertableProperty
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
      Linux
    -> MountPoint
    -> RevertableProperty
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
         Linux
    forall p. IsProp p => p -> MountPoint -> p
    `describe` MountPoint
    desc
      where
    	desc :: MountPoint
    desc = MountPoint
    "built disk image " MountPoint -> MountPoint -> MountPoint
    forall a. [a] -> [a] -> [a]
    ++ d -> MountPoint
    forall d. DiskImage d => d -> MountPoint
    describeDiskImage d
    img
    	cleanrebuild :: Property Linux
    	cleanrebuild :: Property Linux
    cleanrebuild
    		| Bool
    rebuild = MountPoint -> Propellor Result -> Property Linux
    forall {k} (metatypes :: k).
    SingI metatypes =>
    MountPoint -> Propellor Result -> Property (MetaTypes metatypes)
    property MountPoint
    desc (Propellor Result -> Property Linux)
    -> Propellor Result -> Property Linux
    forall a b. (a -> b) -> a -> b
    $ do
    			IO () -> Propellor ()
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Propellor ()) -> IO () -> Propellor ()
    forall a b. (a -> b) -> a -> b
    $ MountPoint -> IO ()
    removeChroot MountPoint
    chrootdir
    			Result -> Propellor Result
    forall a. a -> Propellor a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    MadeChange
    		| Bool
    otherwise = Property Linux
    forall {k} (t :: k). SingI t => Property (MetaTypes t)
    doNothing
    	chrootdir :: MountPoint
    chrootdir = d -> MountPoint
    forall d. DiskImage d => d -> MountPoint
    imageChroot d
    img
    	chroot :: Chroot
    chroot =
    		let c :: Chroot
    c = Chroot -> Chroot
    propprivdataonly (Chroot -> Chroot) -> Chroot -> Chroot
    forall a b. (a -> b) -> a -> b
    $ MountPoint -> Chroot
    mkchroot MountPoint
    chrootdir
    		in Chroot
    -> Props
         (MetaTypes
            (Combine
               (Combine
                  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                     'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
                  '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                     'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
    -> Chroot
    forall c metatypes. IsContainer c => c -> Props metatypes -> c
    setContainerProps Chroot
    c (Props
       (MetaTypes
          (Combine
             (Combine
                '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                   'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
                '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                   'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
             '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
     -> Chroot)
    -> Props
         (MetaTypes
            (Combine
               (Combine
                  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                     'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
                  '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                     'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
    -> Chroot
    forall a b. (a -> b) -> a -> b
    $ Chroot -> Props UnixLike
    forall c. IsContainer c => c -> Props UnixLike
    containerProps Chroot
    c
    			-- Before ensuring any other properties of the chroot,
    			-- avoid starting services. Reverted by imageFinalized.
    			Props UnixLike
    -> RevertableProperty
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
         UnixLike
    -> Props
         (Sing
            (Combine
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
               '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
    forall {a} p (y :: [a]) (x :: [a]).
    (IsProp p, MetaTypes y ~ GetMetaTypes p,
     CheckCombinableNote x y (NoteFor ('Text "&^"))) =>
    Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
    &^ RevertableProperty
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
      UnixLike
    RevertableProperty (HasInfo + UnixLike) UnixLike
    Service.noServices
    			Props
      (Sing
         (Combine
            '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
    -> Property UnixLike
    -> Props
         (MetaTypes
            (Combine
               (Combine
                  '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                     'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
                  '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                     'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
               '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
    forall {a} p (y :: [a]) (x :: [a]).
    (IsProp p, MetaTypes y ~ GetMetaTypes p,
     CheckCombinableNote x y (NoteFor ('Text "&"))) =>
    Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
    & Property UnixLike
    cachesCleaned
    	-- Only propagate privdata Info from this chroot, nothing else.
    	propprivdataonly :: Chroot -> Chroot
    propprivdataonly (Chroot.Chroot MountPoint
    d b
    b InfoPropagator
    ip Host
    h) =
    		MountPoint -> b -> InfoPropagator -> Host -> Chroot
    forall b.
    ChrootBootstrapper b =>
    MountPoint -> b -> InfoPropagator -> Host -> Chroot
    Chroot.Chroot MountPoint
    d b
    b (\Chroot
    c PropagateInfo -> Bool
    _ -> InfoPropagator
    ip Chroot
    c PropagateInfo -> Bool
    onlyPrivData) Host
    h
    	-- Pick boot loader finalization based on which bootloader is
    	-- installed.
    	final :: Finalization
    final = case Info -> [BootloaderInstalled]
    forall v. IsInfo v => Info -> v
    fromInfo (Chroot -> Info
    forall c. IsContainer c => c -> Info
    containerInfo Chroot
    chroot) of
    		[] -> MountPoint -> Finalization
    unbootable MountPoint
    "no bootloader is installed"
    		[GrubInstalled GrubTarget
    grubtarget] -> GrubTarget -> Finalization
    grubFinalized GrubTarget
    grubtarget
    		[UbootInstalled MountPoint -> MountPoint -> Property Linux
    p] -> (MountPoint -> MountPoint -> Property Linux) -> Finalization
    ubootFinalized MountPoint -> MountPoint -> Property Linux
    p
    		[BootloaderInstalled
    FlashKernelInstalled] -> Finalization
    flashKernelFinalized
    		[UbootInstalled MountPoint -> MountPoint -> Property Linux
    p, BootloaderInstalled
    FlashKernelInstalled] ->
    			(MountPoint -> MountPoint -> Property Linux) -> Finalization
    ubootFlashKernelFinalized MountPoint -> MountPoint -> Property Linux
    p
    		[BootloaderInstalled
    FlashKernelInstalled, UbootInstalled MountPoint -> MountPoint -> Property Linux
    p] ->
    			(MountPoint -> MountPoint -> Property Linux) -> Finalization
    ubootFlashKernelFinalized MountPoint -> MountPoint -> Property Linux
    p
    		[BootloaderInstalled
    NoBootloader] -> Finalization
    noBootloaderFinalized
    		[BootloaderInstalled]
    _ -> MountPoint -> Finalization
    unbootable MountPoint
    "multiple bootloaders are installed; don't know which to use"

    -- | This property is automatically added to the chroot when building a
    -- disk image. It cleans any caches of information that can be omitted;
    -- eg the apt cache on Debian.
    cachesCleaned :: Property UnixLike
    cachesCleaned :: Property UnixLike
    cachesCleaned = MountPoint
    "cache cleaned" MountPoint -> Property UnixLike -> Property UnixLike
    forall i.
    IsProp (Property i) =>
    MountPoint -> Property i -> Property i
    ==> (Property DebianLike
    Apt.cacheCleaned Property DebianLike -> Property UnixLike -> Property UnixLike
    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
    skipit)
      where
    	skipit :: Property UnixLike
    skipit = Property UnixLike
    forall {k} (t :: k). SingI t => Property (MetaTypes t)
    doNothing :: Property UnixLike

    -- | Builds a disk image from the contents of a chroot.
    imageBuiltFrom :: DiskImage d => d -> FilePath -> TableType -> Finalization -> [PartSpec ()] -> RevertableProperty (HasInfo + DebianLike) Linux
    imageBuiltFrom :: forall d.
    DiskImage d =>
    d
    -> MountPoint
    -> TableType
    -> Finalization
    -> [PartSpec ()]
    -> RevertableProperty (HasInfo + DebianLike) Linux
    imageBuiltFrom d
    img MountPoint
    chrootdir TableType
    tabletype Finalization
    final [PartSpec ()]
    partspec = Property
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
    mkimg Property
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
    -> Property Linux
    -> RevertableProperty
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
         Linux
    forall setupmetatypes undometatypes.
    Property setupmetatypes
    -> Property undometatypes
    -> RevertableProperty setupmetatypes undometatypes
    <!> CombinedType (Property Linux) (Property UnixLike)
    Property Linux
    rmimg
      where
    	desc :: MountPoint
    desc = d -> MountPoint
    forall d. DiskImage d => d -> MountPoint
    describeDiskImage d
    img MountPoint -> MountPoint -> MountPoint
    forall a. [a] -> [a] -> [a]
    ++ MountPoint
    " built from " MountPoint -> MountPoint -> MountPoint
    forall a. [a] -> [a] -> [a]
    ++ MountPoint
    chrootdir
    	dest :: RawDiskImage
    dest@(RawDiskImage MountPoint
    imgfile) = d -> RawDiskImage
    forall d. DiskImage d => d -> RawDiskImage
    rawDiskImage d
    img
    	mkimg :: Property
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
    mkimg = MountPoint
    -> (OuterMetaTypesWitness
          '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
        -> Propellor Result)
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
    forall {k} (metatypes :: k).
    SingI metatypes =>
    MountPoint
    -> (OuterMetaTypesWitness metatypes -> Propellor Result)
    -> Property (MetaTypes metatypes)
    property' MountPoint
    desc ((OuterMetaTypesWitness
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
      -> Propellor Result)
     -> Property
          (MetaTypes
             '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
    -> (OuterMetaTypesWitness
          '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
        -> Propellor Result)
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
    forall a b. (a -> b) -> a -> b
    $ \OuterMetaTypesWitness
      '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    w -> do
    		-- Unmount helper filesystems such as proc from the chroot
    		-- first; don't want to include the contents of those.
    		IO () -> Propellor ()
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Propellor ()) -> IO () -> Propellor ()
    forall a b. (a -> b) -> a -> b
    $ MountPoint -> IO ()
    unmountBelow MountPoint
    chrootdir
    		Map MountPoint PartSize
    szm <- (MountPoint -> MountPoint)
    -> Map MountPoint PartSize -> Map MountPoint PartSize
    forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
    M.mapKeys (MountPoint -> MountPoint -> MountPoint
    toSysDir MountPoint
    chrootdir) (Map MountPoint PartSize -> Map MountPoint PartSize)
    -> (Map MountPoint Integer -> Map MountPoint PartSize)
    -> Map MountPoint Integer
    -> Map MountPoint PartSize
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Integer -> PartSize)
    -> Map MountPoint Integer -> Map MountPoint PartSize
    forall a b k. (a -> b) -> Map k a -> Map k b
    M.map Integer -> PartSize
    toPartSize
    			(Map MountPoint Integer -> Map MountPoint PartSize)
    -> Propellor (Map MountPoint Integer)
    -> Propellor (Map MountPoint PartSize)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO (Map MountPoint Integer) -> Propellor (Map MountPoint Integer)
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (MountPoint -> IO (Map MountPoint Integer)
    dirSizes MountPoint
    chrootdir)
    		let calcsz :: [Maybe MountPoint] -> Maybe MountPoint -> PartSize
    calcsz [Maybe MountPoint]
    mnts = PartSize -> (PartSize -> PartSize) -> Maybe PartSize -> PartSize
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe PartSize
    defSz PartSize -> PartSize
    fudgeSz (Maybe PartSize -> PartSize)
    -> (Maybe MountPoint -> Maybe PartSize)
    -> Maybe MountPoint
    -> PartSize
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map MountPoint PartSize
    -> [Maybe MountPoint] -> Maybe MountPoint -> Maybe PartSize
    getMountSz Map MountPoint PartSize
    szm [Maybe MountPoint]
    mnts
    		-- tie the knot!
    		let ([Maybe MountPoint]
    mnts, [MountOpts]
    mntopts, PartTable
    parttable) = TableType
    -> [PartSpec ()]
    -> [PartSize]
    -> ([Maybe MountPoint], [MountOpts], PartTable)
    fitChrootSize TableType
    tabletype [PartSpec ()]
    partspec ([PartSize] -> ([Maybe MountPoint], [MountOpts], PartTable))
    -> [PartSize] -> ([Maybe MountPoint], [MountOpts], PartTable)
    forall a b. (a -> b) -> a -> b
    $
    			(Maybe MountPoint -> PartSize) -> [Maybe MountPoint] -> [PartSize]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Maybe MountPoint] -> Maybe MountPoint -> PartSize
    calcsz [Maybe MountPoint]
    mnts) [Maybe MountPoint]
    mnts
    		OuterMetaTypesWitness
      '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    -> Property DebianLike -> Propellor Result
    forall (inner :: [MetaType]) (outer :: [MetaType]).
    EnsurePropertyAllowed inner outer =>
    OuterMetaTypesWitness outer
    -> Property (MetaTypes inner) -> Propellor Result
    ensureProperty OuterMetaTypesWitness
      '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    w (Property DebianLike -> Propellor Result)
    -> Property DebianLike -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $
    			RawDiskImage -> PartTable -> RevertableProperty DebianLike UnixLike
    imageExists' RawDiskImage
    dest PartTable
    parttable
    				RevertableProperty DebianLike UnixLike
    -> Property DebianLike
    -> CombinedType
         (RevertableProperty DebianLike UnixLike) (Property DebianLike)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `before`
    			MountPoint
    -> ([LoopDev] -> Property DebianLike) -> Property DebianLike
    kpartx MountPoint
    imgfile ([Maybe MountPoint]
    -> [MountOpts]
    -> PartTable
    -> [LoopDev]
    -> CombinedType (Property DebianLike) (Property Linux)
    mkimg' [Maybe MountPoint]
    mnts [MountOpts]
    mntopts PartTable
    parttable)
    				Property DebianLike
    -> RevertableProperty DebianLike Linux
    -> CombinedType
         (Property DebianLike) (RevertableProperty DebianLike Linux)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `before`
    			d -> RevertableProperty DebianLike Linux
    forall d. DiskImage d => d -> RevertableProperty DebianLike Linux
    buildDiskImage d
    img
    	mkimg' :: [Maybe MountPoint]
    -> [MountOpts]
    -> PartTable
    -> [LoopDev]
    -> CombinedType (Property DebianLike) (Property Linux)
    mkimg' [Maybe MountPoint]
    mnts [MountOpts]
    mntopts PartTable
    parttable [LoopDev]
    devs =
    		MountPoint
    -> [Maybe MountPoint]
    -> [MountOpts]
    -> [LoopDev]
    -> Property DebianLike
    partitionsPopulated MountPoint
    chrootdir [Maybe MountPoint]
    mnts [MountOpts]
    mntopts [LoopDev]
    devs
    			Property DebianLike
    -> Property Linux
    -> CombinedType (Property DebianLike) (Property Linux)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `before`
    		Finalization
    -> RawDiskImage
    -> [Maybe MountPoint]
    -> [MountOpts]
    -> [LoopDev]
    -> PartTable
    -> Property Linux
    imageFinalized Finalization
    final RawDiskImage
    dest [Maybe MountPoint]
    mnts [MountOpts]
    mntopts [LoopDev]
    devs PartTable
    parttable
    	rmimg :: CombinedType (Property Linux) (Property UnixLike)
    rmimg = RevertableProperty DebianLike Linux -> Property Linux
    forall setupmetatypes undometatypes.
    RevertableProperty setupmetatypes undometatypes
    -> Property undometatypes
    undoRevertableProperty (d -> RevertableProperty DebianLike Linux
    forall d. DiskImage d => d -> RevertableProperty DebianLike Linux
    buildDiskImage d
    img)
    		Property Linux
    -> Property UnixLike
    -> CombinedType (Property Linux) (Property UnixLike)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `before` RevertableProperty DebianLike UnixLike -> Property UnixLike
    forall setupmetatypes undometatypes.
    RevertableProperty setupmetatypes undometatypes
    -> Property undometatypes
    undoRevertableProperty (RawDiskImage -> PartTable -> RevertableProperty DebianLike UnixLike
    imageExists' RawDiskImage
    dest PartTable
    dummyparttable)
    	dummyparttable :: PartTable
    dummyparttable = TableType -> Alignment -> [Partition] -> PartTable
    PartTable TableType
    tabletype Alignment
    safeAlignment []

    partitionsPopulated :: FilePath -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> Property DebianLike
    partitionsPopulated :: MountPoint
    -> [Maybe MountPoint]
    -> [MountOpts]
    -> [LoopDev]
    -> Property DebianLike
    partitionsPopulated MountPoint
    chrootdir [Maybe MountPoint]
    mnts [MountOpts]
    mntopts [LoopDev]
    devs = MountPoint
    -> (OuterMetaTypesWitness
          '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
        -> Propellor Result)
    -> Property DebianLike
    forall {k} (metatypes :: k).
    SingI metatypes =>
    MountPoint
    -> (OuterMetaTypesWitness metatypes -> Propellor Result)
    -> Property (MetaTypes metatypes)
    property' MountPoint
    desc ((OuterMetaTypesWitness
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
      -> Propellor Result)
     -> Property DebianLike)
    -> (OuterMetaTypesWitness
          '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
        -> Propellor Result)
    -> Property DebianLike
    forall a b. (a -> b) -> a -> b
    $ \OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    w ->
    	[Propellor Result] -> Propellor Result
    forall a. Monoid a => [a] -> a
    mconcat ([Propellor Result] -> Propellor Result)
    -> [Propellor Result] -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $ (Maybe MountPoint -> MountOpts -> LoopDev -> Propellor Result)
    -> [Maybe MountPoint]
    -> [MountOpts]
    -> [LoopDev]
    -> [Propellor Result]
    forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
    zipWith3 (OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    -> Maybe MountPoint -> MountOpts -> LoopDev -> Propellor Result
    go OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    w) [Maybe MountPoint]
    mnts [MountOpts]
    mntopts [LoopDev]
    devs
      where
    	desc :: MountPoint
    desc = MountPoint
    "partitions populated from " MountPoint -> MountPoint -> MountPoint
    forall a. [a] -> [a] -> [a]
    ++ MountPoint
    chrootdir

    	go :: OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    -> Maybe MountPoint -> MountOpts -> LoopDev -> Propellor Result
    go OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    _ Maybe MountPoint
    Nothing MountOpts
    _ LoopDev
    _ = Propellor Result
    noChange
    	go OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    w (Just MountPoint
    mnt) MountOpts
    mntopt LoopDev
    loopdev = Propellor Bool
    -> (Propellor Result, Propellor Result) -> Propellor Result
    forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
    ifM (IO Bool -> Propellor Bool
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Bool -> Propellor Bool) -> IO Bool -> Propellor Bool
    forall a b. (a -> b) -> a -> b
    $ MountPoint -> IO Bool
    doesDirectoryExist MountPoint
    srcdir) ((Propellor Result, Propellor Result) -> Propellor Result)
    -> (Propellor Result, Propellor Result) -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $
    		( MountPoint -> (MountPoint -> Propellor Result) -> Propellor Result
    forall (m :: * -> *) a.
    (MonadMask m, MonadIO m) =>
    MountPoint -> (MountPoint -> m a) -> m a
    withTmpDir MountPoint
    "mnt" ((MountPoint -> Propellor Result) -> Propellor Result)
    -> (MountPoint -> Propellor Result) -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $ \MountPoint
    tmpdir -> Propellor Bool
    -> (Bool -> Propellor ())
    -> (Bool -> Propellor Result)
    -> Propellor Result
    forall (m :: * -> *) a c b.
    MonadMask m =>
    m a -> (a -> m c) -> (a -> m b) -> m b
    bracket
    			(IO Bool -> Propellor Bool
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Bool -> Propellor Bool) -> IO Bool -> Propellor Bool
    forall a b. (a -> b) -> a -> b
    $ MountPoint -> MountPoint -> MountPoint -> MountOpts -> IO Bool
    mount MountPoint
    "auto" (LoopDev -> MountPoint
    partitionLoopDev LoopDev
    loopdev) MountPoint
    tmpdir MountOpts
    mntopt)
    			(Propellor () -> Bool -> Propellor ()
    forall a b. a -> b -> a
    const (Propellor () -> Bool -> Propellor ())
    -> Propellor () -> Bool -> Propellor ()
    forall a b. (a -> b) -> a -> b
    $ IO () -> Propellor ()
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Propellor ()) -> IO () -> Propellor ()
    forall a b. (a -> b) -> a -> b
    $ MountPoint -> IO ()
    umountLazy MountPoint
    tmpdir)
    			((Bool -> Propellor Result) -> Propellor Result)
    -> (Bool -> Propellor Result) -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $ \Bool
    ismounted -> if Bool
    ismounted
    				then OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    -> Property Linux -> Propellor Result
    forall (inner :: [MetaType]) (outer :: [MetaType]).
    EnsurePropertyAllowed inner outer =>
    OuterMetaTypesWitness outer
    -> Property (MetaTypes inner) -> Propellor Result
    ensureProperty OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    w (Property Linux -> Propellor Result)
    -> Property Linux -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $
    					[Filter]
    -> MountPoint -> MountPoint -> Property (DebianLike + ArchLinux)
    syncDirFiltered (MountPoint -> [Filter]
    filtersfor MountPoint
    mnt) MountPoint
    srcdir MountPoint
    tmpdir
    				else Result -> Propellor Result
    forall a. a -> Propellor a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    FailedChange
    		, Result -> Propellor Result
    forall a. a -> Propellor a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    NoChange
    		)
    	  where
    		srcdir :: MountPoint
    srcdir = MountPoint
    chrootdir MountPoint -> MountPoint -> MountPoint
    forall a. [a] -> [a] -> [a]
    ++ MountPoint
    mnt

    	filtersfor :: MountPoint -> [Filter]
    filtersfor MountPoint
    mnt =
    		let childmnts :: [MountPoint]
    childmnts = (MountPoint -> MountPoint) -> [MountPoint] -> [MountPoint]
    forall a b. (a -> b) -> [a] -> [b]
    map (Int -> MountPoint -> MountPoint
    forall a. Int -> [a] -> [a]
    drop (MountPoint -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (MountPoint -> MountPoint
    dropTrailingPathSeparator MountPoint
    mnt))) ([MountPoint] -> [MountPoint]) -> [MountPoint] -> [MountPoint]
    forall a b. (a -> b) -> a -> b
    $
    			(MountPoint -> Bool) -> [MountPoint] -> [MountPoint]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\MountPoint
    m -> MountPoint
    m MountPoint -> MountPoint -> Bool
    forall a. Eq a => a -> a -> Bool
    /= MountPoint
    mnt Bool -> Bool -> Bool
    && MountPoint -> MountPoint
    addTrailingPathSeparator MountPoint
    mnt MountPoint -> MountPoint -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` MountPoint
    m)
    				([Maybe MountPoint] -> [MountPoint]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe MountPoint]
    mnts)
    		in (MountPoint -> [Filter]) -> [MountPoint] -> [Filter]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (\MountPoint
    m ->
    			-- Include the child mount point, but exclude its contents.
    			[ Pattern -> Filter
    Include (MountPoint -> Pattern
    Pattern MountPoint
    m)
    			, Pattern -> Filter
    Exclude (MountPoint -> Pattern
    filesUnder MountPoint
    m)
    			-- Preserve any lost+found directory that mkfs made
    			, Pattern -> Filter
    Protect (MountPoint -> Pattern
    Pattern MountPoint
    "lost+found")
    			]) [MountPoint]
    childmnts

    -- The constructor for each Partition is passed the size of the files
    -- from the chroot that will be put in that partition.
    fitChrootSize :: TableType -> [PartSpec ()] -> [PartSize] -> ([Maybe MountPoint], [MountOpts], PartTable)
    fitChrootSize :: TableType
    -> [PartSpec ()]
    -> [PartSize]
    -> ([Maybe MountPoint], [MountOpts], PartTable)
    fitChrootSize TableType
    tt [PartSpec ()]
    l [PartSize]
    basesizes = ([Maybe MountPoint]
    mounts, [MountOpts]
    mountopts, PartTable
    parttable)
      where
    	([Maybe MountPoint]
    mounts, [MountOpts]
    mountopts, [PartSize -> Partition]
    sizers, [()]
    _) = [PartSpec ()]
    -> ([Maybe MountPoint], [MountOpts], [PartSize -> Partition], [()])
    forall a b c d. [(a, b, c, d)] -> ([a], [b], [c], [d])
    unzip4 [PartSpec ()]
    l
    	parttable :: PartTable
    parttable = TableType -> Alignment -> [Partition] -> PartTable
    PartTable TableType
    tt Alignment
    safeAlignment (((PartSize -> Partition) -> PartSize -> Partition)
    -> [PartSize -> Partition] -> [PartSize] -> [Partition]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (PartSize -> Partition) -> PartSize -> Partition
    forall a. a -> a
    id [PartSize -> Partition]
    sizers [PartSize]
    basesizes)

    -- | Generates a map of the sizes of the contents of
    -- every directory in a filesystem tree.
    --
    -- (Hard links are counted multiple times for simplicity)
    --
    -- Should be same values as du -bl
    dirSizes :: FilePath -> IO (M.Map FilePath Integer)
    dirSizes :: MountPoint -> IO (Map MountPoint Integer)
    dirSizes MountPoint
    top = Map MountPoint Integer
    -> MountPoint -> [MountPoint] -> IO (Map MountPoint Integer)
    forall {b}.
    Num b =>
    Map MountPoint b
    -> MountPoint -> [MountPoint] -> IO (Map MountPoint b)
    go Map MountPoint Integer
    forall k a. Map k a
    M.empty MountPoint
    top [MountPoint
    top]
      where
    	go :: Map MountPoint b
    -> MountPoint -> [MountPoint] -> IO (Map MountPoint b)
    go Map MountPoint b
    m MountPoint
    _ [] = Map MountPoint b -> IO (Map MountPoint b)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Map MountPoint b
    m
    	go Map MountPoint b
    m MountPoint
    dir (MountPoint
    i:[MountPoint]
    is) = (IO (Map MountPoint b)
     -> (IOException -> IO (Map MountPoint b)) -> IO (Map MountPoint b))
    -> (IOException -> IO (Map MountPoint b))
    -> IO (Map MountPoint b)
    -> IO (Map MountPoint b)
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip IO (Map MountPoint b)
    -> (IOException -> IO (Map MountPoint b)) -> IO (Map MountPoint b)
    forall (m :: * -> *) a.
    MonadCatch m =>
    m a -> (IOException -> m a) -> m a
    catchIO (\IOException
    _ioerr -> Map MountPoint b
    -> MountPoint -> [MountPoint] -> IO (Map MountPoint b)
    go Map MountPoint b
    m MountPoint
    dir [MountPoint]
    is) (IO (Map MountPoint b) -> IO (Map MountPoint b))
    -> IO (Map MountPoint b) -> IO (Map MountPoint b)
    forall a b. (a -> b) -> a -> b
    $ do
    		FileStatus
    s <- MountPoint -> IO FileStatus
    getSymbolicLinkStatus MountPoint
    i
    		let sz :: b
    sz = FileOffset -> b
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (FileStatus -> FileOffset
    fileSize FileStatus
    s)
    		if FileStatus -> Bool
    isDirectory FileStatus
    s
    			then do
    				Map MountPoint b
    subm <- Map MountPoint b
    -> MountPoint -> [MountPoint] -> IO (Map MountPoint b)
    go Map MountPoint b
    forall k a. Map k a
    M.empty MountPoint
    i ([MountPoint] -> IO (Map MountPoint b))
    -> IO [MountPoint] -> IO (Map MountPoint b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< MountPoint -> IO [MountPoint]
    dirContents MountPoint
    i
    				let sz' :: b
    sz' = (b -> b -> b) -> b -> Map MountPoint b -> b
    forall a b k. (a -> b -> b) -> b -> Map k a -> b
    M.foldr' b -> b -> b
    forall a. Num a => a -> a -> a
    (+) b
    sz
    					((MountPoint -> b -> Bool) -> Map MountPoint b -> Map MountPoint b
    forall k a. (k -> a -> Bool) -> Map k a -> Map k a
    M.filterWithKey (Bool -> b -> Bool
    forall a b. a -> b -> a
    const (Bool -> b -> Bool)
    -> (MountPoint -> Bool) -> MountPoint -> b -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . MountPoint -> MountPoint -> Bool
    subdirof MountPoint
    i) Map MountPoint b
    subm)
    				Map MountPoint b
    -> MountPoint -> [MountPoint] -> IO (Map MountPoint b)
    go ((b -> b -> b)
    -> MountPoint -> b -> Map MountPoint b -> Map MountPoint b
    forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
    M.insertWith b -> b -> b
    forall a. Num a => a -> a -> a
    (+) MountPoint
    i b
    sz' (Map MountPoint b -> Map MountPoint b -> Map MountPoint b
    forall k a. Ord k => Map k a -> Map k a -> Map k a
    M.union Map MountPoint b
    m Map MountPoint b
    subm)) MountPoint
    dir [MountPoint]
    is
    			else Map MountPoint b
    -> MountPoint -> [MountPoint] -> IO (Map MountPoint b)
    go ((b -> b -> b)
    -> MountPoint -> b -> Map MountPoint b -> Map MountPoint b
    forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
    M.insertWith b -> b -> b
    forall a. Num a => a -> a -> a
    (+) MountPoint
    dir b
    sz Map MountPoint b
    m) MountPoint
    dir [MountPoint]
    is
    	subdirof :: MountPoint -> MountPoint -> Bool
    subdirof MountPoint
    parent MountPoint
    i = Bool -> Bool
    not (MountPoint
    i MountPoint -> MountPoint -> Bool
    `equalFilePath` MountPoint
    parent) Bool -> Bool -> Bool
    && MountPoint -> MountPoint
    takeDirectory MountPoint
    i MountPoint -> MountPoint -> Bool
    `equalFilePath` MountPoint
    parent

    getMountSz :: (M.Map FilePath PartSize) -> [Maybe MountPoint] -> Maybe MountPoint -> Maybe PartSize
    getMountSz :: Map MountPoint PartSize
    -> [Maybe MountPoint] -> Maybe MountPoint -> Maybe PartSize
    getMountSz Map MountPoint PartSize
    _ [Maybe MountPoint]
    _ Maybe MountPoint
    Nothing = Maybe PartSize
    forall a. Maybe a
    Nothing
    getMountSz Map MountPoint PartSize
    szm [Maybe MountPoint]
    l (Just MountPoint
    mntpt) =
    	(PartSize -> PartSize) -> Maybe PartSize -> Maybe PartSize
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (PartSize -> PartSize -> PartSize
    `reducePartSize` PartSize
    childsz) (MountPoint -> Map MountPoint PartSize -> Maybe PartSize
    forall k a. Ord k => k -> Map k a -> Maybe a
    M.lookup MountPoint
    mntpt Map MountPoint PartSize
    szm)
      where
    	childsz :: PartSize
    childsz = [PartSize] -> PartSize
    forall a. Monoid a => [a] -> a
    mconcat ([PartSize] -> PartSize) -> [PartSize] -> PartSize
    forall a b. (a -> b) -> a -> b
    $ (Maybe MountPoint -> Maybe PartSize)
    -> [Maybe MountPoint] -> [PartSize]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (Map MountPoint PartSize
    -> [Maybe MountPoint] -> Maybe MountPoint -> Maybe PartSize
    getMountSz Map MountPoint PartSize
    szm [Maybe MountPoint]
    l) ((Maybe MountPoint -> Bool)
    -> [Maybe MountPoint] -> [Maybe MountPoint]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (MountPoint -> Maybe MountPoint -> Bool
    isChild MountPoint
    mntpt) [Maybe MountPoint]
    l)

    -- | Ensures that a disk image file of the specified size exists.
    --
    -- If the file doesn't exist, or is too small, creates a new one, full of 0's.
    --
    -- If the file is too large, truncates it down to the specified size.
    imageExists :: RawDiskImage -> ByteSize -> Property Linux
    imageExists :: RawDiskImage -> Integer -> Property Linux
    imageExists (RawDiskImage MountPoint
    img) Integer
    isz = MountPoint -> Propellor Result -> Property Linux
    forall {k} (metatypes :: k).
    SingI metatypes =>
    MountPoint -> Propellor Result -> Property (MetaTypes metatypes)
    property (MountPoint
    "disk image exists" MountPoint -> MountPoint -> MountPoint
    forall a. [a] -> [a] -> [a]
    ++ MountPoint
    img) (Propellor Result -> Property Linux)
    -> Propellor Result -> Property Linux
    forall a b. (a -> b) -> a -> b
    $ IO Result -> Propellor Result
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Result -> Propellor Result) -> IO Result -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $ do
    	Maybe FileStatus
    ms <- IO FileStatus -> IO (Maybe FileStatus)
    forall (m :: * -> *) a. MonadCatch m => m a -> m (Maybe a)
    catchMaybeIO (IO FileStatus -> IO (Maybe FileStatus))
    -> IO FileStatus -> IO (Maybe FileStatus)
    forall a b. (a -> b) -> a -> b
    $ MountPoint -> IO FileStatus
    getFileStatus MountPoint
    img
    	case (FileStatus -> Integer) -> Maybe FileStatus -> Maybe Integer
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (FileOffset -> Integer
    forall a. Integral a => a -> Integer
    toInteger (FileOffset -> Integer)
    -> (FileStatus -> FileOffset) -> FileStatus -> Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FileStatus -> FileOffset
    fileSize) Maybe FileStatus
    ms of
    		Just Integer
    s
    			| Integer
    s Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Integer -> Integer
    forall a. Integral a => a -> Integer
    toInteger Integer
    sz -> Result -> IO Result
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    NoChange
    			| Integer
    s Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    > Integer -> Integer
    forall a. Integral a => a -> Integer
    toInteger Integer
    sz -> do
    				[MountPoint] -> IO ()
    forall (m :: * -> *). MonadIO m => [MountPoint] -> m ()
    infoMessage [MountPoint
    "truncating " MountPoint -> MountPoint -> MountPoint
    forall a. [a] -> [a] -> [a]
    ++ MountPoint
    img MountPoint -> MountPoint -> MountPoint
    forall a. [a] -> [a] -> [a]
    ++ MountPoint
    " to " MountPoint -> MountPoint -> MountPoint
    forall a. [a] -> [a] -> [a]
    ++ MountPoint
    humansz]
    				MountPoint -> FileOffset -> IO ()
    setFileSize MountPoint
    img (Integer -> FileOffset
    forall a. Num a => Integer -> a
    fromInteger Integer
    sz)
    				Result -> IO Result
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    MadeChange
    			| Bool
    otherwise -> do
    				[MountPoint] -> IO ()
    forall (m :: * -> *). MonadIO m => [MountPoint] -> m ()
    infoMessage [MountPoint
    "expanding " MountPoint -> MountPoint -> MountPoint
    forall a. [a] -> [a] -> [a]
    ++ MountPoint
    img MountPoint -> MountPoint -> MountPoint
    forall a. [a] -> [a] -> [a]
    ++ MountPoint
    " from " MountPoint -> MountPoint -> MountPoint
    forall a. [a] -> [a] -> [a]
    ++ [Unit] -> Bool -> Integer -> MountPoint
    roughSize [Unit]
    storageUnits Bool
    False Integer
    s MountPoint -> MountPoint -> MountPoint
    forall a. [a] -> [a] -> [a]
    ++ MountPoint
    " to " MountPoint -> MountPoint -> MountPoint
    forall a. [a] -> [a] -> [a]
    ++ MountPoint
    humansz]
    				MountPoint -> ByteString -> IO ()
    L.writeFile MountPoint
    img (Int64 -> Word8 -> ByteString
    L.replicate (Integer -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    sz) Word8
    0)
    				Result -> IO Result
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    MadeChange
    		Maybe Integer
    Nothing -> do
    			[MountPoint] -> IO ()
    forall (m :: * -> *). MonadIO m => [MountPoint] -> m ()
    infoMessage [MountPoint
    "creating " MountPoint -> MountPoint -> MountPoint
    forall a. [a] -> [a] -> [a]
    ++ MountPoint
    img MountPoint -> MountPoint -> MountPoint
    forall a. [a] -> [a] -> [a]
    ++ MountPoint
    " of size " MountPoint -> MountPoint -> MountPoint
    forall a. [a] -> [a] -> [a]
    ++ MountPoint
    humansz]
    			MountPoint -> ByteString -> IO ()
    L.writeFile MountPoint
    img (Int64 -> Word8 -> ByteString
    L.replicate (Integer -> Int64
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    sz) Word8
    0)
    			Result -> IO Result
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    MadeChange
      where
    	sz :: Integer
    sz = Double -> Integer
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    ceiling (Integer -> Double
    forall a. Num a => Integer -> a
    fromInteger Integer
    isz Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Double
    sectorsize) Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Double -> Integer
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    ceiling Double
    sectorsize
    	humansz :: MountPoint
    humansz = [Unit] -> Bool -> Integer -> MountPoint
    roughSize [Unit]
    storageUnits Bool
    False (Integer -> Integer
    forall a. Integral a => a -> Integer
    toInteger Integer
    sz)
    	-- Disks have a sector size, and making a disk image not
    	-- aligned to a sector size will confuse some programs.
    	-- Common sector sizes are 512 and 4096; use 4096 as it's larger.
    	sectorsize :: Double
    sectorsize = Double
    4096 :: Double

    -- | Ensure that disk image file exists and is partitioned.
    --
    -- Avoids repartitioning the disk image, when a file of the right size
    -- already exists, and it has the same PartTable.
    imageExists' :: RawDiskImage -> PartTable -> RevertableProperty DebianLike UnixLike
    imageExists' :: RawDiskImage -> PartTable -> RevertableProperty DebianLike UnixLike
    imageExists' dest :: RawDiskImage
    dest@(RawDiskImage MountPoint
    img) PartTable
    parttable = (Property DebianLike
    setup Property DebianLike
    -> Property UnixLike -> RevertableProperty DebianLike UnixLike
    forall setupmetatypes undometatypes.
    Property setupmetatypes
    -> Property undometatypes
    -> RevertableProperty setupmetatypes undometatypes
    <!> CombinedType (Property UnixLike) (Property UnixLike)
    Property UnixLike
    cleanup) RevertableProperty DebianLike UnixLike
    -> MountPoint -> RevertableProperty DebianLike UnixLike
    forall p. IsProp p => p -> MountPoint -> p
    `describe` MountPoint
    desc
      where
    	desc :: MountPoint
    desc = MountPoint
    "disk image exists " MountPoint -> MountPoint -> MountPoint
    forall a. [a] -> [a] -> [a]
    ++ MountPoint
    img
    	parttablefile :: MountPoint
    parttablefile = RawDiskImage -> MountPoint
    forall d. DiskImage d => d -> MountPoint
    imageParttableFile RawDiskImage
    dest
    	setup :: Property DebianLike
    setup = MountPoint
    -> (OuterMetaTypesWitness
          '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
        -> Propellor Result)
    -> Property DebianLike
    forall {k} (metatypes :: k).
    SingI metatypes =>
    MountPoint
    -> (OuterMetaTypesWitness metatypes -> Propellor Result)
    -> Property (MetaTypes metatypes)
    property' MountPoint
    desc ((OuterMetaTypesWitness
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
      -> Propellor Result)
     -> Property DebianLike)
    -> (OuterMetaTypesWitness
          '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
        -> Propellor Result)
    -> Property DebianLike
    forall a b. (a -> b) -> a -> b
    $ \OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    w -> do
    		MountPoint
    oldparttable <- IO MountPoint -> Propellor MountPoint
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO MountPoint -> Propellor MountPoint)
    -> IO MountPoint -> Propellor MountPoint
    forall a b. (a -> b) -> a -> b
    $ MountPoint -> IO MountPoint -> IO MountPoint
    forall (m :: * -> *) a. MonadCatch m => a -> m a -> m a
    catchDefaultIO MountPoint
    "" (IO MountPoint -> IO MountPoint) -> IO MountPoint -> IO MountPoint
    forall a b. (a -> b) -> a -> b
    $ MountPoint -> IO MountPoint
    readFileStrict MountPoint
    parttablefile
    		Result
    res <- OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    -> Property Linux -> Propellor Result
    forall (inner :: [MetaType]) (outer :: [MetaType]).
    EnsurePropertyAllowed inner outer =>
    OuterMetaTypesWitness outer
    -> Property (MetaTypes inner) -> Propellor Result
    ensureProperty OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    w (Property Linux -> Propellor Result)
    -> Property Linux -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $ RawDiskImage -> Integer -> Property Linux
    imageExists RawDiskImage
    dest (PartTable -> Integer
    partTableSize PartTable
    parttable)
    		if Result
    res Result -> Result -> Bool
    forall a. Eq a => a -> a -> Bool
    == Result
    NoChange Bool -> Bool -> Bool
    && MountPoint
    oldparttable MountPoint -> MountPoint -> Bool
    forall a. Eq a => a -> a -> Bool
    == PartTable -> MountPoint
    forall a. Show a => a -> MountPoint
    show PartTable
    parttable
    			then Result -> Propellor Result
    forall a. a -> Propellor a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    NoChange
    			else if Result
    res Result -> Result -> Bool
    forall a. Eq a => a -> a -> Bool
    == Result
    FailedChange
    				then Result -> Propellor Result
    forall a. a -> Propellor a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    FailedChange
    				else do
    					IO () -> Propellor ()
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Propellor ()) -> IO () -> Propellor ()
    forall a b. (a -> b) -> a -> b
    $ MountPoint -> MountPoint -> IO ()
    writeFile MountPoint
    parttablefile (PartTable -> MountPoint
    forall a. Show a => a -> MountPoint
    show PartTable
    parttable)
    					OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    -> Property DebianLike -> Propellor Result
    forall (inner :: [MetaType]) (outer :: [MetaType]).
    EnsurePropertyAllowed inner outer =>
    OuterMetaTypesWitness outer
    -> Property (MetaTypes inner) -> Propellor Result
    ensureProperty OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    w (Property DebianLike -> Propellor Result)
    -> Property DebianLike -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $ Eep -> MountPoint -> PartTable -> Property DebianLike
    partitioned Eep
    YesReallyDeleteDiskContents MountPoint
    img PartTable
    parttable
    	cleanup :: CombinedType (Property UnixLike) (Property UnixLike)
    cleanup = MountPoint -> Property UnixLike
    File.notPresent MountPoint
    img
    		Property UnixLike
    -> Property UnixLike
    -> CombinedType (Property UnixLike) (Property UnixLike)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `before`
    		MountPoint -> Property UnixLike
    File.notPresent MountPoint
    parttablefile

    -- | A property that is run after the disk image is created, with
    -- its populated partition tree mounted in the provided
    -- location from the provided loop devices. This is typically used to
    -- install a boot loader in the image's superblock.
    --
    -- It's ok if the property leaves additional things mounted
    -- in the partition tree.
    type Finalization = (RawDiskImage -> FilePath -> [LoopDev] -> Property Linux)

    imageFinalized :: Finalization -> RawDiskImage -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> PartTable -> Property Linux
    imageFinalized :: Finalization
    -> RawDiskImage
    -> [Maybe MountPoint]
    -> [MountOpts]
    -> [LoopDev]
    -> PartTable
    -> Property Linux
    imageFinalized Finalization
    final RawDiskImage
    img [Maybe MountPoint]
    mnts [MountOpts]
    mntopts [LoopDev]
    devs (PartTable TableType
    _ Alignment
    _ [Partition]
    parts) =
    	MountPoint
    -> (OuterMetaTypesWitness
          '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
             'Targeting 'OSArchLinux]
        -> Propellor Result)
    -> Property Linux
    forall {k} (metatypes :: k).
    SingI metatypes =>
    MountPoint
    -> (OuterMetaTypesWitness metatypes -> Propellor Result)
    -> Property (MetaTypes metatypes)
    property' MountPoint
    "disk image finalized" ((OuterMetaTypesWitness
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux]
      -> Propellor Result)
     -> Property Linux)
    -> (OuterMetaTypesWitness
          '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
             'Targeting 'OSArchLinux]
        -> Propellor Result)
    -> Property Linux
    forall a b. (a -> b) -> a -> b
    $ \OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux]
    w ->
    		MountPoint -> (MountPoint -> Propellor Result) -> Propellor Result
    forall (m :: * -> *) a.
    (MonadMask m, MonadIO m) =>
    MountPoint -> (MountPoint -> m a) -> m a
    withTmpDir MountPoint
    "mnt" ((MountPoint -> Propellor Result) -> Propellor Result)
    -> (MountPoint -> Propellor Result) -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $ \MountPoint
    top ->
    			OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux]
    -> MountPoint -> Propellor Result
    go OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux]
    w MountPoint
    top Propellor Result -> Propellor () -> Propellor Result
    forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
    `finally` IO () -> Propellor ()
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (MountPoint -> IO ()
    unmountall MountPoint
    top)
      where
    	go :: OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux]
    -> MountPoint -> Propellor Result
    go OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux]
    w MountPoint
    top = do
    		IO () -> Propellor ()
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Propellor ()) -> IO () -> Propellor ()
    forall a b. (a -> b) -> a -> b
    $ MountPoint -> IO ()
    mountall MountPoint
    top
    		IO () -> Propellor ()
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Propellor ()) -> IO () -> Propellor ()
    forall a b. (a -> b) -> a -> b
    $ MountPoint -> IO ()
    writefstab MountPoint
    top
    		IO () -> Propellor ()
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Propellor ()) -> IO () -> Propellor ()
    forall a b. (a -> b) -> a -> b
    $ MountPoint -> IO ()
    allowservices MountPoint
    top
    		OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux]
    -> Property Linux -> Propellor Result
    forall (inner :: [MetaType]) (outer :: [MetaType]).
    EnsurePropertyAllowed inner outer =>
    OuterMetaTypesWitness outer
    -> Property (MetaTypes inner) -> Propellor Result
    ensureProperty OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux]
    w (Property Linux -> Propellor Result)
    -> Property Linux -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $
    			Finalization
    final RawDiskImage
    img MountPoint
    top [LoopDev]
    devs

    	-- Ordered lexographically by mount point, so / comes before /usr
    	-- comes before /usr/local
    	orderedmntsdevs :: [(Maybe MountPoint, (MountOpts, LoopDev))]
    	orderedmntsdevs :: [(Maybe MountPoint, (MountOpts, LoopDev))]
    orderedmntsdevs = ((Maybe MountPoint, (MountOpts, LoopDev))
     -> (Maybe MountPoint, (MountOpts, LoopDev)) -> Ordering)
    -> [(Maybe MountPoint, (MountOpts, LoopDev))]
    -> [(Maybe MountPoint, (MountOpts, LoopDev))]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy (Maybe MountPoint -> Maybe MountPoint -> Ordering
    forall a. Ord a => a -> a -> Ordering
    compare (Maybe MountPoint -> Maybe MountPoint -> Ordering)
    -> ((Maybe MountPoint, (MountOpts, LoopDev)) -> Maybe MountPoint)
    -> (Maybe MountPoint, (MountOpts, LoopDev))
    -> (Maybe MountPoint, (MountOpts, LoopDev))
    -> Ordering
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` (Maybe MountPoint, (MountOpts, LoopDev)) -> Maybe MountPoint
    forall a b. (a, b) -> a
    fst) ([(Maybe MountPoint, (MountOpts, LoopDev))]
     -> [(Maybe MountPoint, (MountOpts, LoopDev))])
    -> [(Maybe MountPoint, (MountOpts, LoopDev))]
    -> [(Maybe MountPoint, (MountOpts, LoopDev))]
    forall a b. (a -> b) -> a -> b
    $ [Maybe MountPoint]
    -> [(MountOpts, LoopDev)]
    -> [(Maybe MountPoint, (MountOpts, LoopDev))]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Maybe MountPoint]
    mnts ([MountOpts] -> [LoopDev] -> [(MountOpts, LoopDev)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [MountOpts]
    mntopts [LoopDev]
    devs)

    	swaps :: [SwapPartition]
    swaps = ((Partition, LoopDev) -> SwapPartition)
    -> [(Partition, LoopDev)] -> [SwapPartition]
    forall a b. (a -> b) -> [a] -> [b]
    map (MountPoint -> SwapPartition
    SwapPartition (MountPoint -> SwapPartition)
    -> ((Partition, LoopDev) -> MountPoint)
    -> (Partition, LoopDev)
    -> SwapPartition
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LoopDev -> MountPoint
    partitionLoopDev (LoopDev -> MountPoint)
    -> ((Partition, LoopDev) -> LoopDev)
    -> (Partition, LoopDev)
    -> MountPoint
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Partition, LoopDev) -> LoopDev
    forall a b. (a, b) -> b
    snd) ([(Partition, LoopDev)] -> [SwapPartition])
    -> [(Partition, LoopDev)] -> [SwapPartition]
    forall a b. (a -> b) -> a -> b
    $
    		((Partition, LoopDev) -> Bool)
    -> [(Partition, LoopDev)] -> [(Partition, LoopDev)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((Maybe Fs -> Maybe Fs -> Bool
    forall a. Eq a => a -> a -> Bool
    == Fs -> Maybe Fs
    forall a. a -> Maybe a
    Just Fs
    LinuxSwap) (Maybe Fs -> Bool)
    -> ((Partition, LoopDev) -> Maybe Fs)
    -> (Partition, LoopDev)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Partition -> Maybe Fs
    partFs (Partition -> Maybe Fs)
    -> ((Partition, LoopDev) -> Partition)
    -> (Partition, LoopDev)
    -> Maybe Fs
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Partition, LoopDev) -> Partition
    forall a b. (a, b) -> a
    fst) ([(Partition, LoopDev)] -> [(Partition, LoopDev)])
    -> [(Partition, LoopDev)] -> [(Partition, LoopDev)]
    forall a b. (a -> b) -> a -> b
    $
    			[Partition] -> [LoopDev] -> [(Partition, LoopDev)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Partition]
    parts [LoopDev]
    devs

    	mountall :: MountPoint -> IO ()
    mountall MountPoint
    top = [(Maybe MountPoint, (MountOpts, LoopDev))]
    -> ((Maybe MountPoint, (MountOpts, LoopDev)) -> IO ()) -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    forM_ [(Maybe MountPoint, (MountOpts, LoopDev))]
    orderedmntsdevs (((Maybe MountPoint, (MountOpts, LoopDev)) -> IO ()) -> IO ())
    -> ((Maybe MountPoint, (MountOpts, LoopDev)) -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \(Maybe MountPoint
    mp, (MountOpts
    mopts, LoopDev
    loopdev)) -> case Maybe MountPoint
    mp of
    		Maybe MountPoint
    Nothing -> IO ()
    forall (m :: * -> *). Monad m => m ()
    noop
    		Just MountPoint
    p -> do
    			let mnt :: MountPoint
    mnt = MountPoint
    top MountPoint -> MountPoint -> MountPoint
    forall a. [a] -> [a] -> [a]
    ++ MountPoint
    p
    			Bool -> MountPoint -> IO ()
    createDirectoryIfMissing Bool
    True MountPoint
    mnt
    			IO Bool -> IO () -> IO ()
    forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
    unlessM (MountPoint -> MountPoint -> MountPoint -> MountOpts -> IO Bool
    mount MountPoint
    "auto" (LoopDev -> MountPoint
    partitionLoopDev LoopDev
    loopdev) MountPoint
    mnt MountOpts
    mopts) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
    				MountPoint -> IO ()
    forall a. HasCallStack => MountPoint -> a
    error (MountPoint -> IO ()) -> MountPoint -> IO ()
    forall a b. (a -> b) -> a -> b
    $ MountPoint
    "failed mounting " MountPoint -> MountPoint -> MountPoint
    forall a. [a] -> [a] -> [a]
    ++ MountPoint
    mnt

    	unmountall :: MountPoint -> IO ()
    unmountall MountPoint
    top = do
    		MountPoint -> IO ()
    unmountBelow MountPoint
    top
    		MountPoint -> IO ()
    umountLazy MountPoint
    top

    	writefstab :: MountPoint -> IO ()
    writefstab MountPoint
    top = do
    		let fstab :: MountPoint
    fstab = MountPoint
    top MountPoint -> MountPoint -> MountPoint
    forall a. [a] -> [a] -> [a]
    ++ MountPoint
    "/etc/fstab"
    		[MountPoint]
    old <- [MountPoint] -> IO [MountPoint] -> IO [MountPoint]
    forall (m :: * -> *) a. MonadCatch m => a -> m a -> m a
    catchDefaultIO [] (IO [MountPoint] -> IO [MountPoint])
    -> IO [MountPoint] -> IO [MountPoint]
    forall a b. (a -> b) -> a -> b
    $ (MountPoint -> Bool) -> [MountPoint] -> [MountPoint]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (MountPoint -> Bool) -> MountPoint -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . MountPoint -> Bool
    unconfigured) ([MountPoint] -> [MountPoint])
    -> (MountPoint -> [MountPoint]) -> MountPoint -> [MountPoint]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . MountPoint -> [MountPoint]
    lines
    			(MountPoint -> [MountPoint]) -> IO MountPoint -> IO [MountPoint]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> MountPoint -> IO MountPoint
    readFileStrict MountPoint
    fstab
    		[MountPoint]
    new <- [MountPoint]
    -> [SwapPartition] -> (MountPoint -> MountPoint) -> IO [MountPoint]
    genFstab ((MountPoint -> MountPoint) -> [MountPoint] -> [MountPoint]
    forall a b. (a -> b) -> [a] -> [b]
    map (MountPoint
    top MountPoint -> MountPoint -> MountPoint
    forall a. [a] -> [a] -> [a]
    ++) ([Maybe MountPoint] -> [MountPoint]
    forall a. [Maybe a] -> [a]
    catMaybes [Maybe MountPoint]
    mnts))
    			[SwapPartition]
    swaps (MountPoint -> MountPoint -> MountPoint
    toSysDir MountPoint
    top)
    		MountPoint -> MountPoint -> IO ()
    writeFile MountPoint
    fstab (MountPoint -> IO ()) -> MountPoint -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [MountPoint] -> MountPoint
    unlines ([MountPoint] -> MountPoint) -> [MountPoint] -> MountPoint
    forall a b. (a -> b) -> a -> b
    $ [MountPoint]
    new [MountPoint] -> [MountPoint] -> [MountPoint]
    forall a. [a] -> [a] -> [a]
    ++ [MountPoint]
    old
    	-- Eg "UNCONFIGURED FSTAB FOR BASE SYSTEM"
    	unconfigured :: MountPoint -> Bool
    unconfigured MountPoint
    s = MountPoint
    "UNCONFIGURED" MountPoint -> MountPoint -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isInfixOf` MountPoint
    s

    	allowservices :: MountPoint -> IO ()
    allowservices MountPoint
    top = MountPoint -> IO ()
    nukeFile (MountPoint
    top MountPoint -> MountPoint -> MountPoint
    forall a. [a] -> [a] -> [a]
    ++ MountPoint
    "/usr/sbin/policy-rc.d")

    unbootable :: String -> Finalization
    unbootable :: MountPoint -> Finalization
    unbootable MountPoint
    msg = \RawDiskImage
    _ MountPoint
    _ [LoopDev]
    _ -> MountPoint -> Propellor Result -> Property Linux
    forall {k} (metatypes :: k).
    SingI metatypes =>
    MountPoint -> Propellor Result -> Property (MetaTypes metatypes)
    property MountPoint
    desc (Propellor Result -> Property Linux)
    -> Propellor Result -> Property Linux
    forall a b. (a -> b) -> a -> b
    $ do
    	MountPoint -> Propellor ()
    forall (m :: * -> *). MonadIO m => MountPoint -> m ()
    warningMessage (MountPoint
    desc MountPoint -> MountPoint -> MountPoint
    forall a. [a] -> [a] -> [a]
    ++ MountPoint
    ": " MountPoint -> MountPoint -> MountPoint
    forall a. [a] -> [a] -> [a]
    ++ MountPoint
    msg)
    	Result -> Propellor Result
    forall a. a -> Propellor a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    FailedChange
      where
    	desc :: MountPoint
    desc = MountPoint
    "image is not bootable"

    grubFinalized :: GrubTarget -> Finalization
    grubFinalized :: GrubTarget -> Finalization
    grubFinalized GrubTarget
    grubtarget RawDiskImage
    _img MountPoint
    mnt [LoopDev]
    loopdevs =
    	MountPoint -> MountPoint -> GrubTarget -> Property Linux
    Grub.bootsMounted MountPoint
    mnt MountPoint
    wholediskloopdev GrubTarget
    grubtarget
    		Property Linux -> MountPoint -> Property Linux
    forall p. IsProp p => p -> MountPoint -> p
    `describe` MountPoint
    "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
    	-- for the whole disk image we seek.
    	wholediskloopdev :: MountPoint
    wholediskloopdev = case [LoopDev]
    loopdevs of
    		(LoopDev
    l:[LoopDev]
    _) -> LoopDev -> MountPoint
    wholeDiskLoopDev LoopDev
    l
    		[] -> MountPoint -> MountPoint
    forall a. HasCallStack => MountPoint -> a
    error MountPoint
    "No loop devs provided!"

    ubootFinalized :: (FilePath -> FilePath -> Property Linux) -> Finalization
    ubootFinalized :: (MountPoint -> MountPoint -> Property Linux) -> Finalization
    ubootFinalized MountPoint -> MountPoint -> Property Linux
    p (RawDiskImage MountPoint
    img) MountPoint
    mnt [LoopDev]
    _loopdevs = MountPoint -> MountPoint -> Property Linux
    p MountPoint
    img MountPoint
    mnt

    flashKernelFinalized :: Finalization
    flashKernelFinalized :: Finalization
    flashKernelFinalized RawDiskImage
    _img MountPoint
    mnt [LoopDev]
    _loopdevs = MountPoint -> Property Linux
    FlashKernel.flashKernelMounted MountPoint
    mnt

    ubootFlashKernelFinalized :: (FilePath -> FilePath -> Property Linux) -> Finalization
    ubootFlashKernelFinalized :: (MountPoint -> MountPoint -> Property Linux) -> Finalization
    ubootFlashKernelFinalized MountPoint -> MountPoint -> Property Linux
    p RawDiskImage
    img MountPoint
    mnt [LoopDev]
    loopdevs =
    	(MountPoint -> MountPoint -> Property Linux) -> Finalization
    ubootFinalized MountPoint -> MountPoint -> Property Linux
    p RawDiskImage
    img MountPoint
    mnt [LoopDev]
    loopdevs
    		Property Linux
    -> Property Linux -> CombinedType (Property Linux) (Property Linux)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `before` Finalization
    flashKernelFinalized RawDiskImage
    img MountPoint
    mnt [LoopDev]
    loopdevs

    -- | Normally a boot loader is installed on a disk image. However,
    -- when the disk image will be booted by eg qemu booting the kernel and
    -- initrd, no boot loader is needed, and this property can be used.
    noBootloader :: Property (HasInfo + UnixLike)
    noBootloader :: Property (HasInfo + UnixLike)
    noBootloader = MountPoint
    -> [BootloaderInstalled] -> Property (HasInfo + UnixLike)
    forall v.
    IsInfo v =>
    MountPoint -> v -> Property (HasInfo + UnixLike)
    pureInfoProperty MountPoint
    "no bootloader" [BootloaderInstalled
    NoBootloader]

    noBootloaderFinalized :: Finalization
    noBootloaderFinalized :: Finalization
    noBootloaderFinalized RawDiskImage
    _img MountPoint
    _mnt [LoopDev]
    _loopDevs = Property Linux
    forall {k} (t :: k). SingI t => Property (MetaTypes t)
    doNothing

    imageChrootNotPresent :: DiskImage d => d -> Property UnixLike
    imageChrootNotPresent :: forall d. DiskImage d => d -> Property UnixLike
    imageChrootNotPresent d
    img = IO Bool -> Property UnixLike -> Property UnixLike
    forall (p :: * -> *) i (m :: * -> *).
    (Checkable p i, LiftPropellor m) =>
    m Bool -> p i -> Property i
    check (MountPoint -> IO Bool
    doesDirectoryExist MountPoint
    dir) (Property UnixLike -> Property UnixLike)
    -> Property UnixLike -> Property UnixLike
    forall a b. (a -> b) -> a -> b
    $
    	MountPoint -> Propellor Result -> Property UnixLike
    forall {k} (metatypes :: k).
    SingI metatypes =>
    MountPoint -> Propellor Result -> Property (MetaTypes metatypes)
    property MountPoint
    "destroy the chroot used to build the image" (Propellor Result -> Property UnixLike)
    -> Propellor Result -> Property UnixLike
    forall a b. (a -> b) -> a -> b
    $ IO () -> Propellor Result
    makeChange (IO () -> Propellor Result) -> IO () -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $ do
    		MountPoint -> IO ()
    removeChroot MountPoint
    dir
    		MountPoint -> IO ()
    nukeFile (MountPoint -> IO ()) -> MountPoint -> IO ()
    forall a b. (a -> b) -> a -> b
    $ d -> MountPoint
    forall d. DiskImage d => d -> MountPoint
    imageParttableFile d
    img
      where
    	dir :: MountPoint
    dir = d -> MountPoint
    forall d. DiskImage d => d -> MountPoint
    imageChroot d
    img

    imageChroot :: DiskImage d => d -> FilePath
    imageChroot :: forall d. DiskImage d => d -> MountPoint
    imageChroot d
    img = MountPoint
    imgfile MountPoint -> MountPoint -> MountPoint
    <.> MountPoint
    "chroot"
      where
    	RawDiskImage MountPoint
    imgfile = d -> RawDiskImage
    forall d. DiskImage d => d -> RawDiskImage
    rawDiskImage d
    img

    imageParttableFile :: DiskImage d => d -> FilePath
    imageParttableFile :: forall d. DiskImage d => d -> MountPoint
    imageParttableFile d
    img = MountPoint
    imgfile MountPoint -> MountPoint -> MountPoint
    <.> MountPoint
    "parttable"
      where
    	RawDiskImage MountPoint
    imgfile = d -> RawDiskImage
    forall d. DiskImage d => d -> RawDiskImage
    rawDiskImage d
    img

    isChild :: FilePath -> Maybe MountPoint -> Bool
    isChild :: MountPoint -> Maybe MountPoint -> Bool
    isChild MountPoint
    mntpt (Just MountPoint
    d)
    	| MountPoint
    d MountPoint -> MountPoint -> Bool
    `equalFilePath` MountPoint
    mntpt = Bool
    False
    	| Bool
    otherwise = MountPoint
    mntpt MountPoint -> MountPoint -> Bool
    `dirContains` MountPoint
    d
    isChild MountPoint
    _ Maybe MountPoint
    Nothing = Bool
    False

    -- | From a location in a chroot (eg, /tmp/chroot/usr) to
    -- the corresponding location inside (eg, /usr).
    toSysDir :: FilePath -> FilePath -> FilePath
    toSysDir :: MountPoint -> MountPoint -> MountPoint
    toSysDir MountPoint
    chrootdir MountPoint
    d = case MountPoint -> MountPoint -> MountPoint
    makeRelative MountPoint
    chrootdir MountPoint
    d of
    		MountPoint
    "." -> MountPoint
    "/"
    		MountPoint
    sysdir -> MountPoint
    "/" MountPoint -> MountPoint -> MountPoint
    forall a. [a] -> [a] -> [a]
    ++ MountPoint
    sysdir