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
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
|
{- git-annex command
-
- Copyright 2012 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
{-# LANGUAGE BangPatterns #-}
module Command.Watch where
import Common.Annex
import Command
import Utility.Inotify
import Utility.ThreadLock
import qualified Annex
import qualified Command.Add
import qualified Git
import qualified Git.Command
import qualified Git.UpdateIndex
import Git.HashObject
import Git.Types
import Git.FilePath
import qualified Backend
import Annex.Content
import Control.Exception as E
import System.INotify
import Control.Concurrent.MVar
def :: [Command]
def = [command "watch" paramPaths seek "watch for changes"]
seek :: [CommandSeek]
seek = [withNothing start]
start :: CommandStart
start = notBareRepo $ do
showStart "watch" "."
showAction "scanning"
inRepo $ Git.Command.run "add" [Param "--update"]
state <- Annex.getState id
mvar <- liftIO $ newMVar state
next $ next $ liftIO $ withINotify $ \i -> do
let hook a = Just $ runAnnex mvar a
watchDir i "." (ignored . takeFileName)
(hook onTooMany)
(hook onAdd) (hook onAddSymlink)
(hook onDel) (hook onDelDir)
putStrLn "(started)"
waitForTermination
return True
where
ignored ".git" = True
ignored ".gitignore" = True
ignored ".gitattributes" = True
ignored _ = False
{- Runs a handler, inside the Annex monad.
-
- Exceptions by the handlers are ignored, otherwise a whole watcher
- thread could be crashed.
-}
runAnnex :: MVar Annex.AnnexState -> (FilePath -> Annex a) -> FilePath -> IO ()
runAnnex mvar a f = do
startstate <- takeMVar mvar
r <- E.try (go startstate) :: IO (Either E.SomeException Annex.AnnexState)
case r of
Left e -> do
putStrLn (show e)
putMVar mvar startstate
Right !newstate ->
putMVar mvar newstate
where
go state = Annex.exec state $ a f
{- Adding a file is tricky; the file has to be replaced with a symlink
- but this is race prone, as the symlink could be changed immediately
- after creation. To avoid that race, git add is not used to stage the
- symlink. -}
onAdd :: FilePath -> Annex ()
onAdd file = do
showStart "add" file
Command.Add.ingest file >>= go
where
go Nothing = showEndFail
go (Just key) = do
link <- Command.Add.link file key True
inRepo $ stageSymlink file link
showEndOk
{- A symlink might be an arbitrary symlink, which is just added.
- Or, if it is a git-annex symlink, ensure it points to the content
- before adding it.
-}
onAddSymlink :: FilePath -> Annex ()
onAddSymlink file = go =<< Backend.lookupFile file
where
go Nothing = addlink =<< liftIO (readSymbolicLink file)
go (Just (key, _)) = do
link <- calcGitLink file key
ifM ((==) link <$> liftIO (readSymbolicLink file))
( addlink link
, do
liftIO $ removeFile file
liftIO $ createSymbolicLink link file
addlink link
)
addlink link = inRepo $ stageSymlink file link
{- The file could reappear at any time, so --cached is used, to only delete
- it from the index. -}
onDel :: FilePath -> Annex ()
onDel file = inRepo $ Git.Command.run "rm"
[Params "--quiet --cached --ignore-unmatch --", File file]
{- A directory has been deleted, or moved, so tell git to remove anything
- that was inside it from its cache. -}
onDelDir :: FilePath -> Annex ()
onDelDir dir = inRepo $ Git.Command.run "rm"
[Params "--quiet -r --cached --ignore-unmatch --", File dir]
{- There are too many directories for inotify to watch them all. -}
onTooMany :: FilePath -> Annex ()
onTooMany dir = do
sysctlval <- liftIO $ runsysctl [Param maxwatches]
warning $ unlines $
basewarning : maybe withoutsysctl withsysctl sysctlval
where
maxwatches = "fs.inotify.max_user_watches"
basewarning = "Too many directories to watch! (Not watching " ++ dir ++")"
withoutsysctl = ["Increase the value in /proc/sys/fs/inotify/max_user_watches"]
withsysctl n = let new = n * 10 in
[ "Increase the limit by running:"
, " echo " ++ maxwatches ++ "=" ++ show new ++
" | sudo tee -a /etc/sysctl.conf; sudo sysctl -p"
]
runsysctl ps = do
v <- catchMaybeIO $ hPipeFrom "sysctl" $ toCommand ps
case v of
Nothing -> return Nothing
Just (pid, h) -> do
val <- parsesysctl <$> liftIO (hGetContentsStrict h)
void $ getProcessStatus True False $ processID pid
return val
parsesysctl :: String -> Maybe Integer
parsesysctl s = readish =<< lastMaybe (words s)
{- Adds a symlink to the index, without ever accessing the actual symlink
- on disk. -}
stageSymlink :: FilePath -> String -> Git.Repo -> IO ()
stageSymlink file linktext repo = Git.UpdateIndex.stream_update_index repo [stage]
where
stage streamer = do
line <- Git.UpdateIndex.update_index_line
<$> (hashObject repo BlobObject linktext)
<*> pure SymlinkBlob
<*> toTopFilePath file repo
streamer line
|
