propellor 2.8.1 → 2.9.0

raw patch · 87 files changed

+1240/−584 lines, 87 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- Propellor: localdir :: FilePath

- Propellor.PropAccum: data PropList

- Propellor.PropAccum: instance Propellor.PropAccum.PropAccum Propellor.PropAccum.PropList

- Propellor.PropAccum: propigateContainer :: (PropAccum container) => String -> container -> Property HasInfo -> Property HasInfo

- Propellor.PropAccum: props :: PropList

- Propellor.Property.Chroot: UsingDeboostrap :: DebootstrapConfig -> BuilderConf

- Propellor.Property.Chroot: data BuilderConf

- Propellor.Property.Chroot: instance GHC.Show.Show Propellor.Property.Chroot.BuilderConf

- Propellor.Property.Chroot: propigateChrootInfo :: (IsProp (Property i)) => Chroot -> Property i -> Property HasInfo

- Propellor.Property.List: instance Propellor.Property.List.PropertyList Propellor.PropAccum.PropList

- Propellor.Property.Ssh: getPubKey :: Propellor (Map SshKeyType PubKeyText)

- Propellor.Property.Ssh: instance GHC.Base.Monoid Propellor.Property.Ssh.SshPubKeyInfo

- Propellor.Property.Ssh: instance GHC.Classes.Eq Propellor.Property.Ssh.SshPubKeyInfo

- Propellor.Property.Ssh: instance GHC.Classes.Ord Propellor.Property.Ssh.SshPubKeyInfo

- Propellor.Property.Ssh: instance Propellor.Types.Info.IsInfo Propellor.Property.Ssh.SshPubKeyInfo

- Propellor.Property.Ssh: keyImported :: IsContext c => SshKeyType -> User -> c -> Property HasInfo

- Propellor.Property.Ssh: keyImported' :: IsContext c => Maybe FilePath -> SshKeyType -> User -> c -> Property HasInfo

- Propellor.Property.Ssh: pubKey :: SshKeyType -> PubKeyText -> Property HasInfo

- Propellor.Types: before :: (IsProp x, Combines y x, IsProp (CombinedType y x)) => x -> y -> CombinedType y x

- Propellor.Types: describe :: IsProp p => p -> Desc -> p

- Propellor.Types: requires :: Combines x y => x -> y -> CombinedType x y

- Propellor.Types.Info: instance Data.Typeable.Internal.Typeable v => Propellor.Types.Info.IsInfo (Propellor.Types.Info.InfoVal v)

- Propellor.Types.Info: propigatableInfo :: Info -> Info

- Propellor.Types.Info: propigateInfo :: IsInfo v => v -> Bool

+ Propellor: (!) :: PropAccum h => h -> RevertableProperty -> h

+ Propellor: (&) :: (PropAccum h, IsProp p) => h -> p -> h

+ Propellor: (<!>) :: Property i1 -> Property i2 -> RevertableProperty

+ Propellor: Host :: HostName -> [Property HasInfo] -> Info -> Host

+ Propellor: RevertableProperty :: (Property HasInfo) -> (Property HasInfo) -> RevertableProperty

+ Propellor: [hostInfo] :: Host -> Info

+ Propellor: [hostName] :: Host -> HostName

+ Propellor: [hostProperties] :: Host -> [Property HasInfo]

+ Propellor: before :: (IsProp x, Combines y x, IsProp (CombinedType y x)) => x -> y -> CombinedType y x

+ Propellor: data Host

+ Propellor: data Property i

+ Propellor: data RevertableProperty

+ Propellor: defaultMain :: [Host] -> IO ()

+ Propellor: describe :: IsProp p => p -> Desc -> p

+ Propellor: host :: HostName -> Host

+ Propellor: onChange :: (Combines (Property x) (Property y)) => Property x -> Property y -> CombinedType (Property x) (Property y)

+ Propellor: requires :: Combines x y => x -> y -> CombinedType x y

+ Propellor.Engine: fromHost' :: Host -> Propellor a -> Propellor a

+ Propellor.Info: addHostInfo :: IsInfo v => Host -> v -> Host

+ Propellor.Location: localdir :: FilePath

+ Propellor.PrivData: readPrivData :: String -> PrivMap

+ Propellor.PrivData: unsetPrivDataUnused :: [Host] -> IO ()

+ Propellor.PropAccum: addProp :: (PropAccum h, IsProp p) => h -> p -> h

+ Propellor.PropAccum: addPropFront :: (PropAccum h, IsProp p) => h -> p -> h

+ Propellor.PropAccum: propagateContainer :: (PropAccum container) => String -> container -> Property HasInfo -> Property HasInfo

+ Propellor.Property: before :: (IsProp x, Combines y x, IsProp (CombinedType y x)) => x -> y -> CombinedType y x

+ Propellor.Property: data Propellor p

+ Propellor.Property: describe :: IsProp p => p -> Desc -> p

+ Propellor.Property: ensureProperty :: Property NoInfo -> Propellor Result

+ Propellor.Property: requires :: Combines x y => x -> y -> CombinedType x y

+ Propellor.Property.Apache: listenPorts :: [Port] -> Property NoInfo

+ Propellor.Property.Apache: siteDisabled :: HostName -> Property NoInfo

+ Propellor.Property.Apache: virtualHost :: HostName -> Port -> FilePath -> RevertableProperty

+ Propellor.Property.Apt: hasForeignArch :: String -> Property NoInfo

+ Propellor.Property.Chroot: Debootstrapped :: DebootstrapConfig -> Debootstrapped

+ Propellor.Property.Chroot: bootstrapped :: ChrootBootstrapper b => System -> b -> FilePath -> Chroot

+ Propellor.Property.Chroot: buildchroot :: ChrootBootstrapper b => b -> System -> FilePath -> Maybe (Property HasInfo)

+ Propellor.Property.Chroot: chrootSystem :: Chroot -> System

+ Propellor.Property.Chroot: class ChrootBootstrapper b

+ Propellor.Property.Chroot: data Debootstrapped

+ Propellor.Property.Chroot: instance Propellor.Property.Chroot.ChrootBootstrapper Propellor.Property.Chroot.Debootstrapped

+ Propellor.Property.Chroot: propagateChrootInfo :: (IsProp (Property i)) => Chroot -> Property i -> Property HasInfo

+ Propellor.Property.File: LinkTarget :: FilePath -> LinkTarget

+ Propellor.Property.File: isSymlinkedTo :: FilePath -> LinkTarget -> Property NoInfo

+ Propellor.Property.File: newtype LinkTarget

+ Propellor.Property.File: stableTmpFor :: FilePath -> FilePath

+ Propellor.Property.File: viaStableTmp :: (MonadMask m, MonadIO m) => (FilePath -> m ()) -> FilePath -> m ()

+ Propellor.Property.List: instance Propellor.PropAccum.PropAccum Propellor.Property.List.PropList

+ Propellor.Property.List: instance Propellor.Property.List.PropertyList Propellor.Property.List.PropList

+ Propellor.Property.List: props :: PropList

+ Propellor.Property.SiteSpecific.IABak: sshKeys :: [(SshKeyType, PubKeyText)]

+ Propellor.Property.Spin: class Spinnable t

+ Propellor.Property.Spin: controlledBy :: Host -> Property NoInfo

+ Propellor.Property.Spin: controllerFor :: Spinnable h => h -> Property HasInfo

+ Propellor.Property.Spin: controllerKeys :: [(SshKeyType, PubKeyText)] -> Property HasInfo

+ Propellor.Property.Spin: instance GHC.Base.Monoid Propellor.Property.Spin.Controlling

+ Propellor.Property.Spin: instance GHC.Show.Show Propellor.Property.Spin.Controlling

+ Propellor.Property.Spin: instance Propellor.Property.Spin.Spinnable Propellor.Types.Host

+ Propellor.Property.Spin: instance Propellor.Property.Spin.Spinnable [Propellor.Types.Host]

+ Propellor.Property.Spin: instance Propellor.Types.Info.IsInfo Propellor.Property.Spin.Controlling

+ Propellor.Property.Spin: toSpin :: Spinnable t => t -> Property HasInfo

+ Propellor.Property.Ssh: authorizedKeysFrom :: User -> (User, Host) -> Property NoInfo

+ Propellor.Property.Ssh: getHostPubKey :: Propellor (Map SshKeyType PubKeyText)

+ Propellor.Property.Ssh: getUserPubKeys :: User -> Propellor [(SshKeyType, PubKeyText)]

+ Propellor.Property.Ssh: hostPubKey :: SshKeyType -> PubKeyText -> Property HasInfo

+ Propellor.Property.Ssh: installed :: Property NoInfo

+ Propellor.Property.Ssh: instance GHC.Base.Monoid Propellor.Property.Ssh.HostKeyInfo

+ Propellor.Property.Ssh: instance GHC.Base.Monoid Propellor.Property.Ssh.UserKeyInfo

+ Propellor.Property.Ssh: instance GHC.Classes.Eq Propellor.Property.Ssh.HostKeyInfo

+ Propellor.Property.Ssh: instance GHC.Classes.Eq Propellor.Property.Ssh.UserKeyInfo

+ Propellor.Property.Ssh: instance GHC.Classes.Ord Propellor.Property.Ssh.HostKeyInfo

+ Propellor.Property.Ssh: instance GHC.Classes.Ord Propellor.Property.Ssh.UserKeyInfo

+ Propellor.Property.Ssh: instance GHC.Show.Show Propellor.Property.Ssh.HostKeyInfo

+ Propellor.Property.Ssh: instance GHC.Show.Show Propellor.Property.Ssh.UserKeyInfo

+ Propellor.Property.Ssh: instance Propellor.Types.Info.IsInfo Propellor.Property.Ssh.HostKeyInfo

+ Propellor.Property.Ssh: instance Propellor.Types.Info.IsInfo Propellor.Property.Ssh.UserKeyInfo

+ Propellor.Property.Ssh: userKeyAt :: IsContext c => Maybe FilePath -> User -> c -> (SshKeyType, PubKeyText) -> Property HasInfo

+ Propellor.Property.Ssh: userKeys :: IsContext c => User -> c -> [(SshKeyType, PubKeyText)] -> Property HasInfo

+ Propellor.Property.Uwsgi: appAvailable :: AppName -> ConfigFile -> Property NoInfo

+ Propellor.Property.Uwsgi: appCfg :: AppName -> FilePath

+ Propellor.Property.Uwsgi: appEnabled :: AppName -> ConfigFile -> RevertableProperty

+ Propellor.Property.Uwsgi: appVal :: AppName -> FilePath

+ Propellor.Property.Uwsgi: appValRelativeCfg :: AppName -> LinkTarget

+ Propellor.Property.Uwsgi: installed :: Property NoInfo

+ Propellor.Property.Uwsgi: reloaded :: Property NoInfo

+ Propellor.Property.Uwsgi: restarted :: Property NoInfo

+ Propellor.Property.Uwsgi: type AppName = String

+ Propellor.Property.Uwsgi: type ConfigFile = [String]

+ Propellor.Types: (<<>>) :: Combines x y => x -> y -> CombinedType x y

+ Propellor.Types: setDesc :: IsProp p => p -> Desc -> p

+ Propellor.Types.CmdLine: UnsetUnused :: CmdLine

+ Propellor.Types.Info: instance (Data.Typeable.Internal.Typeable v, GHC.Show.Show v) => Propellor.Types.Info.IsInfo (Propellor.Types.Info.InfoVal v)

+ Propellor.Types.Info: instance GHC.Show.Show Propellor.Types.Info.InfoEntry

+ Propellor.Types.Info: instance GHC.Show.Show v => GHC.Show.Show (Propellor.Types.Info.InfoVal v)

+ Propellor.Types.Info: propagatableInfo :: Info -> Info

+ Propellor.Types.Info: propagateInfo :: IsInfo v => v -> Bool

+ Propellor.Types.OS: instance GHC.Classes.Eq Propellor.Types.OS.Group

+ Propellor.Types.OS: instance GHC.Classes.Eq Propellor.Types.OS.User

+ Propellor.Types.OS: instance GHC.Classes.Ord Propellor.Types.OS.Group

+ Propellor.Types.OS: instance GHC.Classes.Ord Propellor.Types.OS.User

+ Propellor.Types.OS: instance GHC.Show.Show Propellor.Types.OS.Group

+ Propellor.Types.OS: instance GHC.Show.Show Propellor.Types.OS.User

+ Propellor.Utilities: (<&&>) :: Monad m => m Bool -> m Bool -> m Bool

+ Propellor.Utilities: (<||>) :: Monad m => m Bool -> m Bool -> m Bool

+ Propellor.Utilities: CreateProcess :: CmdSpec -> Maybe FilePath -> Maybe [(String, String)] -> StdStream -> StdStream -> StdStream -> Bool -> Bool -> Bool -> CreateProcess

+ Propellor.Utilities: DirectoryHandle :: IsOpen -> DirStream -> DirectoryHandle

+ Propellor.Utilities: StderrHandle :: StdHandle

+ Propellor.Utilities: StdinHandle :: StdHandle

+ Propellor.Utilities: StdoutHandle :: StdHandle

+ Propellor.Utilities: [close_fds] :: CreateProcess -> Bool

+ Propellor.Utilities: [cmdspec] :: CreateProcess -> CmdSpec

+ Propellor.Utilities: [create_group] :: CreateProcess -> Bool

+ Propellor.Utilities: [cwd] :: CreateProcess -> Maybe FilePath

+ Propellor.Utilities: [delegate_ctlc] :: CreateProcess -> Bool

+ Propellor.Utilities: [env] :: CreateProcess -> Maybe [(String, String)]

+ Propellor.Utilities: [std_err] :: CreateProcess -> StdStream

+ Propellor.Utilities: [std_in] :: CreateProcess -> StdStream

+ Propellor.Utilities: [std_out] :: CreateProcess -> StdStream

+ Propellor.Utilities: addEntries :: Eq k => [(k, v)] -> [(k, v)] -> [(k, v)]

+ Propellor.Utilities: addEntry :: Eq k => k -> v -> [(k, v)] -> [(k, v)]

+ Propellor.Utilities: after :: Monad m => m b -> m a -> m a

+ Propellor.Utilities: allM :: Monad m => (a -> m Bool) -> [a] -> m Bool

+ Propellor.Utilities: anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool

+ Propellor.Utilities: beginning :: [a] -> [a]

+ Propellor.Utilities: bracketIO :: (MonadMask m, MonadIO m) => IO v -> (v -> IO b) -> (v -> m a) -> m a

+ Propellor.Utilities: catchBoolIO :: MonadCatch m => m Bool -> m Bool

+ Propellor.Utilities: catchDefaultIO :: MonadCatch m => a -> m a -> m a

+ Propellor.Utilities: catchHardwareFault :: MonadCatch m => m a -> (IOException -> m a) -> m a

+ Propellor.Utilities: catchIO :: MonadCatch m => m a -> (IOException -> m a) -> m a

+ Propellor.Utilities: catchMaybeIO :: MonadCatch m => m a -> m (Maybe a)

+ Propellor.Utilities: catchMsgIO :: MonadCatch m => m a -> m (Either String a)

+ Propellor.Utilities: catchNonAsync :: MonadCatch m => m a -> (SomeException -> m a) -> m a

+ Propellor.Utilities: checkSuccessProcess :: ProcessHandle -> IO Bool

+ Propellor.Utilities: closeDirectory :: DirectoryHandle -> IO ()

+ Propellor.Utilities: createBackgroundProcess :: CreateProcessRunner

+ Propellor.Utilities: createProcess :: CreateProcess -> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)

+ Propellor.Utilities: createProcessChecked :: (ProcessHandle -> IO b) -> CreateProcessRunner

+ Propellor.Utilities: createProcessSuccess :: CreateProcessRunner

+ Propellor.Utilities: data CreateProcess :: *

+ Propellor.Utilities: data DirectoryHandle

+ Propellor.Utilities: data StdHandle

+ Propellor.Utilities: delEntry :: Eq k => k -> [(k, v)] -> [(k, v)]

+ Propellor.Utilities: devNull :: FilePath

+ Propellor.Utilities: dirContents :: FilePath -> IO [FilePath]

+ Propellor.Utilities: dirContentsRecursive :: FilePath -> IO [FilePath]

+ Propellor.Utilities: dirContentsRecursiveSkipping :: (FilePath -> Bool) -> Bool -> FilePath -> IO [FilePath]

+ Propellor.Utilities: dirCruft :: FilePath -> Bool

+ Propellor.Utilities: dirTreeRecursiveSkipping :: (FilePath -> Bool) -> FilePath -> IO [FilePath]

+ Propellor.Utilities: end :: [a] -> [a]

+ Propellor.Utilities: exitBool :: Bool -> IO a

+ Propellor.Utilities: feedWithQuietOutput :: CreateProcessRunner -> CreateProcess -> (Handle -> IO a) -> IO a

+ Propellor.Utilities: firstLine :: String -> String

+ Propellor.Utilities: firstM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)

+ Propellor.Utilities: forceSuccessProcess :: CreateProcess -> ProcessHandle -> IO ()

+ Propellor.Utilities: getEnv :: String -> IO (Maybe String)

+ Propellor.Utilities: getEnvDefault :: String -> String -> IO String

+ Propellor.Utilities: getEnvironment :: IO [(String, String)]

+ Propellor.Utilities: getM :: Monad m => (a -> m (Maybe b)) -> [a] -> m (Maybe b)

+ Propellor.Utilities: hGetContentsStrict :: Handle -> IO String

+ Propellor.Utilities: hGetSomeString :: Handle -> Int -> IO String

+ Propellor.Utilities: head :: [a] -> a

+ Propellor.Utilities: headMaybe :: [a] -> Maybe a

+ Propellor.Utilities: ifM :: Monad m => m Bool -> (m a, m a) -> m a

+ Propellor.Utilities: ignoreFailureProcess :: ProcessHandle -> IO Bool

+ Propellor.Utilities: init :: [a] -> [a]

+ Propellor.Utilities: ioHandles :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> (Handle, Handle)

+ Propellor.Utilities: isDirectoryEmpty :: FilePath -> IO Bool

+ Propellor.Utilities: last :: [a] -> a

+ Propellor.Utilities: lastMaybe :: [a] -> Maybe a

+ Propellor.Utilities: massReplace :: [(String, String)] -> String -> String

+ Propellor.Utilities: moveFile :: FilePath -> FilePath -> IO ()

+ Propellor.Utilities: noop :: Monad m => m ()

+ Propellor.Utilities: nukeFile :: FilePath -> IO ()

+ Propellor.Utilities: observe :: Monad m => (a -> m b) -> m a -> m a

+ Propellor.Utilities: openDirectory :: FilePath -> IO DirectoryHandle

