1 files changed, 150 insertions, 0 deletions
diff --git a/Backend/File.hs b/Backend/File.hs
new file mode 100644
index 000000000..4ea25daa7
--- /dev/null
+++ b/Backend/File.hs
@@ -0,0 +1,150 @@
+{- git-annex pseudo-backend
+ -
+ - This backend does not really do any independant data storage,
+ - it relies on the file contents in .git/annex/ in this repo,
+ - and other accessible repos.
+ -
+ - This is an abstract backend; getKey has to be implemented to complete
+ - it.
+ -}
+
+module Backend.File (backend) where
+
+import Control.Monad.State
+import System.IO
+import System.Cmd
+import System.Cmd.Utils
+import Control.Exception
+import List
+import Maybe
+
+import TypeInternals
+import LocationLog
+import Locations
+import qualified Remotes
+import qualified GitRepo as Git
+import Utility
+import Core
+import qualified Annex
+import UUID
+import qualified Backend
+
+backend = Backend {
+	name = mustProvide,
+	getKey = mustProvide,
+	storeFileKey = dummyStore,
+	retrieveKeyFile = copyKeyFile,
+	removeKey = checkRemoveKey,
+	hasKey = checkKeyFile
+}
+
+mustProvide = error "must provide this field"
+
+{- Storing a key is a no-op. -}
+dummyStore :: FilePath -> Key -> Annex (Bool)
+dummyStore file key = return True
+
+{- Just check if the .git/annex/ file for the key exists. -}
+checkKeyFile :: Key -> Annex Bool
+checkKeyFile k = inAnnex k
+
+{- Try to find a copy of the file in one of the remotes,
+ - and copy it over to this one. -}
+copyKeyFile :: Key -> FilePath -> Annex (Bool)
+copyKeyFile key file = do
+	remotes <- Remotes.withKey key
+	if (0 == length remotes)
+		then do
+			showNote "not available"
+			showLocations key
+			return False
+		else trycopy remotes remotes
+	where
+		trycopy full [] = do
+			showNote "not available"
+			showTriedRemotes full
+			showLocations key
+			return False
+		trycopy full (r:rs) = do
+			-- annexLocation needs the git config to have been
+			-- read for a remote, so do that now,
+			-- if it hasn't been already
+			result <- Remotes.tryGitConfigRead r
+			case (result) of
+				Left err -> trycopy full rs
+				Right r' -> do
+					showNote $ "copying from " ++ (Git.repoDescribe r ) ++ "..."
+					liftIO $ copyFromRemote r' key file
+
+{- Tries to copy a file from a remote. -}
+copyFromRemote :: Git.Repo -> Key -> FilePath -> IO Bool
+copyFromRemote r key file = do
+	if (Git.repoIsLocal r)
+		then getlocal
+		else getremote
+	where
+		getlocal = boolSystem "cp" ["-a", location, file]
+		getremote = return False -- TODO implement get from remote
+		location = annexLocation r key
+
+showLocations :: Key -> Annex ()
+showLocations key = do
+	g <- Annex.gitRepo
+	u <- getUUID g
+	uuids <- liftIO $ keyLocations g key
+	let uuidsf = filter (\v -> v /= u) uuids
+	ppuuids <- prettyPrintUUIDs uuidsf
+	if (0 < length uuidsf)
+		then showLongNote $ "Try making some of these repositories available:\n" ++ ppuuids
+		else showLongNote $ "No other repository is known to contain the file."
+		
+showTriedRemotes remotes =
+	showLongNote $ "I was unable to access these remotes: " ++
+		(Remotes.list remotes)
+
+{- Checks remotes to verify that enough copies of a key exist to allow
+ - for a key to be safely removed (with no data loss), and fails with an
+ - error if not. -}
+checkRemoveKey :: Key -> Annex (Bool)
+checkRemoveKey key = do
+	force <- Annex.flagIsSet Force
+	if (force)
+		then return True
+		else do
+			g <- Annex.gitRepo
+			remotes <- Remotes.withKey key
+			let numcopies = read $ Git.configGet g config "1"
+			if (numcopies > length remotes)
+				then notEnoughCopies numcopies (length remotes) []
+				else findcopies numcopies 0 remotes []
+	where
+		config = "annex.numcopies"
+		findcopies need have [] bad = 
+			if (have >= need)
+				then return True
+				else notEnoughCopies need have bad
+		findcopies need have (r:rs) bad = do
+			all <- Annex.supportedBackends
+			result <- liftIO $ ((try $ remoteHasKey r all)::IO (Either SomeException Bool))
+			case (result) of
+				Right True	-> findcopies need (have+1) rs bad
+				Right False	-> findcopies need have rs bad
+				Left _		-> findcopies need have rs (r:bad)
+		remoteHasKey r all = do
+			-- To check if a remote has a key, construct a new
+			-- Annex monad and query its backend.
+			a <- Annex.new r all
+			(result, _) <- Annex.run a (Backend.hasKey key)
+			return result
+		notEnoughCopies need have bad = do
+			unsafe
+			showLongNote $
+				"Could only verify the existence of " ++
+				(show have) ++ " out of " ++ (show need) ++ 
+				" necessary copies"
+			if (0 /= length bad) then showTriedRemotes bad else return ()
+			showLocations key
+			hint
+			return False
+		unsafe = showNote "unsafe"
+		hint = showLongNote $ "(Use --force to override this check, or adjust annex.numcopies.)"