module Propellor.Property.Git where
import Propellor.Base
import Propellor.Property.File
import qualified Propellor.Property.Apt as Apt
import qualified Propellor.Property.Service as Service
import Data.List
daemonRunning :: FilePath -> RevertableProperty DebianLike DebianLike
daemonRunning exportdir = setup <!> unsetup
where
setup = containsLine conf (mkl "tcp4")
`requires`
containsLine conf (mkl "tcp6")
`requires`
dirExists exportdir
`requires`
Apt.serviceInstalledRunning "openbsd-inetd"
`onChange`
Service.reloaded "openbsd-inetd"
`describe` ("git-daemon exporting " ++ exportdir)
unsetup = lacksLine conf (mkl "tcp4")
`requires`
lacksLine conf (mkl "tcp6")
`onChange`
Service.reloaded "openbsd-inetd"
conf = "/etc/inetd.conf"
mkl tcpv = intercalate "\t"
[ "git"
, "stream"
, tcpv
, "nowait"
, "nobody"
, "/usr/bin/git"
, "git"
, "daemon"
, "--inetd"
, "--export-all"
, "--base-path=" ++ exportdir
, exportdir
]
installed :: Property DebianLike
installed = Apt.installed ["git"]
type RepoUrl = String
type Branch = String
cloned :: User -> RepoUrl -> FilePath -> Maybe Branch -> Property DebianLike
cloned owner url dir mbranch = check originurl go
`requires` installed
where
desc = "git cloned " ++ url ++ " to " ++ 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
)
go :: Property DebianLike
go = property' desc $ \w -> do
liftIO $ do
whenM (doesDirectoryExist dir) $
removeDirectoryRecursive dir
createDirectoryIfMissing True (takeDirectory dir)
ensureProperty w $ userScriptProperty owner (catMaybes checkoutcmds)
`assume` MadeChange
checkoutcmds =
[ Just $ "git clone " ++ shellEscape url ++ " " ++ shellEscape dir ++ " < /dev/null"
, Just $ "cd " ++ shellEscape dir
, ("git checkout " ++) <$> mbranch
, Just "git update-server-info"
]
isGitDir :: FilePath -> IO Bool
isGitDir dir = isNothing <$> catchMaybeIO (readProcess "git" ["rev-parse", "--resolve-git-dir", dir])
data GitShared = Shared Group | SharedAll | NotShared
bareRepo :: FilePath -> User -> GitShared -> Property UnixLike
bareRepo repo user gitshared = check (isRepo repo) $ propertyList ("git repo: " ++ repo) $ toProps $
dirExists repo : case gitshared of
NotShared ->
[ ownerGroup repo user (userGroup user)
, userScriptProperty user ["git init --bare --shared=false " ++ shellEscape repo]
`assume` MadeChange
]
SharedAll ->
[ ownerGroup repo user (userGroup user)
, userScriptProperty user ["git init --bare --shared=all " ++ shellEscape repo]
`assume` MadeChange
]
Shared group' ->
[ ownerGroup repo user group'
, userScriptProperty user ["git init --bare --shared=group " ++ shellEscape repo]
`assume` MadeChange
]
where
isRepo repo' = isNothing <$> catchMaybeIO (readProcess "git" ["rev-parse", "--resolve-git-dir", repo'])
repoConfigured :: FilePath -> (String, String) -> Property UnixLike
repo `repoConfigured` (key, value) = check (not <$> alreadyconfigured) $
userScriptProperty (User "root")
[ "cd " ++ repo
, "git config " ++ key ++ " " ++ value
]
`assume` MadeChange
`describe` desc
where
alreadyconfigured = do
vs <- getRepoConfig repo key
return $ value `elem` vs
desc = "git repo at " ++ repo ++ " config setting " ++ key ++ " set to " ++ value
getRepoConfig :: FilePath -> String -> IO [String]
getRepoConfig repo key = catchDefaultIO [] $
lines <$> readProcess "git" ["-C", repo, "config", key]
repoAcceptsNonFFs :: FilePath -> RevertableProperty UnixLike UnixLike
repoAcceptsNonFFs repo = accepts <!> refuses
where
accepts = repoConfigured repo ("receive.denyNonFastForwards", "false")
`describe` desc "accepts"
refuses = repoConfigured repo ("receive.denyNonFastForwards", "true")
`describe` desc "rejects"
desc s = "git repo " ++ repo ++ " " ++ s ++ " non-fast-forward pushes"
bareRepoDefaultBranch :: FilePath -> String -> Property UnixLike
bareRepoDefaultBranch repo branch =
userScriptProperty (User "root")
[ "cd " ++ repo
, "git symbolic-ref HEAD refs/heads/" ++ branch
]
`changesFileContent` (repo </> "HEAD")
`describe` ("git repo at " ++ repo ++ " has default branch " ++ branch)