+ Propellor.Utilities: processHandle :: (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> ProcessHandle

+ Propellor.Utilities: processTranscript :: String -> [String] -> (Maybe String) -> IO (String, Bool)

+ Propellor.Utilities: processTranscript' :: String -> [String] -> Maybe [(String, String)] -> (Maybe String) -> IO (String, Bool)

+ Propellor.Utilities: prop_segment_regressionTest :: Bool

+ Propellor.Utilities: read :: Read a => String -> a

+ Propellor.Utilities: readDirectory :: DirectoryHandle -> IO (Maybe FilePath)

+ Propellor.Utilities: readFileStrict :: FilePath -> IO String

+ Propellor.Utilities: readFileStrictAnyEncoding :: FilePath -> IO String

+ Propellor.Utilities: readProcess :: FilePath -> [String] -> IO String

+ Propellor.Utilities: readProcess' :: CreateProcess -> IO String

+ Propellor.Utilities: readProcessEnv :: FilePath -> [String] -> Maybe [(String, String)] -> IO String

+ Propellor.Utilities: readish :: Read a => String -> Maybe a

+ Propellor.Utilities: reapZombies :: IO ()

+ Propellor.Utilities: relatedTemplate :: FilePath -> FilePath

+ Propellor.Utilities: segment :: (a -> Bool) -> [a] -> [[a]]

+ Propellor.Utilities: segmentDelim :: (a -> Bool) -> [a] -> [[a]]

+ Propellor.Utilities: separate :: (a -> Bool) -> [a] -> ([a], [a])

+ Propellor.Utilities: setEnv :: String -> String -> Bool -> IO ()

+ Propellor.Utilities: startInteractiveProcess :: FilePath -> [String] -> Maybe [(String, String)] -> IO (ProcessHandle, Handle, Handle)

+ Propellor.Utilities: stderrHandle :: HandleExtractor

+ Propellor.Utilities: stdinHandle :: HandleExtractor

+ Propellor.Utilities: stdoutHandle :: HandleExtractor

+ Propellor.Utilities: tail :: [a] -> [a]

+ Propellor.Utilities: tryIO :: MonadCatch m => m a -> m (Either IOException a)

+ Propellor.Utilities: tryNonAsync :: MonadCatch m => m a -> m (Either SomeException a)

+ Propellor.Utilities: tryWhenExists :: MonadCatch m => m a -> m (Maybe a)

+ Propellor.Utilities: type IsOpen = MVar ()

+ Propellor.Utilities: type Template = String

+ Propellor.Utilities: unsetEnv :: String -> IO ()

+ Propellor.Utilities: untilTrue :: Monad m => [a] -> (a -> m Bool) -> m Bool

+ Propellor.Utilities: viaTmp :: (MonadMask m, MonadIO m) => (FilePath -> String -> m ()) -> FilePath -> String -> m ()

+ Propellor.Utilities: waitForProcess :: ProcessHandle -> IO ExitCode

+ Propellor.Utilities: withHandle :: StdHandle -> CreateProcessRunner -> CreateProcess -> (Handle -> IO a) -> IO a

+ Propellor.Utilities: withIOHandles :: CreateProcessRunner -> CreateProcess -> ((Handle, Handle) -> IO a) -> IO a

+ Propellor.Utilities: withOEHandles :: CreateProcessRunner -> CreateProcess -> ((Handle, Handle) -> IO a) -> IO a

+ Propellor.Utilities: withQuietOutput :: CreateProcessRunner -> CreateProcess -> IO ()

+ Propellor.Utilities: withTmpDir :: (MonadMask m, MonadIO m) => Template -> (FilePath -> m a) -> m a

+ Propellor.Utilities: withTmpDirIn :: (MonadMask m, MonadIO m) => FilePath -> Template -> (FilePath -> m a) -> m a

+ Propellor.Utilities: withTmpFile :: (MonadIO m, MonadMask m) => Template -> (FilePath -> Handle -> m a) -> m a

+ Propellor.Utilities: withTmpFileIn :: (MonadIO m, MonadMask m) => FilePath -> Template -> (FilePath -> Handle -> m a) -> m a

+ Propellor.Utilities: writeFileAnyEncoding :: FilePath -> String -> IO ()

+ Propellor.Utilities: writeReadProcessEnv :: FilePath -> [String] -> Maybe [(String, String)] -> (Maybe (Handle -> IO ())) -> (Maybe (Handle -> IO ())) -> IO String

- Propellor.Property.Chroot: Chroot :: FilePath -> System -> BuilderConf -> Host -> Chroot

+ Propellor.Property.Chroot: Chroot :: FilePath -> System -> b -> Host -> Chroot

- Propellor.Property.Debootstrap: built :: FilePath -> System -> DebootstrapConfig -> RevertableProperty

+ Propellor.Property.Debootstrap: built :: FilePath -> System -> DebootstrapConfig -> Property HasInfo

- Propellor.Property.Nginx: siteValRelativeCfg :: HostName -> FilePath

+ Propellor.Property.Nginx: siteValRelativeCfg :: HostName -> LinkTarget

- Propellor.Property.OpenId: providerFor :: [User] -> String -> Property HasInfo

+ Propellor.Property.OpenId: providerFor :: [User] -> HostName -> Maybe Port -> Property HasInfo

- Propellor.Types.Info: class (Typeable v, Monoid v) => IsInfo v

+ Propellor.Types.Info: class (Typeable v, Monoid v, Show v) => IsInfo v

Files

CHANGELOG +39/−1
config-joey.hs +37/−58
config-simple.hs +17/−18
config.hs +17/−18
debian/changelog +39/−1
propellor.cabal +9/−4
src/Propellor.hs +32/−40
src/Propellor/Base.hs +57/−0
src/Propellor/Bootstrap.hs +1/−1
src/Propellor/CmdLine.hs +10/−5
src/Propellor/Engine.hs +11/−14
src/Propellor/Git.hs +1/−1
src/Propellor/Info.hs +3/−0
src/Propellor/Location.hs +5/−0
src/Propellor/PrivData.hs +38/−10
src/Propellor/PropAccum.hs +26/−34
src/Propellor/Property.hs +58/−4
src/Propellor/Property/Aiccu.hs +1/−1
src/Propellor/Property/Apache.hs +41/−14
src/Propellor/Property/Apt.hs +9/−1
src/Propellor/Property/Chroot.hs +58/−31
src/Propellor/Property/Chroot/Util.hs +9/−2
src/Propellor/Property/ConfFile.hs +1/−1
src/Propellor/Property/Cron.hs +1/−1
src/Propellor/Property/DebianMirror.hs +1/−1
src/Propellor/Property/Debootstrap.hs +3/−17
src/Propellor/Property/DiskImage.hs +1/−1
src/Propellor/Property/Dns.hs +2/−2
src/Propellor/Property/DnsSec.hs +2/−2
src/Propellor/Property/Docker.hs +7/−7
src/Propellor/Property/File.hs +54/−4
src/Propellor/Property/Firewall.hs +1/−1
src/Propellor/Property/Git.hs +1/−1
src/Propellor/Property/Gpg.hs +1/−1
src/Propellor/Property/Group.hs +1/−1
src/Propellor/Property/Grub.hs +1/−1
src/Propellor/Property/HostingProvider/CloudAtCost.hs +1/−1
src/Propellor/Property/HostingProvider/DigitalOcean.hs +1/−1
src/Propellor/Property/HostingProvider/Linode.hs +1/−1
src/Propellor/Property/Hostname.hs +1/−1
src/Propellor/Property/Journald.hs +2/−1
src/Propellor/Property/Kerberos.hs +1/−1
src/Propellor/Property/LightDM.hs +1/−1
src/Propellor/Property/List.hs +19/−7
src/Propellor/Property/Logcheck.hs +1/−1
src/Propellor/Property/Mount.hs +1/−1
src/Propellor/Property/Network.hs +1/−1
src/Propellor/Property/Nginx.hs +4/−11
src/Propellor/Property/OS.hs +1/−1
src/Propellor/Property/Obnam.hs +1/−1
src/Propellor/Property/OpenId.hs +29/−9
src/Propellor/Property/Parted.hs +1/−1
src/Propellor/Property/Partition.hs +1/−1
src/Propellor/Property/Postfix.hs +1/−1
src/Propellor/Property/Prosody.hs +4/−7
src/Propellor/Property/Reboot.hs +1/−1
src/Propellor/Property/Rsync.hs +1/−1
src/Propellor/Property/Scheduled.hs +1/−1
src/Propellor/Property/Service.hs +1/−1
src/Propellor/Property/SiteSpecific/Branchable.hs +4/−2
src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs +1/−1
src/Propellor/Property/SiteSpecific/GitHome.hs +1/−1
src/Propellor/Property/SiteSpecific/IABak.hs +8/−3
src/Propellor/Property/SiteSpecific/JoeySites.hs +15/−4
src/Propellor/Property/Spin.hs +160/−0
src/Propellor/Property/Ssh.hs +142/−90
src/Propellor/Property/Sudo.hs +1/−1
src/Propellor/Property/Systemd.hs +12/−10
src/Propellor/Property/Systemd/Core.hs +1/−1
src/Propellor/Property/Tor.hs +1/−1
src/Propellor/Property/Unbound.hs +1/−1
src/Propellor/Property/User.hs +1/−1
src/Propellor/Property/Uwsgi.hs +49/−0
src/Propellor/Protocol.hs +1/−1
src/Propellor/Shim.hs +1/−1
src/Propellor/Spin.hs +48/−30
src/Propellor/Ssh.hs +1/−1
src/Propellor/Types.hs +35/−34
src/Propellor/Types/Chroot.hs +1/−1
src/Propellor/Types/CmdLine.hs +2/−1
src/Propellor/Types/Dns.hs +4/−4
src/Propellor/Types/Docker.hs +1/−1
src/Propellor/Types/Info.hs +29/−23
src/Propellor/Types/OS.hs +4/−0
src/Propellor/Types/PrivData.hs +1/−1
src/Propellor/Utilities.hs +27/−0
src/config.hs +17/−18

CHANGELOG view

@@ -1,3 +1,41 @@+propellor (2.9.0) unstable; urgency=medium++  * Added basic Uwsgi module, maintained by Félix Sipma.+  * Add Apt.hasForeignArch. Thanks, Per Olofsson.+  * Improved documentation, particularly of the Propellor module.+  * The Propellor module no longer exports many of the things it used to,+    being now focused on only what's needed to write config.hs.+    Use Propellor.Base to get all the things exported by Propellor before.+    (API change)+  * Some renaming of instance methods, and moving of functions to more+    appropriate modules. (API change)+  * Added File.isSymlinkedTo. Thanks, Per Olofsson.+  * fileProperty, and properties derived from it now write the new+    file content via origfile.propellor-new~, instead of to a randomly named+    temp file. This allows them to clean up any temp file that may have+    been left by an interrupted run of propellor.+  * Added Propellor.Property.Spin, which can be used to make a host be a+    controller of other hosts, which will automatically spin them each time+    propellor is run.+  * Ssh.keyImported is replaced with Ssh.userKeys. (API change)+    The new property only gets the private key from the privdata; the+    public key is provided as a parameter, and so is available as+    Info that other properties can use.+  * Ssh.keyImported' is renamed to Ssh.userKeyAt, and also changed+    to only import the private key from the privdata. (API change)+  * While Ssh.keyImported and Ssh.keyImported' avoided updating existing+    keys, the new Ssh.userKeys and Ssh.userKeyAt properties will+    always update out of date key files.+  * Ssh.pubKey renamed to Ssh.hostPubKey. (API change)+  * Added --unset-unused +  * Fix typo: propigate → propagate. Thanks, Felix Gruber.+    (A minor API change)+  * Chroot: Converted to use a ChrootBootstrapper type class, so+    other ways to bootstrap chroots can easily be added in separate+    modules. (API change)++ -- Joey Hess <id@joeyh.name>  Tue, 20 Oct 2015 15:43:12 -0400+ propellor (2.8.1) unstable; urgency=medium    * Guard against power loss etc when building propellor, by updating@@ -272,7 +310,7 @@ propellor (1.2.2) unstable; urgency=medium    * Revert ensureProperty warning message, too many false positives in places-    where Info is correctly propigated. Better approach needed.+    where Info is correctly propagated. Better approach needed.   -- Joey Hess <id@joeyh.name>  Sun, 21 Dec 2014 21:41:11 -0400

config-joey.hs view

@@ -3,7 +3,6 @@ module Main where  import Propellor-import Propellor.CmdLine import Propellor.Property.Scheduled import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt@@ -17,9 +16,9 @@ import qualified Propellor.Property.Tor as Tor import qualified Propellor.Property.Dns as Dns import qualified Propellor.Property.OpenId as OpenId-import qualified Propellor.Property.Docker as Docker import qualified Propellor.Property.Git as Git import qualified Propellor.Property.Postfix as Postfix+import qualified Propellor.Property.Apache as Apache import qualified Propellor.Property.Grub as Grub import qualified Propellor.Property.Obnam as Obnam import qualified Propellor.Property.Gpg as Gpg@@ -104,7 +103,11 @@ 	& ipv4 "167.88.41.194"  	& CloudAtCost.decruft-	& Ssh.randomHostKeys+	& Ssh.hostKeys hostContext+		[ (SshDsa, "ssh-dss AAAAB3NzaC1kc3MAAACBAI3WUq0RaigLlcUivgNG4sXpso2ORZkMvfqKz6zkc60L6dpxvWDNmZVEH8hEjxRSYG07NehcuOgQqeyFnS++xw1hdeGjf37JqCUH49i02lra3Zxv8oPpRxyeqe5MmuzUJhlWvBdlc3O/nqZ4bTUfnxMzSYWyy6++s/BpSHttZplNAAAAFQC1DE0vzgVeNAv9smHLObQWZFe2VQAAAIBECtpJry3GC8NVTFsTHDGWksluoFPIbKiZUFFztZGdM0AO2VwAbiJ6Au6M3VddGFANgTlni6d2/9yS919zO90TaFoIjywZeXhxE2CSuRfU7sx2hqDBk73jlycem/ER0sanFhzpHVpwmLfWneTXImWyq37vhAxatJANOtbj81vQ3AAAAIBV3lcyTT9xWg1Q4vERJbvyF8mCliwZmnIPa7ohveKkxlcgUk5d6dnaqFfjVaiXBPN3Qd08WXoQ/a9k3chBPT9nW2vWgzzM8l36j2MbHLmaxGwevAc9+vx4MXqvnGHzd2ex950mC33ct3j0fzMZlO6vqEsgD4CYmiASxhfefj+JCQ==")+		, (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQDJybAjUPUWIhvVMmer8K5ZgdfI54DM6vc8Mzw+5KmVKL0TwkvzbR1HAB4heyMGtN1F8YzkWhsI3/Txh+MQUJ+i4u8SvSYc6D1q3j3ZyCi06wZ3DJS25tZrOM/thOOA1DFA4Hhb0uI/1Kg8PguNNNSMXn8F7q3F6cFQizYgszs6z6ktiST/BTC+IXWovhcnn2vQXXU8FTcTsqBFqA5dEjZbp1WDzqp3km84ZyXGmoVlpqzXeMvlkWTIshYiQjXIwPOkALzlGYjp1lw1OaxPVI1IGFcgCbIWQQWoCReb+genX2VaR+odAYXjaOdRx0lQj7UCPTBCpqMyzBMLtT5Yiaqh")+		, (SshEcdsa, "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBPhfvcOuw0Yt+MnsFc4TI2gWkKi62Eajxz+TgbHMO/uRTYF8c5V8fOI3o+J/3m5+lT0S5o8j8a7xIC3COvi+AVw=")+		] 	& Apt.unattendedUpgrades 	& Network.ipv6to4 @@ -221,8 +224,10 @@ 		, "--exclude=.*/tmp/" 		, "--one-file-system" 		] Obnam.OnlyClient (Gpg.GpgKeyId "98147487")-		`requires` Ssh.keyImported SshRsa (User "root")+		`requires` Ssh.userKeys (User "root") 			(Context "kite.kitenet.net")+			[ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC5Gza2sNqSKfNtUN4dN/Z3rlqw18nijmXFx6df2GtBoZbkIak73uQfDuZLP+AXlyfHocwdkdHEf/zrxgXS4EokQMGLZhJ37Pr3edrEn/NEnqroiffw7kyd7EqaziA6UOezcLTjWGv+Zqg9JhitYs4WWTpNzrPH3yQf1V9FunZnkzb4gJGndts13wGmPEwSuf+QHbgQvjMOMCJwWSNcJGdhDR66hFlxfG26xx50uIczXYAbgLfHp5W6WuR/lcaS9J6i7HAPwcsPDA04XDinrcpl29QwsMW1HyGS/4FSCgrDqNZ2jzP49Bka78iCLRqfl1efyYas/Zo1jQ0x+pxq2RMr root@kite")+			] 		`requires` Ssh.knownHost hosts "eubackup.kitenet.net" (User "root") 	& Apt.serviceInstalledRunning "ntp" 	& "/etc/timezone" `File.hasContent` ["US/Eastern"]@@ -299,7 +304,9 @@ 	& Apt.unattendedUpgrades 	& Systemd.installed 	& Systemd.persistentJournal-	& Ssh.keyImported SshRsa (User "joey") hostContext+	& Ssh.userKeys (User "joey") hostContext+		[ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC4wJuQEGno+nJvtE75IKL6JQ08sJHZ9Bzs9Dvu0zuxSEZE30MWK98/twNwCH9PVf2N9m4apfN7f9GHgHTUongfo8xnLAk4PuBSTV74YgKyOCvNYqANuKKa+76PsS/vFf/or3ct++uTEWsRyYD29cQndufwKA4rthAqHG+fifbLDC53AjcldI0zI1RckpPzT+AMazlnSBFMlpKvGD2uzSXALVRXa3vSqWkWd0z7qmIkpmpq0AAgbDLwrGBcUGV/h0rOa2s8zSeirA0tLmHNROl4cZsX0T/6VBGfBRkrHSxL67xJziATw4WPq6spYlxg84pC/5qJVr9SC5HosppbDqgj joey@elephant")+		]  	& Apt.serviceInstalledRunning "swapspace"  	& alias "eubackup.kitenet.net"@@ -322,14 +329,10 @@ 	& alias "ns3.kitenet.net" 	& myDnsSecondary 	-	& Docker.configured-	& Docker.docked openidProvider-		`requires` Apt.serviceInstalledRunning "ntp"-	& Docker.docked ancientKitenet-	& Docker.docked jerryPlay-	& Docker.garbageCollected `period` (Weekly (Just 1))-	 	& Systemd.nspawned oldusenetShellBox+	& Systemd.nspawned ancientKitenet+	& Systemd.nspawned openidProvider+	 	`requires` Apt.serviceInstalledRunning "ntp" 	 	& JoeySites.scrollBox 	& alias "scroll.joeyh.name"@@ -349,7 +352,7 @@ 	& ipv6 "2001:4830:1600:195::2" 	& Apt.serviceInstalledRunning "aiccu" 	& Apt.installed ["ssh"]-	& Ssh.pubKey SshDsa "ssh-dss AAAAB3NzaC1kc3MAAACBAIrLX260fY0Jjj/p0syNhX8OyR8hcr6feDPGOj87bMad0k/w/taDSOzpXe0Wet7rvUTbxUjH+Q5wPd4R9zkaSDiR/tCb45OdG6JsaIkmqncwe8yrU+pqSRCxttwbcFe+UU+4AAcinjVedZjVRDj2rRaFPc9BXkPt7ffk8GwEJ31/AAAAFQCG/gOjObsr86vvldUZHCteaJttNQAAAIB5nomvcqOk/TD07DLaWKyG7gAcW5WnfY3WtnvLRAFk09aq1EuiJ6Yba99Zkb+bsxXv89FWjWDg/Z3Psa22JMyi0HEDVsOevy/1sEQ96AGH5ijLzFInfXAM7gaJKXASD7hPbVdjySbgRCdwu0dzmQWHtH+8i1CMVmA2/a5Y/wtlJAAAAIAUZj2US2D378jBwyX1Py7e4sJfea3WSGYZjn4DLlsLGsB88POuh32aOChd1yzF6r6C2sdoPBHQcWBgNGXcx4gF0B5UmyVHg3lIX2NVSG1ZmfuLNJs9iKNu4cHXUmqBbwFYQJBvB69EEtrOw4jSbiTKwHFmqdA/mw1VsMB+khUaVw=="+	& Ssh.hostPubKey SshDsa "ssh-dss AAAAB3NzaC1kc3MAAACBAIrLX260fY0Jjj/p0syNhX8OyR8hcr6feDPGOj87bMad0k/w/taDSOzpXe0Wet7rvUTbxUjH+Q5wPd4R9zkaSDiR/tCb45OdG6JsaIkmqncwe8yrU+pqSRCxttwbcFe+UU+4AAcinjVedZjVRDj2rRaFPc9BXkPt7ffk8GwEJ31/AAAAFQCG/gOjObsr86vvldUZHCteaJttNQAAAIB5nomvcqOk/TD07DLaWKyG7gAcW5WnfY3WtnvLRAFk09aq1EuiJ6Yba99Zkb+bsxXv89FWjWDg/Z3Psa22JMyi0HEDVsOevy/1sEQ96AGH5ijLzFInfXAM7gaJKXASD7hPbVdjySbgRCdwu0dzmQWHtH+8i1CMVmA2/a5Y/wtlJAAAAIAUZj2US2D378jBwyX1Py7e4sJfea3WSGYZjn4DLlsLGsB88POuh32aOChd1yzF6r6C2sdoPBHQcWBgNGXcx4gF0B5UmyVHg3lIX2NVSG1ZmfuLNJs9iKNu4cHXUmqBbwFYQJBvB69EEtrOw4jSbiTKwHFmqdA/mw1VsMB+khUaVw==" 	& alias "usbackup.kitenet.net" 	& JoeySites.backupsBackedupFrom hosts "eubackup.kitenet.net" "/home/joey/lib/backup" 	& Apt.serviceInstalledRunning "anacron"@@ -424,40 +427,36 @@ webserver :: Systemd.Container webserver = standardStableContainer "webserver" 	& Systemd.bind "/var/www"-	& Apt.serviceInstalledRunning "apache2"+	& Apache.installed  -- My own openid provider. Uses php, so containerized for security -- and administrative sanity.-openidProvider :: Docker.Container-openidProvider = standardStableDockerContainer "openid-provider"-	& alias "openid.kitenet.net"-	& Docker.publish "8081:80"-	& OpenId.providerFor [User "joey", User "liw"]-		"openid.kitenet.net:8081"+openidProvider :: Systemd.Container+openidProvider = standardStableContainer "openid-provider"+	& alias hn+	& OpenId.providerFor [User "joey", User "liw"] hn (Just (Port 8081))+  where+	hn = "openid.kitenet.net" --- Exhibit: kite's 90's website.-ancientKitenet :: Docker.Container-ancientKitenet = standardStableDockerContainer "ancient-kitenet"-	& alias "ancient.kitenet.net"-	& Docker.publish "1994:80"-	& Apt.serviceInstalledRunning "apache2"+-- Exhibit: kite's 90's website on port 1994.+ancientKitenet :: Systemd.Container+ancientKitenet = standardStableContainer "ancient-kitenet"+	& alias hn 	& Git.cloned (User "root") "git://kitenet-net.branchable.com/" "/var/www/html" 		(Just "remotes/origin/old-kitenet.net")+	& Apache.installed+	& Apache.listenPorts [p]+	& Apache.virtualHost hn p "/var/www/html"+	& Apache.siteDisabled "000-default"+  where+	p = Port 1994+	hn = "ancient.kitenet.net"  oldusenetShellBox :: Systemd.Container oldusenetShellBox = standardStableContainer "oldusenet-shellbox" 	& alias "shell.olduse.net" 	& JoeySites.oldUseNetShellBox -jerryPlay :: Docker.Container-jerryPlay = standardDockerContainer "jerryplay" Unstable "amd64"-	& alias "jerryplay.kitenet.net"-	& Docker.publish "2202:22"-	& Docker.publish "8001:80"-	& Apt.installed ["ssh"]-	& User.hasPassword (User "root")-	& Ssh.permitRootLogin (Ssh.RootLogin True)- kiteShellBox :: Systemd.Container kiteShellBox = standardStableContainer "kiteshellbox" 	& JoeySites.kiteShellBox@@ -505,26 +504,6 @@ standardStableContainer :: Systemd.MachineName -> Systemd.Container standardStableContainer name = standardContainer name (Stable "jessie") "amd64" -standardStableDockerContainer :: Docker.ContainerName -> Docker.Container-standardStableDockerContainer name = standardDockerContainer name (Stable "jessie") "amd64"--standardDockerContainer :: Docker.ContainerName -> DebianSuite -> Architecture -> Docker.Container-standardDockerContainer name suite arch = Docker.container name (dockerImage system)-	& os system-	& Apt.stdSourcesList `onChange` Apt.upgrade-	& Apt.unattendedUpgrades-	& Apt.cacheCleaned-	& Docker.tweaked-  where-	system = System (Debian suite) arch---- Docker images I prefer to use.-dockerImage :: System -> Docker.Image-dockerImage (System (Debian Unstable) arch) = Docker.latestImage ("joeyh/debian-unstable-" ++ arch)-dockerImage (System (Debian Testing) arch) = Docker.latestImage ("joeyh/debian-unstable-" ++ arch)-dockerImage (System (Debian (Stable _)) arch) = Docker.latestImage ("joeyh/debian-stable-" ++ arch)-dockerImage _ = Docker.latestImage "debian-stable-official" -- does not currently exist!- myDnsSecondary :: Property HasInfo myDnsSecondary = propertyList "dns secondary for all my domains" $ props 	& Dns.secondary hosts "kitenet.net"@@ -553,11 +532,11 @@ monsters :: [Host]    -- Systems I don't manage with propellor, monsters =            -- but do want to track their public keys etc. 	[ host "usw-s002.rsync.net"-		& Ssh.pubKey SshDsa "ssh-dss AAAAB3NzaC1kc3MAAAEBAI6ZsoW8a+Zl6NqUf9a4xXSMcV1akJHDEKKBzlI2YZo9gb9YoCf5p9oby8THUSgfh4kse7LJeY7Nb64NR6Y/X7I2/QzbE1HGGl5mMwB6LeUcJ74T3TQAlNEZkGt/MOIVLolJHk049hC09zLpkUDtX8K0t1yaCirC9SxDGLTCLEhvU9+vVdVrdQlKZ9wpLUNbdAzvbra+O/IVvExxDZ9WCHrnfNA8ddVZIGEWMqsoNgiuCxiXpi8qL+noghsSQNFTXwo7W2Vp9zj1JkCt3GtSz5IzEpARQaXEAWNEM0n1nJ686YUOhou64iRM8bPC1lp3QXvvZNgj3m+QHhIempx+de8AAAAVAKB5vUDaZOg14gRn7Bp81ja/ik+RAAABACPH/bPbW912x1NxNiikzGR6clLh+bLpIp8Qie3J7DwOr8oC1QOKjNDK+UgQ7mDQEgr4nGjNKSvpDi4c1QCw4sbLqQgx1y2VhT0SmUPHf5NQFldRQyR/jcevSSwOBxszz3aq9AwHiv9OWaO3XY18suXPouiuPTpIcZwc2BLDNHFnDURQeGEtmgqj6gZLIkTY0iw7q9Tj5FOyl4AkvEJC5B4CSzaWgey93Wqn1Imt7KI8+H9lApMKziVL1q+K7xAuNkGmx5YOSNlE6rKAPtsIPHZGxR7dch0GURv2jhh0NQYvBRn3ukCjuIO5gx56HLgilq59/o50zZ4NcT7iASF76TcAAAEAC6YxX7rrs8pp13W4YGiJHwFvIO1yXLGOdqu66JM0plO4J1ItV1AQcazOXLiliny3p2/W+wXZZKd5HIRt52YafCA8YNyMk/sF7JcTR4d4z9CfKaAxh0UpzKiAk+0j/Wu3iPoTOsyt7N0j1+dIyrFodY2sKKuBMT4TQ0yqQpbC+IDQv2i1IlZAPneYGfd5MIGygs2QMfaMQ1jWAKJvEO0vstZ7GB6nDAcg4in3ZiBHtomx3PL5w+zg48S4Ed69BiFXLZ1f6MnjpUOP75pD4MP6toS0rgK9b93xCrEQLgm4oD/7TCHHBo2xR7wwcsN2OddtwWsEM2QgOkt/jdCAoVCqwQ=="+		& Ssh.hostPubKey SshDsa "ssh-dss AAAAB3NzaC1kc3MAAAEBAI6ZsoW8a+Zl6NqUf9a4xXSMcV1akJHDEKKBzlI2YZo9gb9YoCf5p9oby8THUSgfh4kse7LJeY7Nb64NR6Y/X7I2/QzbE1HGGl5mMwB6LeUcJ74T3TQAlNEZkGt/MOIVLolJHk049hC09zLpkUDtX8K0t1yaCirC9SxDGLTCLEhvU9+vVdVrdQlKZ9wpLUNbdAzvbra+O/IVvExxDZ9WCHrnfNA8ddVZIGEWMqsoNgiuCxiXpi8qL+noghsSQNFTXwo7W2Vp9zj1JkCt3GtSz5IzEpARQaXEAWNEM0n1nJ686YUOhou64iRM8bPC1lp3QXvvZNgj3m+QHhIempx+de8AAAAVAKB5vUDaZOg14gRn7Bp81ja/ik+RAAABACPH/bPbW912x1NxNiikzGR6clLh+bLpIp8Qie3J7DwOr8oC1QOKjNDK+UgQ7mDQEgr4nGjNKSvpDi4c1QCw4sbLqQgx1y2VhT0SmUPHf5NQFldRQyR/jcevSSwOBxszz3aq9AwHiv9OWaO3XY18suXPouiuPTpIcZwc2BLDNHFnDURQeGEtmgqj6gZLIkTY0iw7q9Tj5FOyl4AkvEJC5B4CSzaWgey93Wqn1Imt7KI8+H9lApMKziVL1q+K7xAuNkGmx5YOSNlE6rKAPtsIPHZGxR7dch0GURv2jhh0NQYvBRn3ukCjuIO5gx56HLgilq59/o50zZ4NcT7iASF76TcAAAEAC6YxX7rrs8pp13W4YGiJHwFvIO1yXLGOdqu66JM0plO4J1ItV1AQcazOXLiliny3p2/W+wXZZKd5HIRt52YafCA8YNyMk/sF7JcTR4d4z9CfKaAxh0UpzKiAk+0j/Wu3iPoTOsyt7N0j1+dIyrFodY2sKKuBMT4TQ0yqQpbC+IDQv2i1IlZAPneYGfd5MIGygs2QMfaMQ1jWAKJvEO0vstZ7GB6nDAcg4in3ZiBHtomx3PL5w+zg48S4Ed69BiFXLZ1f6MnjpUOP75pD4MP6toS0rgK9b93xCrEQLgm4oD/7TCHHBo2xR7wwcsN2OddtwWsEM2QgOkt/jdCAoVCqwQ==" 	, host "github.com" -		& Ssh.pubKey SshRsa "ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAQEAq2A7hRGmdnm9tUDbO9IDSwBK6TbQa+PXYPCPy6rbTrTtw7PHkccKrpp0yVhp5HdEIcKr6pLlVDBfOLX9QUsyCOV0wzfjIJNlGEYsdlLJizHhbn2mUjvSAHQqZETYP81eFzLQNnPHt4EVVUh7VfDESU84KezmD5QlWpXLmvU31/yMf+Se8xhHTvKSCZIFImWwoG6mbUoWf9nzpIoaSjB+weqqUUmpaaasXVal72J+UX2B+2RPW3RcT0eOzQgqlJL3RKrTJvdsjE3JEAvGq3lGHSZXy28G3skua2SmVi/w4yCE6gbODqnTWlg7+wC604ydGXA8VJiS5ap43JXiUFFAaQ=="+		& Ssh.hostPubKey SshRsa "ssh-rsa AAAAB3NzaC1yc2EAAAABIwAAAQEAq2A7hRGmdnm9tUDbO9IDSwBK6TbQa+PXYPCPy6rbTrTtw7PHkccKrpp0yVhp5HdEIcKr6pLlVDBfOLX9QUsyCOV0wzfjIJNlGEYsdlLJizHhbn2mUjvSAHQqZETYP81eFzLQNnPHt4EVVUh7VfDESU84KezmD5QlWpXLmvU31/yMf+Se8xhHTvKSCZIFImWwoG6mbUoWf9nzpIoaSjB+weqqUUmpaaasXVal72J+UX2B+2RPW3RcT0eOzQgqlJL3RKrTJvdsjE3JEAvGq3lGHSZXy28G3skua2SmVi/w4yCE6gbODqnTWlg7+wC604ydGXA8VJiS5ap43JXiUFFAaQ==" 	, host "gitlab.com"-		& Ssh.pubKey SshEcdsa "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBFSMqzJeV9rUzU4kWitGjeR4PWSa29SPqJ1fVkhtj3Hw9xjLVXVYrU9QlYWrOLXBpQ6KWjbjTDTdDkoohFzgbEY="+		& Ssh.hostPubKey SshEcdsa "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBFSMqzJeV9rUzU4kWitGjeR4PWSa29SPqJ1fVkhtj3Hw9xjLVXVYrU9QlYWrOLXBpQ6KWjbjTDTdDkoohFzgbEY=" 	, host "ns6.gandi.net" 		& ipv4 "217.70.177.40" 	, host "turtle.kitenet.net"

config-simple.hs view

@@ -2,13 +2,12 @@ -- the propellor program.  import Propellor-import Propellor.CmdLine-import Propellor.Property.Scheduled import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Network as Network --import qualified Propellor.Property.Ssh as Ssh import qualified Propellor.Property.Cron as Cron+import Propellor.Property.Scheduled --import qualified Propellor.Property.Sudo as Sudo import qualified Propellor.Property.User as User --import qualified Propellor.Property.Hostname as Hostname@@ -19,25 +18,25 @@ main = defaultMain hosts  -- The hosts propellor knows about.--- Edit this to configure propellor! hosts :: [Host] hosts =-	[ host "mybox.example.com"-		& os (System (Debian Unstable) "amd64")-		& Apt.stdSourcesList-		& Apt.unattendedUpgrades-		& Apt.installed ["etckeeper"]-		& Apt.installed ["ssh"]-		& User.hasSomePassword (User "root")-		& Network.ipv6to4-		& File.dirExists "/var/www"-		& Docker.docked webserverContainer-		& Docker.garbageCollected `period` Daily-		& Cron.runPropellor (Cron.Times "30 * * * *")--	-- add more hosts here...-	--, host "foo.example.com" = ...+	[ mybox 	]++-- An example host.+mybox :: Host+mybox = host "mybox.example.com"+	& os (System (Debian Unstable) "amd64")+	& Apt.stdSourcesList+	& Apt.unattendedUpgrades+	& Apt.installed ["etckeeper"]+	& Apt.installed ["ssh"]+	& User.hasSomePassword (User "root")+	& Network.ipv6to4+	& File.dirExists "/var/www"+	& Docker.docked webserverContainer+	& Docker.garbageCollected `period` Daily+	& Cron.runPropellor (Cron.Times "30 * * * *")  -- A generic webserver in a Docker container. webserverContainer :: Docker.Container

config.hs view

@@ -2,13 +2,12 @@ -- the propellor program.  import Propellor-import Propellor.CmdLine-import Propellor.Property.Scheduled import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Network as Network --import qualified Propellor.Property.Ssh as Ssh import qualified Propellor.Property.Cron as Cron+import Propellor.Property.Scheduled --import qualified Propellor.Property.Sudo as Sudo import qualified Propellor.Property.User as User --import qualified Propellor.Property.Hostname as Hostname@@ -19,25 +18,25 @@ main = defaultMain hosts  -- The hosts propellor knows about.--- Edit this to configure propellor! hosts :: [Host] hosts =-	[ host "mybox.example.com"-		& os (System (Debian Unstable) "amd64")-		& Apt.stdSourcesList-		& Apt.unattendedUpgrades-		& Apt.installed ["etckeeper"]-		& Apt.installed ["ssh"]-		& User.hasSomePassword (User "root")-		& Network.ipv6to4-		& File.dirExists "/var/www"-		& Docker.docked webserverContainer-		& Docker.garbageCollected `period` Daily-		& Cron.runPropellor (Cron.Times "30 * * * *")--	-- add more hosts here...-	--, host "foo.example.com" = ...+	[ mybox 	]++-- An example host.+mybox :: Host+mybox = host "mybox.example.com"+	& os (System (Debian Unstable) "amd64")+	& Apt.stdSourcesList+	& Apt.unattendedUpgrades+	& Apt.installed ["etckeeper"]+	& Apt.installed ["ssh"]+	& User.hasSomePassword (User "root")+	& Network.ipv6to4+	& File.dirExists "/var/www"+	& Docker.docked webserverContainer+	& Docker.garbageCollected `period` Daily+	& Cron.runPropellor (Cron.Times "30 * * * *")  -- A generic webserver in a Docker container. webserverContainer :: Docker.Container

debian/changelog view

@@ -1,3 +1,41 @@+propellor (2.9.0) unstable; urgency=medium++  * Added basic Uwsgi module, maintained by Félix Sipma.+  * Add Apt.hasForeignArch. Thanks, Per Olofsson.+  * Improved documentation, particularly of the Propellor module.+  * The Propellor module no longer exports many of the things it used to,+    being now focused on only what's needed to write config.hs.+    Use Propellor.Base to get all the things exported by Propellor before.+    (API change)+  * Some renaming of instance methods, and moving of functions to more+    appropriate modules. (API change)+  * Added File.isSymlinkedTo. Thanks, Per Olofsson.+  * fileProperty, and properties derived from it now write the new+    file content via origfile.propellor-new~, instead of to a randomly named+    temp file. This allows them to clean up any temp file that may have+    been left by an interrupted run of propellor.+  * Added Propellor.Property.Spin, which can be used to make a host be a+    controller of other hosts, which will automatically spin them each time+    propellor is run.+  * Ssh.keyImported is replaced with Ssh.userKeys. (API change)+    The new property only gets the private key from the privdata; the+    public key is provided as a parameter, and so is available as+    Info that other properties can use.+  * Ssh.keyImported' is renamed to Ssh.userKeyAt, and also changed+    to only import the private key from the privdata. (API change)+  * While Ssh.keyImported and Ssh.keyImported' avoided updating existing+    keys, the new Ssh.userKeys and Ssh.userKeyAt properties will+    always update out of date key files.+  * Ssh.pubKey renamed to Ssh.hostPubKey. (API change)+  * Added --unset-unused +  * Fix typo: propigate → propagate. Thanks, Felix Gruber.+    (A minor API change)+  * Chroot: Converted to use a ChrootBootstrapper type class, so+    other ways to bootstrap chroots can easily be added in separate+    modules. (API change)++ -- Joey Hess <id@joeyh.name>  Tue, 20 Oct 2015 15:43:12 -0400+ propellor (2.8.1) unstable; urgency=medium    * Guard against power loss etc when building propellor, by updating@@ -272,7 +310,7 @@ propellor (1.2.2) unstable; urgency=medium    * Revert ensureProperty warning message, too many false positives in places-    where Info is correctly propigated. Better approach needed.+    where Info is correctly propagated. Better approach needed.   -- Joey Hess <id@joeyh.name>  Sun, 21 Dec 2014 21:41:11 -0400

propellor.cabal view

@@ -1,5 +1,5 @@ Name: propellor-Version: 2.8.1+Version: 2.9.0 Cabal-Version: >= 1.8 License: BSD3 Maintainer: Joey Hess <id@joeyh.name>@@ -69,6 +69,8 @@    Exposed-Modules:     Propellor+    Propellor.Base+    Propellor.Location     Propellor.Property     Propellor.Property.Aiccu     Propellor.Property.Apache@@ -92,6 +94,9 @@     Propellor.Property.Grub     Propellor.Property.Journald     Propellor.Property.Kerberos+    Propellor.Property.List+    Propellor.Property.LightDM+    Propellor.Property.Logcheck     Propellor.Property.Mount     Propellor.Property.Network     Propellor.Property.Nginx@@ -104,9 +109,7 @@     Propellor.Property.Prosody     Propellor.Property.Reboot     Propellor.Property.Rsync-    Propellor.Property.List-    Propellor.Property.LightDM-    Propellor.Property.Logcheck+    Propellor.Property.Spin     Propellor.Property.Scheduled     Propellor.Property.Service     Propellor.Property.Ssh@@ -116,6 +119,7 @@     Propellor.Property.Tor     Propellor.Property.Unbound     Propellor.Property.User+    Propellor.Property.Uwsgi     Propellor.Property.HostingProvider.CloudAtCost     Propellor.Property.HostingProvider.DigitalOcean     Propellor.Property.HostingProvider.Linode@@ -125,6 +129,7 @@     Propellor.Property.SiteSpecific.Branchable     Propellor.Property.SiteSpecific.IABak     Propellor.PropAccum+    Propellor.Utilities     Propellor.CmdLine     Propellor.Info     Propellor.Message

src/Propellor.hs view

@@ -1,15 +1,12 @@-{-# LANGUAGE PackageImports #-}+{-# OPTIONS_GHC -fno-warn-duplicate-exports #-} --- | Pulls in lots of useful modules for building and using Properties.--- --- When propellor runs on a Host, it ensures that its list of Properties--- is satisfied, taking action as necessary when a Property is not+-- | When propellor runs on a Host, it ensures that its Properties+-- are satisfied, taking action as necessary when a Property is not -- currently satisfied. -- -- A simple propellor program example: -- -- > import Propellor--- > import Propellor.CmdLine -- > import qualified Propellor.Property.File as File -- > import qualified Propellor.Property.Apt as Apt -- > @@ -30,54 +27,49 @@ -- git clone <git://git.joeyh.name/propellor>  module Propellor (-	  module Propellor.Types+	-- * Core data types+	  Host(..)+	, Property+	, RevertableProperty+	, (<!>)+	, module Propellor.Types+	-- * Config file+	, defaultMain+	, host+	, (&)+	, (!)+	-- * Propertries+	, describe+	-- | Properties are often combined together in your propellor+	-- configuration. For example:+	--+	-- > "/etc/foo/config" `File.containsLine` "bar=1"+	-- > 	`requires` File.dirExists "/etc/foo"+	, requires+	, before+	, onChange 	, module Propellor.Property-	, module Propellor.Property.List+	-- | Everything you need to build your own properties,+	-- and useful property combinators 	, module Propellor.Property.Cmd-	, module Propellor.PropAccum+	-- | Properties to run shell commands 	, module Propellor.Info-	, module Propellor.PrivData+	-- | Properties that set `Info`+	, module Propellor.Property.List+	-- | Combining a list of properties into a single property 	, module Propellor.Types.PrivData-	, module Propellor.Engine-	, module Propellor.Exception-	, module Propellor.Message-	, localdir+	-- | Private data access for properties  	, module X ) where  import Propellor.Types+import Propellor.CmdLine (defaultMain) import Propellor.Property-import Propellor.Engine import Propellor.Property.List import Propellor.Property.Cmd-import Propellor.PrivData import Propellor.Types.PrivData-import Propellor.Message-import Propellor.Exception import Propellor.Info import Propellor.PropAccum -import Utility.PartialPrelude as X-import Utility.Process as X-import Utility.Exception as X-import Utility.Env as X-import Utility.Directory as X-import Utility.Tmp as X-import Utility.Monad as X-import Utility.Misc as X--import System.Directory as X-import System.IO as X-import System.FilePath as X-import Data.Maybe as X-import Data.Either as X-import Control.Applicative as X-import Control.Monad as X import Data.Monoid as X-import Control.Monad.IfElse as X-import "mtl" Control.Monad.Reader as X---- | This is where propellor installs itself when deploying a host.-localdir :: FilePath-localdir = "/usr/local/propellor"

+ src/Propellor/Base.hs view

@@ -0,0 +1,57 @@+{-# LANGUAGE PackageImports #-}++-- | Pulls in lots of useful modules for building and using Properties.++module Propellor.Base (+	-- * Propellor modules+	  module Propellor.Types+	, module Propellor.Property+	, module Propellor.Property.Cmd+	, module Propellor.Property.List+	, module Propellor.Types.PrivData+	, module Propellor.PropAccum+	, module Propellor.Info+	, module Propellor.PrivData+	, module Propellor.Engine+	, module Propellor.Exception+	, module Propellor.Message+	, module Propellor.Location+	, module Propellor.Utilities++	-- * System modules+	, module System.Directory+	, module System.IO+	, module System.FilePath+	, module Data.Maybe+	, module Data.Either+	, module Control.Applicative+	, module Control.Monad+	, module Data.Monoid+	, module Control.Monad.IfElse+	, module Control.Monad.Reader+) where++import Propellor.Types+import Propellor.Property+import Propellor.Engine+import Propellor.Property.List+import Propellor.Property.Cmd+import Propellor.PrivData+import Propellor.Types.PrivData+import Propellor.Message+import Propellor.Exception+import Propellor.Info+import Propellor.PropAccum+import Propellor.Location+import Propellor.Utilities++import System.Directory+import System.IO+import System.FilePath+import Data.Maybe+import Data.Either+import Control.Applicative+import Control.Monad+import Data.Monoid+import Control.Monad.IfElse+import "mtl" Control.Monad.Reader

src/Propellor/Bootstrap.hs view

@@ -5,7 +5,7 @@ 	buildPropellor, ) where -import Propellor+import Propellor.Base  import System.Posix.Files import Data.List

src/Propellor/CmdLine.hs view

@@ -9,7 +9,7 @@ import System.PosixCompat import Network.Socket -import Propellor+import Propellor.Base import Propellor.Gpg import Propellor.Git import Propellor.Bootstrap@@ -27,10 +27,12 @@ 	, "  propellor --spin targethost [--via relayhost]" 	, "  propellor --add-key keyid" 	, "  propellor --rm-key keyid"-	, "  propellor --set field context"+	, "  propellor --list-fields" 	, "  propellor --dump field context" 	, "  propellor --edit field context"-	, "  propellor --list-fields"+	, "  propellor --set field context"+	, "  propellor --unset field context"+	, "  propellor --unset-unused" 	, "  propellor --merge" 	, "  propellor --build" 	, "  propellor --check"@@ -54,6 +56,7 @@ 	go ("--rm-key":k:[]) = return $ RmKey k 	go ("--set":f:c:[]) = withprivfield f c Set 	go ("--unset":f:c:[]) = withprivfield f c Unset+	go ("--unset-unused":[]) = return UnsetUnused 	go ("--dump":f:c:[]) = withprivfield f c Dump 	go ("--edit":f:c:[]) = withprivfield f c Edit 	go ("--list-fields":[]) = return ListFields@@ -98,6 +101,7 @@ 	go _ Check = return () 	go _ (Set field context) = setPrivData field context 	go _ (Unset field context) = unsetPrivData field context+	go _ (UnsetUnused) = unsetPrivDataUnused hostlist 	go _ (Dump field context) = dumpPrivData field context 	go _ (Edit field context) = editPrivData field context 	go _ ListFields = listPrivDataFields hostlist@@ -113,9 +117,10 @@ 	go _ Merge = mergeSpin 	go True cmdline@(Spin _ _) = buildFirst cmdline $ go False cmdline 	go True cmdline = updateFirst cmdline $ go False cmdline-	go False (Spin hs r) = do+	go False (Spin hs mrelay) = do 		commitSpin-		forM_ hs $ \hn -> withhost hn $ spin hn r+		forM_ hs $ \hn -> withhost hn $+			spin (maybe RegularSpin RelaySpin mrelay) hn 	go False cmdline@(SimpleRun hn) = buildFirst cmdline $ 		go False (Run hn) 	go False (Run hn) = ifM ((==) 0 <$> getRealUserID)

src/Propellor/Engine.hs view

@@ -7,6 +7,7 @@ 	ensureProperty, 	ensureProperties, 	fromHost,+	fromHost', 	onlyProcess, 	processChainOutput, ) where@@ -26,6 +27,7 @@ import Propellor.Message import Propellor.Exception import Propellor.Info+import Propellor.Property import Utility.Exception import Utility.PartialPrelude import Utility.Monad@@ -62,13 +64,6 @@ 	(ret, _s, _) <- runRWST (runWithHost (catchPropellor (a res))) host () 	return ret --- | For when code running in the Propellor monad needs to ensure a--- Property.------ This can only be used on a Property that has NoInfo.-ensureProperty :: Property NoInfo -> Propellor Result-ensureProperty = catchPropellor . propertySatisfy- -- | Ensures a list of Properties, with a display of each as it runs. ensureProperties :: [Property NoInfo] -> Propellor Result ensureProperties ps = ensure ps NoChange@@ -79,17 +74,19 @@ 		r <- actionMessageOn hn (propertyDesc p) (ensureProperty p) 		ensure ls (r <> rs) --- | Lifts an action into a different host.+-- | Lifts an action into the context of a different host. ----- > fromHost hosts "otherhost" getPubKey+-- > fromHost hosts "otherhost" Ssh.getHostPubKey fromHost :: [Host] -> HostName -> Propellor a -> Propellor (Maybe a) fromHost l hn getter = case findHost l hn of 	Nothing -> return Nothing-	Just h -> do-		(ret, _s, runlog) <- liftIO $-			runRWST (runWithHost getter) h ()-		tell runlog-		return (Just ret)+	Just h -> Just <$> fromHost' h getter++fromHost' :: Host -> Propellor a -> Propellor a+fromHost' h getter = do+	(ret, _s, runlog) <- liftIO $ runRWST (runWithHost getter) h ()+	tell runlog+	return ret  onlyProcess :: FilePath -> IO a -> IO a onlyProcess lockfile a = bracket lock unlock (const a)

src/Propellor/Git.hs view

@@ -1,6 +1,6 @@ module Propellor.Git where -import Propellor+import Propellor.Base import Propellor.PrivData.Paths import Propellor.Gpg import Utility.FileMode

src/Propellor/Info.hs view

@@ -101,3 +101,6 @@  hostAddresses :: HostName -> [Host] -> [IPAddr] hostAddresses hn hosts = maybe [] (getAddresses . hostInfo) (findHost hosts hn)++addHostInfo ::IsInfo v => Host -> v -> Host+addHostInfo h v = h { hostInfo = addInfo (hostInfo h) v }

+ src/Propellor/Location.hs view

@@ -0,0 +1,5 @@+module Propellor.Location where++-- | This is where propellor installs itself when deploying a host.+localdir :: FilePath+localdir = "/usr/local/propellor"

src/Propellor/PrivData.hs view

@@ -9,12 +9,14 @@ 	addPrivData, 	setPrivData, 	unsetPrivData,+	unsetPrivDataUnused, 	dumpPrivData, 	editPrivData, 	filterPrivData, 	listPrivDataFields, 	makePrivDataDir, 	decryptPrivData,+	readPrivData, 	PrivMap, 	PrivInfo, 	forceHostContext,@@ -158,8 +160,21 @@ unsetPrivData :: PrivDataField -> Context -> IO () unsetPrivData field context = do 	modifyPrivData $ M.delete (field, context)-	putStrLn "Private data unset."+	descUnset field context +descUnset :: PrivDataField -> Context -> IO ()+descUnset field context =+	putStrLn $ "Private data unset: " ++ show field ++ " " ++ show context++unsetPrivDataUnused :: [Host] -> IO ()+unsetPrivDataUnused hosts = do+	deleted <- modifyPrivData' $ \m ->+		let (keep, del) = M.partitionWithKey (\k _ -> k `M.member` usedby) m+		in (keep, M.keys del)+	mapM_ (uncurry descUnset) deleted+  where+	usedby = mkUsedByMap hosts+ dumpPrivData :: PrivDataField -> Context -> IO () dumpPrivData field context = do 	maybe (error "Requested privdata is not set.")@@ -199,15 +214,21 @@ 		, shellEscape context 		, intercalate ", " $ sort $ fromMaybe [] $ M.lookup k usedby 		]-	mkhostmap host mkv = M.fromList $ map (\(f, d, c) -> ((f, mkHostContext c (hostName host)), mkv d)) $-		S.toList $ fromPrivInfo $ getInfo $ hostInfo host-	usedby = M.unionsWith (++) $ map (\h -> mkhostmap h $ const [hostName h]) hosts+	usedby = mkUsedByMap hosts 	wantedmap = M.fromList $ zip (M.keys usedby) (repeat "")-	descmap = M.unions $ map (`mkhostmap` id) hosts+	descmap = M.unions $ map (`mkPrivDataMap` id) hosts 	section desc = putStrLn $ "\n" ++ desc 	showtable rows = do 		putStr $ unlines $ formatTable $ tableWithHeader header rows +mkUsedByMap :: [Host] -> M.Map (PrivDataField, Context) [HostName]+mkUsedByMap = M.unionsWith (++) . map (\h -> mkPrivDataMap h $ const [hostName h])++mkPrivDataMap :: Host -> (Maybe PrivDataSourceDesc -> a) -> M.Map (PrivDataField, Context) a+mkPrivDataMap host mkv = M.fromList $+	map (\(f, d, c) -> ((f, mkHostContext c (hostName host)), mkv d))+		(S.toList $ fromPrivInfo $ getInfo $ hostInfo host)+ setPrivDataTo :: PrivDataField -> Context -> PrivData -> IO () setPrivDataTo field context (PrivData value) = do 	modifyPrivData set@@ -216,16 +237,23 @@ 	set = M.insert (field, context) value  modifyPrivData :: (PrivMap -> PrivMap) -> IO ()-modifyPrivData f = do+modifyPrivData f = modifyPrivData' (\m -> (f m, ()))++modifyPrivData' :: (PrivMap -> (PrivMap, a)) -> IO a+modifyPrivData' f = do 	makePrivDataDir 	m <- decryptPrivData-	let m' = f m+	let (m', r) = f m 	gpgEncrypt privDataFile (show m') 	void $ boolSystem "git" [Param "add", File privDataFile]+	return r  decryptPrivData :: IO PrivMap-decryptPrivData = fromMaybe M.empty . readish <$> gpgDecrypt privDataFile+decryptPrivData = readPrivData <$> gpgDecrypt privDataFile +readPrivData :: String -> PrivMap+readPrivData = fromMaybe M.empty . readish+ makePrivDataDir :: IO () makePrivDataDir = createDirectoryIfMissing False privDataDir @@ -233,10 +261,10 @@ 	{ fromPrivInfo :: S.Set (PrivDataField, Maybe PrivDataSourceDesc, HostContext) } 	deriving (Eq, Ord, Show, Typeable, Monoid) --- PrivInfo is propigated out of containers, so that propellor can see which+-- PrivInfo is propagated out of containers, so that propellor can see which -- hosts need it. instance IsInfo PrivInfo where-	propigateInfo _ = True+	propagateInfo _ = True  -- | Sets the context of any privdata that uses HostContext to the -- provided name.

src/Propellor/PropAccum.hs view

@@ -2,11 +2,11 @@  module Propellor.PropAccum 	( host-	, props 	, PropAccum(..)+	, (&)+	, (&^) 	, (!)-	, PropList-	, propigateContainer+	, propagateContainer 	) where  import Data.Monoid@@ -25,64 +25,56 @@ host :: HostName -> Host host hn = Host hn [] mempty --- | Starts accumulating a list of properties.------ > propertyList "foo" $ props--- > 	& someproperty--- > 	! oldproperty--- > 	& otherproperty-props :: PropList-props = PropList []- -- | Something that can accumulate properties. class PropAccum h where 	-- | Adds a property.-	---	-- Can add Properties and RevertableProperties-	(&) :: IsProp p => h -> p -> h+	addProp :: IsProp p => h -> p -> h -	-- | Like (&), but adds the property at the front of the list.-	(&^) :: IsProp p => h -> p -> h+	-- | Like addProp, but adds the property at the front of the list.+	addPropFront :: IsProp p => h -> p -> h  	getProperties :: h -> [Property HasInfo] -instance PropAccum Host where-	(Host hn ps is) &  p = Host hn (ps ++ [toProp p])-		(is <> getInfoRecursive p)-	(Host hn ps is) &^ p = Host hn (toProp p : ps)-		(getInfoRecursive p <> is)-	getProperties = hostProperties--data PropList = PropList [Property HasInfo]+-- | Adds a property to a `Host` or other `PropAccum`+--+-- Can add Properties and RevertableProperties+(&) :: (PropAccum h, IsProp p) => h -> p -> h+(&) = addProp -instance PropAccum PropList where-	PropList l &  p = PropList (toProp p : l)-	PropList l &^ p = PropList (l ++ [toProp p])-	getProperties (PropList l) = reverse l+-- | Adds a property before any other properties.+(&^) :: (PropAccum h, IsProp p) => h -> p -> h+(&^) = addPropFront  -- | Adds a property in reverted form. (!) :: PropAccum h => h -> RevertableProperty -> h h ! p = h & revert p -infixl 1 &^ infixl 1 &+infixl 1 &^ infixl 1 ! +instance PropAccum Host where+	(Host hn ps is) `addProp`  p = Host hn (ps ++ [toProp p])+		(is <> getInfoRecursive p)+	(Host hn ps is) `addPropFront` p = Host hn (toProp p : ps)+		(getInfoRecursive p <> is)+	getProperties = hostProperties+ -- | Adjust the provided Property, adding to its -- propertyChidren the properties of the provided container. --  -- The Info of the propertyChildren is adjusted to only include --- info that should be propigated out to the Property.+-- info that should be propagated out to the Property. -- -- Any PrivInfo that uses HostContext is adjusted to use the name -- of the container as its context.-propigateContainer+propagateContainer 	:: (PropAccum container) 	=> String 	-> container 	-> Property HasInfo 	-> Property HasInfo-propigateContainer containername c prop = infoProperty+propagateContainer containername c prop = infoProperty 	(propertyDesc prop) 	(propertySatisfy prop) 	(propertyInfo prop)@@ -91,6 +83,6 @@ 	hostprops = map go $ getProperties c 	go p =  		let i = mapInfo (forceHostContext containername)-			(propigatableInfo (propertyInfo p))+			(propagatableInfo (propertyInfo p)) 		    cs = map go (propertyChildren p) 		in infoProperty (propertyDesc p) (propertySatisfy p) i cs

src/Propellor/Property.hs view

@@ -1,7 +1,31 @@ {-# LANGUAGE PackageImports #-} {-# LANGUAGE FlexibleContexts #-} -module Propellor.Property where+module Propellor.Property (+	-- * Property combinators+	  requires+	, before+	, onChange+	, onChangeFlagOnFail+	, flagFile+	, flagFile'+	, check+	, fallback+	, trivial+	, revert+	-- * Property descriptions+	, describe+	, (==>)+	-- * Constructing properties+	, Propellor+	, property+	, ensureProperty+	, withOS+	, makeChange+	, noChange+	, doNothing+	, endAction+) where  import System.Directory import System.FilePath@@ -12,6 +36,7 @@  import Propellor.Types import Propellor.Info+import Propellor.Exception import Utility.Monad  -- | Constructs a Property, from a description and an action to run to@@ -39,6 +64,18 @@ 				writeFile flagfile "" 		return r +-- | Indicates that the first property depends on the second,+-- so before the first is ensured, the second must be ensured.+requires :: Combines x y => x -> y -> CombinedType x y+requires = (<<>>)++-- | Combines together two properties, resulting in one property+-- that ensures the first, and if the first succeeds, ensures the second.+--+-- The combined property uses the description of the first property.+before :: (IsProp x, Combines y x, IsProp (CombinedType y x)) => x -> y -> CombinedType y x+before x y = (y `requires` x) `describe` getDesc x+ -- | Whenever a change has to be made for a Property, causes a hook -- Property to also be run, but not otherwise. onChange@@ -88,11 +125,22 @@ 		writeFile flagfile "" 	removeFlagFile = whenM (doesFileExist flagfile) $ removeFile flagfile +-- | Changes the description of a property.+describe :: IsProp p => p -> Desc -> p+describe = setDesc+ -- | Alias for @flip describe@ (==>) :: IsProp (Property i) => Desc -> Property i -> Property i (==>) = flip describe infixl 1 ==> +-- | For when code running in the Propellor monad needs to ensure a+-- Property.+--+-- This can only be used on a Property that has NoInfo.+ensureProperty :: Property NoInfo -> Propellor Result+ensureProperty = catchPropellor . propertySatisfy+ -- | Makes a Property only need to do anything when a test succeeds. check :: IO Bool -> Property i -> Property i check c p = adjustPropertySatisfy p $ \satisfy -> ifM (liftIO c)@@ -125,11 +173,16 @@ -- | Makes a property that is satisfied differently depending on the host's -- operating system.  ----- Note that the operating system may not be declared for some hosts.+-- Note that the operating system may not be declared for all hosts.+--+-- > myproperty = withOS "foo installed" $ \o -> case o of+-- > 	(Just (System (Debian suite) arch)) -> ...+-- > 	(Just (System (Ubuntu release) arch)) -> ...+-- >	Nothing -> ... withOS :: Desc -> (Maybe System -> Propellor Result) -> Property NoInfo withOS desc a = property desc $ a =<< getOS --- | Undoes the effect of a property.+-- | Undoes the effect of a RevertableProperty. revert :: RevertableProperty -> RevertableProperty revert (RevertableProperty p1 p2) = RevertableProperty p2 p1 @@ -142,6 +195,7 @@ doNothing :: Property NoInfo doNothing = property "noop property" noChange --- | Registers an action that should be run at the very end,+-- | Registers an action that should be run at the very end, after+-- propellor has checks all the properties of a host. endAction :: Desc -> (Result -> Propellor Result) -> Propellor () endAction desc a = tell [EndAction desc a]

src/Propellor/Property/Aiccu.hs view

@@ -9,7 +9,7 @@ 	hasConfig, ) where -import Propellor+import Propellor.Base import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Service as Service import qualified Propellor.Property.File as File

src/Propellor/Property/Apache.hs view

@@ -1,10 +1,33 @@ module Propellor.Property.Apache where -import Propellor+import Propellor.Base import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Service as Service +installed :: Property NoInfo+installed = Apt.installed ["apache2"]++restarted :: Property NoInfo+restarted = Service.restarted "apache2"++reloaded :: Property NoInfo+reloaded = Service.reloaded "apache2"++-- | A basic virtual host, publishing a directory, and logging to+-- the combined apache log file.+virtualHost :: HostName -> Port -> FilePath -> RevertableProperty+virtualHost hn (Port p) docroot = siteEnabled hn+	[ "<VirtualHost *:"++show p++">"+	, "ServerName "++hn++":"++show p+	, "DocumentRoot " ++ docroot+	, "ErrorLog /var/log/apache2/error.log"+	, "LogLevel warn"+	, "CustomLog /var/log/apache2/access.log combined"+	, "ServerSignature On"+	, "</VirtualHost>"+	]+ type ConfigFile = [String]  siteEnabled :: HostName -> ConfigFile -> RevertableProperty@@ -19,13 +42,16 @@ 				`requires` installed 				`onChange` reloaded 		]-	disable = combineProperties-		("apache site disabled " ++ hn) -		(map File.notPresent (siteCfg hn))+	disable = siteDisabled hn+	isenabled = boolSystem "a2query" [Param "-q", Param "-s", Param hn]++siteDisabled :: HostName -> Property NoInfo+siteDisabled hn = combineProperties+	("apache site disabled " ++ hn) +	(map File.notPresent (siteCfg hn)) 		`onChange` cmdProperty "a2dissite" ["--quiet", hn] 		`requires` installed 		`onChange` reloaded-	isenabled = boolSystem "a2query" [Param "-q", Param "-s", Param hn]  siteAvailable :: HostName -> ConfigFile -> Property NoInfo siteAvailable hn cf = combineProperties ("apache site available " ++ hn) $@@ -48,6 +74,16 @@ 			`onChange` reloaded 	isenabled = boolSystem "a2query" [Param "-q", Param "-m", Param modname] +-- | Make apache listen on the specified ports.+--+-- Note that ports are also specified inside a site's config file,+-- so that also needs to be changed.+listenPorts :: [Port] -> Property NoInfo+listenPorts ps = "/etc/apache2/ports.conf" `File.hasContent` map portline ps+	`onChange` restarted+  where+	portline (Port n) = "Listen " ++ show n+ -- This is a list of config files because different versions of apache -- use different filenames. Propellor simply writes them all. siteCfg :: HostName -> [FilePath]@@ -57,15 +93,6 @@ 	-- Debian 2.4+ 	, "/etc/apache2/sites-available/" ++ hn ++ ".conf" 	] --installed :: Property NoInfo-installed = Apt.installed ["apache2"]--restarted :: Property NoInfo-restarted = Service.restarted "apache2"--reloaded :: Property NoInfo-reloaded = Service.reloaded "apache2"  -- | Configure apache to use SNI to differentiate between -- https hosts.

src/Propellor/Property/Apt.hs view

@@ -8,7 +8,7 @@ import System.IO import Control.Monad -import Propellor+import Propellor.Base import qualified Propellor.Property.File as File import qualified Propellor.Property.Service as Service import Propellor.Property.File (Line)@@ -297,3 +297,11 @@ cacheCleaned :: Property NoInfo cacheCleaned = trivial $ cmdProperty "apt-get" ["clean"] 	`describe` "apt cache cleaned"++-- | Add a foreign architecture to dpkg and apt.+hasForeignArch :: String -> Property NoInfo+hasForeignArch arch = check notAdded add+	`describe` ("dpkg has foreign architecture " ++ arch)+  where+	notAdded = (not . elem arch . lines) <$> readProcess "dpkg" ["--print-foreign-architectures"]+	add = cmdProperty "dpkg" ["--add-architecture", arch] `before` update

src/Propellor/Property/Chroot.hs view

@@ -1,18 +1,21 @@-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleContexts, GADTs #-}  module Propellor.Property.Chroot ( 	Chroot(..),-	BuilderConf(..),+	ChrootBootstrapper(..),+	Debootstrapped(..), 	debootstrapped,+	bootstrapped, 	provisioned, 	-- * Internal use 	provisioned',-	propigateChrootInfo,+	propagateChrootInfo, 	propellChroot, 	chain,+	chrootSystem, ) where -import Propellor+import Propellor.Base import Propellor.Types.CmdLine import Propellor.Types.Chroot import Propellor.Types.Info@@ -26,33 +29,57 @@ import Data.List.Utils import System.Posix.Directory -data Chroot = Chroot FilePath System BuilderConf Host-	deriving (Show)+-- | Specification of a chroot. Normally you'll use `debootstrapped` or+-- `bootstrapped` to construct a Chroot value.+data Chroot where+	Chroot :: ChrootBootstrapper b => FilePath -> System -> b -> Host -> Chroot -data BuilderConf-	= UsingDeboostrap Debootstrap.DebootstrapConfig-	deriving (Show)+chrootSystem :: Chroot -> System+chrootSystem (Chroot _ system _ _) = system +instance Show Chroot where+	show (Chroot loc system _ _) = "Chroot " ++ loc ++ " " ++ show system+ instance PropAccum Chroot where-	(Chroot l s c h) & p = Chroot l s c (h & p)-	(Chroot l s c h) &^ p = Chroot l s c (h &^ p)+	(Chroot l s c h) `addProp` p = Chroot l s c (h & p)+	(Chroot l s c h) `addPropFront` p = Chroot l s c (h `addPropFront` p) 	getProperties (Chroot _ _ _ h) = hostProperties h +-- | Class of things that can do initial bootstrapping of an operating+-- System in a chroot.+class ChrootBootstrapper b where+	-- | Do initial bootstrapping of an operating system in a chroot.+	-- If the operating System is not supported, return Nothing.+	buildchroot :: b -> System -> FilePath -> Maybe (Property HasInfo)++-- | Use to bootstrap a chroot with debootstrap.+data Debootstrapped = Debootstrapped Debootstrap.DebootstrapConfig++instance ChrootBootstrapper Debootstrapped where+	buildchroot (Debootstrapped cf) system loc = case system of+		(System (Debian _) _) -> Just debootstrap+		(System (Ubuntu _) _) -> Just debootstrap+	  where+		debootstrap = Debootstrap.built loc system cf+ -- | Defines a Chroot at the given location, built with debootstrap. -- -- Properties can be added to configure the Chroot. -- -- > debootstrapped (System (Debian Unstable) "amd64") Debootstrap.BuildD "/srv/chroot/ghc-dev"--- >    & Apt.installed ["ghc", "haskell-platform"]--- >	& ...+-- > 	& Apt.installed ["ghc", "haskell-platform"]+-- > 	& ... debootstrapped :: System -> Debootstrap.DebootstrapConfig -> FilePath -> Chroot-debootstrapped system conf location = case system of-	(System (Debian _) _) -> mk-	(System (Ubuntu _) _) -> mk+debootstrapped system conf = bootstrapped system (Debootstrapped conf)++-- | Defines a Chroot at the given location, bootstrapped with the+-- specified ChrootBootstrapper.+bootstrapped :: ChrootBootstrapper b => System -> b -> FilePath -> Chroot+bootstrapped system bootstrapper location =+	Chroot location system bootstrapper h+		& os system   where 	h = Host location [] mempty-	mk = Chroot location system (UsingDeboostrap conf) h-		& os system  -- | Ensures that the chroot exists and is provisioned according to its -- properties.@@ -61,29 +88,29 @@ -- is first unmounted. Note that it does not ensure that any processes -- that might be running inside the chroot are stopped. provisioned :: Chroot -> RevertableProperty-provisioned c = provisioned' (propigateChrootInfo c) c False+provisioned c = provisioned' (propagateChrootInfo c) c False  provisioned' :: (Property HasInfo -> Property HasInfo) -> Chroot -> Bool -> RevertableProperty-provisioned' propigator c@(Chroot loc system builderconf _) systemdonly =-	(propigator $ go "exists" setup)+provisioned' propigator c@(Chroot loc system bootstrapper _) systemdonly =+	(propigator $ propertyList (chrootDesc c "exists") [setup]) 		<!>-	(go "removed" teardown)+	(propertyList (chrootDesc c "removed") [teardown])   where-	go desc a = propertyList (chrootDesc c desc) [a]- 	setup = propellChroot c (inChrootProcess (not systemdonly) c) systemdonly 		`requires` toProp built 	-	built = case (system, builderconf) of-		((System (Debian _) _), UsingDeboostrap cf) -> debootstrap cf-		((System (Ubuntu _) _), UsingDeboostrap cf) -> debootstrap cf+	built = case buildchroot bootstrapper system loc of+		Just p -> p+		Nothing -> cantbuild -	debootstrap = Debootstrap.built loc system+	cantbuild = infoProperty (chrootDesc c "built") (error $ "cannot bootstrap " ++ show system ++ " using supplied ChrootBootstrapper") mempty [] -	teardown = toProp (revert built)+	teardown = check (not <$> unpopulated loc) $+		property ("removed " ++ loc) $+			makeChange (removeChroot loc) -propigateChrootInfo :: (IsProp (Property i)) => Chroot -> Property i -> Property HasInfo-propigateChrootInfo c@(Chroot location _ _ _) p = propigateContainer location c p'+propagateChrootInfo :: (IsProp (Property i)) => Chroot -> Property i -> Property HasInfo+propagateChrootInfo c@(Chroot location _ _ _) p = propagateContainer location c p'   where 	p' = infoProperty 		(propertyDesc p)

src/Propellor/Property/Chroot/Util.hs view

@@ -2,11 +2,14 @@  import Propellor.Property.Mount +import Utility.Exception import Utility.Env+import Utility.Directory+ import Control.Applicative import System.Directory --- When chrooting, it's useful to ensure that PATH has all the standard+-- | When chrooting, it's useful to ensure that PATH has all the standard -- directories in it. This adds those directories to whatever PATH is -- already set. standardPathEnv :: IO [(String, String)]@@ -18,9 +21,13 @@ stdPATH :: String stdPATH = "/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin" --- Removes the contents of a chroot. First, unmounts any filesystems+-- | Removes the contents of a chroot. First, unmounts any filesystems -- mounted within it. removeChroot :: FilePath -> IO () removeChroot c = do 	unmountBelow c 	removeDirectoryRecursive c++-- | Returns true if a chroot directory is empty.+unpopulated :: FilePath -> IO Bool+unpopulated d = null <$> catchDefaultIO [] (dirContents d)

src/Propellor/Property/ConfFile.hs view

@@ -12,7 +12,7 @@ 	lacksIniSection, ) where -import Propellor+import Propellor.Base import Propellor.Property.File  import Data.List (isPrefixOf, foldl')

src/Propellor/Property/Cron.hs view

@@ -1,6 +1,6 @@ module Propellor.Property.Cron where -import Propellor+import Propellor.Base import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt import Propellor.Bootstrap

src/Propellor/Property/DebianMirror.hs view

@@ -7,7 +7,7 @@ 	, mirrorCdn 	) where -import Propellor+import Propellor.Base import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Cron as Cron

src/Propellor/Property/Debootstrap.hs view

@@ -10,7 +10,7 @@ 	programPath, ) where -import Propellor+import Propellor.Base import qualified Propellor.Property.Apt as Apt import Propellor.Property.Chroot.Util import Utility.Path@@ -48,19 +48,8 @@ -- -- The System can be any OS and architecture that debootstrap -- and the kernel support.------ Reverting this property deletes the chroot and all its contents.--- Anything mounted under the filesystem is first unmounted.------ Note that reverting this property does not stop any processes--- currently running in the chroot.-built :: FilePath -> System -> DebootstrapConfig -> RevertableProperty-built target system config = built' (toProp installed) target system config <!> teardown-  where-	teardown = check (not <$> unpopulated target) teardownprop-	-	teardownprop = property ("removed debootstrapped " ++ target) $-		makeChange (removeChroot target)+built :: FilePath -> System -> DebootstrapConfig -> Property HasInfo+built target system config = built' (toProp installed) target system config  built' :: (Combines (Property NoInfo) (Property i)) => Property i -> FilePath -> System -> DebootstrapConfig -> Property (CInfo NoInfo i) built' installprop target system@(System _ arch) config = @@ -100,9 +89,6 @@ 		, return False 		) 	-unpopulated :: FilePath -> IO Bool-unpopulated d = null <$> catchDefaultIO [] (dirContents d)	- extractSuite :: System -> Maybe String extractSuite (System (Debian s) _) = Just $ Apt.showSuite s extractSuite (System (Ubuntu r) _) = Just r

src/Propellor/Property/DiskImage.hs view

@@ -36,7 +36,7 @@ 	noFinalization, ) where -import Propellor+import Propellor.Base import Propellor.Property.Chroot (Chroot) import Propellor.Property.Chroot.Util (removeChroot) import qualified Propellor.Property.Chroot as Chroot

