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/FreeBSD/Pkg.hs | 89 +++++++++++++++++++++++++++++++++++ 1 file changed, 89 insertions(+) create mode 100644 src/Propellor/Property/FreeBSD/Pkg.hs (limited to 'src/Propellor/Property/FreeBSD/Pkg.hs') diff --git a/src/Propellor/Property/FreeBSD/Pkg.hs b/src/Propellor/Property/FreeBSD/Pkg.hs new file mode 100644 index 00000000..7e02d99b --- /dev/null +++ b/src/Propellor/Property/FreeBSD/Pkg.hs @@ -0,0 +1,89 @@ +-- | FreeBSD pkgng properties +-- +-- Copyright 2016 Evan Cofsky +-- License: BSD 2-clause + +{-# Language ScopedTypeVariables, GeneralizedNewtypeDeriving #-} + +module Propellor.Property.FreeBSD.Pkg where + +import Propellor.Base +import Propellor.Types.Info + +noninteractiveEnv :: [([Char], [Char])] +noninteractiveEnv = [("ASSUME_ALWAYS_YES", "yes")] + +pkgCommand :: String -> [String] -> (String, [String]) +pkgCommand cmd args = ("pkg", (cmd:args)) + +runPkg :: String -> [String] -> IO [String] +runPkg cmd args = + let + (p, a) = pkgCommand cmd args + in + lines <$> readProcess p a + +pkgCmdProperty :: String -> [String] -> UncheckedProperty NoInfo +pkgCmdProperty cmd args = + let + (p, a) = pkgCommand cmd args + in + cmdPropertyEnv p a noninteractiveEnv + +pkgCmd :: String -> [String] -> IO [String] +pkgCmd cmd args = + let + (p, a) = pkgCommand cmd args + in + lines <$> readProcessEnv p a (Just noninteractiveEnv) + +newtype PkgUpdate = PkgUpdate String + deriving (Typeable, Monoid, Show) +instance IsInfo PkgUpdate where + propagateInfo _ = False + +pkgUpdated :: PkgUpdate -> Bool +pkgUpdated (PkgUpdate _) = True + +update :: Property HasInfo +update = + let + upd = pkgCmd "update" [] + go = ifM (pkgUpdated <$> askInfo) ((noChange), (liftIO upd >> return MadeChange)) + in + infoProperty "pkg update has run" go (addInfo mempty (PkgUpdate "")) [] + +newtype PkgUpgrade = PkgUpgrade String + deriving (Typeable, Monoid, Show) +instance IsInfo PkgUpgrade where + propagateInfo _ = False + +pkgUpgraded :: PkgUpgrade -> Bool +pkgUpgraded (PkgUpgrade _) = True + +upgrade :: Property HasInfo +upgrade = + let + upd = pkgCmd "upgrade" [] + go = ifM (pkgUpgraded <$> askInfo) ((noChange), (liftIO upd >> return MadeChange)) + in + infoProperty "pkg upgrade has run" go (addInfo mempty (PkgUpgrade "")) [] `requires` update + +type Package = String + +installed :: Package -> Property NoInfo +installed pkg = + check (isInstallable pkg) $ pkgCmdProperty "install" [pkg] + +isInstallable :: Package -> IO Bool +isInstallable p = do + l <- isInstalled p + e <- exists p + + return $ (not l) && e + +isInstalled :: Package -> IO Bool +isInstalled p = catch (runPkg "info" [p] >> return True) (\(_ :: IOError ) -> return False) + +exists :: Package -> IO Bool +exists p = catch (runPkg "search" ["--search", "name", "--exact", p] >> return True) (\(_ :: IOError ) -> return False) -- cgit v1.2.3