propellor spin

2 files changed, 38 insertions, 8 deletions

diff --git a/Propellor/Property/Git.hs b/Propellor/Property/Git.hs
index c0494160..6f3c0364 100644
--- a/Propellor/Property/Git.hs
+++ b/Propellor/Property/Git.hs
@@ -4,6 +4,7 @@ import Propellor
 import Propellor.Property.File
 import qualified Propellor.Property.Apt as Apt
 import qualified Propellor.Property.Service as Service
+import Utility.SafeCommand
 
 import Data.List
 
@@ -46,3 +47,38 @@ daemonRunning exportdir = RevertableProperty setup unsetup
 		, "--base-path=" ++ exportdir
 		, exportdir
 		]
+
+installed :: Property
+installed = Apt.installed ["git"]
+
+type RepoUrl = String
+
+type Branch = String
+
+-- | Specified git repository is cloned to the specified directory.
+--
+-- If the firectory exists with some other content, it will be recursively
+-- deleted.
+--
+-- A branch can be specified, to check out.
+cloned :: UserName -> RepoUrl -> FilePath -> Maybe Branch -> Property
+cloned owner url dir mbranch = check originurl (Property desc checkout)
+	`requires` installed
+  where
+	desc = "git cloned " ++ url ++ " " ++ dir
+	gitconfig = dir </> ".git/config"
+	originurl = ifM (doesFileExist gitconfig)
+		( do
+			v <- catchDefaultIO Nothing $ headMaybe . lines <$>
+				readProcess "git" ["config", "--file", gitconfig, "remote.origin.url"]
+			return (v /= Just url)
+		, return True
+		)
+	checkout = do
+		liftIO $ whenM (doesDirectoryExist dir) $
+			removeDirectoryRecursive dir
+		ensureProperty $ userScriptProperty owner $ catMaybes
+			[ Just $ "git clone " ++ shellEscape url ++ " " ++ shellEscape dir
+			, Just $ "cd " ++ shellEscape dir
+			, ("git checkout " ++) <$> mbranch
+			]
diff --git a/config-joey.hs b/config-joey.hs
index 8a585451..2efb81c6 100644
--- a/config-joey.hs
+++ b/config-joey.hs
@@ -104,14 +104,8 @@ hosts =
 	, standardContainer "ancient-kitenet" Stable "amd64"
 		& Docker.publish "1994:80"
 		& Apt.serviceInstalledRunning "apache2"
-		& Apt.installed ["git"]
-		& scriptProperty 
-			[ "cd /var/"
-			, "rm -rf www"
-			, "git clone git://git.kitenet.net/kitewiki www"
-			, "cd www"
-			, "git checkout remotes/origin/old-kitenet.net"
-			] `flagFile` "/var/www/blastfromthepast.html"
+		& Git.cloned "root" "git://git.kitenet.net/kitewiki" "/var/www"
+			(Just "remotes/origin/old-kitenet.net")
 	
 	-- git-annex autobuilder containers
 	, gitAnnexBuilder "amd64" 15