src/Propellor/Property/Dns.hs view

@@ -13,7 +13,7 @@ 	genZone, ) where -import Propellor+import Propellor.Base import Propellor.Types.Dns import Propellor.Types.Info import Propellor.Property.File@@ -524,7 +524,7 @@ genSSHFP :: Domain -> Host -> Propellor [(BindDomain, Record)] genSSHFP domain h = concatMap mk . concat <$> (gen =<< get)   where-	get = fromHost [h] hostname Ssh.getPubKey+	get = fromHost [h] hostname Ssh.getHostPubKey 	gen = liftIO . mapM genSSHFP' . M.elems . fromMaybe M.empty 	mk r = mapMaybe (\d -> if inDomain domain d then Just (d, r) else Nothing) 		(AbsDomain hostname : cnames)

src/Propellor/Property/DnsSec.hs view

@@ -1,6 +1,6 @@ module Propellor.Property.DnsSec where -import Propellor+import Propellor.Base import qualified Propellor.Property.File as File  -- | Puts the DNSSEC key files in place from PrivData.@@ -71,7 +71,7 @@ 		, "-3", salt 		-- The serial number needs to be increased each time the 		-- zone is resigned, even if there are no other changes,-		-- so that it will propigate to secondaries. So, use the+		-- so that it will propagate to secondaries. So, use the 		-- unixtime serial format. 		, "-N", "unixtime" 		, "-o", domain

