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
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
|
{- git-annex file content managing for direct mode
-
- This is deprecated, and will be removed when direct mode gets removed
- from git-annex.
-
- Copyright 2012-2014 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Annex.Content.Direct (
associatedFiles,
associatedFilesRelative,
removeAssociatedFile,
removeAssociatedFileUnchecked,
removeAssociatedFiles,
addAssociatedFile,
goodContent,
recordedInodeCache,
updateInodeCache,
addInodeCache,
writeInodeCache,
compareInodeCaches,
sameInodeCache,
elemInodeCaches,
sameFileStatus,
removeInodeCache,
toInodeCache,
addContentWhenNotPresent,
) where
import Common.Annex
import Annex.Perms
import qualified Git
import Utility.Tmp
import Logs.Location
import Utility.InodeCache
import Utility.CopyFile
import Annex.ReplaceFile
import Annex.Link
import Annex.InodeSentinal
{- Absolute FilePaths of Files in the tree that are associated with a key. -}
associatedFiles :: Key -> Annex [FilePath]
associatedFiles key = do
files <- associatedFilesRelative key
top <- fromRepo Git.repoPath
return $ map (top </>) files
{- List of files in the tree that are associated with a key, relative to
- the top of the repo. -}
associatedFilesRelative :: Key -> Annex [FilePath]
associatedFilesRelative key = do
mapping <- calcRepo $ gitAnnexMapping key
liftIO $ catchDefaultIO [] $ withFile mapping ReadMode $ \h -> do
fileEncoding h
-- Read strictly to ensure the file is closed
-- before changeAssociatedFiles tries to write to it.
-- (Especially needed on Windows.)
lines <$> hGetContentsStrict h
{- Changes the associated files information for a key, applying a
- transformation to the list. Returns new associatedFiles value. -}
changeAssociatedFiles :: Key -> ([FilePath] -> [FilePath]) -> Annex [FilePath]
changeAssociatedFiles key transform = do
mapping <- calcRepo $ gitAnnexMapping key
files <- associatedFilesRelative key
let files' = transform files
when (files /= files') $
modifyContent mapping $
liftIO $ viaTmp writeFileAnyEncoding mapping $
unlines files'
top <- fromRepo Git.repoPath
return $ map (top </>) files'
{- Removes the list of associated files. -}
removeAssociatedFiles :: Key -> Annex ()
removeAssociatedFiles key = do
mapping <- calcRepo $ gitAnnexMapping key
modifyContent mapping $
liftIO $ nukeFile mapping
{- Removes an associated file. Returns new associatedFiles value.
- Checks if this was the last copy of the object, and updates location
- log. -}
removeAssociatedFile :: Key -> FilePath -> Annex [FilePath]
removeAssociatedFile key file = do
fs <- removeAssociatedFileUnchecked key file
when (null fs) $
logStatus key InfoMissing
return fs
{- Removes an associated file. Returns new associatedFiles value. -}
removeAssociatedFileUnchecked :: Key -> FilePath -> Annex [FilePath]
removeAssociatedFileUnchecked key file = do
file' <- normaliseAssociatedFile file
changeAssociatedFiles key $ filter (/= file')
{- Adds an associated file. Returns new associatedFiles value. -}
addAssociatedFile :: Key -> FilePath -> Annex [FilePath]
addAssociatedFile key file = do
file' <- normaliseAssociatedFile file
changeAssociatedFiles key $ \files ->
if file' `elem` files
then files
else file':files
{- Associated files are always stored relative to the top of the repository.
- The input FilePath is relative to the CWD, or is absolute. -}
normaliseAssociatedFile :: FilePath -> Annex FilePath
normaliseAssociatedFile file = do
top <- fromRepo Git.repoPath
liftIO $ relPathDirToFile top file
{- Checks if a file in the tree, associated with a key, has not been modified.
-
- To avoid needing to fsck the file's content, which can involve an
- expensive checksum, this relies on a cache that contains the file's
- expected mtime and inode.
-}
goodContent :: Key -> FilePath -> Annex Bool
goodContent key file = sameInodeCache file =<< recordedInodeCache key
{- Gets the recorded inode cache for a key.
-
- A key can be associated with multiple files, so may return more than
- one. -}
recordedInodeCache :: Key -> Annex [InodeCache]
recordedInodeCache key = withInodeCacheFile key $ \f ->
liftIO $ catchDefaultIO [] $
mapMaybe readInodeCache . lines <$> readFileStrict f
{- Caches an inode for a file.
-
- Anything else already cached is preserved.
-}
updateInodeCache :: Key -> FilePath -> Annex ()
updateInodeCache key file = maybe noop (addInodeCache key)
=<< withTSDelta (liftIO . genInodeCache file)
{- Adds another inode to the cache for a key. -}
addInodeCache :: Key -> InodeCache -> Annex ()
addInodeCache key cache = do
oldcaches <- recordedInodeCache key
unlessM (elemInodeCaches cache oldcaches) $
writeInodeCache key (cache:oldcaches)
{- Writes inode cache for a key. -}
writeInodeCache :: Key -> [InodeCache] -> Annex ()
writeInodeCache key caches = withInodeCacheFile key $ \f ->
modifyContent f $
liftIO $ writeFile f $
unlines $ map showInodeCache caches
{- Removes an inode cache. -}
removeInodeCache :: Key -> Annex ()
removeInodeCache key = withInodeCacheFile key $ \f ->
modifyContent f $
liftIO $ nukeFile f
withInodeCacheFile :: Key -> (FilePath -> Annex a) -> Annex a
withInodeCacheFile key a = a =<< calcRepo (gitAnnexInodeCache key)
{- Checks if a FileStatus matches the recorded InodeCache of a file. -}
sameFileStatus :: Key -> FilePath -> FileStatus -> Annex Bool
sameFileStatus key f status = do
old <- recordedInodeCache key
curr <- withTSDelta $ \delta -> liftIO $ toInodeCache delta f status
case (old, curr) of
(_, Just c) -> elemInodeCaches c old
([], Nothing) -> return True
_ -> return False
{- Copies the contentfile to the associated file, if the associated
- file has no content. If the associated file does have content,
- even if the content differs, it's left unchanged. -}
addContentWhenNotPresent :: Key -> FilePath -> FilePath -> Annex ()
addContentWhenNotPresent key contentfile associatedfile = do
v <- isAnnexLink associatedfile
when (Just key == v) $
replaceFile associatedfile $
liftIO . void . copyFileExternal CopyAllMetaData contentfile
updateInodeCache key associatedfile
|
