From 3218e344d117701066ced6c13927318ea2938ad4 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 26 Mar 2016 14:28:38 -0400 Subject: more porting --- src/Propellor/Property/Git.hs | 23 ++++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) (limited to 'src/Propellor/Property/Git.hs') diff --git a/src/Propellor/Property/Git.hs b/src/Propellor/Property/Git.hs index a5ef5ab1..5d7c8b4d 100644 --- a/src/Propellor/Property/Git.hs +++ b/src/Propellor/Property/Git.hs @@ -11,7 +11,7 @@ import Data.List -- using git-daemon, run from inetd. -- -- Note that reverting this property does not remove or stop inetd. -daemonRunning :: FilePath -> RevertableProperty NoInfo +daemonRunning :: FilePath -> RevertableProperty DebianLike DebianLike daemonRunning exportdir = setup unsetup where setup = containsLine conf (mkl "tcp4") @@ -47,7 +47,7 @@ daemonRunning exportdir = setup unsetup , exportdir ] -installed :: Property NoInfo +installed :: Property DebianLike installed = Apt.installed ["git"] type RepoUrl = String @@ -61,8 +61,8 @@ type Branch = String -- it will be recursively deleted first. -- -- A branch can be specified, to check out. -cloned :: User -> RepoUrl -> FilePath -> Maybe Branch -> Property NoInfo -cloned owner url dir mbranch = check originurl (property desc checkout) +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 @@ -74,12 +74,13 @@ cloned owner url dir mbranch = check originurl (property desc checkout) return (v /= Just url) , return True ) - checkout = do + go :: Property DebianLike + go = property' desc $ \w -> do liftIO $ do whenM (doesDirectoryExist dir) $ removeDirectoryRecursive dir createDirectoryIfMissing True (takeDirectory dir) - ensureProperty $ userScriptProperty owner (catMaybes checkoutcmds) + ensureProperty w $ userScriptProperty owner (catMaybes checkoutcmds) `assume` MadeChange checkoutcmds = -- The catchMaybeIO (readProcess "git" ["rev-parse", "--re data GitShared = Shared Group | SharedAll | NotShared -bareRepo :: FilePath -> User -> GitShared -> Property NoInfo -bareRepo repo user gitshared = check (isRepo repo) $ propertyList ("git repo: " ++ repo) $ +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) @@ -121,7 +122,7 @@ bareRepo repo user gitshared = check (isRepo repo) $ propertyList ("git repo: " isRepo repo' = isNothing <$> catchMaybeIO (readProcess "git" ["rev-parse", "--resolve-git-dir", repo']) -- | Set a key value pair in a git repo's configuration. -repoConfigured :: FilePath -> (String, String) -> Property NoInfo +repoConfigured :: FilePath -> (String, String) -> Property UnixLike repo `repoConfigured` (key, value) = check (not <$> alreadyconfigured) $ userScriptProperty (User "root") [ "cd " ++ repo @@ -141,7 +142,7 @@ getRepoConfig repo key = catchDefaultIO [] $ lines <$> readProcess "git" ["-C", repo, "config", key] -- | Whether a repo accepts non-fast-forward pushes. -repoAcceptsNonFFs :: FilePath -> RevertableProperty NoInfo +repoAcceptsNonFFs :: FilePath -> RevertableProperty UnixLike UnixLike repoAcceptsNonFFs repo = accepts refuses where accepts = repoConfigured repo ("receive.denyNonFastForwards", "false") @@ -152,7 +153,7 @@ repoAcceptsNonFFs repo = accepts refuses -- | Sets a bare repository's default branch, which will be checked out -- when cloning it. -bareRepoDefaultBranch :: FilePath -> String -> Property NoInfo +bareRepoDefaultBranch :: FilePath -> String -> Property UnixLike bareRepoDefaultBranch repo branch = userScriptProperty (User "root") [ "cd " ++ repo -- cgit v1.2.3