cadey
/
propellor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Merge branch 'joeyconfig'

This commit is contained in:
Joey Hess 2014-04-03 12:35:27 -04:00
parent 25ba6d5393 9c3ab75059
commit ced760359a
1 changed files with 16 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
Propellor/CmdLine.hs
View File

@ -94,11 +94,14 @@ buildFirst cmdline next = do
where where
getmtime = catchMaybeIO $ getModificationTime "propellor" getmtime = catchMaybeIO $ getModificationTime "propellor"
getCurrentBranch :: IO String
getCurrentBranch = takeWhile (/= '\n')
<$> readProcess "git" ["symbolic-ref", "--short", "HEAD"]
updateFirst :: CmdLine -> IO () -> IO () updateFirst :: CmdLine -> IO () -> IO ()
updateFirst cmdline next = do updateFirst cmdline next = do
branchref <- takeWhile (/= '\n') branchref <- getCurrentBranch
<$> readProcess "git" ["symbolic-ref", "HEAD"] let originbranch = "origin" </> branchref
let originbranch = "origin" </> takeFileName branchref
void $ actionMessage "Git fetch" $ boolSystem "git" [Param "fetch"] void $ actionMessage "Git fetch" $ boolSystem "git" [Param "fetch"]
@ -116,7 +119,8 @@ updateFirst cmdline next = do
modifyFileMode privDataDir (removeModes otherGroupModes) modifyFileMode privDataDir (removeModes otherGroupModes)
s <- readProcessEnv "git" ["log", "-n", "1", "--format=%G?", originbranch] s <- readProcessEnv "git" ["log", "-n", "1", "--format=%G?", originbranch]
(Just [("GNUPGHOME", privDataDir)]) (Just [("GNUPGHOME", privDataDir)])
nukeFile $ privDataDir </> "trustring.gpg" nukeFile $ privDataDir </> "trustdb.gpg"
nukeFile $ privDataDir </> "pubring.gpg"
nukeFile $ privDataDir </> "gpg.conf" nukeFile $ privDataDir </> "gpg.conf"
if s == "U\n" || s == "G\n" if s == "U\n" || s == "G\n"
then do then do
@ -143,9 +147,10 @@ spin host = do
url <- getUrl url <- getUrl
void $ gitCommit [Param "--allow-empty", Param "-a", Param "-m", Param "propellor spin"] void $ gitCommit [Param "--allow-empty", Param "-a", Param "-m", Param "propellor spin"]
void $ boolSystem "git" [Param "push"] void $ boolSystem "git" [Param "push"]
go url =<< gpgDecrypt (privDataFile host) branch <- getCurrentBranch
go url branch =<< gpgDecrypt (privDataFile host)
where where
go url privdata = withBothHandles createProcessSuccess (proc "ssh" [user, bootstrapcmd]) $ \(toh, fromh) -> do go url branch privdata = withBothHandles createProcessSuccess (proc "ssh" [user, bootstrapcmd branch]) $ \(toh, fromh) -> do
let finish = do let finish = do
senddata toh (privDataFile host) privDataMarker privdata senddata toh (privDataFile host) privDataMarker privdata
hClose toh hClose toh
@ -161,11 +166,11 @@ spin host = do
hClose toh hClose toh
hClose fromh hClose fromh
sendGitClone host url sendGitClone host url
go url privdata go url branch privdata
user = "root@"++host user = "root@"++host
bootstrapcmd = shellWrap $ intercalate " ; " bootstrapcmd branch = shellWrap $ intercalate " ; "
[ "if [ ! -d " ++ localdir ++ " ]" [ "if [ ! -d " ++ localdir ++ " ]"
, "then " ++ intercalate " && " , "then " ++ intercalate " && "
[ "apt-get -y install git" [ "apt-get -y install git"
@ -173,6 +178,8 @@ spin host = do
] ]
, "else " ++ intercalate " && " , "else " ++ intercalate " && "
[ "cd " ++ localdir [ "cd " ++ localdir
, "git checkout -b " ++ branch
, "git branch --set-upstream-to=origin/" ++ branch ++ " " ++ branch
, "if ! test -x ./propellor; then make build; fi" , "if ! test -x ./propellor; then make build; fi"
, "./propellor --boot " ++ host , "./propellor --boot " ++ host
] ]
@ -196,7 +203,7 @@ spin host = do
sendGitClone :: HostName -> String -> IO () sendGitClone :: HostName -> String -> IO ()
sendGitClone host url = void $ actionMessage ("Pushing git repository to " ++ host) $ sendGitClone host url = void $ actionMessage ("Pushing git repository to " ++ host) $
withTmpFile "propellor.git." $ \tmp _ -> allM id withTmpFile "propellor.git" $ \tmp _ -> allM id
-- TODO: ssh connection caching, or better push method -- TODO: ssh connection caching, or better push method
-- with less connections. -- with less connections.
[ boolSystem "git" [Param "bundle", Param "create", File tmp, Param "HEAD"] [ boolSystem "git" [Param "bundle", Param "create", File tmp, Param "HEAD"]