1{- git-annex object content presence
2 -
3 - Copyright 2010-2021 Joey Hess <id@joeyh.name>
4 -
5 - Licensed under the GNU AGPL version 3 or higher.
6 -}
7
8{-# LANGUAGE CPP #-}
9
10module Annex.Content.Presence (
11	inAnnex,
12	inAnnex',
13	inAnnexSafe,
14	inAnnexCheck,
15	objectFileExists,
16	withObjectLoc,
17	isUnmodified,
18	isUnmodified',
19	isUnmodifiedCheap,
20	contentLockFile,
21) where
22
23import Annex.Content.Presence.LowLevel
24import Annex.Common
25import qualified Annex
26import Annex.LockPool
27import qualified Database.Keys
28import Annex.InodeSentinal
29import Utility.InodeCache
30import qualified Utility.RawFilePath as R
31
32#ifdef mingw32_HOST_OS
33import Annex.Perms
34#endif
35
36{- Checks if a given key's content is currently present. -}
37inAnnex :: Key -> Annex Bool
38inAnnex key = inAnnexCheck key $ liftIO . R.doesPathExist
39
40{- Runs an arbitrary check on a key's content. -}
41inAnnexCheck :: Key -> (RawFilePath -> Annex Bool) -> Annex Bool
42inAnnexCheck key check = inAnnex' id False check key
43
44{- inAnnex that performs an arbitrary check of the key's content. -}
45inAnnex' :: (a -> Bool) -> a -> (RawFilePath -> Annex a) -> Key -> Annex a
46inAnnex' isgood bad check key = withObjectLoc key $ \loc -> do
47	r <- check loc
48	if isgood r
49		then ifM (annexThin <$> Annex.getGitConfig)
50			-- When annex.thin is set, the object file
51			-- could be modified; make sure it's not.
52			-- (Suppress any messages about
53			-- checksumming, to avoid them cluttering
54			-- the display.)
55			( ifM (doQuietAction $ isUnmodified key loc)
56				( return r
57				, return bad
58				)
59			, return r
60			)
61		else return bad
62
63{- Like inAnnex, checks if the object file for a key exists,
64 - but there are no guarantees it has the right content. -}
65objectFileExists :: Key -> Annex Bool
66objectFileExists key =
67	calcRepo (gitAnnexLocation key)
68		>>= liftIO . R.doesPathExist
69
70{- A safer check; the key's content must not only be present, but
71 - is not in the process of being removed. -}
72inAnnexSafe :: Key -> Annex (Maybe Bool)
73inAnnexSafe key = inAnnex' (fromMaybe True) (Just False) go key
74  where
75	is_locked = Nothing
76	is_unlocked = Just True
77	is_missing = Just False
78
79	go contentfile = flip checklock contentfile =<< contentLockFile key
80
81#ifndef mingw32_HOST_OS
82	checklock Nothing contentfile = checkOr is_missing contentfile
83	{- The content file must exist, but the lock file generally
84	 - won't exist unless a removal is in process. -}
85	checklock (Just lockfile) contentfile =
86		ifM (liftIO $ doesFileExist (fromRawFilePath contentfile))
87			( checkOr is_unlocked lockfile
88			, return is_missing
89			)
90	checkOr d lockfile = checkLocked lockfile >>= return . \case
91		Nothing -> d
92		Just True -> is_locked
93		Just False -> is_unlocked
94#else
95	checklock Nothing contentfile = liftIO $ ifM (doesFileExist (fromRawFilePath contentfile))
96		( lockShared contentfile >>= \case
97			Nothing -> return is_locked
98			Just lockhandle -> do
99				dropLock lockhandle
100				return is_unlocked
101		, return is_missing
102		)
103	{- In Windows, see if we can take a shared lock. If so,
104	 - remove the lock file to clean up after ourselves. -}
105	checklock (Just lockfile) contentfile =
106		ifM (liftIO $ doesFileExist (fromRawFilePath contentfile))
107			( modifyContent lockfile $ liftIO $
108				lockShared lockfile >>= \case
109					Nothing -> return is_locked
110					Just lockhandle -> do
111						dropLock lockhandle
112						void $ tryIO $ removeWhenExistsWith R.removeLink lockfile
113						return is_unlocked
114			, return is_missing
115			)
116#endif
117
118{- Windows has to use a separate lock file from the content, since
119 - locking the actual content file would interfere with the user's
120 - use of it. -}
121contentLockFile :: Key -> Annex (Maybe RawFilePath)
122#ifndef mingw32_HOST_OS
123contentLockFile _ = pure Nothing
124#else
125contentLockFile key = Just <$> calcRepo (gitAnnexContentLock key)
126#endif
127
128{- Performs an action, passing it the location to use for a key's content. -}
129withObjectLoc :: Key -> (RawFilePath -> Annex a) -> Annex a
130withObjectLoc key a = a =<< calcRepo (gitAnnexLocation key)
131
132{- Check if a file contains the unmodified content of the key.
133 -
134 - The expensive way to tell is to do a verification of its content.
135 - The cheaper way is to see if the InodeCache for the key matches the
136 - file. -}
137isUnmodified :: Key -> RawFilePath -> Annex Bool
138isUnmodified key f =
139	withTSDelta (liftIO . genInodeCache f) >>= \case
140		Just fc -> do
141			ic <- Database.Keys.getInodeCaches key
142			isUnmodified' key f fc ic
143		Nothing -> return False
144
145isUnmodified' :: Key -> RawFilePath -> InodeCache -> [InodeCache] -> Annex Bool
146isUnmodified' = isUnmodifiedLowLevel Database.Keys.addInodeCaches
147
148{- Cheap check if a file contains the unmodified content of the key,
149 - only checking the InodeCache of the key.
150 -
151 - When the InodeCache is stale, this may incorrectly report that a file is
152 - modified.
153 -
154 - Note that, on systems not supporting high-resolution mtimes,
155 - this may report a false positive when repeated edits are made to a file
156 - within a small time window (eg 1 second).
157 -}
158isUnmodifiedCheap :: Key -> RawFilePath -> Annex Bool
159isUnmodifiedCheap key f = maybe (return False) (isUnmodifiedCheap' key)
160	=<< withTSDelta (liftIO . genInodeCache f)
161
162isUnmodifiedCheap' :: Key -> InodeCache -> Annex Bool
163isUnmodifiedCheap' key fc = isUnmodifiedCheapLowLevel fc
164	=<< Database.Keys.getInodeCaches key
165