use RawFilePath getFileStatus for speed
Only done on those calls to getFileStatus that had a RawFilePath, not a FilePath. The others would probably be just as fast if converted to use it with toRawFilePath, but I'm not 100% sure. Note that genInodeCache' uses fromRawFilePath, but that value only gets used on Windows, so on unix the thunk will never be evaluated.
This commit is contained in:
parent
0e9d699ef3
commit
5f391179f1
9 changed files with 36 additions and 21 deletions
|
@ -182,7 +182,7 @@ restagePointerFile (Restage True) f orig = withTSDelta $ \tsd -> do
|
||||||
absf <- liftIO $ absPath $ fromRawFilePath f
|
absf <- liftIO $ absPath $ fromRawFilePath f
|
||||||
Annex.Queue.addInternalAction runner [(absf, isunmodified tsd)]
|
Annex.Queue.addInternalAction runner [(absf, isunmodified tsd)]
|
||||||
where
|
where
|
||||||
isunmodified tsd = genInodeCache (fromRawFilePath f) tsd >>= return . \case
|
isunmodified tsd = genInodeCache' f tsd >>= return . \case
|
||||||
Nothing -> False
|
Nothing -> False
|
||||||
Just new -> compareStrong orig new
|
Just new -> compareStrong orig new
|
||||||
|
|
||||||
|
|
|
@ -56,30 +56,30 @@ start fixwhat file key = do
|
||||||
obj <- calcRepo $ gitAnnexLocation key
|
obj <- calcRepo $ gitAnnexLocation key
|
||||||
stopUnless (isUnmodified key (fromRawFilePath file) <&&> isUnmodified key obj) $ do
|
stopUnless (isUnmodified key (fromRawFilePath file) <&&> isUnmodified key obj) $ do
|
||||||
thin <- annexThin <$> Annex.getGitConfig
|
thin <- annexThin <$> Annex.getGitConfig
|
||||||
fs <- liftIO $ catchMaybeIO $ getFileStatus (fromRawFilePath file)
|
fs <- liftIO $ catchMaybeIO $ R.getFileStatus file
|
||||||
os <- liftIO $ catchMaybeIO $ getFileStatus obj
|
os <- liftIO $ catchMaybeIO $ getFileStatus obj
|
||||||
case (linkCount <$> fs, linkCount <$> os, thin) of
|
case (linkCount <$> fs, linkCount <$> os, thin) of
|
||||||
(Just 1, Just 1, True) ->
|
(Just 1, Just 1, True) ->
|
||||||
fixby $ makeHardLink (fromRawFilePath file) key
|
fixby $ makeHardLink file key
|
||||||
(Just n, Just n', False) | n > 1 && n == n' ->
|
(Just n, Just n', False) | n > 1 && n == n' ->
|
||||||
fixby $ breakHardLink (fromRawFilePath file) key obj
|
fixby $ breakHardLink file key obj
|
||||||
_ -> stop
|
_ -> stop
|
||||||
|
|
||||||
breakHardLink :: FilePath -> Key -> FilePath -> CommandPerform
|
breakHardLink :: RawFilePath -> Key -> FilePath -> CommandPerform
|
||||||
breakHardLink file key obj = do
|
breakHardLink file key obj = do
|
||||||
replaceFile file $ \tmp -> do
|
replaceFile (fromRawFilePath file) $ \tmp -> do
|
||||||
mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus file
|
mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file
|
||||||
unlessM (checkedCopyFile key obj tmp mode) $
|
unlessM (checkedCopyFile key obj tmp mode) $
|
||||||
error "unable to break hard link"
|
error "unable to break hard link"
|
||||||
thawContent tmp
|
thawContent tmp
|
||||||
modifyContent obj $ freezeContent obj
|
modifyContent obj $ freezeContent obj
|
||||||
Database.Keys.storeInodeCaches key [file]
|
Database.Keys.storeInodeCaches key [fromRawFilePath file]
|
||||||
next $ return True
|
next $ return True
|
||||||
|
|
||||||
makeHardLink :: FilePath -> Key -> CommandPerform
|
makeHardLink :: RawFilePath -> Key -> CommandPerform
|
||||||
makeHardLink file key = do
|
makeHardLink file key = do
|
||||||
replaceFile file $ \tmp -> do
|
replaceFile (fromRawFilePath file) $ \tmp -> do
|
||||||
mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus file
|
mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file
|
||||||
linkFromAnnex key tmp mode >>= \case
|
linkFromAnnex key tmp mode >>= \case
|
||||||
LinkAnnexFailed -> error "unable to make hard link"
|
LinkAnnexFailed -> error "unable to make hard link"
|
||||||
_ -> noop
|
_ -> noop
|
||||||
|
|
|
@ -35,6 +35,7 @@ import qualified Database.Fsck as FsckDb
|
||||||
import Types.CleanupActions
|
import Types.CleanupActions
|
||||||
import Types.Key
|
import Types.Key
|
||||||
import Types.ActionItem
|
import Types.ActionItem
|
||||||
|
import qualified Utility.RawFilePath as R
|
||||||
|
|
||||||
import Data.Time.Clock.POSIX
|
import Data.Time.Clock.POSIX
|
||||||
import System.Posix.Types (EpochTime)
|
import System.Posix.Types (EpochTime)
|
||||||
|
@ -327,7 +328,7 @@ verifyWorkTree key file = do
|
||||||
Just k | k == key -> whenM (inAnnex key) $ do
|
Just k | k == key -> whenM (inAnnex key) $ do
|
||||||
showNote "fixing worktree content"
|
showNote "fixing worktree content"
|
||||||
replaceFile (fromRawFilePath file) $ \tmp -> do
|
replaceFile (fromRawFilePath file) $ \tmp -> do
|
||||||
mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus (fromRawFilePath file)
|
mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file
|
||||||
ifM (annexThin <$> Annex.getGitConfig)
|
ifM (annexThin <$> Annex.getGitConfig)
|
||||||
( void $ linkFromAnnex key tmp mode
|
( void $ linkFromAnnex key tmp mode
|
||||||
, do
|
, do
|
||||||
|
|
|
@ -56,7 +56,7 @@ performNew :: RawFilePath -> Key -> CommandPerform
|
||||||
performNew file key = do
|
performNew file key = do
|
||||||
lockdown =<< calcRepo (gitAnnexLocation key)
|
lockdown =<< calcRepo (gitAnnexLocation key)
|
||||||
addLink (fromRawFilePath file) key
|
addLink (fromRawFilePath file) key
|
||||||
=<< withTSDelta (liftIO . genInodeCache (fromRawFilePath file))
|
=<< withTSDelta (liftIO . genInodeCache' file)
|
||||||
next $ cleanupNew file key
|
next $ cleanupNew file key
|
||||||
where
|
where
|
||||||
lockdown obj = do
|
lockdown obj = do
|
||||||
|
@ -70,7 +70,7 @@ performNew file key = do
|
||||||
-- It's ok if the file is hard linked to obj, but if some other
|
-- It's ok if the file is hard linked to obj, but if some other
|
||||||
-- associated file is, we need to break that link to lock down obj.
|
-- associated file is, we need to break that link to lock down obj.
|
||||||
breakhardlink obj = whenM (catchBoolIO $ (> 1) . linkCount <$> liftIO (getFileStatus obj)) $ do
|
breakhardlink obj = whenM (catchBoolIO $ (> 1) . linkCount <$> liftIO (getFileStatus obj)) $ do
|
||||||
mfc <- withTSDelta (liftIO . genInodeCache (fromRawFilePath file))
|
mfc <- withTSDelta (liftIO . genInodeCache' file)
|
||||||
unlessM (sameInodeCache obj (maybeToList mfc)) $ do
|
unlessM (sameInodeCache obj (maybeToList mfc)) $ do
|
||||||
modifyContent obj $ replaceFile obj $ \tmp -> do
|
modifyContent obj $ replaceFile obj $ \tmp -> do
|
||||||
unlessM (checkedCopyFile key obj tmp Nothing) $
|
unlessM (checkedCopyFile key obj tmp Nothing) $
|
||||||
|
|
|
@ -19,6 +19,7 @@ import Git.FilePath
|
||||||
import qualified Database.Keys
|
import qualified Database.Keys
|
||||||
import Annex.InodeSentinal
|
import Annex.InodeSentinal
|
||||||
import Utility.InodeCache
|
import Utility.InodeCache
|
||||||
|
import qualified Utility.RawFilePath as R
|
||||||
|
|
||||||
cmd :: Command
|
cmd :: Command
|
||||||
cmd = command "rekey" SectionPlumbing
|
cmd = command "rekey" SectionPlumbing
|
||||||
|
@ -89,14 +90,14 @@ linkKey file oldkey newkey = ifM (isJust <$> isAnnexLink file)
|
||||||
- it's hard linked to the old key, that link must be broken. -}
|
- it's hard linked to the old key, that link must be broken. -}
|
||||||
oldobj <- calcRepo (gitAnnexLocation oldkey)
|
oldobj <- calcRepo (gitAnnexLocation oldkey)
|
||||||
v <- tryNonAsync $ do
|
v <- tryNonAsync $ do
|
||||||
st <- liftIO $ getFileStatus (fromRawFilePath file)
|
st <- liftIO $ R.getFileStatus file
|
||||||
when (linkCount st > 1) $ do
|
when (linkCount st > 1) $ do
|
||||||
freezeContent oldobj
|
freezeContent oldobj
|
||||||
replaceFile (fromRawFilePath file) $ \tmp -> do
|
replaceFile (fromRawFilePath file) $ \tmp -> do
|
||||||
unlessM (checkedCopyFile oldkey oldobj tmp Nothing) $
|
unlessM (checkedCopyFile oldkey oldobj tmp Nothing) $
|
||||||
error "can't lock old key"
|
error "can't lock old key"
|
||||||
thawContent tmp
|
thawContent tmp
|
||||||
ic <- withTSDelta (liftIO . genInodeCache (fromRawFilePath file))
|
ic <- withTSDelta (liftIO . genInodeCache' file)
|
||||||
case v of
|
case v of
|
||||||
Left e -> do
|
Left e -> do
|
||||||
warning (show e)
|
warning (show e)
|
||||||
|
@ -117,7 +118,7 @@ cleanup file oldkey newkey = do
|
||||||
liftIO $ removeFile (fromRawFilePath file)
|
liftIO $ removeFile (fromRawFilePath file)
|
||||||
addLink (fromRawFilePath file) newkey Nothing
|
addLink (fromRawFilePath file) newkey Nothing
|
||||||
, do
|
, do
|
||||||
mode <- liftIO $ catchMaybeIO $ fileMode <$> getFileStatus (fromRawFilePath file)
|
mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file
|
||||||
liftIO $ whenM (isJust <$> isPointerFile file) $
|
liftIO $ whenM (isJust <$> isPointerFile file) $
|
||||||
writePointerFile file newkey mode
|
writePointerFile file newkey mode
|
||||||
stagePointerFile file mode =<< hashPointerFile newkey
|
stagePointerFile file mode =<< hashPointerFile newkey
|
||||||
|
|
|
@ -14,6 +14,7 @@ import Annex.Link
|
||||||
import Annex.ReplaceFile
|
import Annex.ReplaceFile
|
||||||
import Git.FilePath
|
import Git.FilePath
|
||||||
import qualified Database.Keys
|
import qualified Database.Keys
|
||||||
|
import qualified Utility.RawFilePath as R
|
||||||
|
|
||||||
cmd :: Command
|
cmd :: Command
|
||||||
cmd = mkcmd "unlock" "unlock files for modification"
|
cmd = mkcmd "unlock" "unlock files for modification"
|
||||||
|
@ -40,8 +41,7 @@ start file key = ifM (isJust <$> isAnnexLink file)
|
||||||
|
|
||||||
perform :: RawFilePath -> Key -> CommandPerform
|
perform :: RawFilePath -> Key -> CommandPerform
|
||||||
perform dest key = do
|
perform dest key = do
|
||||||
destmode <- liftIO $ catchMaybeIO $ fileMode
|
destmode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus dest
|
||||||
<$> getFileStatus (fromRawFilePath dest)
|
|
||||||
replaceFile (fromRawFilePath dest) $ \tmp ->
|
replaceFile (fromRawFilePath dest) $ \tmp ->
|
||||||
ifM (inAnnex key)
|
ifM (inAnnex key)
|
||||||
( do
|
( do
|
||||||
|
|
|
@ -33,7 +33,10 @@ getFileSize f = fmap (fromIntegral . fileSize) (getFileStatus f)
|
||||||
getFileSize f = bracket (openFile f ReadMode) hClose hFileSize
|
getFileSize f = bracket (openFile f ReadMode) hClose hFileSize
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
{- Gets the size of the file, when its FileStatus is already known. -}
|
{- Gets the size of the file, when its FileStatus is already known.
|
||||||
|
-
|
||||||
|
- On windows, uses getFileSize. Otherwise, the FileStatus contains the
|
||||||
|
- size, so this does not do any work. -}
|
||||||
getFileSize' :: FilePath -> FileStatus -> IO FileSize
|
getFileSize' :: FilePath -> FileStatus -> IO FileSize
|
||||||
#ifndef mingw32_HOST_OS
|
#ifndef mingw32_HOST_OS
|
||||||
getFileSize' _ s = return $ fromIntegral $ fileSize s
|
getFileSize' _ s = return $ fromIntegral $ fileSize s
|
||||||
|
|
|
@ -22,6 +22,7 @@ module Utility.InodeCache (
|
||||||
readInodeCache,
|
readInodeCache,
|
||||||
showInodeCache,
|
showInodeCache,
|
||||||
genInodeCache,
|
genInodeCache,
|
||||||
|
genInodeCache',
|
||||||
toInodeCache,
|
toInodeCache,
|
||||||
likeInodeCacheWeak,
|
likeInodeCacheWeak,
|
||||||
|
|
||||||
|
@ -43,6 +44,7 @@ module Utility.InodeCache (
|
||||||
import Common
|
import Common
|
||||||
import Utility.TimeStamp
|
import Utility.TimeStamp
|
||||||
import Utility.QuickCheck
|
import Utility.QuickCheck
|
||||||
|
import qualified Utility.RawFilePath as R
|
||||||
|
|
||||||
import System.PosixCompat.Types
|
import System.PosixCompat.Types
|
||||||
import Data.Time.Clock.POSIX
|
import Data.Time.Clock.POSIX
|
||||||
|
@ -184,6 +186,10 @@ genInodeCache :: FilePath -> TSDelta -> IO (Maybe InodeCache)
|
||||||
genInodeCache f delta = catchDefaultIO Nothing $
|
genInodeCache f delta = catchDefaultIO Nothing $
|
||||||
toInodeCache delta f =<< getFileStatus f
|
toInodeCache delta f =<< getFileStatus f
|
||||||
|
|
||||||
|
genInodeCache' :: RawFilePath -> TSDelta -> IO (Maybe InodeCache)
|
||||||
|
genInodeCache' f delta = catchDefaultIO Nothing $
|
||||||
|
toInodeCache delta (fromRawFilePath f) =<< R.getFileStatus f
|
||||||
|
|
||||||
toInodeCache :: TSDelta -> FilePath -> FileStatus -> IO (Maybe InodeCache)
|
toInodeCache :: TSDelta -> FilePath -> FileStatus -> IO (Maybe InodeCache)
|
||||||
toInodeCache (TSDelta getdelta) f s
|
toInodeCache (TSDelta getdelta) f s
|
||||||
| isRegularFile s = do
|
| isRegularFile s = do
|
||||||
|
|
|
@ -17,11 +17,12 @@
|
||||||
module Utility.RawFilePath (
|
module Utility.RawFilePath (
|
||||||
RawFilePath,
|
RawFilePath,
|
||||||
readSymbolicLink,
|
readSymbolicLink,
|
||||||
|
getFileStatus,
|
||||||
) where
|
) where
|
||||||
|
|
||||||
#ifndef mingw32_HOST_OS
|
#ifndef mingw32_HOST_OS
|
||||||
|
import Utility.FileSystemEncoding (RawFilePath)
|
||||||
import System.Posix.Files.ByteString
|
import System.Posix.Files.ByteString
|
||||||
import System.Posix.ByteString.FilePath
|
|
||||||
#else
|
#else
|
||||||
import qualified Data.ByteString as B
|
import qualified Data.ByteString as B
|
||||||
import qualified System.PosixCompat as P
|
import qualified System.PosixCompat as P
|
||||||
|
@ -29,4 +30,7 @@ import Utility.FileSystemEncoding
|
||||||
|
|
||||||
readSymbolicLink :: RawFilePath -> IO RawFilePath
|
readSymbolicLink :: RawFilePath -> IO RawFilePath
|
||||||
readSymbolicLink f = toRawFilePath <$> P.readSymbolicLink (fromRawFilePath f)
|
readSymbolicLink f = toRawFilePath <$> P.readSymbolicLink (fromRawFilePath f)
|
||||||
|
|
||||||
|
getFileStatus :: RawFilePath -> IO FileStatus
|
||||||
|
getFileStatus = P.getFileStatus . fromRawFilePath
|
||||||
#endif
|
#endif
|
||||||
|
|
Loading…
Reference in a new issue