src/Propellor/Property/Docker.hs view

@@ -45,7 +45,7 @@ 	chain, ) where -import Propellor hiding (init)+import Propellor.Base hiding (init) import Propellor.Types.Docker import Propellor.Types.Container import Propellor.Types.CmdLine@@ -97,8 +97,8 @@ 	getImageName (Container i _) = i  instance PropAccum Container where-	(Container i h) & p = Container i (h & p)-	(Container i h) &^ p = Container i (h &^ p)+	(Container i h) `addProp` p = Container i (h `addProp` p)+	(Container i h) `addPropFront` p = Container i (h `addPropFront` p) 	getProperties (Container _ h) = hostProperties h  -- | Defines a Container with a given name, image, and properties.@@ -119,13 +119,13 @@ -- propellor inside the container. -- -- When the container's Properties include DNS info, such as a CNAME,--- that is propigated to the Info of the Host it's docked in.+-- that is propagated to the Info of the Host it's docked in. -- -- Reverting this property ensures that the container is stopped and -- removed. docked :: Container -> RevertableProperty docked ctr@(Container _ h) =-	(propigateContainerInfo ctr (go "docked" setup))+	(propagateContainerInfo ctr (go "docked" setup)) 		<!> 	(go "undocked" teardown)   where@@ -170,8 +170,8 @@ 	pulled = Cmd.cmdProperty dockercmd ["pull", imageIdentifier image] 	image = getImageName ctr -propigateContainerInfo :: (IsProp (Property i)) => Container -> Property i -> Property HasInfo-propigateContainerInfo ctr@(Container _ h) p = propigateContainer cn ctr p'+propagateContainerInfo :: (IsProp (Property i)) => Container -> Property i -> Property HasInfo+propagateContainerInfo ctr@(Container _ h) p = propagateContainer cn ctr p'   where 	p' = infoProperty 		(propertyDesc p)

