diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,11 @@ +propellor (4.0.6) unstable; urgency=medium + + * Fix bug that sometimes made --spin fail with + "fatal: Couldn't find remote ref HEAD" + * Display error and warning messages to stderr, not stdout. + + -- Joey Hess Sun, 18 Jun 2017 19:30:50 -0400 + propellor (4.0.5) unstable; urgency=medium * Switch cabal file from Extensions to Default-Extensions to fix diff --git a/config-freebsd.hs b/config-freebsd.hs --- a/config-freebsd.hs +++ b/config-freebsd.hs @@ -59,7 +59,7 @@ -- A generic webserver in a Docker container. webserverContainer :: Docker.Container webserverContainer = Docker.container "webserver" (Docker.latestImage "debian") $ props - & osDebian' KFreeBSD (Stable "jessie") X86_64 + & osDebian' KFreeBSD (Stable "stretch") X86_64 & Apt.stdSourcesList & Docker.publish "80:80" & Docker.volume "/var/www:/var/www" diff --git a/debian/changelog b/debian/changelog --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,11 @@ +propellor (4.0.6) unstable; urgency=medium + + * Fix bug that sometimes made --spin fail with + "fatal: Couldn't find remote ref HEAD" + * Display error and warning messages to stderr, not stdout. + + -- Joey Hess Sun, 18 Jun 2017 19:30:50 -0400 + propellor (4.0.5) unstable; urgency=medium * Switch cabal file from Extensions to Default-Extensions to fix diff --git a/joeyconfig.hs b/joeyconfig.hs --- a/joeyconfig.hs +++ b/joeyconfig.hs @@ -50,7 +50,6 @@ , gnu , dragon , clam - , mayfly , orca , baleen , honeybee @@ -124,7 +123,7 @@ clam = host "clam.kitenet.net" $ props & standardSystem Unstable X86_64 ["Unreliable server. Anything here may be lost at any time!" ] - & ipv4 "64.137.231.62" + & ipv4 "64.137.239.3" & CloudAtCost.decruft & Ssh.hostKeys hostContext @@ -133,7 +132,6 @@ , (SshEcdsa, "ecdsa-sha2-nistp256 AAAAE2VjZHNhLXNoYTItbmlzdHAyNTYAAAAIbmlzdHAyNTYAAABBBPhfvcOuw0Yt+MnsFc4TI2gWkKi62Eajxz+TgbHMO/uRTYF8c5V8fOI3o+J/3m5+lT0S5o8j8a7xIC3COvi+AVw=") ] & Apt.unattendedUpgrades - & Network.ipv6to4 & Systemd.persistentJournal & Journald.systemMaxUse "50MiB" @@ -147,22 +145,6 @@ & alias "scroll.joeyh.name" & alias "us.scroll.joeyh.name" -mayfly :: Host -mayfly = host "mayfly.kitenet.net" $ props - & standardSystem (Stable "jessie") X86_64 - [ "Scratch VM. Contents can change at any time!" ] - & ipv4 "167.88.36.193" - - & CloudAtCost.decruft - & Apt.unattendedUpgrades - & Network.ipv6to4 - & Systemd.persistentJournal - & Journald.systemMaxUse "500MiB" - - & Tor.isRelay - & Tor.named "kite3" - & Tor.bandwidthRate (Tor.PerMonth "400 GB") - baleen :: Host baleen = host "baleen.kitenet.net" $ props & standardSystem Unstable X86_64 [ "New git-annex build box." ] @@ -468,6 +450,7 @@ & alias "dist-bugs.kitenet.net" & alias "family.kitenet.net" + & osDebian (Stable "jessie") X86_64 & Apt.installed ["linux-image-amd64"] & Apt.unattendedUpgrades & Branchable.server hosts @@ -478,7 +461,7 @@ keysafe = host "keysafe.joeyh.name" $ props & ipv4 "139.59.17.168" & Hostname.sane - & osDebian (Stable "jessie") X86_64 + & osDebian (Stable "stretch") X86_64 & Apt.stdSourcesList `onChange` Apt.upgrade & Apt.unattendedUpgrades & DigitalOcean.distroKernel @@ -567,7 +550,7 @@ kiteShellBox :: Systemd.Container kiteShellBox = Systemd.debContainer "kiteshellbox" $ props - & standardContainer (Stable "jessie") + & standardContainer (Stable "stretch") & JoeySites.kiteShellBox type Motd = [String] diff --git a/propellor.cabal b/propellor.cabal --- a/propellor.cabal +++ b/propellor.cabal @@ -1,5 +1,5 @@ Name: propellor -Version: 4.0.4 +Version: 4.0.6 Cabal-Version: >= 1.20 License: BSD2 Maintainer: Joey Hess diff --git a/src/Propellor/Info.hs b/src/Propellor/Info.hs --- a/src/Propellor/Info.hs +++ b/src/Propellor/Info.hs @@ -84,13 +84,13 @@ -- It also lets the type checker know that all the properties of the -- host must support Debian. -- --- > & osDebian (Stable "jessie") X86_64 +-- > & osDebian (Stable "stretch") X86_64 osDebian :: DebianSuite -> Architecture -> Property (HasInfo + Debian) osDebian = osDebian' Linux -- Use to specify a different `DebianKernel` than the default `Linux` -- --- > & osDebian' KFreeBSD (Stable "jessie") X86_64 +-- > & osDebian' KFreeBSD (Stable "stretch") X86_64 osDebian' :: DebianKernel -> DebianSuite -> Architecture -> Property (HasInfo + Debian) osDebian' kernel suite arch = tightenTargets $ os (System (Debian kernel suite) arch) diff --git a/src/Propellor/Message.hs b/src/Propellor/Message.hs --- a/src/Propellor/Message.hs +++ b/src/Propellor/Message.hs @@ -102,7 +102,7 @@ warningMessage :: MonadIO m => String -> m () warningMessage s = liftIO $ - outputConcurrent =<< colorLine Vivid Magenta ("** warning: " ++ s) + errorConcurrent =<< colorLine Vivid Magenta ("** warning: " ++ s) infoMessage :: MonadIO m => [String] -> m () infoMessage ls = liftIO $ outputConcurrent $ concatMap (++ "\n") ls @@ -113,7 +113,7 @@ -- property fail. Propellor will continue to the next property. errorMessage :: MonadIO m => String -> m a errorMessage s = liftIO $ do - outputConcurrent =<< colorLine Vivid Red ("** error: " ++ s) + errorConcurrent =<< colorLine Vivid Red ("** error: " ++ s) -- Normally this exception gets caught and is not displayed, -- and propellor continues. So it's only displayed if not -- caught, and so we say, cannot continue. diff --git a/src/Propellor/Protocol.hs b/src/Propellor/Protocol.hs --- a/src/Propellor/Protocol.hs +++ b/src/Propellor/Protocol.hs @@ -53,7 +53,11 @@ hFlush h getMarked :: Handle -> Marker -> IO (Maybe String) -getMarked h marker = go =<< catchMaybeIO (hGetLine h) +getMarked h marker = do + -- Avoid buffering anything in Handle, so that the data after + -- the marker will be available to be read from the underlying Fd. + hSetBuffering stdin NoBuffering + go =<< catchMaybeIO (hGetLine h) where go Nothing = return Nothing go (Just l) = case fromMarked marker l of @@ -65,8 +69,8 @@ debug ["received marked", marker] return (Just v) -req :: Stage -> Marker -> (String -> IO ()) -> IO () -req stage marker a = do +reqMarked :: Stage -> Marker -> (String -> IO ()) -> IO () +reqMarked stage marker a = do debug ["requested marked", marker] sendMarked' stdout statusMarker (show stage) maybe noop a =<< getMarked stdin marker diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs --- a/src/Propellor/Spin.hs +++ b/src/Propellor/Spin.hs @@ -178,34 +178,16 @@ update :: Maybe HostName -> IO () update forhost = do whenM hasGitRepo $ - req NeedRepoUrl repoUrlMarker setRepoUrl + reqMarked NeedRepoUrl repoUrlMarker setRepoUrl makePrivDataDir createDirectoryIfMissing True (takeDirectory privfile) - req NeedPrivData privDataMarker $ + reqMarked NeedPrivData privDataMarker $ writeFileProtected privfile whenM hasGitRepo $ - req NeedGitPush gitPushMarker $ \_ -> do - hin <- dup stdInput - hout <- dup stdOutput - hClose stdin - hClose stdout - -- Not using git pull because git 2.5.0 badly - -- broke its option parser. - unlessM (boolSystemNonConcurrent "git" (pullparams hin hout)) $ - errorMessage "git fetch from client failed" - unlessM (boolSystemNonConcurrent "git" [Param "merge", Param "FETCH_HEAD"]) $ - errorMessage "git merge from client failed" + gitPullFromUpdateServer where - pullparams hin hout = - [ Param "fetch" - , Param "--progress" - , Param "--upload-pack" - , Param $ "./propellor --gitpush " ++ show hin ++ " " ++ show hout - , Param "." - ] - -- When --spin --relay is run, get a privdata file -- to be relayed to the target host. privfile = maybe privDataLocal privDataRelay forhost @@ -336,31 +318,6 @@ , "rm -f " ++ remotetarball ] --- Shim for git push over the propellor ssh channel. --- Reads from stdin and sends it to hout; --- reads from hin and sends it to stdout. -gitPushHelper :: Fd -> Fd -> IO () -gitPushHelper hin hout = void $ fromstdin `concurrently` tostdout - where - fromstdin = do - h <- fdToHandle hout - connect stdin h - tostdout = do - h <- fdToHandle hin - connect h stdout - connect fromh toh = do - hSetBinaryMode fromh True - hSetBinaryMode toh True - b <- B.hGetSome fromh 40960 - if B.null b - then do - hClose fromh - hClose toh - else do - B.hPut toh b - hFlush toh - connect fromh toh - mergeSpin :: IO () mergeSpin = do branch <- getCurrentBranch @@ -388,3 +345,56 @@ spinCommitMessage :: String spinCommitMessage = "propellor spin" + +-- Stdin and stdout are connected to the updateServer over ssh. +-- Request that it run git upload-pack, and connect that up to a git fetch +-- to receive the data. +gitPullFromUpdateServer :: IO () +gitPullFromUpdateServer = reqMarked NeedGitPush gitPushMarker $ \_ -> do + -- Note that this relies on data not being buffered in the stdin + -- Handle, since such buffered data would not be available in the + -- FD passed to git fetch. + hin <- dup stdInput + hout <- dup stdOutput + hClose stdin + hClose stdout + -- Not using git pull because git 2.5.0 badly + -- broke its option parser. + unlessM (boolSystemNonConcurrent "git" (fetchparams hin hout)) $ + errorMessage "git fetch from client failed" + unlessM (boolSystemNonConcurrent "git" [Param "merge", Param "FETCH_HEAD"]) $ + errorMessage "git merge from client failed" + where + fetchparams hin hout = + [ Param "fetch" + , Param "--progress" + , Param "--upload-pack" + , Param $ "./propellor --gitpush " ++ show hin ++ " " ++ show hout + , Param "." + ] + +-- Shim for git push over the propellor ssh channel. +-- Reads from stdin and sends it to hout; +-- reads from hin and sends it to stdout. +gitPushHelper :: Fd -> Fd -> IO () +gitPushHelper hin hout = void $ fromstdin `concurrently` tostdout + where + fromstdin = do + h <- fdToHandle hout + stdin *>* h + tostdout = do + h <- fdToHandle hin + h *>* stdout + +-- Forward data from one handle to another. +(*>*) :: Handle -> Handle -> IO () +fromh *>* toh = do + b <- B.hGetSome fromh 40960 + if B.null b + then do + hClose fromh + hClose toh + else do + B.hPut toh b + hFlush toh + fromh *>* toh diff --git a/src/Propellor/Types/OS.hs b/src/Propellor/Types/OS.hs --- a/src/Propellor/Types/OS.hs +++ b/src/Propellor/Types/OS.hs @@ -59,7 +59,7 @@ deriving (Show, Eq) -- | Debian has several rolling suites, and a number of stable releases, --- such as Stable "jessie". +-- such as Stable "stretch". data DebianSuite = Experimental | Unstable | Testing | Stable Release deriving (Show, Eq)