{- 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 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 cantfind else trycopy remotes remotes where trycopy full [] = do showNote $ "need access to one of these remotes: " ++ (Remotes.list full) 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 Nothing -> trycopy full rs Just r' -> do showNote $ "copying from " ++ (Git.repoDescribe r ) ++ "..." liftIO $ copyFromRemote r' key file cantfind = do g <- Annex.gitRepo uuids <- liftIO $ keyLocations g key ppuuids <- prettyPrintUUIDs uuids showNote $ "No available git remotes have the file." if (0 < length uuids) then showLongNote $ "It has been seen before in these repositories:\n" ++ ppuuids else return () return False {- 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 {- 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 let numcopies = read $ Git.configGet g config "1" remotes <- Remotes.withKey key if (numcopies > length remotes) then retNotEnoughCopiesKnown remotes numcopies else findcopies numcopies remotes [] where config = "annex.numcopies" findcopies 0 _ _ = return True -- success, enough copies found findcopies _ [] bad = notEnoughCopiesSeen bad findcopies n (r:rs) bad = do all <- Annex.supportedBackends result <- liftIO $ ((try $ remoteHasKey r all)::IO (Either SomeException Bool)) case (result) of Right True -> findcopies (n-1) rs bad Right False -> findcopies n rs bad Left _ -> findcopies n 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 notEnoughCopiesSeen bad = do showNote "failed to find enough other copies of the file" if (0 /= length bad) then listbad bad else return () unsafe return False listbad bad = showLongNote $ "I was unable to access these remotes: " ++ (Remotes.list bad) retNotEnoughCopiesKnown remotes numcopies = do showNote $ "I only know about " ++ (show $ length remotes) ++ " out of " ++ (show numcopies) ++ " necessary copies of the file" unsafe return False unsafe = do showLongNote $ "According to the " ++ config ++ " setting, it is not safe to remove it!" showLongNote "(Use --force to override.)"