src/Propellor/Property/File.hs view

@@ -1,6 +1,6 @@ module Propellor.Property.File where -import Propellor+import Propellor.Base import Utility.FileMode  import System.Posix.Files@@ -82,12 +82,11 @@ 		let new = unlines (a (lines old)) 		if old == new 			then noChange-			else makeChange $ viaTmp updatefile f new+			else makeChange $ updatefile new `viaStableTmp` f 	go False = makeChange $ writer f (unlines $ a []) -	-- viaTmp makes the temp file mode 600. 	-- Replicate the original file's owner and mode.-	updatefile f' content = do+	updatefile content f' = do 		writer f' content 		s <- getFileStatus f 		setFileMode f' (fileMode s)@@ -98,6 +97,33 @@ dirExists d = check (not <$> doesDirectoryExist d) $ property (d ++ " exists") $ 	makeChange $ createDirectoryIfMissing True d +-- | The location that a symbolic link points to.+newtype LinkTarget = LinkTarget FilePath++-- | Creates or atomically updates a symbolic link.+--+-- Does not overwrite regular files or directories.+isSymlinkedTo :: FilePath -> LinkTarget -> Property NoInfo+link `isSymlinkedTo` (LinkTarget target) = property desc $+	go =<< (liftIO $ tryIO $ getSymbolicLinkStatus link)+  where+	desc = link ++ " is symlinked to " ++ target+	go (Right stat) =+		if isSymbolicLink stat+			then checkLink+			else nonSymlinkExists+	go (Left _) = makeChange $ createSymbolicLink target link++	nonSymlinkExists = do+		warningMessage $ link ++ " exists and is not a symlink"+		return FailedChange+	checkLink = do+		target' <- liftIO $ readSymbolicLink link+		if target == target'+			then noChange+			else makeChange updateLink+	updateLink = createSymbolicLink target `viaStableTmp` link+ -- | Ensures that a file/dir has the specified owner and group. ownerGroup :: FilePath -> User -> Group -> Property NoInfo ownerGroup f (User owner) (Group group) = property (f ++ " owner " ++ og) $ do@@ -113,3 +139,27 @@ mode f v = property (f ++ " mode " ++ show v) $ do 	liftIO $ modifyFileMode f (const v) 	noChange++-- | A temp file to use when writing new content for a file.+--+-- This is a stable name so it can be removed idempotently.+--+-- It ends with "~" so that programs that read many config files from a+-- directory will treat it as an editor backup file, and not read it.+stableTmpFor :: FilePath -> FilePath+stableTmpFor f = f ++ ".propellor-new~"++-- | Creates/updates a file atomically, running the action to create the+-- stable tmp file, and then renaming it into place.+viaStableTmp :: (MonadMask m, MonadIO m) => (FilePath -> m ()) -> FilePath -> m ()+viaStableTmp a f = bracketIO setup cleanup go+  where+	setup = do+		createDirectoryIfMissing True (takeDirectory f)+		let tmpfile = stableTmpFor f+		nukeFile tmpfile+		return tmpfile+	cleanup tmpfile = tryIO $ removeFile tmpfile+	go tmpfile = do+		a tmpfile+		liftIO $ rename tmpfile f

src/Propellor/Property/Firewall.hs view

@@ -16,7 +16,7 @@ import Data.Char import Data.List -import Propellor+import Propellor.Base import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Network as Network

src/Propellor/Property/Git.hs view

@@ -1,6 +1,6 @@ module Propellor.Property.Git where -import Propellor+import Propellor.Base import Propellor.Property.File import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Service as Service

src/Propellor/Property/Gpg.hs view

@@ -1,6 +1,6 @@ module Propellor.Property.Gpg where -import Propellor+import Propellor.Base import qualified Propellor.Property.Apt as Apt import Utility.FileSystemEncoding

src/Propellor/Property/Group.hs view

@@ -1,6 +1,6 @@ module Propellor.Property.Group where -import Propellor+import Propellor.Base  type GID = Int

src/Propellor/Property/Grub.hs view

@@ -1,6 +1,6 @@ module Propellor.Property.Grub where -import Propellor+import Propellor.Base import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt

src/Propellor/Property/HostingProvider/CloudAtCost.hs view

@@ -1,6 +1,6 @@ module Propellor.Property.HostingProvider.CloudAtCost where -import Propellor+import Propellor.Base import qualified Propellor.Property.Hostname as Hostname import qualified Propellor.Property.File as File import qualified Propellor.Property.User as User

src/Propellor/Property/HostingProvider/DigitalOcean.hs view

@@ -2,7 +2,7 @@ 	distroKernel ) where -import Propellor+import Propellor.Base import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.File as File import qualified Propellor.Property.Reboot as Reboot

src/Propellor/Property/HostingProvider/Linode.hs view

@@ -1,6 +1,6 @@ module Propellor.Property.HostingProvider.Linode where -import Propellor+import Propellor.Base import qualified Propellor.Property.Grub as Grub import qualified Propellor.Property.File as File import Utility.FileMode

src/Propellor/Property/Hostname.hs view

@@ -1,6 +1,6 @@ module Propellor.Property.Hostname where -import Propellor+import Propellor.Base import qualified Propellor.Property.File as File  import Data.List

src/Propellor/Property/Journald.hs view

@@ -1,5 +1,6 @@ module Propellor.Property.Journald where-import Propellor++import Propellor.Base import qualified Propellor.Property.Systemd as Systemd import Utility.DataUnits

src/Propellor/Property/Kerberos.hs view

@@ -4,7 +4,7 @@  import Utility.Process -import Propellor+import Propellor.Base import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.File as File import Propellor.Property.User

src/Propellor/Property/LightDM.hs view

@@ -4,7 +4,7 @@  module Propellor.Property.LightDM where -import Propellor+import Propellor.Base import qualified Propellor.Property.ConfFile as ConfFile  -- | Configures LightDM to skip the login screen and autologin as a user.

src/Propellor/Property/List.hs view

@@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleInstances #-}  module Propellor.Property.List (+	props, 	PropertyList(..), 	PropertyListType, ) where@@ -12,21 +13,32 @@  import Data.Monoid +-- | Starts accumulating a list of properties.+--+-- > propertyList "foo" $ props+-- > 	& someproperty+-- > 	! oldproperty+-- > 	& otherproperty+props :: PropList+props = PropList []++data PropList = PropList [Property HasInfo]++instance PropAccum PropList where+	PropList l `addProp` p = PropList (toProp p : l)+	PropList l `addPropFront` p = PropList (l ++ [toProp p])+	getProperties (PropList l) = reverse l+ class PropertyList l where 	-- | Combines a list of properties, resulting in a single property 	-- that when run will run each property in the list in turn, 	-- and print out the description of each as it's run. Does not stop-	-- on failure; does propigate overall success/failure.+	-- on failure; does propagate overall success/failure. 	-- 	-- Note that Property HasInfo and Property NoInfo are not the same 	-- type, and so cannot be mixed in a list. To make a list of 	-- mixed types, which can also include RevertableProperty,-	-- use `props`:-	---	-- > propertyList "foo" $ props-	-- >	& someproperty-	-- >	! oldproperty-	-- > 	& otherproperty+	-- use `props` 	propertyList :: Desc -> l -> Property (PropertyListType l)  	-- | Combines a list of properties, resulting in one property that

src/Propellor/Property/Logcheck.hs view

@@ -9,7 +9,7 @@ 	installed, ) where -import Propellor+import Propellor.Base import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.File as File

src/Propellor/Property/Mount.hs view

@@ -1,6 +1,6 @@ module Propellor.Property.Mount where -import Propellor+import Propellor.Base import Utility.Path  type FsType = String -- ^ type of filesystem to mount ("auto" to autodetect)

src/Propellor/Property/Network.hs view

@@ -1,6 +1,6 @@ module Propellor.Property.Network where -import Propellor+import Propellor.Base import Propellor.Property.File  type Interface = String

src/Propellor/Property/Nginx.hs view

@@ -2,28 +2,21 @@  module Propellor.Property.Nginx where -import Propellor+import Propellor.Base import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Service as Service-import System.Posix.Files  type ConfigFile = [String]  siteEnabled :: HostName -> ConfigFile -> RevertableProperty siteEnabled hn cf = enable <!> disable   where-	enable = check test prop+	enable = siteVal hn `File.isSymlinkedTo` siteValRelativeCfg hn 		`describe` ("nginx site enabled " ++ hn) 		`requires` siteAvailable hn cf 		`requires` installed 		`onChange` reloaded-	  where-		test = not <$> doesFileExist (siteVal hn)-		prop = property "nginx site in place" $ makeChange $-			createSymbolicLink target dir-		target = siteValRelativeCfg hn-		dir = siteVal hn 	disable = trivial $ File.notPresent (siteVal hn) 		`describe` ("nginx site disable" ++ hn) 		`requires` installed@@ -41,8 +34,8 @@ siteVal :: HostName -> FilePath siteVal hn = "/etc/nginx/sites-enabled/" ++ hn -siteValRelativeCfg :: HostName -> FilePath-siteValRelativeCfg hn = "../sites-available/" ++ hn+siteValRelativeCfg :: HostName -> File.LinkTarget+siteValRelativeCfg hn = File.LinkTarget ("../sites-available/" ++ hn)  installed :: Property NoInfo installed = Apt.installed ["nginx"]

