summaryrefslogtreecommitdiff
path: root/src/Propellor
diff options
context:
space:
mode:
authorJoey Hess2018-02-27 12:09:46 -0400
committerJoey Hess2018-02-27 12:09:46 -0400
commit3919fa183bce29d4fbdbdcc4bd780e462dd6700f (patch)
tree1e549d69ec771d7f5505b94c93c5843bd44850fb /src/Propellor
parent3e1d8b6b6cbbb4d9560fb0d2ea1aec22e5f19239 (diff)
parent094a6419f7e5ddb0566e10ef4122306187dc00d7 (diff)
Merge branch 'master' into joeyconfig
Diffstat (limited to 'src/Propellor')
-rw-r--r--src/Propellor/DotDir.hs54
-rw-r--r--src/Propellor/Git.hs4
-rw-r--r--src/Propellor/Git/VerifiedBranch.hs11
-rw-r--r--src/Propellor/Property/Atomic.hs2
-rw-r--r--src/Propellor/Property/Openssl.hs29
-rw-r--r--src/Propellor/Property/Systemd.hs4
6 files changed, 82 insertions, 22 deletions
diff --git a/src/Propellor/DotDir.hs b/src/Propellor/DotDir.hs
index f62b38f8..125cec3f 100644
--- a/src/Propellor/DotDir.hs
+++ b/src/Propellor/DotDir.hs
@@ -387,13 +387,12 @@ checkRepoUpToDate = whenM (gitbundleavail <&&> dotpropellorpopulated) $ do
-- into the user's repository, as if fetching from a upstream remote,
-- yielding a new upstream/master branch.
--
--- If there's no upstream/master, the user is not using the distrepo,
--- so do nothing. And, if there's a remote named "upstream", the user
--- must have set that up is not using the distrepo, so do nothing.
+-- If there's no upstream/master, or the repo is not using the distrepo,
+-- do nothing.
updateUpstreamMaster :: String -> IO ()
-updateUpstreamMaster newref = unlessM (hasRemote "upstream") $ do
+updateUpstreamMaster newref = do
changeWorkingDirectory =<< dotPropellor
- go =<< catchMaybeIO getoldrev
+ go =<< getoldref
where
go Nothing = return ()
go (Just oldref) = do
@@ -421,19 +420,42 @@ updateUpstreamMaster newref = unlessM (hasRemote "upstream") $ do
cleantmprepo
warnoutofdate True
- getoldrev = takeWhile (/= '\n')
- <$> readProcess "git" ["show-ref", upstreambranch, "--hash"]
-
git = run "git"
run cmd ps = unlessM (boolSystem cmd (map Param ps)) $
error $ "Failed to run " ++ cmd ++ " " ++ show ps
+ -- Get ref that the upstreambranch points to, only when
+ -- the distrepo is being used.
+ getoldref = do
+ mref <- catchMaybeIO $ takeWhile (/= '\n')
+ <$> readProcess "git" ["show-ref", upstreambranch, "--hash"]
+ case mref of
+ Just _ -> do
+ -- Normally there will be no upstream
+ -- remote when the distrepo is used.
+ -- Older versions of propellor set up
+ -- an upstream remote pointing at the
+ -- distrepo.
+ ifM (hasRemote "upstream")
+ ( do
+ v <- remoteUrl "upstream"
+ return $ case v of
+ Just rurl | rurl == distrepo -> mref
+ _ -> Nothing
+ , return mref
+ )
+ Nothing -> return mref
+
+-- And, if there's a remote named "upstream"
+-- that does not point at the distrepo, the user must have set that up
+-- and is not using the distrepo, so do nothing.
warnoutofdate :: Bool -> IO ()
-warnoutofdate havebranch = do
- warningMessage ("** Your ~/.propellor/ is out of date..")
- let also s = infoMessage [" " ++ s]
- also ("A newer upstream version is available in " ++ distrepo)
- if havebranch
- then also ("To merge it, run: git merge " ++ upstreambranch)
- else also ("To merge it, find the most recent commit in your repository's history that corresponds to an upstream release of propellor, and set refs/remotes/" ++ upstreambranch ++ " to it. Then run propellor again.")
- also ""
+warnoutofdate havebranch = warningMessage $ unlines
+ [ "** Your ~/.propellor/ is out of date.."
+ , indent "A newer upstream version is available in " ++ distrepo
+ , indent $ if havebranch
+ then "To merge it, run: git merge " ++ upstreambranch
+ else "To merge it, find the most recent commit in your repository's history that corresponds to an upstream release of propellor, and set refs/remotes/" ++ upstreambranch ++ " to it. Then run propellor again."
+ ]
+ where
+ indent s = " " ++ s
diff --git a/src/Propellor/Git.hs b/src/Propellor/Git.hs
index 10b88ddd..c446f67a 100644
--- a/src/Propellor/Git.hs
+++ b/src/Propellor/Git.hs
@@ -30,6 +30,10 @@ hasRemote remotename = catchDefaultIO False $ do
rs <- lines <$> readProcess "git" ["remote"]
return $ remotename `elem` rs
+remoteUrl :: String -> IO (Maybe String)
+remoteUrl remotename = catchDefaultIO Nothing $ headMaybe . lines
+ <$> readProcess "git" ["config", "remote." ++ remotename ++ ".url"]
+
hasGitRepo :: IO Bool
hasGitRepo = doesFileExist ".git/HEAD"
diff --git a/src/Propellor/Git/VerifiedBranch.hs b/src/Propellor/Git/VerifiedBranch.hs
index 51fcb573..df607bd2 100644
--- a/src/Propellor/Git/VerifiedBranch.hs
+++ b/src/Propellor/Git/VerifiedBranch.hs
@@ -30,12 +30,17 @@ verifyOriginBranch originbranch = do
-- Returns True if HEAD is changed by fetching and merging from origin.
fetchOrigin :: IO Bool
fetchOrigin = do
+ fetched <- actionMessage "Pull from central git repository" $
+ boolSystem "git" [Param "fetch"]
+ if fetched
+ then mergeOrigin
+ else return False
+
+mergeOrigin :: IO Bool
+mergeOrigin = do
branchref <- getCurrentBranch
let originbranch = "origin" </> branchref
- void $ actionMessage "Pull from central git repository" $
- boolSystem "git" [Param "fetch"]
-
oldsha <- getCurrentGitSha1 branchref
keyring <- privDataKeyring
diff --git a/src/Propellor/Property/Atomic.hs b/src/Propellor/Property/Atomic.hs
index 5db17474..8519048b 100644
--- a/src/Propellor/Property/Atomic.hs
+++ b/src/Propellor/Property/Atomic.hs
@@ -144,7 +144,7 @@ checkDirLink d rp = liftIO $ do
-- Using atomicDirSync in the above example lets git only download
-- the changes once, rather than the same changes being downloaded a second
-- time to update the other copy of the directory the next time propellor
--- runs
+-- runs.
--
-- Suppose that a web server program is run from the git repository,
-- and needs to be restarted after the pull. That restart should be done
diff --git a/src/Propellor/Property/Openssl.hs b/src/Propellor/Property/Openssl.hs
new file mode 100644
index 00000000..a91b8195
--- /dev/null
+++ b/src/Propellor/Property/Openssl.hs
@@ -0,0 +1,29 @@
+-- | Maintainer: FĂ©lix Sipma <felix+propellor@gueux.org>
+
+module Propellor.Property.Openssl where
+
+import Propellor.Base
+import qualified Propellor.Property.Apt as Apt
+import qualified Propellor.Property.File as File
+import Utility.FileMode
+import Utility.SafeCommand
+
+
+installed :: Property DebianLike
+installed = Apt.installed ["openssl"]
+
+dhparamsLength :: Int
+dhparamsLength = 2048
+
+dhparams :: FilePath
+dhparams = "/etc/ssl/private/dhparams.pem"
+
+safeDhparams :: Property DebianLike
+safeDhparams = propertyList "safe dhparams" $ props
+ & File.dirExists (takeDirectory dhparams)
+ & installed
+ & check (not <$> doesFileExist dhparams) (createDhparams dhparams dhparamsLength)
+
+createDhparams :: FilePath -> Int -> Property UnixLike
+createDhparams f l = property ("generate new dhparams: " ++ f) $ liftIO $ withUmask 0o0177 $ withFile f WriteMode $ \h ->
+ cmdResult <$> boolSystem' "openssl" [Param "dhparam", Param (show l)] (\p -> p { std_out = UseHandle h })
diff --git a/src/Propellor/Property/Systemd.hs b/src/Propellor/Property/Systemd.hs
index 51d1313c..8fa236d2 100644
--- a/src/Propellor/Property/Systemd.hs
+++ b/src/Propellor/Property/Systemd.hs
@@ -205,8 +205,8 @@ machined = withOS "machined installed" $ \w o ->
case o of
-- Split into separate debian package since systemd 225.
(Just (System (Debian _ suite) _))
- | not (isStable suite) -> ensureProperty w $
- Apt.installed ["systemd-container"]
+ | not (isStable suite) || suite == (Stable "stretch") ->
+ ensureProperty w $ Apt.installed ["systemd-container"]
_ -> noChange
-- | Defines a container with a given machine name,