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 +++++++++++++++++ src/Propellor/Property/FreeBSD/Poudriere.hs | 147 ++++++++++++++++++++++++++++ 2 files changed, 236 insertions(+) create mode 100644 src/Propellor/Property/FreeBSD/Pkg.hs create mode 100644 src/Propellor/Property/FreeBSD/Poudriere.hs (limited to 'src/Propellor/Property/FreeBSD') 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) diff --git a/src/Propellor/Property/FreeBSD/Poudriere.hs b/src/Propellor/Property/FreeBSD/Poudriere.hs new file mode 100644 index 00000000..217e6e5a --- /dev/null +++ b/src/Propellor/Property/FreeBSD/Poudriere.hs @@ -0,0 +1,147 @@ +-- | FreeBSD Poudriere properties +-- +-- Copyright 2016 Evan Cofsky +-- License: BSD 2-clause + +{-# Language GeneralizedNewtypeDeriving #-} + +-- | Maintainer: Evan Cofsky + +module Propellor.Property.FreeBSD.Poudriere where + +import Propellor.Base +import Propellor.Types.Info +import Data.List +import Data.String (IsString(..)) + +import qualified Propellor.Property.FreeBSD.Pkg as Pkg +import qualified Propellor.Property.ZFS as ZFS +import qualified Propellor.Property.File as File + +poudriereConfigPath :: FilePath +poudriereConfigPath = "/usr/local/etc/poudriere.conf" + +newtype PoudriereConfigured = PoudriereConfigured String + deriving (Typeable, Monoid, Show) +instance IsInfo PoudriereConfigured where + propagateInfo _ = False + +poudriereConfigured :: PoudriereConfigured -> Bool +poudriereConfigured (PoudriereConfigured _) = True + +setConfigured :: Property HasInfo +setConfigured = pureInfoProperty "Poudriere Configured" (PoudriereConfigured "") + +poudriere :: Poudriere -> Property HasInfo +poudriere conf@(Poudriere _ _ _ _ _ _ zfs) = + let + confProp = + File.containsLines poudriereConfigPath (toLines conf) + setZfs (PoudriereZFS z p) = ZFS.zfsSetProperties z p `describe` "Configuring Poudriere with ZFS" + prop :: CombinedType (Property NoInfo) (Property NoInfo) + prop = + if isJust zfs + then ((setZfs $ fromJust zfs) `before` confProp) + else propertyList "Configuring Poudriere without ZFS" [confProp] + in + prop + `requires` Pkg.installed "poudriere" + `before` setConfigured + +poudriereCommand :: String -> [String] -> (String, [String]) +poudriereCommand cmd args = ("poudriere", cmd:args) + +runPoudriere :: String -> [String] -> IO [String] +runPoudriere cmd args = + let + (p, a) = poudriereCommand cmd args + in + lines <$> readProcess p a + +listJails :: IO [String] +listJails = runPoudriere "jail" ["-l", "-q"] + +jailExists :: Jail -> IO Bool +jailExists (Jail name _ _) = isInfixOf [name] <$> listJails + +jail :: Jail -> Property NoInfo +jail j@(Jail name version arch) = + let + cfgd = poudriereConfigured <$> askInfo + + notExists :: IO Bool + notExists = not <$> jailExists j + chk = do + c <- cfgd + x <- liftIO notExists + return $ c && x + + (cmd, args) = poudriereCommand "jail" ["-c", "-j", name, "-a", show arch, "-v", show version] + createJail = cmdProperty cmd args + in + checkResult chk (\_ -> return MadeChange) createJail + `describe` unwords ["Create poudriere jail", name] + + +data Poudriere = Poudriere + { _resolvConf :: String + , _freebsdHost :: String + , _baseFs :: String + , _usePortLint :: Bool + , _distFilesCache :: FilePath + , _svnHost :: String + , _zfs :: Maybe PoudriereZFS} + +defaultConfig :: Poudriere +defaultConfig = Poudriere + "/etc/resolv.conf" + "ftp://ftp5.us.FreeBSD.org" + "/usr/local/poudriere" + True + "/usr/ports/distfiles" + "svn.freebsd.org" + Nothing + +data PoudriereZFS = PoudriereZFS ZFS.ZFS ZFS.ZFSProperties + +data Jail = Jail String FBSDVersion PoudriereArch + +data PoudriereArch = I386 | AMD64 deriving (Eq) +instance Show PoudriereArch where + show I386 = "i386" + show AMD64 = "amd64" + +instance IsString PoudriereArch where + fromString "i386" = I386 + fromString "amd64" = AMD64 + fromString _ = error "Not a valid Poudriere architecture." + +yesNoProp :: Bool -> String +yesNoProp b = if b then "yes" else "no" + +instance ToShellConfigLines Poudriere where + toAssoc c = map (\(k, f) -> (k, f c)) + [("RESOLV_CONF", _resolvConf) + ,("FREEBSD_HOST", _freebsdHost) + ,("BASEFS", _baseFs) + ,("USE_PORTLINT", yesNoProp . _usePortLint) + ,("DISTFILES_CACHE", _distFilesCache) + ,("SVN_HOST", _svnHost)] ++ maybe [("NO_ZFS", "yes")] toAssoc (_zfs c) + +instance ToShellConfigLines PoudriereZFS where + toAssoc (PoudriereZFS (ZFS.ZFS (ZFS.ZPool pool) dataset) _) = + [("NO_ZFS", "no") + , ("ZPOOL", pool) + , ("ZROOTFS", show dataset)] + +type ConfigLine = String +type ConfigFile = [ConfigLine] + +class ToShellConfigLines a where + toAssoc :: a -> [(String, String)] + + toLines :: a -> [ConfigLine] + toLines c = map (\(k, v) -> intercalate "=" [k, v]) $ toAssoc c + +confFile :: FilePath +confFile = "/usr/local/etc/poudriere.conf" -- cgit v1.2.3