src/Propellor/Property/OS.hs view

@@ -7,7 +7,7 @@ 	oldOSRemoved, ) where -import Propellor+import Propellor.Base import qualified Propellor.Property.Debootstrap as Debootstrap import qualified Propellor.Property.Ssh as Ssh import qualified Propellor.Property.Network as Network

src/Propellor/Property/Obnam.hs view

@@ -1,6 +1,6 @@ module Propellor.Property.Obnam where -import Propellor+import Propellor.Base import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Cron as Cron import qualified Propellor.Property.Gpg as Gpg

src/Propellor/Property/OpenId.hs view

@@ -1,27 +1,47 @@ module Propellor.Property.OpenId where -import Propellor+import Propellor.Base import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt-import qualified Propellor.Property.Service as Service+import qualified Propellor.Property.Apache as Apache  import Data.List -providerFor :: [User] -> String -> Property HasInfo-providerFor users baseurl = propertyList desc $ map toProp-	[ Apt.serviceInstalledRunning "apache2"-	, Apt.installed ["simpleid"]-		`onChange` Service.restarted "apache2"-	, File.fileProperty (desc ++ " configured")+-- | Openid provider, using the simpleid PHP CGI, with apache.+--+-- Runs on usual port by default. When a nonstandard port is specified,+-- apache is limited to listening only on that port. Warning: Specifying+-- a port won't compose well with other apache properties on the same+-- host.+--+-- It's probably a good idea to put this property inside a docker or+-- systemd-nspawn container.+providerFor :: [User] -> HostName -> Maybe Port -> Property HasInfo+providerFor users hn mp = propertyList desc $ props+	& Apt.serviceInstalledRunning "apache2"+	& apacheconfigured+	& Apt.installed ["simpleid"]+		`onChange` Apache.restarted+	& File.fileProperty (desc ++ " configured") 		(map setbaseurl) "/etc/simpleid/config.inc"-	] ++ map identfile users+	& propertyList desc (map identfile users)   where+	baseurl = hn ++ case mp of+		Nothing -> ""+		Just (Port p) -> ':' : show p 	url = "http://"++baseurl++"/simpleid" 	desc = "openid provider " ++ url 	setbaseurl l 		| "SIMPLEID_BASE_URL" `isInfixOf` l =  			"define('SIMPLEID_BASE_URL', '"++url++"');" 		| otherwise = l+	+	apacheconfigured = case mp of+		Nothing -> toProp $+			Apache.virtualHost hn (Port 80) "/var/www/html"+		Just p -> propertyList desc $ props+			& Apache.listenPorts [p]+			& Apache.virtualHost hn p "/var/www/html" 	 	-- the identities directory controls access, so open up 	-- file mode

src/Propellor/Property/Parted.hs view

@@ -21,7 +21,7 @@ 	installed, ) where -import Propellor+import Propellor.Base import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Partition as Partition import Utility.DataUnits

src/Propellor/Property/Partition.hs view

@@ -2,7 +2,7 @@  module Propellor.Property.Partition where -import Propellor+import Propellor.Base import qualified Propellor.Property.Apt as Apt  -- | Filesystems etc that can be used for a partition.

src/Propellor/Property/Postfix.hs view

@@ -2,7 +2,7 @@  module Propellor.Property.Postfix where -import Propellor+import Propellor.Base import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.File as File import qualified Propellor.Property.Service as Service

src/Propellor/Property/Prosody.hs view

@@ -2,11 +2,10 @@  module Propellor.Property.Prosody where -import Propellor+import Propellor.Base import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Service as Service-import System.Posix.Files  type ConfigFile = [String] @@ -15,18 +14,16 @@ confEnabled :: Conf -> ConfigFile -> RevertableProperty confEnabled conf cf = enable <!> disable   where-	enable = check test prop+	enable = dir `File.isSymlinkedTo` target 		`describe` ("prosody conf enabled " ++ conf) 		`requires` confAvailable conf cf 		`requires` installed 		`onChange` reloaded 	  where-		test = not <$> doesFileExist (confValPath conf)-		prop = property "prosody conf in place" $ makeChange $-			createSymbolicLink target dir 		target = confValRelativePath conf 		dir = confValPath conf-		confValRelativePath conf' = "../conf.avail" </> conf' <.> "cfg.lua"+		confValRelativePath conf' = File.LinkTarget $+			"../conf.avail" </> conf' <.> "cfg.lua" 	disable = trivial $ File.notPresent (confValPath conf) 		`describe` ("prosody conf disabled " ++ conf) 		`requires` installed

src/Propellor/Property/Reboot.hs view

@@ -1,6 +1,6 @@ module Propellor.Property.Reboot where -import Propellor+import Propellor.Base  now :: Property NoInfo now = cmdProperty "reboot" []

src/Propellor/Property/Rsync.hs view

@@ -1,6 +1,6 @@ module Propellor.Property.Rsync where -import Propellor+import Propellor.Base import qualified Propellor.Property.Apt as Apt  type Src = FilePath

src/Propellor/Property/Scheduled.hs view

@@ -9,7 +9,7 @@ 	, YearDay 	) where -import Propellor+import Propellor.Base import Utility.Scheduled  import Data.Time.Clock

src/Propellor/Property/Service.hs view

@@ -1,6 +1,6 @@ module Propellor.Property.Service where -import Propellor+import Propellor.Base  type ServiceName = String

src/Propellor/Property/SiteSpecific/Branchable.hs view

