blob: 09ff042aa6ece1091bed0f6f1e1a19d0810adcee (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
|
{- git-annex command
-
- Copyright 2010-2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
{-# LANGUAGE CPP #-}
module Command.PreCommit where
import Common.Annex
import Command
import Config
import qualified Command.Add
import qualified Command.Fix
import Annex.Direct
import Annex.Hook
import Annex.View
import Annex.View.ViewedFile
import Annex.Perms
import Logs.View
import Logs.MetaData
import Types.View
import Types.MetaData
#ifdef mingw32_HOST_OS
import Utility.WinLock
#endif
import qualified Data.Set as S
def :: [Command]
def = [command "pre-commit" paramPaths seek SectionPlumbing
"run by git pre-commit hook"]
seek :: CommandSeek
seek ps = lockPreCommitHook $ ifM isDirect
( do
-- update direct mode mappings for committed files
withWords startDirect ps
runAnnexHook preCommitAnnexHook
, do
-- fix symlinks to files being committed
withFilesToBeCommitted (whenAnnexed Command.Fix.start) ps
-- inject unlocked files into the annex
withFilesUnlockedToBeCommitted startIndirect ps
runAnnexHook preCommitAnnexHook
-- committing changes to a view updates metadata
mv <- currentView
case mv of
Nothing -> noop
Just v -> withViewChanges
(addViewMetaData v)
(removeViewMetaData v)
)
startIndirect :: FilePath -> CommandStart
startIndirect f = next $ do
unlessM (callCommandAction $ Command.Add.start f) $
error $ "failed to add " ++ f ++ "; canceling commit"
next $ return True
startDirect :: [String] -> CommandStart
startDirect _ = next $ next $ preCommitDirect
addViewMetaData :: View -> ViewedFile -> Key -> CommandStart
addViewMetaData v f k = do
showStart "metadata" f
next $ next $ changeMetaData k $ fromView v f
removeViewMetaData :: View -> ViewedFile -> Key -> CommandStart
removeViewMetaData v f k = do
showStart "metadata" f
next $ next $ changeMetaData k $ unsetMetaData $ fromView v f
changeMetaData :: Key -> MetaData -> CommandCleanup
changeMetaData k metadata = do
showMetaDataChange metadata
addMetaData k metadata
return True
showMetaDataChange :: MetaData -> Annex ()
showMetaDataChange = showLongNote . unlines . concatMap showmeta . fromMetaData
where
showmeta (f, vs) = map (showmetavalue f) $ S.toList vs
showmetavalue f v = fromMetaField f ++ showset v ++ "=" ++ fromMetaValue v
showset v
| isSet v = "+"
| otherwise = "-"
{- Takes exclusive lock; blocks until available. -}
lockPreCommitHook :: Annex a -> Annex a
lockPreCommitHook a = do
lockfile <- fromRepo gitAnnexPreCommitLock
createAnnexDirectory $ takeDirectory lockfile
mode <- annexFileMode
bracketIO (lock lockfile mode) unlock (const a)
where
#ifndef mingw32_HOST_OS
lock lockfile mode = do
l <- liftIO $ noUmask mode $ createFile lockfile mode
liftIO $ waitToSetLock l (WriteLock, AbsoluteSeek, 0, 0)
return l
unlock = closeFd
#else
lock lockfile _mode = liftIO $ waitToLock $ lockExclusive lockfile
unlock = dropLock
#endif
|
