diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,14 @@ +propellor (5.3.3) unstable; urgency=medium + + * Warn again about new upstream version when ~/.propellor was cloned from the + Debian git bundle using an older version of propellor that set up an + upstream remote. + * Avoid crashing if initial fetch from origin fails when spinning a host. + * Added Propllor.Property.Openssl module contributed by contributed by + Félix Sipma. + + -- Joey Hess Mon, 26 Feb 2018 14:34:37 -0400 + propellor (5.3.2) unstable; urgency=medium * Added Propellor.Property.Atomic, which can make a non-atomic property diff --git a/debian/changelog b/debian/changelog --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,14 @@ +propellor (5.3.3) unstable; urgency=medium + + * Warn again about new upstream version when ~/.propellor was cloned from the + Debian git bundle using an older version of propellor that set up an + upstream remote. + * Avoid crashing if initial fetch from origin fails when spinning a host. + * Added Propllor.Property.Openssl module contributed by contributed by + Félix Sipma. + + -- Joey Hess Mon, 26 Feb 2018 14:34:37 -0400 + propellor (5.3.2) unstable; urgency=medium * Added Propellor.Property.Atomic, which can make a non-atomic property diff --git a/propellor.cabal b/propellor.cabal --- a/propellor.cabal +++ b/propellor.cabal @@ -1,5 +1,5 @@ Name: propellor -Version: 5.3.2 +Version: 5.3.3 Cabal-Version: >= 1.20 License: BSD2 Maintainer: Joey Hess @@ -140,6 +140,7 @@ Propellor.Property.Nginx Propellor.Property.Obnam Propellor.Property.OpenId + Propellor.Property.Openssl Propellor.Property.OS Propellor.Property.Pacman Propellor.Property.Parted diff --git a/src/Propellor/DotDir.hs b/src/Propellor/DotDir.hs --- a/src/Propellor/DotDir.hs +++ b/src/Propellor/DotDir.hs @@ -387,13 +387,12 @@ -- 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 @@ 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 --- a/src/Propellor/Git.hs +++ b/src/Propellor/Git.hs @@ -30,6 +30,10 @@ 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 --- a/src/Propellor/Git/VerifiedBranch.hs +++ b/src/Propellor/Git/VerifiedBranch.hs @@ -30,11 +30,16 @@ -- 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 diff --git a/src/Propellor/Property/Openssl.hs b/src/Propellor/Property/Openssl.hs new file mode 100644 --- /dev/null +++ b/src/Propellor/Property/Openssl.hs @@ -0,0 +1,29 @@ +-- | Maintainer: Félix Sipma + +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 })