@@ -1,6 +1,6 @@ module Propellor.Property.SiteSpecific.Branchable where -import Propellor+import Propellor.Base import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.File as File import qualified Propellor.Property.User as User@@ -50,7 +50,9 @@ 		, "lru-size = 128" 		] 	& Gpg.keyImported (Gpg.GpgKeyId obnamkey) (User "root")-	& Ssh.keyImported SshRsa (User "root") (Context "branchable.com")+	& Ssh.userKeys (User "root") (Context "branchable.com")+		[ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC2PqTSupwncqeffNwZQXacdEWp7L+TxllIxH7WjfRMb3U74mQxWI0lwqLVW6Fox430DvhSqF1y5rJBvTHh4i49Tc9lZ7mwAxA6jNOP6bmdfteaKKYmUw5qwtJW0vISBFu28qBO11Nq3uJ1D3Oj6N+b3mM/0D3Y3NoGgF8+2dLdi81u9+l6AQ5Jsnozi2Ni/Osx2oVGZa+IQDO6gX8VEP4OrcJFNJe8qdnvItcGwoivhjbIfzaqNNvswKgGzhYLOAS5KT8HsjvIpYHWkyQ5QUX7W/lqGSbjP+6B8C3tkvm8VLXbmaD+aSkyCaYbuoXC2BoJdS7Jh8phKMwPJmdYVepn")+		] 	& Ssh.knownHost hosts "eubackup.kitenet.net" (User "root") 	& Ssh.knownHost hosts "usw-s002.rsync.net" (User "root")

src/Propellor/Property/SiteSpecific/GitAnnexBuilder.hs view

@@ -2,7 +2,7 @@  module Propellor.Property.SiteSpecific.GitAnnexBuilder where -import Propellor+import Propellor.Base import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.User as User import qualified Propellor.Property.Cron as Cron

src/Propellor/Property/SiteSpecific/GitHome.hs view

@@ -1,6 +1,6 @@ module Propellor.Property.SiteSpecific.GitHome where -import Propellor+import Propellor.Base import qualified Propellor.Property.Apt as Apt import Propellor.Property.User

src/Propellor/Property/SiteSpecific/IABak.hs view

@@ -1,6 +1,6 @@ module Propellor.Property.SiteSpecific.IABak where -import Propellor+import Propellor.Base import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Git as Git import qualified Propellor.Property.Cron as Cron@@ -26,7 +26,7 @@ gitServer knownhosts = propertyList "iabak git server" $ props 	& Git.cloned (User "root") repo "/usr/local/IA.BAK" (Just "server") 	& Git.cloned (User "root") repo "/usr/local/IA.BAK/client" (Just "master")-	& Ssh.keyImported SshRsa (User "root") (Context "IA.bak.users.git")+	& Ssh.userKeys (User "root") (Context "IA.bak.users.git") sshKeys 	& Ssh.knownHost knownhosts "gitlab.com" (User "root") 	& Git.cloned (User "root") userrepo "/usr/local/IA.BAK/pubkeys" (Just "master") 	& Apt.serviceInstalledRunning "apache2"@@ -45,7 +45,7 @@ registrationServer :: [Host] -> Property HasInfo registrationServer knownhosts = propertyList "iabak registration server" $ props 	& User.accountFor (User "registrar")-	& Ssh.keyImported SshRsa (User "registrar") (Context "IA.bak.users.git")+	& Ssh.userKeys (User "registrar") (Context "IA.bak.users.git") sshKeys 	& Ssh.knownHost knownhosts "gitlab.com" (User "registrar") 	& Git.cloned (User "registrar") repo "/home/registrar/IA.BAK" (Just "server") 	& Git.cloned (User "registrar") userrepo "/home/registrar/users" (Just "master")@@ -59,6 +59,11 @@ 		`requires` File.dirExists "/etc/kgb-bot/"   where 	link = "/usr/lib/cgi-bin/register.cgi"++sshKeys :: [(SshKeyType, Ssh.PubKeyText)]+sshKeys = +	[ (SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQCoiE+CPiIQyfWnl/E9iKG3eo4QzlH30vi7xAgKolGaTu6qKy4XPtl+8MNm2Dqn9QEYRVyyOT/XH0yP5dRc6uyReT8dBy03MmLkVbj8Q+nKCz5YOMTxrY3sX6RRXU1zVGjeVd0DtC+rKRT7reoCxef42LAJTm8nCyZu/enAuso5qHqBbqulFz2YXEKfU1SEEXLawtvgGck1KmCyg+pqazeI1eHWXrojQf5isTBKfPQLWVppBkWAf5cA4wP5U1vN9dVirIdw66ds1M8vnGlkTBjxP/HLGBWGYhZHE7QXjXRsk2RIXlHN9q6GdNu8+F3HXS22mst47E4UAeRoiXSMMtF5")+	]  graphiteServer :: Property HasInfo graphiteServer = propertyList "iabak graphite server" $ props

src/Propellor/Property/SiteSpecific/JoeySites.hs view

@@ -3,7 +3,7 @@  module Propellor.Property.SiteSpecific.JoeySites where -import Propellor+import Propellor.Base import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.File as File import qualified Propellor.Property.Gpg as Gpg@@ -137,7 +137,10 @@ 		, "--client-name=spool" 		, "--ssh-key=" ++ keyfile 		] Obnam.OnlyClient-		`requires` Ssh.keyImported' (Just keyfile) SshRsa (User "root") (Context "olduse.net")+		`requires` Ssh.userKeyAt (Just keyfile)+			(User "root")+			(Context "olduse.net")+			(SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQD0F6L76SChMCIGmeyGhlFMUTgZ3BoTbATiOSs0A7KXQoI1LTE5ZtDzzUkrQRJVpJ640pfMR7cQZyBm8tv+kYIPp0238GrX43c1vgm0L78agDnBU7r2iNMyWIwhssK8O3ZAhp8Q4KCz1r8hP2nIiD0y1D1VWW8h4KWOS7I1XCEAjOTvFvEjTh6a9MyHrcIkv7teUUzTBRjNrsyijCFRk1+pEET54RueoOmEjQcWd/sK1tYRiMZjegRLBOus2wUWsUOvznJ2iniLONUTGAWRnEV+O7hLN6CD44osJ+wkZk8bPAumTS0zcSLckX1jpdHJicmAyeniWSd4FCqm1YE6/xDD") 		`requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root") 	keyfile = "/root/.ssh/olduse.net.key" @@ -183,13 +186,18 @@ 	& Apt.serviceInstalledRunning "mumble-server" 	& Obnam.backup "/var/lib/mumble-server" (Cron.Times "55 5 * * *") 		[ "--repository=sftp://2318@usw-s002.rsync.net/~/" ++ hn ++ ".obnam"+		, "--ssh-key=" ++ sshkey 		, "--client-name=mumble" 		] Obnam.OnlyClient-		`requires` Ssh.keyImported SshRsa (User "root") (Context hn)+		`requires` Ssh.userKeyAt (Just sshkey)+			(User "root")+ 			(Context hn)+			(SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQDSXXSM3mM8SNu+qel9R/LkDIkjpV3bfpUtRtYv2PTNqicHP+DdoThrr0ColFCtLH+k2vQJvR2n8uMzHn53Dq2IO3TtD27+7rJSsJwAZ8oftNzuTir8IjAwX5g6JYJs+L0Ny4RB0ausd+An0k/CPMRl79zKxpZd2MBMDNXt8hyqu0vS0v1ohq5VBEVhBBvRvmNQvWOCj7PdrKQXpUBHruZOeVVEdUUXZkVc1H0t7LVfJnE+nGKyWbw2jM+7r3Rn5Semc4R1DxsfaF8lKkZyE88/5uZQ/ddomv8ptz6YZ5b+Bg6wfooWPC3RWAALjxnHaC2yN1VONAvHmT0uNn1o6v0b") 		`requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root") 	& trivial (cmdProperty "chown" ["-R", "mumble-server:mumble-server", "/var/lib/mumble-server"])   where 	hn = "mumble.debian.net"+	sshkey = "/root/.ssh/mumble.debian.net.key"  -- git.kitenet.net and git.joeyh.name gitServer :: [Host] -> Property HasInfo@@ -199,7 +207,10 @@ 		, "--ssh-key=" ++ sshkey 		, "--client-name=wren" -- historical 		] Obnam.OnlyClient (Gpg.GpgKeyId "1B169BE1")-		`requires` Ssh.keyImported' (Just sshkey) SshRsa (User "root") (Context "git.kitenet.net")+		`requires` Ssh.userKeyAt (Just sshkey)+			(User "root")+			(Context "git.kitenet.net")+			(SshRsa, "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQD0F6L76SChMCIGmeyGhlFMUTgZ3BoTbATiOSs0A7KXQoI1LTE5ZtDzzUkrQRJVpJ640pfMR7cQZyBm8tv+kYIPp0238GrX43c1vgm0L78agDnBU7r2iNMyWIwhssK8O3ZAhp8Q4KCz1r8hP2nIiD0y1D1VWW8h4KWOS7I1XCEAjOTvFvEjTh6a9MyHrcIkv7teUUzTBRjNrsyijCFRk1+pEET54RueoOmEjQcWd/sK1tYRiMZjegRLBOus2wUWsUOvznJ2iniLONUTGAWRnEV+O7hLN6CD44osJ+wkZk8bPAumTS0zcSLckX1jpdHJicmAyeniWSd4FCqm1YE6/xDD") 		`requires` Ssh.knownHost hosts "usw-s002.rsync.net" (User "root") 		`requires` Ssh.authorizedKeys (User "family") (Context "git.kitenet.net") 		`requires` User.accountFor (User "family")

+ src/Propellor/Property/Spin.hs view

@@ -0,0 +1,160 @@+{-# LANGUAGE FlexibleInstances, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}++module Propellor.Property.Spin (+	Spinnable(..),+	controllerFor,+	controllerKeys,+	controlledBy,+) where++import Propellor.Base+import Propellor.Spin (spin, SpinMode(..))+import Propellor.Types.Info+import qualified Propellor.Property.Ssh as Ssh++import qualified Data.Set as S++-- | A class of things that can be spinned.+class Spinnable t where+	toSpin :: t -> Property HasInfo++instance Spinnable Host where+	toSpin h = infoProperty desc go (mkControllingInfo h <> privinfo) []+		`requires` Ssh.knownHost [h] (hostName h) (User "root")+	  where+		desc = cdesc (hostName h)+		go = do+			thishost <- ask+			if isControllerLoop thishost h+				then errorMessage $ unwords+					[ "controller loop detected involving"+					, hostName thishost+					, "and"+					, hostName h+					]+				else do+					liftIO $ spin ControllingSpin (hostName h) h+					-- Don't know if the spin made a+					-- change to the remote host or not,+					-- but in any case, the+					-- local host was not changed.+					noChange+		-- Make the controlling host have all the remote host's+		-- PrivData, so it can send it on to the remote host+		-- when spinning it.+		privinfo = addInfo mempty $+			forceHostContext (hostName h) $+				getInfo (hostInfo h)++-- | Each Host in the list is spinned in turn. Does not stop on spin+-- failure; does propagate overall success/failure.+instance Spinnable [Host] where+	toSpin l = propertyList (cdesc $ unwords $ map hostName l) (map toSpin l)++-- | The Host that has this Property is in control of running propellor on+-- some other Hosts.+--+-- Making a host a controller eliminates the need to manually run+-- propellor --spin to update the controlled hosts. Each time+-- propellor is run on the controller host, it will in turn run+-- propellor on the controlled Hosts.+--+-- The controller needs to be able to ssh to the hosts it controls,+-- and run propellor, as root. The controller is automatically configured+-- with `Propellor.Property.Ssh.knownHost` to know the host keys of the +-- hosts that it will ssh to. It's up to you to use `controllerKeys`+-- and `controlledBy` to set up the ssh keys that will let the controller+-- log into the hosts it controls.+--+-- For example, if you have some webservers and a dnsserver,+-- and want a master that runs propellor on all of them:+--+-- > import Propellor+-- > import qualified Propellor.Property.Spin as Spin+-- > import qualified Propellor.Property.Ssh as Ssh+-- > import qualified Propellor.Property.Cron as Cron+-- > +-- > main = defaultMain hosts+-- >+-- > hosts =+-- > 	[ master+-- >	, dnsserver+-- >	] ++ webservers+-- > +-- > dnsserver = host "dns.example.com"+-- >	& Ssh.hostKeys hostContext [(SshEd25519, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIB3BJ2GqZiTR2LEoDXyYFgh/BduWefjdKXAsAtzS9zeI")]+-- >    & Spin.controlledBy master+-- >	& ...+-- > +-- > webservers =+-- >    [ host "www1.example.com"+-- >		& Ssh.hostKeys hostContext [(SshEd25519, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAICfFntnesZcYz2B2T41ay45igfckXRSh5uVffkuCQkLv")]+-- > 		& Spin.controlledBy master+-- >		& ...+-- >	, ...+-- >	]+-- >+-- > master = host "master.example.com"+-- >	& Spin.controllerKeys [(SshEd25519, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIFWD0Hau5FDLeNrDHKilNMKm9c68R3WD+NJOp2jPWvJV")]+-- > 	-- Only update dnsserver once all webservers are successfully updated.+-- >	& Spin.controllerFor dnsserver+-- >		`requires` Spin.controllerFor webservers+-- >	& Cron.runPropellor+--+-- Multiple controllers can control the same hosts. However, when+-- propellor is already running on a host, a controller will fail+-- to run it. So, if two controllers both try to control the same+-- host at the same time, one will fail.+--+-- Chains of controllers are supported; host A can control host B which+-- controls host C. Loops of controllers are automatically prevented.+--+-- Note that a controller can see all PrivInfo of the hosts it controls.+controllerFor :: Spinnable h => h -> Property HasInfo+controllerFor h = toSpin h+	`requires` Ssh.installed++-- | Uses `Propellor.Property.Ssh.keysImported` to set up the ssh keys+-- for the root user on a controller. +--+-- (The corresponding private keys come from the privdata.)+controllerKeys :: [(SshKeyType, Ssh.PubKeyText)] -> Property HasInfo+controllerKeys ks = Ssh.userKeys (User "root") hostContext ks+	`requires` Ssh.installed++-- | Use this property to let the specified controller Host ssh in+-- and run propellor.+controlledBy :: Host -> Property NoInfo+controlledBy h = User "root" `Ssh.authorizedKeysFrom` (User "root", h)+	`requires` Ssh.installed++cdesc :: String -> Desc+cdesc n = "controller for " ++ n++-- To detect loops of controlled hosts, each Host's info contains a list+-- of the hosts it's controlling.+newtype Controlling = Controlled [Host]+	deriving (Typeable, Monoid, Show)++isControlledBy :: Host -> Controlling -> Bool+h `isControlledBy` (Controlled hs) = any (== hostName h) (map hostName hs)++instance IsInfo Controlling where+	propagateInfo _ = True++mkControllingInfo :: Host -> Info+mkControllingInfo controlled = addInfo mempty (Controlled [controlled])++getControlledBy :: Host -> Controlling+getControlledBy = getInfo . hostInfo++isControllerLoop :: Host -> Host -> Bool+isControllerLoop controller controlled = go S.empty controlled+  where+	go checked h+		| controller `isControlledBy` c = True+		-- avoid checking loops that have been checked before+		| hostName h `S.member` checked = False+		| otherwise = any (go (S.insert (hostName h) checked)) l+	  where+		c@(Controlled l) = getControlledBy h

src/Propellor/Property/Ssh.hs view

@@ -1,7 +1,10 @@ {-# LANGUAGE DeriveDataTypeable #-}  module Propellor.Property.Ssh (+	installed,+	restarted, 	PubKeyText,+	-- * Daemon configuration 	sshdConfig, 	ConfigKeyword, 	setSshdConfigBool,@@ -10,34 +13,43 @@ 	permitRootLogin, 	passwordAuthentication, 	noPasswords,-	hasAuthorizedKeys,-	authorizedKey,-	restarted,+	listenPort,+	-- * Host keys 	randomHostKeys, 	hostKeys, 	hostKey,-	pubKey,-	getPubKey,-	keyImported,-	keyImported',+	hostPubKey,+	getHostPubKey,+	-- * User keys and configuration+	userKeys,+	userKeyAt, 	knownHost,+	authorizedKeysFrom, 	authorizedKeys,-	listenPort+	authorizedKey,+	hasAuthorizedKeys,+	getUserPubKeys, ) where -import Propellor+import Propellor.Base import qualified Propellor.Property.File as File import qualified Propellor.Property.Service as Service+import qualified Propellor.Property.Apt as Apt import Propellor.Property.User import Propellor.Types.Info import Utility.FileMode  import System.PosixCompat import qualified Data.Map as M+import qualified Data.Set as S import Data.List -type PubKeyText = String+installed :: Property NoInfo+installed = Apt.installed ["ssh"] +restarted :: Property NoInfo+restarted = Service.restarted "ssh"+ sshBool :: Bool -> String sshBool True = "yes" sshBool False = "no"@@ -95,14 +107,26 @@ 	d <- dotDir user 	return $ d </> f +-- | Makes the ssh server listen on a given port, in addition to any other+-- ports it is configured to listen on.+--+-- Revert to prevent it listening on a particular port.+listenPort :: Int -> RevertableProperty+listenPort port = enable <!> disable+  where+	portline = "Port " ++ show port+	enable = sshdConfig `File.containsLine` portline+		`describe` ("ssh listening on " ++ portline)+		`onChange` restarted+	disable = sshdConfig `File.lacksLine` portline+		`describe` ("ssh not listening on " ++ portline)+		`onChange` restarted+ hasAuthorizedKeys :: User -> IO Bool hasAuthorizedKeys = go <=< dotFile "authorized_keys"   where 	go f = not . null <$> catchDefaultIO "" (readFile f) -restarted :: Property NoInfo-restarted = Service.restarted "ssh"- -- | Blows away existing host keys and make new ones. -- Useful for systems installed from an image that might reuse host keys. -- A flag file is used to only ever do this once.@@ -118,6 +142,9 @@ 		ensureProperty $ scriptProperty  			[ "DPKG_MAINTSCRIPT_NAME=postinst DPKG_MAINTSCRIPT_PACKAGE=openssh-server /var/lib/dpkg/info/openssh-server.postinst configure" ] +-- | The text of a ssh public key, for example, "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAIB3BJ2GqZiTR2LEoDXyYFgh/BduWefjdKXAsAtzS9zeI"+type PubKeyText = String+ -- | Installs the specified list of ssh host keys. -- -- The corresponding private keys come from the privdata.@@ -146,29 +173,25 @@ -- the private key comes from the privdata;  hostKey :: IsContext c => c -> SshKeyType -> PubKeyText -> Property HasInfo hostKey context keytype pub = combineProperties desc-	[ pubKey keytype pub-	, toProp $ property desc $ install writeFile True (lines pub)+	[ hostPubKey keytype pub+	, toProp $ property desc $ install File.hasContent True (lines pub) 	, withPrivData (keysrc "" (SshPrivKey keytype "")) context $ \getkey -> 		property desc $ getkey $-			install writeFileProtected False . privDataLines+			install File.hasContentProtected False . privDataLines 	] 	`onChange` restarted   where 	desc = "ssh host key configured (" ++ fromKeyType keytype ++ ")" 	install writer ispub keylines = do 		let f = keyFile keytype ispub-		have <- liftIO $ catchDefaultIO "" $ readFileStrict f-		let want = keyFileContent keylines-		if have == want-			then noChange-			else makeChange $ writer f want+		ensureProperty $ writer f (keyFileContent keylines) 	keysrc ext field = PrivDataSourceFileFromCommand field ("sshkey"++ext) 		("ssh-keygen -t " ++ sshKeyTypeParam keytype ++ " -f sshkey")  -- Make sure that there is a newline at the end; -- ssh requires this for some types of private keys.-keyFileContent :: [String] -> String-keyFileContent keylines = unlines (keylines ++ [""])+keyFileContent :: [String] -> [File.Line]+keyFileContent keylines = keylines ++ [""]  keyFile :: SshKeyType -> Bool -> FilePath keyFile keytype ispub = "/etc/ssh/ssh_host_" ++ fromKeyType keytype ++ "_key" ++ ext@@ -178,80 +201,106 @@ -- | Indicates the host key that is used by a Host, but does not actually -- configure the host to use it. Normally this does not need to be used; -- use 'hostKey' instead.-pubKey :: SshKeyType -> PubKeyText -> Property HasInfo-pubKey t = pureInfoProperty "ssh pubkey known" . SshPubKeyInfo . M.singleton t+hostPubKey :: SshKeyType -> PubKeyText -> Property HasInfo+hostPubKey t = pureInfoProperty "ssh pubkey known" . HostKeyInfo . M.singleton t -getPubKey :: Propellor (M.Map SshKeyType PubKeyText)-getPubKey = fromSshPubKeyInfo <$> askInfo+getHostPubKey :: Propellor (M.Map SshKeyType PubKeyText)+getHostPubKey = fromHostKeyInfo <$> askInfo -newtype SshPubKeyInfo = SshPubKeyInfo -	{ fromSshPubKeyInfo :: M.Map SshKeyType PubKeyText }-	deriving (Eq, Ord, Typeable)+newtype HostKeyInfo = HostKeyInfo +	{ fromHostKeyInfo :: M.Map SshKeyType PubKeyText }+	deriving (Eq, Ord, Typeable, Show) -instance IsInfo SshPubKeyInfo where-	propigateInfo _ = False+instance IsInfo HostKeyInfo where+	propagateInfo _ = False -instance Monoid SshPubKeyInfo where-	mempty = SshPubKeyInfo M.empty-	mappend (SshPubKeyInfo old) (SshPubKeyInfo new) = +instance Monoid HostKeyInfo where+	mempty = HostKeyInfo M.empty+	mappend (HostKeyInfo old) (HostKeyInfo new) =  		-- new first because union prefers values from the first 		-- parameter when there is a duplicate key-		SshPubKeyInfo (new `M.union` old)+		HostKeyInfo (new `M.union` old) --- | Sets up a user with a ssh private key and public key pair from the--- PrivData.------ If the user already has a private/public key, it is left unchanged.-keyImported :: IsContext c => SshKeyType -> User -> c -> Property HasInfo-keyImported = keyImported' Nothing+userPubKeys :: User -> [(SshKeyType, PubKeyText)] -> Property HasInfo+userPubKeys u@(User n) l = pureInfoProperty ("ssh pubkey for " ++ n) $+	UserKeyInfo (M.singleton u (S.fromList l)) --- | A file can be speficied to write the key to somewhere other than--- usual. Allows a user to have multiple keys for different roles.-keyImported' :: IsContext c => Maybe FilePath -> SshKeyType -> User -> c -> Property HasInfo-keyImported' dest keytype user@(User u) context = combineProperties desc-	[ installkey (SshPubKey keytype u) (install writeFile ".pub")-	, installkey (SshPrivKey keytype u) (install writeFileProtected "")-	]+getUserPubKeys :: User -> Propellor [(SshKeyType, PubKeyText)]+getUserPubKeys u = maybe [] S.toList . M.lookup u . fromUserKeyInfo <$> askInfo++newtype UserKeyInfo = UserKeyInfo+	{ fromUserKeyInfo :: M.Map User (S.Set (SshKeyType, PubKeyText)) }+	deriving (Eq, Ord, Typeable, Show)++instance IsInfo UserKeyInfo where+	propagateInfo _ = False++instance Monoid UserKeyInfo where+	mempty = UserKeyInfo M.empty+	mappend (UserKeyInfo old) (UserKeyInfo new) = +		UserKeyInfo (M.unionWith S.union old new)++-- | Sets up a user with the specified public keys, and the corresponding+-- private keys from the privdata.+-- +-- The public keys are added to the Info, so other properties like+-- `authorizedKeysFrom` can use them.+userKeys :: IsContext c => User -> c -> [(SshKeyType, PubKeyText)] -> Property HasInfo+userKeys user@(User name) context ks = combineProperties desc $+	userPubKeys user ks : map (userKeyAt Nothing user context) ks   where+	desc = unwords+		[ name+		, "has ssh key"+		, "(" ++ unwords (map (fromKeyType . fst) ks) ++ ")"+		]++-- | Sets up a user with the specified pubic key, and a private+-- key from the privdata.+--+-- A file can be specified to write the key to somewhere other than+-- the default locations. Allows a user to have multiple keys for+-- different roles.+userKeyAt :: IsContext c => Maybe FilePath -> User -> c -> (SshKeyType, PubKeyText) -> Property HasInfo+userKeyAt dest user@(User u) context (keytype, pubkeytext) =+	combineProperties desc $ props+		& pubkey+		& privkey+  where 	desc = unwords $ catMaybes 		[ Just u 		, Just "has ssh key" 		, dest 		, Just $ "(" ++ fromKeyType keytype ++ ")" 		]-	installkey p a = withPrivData p context $ \getkey ->-		property desc $ getkey a+	pubkey = property desc $ install File.hasContent ".pub" [pubkeytext]+	privkey = withPrivData (SshPrivKey keytype u) context $ \getkey -> +		property desc $ getkey $+			install File.hasContentProtected "" . privDataLines 	install writer ext key = do 		f <- liftIO $ keyfile ext-		ifM (liftIO $ doesFileExist f)-			( noChange-			, ensureProperties-				[ property desc $ makeChange $ do-					createDirectoryIfMissing True (takeDirectory f)-					writer f (keyFileContent (privDataLines key))-				, File.ownerGroup f user (userGroup user)-				, File.ownerGroup (takeDirectory f) user (userGroup user)-				]-			)+		ensureProperty $ combineProperties desc+			[ writer f (keyFileContent key)+			, File.ownerGroup f user (userGroup user)+			, File.ownerGroup (takeDirectory f) user (userGroup user)+			] 	keyfile ext = case dest of 		Nothing -> do 			home <- homeDirectory <$> getUserEntryForName u 			return $ home </> ".ssh" </> "id_" ++ fromKeyType keytype ++ ext 		Just f -> return $ f ++ ext -- fromKeyType :: SshKeyType -> String fromKeyType SshRsa = "rsa" fromKeyType SshDsa = "dsa" fromKeyType SshEcdsa = "ecdsa" fromKeyType SshEd25519 = "ed25519" --- | Puts some host's ssh public key(s), as set using 'pubKey' or 'hostKey'--- into the known_hosts file for a user.+-- | Puts some host's ssh public key(s), as set using `hostPubKey`+-- or `hostKey` into the known_hosts file for a user. knownHost :: [Host] -> HostName -> User -> Property NoInfo knownHost hosts hn user@(User u) = property desc $-	go =<< fromHost hosts hn getPubKey+	go =<< fromHost hosts hn getHostPubKey   where 	desc = u ++ " knows ssh key for " ++ hn 	go (Just m) | not (M.null m) = do@@ -264,23 +313,41 @@ 			, File.ownerGroup (takeDirectory f) user (userGroup user) 			] 	go _ = do-		warningMessage $ "no configred pubKey for " ++ hn+		warningMessage $ "no configured ssh host keys for " ++ hn 		return FailedChange +-- | Ensures that a local user's authorized keys contains a line allowing+-- logins from a remote user on the specified Host.+--+-- The ssh keys of the remote user can be set using `keysImported`+--+-- Any other lines in the authorized_keys file are preserved as-is.+authorizedKeysFrom :: User -> (User, Host) -> Property NoInfo+localuser@(User ln) `authorizedKeysFrom` (remoteuser@(User rn), remotehost) = +	property desc $ go =<< fromHost' remotehost (getUserPubKeys remoteuser)+  where+	remote = rn ++ "@" ++ hostName remotehost+	desc = ln ++ " authorized_keys from " ++ remote+	go [] = do+		warningMessage $ "no configured ssh user keys for " ++ remote+		return FailedChange+	go ks = ensureProperty $ combineProperties desc $+		map (authorizedKey localuser . snd) ks+ -- | Makes a user have authorized_keys from the PrivData -- -- This removes any other lines from the file. authorizedKeys :: IsContext c => User -> c -> Property HasInfo authorizedKeys user@(User u) context = withPrivData (SshAuthorizedKeys u) context $ \get ->-	property (u ++ " has authorized_keys") $ get $ \v -> do+	property desc $ get $ \v -> do 		f <- liftIO $ dotFile "authorized_keys" user-		liftIO $ do-			createDirectoryIfMissing True (takeDirectory f)-			writeFileProtected f (keyFileContent (privDataLines v))-		ensureProperties -			[ File.ownerGroup f user (userGroup user)+		ensureProperty $ combineProperties desc+			[ File.hasContentProtected f (keyFileContent (privDataLines v))+			, File.ownerGroup f user (userGroup user) 			, File.ownerGroup (takeDirectory f) user (userGroup user)-			] +			]+  where+	desc = u ++ " has authorized_keys"  -- | Ensures that a user's authorized_keys contains a line. -- Any other lines in the file are preserved as-is.@@ -295,19 +362,4 @@ 		, File.ownerGroup (takeDirectory f) user (userGroup user) 		]   where-	desc = u ++ " has autorized_keys"---- | Makes the ssh server listen on a given port, in addition to any other--- ports it is configured to listen on.------ Revert to prevent it listening on a particular port.-listenPort :: Int -> RevertableProperty-listenPort port = enable <!> disable-  where-	portline = "Port " ++ show port-	enable = sshdConfig `File.containsLine` portline-		`describe` ("ssh listening on " ++ portline)-		`onChange` restarted-	disable = sshdConfig `File.lacksLine` portline-		`describe` ("ssh not listening on " ++ portline)-		`onChange` restarted+	desc = u ++ " has authorized_keys"

src/Propellor/Property/Sudo.hs view

@@ -2,7 +2,7 @@  import Data.List -import Propellor+import Propellor.Base import Propellor.Property.File import qualified Propellor.Property.Apt as Apt import Propellor.Property.User

src/Propellor/Property/Systemd.hs view

@@ -40,7 +40,7 @@ 	bindRo, ) where -import Propellor+import Propellor.Base import Propellor.Types.Chroot import Propellor.Types.Container import Propellor.Types.Info@@ -62,8 +62,8 @@ 	deriving (Show)  instance PropAccum Container where-	(Container n c h) & p = Container n c (h & p)-	(Container n c h) &^ p = Container n c (h &^ p)+	(Container n c h) `addProp` p = Container n c (h `addProp` p)+	(Container n c h) `addPropFront` p = Container n c (h `addPropFront` p) 	getProperties (Container _ _ h) = hostProperties h  -- | Starts a systemd service.@@ -187,7 +187,8 @@ 	& resolvConfed 	& linkJournal   where-	c@(Chroot.Chroot _ system _ _) = mkchroot (containerDir name)+	c = mkchroot (containerDir name)+	system = Chroot.chrootSystem c 	h = Host name [] mempty  -- | Runs a container using systemd-nspawn.@@ -205,7 +206,7 @@ -- Reverting this property stops the container, removes the systemd unit, -- and deletes the chroot and all its contents. nspawned :: Container -> RevertableProperty-nspawned c@(Container name (Chroot.Chroot loc system builderconf _) h) =+nspawned c@(Container name (Chroot.Chroot loc system builder _) h) = 	p `describe` ("nspawned " ++ name)   where 	p = enterScript c@@ -216,7 +217,7 @@ 	-- Chroot provisioning is run in systemd-only mode, 	-- which sets up the chroot and ensures systemd and dbus are 	-- installed, but does not handle the other provisions.-	chrootprovisioned = Chroot.provisioned' (Chroot.propigateChrootInfo chroot) chroot True+	chrootprovisioned = Chroot.provisioned' (Chroot.propagateChrootInfo chroot) chroot True  	-- Use nsenter to enter container and and run propellor to 	-- finish provisioning.@@ -225,7 +226,7 @@ 			<!> 		doNothing -	chroot = Chroot.Chroot loc system builderconf h+	chroot = Chroot.Chroot loc system builder h  -- | Sets up the service file for the container, and then starts -- it running.@@ -254,8 +255,9 @@ 		<$> servicefilecontent 		<*> catchDefaultIO "" (readFile servicefile) -	writeservicefile = property servicefile $ makeChange $-		viaTmp writeFile servicefile =<< servicefilecontent+	writeservicefile = property servicefile $ makeChange $ do+		c <- servicefilecontent+		File.viaStableTmp (\t -> writeFile t c) servicefile  	setupservicefile = check (not <$> goodservicefile) $ 		-- if it's running, it has the wrong configuration,@@ -376,8 +378,8 @@ -- -- > foo :: Host -- > foo = host "foo.example.com"--- >	& Systemd.running Systemd.networkd -- >	& Systemd.nspawned webserver+-- > 		`requires` Systemd.running Systemd.networkd -- > -- > webserver :: Systemd.container -- > webserver = Systemd.container "webserver" (Chroot.debootstrapped (System (Debian Testing) "amd64") mempty)

src/Propellor/Property/Systemd/Core.hs view

@@ -1,6 +1,6 @@ module Propellor.Property.Systemd.Core where -import Propellor+import Propellor.Base import qualified Propellor.Property.Apt as Apt  -- dbus is only a Recommends of systemd, but is needed for communication

src/Propellor/Property/Tor.hs view

@@ -1,6 +1,6 @@ module Propellor.Property.Tor where -import Propellor+import Propellor.Base import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Service as Service

src/Propellor/Property/Unbound.hs view

@@ -17,7 +17,7 @@ 	, cachingDnsServer 	) where -import Propellor+import Propellor.Base import Propellor.Property.File import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Service as Service

src/Propellor/Property/User.hs view

@@ -2,7 +2,7 @@  import System.Posix -import Propellor+import Propellor.Base import qualified Propellor.Property.File as File  data Eep = YesReallyDeleteHome

+ src/Propellor/Property/Uwsgi.hs view

@@ -0,0 +1,49 @@+-- | Maintainer: Félix Sipma <felix+propellor@gueux.org>++module Propellor.Property.Uwsgi where++import Propellor.Base+import qualified Propellor.Property.File as File+import qualified Propellor.Property.Apt as Apt+import qualified Propellor.Property.Service as Service++type ConfigFile = [String]++type AppName = String++appEnabled :: AppName -> ConfigFile -> RevertableProperty+appEnabled an cf = enable <!> disable+  where+	enable = appVal an `File.isSymlinkedTo` appValRelativeCfg an+		`describe` ("uwsgi app enabled " ++ an)+		`requires` appAvailable an cf+		`requires` installed+		`onChange` reloaded+	disable = trivial $ File.notPresent (appVal an)+		`describe` ("uwsgi app disable" ++ an)+		`requires` installed+		`onChange` reloaded++appAvailable :: AppName -> ConfigFile -> Property NoInfo+appAvailable an cf = ("uwsgi app available " ++ an) ==>+	appCfg an `File.hasContent` (comment : cf)+  where+	comment = "# deployed with propellor, do not modify"++appCfg :: AppName -> FilePath+appCfg an = "/etc/uwsgi/apps-available/" ++ an++appVal :: AppName -> FilePath+appVal an = "/etc/uwsgi/apps-enabled/" ++ an++appValRelativeCfg :: AppName -> File.LinkTarget+appValRelativeCfg an = File.LinkTarget $ "../apps-available/" ++ an++installed :: Property NoInfo+installed = Apt.installed ["uwsgi"]++restarted :: Property NoInfo+restarted = Service.restarted "uwsgi"++reloaded :: Property NoInfo+reloaded = Service.reloaded "uwsgi"

src/Propellor/Protocol.hs view

@@ -11,7 +11,7 @@  import Data.List -import Propellor+import Propellor.Base  data Stage = NeedGitClone | NeedRepoUrl | NeedPrivData | NeedGitPush | NeedPrecompiled 	deriving (Read, Show, Eq)

src/Propellor/Shim.hs view

@@ -6,7 +6,7 @@  module Propellor.Shim (setup, cleanEnv, file) where -import Propellor+import Propellor.Base import Utility.LinuxMkLibs import Utility.FileMode import Utility.FileSystemEncoding

src/Propellor/Spin.hs view

@@ -1,5 +1,6 @@ module Propellor.Spin ( 	commitSpin,+	SpinMode(..), 	spin, 	update, 	gitPushHelper,@@ -16,7 +17,7 @@ import qualified Data.Set as S import Network.Socket (getAddrInfo, defaultHints, AddrInfo(..), AddrInfoFlag(..), SockAddr) -import Propellor+import Propellor.Base import Propellor.Protocol import Propellor.PrivData.Paths import Propellor.Git@@ -40,20 +41,26 @@ 		void $ actionMessage "Push to central git repository" $ 			boolSystem "git" [Param "push"] -spin :: HostName -> Maybe HostName -> Host -> IO ()-spin target relay hst = do+data SpinMode+	= RegularSpin+	| RelaySpin HostName+	| ControllingSpin+	deriving (Eq)++spin :: SpinMode -> HostName -> Host -> IO ()+spin spinmode target hst = do 	cacheparams <- if viarelay 		then pure ["-A"] 		else toCommand <$> sshCachingParams hn 	when viarelay $ 		void $ boolSystem "ssh-add" [] -	sshtarget <- ("root@" ++) <$> case relay of-		Just r -> pure r-		Nothing -> getSshTarget target hst+	sshtarget <- ("root@" ++) <$> case spinmode of+		RelaySpin r -> pure r+		_ -> getSshTarget target hst  	-- Install, or update the remote propellor.-	updateServer target relay hst+	updateServer target spinmode hst 		(proc "ssh" $ cacheparams ++ [sshtarget, shellWrap probecmd]) 		(proc "ssh" $ cacheparams ++ [sshtarget, shellWrap updatecmd]) @@ -61,10 +68,14 @@ 	unlessM (boolSystem "ssh" (map Param $ cacheparams ++ ["-t", sshtarget, shellWrap runcmd])) $ 		error "remote propellor failed"   where-	hn = fromMaybe target relay+	hn = case spinmode of+		RelaySpin h -> h+		_ -> target -	relaying = relay == Just target-	viarelay = isJust relay && not relaying+	relaying = spinmode == RelaySpin target+	viarelay = not relaying && case spinmode of+		RelaySpin _ -> True+		_ -> False  	probecmd = intercalate " ; " 		[ "if [ ! -d " ++ localdir ++ "/.git ]"@@ -169,20 +180,22 @@  updateServer 	:: HostName-	-> Maybe HostName+	-> SpinMode 	-> Host 	-> CreateProcess 	-> CreateProcess 	-> IO ()-updateServer target relay hst connect haveprecompiled =+updateServer target spinmode hst connect haveprecompiled = 	withIOHandles createProcessSuccess connect go   where-	hn = fromMaybe target relay-	relaying = relay == Just target+	hn = case spinmode of+		RelaySpin h -> h+		_ -> target+	relaying = spinmode == RelaySpin target  	go (toh, fromh) = do 		let loop = go (toh, fromh)-		let restart = updateServer hn relay hst connect haveprecompiled+		let restart = updateServer hn spinmode hst connect haveprecompiled 		let done = return () 		v <- maybe Nothing readish <$> getMarked fromh statusMarker 		case v of@@ -190,7 +203,7 @@ 				sendRepoUrl toh 				loop 			(Just NeedPrivData) -> do-				sendPrivData hn hst toh relaying+				sendPrivData hn toh =<< getprivdata 				loop 			(Just NeedGitClone) -> do 				hClose toh@@ -201,31 +214,36 @@ 				hClose toh 				hClose fromh 				sendPrecompiled hn-				updateServer hn relay hst haveprecompiled (error "loop")+				updateServer hn spinmode hst haveprecompiled (error "loop") 			(Just NeedGitPush) -> do 				sendGitUpdate hn fromh toh 				hClose fromh 				hClose toh 				done 			Nothing -> done--sendRepoUrl :: Handle -> IO ()-sendRepoUrl toh = sendMarked toh repoUrlMarker =<< (fromMaybe "" <$> getRepoUrl)--sendPrivData :: HostName -> Host -> Handle -> Bool -> IO ()-sendPrivData hn hst toh relaying = do-	privdata <- getdata-	void $ actionMessage ("Sending privdata (" ++ show (length privdata) ++ " bytes) to " ++ hn) $ do-		sendMarked toh privDataMarker privdata-		return True-  where-	getdata+	getprivdata 		| relaying = do 			let f = privDataRelay hn 			d <- readFileStrictAnyEncoding f 			nukeFile f 			return d-		| otherwise = show . filterPrivData hst <$> decryptPrivData+		| otherwise = case spinmode of+			-- When one host is controlling another,+			-- the controlling host's privdata includes the+			-- privdata of the controlled host.+			ControllingSpin -> show . filterPrivData hst . readPrivData+				<$> readFileStrictAnyEncoding privDataLocal+			_ -> show . filterPrivData hst <$> decryptPrivData++sendRepoUrl :: Handle -> IO ()+sendRepoUrl toh = sendMarked toh repoUrlMarker =<< (fromMaybe "" <$> getRepoUrl)++sendPrivData :: HostName -> Handle -> String -> IO ()+sendPrivData hn toh privdata = void $ actionMessage msg $ do+	sendMarked toh privDataMarker privdata+	return True+  where+	msg = "Sending privdata (" ++ show (length privdata) ++ " bytes) to " ++ hn  sendGitUpdate :: HostName -> Handle -> Handle -> IO () sendGitUpdate hn fromh toh =

src/Propellor/Ssh.hs view

@@ -1,6 +1,6 @@ module Propellor.Ssh where -import Propellor+import Propellor.Base import Utility.UserInfo  import System.PosixCompat

src/Propellor/Types.hs view

@@ -10,12 +10,12 @@  module Propellor.Types 	( Host(..)-	, Desc 	, Property 	, Info 	, HasInfo 	, NoInfo 	, CInfo+	, Desc 	, infoProperty 	, simpleProperty 	, adjustPropertySatisfy@@ -27,7 +27,6 @@ 	, IsProp(..) 	, Combines(..) 	, CombinedType-	, before 	, combineWith 	, Propellor(..) 	, EndAction(..)@@ -93,6 +92,12 @@ -- | The core data type of Propellor, this represents a property -- that the system should have, and an action to ensure it has the -- property.+--+-- A property can have associated `Info` or not. This is tracked at the+-- type level with Property `NoInfo` and Property `HasInfo`.+--+-- There are many instances and type families, which are mostly used+-- internally, so you needn't worry about them. data Property i where 	IProperty :: Desc -> Propellor Result -> Info -> [Property HasInfo] -> Property HasInfo 	SProperty :: Desc -> Propellor Result -> [Property NoInfo] -> Property NoInfo@@ -164,17 +169,17 @@ propertyChildren (IProperty _ _ _ cs) = cs propertyChildren (SProperty _ _ cs) = cs --- | A property that can be reverted.+-- | A property that can be reverted. The first Property is run+-- normally and the second is run when it's reverted. data RevertableProperty = RevertableProperty (Property HasInfo) (Property HasInfo) --- | Makes a revertable property; the first Property is run--- normally and the second is run when it's reverted.+-- | Shorthand to construct a revertable property. (<!>) :: Property i1 -> Property i2 -> RevertableProperty p1 <!> p2 = RevertableProperty (toIProperty p1) (toIProperty p2) +-- | Class of types that can be used as properties of a host. class IsProp p where-	-- | Sets description.-	describe :: p -> Desc -> p+	setDesc :: p -> Desc -> p 	toProp :: p -> Property HasInfo 	getDesc :: p -> Desc 	-- | Gets the info of the property, combined with all info@@ -182,28 +187,28 @@ 	getInfoRecursive :: p -> Info  instance IsProp (Property HasInfo) where-	describe (IProperty _ a i cs) d = IProperty d a i cs+	setDesc (IProperty _ a i cs) d = IProperty d a i cs 	toProp = id 	getDesc = propertyDesc 	getInfoRecursive (IProperty _ _ i cs) =  		i <> mconcat (map getInfoRecursive cs) instance IsProp (Property NoInfo) where-	describe (SProperty _ a cs) d = SProperty d a cs+	setDesc (SProperty _ a cs) d = SProperty d a cs 	toProp = toIProperty 	getDesc = propertyDesc 	getInfoRecursive _ = mempty  instance IsProp RevertableProperty where 	-- | Sets the description of both sides.-	describe (RevertableProperty p1 p2) d = -		RevertableProperty (describe p1 d) (describe p2 ("not " ++ d))+	setDesc (RevertableProperty p1 p2) d = +		RevertableProperty (setDesc p1 d) (setDesc p2 ("not " ++ d)) 	getDesc (RevertableProperty p1 _) = getDesc p1 	toProp (RevertableProperty p1 _) = p1 	-- | Return the Info of the currently active side. 	getInfoRecursive (RevertableProperty p1 _p2) = getInfoRecursive p1 --- | Type level calculation of the type that results from combining two types--- with `requires`.+-- | Type level calculation of the type that results from combining two+-- types of properties. type family CombinedType x y type instance CombinedType (Property x) (Property y) = Property (CInfo x y) type instance CombinedType RevertableProperty (Property NoInfo) = RevertableProperty@@ -211,15 +216,11 @@ type instance CombinedType RevertableProperty RevertableProperty = RevertableProperty  class Combines x y where-	-- | Indicates that the first property depends on the second,-	-- so before the first is ensured, the second will be ensured.-	requires :: x -> y -> CombinedType x y-	--- | Combines together two properties, resulting in one property--- that ensures the first, and if the first succeeds, ensures the second.--- The property uses the description of the first property.-before :: (IsProp x, Combines y x, IsProp (CombinedType y x)) => x -> y -> CombinedType y x-before x y = (y `requires` x) `describe` getDesc x+	-- | Combines two properties. The second property is ensured+	-- first, and only once it is successfully ensures will the first+	-- be ensured. The combined property will have the description of+	-- the first property.+	(<<>>) :: x -> y -> CombinedType x y  -- | Combines together two properties, yielding a property that -- has the description and info of the first, and that has the second@@ -231,36 +232,36 @@ 	-> Property x 	-> Property y 	-> CombinedType (Property x) (Property y)-combineWith f x y = adjustPropertySatisfy (x `requires` y) $ \_ ->+combineWith f x y = adjustPropertySatisfy (x <<>> y) $ \_ -> 	f (propertySatisfy $ toSProperty x) (propertySatisfy $ toSProperty y)  instance Combines (Property HasInfo) (Property HasInfo) where-	requires (IProperty d1 a1 i1 cs1) y@(IProperty _d2 a2 _i2 _cs2) =+	(IProperty d1 a1 i1 cs1) <<>> y@(IProperty _d2 a2 _i2 _cs2) = 		IProperty d1 (a2 <> a1) i1 (y : cs1)  instance Combines (Property HasInfo) (Property NoInfo) where-	requires (IProperty d1 a1 i1 cs1) y@(SProperty _d2 a2 _cs2) =+	(IProperty d1 a1 i1 cs1) <<>> y@(SProperty _d2 a2 _cs2) = 		IProperty d1 (a2 <> a1) i1 (toIProperty y : cs1)  instance Combines (Property NoInfo) (Property HasInfo) where-	requires (SProperty d1 a1 cs1) y@(IProperty _d2 a2 _i2 _cs2) =+	(SProperty d1 a1 cs1) <<>> y@(IProperty _d2 a2 _i2 _cs2) = 		IProperty d1 (a2 <> a1) mempty (y : map toIProperty cs1)  instance Combines (Property NoInfo) (Property NoInfo) where-	requires (SProperty d1 a1  cs1) y@(SProperty _d2 a2 _cs2) =+	(SProperty d1 a1  cs1) <<>> y@(SProperty _d2 a2 _cs2) = 		SProperty d1 (a2 <> a1) (y : cs1)  instance Combines RevertableProperty (Property HasInfo) where-	requires (RevertableProperty p1 p2) y =-		RevertableProperty (p1 `requires` y) p2+	(RevertableProperty p1 p2) <<>> y =+		RevertableProperty (p1 <<>> y) p2  instance Combines RevertableProperty (Property NoInfo) where-	requires (RevertableProperty p1 p2) y =-		RevertableProperty (p1 `requires` toIProperty y) p2+	(RevertableProperty p1 p2) <<>> y =+		RevertableProperty (p1 <<>> toIProperty y) p2  instance Combines RevertableProperty RevertableProperty where-	requires (RevertableProperty x1 x2) (RevertableProperty y1 y2) =+	(RevertableProperty x1 x2) <<>> (RevertableProperty y1 y2) = 		RevertableProperty-			(x1 `requires` y1)+			(x1 <<>> y1) 			-- when reverting, run actions in reverse order-			(y2 `requires` x2)+			(y2 <<>> x2)

src/Propellor/Types/Chroot.hs view

@@ -16,7 +16,7 @@ 	deriving (Show, Typeable)  instance IsInfo ChrootInfo where-	propigateInfo _ = False+	propagateInfo _ = False  instance Monoid ChrootInfo where 	mempty = ChrootInfo mempty mempty

src/Propellor/Types/CmdLine.hs view

@@ -5,12 +5,14 @@  import System.Posix.Types +-- | All the command line actions that propellor can perform. data CmdLine 	= Run HostName 	| Spin [HostName] (Maybe HostName) 	| SimpleRun HostName 	| Set PrivDataField Context 	| Unset PrivDataField Context+	| UnsetUnused 	| Dump PrivDataField Context 	| Edit PrivDataField Context 	| ListFields@@ -27,4 +29,3 @@ 	| GitPush Fd Fd 	| Check 	deriving (Read, Show, Eq)-

src/Propellor/Types/Dns.hs view

@@ -26,7 +26,7 @@ 	deriving (Show, Eq, Ord, Monoid, Typeable)  instance IsInfo AliasesInfo where-	propigateInfo _ = False+	propagateInfo _ = False  toAliasesInfo :: [HostName] -> AliasesInfo toAliasesInfo l = AliasesInfo (S.fromList l)@@ -40,10 +40,10 @@ toDnsInfo :: S.Set Record -> DnsInfo toDnsInfo = DnsInfo --- | DNS Info is propigated, so that eg, aliases of a container+-- | DNS Info is propagated, so that eg, aliases of a container -- are reflected in the dns for the host where it runs. instance IsInfo DnsInfo where-	propigateInfo _ = True+	propagateInfo _ = True  -- | Represents a bind 9 named.conf file. data NamedConf = NamedConf@@ -155,7 +155,7 @@ 	deriving (Eq, Ord, Show, Typeable)  instance IsInfo NamedConfMap where-	propigateInfo _ = False+	propagateInfo _ = False  -- | Adding a Master NamedConf stanza for a particulr domain always -- overrides an existing Secondary stanza for that domain, while a

src/Propellor/Types/Docker.hs view

@@ -16,7 +16,7 @@ 	deriving (Show, Typeable)  instance IsInfo DockerInfo where-	propigateInfo _ = False+	propagateInfo _ = False  instance Monoid DockerInfo where 	mempty = DockerInfo mempty mempty

src/Propellor/Types/Info.hs view

@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE GADTs, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}  module Propellor.Types.Info ( 	Info,@@ -6,7 +6,7 @@ 	addInfo, 	getInfo, 	mapInfo,-	propigatableInfo,+	propagatableInfo, 	InfoVal(..), 	fromInfoVal, 	Typeable,@@ -17,59 +17,65 @@ import Data.Maybe  -- | Information about a Host, which can be provided by its properties.-data Info = Info [(Dynamic, Bool)]+newtype Info = Info [InfoEntry]+	deriving (Monoid, Show) -instance Show Info where-	show (Info l) = "Info " ++ show (map (dynTypeRep . fst) l)+data InfoEntry where+	InfoEntry :: (IsInfo v, Typeable v) => v -> InfoEntry -instance Monoid Info where- 	mempty = Info []-	mappend (Info a) (Info b) = Info (a <> b)+instance Show InfoEntry where+	show (InfoEntry v) = show v +-- Extracts the value from an InfoEntry but only when+-- it's of the requested type.+extractInfoEntry :: Typeable v => InfoEntry -> Maybe v+extractInfoEntry (InfoEntry v) = cast v+ -- | Values stored in Info must be members of this class. -- -- This is used to avoid accidentially using other data types -- as info, especially type aliases which coud easily lead to bugs. -- We want a little bit of dynamic types here, but not too far..-class (Typeable v, Monoid v) => IsInfo v where-	-- | Should info of this type be propigated out of a+class (Typeable v, Monoid v, Show v) => IsInfo v where+	-- | Should info of this type be propagated out of a 	-- container to its Host?-	propigateInfo :: v -> Bool+	propagateInfo :: v -> Bool  -- | Any value in the `IsInfo` type class can be added to an Info. addInfo :: IsInfo v => Info -> v -> Info-addInfo (Info l) v = Info ((toDyn v, propigateInfo v):l)+addInfo (Info l) v = Info (InfoEntry v:l) +-- The list is reversed here because addInfo builds it up in reverse order. getInfo :: IsInfo v => Info -> v-getInfo (Info l) = mconcat (mapMaybe (fromDynamic . fst) (reverse l))+getInfo (Info l) = mconcat (mapMaybe extractInfoEntry (reverse l))  -- | Maps a function over all values stored in the Info that are of the -- appropriate type. mapInfo :: IsInfo v => (v -> v) -> Info -> Info mapInfo f (Info l) = Info (map go l)   where-	go (i, p) = case fromDynamic i of-		Nothing -> (i, p)-		Just v -> (toDyn (f v), p)+	go i = case extractInfoEntry i of+		Nothing -> i+		Just v -> InfoEntry (f v) --- | Filters out parts of the Info that should not propigate out of a+-- | Filters out parts of the Info that should not propagate out of a -- container.-propigatableInfo :: Info -> Info-propigatableInfo (Info l) = Info (filter snd l)+propagatableInfo :: Info -> Info+propagatableInfo (Info l) = Info (filter (\(InfoEntry a) -> propagateInfo a) l)  -- | Use this to put a value in Info that is not a monoid.--- The last value set will be used. This info does not propigate+-- The last value set will be used. This info does not propagate -- out of a container. data InfoVal v = NoInfoVal | InfoVal v-	deriving (Typeable)+	deriving (Typeable, Show)  instance Monoid (InfoVal v) where 	mempty = NoInfoVal 	mappend _ v@(InfoVal _) = v 	mappend v NoInfoVal = v -instance Typeable v => IsInfo (InfoVal v) where-	propigateInfo _ = False+instance (Typeable v, Show v) => IsInfo (InfoVal v) where+	propagateInfo _ = False  fromInfoVal :: InfoVal v -> Maybe v fromInfoVal NoInfoVal = Nothing

src/Propellor/Types/OS.hs view

@@ -40,8 +40,12 @@ type Architecture = String  type UserName = String+ newtype User = User UserName+	deriving (Eq, Ord, Show)+ newtype Group = Group String+	deriving (Eq, Ord, Show)  -- | Makes a Group with the same name as the User. userGroup :: User -> Group

src/Propellor/Types/PrivData.hs view

@@ -12,7 +12,7 @@ -- It's fine to add new constructors. data PrivDataField 	= DockerAuthentication-	| SshPubKey SshKeyType UserName+	| SshPubKey SshKeyType UserName -- ^ Not used anymore, but retained to avoid breaking serialization of old files 	| SshPrivKey SshKeyType UserName -- ^ For host key, use empty UserName 	| SshAuthorizedKeys UserName 	| Password UserName

+ src/Propellor/Utilities.hs view

@@ -0,0 +1,27 @@+-- | Re-exports some of propellor's internal utility modules.+--+-- These are used in the implementation of propellor, including some of its+-- properties. However, there is no API stability; any of these can change+-- or be removed without a major version number increase. +--+-- Use outside propellor at your own risk.++module Propellor.Utilities (+	  module Utility.PartialPrelude+	, module Utility.Process+	, module Utility.Exception+	, module Utility.Env+	, module Utility.Directory+	, module Utility.Tmp+	, module Utility.Monad+	, module Utility.Misc+) where++import Utility.PartialPrelude+import Utility.Process+import Utility.Exception+import Utility.Env+import Utility.Directory+import Utility.Tmp+import Utility.Monad+import Utility.Misc

src/config.hs view

@@ -2,13 +2,12 @@ -- the propellor program.  import Propellor-import Propellor.CmdLine-import Propellor.Property.Scheduled import qualified Propellor.Property.File as File import qualified Propellor.Property.Apt as Apt import qualified Propellor.Property.Network as Network --import qualified Propellor.Property.Ssh as Ssh import qualified Propellor.Property.Cron as Cron+import Propellor.Property.Scheduled --import qualified Propellor.Property.Sudo as Sudo import qualified Propellor.Property.User as User --import qualified Propellor.Property.Hostname as Hostname@@ -19,25 +18,25 @@ main = defaultMain hosts  -- The hosts propellor knows about.--- Edit this to configure propellor! hosts :: [Host] hosts =-	[ host "mybox.example.com"-		& os (System (Debian Unstable) "amd64")-		& Apt.stdSourcesList-		& Apt.unattendedUpgrades-		& Apt.installed ["etckeeper"]-		& Apt.installed ["ssh"]-		& User.hasSomePassword (User "root")-		& Network.ipv6to4-		& File.dirExists "/var/www"-		& Docker.docked webserverContainer-		& Docker.garbageCollected `period` Daily-		& Cron.runPropellor (Cron.Times "30 * * * *")--	-- add more hosts here...-	--, host "foo.example.com" = ...+	[ mybox 	]++-- An example host.+mybox :: Host+mybox = host "mybox.example.com"+	& os (System (Debian Unstable) "amd64")+	& Apt.stdSourcesList+	& Apt.unattendedUpgrades+	& Apt.installed ["etckeeper"]+	& Apt.installed ["ssh"]+	& User.hasSomePassword (User "root")+	& Network.ipv6to4+	& File.dirExists "/var/www"+	& Docker.docked webserverContainer+	& Docker.garbageCollected `period` Daily+	& Cron.runPropellor (Cron.Times "30 * * * *")  -- A generic webserver in a Docker container. webserverContainer :: Docker.Container