From 822694e790102efa2a5bb4a0c3d62c6fce1d4e87 Mon Sep 17 00:00:00 2001 From: Evan Cofsky Date: Fri, 26 Feb 2016 10:20:21 -0600 Subject: FreeBSD Support including: - Propellor bootstrapping - Basic pkg - Basic ZFS datasets and properties - Simple Poudriere configuration (regular and ZFS) - Poudriere jail creation FIXME: - Cron.hs: runPropellor needs the System, but hasn't yet gotten it. Reorganizing: - Remove FreeBSD.Process - Move ZFS up to Property - Add Info for Pkg.update/Pkg.upgrade - Move FreeBSD.md to doc so it'll show up automatically. - Merge the FreeBSD config with the other sample config. - Use Info to check Pkg updated/upgraded and Poudriere configured. - Warnings clean-up, move ZFS types to Propellor.Types. - Maintainer and license statements. --- src/Propellor/Property/ZFS/Process.hs | 40 ++++++++++++++++++++++++++++++++ src/Propellor/Property/ZFS/Properties.hs | 37 +++++++++++++++++++++++++++++ 2 files changed, 77 insertions(+) create mode 100644 src/Propellor/Property/ZFS/Process.hs create mode 100644 src/Propellor/Property/ZFS/Properties.hs (limited to 'src/Propellor/Property/ZFS') diff --git a/src/Propellor/Property/ZFS/Process.hs b/src/Propellor/Property/ZFS/Process.hs new file mode 100644 index 00000000..c6615252 --- /dev/null +++ b/src/Propellor/Property/ZFS/Process.hs @@ -0,0 +1,40 @@ +-- | Functions running zfs processes. +-- +-- Copyright 2016 Evan Cofsky +-- License: BSD 2-clause + +module Propellor.Property.ZFS.Process where + +import Propellor.Base +import Data.String.Utils (split) +import Data.List + +-- | Gets the properties of a ZFS volume. +zfsGetProperties :: ZFS -> IO ZFSProperties +zfsGetProperties z = + let + plist = fromPropertyList . map (\(_:k:v:_) -> (k, v)) . (map (split "\t")) + in + do + plist <$> runZfs "get" [Just "-H", Just "-p", Just "all"] z + +zfsExists :: ZFS -> IO Bool +zfsExists z = + any id . map (isInfixOf (zfsName z)) <$> runZfs "list" [Just "-H"] z + +-- | Runs the zfs command with the arguments. +-- +-- Runs the command with -H which will skip the header line and +-- separate all fields with tabs. +-- +-- Replaces Nothing in the argument list with the ZFS pool/dataset. +runZfs :: String -> [Maybe String] -> ZFS -> IO [String] +runZfs cmd args z = + let + (p, a) = zfsCommand cmd args z + in + lines <$> readProcess p a + +-- | Return the ZFS command line suitable for readProcess or cmdProperty. +zfsCommand :: String -> [Maybe String] -> ZFS -> (String, [String]) +zfsCommand cmd args z = ("zfs", cmd:(map (maybe (zfsName z) id) args)) diff --git a/src/Propellor/Property/ZFS/Properties.hs b/src/Propellor/Property/ZFS/Properties.hs new file mode 100644 index 00000000..ba303bc3 --- /dev/null +++ b/src/Propellor/Property/ZFS/Properties.hs @@ -0,0 +1,37 @@ +-- | Functions defining zfs Properties. +-- +-- Copyright 2016 Evan Cofsky +-- License: BSD 2-clause + +module Propellor.Property.ZFS.Properties ( + zfsExists, zfsSetProperties + ) where + +import Propellor.Base +import Data.List (intercalate) +import qualified Propellor.Property.ZFS.Process as ZP + +-- | Will ensure that a ZFS volume exists with the specified mount point. +-- This requires the pool to exist as well, but we don't create pools yet. +zfsExists :: ZFS -> Property NoInfo +zfsExists z = + let + (p, a) = ZP.zfsCommand "create" [Nothing] z + create = cmdProperty p a + in + check (not <$> ZP.zfsExists z) (create) `describe` (unwords ["Creating", zfsName z]) + +-- | Sets the given properties. Returns True if all were successfully changed, False if not. +zfsSetProperties :: ZFS -> ZFSProperties -> Property NoInfo +zfsSetProperties z setProperties = + let + spcmd :: String -> String -> (String, [String]) + spcmd p v = ZP.zfsCommand "set" [Just (intercalate "=" [p, v]), Nothing] z + + setprop :: (String, String) -> Property NoInfo + setprop (p, v) = check (ZP.zfsExists z) $ cmdProperty (fst (spcmd p v)) (snd (spcmd p v)) + + setall = combineProperties (unwords ["Setting properties on", zfsName z]) $ + map setprop $ toPropertyList setProperties + in + setall `requires` zfsExists z -- cgit v1.2.3