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
|
{- git-annex file content managing for direct mode
-
- Copyright 2012-2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Annex.Content.Direct (
associatedFiles,
removeAssociatedFile,
addAssociatedFile,
goodContent,
changedFileStatus,
recordedInodeCache,
updateInodeCache,
writeInodeCache,
sameInodeCache,
removeInodeCache,
toInodeCache,
) where
import Common.Annex
import qualified Annex
import Annex.Perms
import qualified Git
import Utility.TempFile
import Logs.Location
import Utility.InodeCache
{- 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 <- inRepo $ gitAnnexMapping key
liftIO $ catchDefaultIO [] $ do
h <- openFile mapping ReadMode
fileEncoding h
lines <$> hGetContents 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 <- inRepo $ gitAnnexMapping key
files <- associatedFilesRelative key
let files' = transform files
when (files /= files') $ do
createContentDir mapping
liftIO $ viaTmp write mapping $ unlines files'
top <- fromRepo Git.repoPath
return $ map (top </>) files'
where
write file content = do
h <- openFile file WriteMode
fileEncoding h
hPutStr h content
hClose h
{- Removes an associated file. Returns new associatedFiles value. -}
removeAssociatedFile :: Key -> FilePath -> Annex [FilePath]
removeAssociatedFile key file = do
file' <- normaliseAssociatedFile file
fs <- changeAssociatedFiles key $ filter (/= file')
when (null fs) $
logStatus key InfoMissing
return fs
{- 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. -}
normaliseAssociatedFile :: FilePath -> Annex FilePath
normaliseAssociatedFile file = do
top <- fromRepo Git.repoPath
liftIO $ relPathDirToFile top <$> absPath 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
changedFileStatus :: Key -> FileStatus -> Annex Bool
changedFileStatus key status = do
old <- recordedInodeCache key
let curr = toInodeCache status
return $ curr /= old
{- Gets the recorded inode cache for a key. -}
recordedInodeCache :: Key -> Annex (Maybe InodeCache)
recordedInodeCache key = withInodeCacheFile key $ \f ->
liftIO $ catchDefaultIO Nothing $ readInodeCache <$> readFile f
{- Stores a cache of attributes for a file that is associated with a key. -}
updateInodeCache :: Key -> FilePath -> Annex ()
updateInodeCache key file = maybe noop (writeInodeCache key)
=<< liftIO (genInodeCache file)
{- Writes a cache for a key. -}
writeInodeCache :: Key -> InodeCache -> Annex ()
writeInodeCache key cache = withInodeCacheFile key $ \f -> do
createContentDir f
liftIO $ writeFile f $ showInodeCache cache
{- Removes an inode cache. -}
removeInodeCache :: Key -> Annex ()
removeInodeCache key = withInodeCacheFile key $ \f -> do
createContentDir f -- also thaws directory
liftIO $ nukeFile f
withInodeCacheFile :: Key -> (FilePath -> Annex a) -> Annex a
withInodeCacheFile key a = a =<< inRepo (gitAnnexInodeCache key)
{- Checks if a file's InodeCache matches its current info.
-
- If the inodes have changed, only the size and mtime are compared.
-}
sameInodeCache :: FilePath -> Maybe InodeCache -> Annex Bool
sameInodeCache _ Nothing = return False
sameInodeCache file (Just old) = go =<< liftIO (genInodeCache file)
where
go Nothing = return False
go (Just curr)
| curr == old = return True
| otherwise = ifM inodesChanged
( return $ compareWeak curr old
, return False
)
{- Some filesystems get new inodes each time they are mounted.
- In order to work on such a filesystem, a sentinal file is used to detect
- when the inodes have changed. -}
inodesChanged :: Annex Bool
inodesChanged = maybe calc return =<< Annex.getState Annex.inodeschanged
where
calc = do
sentinalfile <- fromRepo gitAnnexInodeSentinal
sentinalcachefile <- fromRepo gitAnnexInodeSentinalCache
scache <- liftIO $ genInodeCache sentinalfile
scached <- liftIO $ catchMaybeIO $ readInodeCache <$> readFile sentinalcachefile
case (scache, scached) of
(Just c1, Just (Just c2)) -> changed $ c1 /= c2
_ -> do
writesentinal
changed True
changed v = do
Annex.changeState $ \s -> s { Annex.inodeschanged = Just v }
return v
writesentinal = do
sentinalfile <- fromRepo gitAnnexInodeSentinal
sentinalcachefile <- fromRepo gitAnnexInodeSentinalCache
liftIO $ writeFile sentinalfile ""
liftIO $ maybe noop (writeFile sentinalcachefile . showInodeCache)
=<< genInodeCache sentinalfile
|
