propellor --spin can now deploy propellor to hosts that do not have git, ghc, or apt-get. This is accomplished by uploading a fairly portable precompiled tarball of propellor.

debian/changelog

@@ -1,3 +1,11 @@
+propellor (1.0.1) UNRELEASED; urgency=medium
+
+  * propellor --spin can now deploy propellor to hosts that do not have 
+    git, ghc, or apt-get. This is accomplished by uploading a fairly
+    portable precompiled tarball of propellor.
+
+ -- Joey Hess <joeyh@debian.org>  Sat, 22 Nov 2014 00:12:35 -0400
+
 propellor (1.0.0) unstable; urgency=medium
 
   * propellor --spin can now be used to update remote hosts, without

src/Propellor/CmdLine.hs

@@ -114,16 +114,19 @@ unknownhost h hosts = errorMessage $ unlines
 	]
 
 buildFirst :: CmdLine -> IO () -> IO ()
-buildFirst cmdline next = do
+buildFirst cmdline next = ifM (doesFileExist "Makefile")
-	oldtime <- getmtime
+	( do
-	ifM (actionMessage "Propellor build" $ boolSystem "make" [Param "build"])
+		oldtime <- getmtime
-		( do
+		ifM (actionMessage "Propellor build" $ boolSystem "make" [Param "build"])
-			newtime <- getmtime
+			( do
-			if newtime == oldtime
+				newtime <- getmtime
-				then next
+				if newtime == oldtime
-				else void $ boolSystem "./propellor" [Param "--continue", Param (show cmdline)]
+					then next
-		, errorMessage "Propellor build failed!" 
+					else void $ boolSystem "./propellor" [Param "--continue", Param (show cmdline)]
-		)
+			, errorMessage "Propellor build failed!" 
+			)
+	, next
+	)
   where
 	getmtime = catchMaybeIO $ getModificationTime "propellor"
 
@@ -172,11 +175,11 @@ spin hn hst = do
 
 	updatecmd = mkcmd
 		[ "if [ ! -d " ++ localdir ++ " ]"
-		, "then " ++ intercalate " && "
+		, "then (" ++ intercalate " && "
 			[ "apt-get update"
 			, "apt-get --no-install-recommends --no-upgrade -y install git make"
 			, "echo " ++ toMarked statusMarker (show NeedGitClone)
-			]
+			] ++ ") || echo " ++ toMarked statusMarker (show NeedPrecompiled)
 		, "else " ++ intercalate " && "
 			[ "cd " ++ localdir
 			, "if ! test -x ./propellor; then make deps build; fi"

src/Propellor/Git.hs

@@ -38,7 +38,7 @@ getRepoUrl = getM get urls
 			_ -> Nothing
 
 hasOrigin :: IO Bool
-hasOrigin = do
+hasOrigin = catchDefaultIO False $ do
 	rs <- lines <$> readProcess "git" ["remote"]
 	return $ "origin" `elem` rs
 

src/Propellor/Protocol.hs

@@ -13,7 +13,7 @@ import Data.List
 
 import Propellor
 
-data Stage = NeedGitClone | NeedRepoUrl | NeedPrivData | NeedGitPush
+data Stage = NeedGitClone | NeedRepoUrl | NeedPrivData | NeedGitPush | NeedPrecompiled
 	deriving (Read, Show, Eq)
 
 type Marker = String

src/Propellor/Server.hs

@@ -16,6 +16,7 @@ import Propellor.Protocol
 import Propellor.PrivData.Paths
 import Propellor.Git
 import Propellor.Ssh
+import qualified Propellor.Shim as Shim
 import Utility.FileMode
 import Utility.SafeCommand
 
@@ -69,6 +70,11 @@ updateServer hn hst connect = connect go
 				hClose fromh
 				sendGitClone hn
 				updateServer hn hst connect
+			(Just NeedPrecompiled) -> do
+				hClose toh
+				hClose fromh
+				sendPrecompiled hn
+				updateServer hn hst connect
 			Nothing -> return ()
 
 sendRepoUrl :: Handle -> IO ()
@@ -113,6 +119,32 @@ sendGitClone hn = void $ actionMessage ("Clone git repository to " ++ hn) $ do
 		, "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 " ++ hn) $ do
+	cacheparams <- sshCachingParams hn
+	withTmpDir "propellor" $ \tmpdir ->
+		bracket getWorkingDirectory changeWorkingDirectory $ \_ -> do
+			changeWorkingDirectory tmpdir
+			let shimdir = "propellor"
+			let me = localdir </> "propellor"
+			void $ Shim.setup me shimdir
+			withTmpFile "propellor.tar" $ \tarball -> allM id
+				[ boolSystem "strip" [File me]
+				, boolSystem "tar" [Param "cf", File tmp, File shimdir]
+				, boolSystem "scp" $ cacheparams ++ [File tarball, Param ("root@"++hn++":"++remotetarball)
+				, boolSystem "ssh" $ cacheparams ++ [Param ("root@"++hn), Param unpackcmd]
+				]
+  where
+	remotetarball = "/usr/local/propellor.tar"
+	unpackcmd = shellSwap $ intercalate " && "
+		[ "cd " ++ takeDirectory remotetarball
+		, "tar xf " ++ 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.