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 :: FilePath -> RevertableProperty DebianLike DebianLike
daemonRunning FilePath
exportdir = Property DebianLike
setup forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property DebianLike
unsetup
where
setup :: CombinedType
(CombinedType
(CombinedType (Property UnixLike) (Property UnixLike))
(Property DebianLike))
(Property DebianLike)
setup = FilePath -> FilePath -> Property UnixLike
containsLine FilePath
conf (FilePath -> FilePath
mkl FilePath
"tcp4")
forall x y. Combines x y => x -> y -> CombinedType x y
`requires`
FilePath -> FilePath -> Property UnixLike
containsLine FilePath
conf (FilePath -> FilePath
mkl FilePath
"tcp6")
forall x y. Combines x y => x -> y -> CombinedType x y
`requires`
FilePath -> Property UnixLike
dirExists FilePath
exportdir
forall x y. Combines x y => x -> y -> CombinedType x y
`requires`
FilePath -> Property DebianLike
Apt.serviceInstalledRunning FilePath
"openbsd-inetd"
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange`
FilePath -> Property DebianLike
Service.reloaded FilePath
"openbsd-inetd"
forall p. IsProp p => p -> FilePath -> p
`describe` (FilePath
"git-daemon exporting " forall a. [a] -> [a] -> [a]
++ FilePath
exportdir)
unsetup :: CombinedType (Property UnixLike) (Property DebianLike)
unsetup = FilePath -> FilePath -> Property UnixLike
lacksLine FilePath
conf (FilePath -> FilePath
mkl FilePath
"tcp4")
forall x y. Combines x y => x -> y -> CombinedType x y
`requires`
FilePath -> FilePath -> Property UnixLike
lacksLine FilePath
conf (FilePath -> FilePath
mkl FilePath
"tcp6")
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange`
FilePath -> Property DebianLike
Service.reloaded FilePath
"openbsd-inetd"
conf :: FilePath
conf = FilePath
"/etc/inetd.conf"
mkl :: FilePath -> FilePath
mkl FilePath
tcpv = forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"\t"
[ FilePath
"git"
, FilePath
"stream"
, FilePath
tcpv
, FilePath
"nowait"
, FilePath
"nobody"
, FilePath
"/usr/bin/git"
, FilePath
"git"
, FilePath
"daemon"
, FilePath
"--inetd"
, FilePath
"--export-all"
, FilePath
"--base-path=" forall a. [a] -> [a] -> [a]
++ FilePath
exportdir
, FilePath
exportdir
]
installed :: Property DebianLike
installed :: Property DebianLike
installed = [FilePath] -> Property DebianLike
Apt.installed [FilePath
"git"]
type RepoUrl = String
type Branch = String
cloned :: User -> RepoUrl -> FilePath -> Maybe Branch -> Property DebianLike
cloned :: User
-> FilePath -> FilePath -> Maybe FilePath -> Property DebianLike
cloned User
owner FilePath
url FilePath
dir Maybe FilePath
mbranch = forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check IO Bool
originurl Property DebianLike
go
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
installed
where
desc :: FilePath
desc = FilePath
"git cloned " forall a. [a] -> [a] -> [a]
++ FilePath
url forall a. [a] -> [a] -> [a]
++ FilePath
" to " forall a. [a] -> [a] -> [a]
++ FilePath
dir
gitconfig :: FilePath
gitconfig = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
".git/config"
originurl :: IO Bool
originurl = forall (m :: * -> *) a. Monad m => m Bool -> (m a, m a) -> m a
ifM (FilePath -> IO Bool
doesFileExist FilePath
gitconfig)
( do
Maybe FilePath
v <- forall (m :: * -> *) a. MonadCatch m => a -> m a -> m a
catchDefaultIO forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Maybe a
headMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
FilePath -> [FilePath] -> IO FilePath
readProcess FilePath
"git" [FilePath
"config", FilePath
"--file", FilePath
gitconfig, FilePath
"remote.origin.url"]
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FilePath
v forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just FilePath
url)
, forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
)
go :: Property DebianLike
go :: Property DebianLike
go = forall {k} (metatypes :: k).
SingI metatypes =>
FilePath
-> (OuterMetaTypesWitness metatypes -> Propellor Result)
-> Property (MetaTypes metatypes)
property' FilePath
desc forall a b. (a -> b) -> a -> b
$ \OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w -> do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (FilePath -> IO Bool
doesDirectoryExist FilePath
dir) forall a b. (a -> b) -> a -> b
$
FilePath -> IO ()
removeDirectoryRecursive FilePath
dir
Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> FilePath
takeDirectory FilePath
dir)
forall (inner :: [MetaType]) (outer :: [MetaType]).
EnsurePropertyAllowed inner outer =>
OuterMetaTypesWitness outer
-> Property (MetaTypes inner) -> Propellor Result
ensureProperty OuterMetaTypesWitness
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
w forall a b. (a -> b) -> a -> b
$ User -> [FilePath] -> UncheckedProperty UnixLike
userScriptProperty User
owner (forall a. [Maybe a] -> [a]
catMaybes [Maybe FilePath]
checkoutcmds)
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
checkoutcmds :: [Maybe FilePath]
checkoutcmds =
[ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ FilePath
"git clone " forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
shellEscape FilePath
url forall a. [a] -> [a] -> [a]
++ FilePath
" " forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
shellEscape FilePath
dir forall a. [a] -> [a] -> [a]
++ FilePath
" < /dev/null"
, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ FilePath
"cd " forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
shellEscape FilePath
dir
, (FilePath
"git checkout " forall a. [a] -> [a] -> [a]
++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe FilePath
mbranch
, forall a. a -> Maybe a
Just FilePath
"git update-server-info"
]
pulled :: User -> RepoUrl -> FilePath -> Maybe Branch -> Property DebianLike
pulled :: User
-> FilePath -> FilePath -> Maybe FilePath -> Property DebianLike
pulled User
owner FilePath
url FilePath
dir Maybe FilePath
mbranch = Property UnixLike
go
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` User
-> FilePath -> FilePath -> Maybe FilePath -> Property DebianLike
cloned User
owner FilePath
url FilePath
dir Maybe FilePath
mbranch
forall p. IsProp p => p -> FilePath -> p
`describe` FilePath
desc
where
desc :: FilePath
desc = FilePath
"git pulled " forall a. [a] -> [a] -> [a]
++ FilePath
url forall a. [a] -> [a] -> [a]
++ FilePath
" to " forall a. [a] -> [a] -> [a]
++ FilePath
dir
go :: Property UnixLike
go = User -> [FilePath] -> UncheckedProperty UnixLike
userScriptProperty User
owner
[ FilePath
"cd " forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
shellEscape FilePath
dir
, FilePath
"git pull"
]
forall (p :: * -> *) i.
Checkable p i =>
p i -> FilePath -> Property i
`changesFileContent` (FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
".git" FilePath -> FilePath -> FilePath
</> FilePath
"FETCH_HEAD")
isGitDir :: FilePath -> IO Bool
isGitDir :: FilePath -> IO Bool
isGitDir FilePath
dir = forall a. Maybe a -> Bool
isNothing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadCatch m => m a -> m (Maybe a)
catchMaybeIO (FilePath -> [FilePath] -> IO FilePath
readProcess FilePath
"git" [FilePath
"rev-parse", FilePath
"--resolve-git-dir", FilePath
dir])
data GitShared = Shared Group | SharedAll | NotShared
bareRepo :: FilePath -> User -> GitShared -> Property UnixLike
bareRepo :: FilePath -> User -> GitShared -> Property UnixLike
bareRepo FilePath
repo User
user GitShared
gitshared = forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (FilePath -> IO Bool
isRepo FilePath
repo) forall a b. (a -> b) -> a -> b
$ forall {k} (metatypes :: k).
SingI metatypes =>
FilePath
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList (FilePath
"git repo: " forall a. [a] -> [a] -> [a]
++ FilePath
repo) forall a b. (a -> b) -> a -> b
$ forall {k} (metatypes :: k).
[Property (MetaTypes metatypes)] -> Props (MetaTypes metatypes)
toProps forall a b. (a -> b) -> a -> b
$
FilePath -> Property UnixLike
dirExists FilePath
repo forall a. a -> [a] -> [a]
: case GitShared
gitshared of
GitShared
NotShared ->
[ FilePath -> User -> Group -> Property UnixLike
ownerGroup FilePath
repo User
user (User -> Group
userGroup User
user)
, User -> [FilePath] -> UncheckedProperty UnixLike
userScriptProperty User
user [FilePath
"git init --bare --shared=false " forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
shellEscape FilePath
repo]
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
]
GitShared
SharedAll ->
[ FilePath -> User -> Group -> Property UnixLike
ownerGroup FilePath
repo User
user (User -> Group
userGroup User
user)
, User -> [FilePath] -> UncheckedProperty UnixLike
userScriptProperty User
user [FilePath
"git init --bare --shared=all " forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
shellEscape FilePath
repo]
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
]
Shared Group
group' ->
[ FilePath -> User -> Group -> Property UnixLike
ownerGroup FilePath
repo User
user Group
group'
, User -> [FilePath] -> UncheckedProperty UnixLike
userScriptProperty User
user [FilePath
"git init --bare --shared=group " forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
shellEscape FilePath
repo]
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
]
where
isRepo :: FilePath -> IO Bool
isRepo FilePath
repo' = forall a. Maybe a -> Bool
isNothing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadCatch m => m a -> m (Maybe a)
catchMaybeIO (FilePath -> [FilePath] -> IO FilePath
readProcess FilePath
"git" [FilePath
"rev-parse", FilePath
"--resolve-git-dir", FilePath
repo'])
repoConfigured :: FilePath -> (String, String) -> Property UnixLike
FilePath
repo repoConfigured :: FilePath -> (FilePath, FilePath) -> Property UnixLike
`repoConfigured` (FilePath
key, FilePath
value) = forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Bool
alreadyconfigured) forall a b. (a -> b) -> a -> b
$
User -> [FilePath] -> UncheckedProperty UnixLike
userScriptProperty (FilePath -> User
User FilePath
"root")
[ FilePath
"cd " forall a. [a] -> [a] -> [a]
++ FilePath
repo
, FilePath
"git config " forall a. [a] -> [a] -> [a]
++ FilePath
key forall a. [a] -> [a] -> [a]
++ FilePath
" " forall a. [a] -> [a] -> [a]
++ FilePath
value
]
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
forall p. IsProp p => p -> FilePath -> p
`describe` FilePath
desc
where
alreadyconfigured :: IO Bool
alreadyconfigured = do
[FilePath]
vs <- FilePath -> FilePath -> IO [FilePath]
getRepoConfig FilePath
repo FilePath
key
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FilePath
value forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
vs
desc :: FilePath
desc = FilePath
"git repo at " forall a. [a] -> [a] -> [a]
++ FilePath
repo forall a. [a] -> [a] -> [a]
++ FilePath
" config setting " forall a. [a] -> [a] -> [a]
++ FilePath
key forall a. [a] -> [a] -> [a]
++ FilePath
" set to " forall a. [a] -> [a] -> [a]
++ FilePath
value
getRepoConfig :: FilePath -> String -> IO [String]
getRepoConfig :: FilePath -> FilePath -> IO [FilePath]
getRepoConfig FilePath
repo FilePath
key = forall (m :: * -> *) a. MonadCatch m => a -> m a -> m a
catchDefaultIO [] forall a b. (a -> b) -> a -> b
$
FilePath -> [FilePath]
lines forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> [FilePath] -> IO FilePath
readProcess FilePath
"git" [FilePath
"-C", FilePath
repo, FilePath
"config", FilePath
key]
repoAcceptsNonFFs :: FilePath -> RevertableProperty UnixLike UnixLike
repoAcceptsNonFFs :: FilePath -> RevertableProperty UnixLike UnixLike
repoAcceptsNonFFs FilePath
repo = Property UnixLike
accepts forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property UnixLike
refuses
where
accepts :: Property UnixLike
accepts = FilePath -> (FilePath, FilePath) -> Property UnixLike
repoConfigured FilePath
repo (FilePath
"receive.denyNonFastForwards", FilePath
"false")
forall p. IsProp p => p -> FilePath -> p
`describe` FilePath -> FilePath
desc FilePath
"accepts"
refuses :: Property UnixLike
refuses = FilePath -> (FilePath, FilePath) -> Property UnixLike
repoConfigured FilePath
repo (FilePath
"receive.denyNonFastForwards", FilePath
"true")
forall p. IsProp p => p -> FilePath -> p
`describe` FilePath -> FilePath
desc FilePath
"rejects"
desc :: FilePath -> FilePath
desc FilePath
s = FilePath
"git repo " forall a. [a] -> [a] -> [a]
++ FilePath
repo forall a. [a] -> [a] -> [a]
++ FilePath
" " forall a. [a] -> [a] -> [a]
++ FilePath
s forall a. [a] -> [a] -> [a]
++ FilePath
" non-fast-forward pushes"
bareRepoDefaultBranch :: FilePath -> String -> Property UnixLike
bareRepoDefaultBranch :: FilePath -> FilePath -> Property UnixLike
bareRepoDefaultBranch FilePath
repo FilePath
branch =
User -> [FilePath] -> UncheckedProperty UnixLike
userScriptProperty (FilePath -> User
User FilePath
"root")
[ FilePath
"cd " forall a. [a] -> [a] -> [a]
++ FilePath
repo
, FilePath
"git symbolic-ref HEAD refs/heads/" forall a. [a] -> [a] -> [a]
++ FilePath
branch
]
forall (p :: * -> *) i.
Checkable p i =>
p i -> FilePath -> Property i
`changesFileContent` (FilePath
repo FilePath -> FilePath -> FilePath
</> FilePath
"HEAD")
forall p. IsProp p => p -> FilePath -> p
`describe` (FilePath
"git repo at " forall a. [a] -> [a] -> [a]
++ FilePath
repo forall a. [a] -> [a] -> [a]
++ FilePath
" has default branch " forall a. [a] -> [a] -> [a]
++ FilePath
branch)