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
|
{- git-annex file content managing for direct mode
-
- Copyright 2010,2012 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,
compareInodeCache,
toInodeCache,
) where
import Common.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 -> do
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 = do
old <- recordedInodeCache key
liftIO $ compareInodeCache file old
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
withInodeCacheFile :: Key -> (FilePath -> Annex a) -> Annex a
withInodeCacheFile key a = a =<< inRepo (gitAnnexInodeCache key)
|
