summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Propellor/CmdLine.hs37
-rw-r--r--src/Propellor/Git.hs41
2 files changed, 42 insertions, 36 deletions
diff --git a/src/Propellor/CmdLine.hs b/src/Propellor/CmdLine.hs
index 21ad5dba..c5dcd348 100644
--- a/src/Propellor/CmdLine.hs
+++ b/src/Propellor/CmdLine.hs
@@ -19,6 +19,7 @@ import Propellor
import Propellor.Protocol
import Propellor.PrivData.Paths
import Propellor.Gpg
+import Propellor.Git
import qualified Propellor.Property.Docker as Docker
import qualified Propellor.Property.Docker.Shim as DockerShim
import Utility.FileMode
@@ -143,10 +144,6 @@ buildFirst cmdline next = do
where
getmtime = catchMaybeIO $ getModificationTime "propellor"
-getCurrentBranch :: IO String
-getCurrentBranch = takeWhile (/= '\n')
- <$> readProcess "git" ["symbolic-ref", "--short", "HEAD"]
-
updateFirst :: CmdLine -> IO () -> IO ()
updateFirst cmdline next = ifM hasOrigin (updateFirst' cmdline next, next)
@@ -192,9 +189,6 @@ updateFirst' cmdline next = do
, errorMessage "Propellor build failed!"
)
-getCurrentGitSha1 :: String -> IO String
-getCurrentGitSha1 branchref = readProcess "git" ["show-ref", "--hash", branchref]
-
-- spin handles deploying propellor to a remote host, if it's not already
-- installed there, or updating it if it is. Once the remote propellor is
-- updated, it's run.
@@ -351,35 +345,6 @@ gitPush hin hout = void $ fromstdin `concurrently` tostdout
hFlush toh
connect fromh toh
-hasOrigin :: IO Bool
-hasOrigin = do
- rs <- lines <$> readProcess "git" ["remote"]
- return $ "origin" `elem` rs
-
-setRepoUrl :: String -> IO ()
-setRepoUrl "" = return ()
-setRepoUrl url = do
- subcmd <- ifM hasOrigin (pure "set-url", pure "add")
- void $ boolSystem "git" [Param "remote", Param subcmd, Param "origin", Param url]
- -- same as --set-upstream-to, except origin branch
- -- may not have been pulled yet
- branch <- getCurrentBranch
- let branchval s = "branch." ++ branch ++ "." ++ s
- void $ boolSystem "git" [Param "config", Param (branchval "remote"), Param "origin"]
- void $ boolSystem "git" [Param "config", Param (branchval "merge"), Param $ "refs/heads/"++branch]
-
-getRepoUrl :: IO (Maybe String)
-getRepoUrl = getM get urls
- where
- urls = ["remote.deploy.url", "remote.origin.url"]
- get u = do
- v <- catchMaybeIO $
- takeWhile (/= '\n')
- <$> readProcess "git" ["config", u]
- return $ case v of
- Just url | not (null url) -> Just url
- _ -> Nothing
-
checkDebugMode :: IO ()
checkDebugMode = go =<< getEnv "PROPELLOR_DEBUG"
where
diff --git a/src/Propellor/Git.hs b/src/Propellor/Git.hs
new file mode 100644
index 00000000..0de82f8a
--- /dev/null
+++ b/src/Propellor/Git.hs
@@ -0,0 +1,41 @@
+module Propellor.Git where
+
+import Propellor
+import Utility.SafeCommand
+
+getCurrentBranch :: IO String
+getCurrentBranch = takeWhile (/= '\n')
+ <$> readProcess "git" ["symbolic-ref", "--short", "HEAD"]
+
+getCurrentGitSha1 :: String -> IO String
+getCurrentGitSha1 branchref = readProcess "git" ["show-ref", "--hash", branchref]
+
+setRepoUrl :: String -> IO ()
+setRepoUrl "" = return ()
+setRepoUrl url = do
+ subcmd <- ifM hasOrigin (pure "set-url", pure "add")
+ void $ boolSystem "git" [Param "remote", Param subcmd, Param "origin", Param url]
+ -- same as --set-upstream-to, except origin branch
+ -- may not have been pulled yet
+ branch <- getCurrentBranch
+ let branchval s = "branch." ++ branch ++ "." ++ s
+ void $ boolSystem "git" [Param "config", Param (branchval "remote"), Param "origin"]
+ void $ boolSystem "git" [Param "config", Param (branchval "merge"), Param $ "refs/heads/"++branch]
+
+getRepoUrl :: IO (Maybe String)
+getRepoUrl = getM get urls
+ where
+ urls = ["remote.deploy.url", "remote.origin.url"]
+ get u = do
+ v <- catchMaybeIO $
+ takeWhile (/= '\n')
+ <$> readProcess "git" ["config", u]
+ return $ case v of
+ Just url | not (null url) -> Just url
+ _ -> Nothing
+
+hasOrigin :: IO Bool
+hasOrigin = do
+ rs <- lines <$> readProcess "git" ["remote"]
+ return $ "origin" `elem` rs
+