6158036e23
Using msysgit with git-annex is no longer supported. At the same time, I'm updating the rsync.exe in my downloads repository with the one from msys2. Note that rsync is currently still being ldded and installed in Git/cmd/ like the other cygwin programs. The ldd fails and this failure is ignored. It would be better to special case it to go in Git/usr/bin/, so that the user can't run rsync in a dos prompt window, which doesn't work, as it needs additional libs. However, as far as git-annex running rsync running ssh, it works ok in this location. Removed the ssh.cmd and ssh-keygen.cmd; these are not needed with git for windows. Keeping them would let ssh be run manually from a dos prompt window, but that's not really a goal.
97 lines
2.1 KiB
Haskell
97 lines
2.1 KiB
Haskell
{- git hooks
|
|
-
|
|
- Copyright 2013-2015 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE CPP #-}
|
|
|
|
module Git.Hook where
|
|
|
|
import Common
|
|
import Git
|
|
import Utility.Tmp
|
|
#ifndef mingw32_HOST_OS
|
|
import Utility.FileMode
|
|
#endif
|
|
|
|
data Hook = Hook
|
|
{ hookName :: FilePath
|
|
, hookScript :: String
|
|
}
|
|
deriving (Ord)
|
|
|
|
instance Eq Hook where
|
|
a == b = hookName a == hookName b
|
|
|
|
hookFile :: Hook -> Repo -> FilePath
|
|
hookFile h r = localGitDir r </> "hooks" </> hookName h
|
|
|
|
{- Writes a hook. Returns False if the hook already exists with a different
|
|
- content. -}
|
|
hookWrite :: Hook -> Repo -> IO Bool
|
|
hookWrite h r = do
|
|
let f = hookFile h r
|
|
ifM (doesFileExist f)
|
|
( expectedContent h r
|
|
, do
|
|
viaTmp writeFile f (hookScript h)
|
|
p <- getPermissions f
|
|
setPermissions f $ p {executable = True}
|
|
return True
|
|
)
|
|
|
|
{- Removes a hook. Returns False if the hook contained something else, and
|
|
- could not be removed. -}
|
|
hookUnWrite :: Hook -> Repo -> IO Bool
|
|
hookUnWrite h r = do
|
|
let f = hookFile h r
|
|
ifM (doesFileExist f)
|
|
( ifM (expectedContent h r)
|
|
( do
|
|
removeFile f
|
|
return True
|
|
, return False
|
|
)
|
|
, return True
|
|
)
|
|
|
|
expectedContent :: Hook -> Repo -> IO Bool
|
|
expectedContent h r = do
|
|
content <- readFile $ hookFile h r
|
|
return $ content == hookScript h
|
|
|
|
hookExists :: Hook -> Repo -> IO Bool
|
|
hookExists h r = do
|
|
let f = hookFile h r
|
|
catchBoolIO $
|
|
#ifndef mingw32_HOST_OS
|
|
isExecutable . fileMode <$> getFileStatus f
|
|
#else
|
|
doesFileExist f
|
|
#endif
|
|
|
|
runHook :: Hook -> Repo -> IO Bool
|
|
runHook h r = do
|
|
let f = hookFile h r
|
|
(c, ps) <- findcmd f
|
|
boolSystem c ps
|
|
where
|
|
#ifndef mingw32_HOST_OS
|
|
findcmd = defcmd
|
|
#else
|
|
{- Like git for windows, parse the first line of the hook file,
|
|
- look for "#!", and dispatch the interpreter on the file. -}
|
|
findcmd f = do
|
|
l <- headMaybe . lines <$> catchDefaultIO "" (readFile f)
|
|
case l of
|
|
Just ('#':'!':rest) -> case words rest of
|
|
[] -> defcmd f
|
|
(c:ps) -> do
|
|
let ps' = map Param (ps ++ [f])
|
|
ok <- inPath c
|
|
return (if ok then c else takeFileName c, ps')
|
|
_ -> defcmd f
|
|
#endif
|
|
defcmd f = return (f, [])
|