diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,14 @@ +propellor (2.17.2) unstable; urgency=medium + + * When new dependencies are added to propellor or the propellor config, + try harder to get them installed. In particular, this makes + propellor --spin work when the remote host needs to get dependencies + installed in order to build the updated config. + * Apt.update: Also run dpkg --configure -a here as apt for some reason + won't even update if dpkg was interrupted. + + -- Joey Hess Wed, 30 Mar 2016 15:45:08 -0400 + propellor (2.17.1) unstable; urgency=medium * Avoid generating excessively long paths to the unix socket file diff --git a/debian/changelog b/debian/changelog --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,14 @@ +propellor (2.17.2) unstable; urgency=medium + + * When new dependencies are added to propellor or the propellor config, + try harder to get them installed. In particular, this makes + propellor --spin work when the remote host needs to get dependencies + installed in order to build the updated config. + * Apt.update: Also run dpkg --configure -a here as apt for some reason + won't even update if dpkg was interrupted. + + -- Joey Hess Wed, 30 Mar 2016 15:45:08 -0400 + propellor (2.17.1) unstable; urgency=medium * Avoid generating excessively long paths to the unix socket file diff --git a/propellor.cabal b/propellor.cabal --- a/propellor.cabal +++ b/propellor.cabal @@ -1,5 +1,5 @@ Name: propellor -Version: 2.17.1 +Version: 2.17.2 Cabal-Version: >= 1.8 License: BSD3 Maintainer: Joey Hess diff --git a/src/Propellor/Bootstrap.hs b/src/Propellor/Bootstrap.hs --- a/src/Propellor/Bootstrap.hs +++ b/src/Propellor/Bootstrap.hs @@ -6,6 +6,7 @@ ) where import Propellor.Base +import Propellor.Types.Info import System.Posix.Files import Data.List @@ -128,22 +129,27 @@ , "DEBIAN_FRONTEND=noninteractive apt-get --no-install-recommends --no-upgrade -y install git" ] -buildPropellor :: IO () -buildPropellor = unlessM (actionMessage "Propellor build" build) $ +buildPropellor :: Maybe Host -> IO () +buildPropellor mh = unlessM (actionMessage "Propellor build" (build msys)) $ errorMessage "Propellor build failed!" + where + msys = case fmap (getInfo . hostInfo) mh of + Just (InfoVal sys) -> Just sys + _ -> Nothing -- Build propellor using cabal, and symlink propellor to where cabal -- leaves the built binary. -- -- For speed, only runs cabal configure when it's not been run before. -- If the build fails cabal may need to have configure re-run. -build :: IO Bool -build = catchBoolIO $ do - make "dist/setup-config" ["propellor.cabal"] $ - cabal ["configure"] - unlessM (cabal ["build", "propellor-config"]) $ do - void $ cabal ["configure"] - unlessM (cabal ["build"]) $ +-- +-- If the cabal configure fails, and a System is provided, installs +-- dependencies and retries. +build :: Maybe System -> IO Bool +build msys = catchBoolIO $ do + make "dist/setup-config" ["propellor.cabal"] cabal_configure + unlessM cabal_build $ + unlessM (cabal_configure <&&> cabal_build) $ error "cabal build failed" -- For safety against eg power loss in the middle of the build, -- make a copy of the binary, and move it into place atomically. @@ -163,6 +169,15 @@ cabalbuiltbin = "dist/build/propellor-config/propellor-config" safetycopy = cabalbuiltbin ++ ".built" tmpfor f = f ++ ".propellortmp" + cabal_configure = ifM (cabal ["configure"]) + ( return True + , case msys of + Nothing -> return False + Just sys -> + boolSystem "sh" [Param "-c", Param (depsCommand (Just sys))] + <&&> cabal ["configure"] + ) + cabal_build = cabal ["build", "propellor-config"] make :: FilePath -> [FilePath] -> IO Bool -> IO () make dest srcs builder = do diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs --- a/src/Propellor/CmdLine.hs +++ b/src/Propellor/CmdLine.hs @@ -114,20 +114,20 @@ go _ (DockerInit hn) = Docker.init hn go _ (GitPush fin fout) = gitPushHelper fin fout go cr (Relay h) = forceConsole >> - updateFirst cr (Update (Just h)) (update (Just h)) + updateFirst Nothing cr (Update (Just h)) (update (Just h)) go _ (Update Nothing) = forceConsole >> fetchFirst (onlyprocess (update Nothing)) go _ (Update (Just h)) = update (Just h) go _ Merge = mergeSpin - go cr cmdline@(Spin hs mrelay) = buildFirst cr cmdline $ do + go cr cmdline@(Spin hs mrelay) = buildFirst Nothing cr cmdline $ do unless (isJust mrelay) commitSpin forM_ hs $ \hn -> withhost hn $ spin mrelay hn go cr cmdline@(Run hn) = ifM ((==) 0 <$> getRealUserID) - ( updateFirst cr cmdline $ runhost hn + ( updateFirst (findHost hostlist hn) cr cmdline $ runhost hn , fetchFirst $ go cr (Spin [hn] Nothing) ) go cr cmdline@(SimpleRun hn) = forceConsole >> - fetchFirst (buildFirst cr cmdline (runhost hn)) + fetchFirst (buildFirst (findHost hostlist hn) cr cmdline (runhost hn)) -- When continuing after a rebuild, don't want to rebuild again. go _ (Continue cmdline) = go NoRebuild cmdline @@ -149,17 +149,17 @@ -- Builds propellor (when allowed) and if it looks like a new binary, -- re-execs it to continue. -- Otherwise, runs the IO action to continue. -buildFirst :: CanRebuild -> CmdLine -> IO () -> IO () -buildFirst CanRebuild cmdline next = do +buildFirst :: Maybe Host -> CanRebuild -> CmdLine -> IO () -> IO () +buildFirst h CanRebuild cmdline next = do oldtime <- getmtime - buildPropellor + buildPropellor h newtime <- getmtime if newtime == oldtime then next else continueAfterBuild cmdline where getmtime = catchMaybeIO $ getModificationTime "propellor" -buildFirst NoRebuild _ next = next +buildFirst _ NoRebuild _ next = next continueAfterBuild :: CmdLine -> IO a continueAfterBuild cmdline = go =<< boolSystem "./propellor" @@ -176,23 +176,23 @@ void fetchOrigin next -updateFirst :: CanRebuild -> CmdLine -> IO () -> IO () -updateFirst canrebuild cmdline next = ifM hasOrigin - ( updateFirst' canrebuild cmdline next +updateFirst :: Maybe Host -> CanRebuild -> CmdLine -> IO () -> IO () +updateFirst h canrebuild cmdline next = ifM hasOrigin + ( updateFirst' h canrebuild cmdline next , next ) -- If changes can be fetched from origin, Builds propellor (when allowed) -- and re-execs the updated propellor binary to continue. -- Otherwise, runs the IO action to continue. -updateFirst' :: CanRebuild -> CmdLine -> IO () -> IO () -updateFirst' CanRebuild cmdline next = ifM fetchOrigin +updateFirst' :: Maybe Host -> CanRebuild -> CmdLine -> IO () -> IO () +updateFirst' h CanRebuild cmdline next = ifM fetchOrigin ( do - buildPropellor + buildPropellor h continueAfterBuild cmdline , next ) -updateFirst' NoRebuild _ next = next +updateFirst' _ NoRebuild _ next = next -- Gets the fully qualified domain name, given a string that might be -- a short name to look up in the DNS. diff --git a/src/Propellor/Property/Apt.hs b/src/Propellor/Property/Apt.hs --- a/src/Propellor/Property/Apt.hs +++ b/src/Propellor/Property/Apt.hs @@ -119,9 +119,11 @@ ] update :: Property NoInfo -update = runApt ["update"] - `assume` MadeChange - `describe` "apt update" +update = combineProperties ("apt update") + [ pendingConfigured + , runApt ["update"] + `assume` MadeChange + ] -- | Have apt upgrade packages, adding new packages and removing old as -- necessary. diff --git a/src/Propellor/Ssh.hs b/src/Propellor/Ssh.hs --- a/src/Propellor/Ssh.hs +++ b/src/Propellor/Ssh.hs @@ -66,11 +66,11 @@ md5 = take 9 $ MD5.md5s $ MD5.Str hn selectSocketFile :: [FilePath] -> FilePath -> FilePath -selectSocketFile [] fallback = fallback +selectSocketFile [] d = d selectSocketFile [f] _ = f -selectSocketFile (f:fs) fallback +selectSocketFile (f:fs) d | valid_unix_socket_path f = f - | otherwise = selectSocketFile fs fallback + | otherwise = selectSocketFile fs d valid_unix_socket_path :: FilePath -> Bool valid_unix_socket_path f = length (decodeW8 f) < 100 - reservedbyssh diff --git a/src/wrapper.hs b/src/wrapper.hs --- a/src/wrapper.hs +++ b/src/wrapper.hs @@ -99,7 +99,7 @@ warnoutofdate propellordir True buildruncfg = do changeWorkingDirectory propellordir - buildPropellor + buildPropellor Nothing putStrLn "" putStrLn "" chain