1{- git hooks 2 - 3 - Copyright 2013-2018 Joey Hess <id@joeyh.name> 4 - 5 - Licensed under the GNU AGPL version 3 or higher. 6 -} 7 8{-# LANGUAGE CPP #-} 9 10module Git.Hook where 11 12import Common 13import Git 14import Utility.Tmp 15import Utility.Shell 16import Utility.FileMode 17 18data Hook = Hook 19 { hookName :: FilePath 20 , hookScript :: String 21 , hookOldScripts :: [String] 22 } 23 deriving (Ord) 24 25instance Eq Hook where 26 a == b = hookName a == hookName b 27 28hookFile :: Hook -> Repo -> FilePath 29hookFile h r = fromRawFilePath (localGitDir r) </> "hooks" </> hookName h 30 31{- Writes a hook. Returns False if the hook already exists with a different 32 - content. Upgrades old scripts. 33 - 34 - This can install hooks on both filesystem like FAT that do not support 35 - execute bits, and on Windows. 36 - 37 - If the filesystem does not support execute bits, it's typically mounted 38 - such that all files have the execute bit set. So just write the hook 39 - and ignore failure to make it executable. 40 - 41 - On Windows, git will run hooks that are not executable. The hook 42 - is run with a bundled bash, so should start with #!/bin/sh 43 -} 44hookWrite :: Hook -> Repo -> IO Bool 45hookWrite h r = ifM (doesFileExist f) 46 ( expectedContent h r >>= \case 47 UnexpectedContent -> return False 48 ExpectedContent -> return True 49 OldExpectedContent -> go 50 , go 51 ) 52 where 53 f = hookFile h r 54 go = do 55 viaTmp writeFile f (hookScript h) 56 void $ tryIO $ modifyFileMode 57 (toRawFilePath f) 58 (addModes executeModes) 59 return True 60 61{- Removes a hook. Returns False if the hook contained something else, and 62 - could not be removed. -} 63hookUnWrite :: Hook -> Repo -> IO Bool 64hookUnWrite h r = ifM (doesFileExist f) 65 ( expectedContent h r >>= \case 66 UnexpectedContent -> return False 67 _ -> do 68 removeFile f 69 return True 70 , return True 71 ) 72 where 73 f = hookFile h r 74 75data ExpectedContent = UnexpectedContent | ExpectedContent | OldExpectedContent 76 77expectedContent :: Hook -> Repo -> IO ExpectedContent 78expectedContent h r = do 79 content <- readFile $ hookFile h r 80 return $ if content == hookScript h 81 then ExpectedContent 82 else if any (content ==) (hookOldScripts h) 83 then OldExpectedContent 84 else UnexpectedContent 85 86hookExists :: Hook -> Repo -> IO Bool 87hookExists h r = do 88 let f = hookFile h r 89 catchBoolIO $ 90#ifndef mingw32_HOST_OS 91 isExecutable . fileMode <$> getFileStatus f 92#else 93 doesFileExist f 94#endif 95 96runHook :: Hook -> Repo -> IO Bool 97runHook h r = do 98 let f = hookFile h r 99 (c, ps) <- findShellCommand f 100 boolSystem c ps 101