From 560b644a52971a7e4706c775982ec29e03ca3ab2 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 7 Dec 2012 17:28:23 -0400
Subject: support for checking presence of objects in direct mode

Also for dropping objects in direct mode.

Checking presence reliably needs a cache of mtime, size, and inode.
This way, if a file is modified, keys that point to it are no longer
present.

Also, the code for restoring the symlink when removing objects is
unnecessarily messy. calcGitLink was generating links starting with
"../../remote/.git/", when running "git annex move --from remote".
I put in a workaround, but calcGitLink should probably be fixed.

There is not yet support for getting objects from repositories in direct
mode; it still looks for content in .git/annex/objects, and there's no
once place I can change to fix that.

Also, getting objects from direct mode repositories is problematic since
the can be changed while the object is being transferred. It probably needs
to quarantine it first.
---
 Annex/Content/Direct.hs | 78 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 78 insertions(+)
 create mode 100644 Annex/Content/Direct.hs

(limited to 'Annex/Content/Direct.hs')

diff --git a/Annex/Content/Direct.hs b/Annex/Content/Direct.hs
new file mode 100644
index 000000000..e23c6512c
--- /dev/null
+++ b/Annex/Content/Direct.hs
@@ -0,0 +1,78 @@
+{- 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,
+	unmodifed,
+	getCache,
+	showCache,
+) 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.
+ -}
+unmodifed :: Key -> FilePath -> Annex Bool
+unmodifed key file = do
+	cachefile <- inRepo $ gitAnnexCache key
+	liftIO $ do
+		curr <- getCache file
+		old <- catchDefaultIO Nothing $ readCache <$> readFile cachefile
+		return $ isJust curr && curr == old
+
+{- 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
+
+getCache :: FilePath -> IO (Maybe Cache)
+getCache f = catchDefaultIO Nothing $ toCache <$> getFileStatus f
+
+toCache :: FileStatus -> Maybe Cache
+toCache s
+	| isRegularFile s = Just $ Cache
+		(fileID s)
+		(fileSize s)
+		(modificationTime s)
+	| otherwise = Nothing
-- 
cgit v1.2.3