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