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
|
{- 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,
goodContent,
updateCache,
recordedCache,
compareCache,
removeCache
) where
import Common.Annex
import qualified Git
import System.Posix.Types
{- Files in the tree that are associated with a key.
-
- When no known associated files exist, returns the gitAnnexLocation. -}
associatedFiles :: Key -> Annex [FilePath]
associatedFiles key = do
mapping <- inRepo $ gitAnnexMapping key
files <- liftIO $ catchDefaultIO [] $ lines <$> readFile mapping
if null files
then do
l <- inRepo $ gitAnnexLocation key
return [l]
else do
top <- fromRepo Git.repoPath
return $ map (top </>) files
{- 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 <- recordedCache key
compareCache file old
{- Gets the recorded cache for a key. -}
recordedCache :: Key -> Annex (Maybe Cache)
recordedCache key = withCacheFile key $ \cachefile ->
catchDefaultIO Nothing $ readCache <$> readFile cachefile
{- Compares a cache with the current cache for a file. -}
compareCache :: FilePath -> Maybe Cache -> Annex Bool
compareCache file old = do
curr <- liftIO $ genCache file
return $ isJust curr && curr == old
{- Stores a cache of attributes for a file that is associated with a key. -}
updateCache :: Key -> FilePath -> Annex ()
updateCache key file = withCacheFile key $ \cachefile ->
maybe noop (writeFile cachefile . showCache) =<< genCache file
{- Removes a cache. -}
removeCache :: Key -> Annex ()
removeCache key = withCacheFile key nukeFile
withCacheFile :: Key -> (FilePath -> IO a) -> Annex a
withCacheFile key a = liftIO . a =<< inRepo (gitAnnexCache key)
{- Cache a file's inode, size, and modification time to determine if it's
- been changed. -}
data Cache = Cache FileID FileOffset EpochTime
deriving (Eq)
showCache :: Cache -> String
showCache (Cache inode size mtime) = unwords
[ show inode
, show size
, show mtime
]
readCache :: String -> Maybe Cache
readCache s = case words s of
(inode:size:mtime:_) -> Cache
<$> readish inode
<*> readish size
<*> readish mtime
_ -> Nothing
genCache :: FilePath -> IO (Maybe Cache)
genCache f = catchDefaultIO Nothing $ toCache <$> getFileStatus f
toCache :: FileStatus -> Maybe Cache
toCache s
| isRegularFile s = Just $ Cache
(fileID s)
(fileSize s)
(modificationTime s)
| otherwise = Nothing
|
