From 540faf8215f8c38e1c6f8da4d82776986eea62a6 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 16 Nov 2017 15:51:21 -0400 Subject: flash-kernel support Can be used to create disk images for arm boards using flash-kernel. This commit was sponsored by Ewen McNeill. --- src/Propellor/Types/Bootloader.hs | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'src/Propellor/Types') diff --git a/src/Propellor/Types/Bootloader.hs b/src/Propellor/Types/Bootloader.hs index 4a75503a..9822d520 100644 --- a/src/Propellor/Types/Bootloader.hs +++ b/src/Propellor/Types/Bootloader.hs @@ -5,7 +5,9 @@ module Propellor.Types.Bootloader where import Propellor.Types.Info -- | Boot loader installed on a host. -data BootloaderInstalled = GrubInstalled +data BootloaderInstalled + = GrubInstalled + | FlashKernelInstalled deriving (Typeable, Show) instance IsInfo [BootloaderInstalled] where -- cgit v1.2.3 From cff178de9c0d229574ab884fcca08a41f434e119 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 16 Nov 2017 17:54:47 -0400 Subject: Uboot: New module. Installing u-boot to the boot sector is not needed by some boards (my CubieTruck boots without it), but may be by others. Tricky part was making u-boot be written to a disk image when building one. This commit was sponsored by Jake Vosloo on Patreon. --- debian/changelog | 1 + propellor.cabal | 1 + src/Propellor/Property/DiskImage.hs | 33 ++++++++++++++++++--------------- src/Propellor/Property/Machine.hs | 17 +++++++++-------- src/Propellor/Property/Mount.hs | 20 ++++++++++++-------- src/Propellor/Property/Uboot.hs | 36 ++++++++++++++++++++++++++++++++++++ src/Propellor/Types/Bootloader.hs | 9 ++++++++- 7 files changed, 85 insertions(+), 32 deletions(-) create mode 100644 src/Propellor/Property/Uboot.hs (limited to 'src/Propellor/Types') diff --git a/debian/changelog b/debian/changelog index d6be2ca7..894c906f 100644 --- a/debian/changelog +++ b/debian/changelog @@ -12,6 +12,7 @@ propellor (4.9.1) UNRELEASED; urgency=medium * Qemu: New module. * FlashKernel: New module, can be used to create disk images for ARM boards using flash-kernel. + * Uboot: New module. * Machine: New module, machine-specific properties for ARM boards are being collected here. diff --git a/propellor.cabal b/propellor.cabal index 51640658..239a00e6 100644 --- a/propellor.cabal +++ b/propellor.cabal @@ -157,6 +157,7 @@ Library Propellor.Property.Systemd.Core Propellor.Property.Timezone Propellor.Property.Tor + Propellor.Property.Uboot Propellor.Property.Unbound Propellor.Property.User Propellor.Property.Uwsgi diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs index 7493dd21..fe2e60ac 100644 --- a/src/Propellor/Property/DiskImage.hs +++ b/src/Propellor/Property/DiskImage.hs @@ -191,10 +191,14 @@ imageBuilt' rebuild img mkchroot tabletype partspec = -- Pick boot loader finalization based on which bootloader is -- installed. final = case fromInfo (containerInfo chroot) of - [GrubInstalled] -> grubBooted - [FlashKernelInstalled] -> \_ _ -> doNothing [] -> unbootable "no bootloader is installed" - _ -> unbootable "multiple bootloaders are installed; don't know which to use" + l -> case filter ignorablefinal l of + [] -> \_ _ _ -> doNothing + [GrubInstalled] -> grubFinalized + [UbootInstalled p] -> ubootFinalized p + _ -> unbootable "multiple bootloaders are installed; don't know which to use" + ignorablefinal FlashKernelInstalled = True + ignorablefinal _ = False -- | This property is automatically added to the chroot when building a -- disk image. It cleans any caches of information that can be omitted; @@ -229,7 +233,7 @@ imageBuiltFrom img chrootdir tabletype final partspec = mkimg rmimg mkimg' mnts mntopts parttable devs = partitionsPopulated chrootdir mnts mntopts devs `before` - imageFinalized final mnts mntopts devs parttable + imageFinalized final dest mnts mntopts devs parttable rmimg = undoRevertableProperty (buildDiskImage img) `before` undoRevertableProperty (imageExists' dest dummyparttable) dummyparttable = PartTable tabletype [] @@ -352,10 +356,10 @@ imageExists' dest@(RawDiskImage img) parttable = (setup cleanup) `describe` -- -- It's ok if the property leaves additional things mounted -- in the partition tree. -type Finalization = (FilePath -> [LoopDev] -> Property Linux) +type Finalization = (RawDiskImage -> FilePath -> [LoopDev] -> Property Linux) -imageFinalized :: Finalization -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> PartTable -> Property Linux -imageFinalized final mnts mntopts devs (PartTable _ parts) = +imageFinalized :: Finalization -> RawDiskImage -> [Maybe MountPoint] -> [MountOpts] -> [LoopDev] -> PartTable -> Property Linux +imageFinalized final img mnts mntopts devs (PartTable _ parts) = property' "disk image finalized" $ \w -> withTmpDir "mnt" $ \top -> go w top `finally` liftIO (unmountall top) @@ -364,7 +368,7 @@ imageFinalized final mnts mntopts devs (PartTable _ parts) = liftIO $ mountall top liftIO $ writefstab top liftIO $ allowservices top - ensureProperty w $ final top devs + ensureProperty w $ final img top devs -- Ordered lexographically by mount point, so / comes before /usr -- comes before /usr/local @@ -400,18 +404,14 @@ imageFinalized final mnts mntopts devs (PartTable _ parts) = allowservices top = nukeFile (top ++ "/usr/sbin/policy-rc.d") unbootable :: String -> Finalization -unbootable msg = \_ _ -> property desc $ do +unbootable msg = \_ _ _ -> property desc $ do warningMessage (desc ++ ": " ++ msg) return FailedChange where desc = "image is not bootable" --- | Makes grub be the boot loader of the disk image. --- --- This does not install the grub package. You will need to add --- the `Grub.installed` property to the chroot. -grubBooted :: Finalization -grubBooted mnt loopdevs = Grub.bootsMounted mnt wholediskloopdev +grubFinalized :: Finalization +grubFinalized _img mnt loopdevs = Grub.bootsMounted mnt wholediskloopdev `describe` "disk image boots using grub" where -- It doesn't matter which loopdev we use; all @@ -421,6 +421,9 @@ grubBooted mnt loopdevs = Grub.bootsMounted mnt wholediskloopdev (l:_) -> wholeDiskLoopDev l [] -> error "No loop devs provided!" +ubootFinalized :: (FilePath -> FilePath -> Property Linux) -> Finalization +ubootFinalized p (RawDiskImage img) mnt _loopdevs = p img mnt + isChild :: FilePath -> Maybe MountPoint -> Bool isChild mntpt (Just d) | d `equalFilePath` mntpt = False diff --git a/src/Propellor/Property/Machine.hs b/src/Propellor/Property/Machine.hs index 2f356bdd..5f5024df 100644 --- a/src/Propellor/Property/Machine.hs +++ b/src/Propellor/Property/Machine.hs @@ -14,6 +14,7 @@ module Propellor.Property.Machine ( import Propellor.Base import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.FlashKernel as FlashKernel +import qualified Propellor.Property.Uboot as Uboot -- | Cubietech Cubietruck -- @@ -21,21 +22,21 @@ import qualified Propellor.Property.FlashKernel as FlashKernel -- this property. Also, see https://bugs.debian.org/844056 cubietech_Cubietruck :: Property (HasInfo + DebianLike) cubietech_Cubietruck = FlashKernel.installed "Cubietech Cubietruck" - `requires` sunixi + `requires` sunixi "Cubietruck" `requires` lpae -- | Olimex A10-OLinuXino-LIME olimex_A10_OLinuXino_LIME :: Property (HasInfo + DebianLike) olimex_A10_OLinuXino_LIME = FlashKernel.installed "Olimex A10-OLinuXino-LIME" - `requires` sunixi + `requires` sunixi "A10-OLinuXino-Lime" `requires` armmp -sunixi :: Property DebianLike -sunixi = Apt.installed - [ "firmware-linux-free" - , "u-boot" - , "sunxi-tools" - ] +sunixi :: Uboot.BoardName -> Property (HasInfo + DebianLike) +sunixi boardname = Uboot.sunxi boardname + `requires` Apt.installed + [ "firmware-linux-free" + , "sunxi-tools" + ] armmp :: Property DebianLike armmp = Apt.installed ["linux-image-armmp"] diff --git a/src/Propellor/Property/Mount.hs b/src/Propellor/Property/Mount.hs index 2c4d9620..c047161d 100644 --- a/src/Propellor/Property/Mount.hs +++ b/src/Propellor/Property/Mount.hs @@ -90,18 +90,18 @@ mountPointsBelow target = filter (\p -> simplifyPath p /= simplifyPath target) -- | Filesystem type mounted at a given location. getFsType :: MountPoint -> IO (Maybe FsType) -getFsType = findmntField "fstype" +getFsType p = findmntField "fstype" [p] -- | Mount options for the filesystem mounted at a given location. getFsMountOpts :: MountPoint -> IO MountOpts getFsMountOpts p = maybe mempty toMountOpts - <$> findmntField "fs-options" p + <$> findmntField "fs-options" [p] type UUID = String -- | UUID of filesystem mounted at a given location. getMountUUID :: MountPoint -> IO (Maybe UUID) -getMountUUID = findmntField "uuid" +getMountUUID p = findmntField "uuid" [p] -- | UUID of a device getSourceUUID :: Source -> IO (Maybe UUID) @@ -111,7 +111,7 @@ type Label = String -- | Label of filesystem mounted at a given location. getMountLabel :: MountPoint -> IO (Maybe Label) -getMountLabel = findmntField "label" +getMountLabel p = findmntField "label" [p] -- | Label of a device getSourceLabel :: Source -> IO (Maybe UUID) @@ -119,12 +119,16 @@ getSourceLabel = blkidTag "LABEL" -- | Device mounted at a given location. getMountSource :: MountPoint -> IO (Maybe Source) -getMountSource = findmntField "source" +getMountSource p = findmntField "source" [p] -findmntField :: String -> FilePath -> IO (Maybe String) -findmntField field mnt = catchDefaultIO Nothing $ +-- | Device that a given path is located within. +getMountContaining :: FilePath -> IO (Maybe Source) +getMountContaining p = findmntField "source" ["-T", p] + +findmntField :: String -> [String] -> IO (Maybe String) +findmntField field ps = catchDefaultIO Nothing $ headMaybe . filter (not . null) . lines - <$> readProcess "findmnt" ["-n", mnt, "--output", field] + <$> readProcess "findmnt" ("-n" : ps ++ ["--output", field]) blkidTag :: String -> Source -> IO (Maybe String) blkidTag tag dev = catchDefaultIO Nothing $ diff --git a/src/Propellor/Property/Uboot.hs b/src/Propellor/Property/Uboot.hs new file mode 100644 index 00000000..70b4dd68 --- /dev/null +++ b/src/Propellor/Property/Uboot.hs @@ -0,0 +1,36 @@ +module Propellor.Property.Uboot where + +import Propellor.Base +import Propellor.Types.Info +import Propellor.Types.Bootloader +import Propellor.Property.Chroot +import Propellor.Property.Mount +import qualified Propellor.Property.Apt as Apt + +-- | Name of a board. +type BoardName = String + +-- | Installs u-boot for Allwinner/sunxi platforms. +-- +-- This includes writing it to the boot sector. +sunxi :: BoardName -> Property (HasInfo + DebianLike) +sunxi boardname = setInfoProperty (check (not <$> inChroot) go) info + `requires` Apt.installed ["u-boot", "u-boot-sunxi"] + where + go :: Property Linux + go = property' "u-boot installed" $ \w -> do + v <- liftIO $ getMountContaining "/boot" + case v of + Nothing -> error "unable to determine boot device" + Just dev -> ensureProperty w (dd dev "/") + dd :: FilePath -> FilePath -> Property Linux + dd dev prefix = tightenTargets $ cmdProperty "dd" + [ "conv=fsync,notrunc" + , "if=" ++ prefix "/usr/lib/u-boot" + boardname "u-boot-sunxi-with-spl.bin" + , "of=" ++ dev + , "bs=1024" + , "seek=8" + ] + `assume` NoChange + info = toInfo [UbootInstalled dd] diff --git a/src/Propellor/Types/Bootloader.hs b/src/Propellor/Types/Bootloader.hs index 9822d520..fd929d7e 100644 --- a/src/Propellor/Types/Bootloader.hs +++ b/src/Propellor/Types/Bootloader.hs @@ -2,13 +2,20 @@ module Propellor.Types.Bootloader where +import Propellor.Types import Propellor.Types.Info -- | Boot loader installed on a host. data BootloaderInstalled = GrubInstalled | FlashKernelInstalled - deriving (Typeable, Show) + | UbootInstalled (FilePath -> FilePath -> Property Linux) + deriving (Typeable) + +instance Show BootloaderInstalled where + show GrubInstalled = "GrubInstalled" + show FlashKernelInstalled = "FlashKernelInstalled" + show (UbootInstalled _) = "UbootInstalled" instance IsInfo [BootloaderInstalled] where propagateInfo _ = PropagateInfo False -- cgit v1.2.3 From 492c52bfabb4d1772034eb15b263f5e257d2548b Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 18 Nov 2017 05:02:24 -0400 Subject: reorganized --- src/Propellor/Property/DiskImage.hs | 2 +- src/Propellor/Property/DiskImage/PartSpec.hs | 67 +++++++++++++++++++----- src/Propellor/Property/Parted.hs | 23 ++++++-- src/Propellor/Property/SiteSpecific/JoeySites.hs | 2 +- src/Propellor/Types/PartSpec.hs | 58 -------------------- 5 files changed, 76 insertions(+), 76 deletions(-) (limited to 'src/Propellor/Types') diff --git a/src/Propellor/Property/DiskImage.hs b/src/Propellor/Property/DiskImage.hs index f0e1602e..2c35b532 100644 --- a/src/Propellor/Property/DiskImage.hs +++ b/src/Propellor/Property/DiskImage.hs @@ -224,7 +224,7 @@ imageBuiltFrom img chrootdir tabletype final partspec = mkimg rmimg liftIO $ unmountBelow chrootdir szm <- M.mapKeys (toSysDir chrootdir) . M.map toPartSize <$> liftIO (dirSizes chrootdir) - let calcsz mnts = maybe defSz fudge . getMountSz szm mnts + let calcsz mnts = maybe defSz fudgeSz . getMountSz szm mnts -- tie the knot! let (mnts, mntopts, parttable) = fitChrootSize tabletype partspec $ map (calcsz mnts) mnts diff --git a/src/Propellor/Property/DiskImage/PartSpec.hs b/src/Propellor/Property/DiskImage/PartSpec.hs index 55249889..f7492589 100644 --- a/src/Propellor/Property/DiskImage/PartSpec.hs +++ b/src/Propellor/Property/DiskImage/PartSpec.hs @@ -1,10 +1,5 @@ -- | Disk image partition specification and combinators. --- Partitions in disk images default to being sized large enough to hold --- the files that appear in the directory where the partition is to be --- mounted. Plus a fudge factor, since filesystems have some space --- overhead. - module Propellor.Property.DiskImage.PartSpec ( module Propellor.Types.PartSpec, module Propellor.Property.DiskImage.PartSpec, @@ -17,17 +12,63 @@ import Propellor.Property.Parted import Propellor.Types.PartSpec import Propellor.Property.Parted.Types import Propellor.Property.Partition (Fs(..)) +import Propellor.Property.Mount + +-- | Specifies a partition with a given filesystem. +-- +-- The partition is not mounted anywhere by default; use the combinators +-- below to configure it. +partition :: Monoid t => Fs -> PartSpec t +partition fs = (Nothing, mempty, mkPartition fs, mempty) + +-- | Specifies a swap partition of a given size. +swapPartition :: Monoid t => PartSize -> PartSpec t +swapPartition sz = (Nothing, mempty, const (mkPartition LinuxSwap sz), mempty) --- | Adds additional free space to the partition. +-- | Specifies where to mount a partition. +mountedAt :: PartSpec t -> FilePath -> PartSpec t +mountedAt (_, o, p, t) mp = (Just mp, o, p, t) + +-- | Partitions in disk images default to being sized large enough to hold +-- the files that live in that partition. +-- +-- This adds additional free space to a partition. addFreeSpace :: PartSpec t -> PartSize -> PartSpec t addFreeSpace (mp, o, p, t) freesz = (mp, o, p', t) where p' = \sz -> p (sz <> freesz) --- | Add 2% for filesystem overhead. Rationalle for picking 2%: --- A filesystem with 1% overhead might just sneak by as acceptable. --- Double that just in case. Add an additional 3 mb to deal with --- non-scaling overhead of filesystems (eg, superblocks). --- Add an additional 200 mb for temp files, journals, etc. -fudge :: PartSize -> PartSize -fudge (MegaBytes n) = MegaBytes (n + n `div` 100 * 2 + 3 + 200) +-- | Specify a fixed size for a partition. +setSize :: PartSpec t -> PartSize -> PartSpec t +setSize (mp, o, p, t) sz = (mp, o, const (p sz), t) + +-- | Specifies a mount option, such as "noexec" +mountOpt :: ToMountOpts o => PartSpec t -> o -> PartSpec t +mountOpt (mp, o, p, t) o' = (mp, o <> toMountOpts o', p, t) + +-- | Mount option to make a partition be remounted readonly when there's an +-- error accessing it. +errorReadonly :: MountOpts +errorReadonly = toMountOpts "errors=remount-ro" + +-- | Sets the percent of the filesystem blocks reserved for the super-user. +-- +-- The default is 5% for ext2 and ext4. Some filesystems may not support +-- this. +reservedSpacePercentage :: PartSpec t -> Int -> PartSpec t +reservedSpacePercentage s percent = adjustp s $ \p -> + p { partMkFsOpts = ("-m"):show percent:partMkFsOpts p } + +-- | Sets a flag on the partition. +setFlag :: PartSpec t -> PartFlag -> PartSpec t +setFlag s f = adjustp s $ \p -> p { partFlags = (f, True):partFlags p } + +-- | Makes a MSDOS partition be Extended, rather than Primary. +extended :: PartSpec t -> PartSpec t +extended s = adjustp s $ \p -> p { partType = Extended } + +adjustp :: PartSpec t -> (Partition -> Partition) -> PartSpec t +adjustp (mp, o, p, t) f = (mp, o, f . p, t) + +adjustt :: PartSpec t -> (t -> t) -> PartSpec t +adjustt (mp, o, p, t) f = (mp, o, p, f t) diff --git a/src/Propellor/Property/Parted.hs b/src/Propellor/Property/Parted.hs index 43744142..d60d4a60 100644 --- a/src/Propellor/Property/Parted.hs +++ b/src/Propellor/Property/Parted.hs @@ -21,13 +21,14 @@ module Propellor.Property.Parted ( parted, Eep(..), installed, - -- * PartSpec combinators + -- * Partition table sizing calcPartTable, DiskSize(..), DiskPart, - module Propellor.Types.PartSpec, DiskSpaceUse(..), useDiskSpace, + defSz, + fudgeSz, ) where import Propellor.Base @@ -35,7 +36,7 @@ import Propellor.Property.Parted.Types import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Pacman as Pacman import qualified Propellor.Property.Partition as Partition -import Propellor.Types.PartSpec +import Propellor.Types.PartSpec (PartSpec) import Utility.DataUnits import System.Posix.Files @@ -160,3 +161,19 @@ instance Monoid DiskPart -- (less all fixed size partitions), or the remaining space in the disk. useDiskSpace :: PartSpec DiskPart -> DiskSpaceUse -> PartSpec DiskPart useDiskSpace (mp, o, p, _) diskuse = (mp, o, p, DynamicDiskPart diskuse) + +-- | Default partition size when not otherwize specified is 128 MegaBytes. +defSz :: PartSize +defSz = MegaBytes 128 + +-- | When a partition is sized to fit the files that live in it, +-- this fudge factor is added to the size of the files. This is necessary +-- since filesystems have some space overhead. +-- +-- Add 2% for filesystem overhead. Rationalle for picking 2%: +-- A filesystem with 1% overhead might just sneak by as acceptable. +-- Double that just in case. Add an additional 3 mb to deal with +-- non-scaling overhead of filesystems (eg, superblocks). +-- Add an additional 200 mb for temp files, journals, etc. +fudgeSz :: PartSize -> PartSize +fudgeSz (MegaBytes n) = MegaBytes (n + n `div` 100 * 2 + 3 + 200) diff --git a/src/Propellor/Property/SiteSpecific/JoeySites.hs b/src/Propellor/Property/SiteSpecific/JoeySites.hs index 1a4e211c..097171a3 100644 --- a/src/Propellor/Property/SiteSpecific/JoeySites.hs +++ b/src/Propellor/Property/SiteSpecific/JoeySites.hs @@ -971,7 +971,7 @@ homeRouter = propertyList "home router" $ props `requires` File.dirExists "/etc/hostapd" `requires` File.hasContent "/etc/default/hostapd" [ "DAEMON_CONF=/etc/hostapd/hostapd.conf" ] - `onChange` Service.started "hostapd" + `onChange` Service.running "hostapd" & File.hasContent "/etc/resolv.conf" [ "domain kitenet.net" , "search kitenet.net" diff --git a/src/Propellor/Types/PartSpec.hs b/src/Propellor/Types/PartSpec.hs index 2b0a8787..860b38f6 100644 --- a/src/Propellor/Types/PartSpec.hs +++ b/src/Propellor/Types/PartSpec.hs @@ -1,66 +1,8 @@ --- | Partition specification combinators. - module Propellor.Types.PartSpec where -import Propellor.Base import Propellor.Property.Parted.Types import Propellor.Property.Mount -import Propellor.Property.Partition -- | Specifies a mount point, mount options, and a constructor for a -- Partition that determines its size. type PartSpec t = (Maybe MountPoint, MountOpts, PartSize -> Partition, t) - --- | Specifies a partition with a given filesystem. --- --- The partition is not mounted anywhere by default; use the combinators --- below to configure it. -partition :: Monoid t => Fs -> PartSpec t -partition fs = (Nothing, mempty, mkPartition fs, mempty) - --- | Specifies a swap partition of a given size. -swapPartition :: Monoid t => PartSize -> PartSpec t -swapPartition sz = (Nothing, mempty, const (mkPartition LinuxSwap sz), mempty) - --- | Specifies where to mount a partition. -mountedAt :: PartSpec t -> FilePath -> PartSpec t -mountedAt (_, o, p, t) mp = (Just mp, o, p, t) - --- | Specify a fixed size for a partition. -setSize :: PartSpec t -> PartSize -> PartSpec t -setSize (mp, o, p, t) sz = (mp, o, const (p sz), t) - --- | Specifies a mount option, such as "noexec" -mountOpt :: ToMountOpts o => PartSpec t -> o -> PartSpec t -mountOpt (mp, o, p, t) o' = (mp, o <> toMountOpts o', p, t) - --- | Mount option to make a partition be remounted readonly when there's an --- error accessing it. -errorReadonly :: MountOpts -errorReadonly = toMountOpts "errors=remount-ro" - --- | Sets the percent of the filesystem blocks reserved for the super-user. --- --- The default is 5% for ext2 and ext4. Some filesystems may not support --- this. -reservedSpacePercentage :: PartSpec t -> Int -> PartSpec t -reservedSpacePercentage s percent = adjustp s $ \p -> - p { partMkFsOpts = ("-m"):show percent:partMkFsOpts p } - --- | Sets a flag on the partition. -setFlag :: PartSpec t -> PartFlag -> PartSpec t -setFlag s f = adjustp s $ \p -> p { partFlags = (f, True):partFlags p } - --- | Makes a MSDOS partition be Extended, rather than Primary. -extended :: PartSpec t -> PartSpec t -extended s = adjustp s $ \p -> p { partType = Extended } - -adjustp :: PartSpec t -> (Partition -> Partition) -> PartSpec t -adjustp (mp, o, p, t) f = (mp, o, f . p, t) - -adjustt :: PartSpec t -> (t -> t) -> PartSpec t -adjustt (mp, o, p, t) f = (mp, o, p, f t) - --- | Default partition size when not otherwize specified is 128 MegaBytes. -defSz :: PartSize -defSz = MegaBytes 128 -- cgit v1.2.3