From 239581c75901c3305eaa9298cf41de28a57bd099 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 22 Nov 2014 20:17:46 -0400 Subject: reorg --- src/Propellor/Spin.hs | 262 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 262 insertions(+) create mode 100644 src/Propellor/Spin.hs (limited to 'src/Propellor/Spin.hs') diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs new file mode 100644 index 00000000..8baf4fd9 --- /dev/null +++ b/src/Propellor/Spin.hs @@ -0,0 +1,262 @@ +module Propellor.Spin ( + spin, + update, + gitPushHelper +) where + +import Data.List +import System.Exit +import System.PosixCompat +import System.Posix.IO +import System.Posix.Directory +import Control.Concurrent.Async +import Control.Exception (bracket) +import qualified Data.ByteString as B + +import Propellor +import Propellor.Protocol +import Propellor.PrivData.Paths +import Propellor.Git +import Propellor.Ssh +import Propellor.Gpg +import qualified Propellor.Shim as Shim +import Utility.FileMode +import Utility.SafeCommand + +spin :: HostName -> Maybe HostName -> Host -> IO () +spin target relay hst = do + unless relaying $ do + void $ actionMessage "Git commit" $ + gitCommit [Param "--allow-empty", Param "-a", Param "-m", Param "propellor spin"] + -- Push to central origin repo first, if possible. + -- The remote propellor will pull from there, which avoids + -- us needing to send stuff directly to the remote host. + whenM hasOrigin $ + void $ actionMessage "Push to central git repository" $ + boolSystem "git" [Param "push"] + + cacheparams <- if viarelay + then pure ["-A"] + else toCommand <$> sshCachingParams hn + when viarelay $ + void $ boolSystem "ssh-add" [] + + -- Install, or update the remote propellor. + updateServer target relay hst $ withBothHandles createProcessSuccess + (proc "ssh" $ cacheparams ++ [user, updatecmd]) + + -- And now we can run it. + unlessM (boolSystem "ssh" (map Param $ cacheparams ++ ["-t", user, runcmd])) $ + error $ "remote propellor failed" + where + hn = fromMaybe target relay + user = "root@"++hn + + relaying = relay == Just target + viarelay = isJust relay && not relaying + + mkcmd = shellWrap . intercalate " ; " + + updatecmd = mkcmd + [ "if [ ! -d " ++ localdir ++ "/.git ]" + , "then (" ++ intercalate " && " + [ "if ! git --version || ! make --version; then apt-get update && apt-get --no-install-recommends --no-upgrade -y install git make; fi" + , "echo " ++ toMarked statusMarker (show NeedGitClone) + ] ++ ") || echo " ++ toMarked statusMarker (show NeedPrecompiled) + , "else " ++ intercalate " && " + [ "cd " ++ localdir + , "if ! test -x ./propellor; then make deps build; fi" + , if viarelay + then "./propellor --continue " ++ + shellEscape (show (Update (Just target))) + -- Still using --boot for back-compat... + else "./propellor --boot " ++ target + ] + , "fi" + ] + + runcmd = mkcmd [ "cd " ++ localdir ++ " && ./propellor " ++ cmd ] + cmd = if viarelay + then "--serialized " ++ shellEscape (show (Spin target (Just target))) + else "--continue " ++ shellEscape (show (SimpleRun target)) + +-- Update the privdata, repo url, and git repo over the ssh +-- connection, talking to the user's local propellor instance which is +-- running the updateServer +update :: Maybe HostName -> IO () +update forhost = do + whenM hasGitRepo $ + req NeedRepoUrl repoUrlMarker setRepoUrl + + makePrivDataDir + createDirectoryIfMissing True (takeDirectory privfile) + req NeedPrivData privDataMarker $ + writeFileProtected privfile + + whenM hasGitRepo $ + req NeedGitPush gitPushMarker $ \_ -> do + hin <- dup stdInput + hout <- dup stdOutput + hClose stdin + hClose stdout + unlessM (boolSystem "git" (pullparams hin hout)) $ + errorMessage "git pull from client failed" + where + pullparams hin hout = + [ Param "pull" + , 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 + +-- The connect action should ssh to the remote host and run the provided +-- calback action. +updateServer :: HostName -> Maybe HostName -> Host -> (((Handle, Handle) -> IO ()) -> IO ()) -> IO () +updateServer target relay hst connect = connect go + where + hn = fromMaybe target relay + relaying = relay == Just target + + go (toh, fromh) = do + let loop = go (toh, fromh) + let restart = updateServer hn relay hst connect + let done = return () + v <- (maybe Nothing readish <$> getMarked fromh statusMarker) + case v of + (Just NeedRepoUrl) -> do + sendRepoUrl toh + loop + (Just NeedPrivData) -> do + sendPrivData hn hst toh relaying + loop + (Just NeedGitClone) -> do + hClose toh + hClose fromh + sendGitClone hn + restart + (Just NeedPrecompiled) -> do + hClose toh + hClose fromh + sendPrecompiled hn + restart + (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 + | relaying = do + let f = privDataRelay hn + d <- readFileStrictAnyEncoding f + nukeFile f + return d + | otherwise = show . filterPrivData hst <$> decryptPrivData + +sendGitUpdate :: HostName -> Handle -> Handle -> IO () +sendGitUpdate hn fromh toh = + void $ actionMessage ("Sending git update to " ++ hn) $ do + sendMarked toh gitPushMarker "" + (Nothing, Nothing, Nothing, h) <- createProcess p + (==) ExitSuccess <$> waitForProcess h + where + p = (proc "git" ["upload-pack", "."]) + { std_in = UseHandle fromh + , std_out = UseHandle toh + } + +-- Initial git clone, used for bootstrapping. +sendGitClone :: HostName -> IO () +sendGitClone hn = void $ actionMessage ("Clone git repository to " ++ hn) $ do + branch <- getCurrentBranch + cacheparams <- sshCachingParams hn + withTmpFile "propellor.git" $ \tmp _ -> allM id + [ boolSystem "git" [Param "bundle", Param "create", File tmp, Param "HEAD"] + , boolSystem "scp" $ cacheparams ++ [File tmp, Param ("root@"++hn++":"++remotebundle)] + , boolSystem "ssh" $ cacheparams ++ [Param ("root@"++hn), Param $ unpackcmd branch] + ] + where + remotebundle = "/usr/local/propellor.git" + unpackcmd branch = shellWrap $ intercalate " && " + [ "git clone " ++ remotebundle ++ " " ++ localdir + , "cd " ++ localdir + , "git checkout -b " ++ branch + , "git remote rm origin" + , "rm -f " ++ remotebundle + ] + +-- Send a tarball containing the precompiled propellor, and libraries. +-- This should be reasonably portable, as long as the remote host has the +-- same architecture as the build host. +sendPrecompiled :: HostName -> IO () +sendPrecompiled hn = void $ actionMessage ("Uploading locally compiled propellor as a last resort") $ do + bracket getWorkingDirectory changeWorkingDirectory $ \_ -> + withTmpDir "propellor" go + where + go tmpdir = do + cacheparams <- sshCachingParams hn + let shimdir = takeFileName localdir + createDirectoryIfMissing True (tmpdir shimdir) + changeWorkingDirectory (tmpdir shimdir) + me <- readSymbolicLink "/proc/self/exe" + createDirectoryIfMissing True "bin" + unlessM (boolSystem "cp" [File me, File "bin/propellor"]) $ + errorMessage "failed copying in propellor" + void $ Shim.setup "bin/propellor" "." + changeWorkingDirectory tmpdir + withTmpFile "propellor.tar." $ \tarball _ -> allM id + [ boolSystem "strip" [File me] + , boolSystem "tar" [Param "czf", File tarball, File shimdir] + , boolSystem "scp" $ cacheparams ++ [File tarball, Param ("root@"++hn++":"++remotetarball)] + , boolSystem "ssh" $ cacheparams ++ [Param ("root@"++hn), Param unpackcmd] + ] + + remotetarball = "/usr/local/propellor.tar" + + unpackcmd = shellWrap $ intercalate " && " + [ "cd " ++ takeDirectory remotetarball + , "rm -rf " ++ localdir + , "tar xzf " ++ remotetarball + , "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 -- cgit v1.3-2-g0d8e From 868d7cdcb5c80d38f4d96efff121b5940c667b2e Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 22 Nov 2014 20:29:27 -0400 Subject: avoid loop after uploading precompiled tarball The localdir still has no .git repo, so it looped. --- src/Propellor/Spin.hs | 50 ++++++++++++++++++++++++++++---------------------- 1 file changed, 28 insertions(+), 22 deletions(-) (limited to 'src/Propellor/Spin.hs') diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs index 8baf4fd9..cffa7610 100644 --- a/src/Propellor/Spin.hs +++ b/src/Propellor/Spin.hs @@ -42,11 +42,12 @@ spin target relay hst = do void $ boolSystem "ssh-add" [] -- Install, or update the remote propellor. - updateServer target relay hst $ withBothHandles createProcessSuccess - (proc "ssh" $ cacheparams ++ [user, updatecmd]) + updateServer target relay hst + (proc "ssh" $ cacheparams ++ [user, shellWrap probecmd]) + (proc "ssh" $ cacheparams ++ [user, shellWrap updatecmd]) -- And now we can run it. - unlessM (boolSystem "ssh" (map Param $ cacheparams ++ ["-t", user, runcmd])) $ + unlessM (boolSystem "ssh" (map Param $ cacheparams ++ ["-t", user, shellWrap runcmd])) $ error $ "remote propellor failed" where hn = fromMaybe target relay @@ -55,27 +56,27 @@ spin target relay hst = do relaying = relay == Just target viarelay = isJust relay && not relaying - mkcmd = shellWrap . intercalate " ; " - - updatecmd = mkcmd + probecmd = intercalate " ; " [ "if [ ! -d " ++ localdir ++ "/.git ]" , "then (" ++ intercalate " && " [ "if ! git --version || ! make --version; then apt-get update && apt-get --no-install-recommends --no-upgrade -y install git make; fi" , "echo " ++ toMarked statusMarker (show NeedGitClone) ] ++ ") || echo " ++ toMarked statusMarker (show NeedPrecompiled) - , "else " ++ intercalate " && " - [ "cd " ++ localdir - , "if ! test -x ./propellor; then make deps build; fi" - , if viarelay - then "./propellor --continue " ++ - shellEscape (show (Update (Just target))) - -- Still using --boot for back-compat... - else "./propellor --boot " ++ target - ] + , "else " ++ updatecmd , "fi" ] + + updatecmd = intercalate " && " + [ "cd " ++ localdir + , "if ! test -x ./propellor; then make deps build; fi" + , if viarelay + then "./propellor --continue " ++ + shellEscape (show (Update (Just target))) + -- Still using --boot for back-compat... + else "./propellor --boot " ++ target + ] - runcmd = mkcmd [ "cd " ++ localdir ++ " && ./propellor " ++ cmd ] + runcmd = "cd " ++ localdir ++ " && ./propellor " ++ cmd cmd = if viarelay then "--serialized " ++ shellEscape (show (Spin target (Just target))) else "--continue " ++ shellEscape (show (SimpleRun target)) @@ -114,17 +115,22 @@ update forhost = do -- to be relayed to the target host. privfile = maybe privDataLocal privDataRelay forhost --- The connect action should ssh to the remote host and run the provided --- calback action. -updateServer :: HostName -> Maybe HostName -> Host -> (((Handle, Handle) -> IO ()) -> IO ()) -> IO () -updateServer target relay hst connect = connect go +updateServer + :: HostName + -> Maybe HostName + -> Host + -> CreateProcess + -> CreateProcess + -> IO () +updateServer target relay hst connect haveprecompiled = + withBothHandles createProcessSuccess connect go where hn = fromMaybe target relay relaying = relay == Just target go (toh, fromh) = do let loop = go (toh, fromh) - let restart = updateServer hn relay hst connect + let restart = updateServer hn relay hst connect haveprecompiled let done = return () v <- (maybe Nothing readish <$> getMarked fromh statusMarker) case v of @@ -143,7 +149,7 @@ updateServer target relay hst connect = connect go hClose toh hClose fromh sendPrecompiled hn - restart + updateServer hn relay hst haveprecompiled (error "loop") (Just NeedGitPush) -> do sendGitUpdate hn fromh toh hClose fromh -- cgit v1.3-2-g0d8e From 40bec41f569a73a8e95d9acf91f0ae7465b0f8c0 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 22 Nov 2014 20:35:46 -0400 Subject: avoid removing whole localdir every time the precompiled tarball is uploaded There's some state in there.. Moved it to a shim subdir, which can be deleted and the tarball unpacked to recreate it. --- src/Propellor/Spin.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'src/Propellor/Spin.hs') diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs index cffa7610..1688bcaf 100644 --- a/src/Propellor/Spin.hs +++ b/src/Propellor/Spin.hs @@ -217,7 +217,7 @@ sendPrecompiled hn = void $ actionMessage ("Uploading locally compiled propellor where go tmpdir = do cacheparams <- sshCachingParams hn - let shimdir = takeFileName localdir + let shimdir = takeFileName localdir "shim" createDirectoryIfMissing True (tmpdir shimdir) changeWorkingDirectory (tmpdir shimdir) me <- readSymbolicLink "/proc/self/exe" @@ -237,9 +237,10 @@ sendPrecompiled hn = void $ actionMessage ("Uploading locally compiled propellor unpackcmd = shellWrap $ intercalate " && " [ "cd " ++ takeDirectory remotetarball - , "rm -rf " ++ localdir + , "rm -rf " ++ localdir "shim" , "tar xzf " ++ remotetarball , "rm -f " ++ remotetarball + , "ln -sf shim/propellor propellor/propellor" ] -- Shim for git push over the propellor ssh channel. -- cgit v1.3-2-g0d8e From 58b5de78020f65ec54ba3ddb20741d9bf9906ad6 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 22 Nov 2014 20:42:20 -0400 Subject: Revert "avoid removing whole localdir every time the precompiled tarball is uploaded" This reverts commit 40bec41f569a73a8e95d9acf91f0ae7465b0f8c0. --- src/Propellor/Spin.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) (limited to 'src/Propellor/Spin.hs') diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs index 1688bcaf..cffa7610 100644 --- a/src/Propellor/Spin.hs +++ b/src/Propellor/Spin.hs @@ -217,7 +217,7 @@ sendPrecompiled hn = void $ actionMessage ("Uploading locally compiled propellor where go tmpdir = do cacheparams <- sshCachingParams hn - let shimdir = takeFileName localdir "shim" + let shimdir = takeFileName localdir createDirectoryIfMissing True (tmpdir shimdir) changeWorkingDirectory (tmpdir shimdir) me <- readSymbolicLink "/proc/self/exe" @@ -237,10 +237,9 @@ sendPrecompiled hn = void $ actionMessage ("Uploading locally compiled propellor unpackcmd = shellWrap $ intercalate " && " [ "cd " ++ takeDirectory remotetarball - , "rm -rf " ++ localdir "shim" + , "rm -rf " ++ localdir , "tar xzf " ++ remotetarball , "rm -f " ++ remotetarball - , "ln -sf shim/propellor propellor/propellor" ] -- Shim for git push over the propellor ssh channel. -- cgit v1.3-2-g0d8e From 1338f4effda3293356e493a375e912d3821b6069 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 22 Nov 2014 20:42:31 -0400 Subject: don't remove old localdir before tarball unpack it may get messy if old stuff is left, but there is state in there --- src/Propellor/Spin.hs | 1 - 1 file changed, 1 deletion(-) (limited to 'src/Propellor/Spin.hs') diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs index cffa7610..6add4f9f 100644 --- a/src/Propellor/Spin.hs +++ b/src/Propellor/Spin.hs @@ -237,7 +237,6 @@ sendPrecompiled hn = void $ actionMessage ("Uploading locally compiled propellor unpackcmd = shellWrap $ intercalate " && " [ "cd " ++ takeDirectory remotetarball - , "rm -rf " ++ localdir , "tar xzf " ++ remotetarball , "rm -f " ++ remotetarball ] -- cgit v1.3-2-g0d8e From 96ecbaad25076901802dd7a311161d46a1212d68 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 22 Nov 2014 22:10:53 -0400 Subject: pute full path to bin/propellor inside shim --- src/Propellor/Property/Chroot.hs | 2 +- src/Propellor/Property/Debootstrap.hs | 3 ++- src/Propellor/Property/Docker.hs | 2 +- src/Propellor/Shim.hs | 6 +++--- src/Propellor/Spin.hs | 2 +- 5 files changed, 8 insertions(+), 7 deletions(-) (limited to 'src/Propellor/Spin.hs') diff --git a/src/Propellor/Property/Chroot.hs b/src/Propellor/Property/Chroot.hs index c3b14a8e..f45e2fc1 100644 --- a/src/Propellor/Property/Chroot.hs +++ b/src/Propellor/Property/Chroot.hs @@ -88,7 +88,7 @@ propellChroot c@(Chroot loc _ _ _) mkproc systemdonly = property (chrootDesc c " let me = localdir "propellor" shim <- liftIO $ ifM (doesDirectoryExist d) ( pure (Shim.file me d) - , Shim.setup me d + , Shim.setup me Nothing d ) ifM (liftIO $ bindmount shim) ( chainprovision shim diff --git a/src/Propellor/Property/Debootstrap.hs b/src/Propellor/Property/Debootstrap.hs index a8c80348..f85eb2e6 100644 --- a/src/Propellor/Property/Debootstrap.hs +++ b/src/Propellor/Property/Debootstrap.hs @@ -263,7 +263,8 @@ fixForeignDev target = whenM (doesFileExist (target ++ foreignDevFlag)) $ do , Param "sh" , Param "-c" , Param $ intercalate " && " - [ "rm -rf /dev" + [ "apt-get -y install makedev" + , "rm -rf /dev" , "mkdir /dev" , "cd /dev" , "/sbin/MAKEDEV std ptmx fd consoleonly" diff --git a/src/Propellor/Property/Docker.hs b/src/Propellor/Property/Docker.hs index 460bc3ec..586ebc2e 100644 --- a/src/Propellor/Property/Docker.hs +++ b/src/Propellor/Property/Docker.hs @@ -377,7 +377,7 @@ runningContainer cid@(ContainerId hn cn) image runps = containerDesc cid $ prope liftIO $ do clearProvisionedFlag cid createDirectoryIfMissing True (takeDirectory $ identFile cid) - shim <- liftIO $ Shim.setup (localdir "propellor") (localdir shimdir cid) + shim <- liftIO $ Shim.setup (localdir "propellor") Nothing (localdir shimdir cid) liftIO $ writeFile (identFile cid) (show ident) ensureProperty $ boolProperty "run" $ runContainer img (runps ++ ["-i", "-d", "-t"]) diff --git a/src/Propellor/Shim.hs b/src/Propellor/Shim.hs index 6262ea5c..a97bf5c8 100644 --- a/src/Propellor/Shim.hs +++ b/src/Propellor/Shim.hs @@ -21,8 +21,8 @@ import System.Posix.Files -- -- Propellor may be running from an existing shim, in which case it's -- simply reused. -setup :: FilePath -> FilePath -> IO FilePath -setup propellorbin dest = checkAlreadyShimmed propellorbin $ do +setup :: FilePath -> Maybe FilePath -> FilePath -> IO FilePath +setup propellorbin propellorbinpath dest = checkAlreadyShimmed propellorbin $ do createDirectoryIfMissing True dest libs <- parseLdd <$> readProcess "ldd" [propellorbin] @@ -44,7 +44,7 @@ setup propellorbin dest = checkAlreadyShimmed propellorbin $ do , "GCONV_PATH=" ++ shellEscape gconvdir , "export GCONV_PATH" , "exec " ++ unwords (map shellEscape $ linker : linkerparams) ++ - " " ++ shellEscape propellorbin ++ " \"$@\"" + " " ++ shellEscape (fromMaybe propellorbin propellorbinpath) ++ " \"$@\"" ] modifyFileMode shim (addModes executeModes) return shim diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs index 6add4f9f..228c4027 100644 --- a/src/Propellor/Spin.hs +++ b/src/Propellor/Spin.hs @@ -224,7 +224,7 @@ sendPrecompiled hn = void $ actionMessage ("Uploading locally compiled propellor createDirectoryIfMissing True "bin" unlessM (boolSystem "cp" [File me, File "bin/propellor"]) $ errorMessage "failed copying in propellor" - void $ Shim.setup "bin/propellor" "." + void $ Shim.setup "bin/propellor" (localdir "bin/propellor") "." changeWorkingDirectory tmpdir withTmpFile "propellor.tar." $ \tarball _ -> allM id [ boolSystem "strip" [File me] -- cgit v1.3-2-g0d8e From 81e52f1e14d92a455a873afc183aa9d4333876b4 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 22 Nov 2014 22:11:36 -0400 Subject: update --- .gitignore | 1 + src/Propellor/Spin.hs | 4 +++- 2 files changed, 4 insertions(+), 1 deletion(-) (limited to 'src/Propellor/Spin.hs') diff --git a/.gitignore b/.gitignore index e9925509..a2d84e4e 100644 --- a/.gitignore +++ b/.gitignore @@ -7,3 +7,4 @@ Setup Setup.hi Setup.o docker +propellor.1 diff --git a/src/Propellor/Spin.hs b/src/Propellor/Spin.hs index 228c4027..06bac330 100644 --- a/src/Propellor/Spin.hs +++ b/src/Propellor/Spin.hs @@ -224,7 +224,9 @@ sendPrecompiled hn = void $ actionMessage ("Uploading locally compiled propellor createDirectoryIfMissing True "bin" unlessM (boolSystem "cp" [File me, File "bin/propellor"]) $ errorMessage "failed copying in propellor" - void $ Shim.setup "bin/propellor" (localdir "bin/propellor") "." + let bin = "bin/propellor" + let binpath = Just $ localdir bin + void $ Shim.setup bin binpath "." changeWorkingDirectory tmpdir withTmpFile "propellor.tar." $ \tarball _ -> allM id [ boolSystem "strip" [File me] -- cgit v1.3-2-g0d8e