diff options
author | Joey Hess <joey@kitenet.net> | 2010-10-14 03:50:28 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2010-10-14 03:50:28 -0400 |
commit | 0f12bd16d829432f7b1c2efbba386262ed36fc27 (patch) | |
tree | f205d39ce599d1c25f0ce76b590a604377605a75 /Backend | |
parent | 7117702fddf521ed4f3675a91cd87119207eba02 (diff) |
subdir
Diffstat (limited to 'Backend')
-rw-r--r-- | Backend/Checksum.hs | 18 | ||||
-rw-r--r-- | Backend/File.hs | 72 | ||||
-rw-r--r-- | Backend/Url.hs | 35 |
3 files changed, 125 insertions, 0 deletions
diff --git a/Backend/Checksum.hs b/Backend/Checksum.hs new file mode 100644 index 000000000..bfc789e40 --- /dev/null +++ b/Backend/Checksum.hs @@ -0,0 +1,18 @@ +{- git-annex "checksum" backend + - -} + +module Backend.Checksum (backend) where + +import qualified Backend.File +import Data.Digest.Pure.SHA +import BackendTypes + +-- based on BackendFile just with a different key type +backend = Backend.File.backend { + name = "checksum", + getKey = keyValue +} + +-- checksum the file to get its key +keyValue :: FilePath -> Annex (Maybe Key) +keyValue k = error "checksum keyValue unimplemented" -- TODO diff --git a/Backend/File.hs b/Backend/File.hs new file mode 100644 index 000000000..107ef3851 --- /dev/null +++ b/Backend/File.hs @@ -0,0 +1,72 @@ +{- git-annex "file" backend + - -} + +module Backend.File (backend) where + +import Control.Monad.State +import System.IO +import System.Cmd +import Control.Exception +import BackendTypes +import LocationLog +import Locations +import qualified Remotes +import qualified GitRepo as Git + +backend = Backend { + name = "file", + getKey = keyValue, + storeFileKey = dummyStore, + retrieveKeyFile = copyKeyFile, + removeKey = dummyRemove +} + +-- direct mapping from filename to key +keyValue :: FilePath -> Annex (Maybe Key) +keyValue file = return $ Just $ Key file + +{- 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. So storing or removing a key is + - a no-op. TODO until support is added for git annex --push otherrepo, + - then these could implement that.. -} +dummyStore :: FilePath -> Key -> Annex (Bool) +dummyStore file key = return True +dummyRemove :: Key -> Annex Bool +dummyRemove url = return False + +{- 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 + trycopy remotes remotes + where + trycopy full [] = error $ "unable to get: " ++ (keyFile key) ++ "\n" ++ + "To get that file, need access to one of these remotes: " ++ + (Remotes.list full) + 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 + r' <- Remotes.ensureGitConfigRead r + result <- liftIO $ (try (copyFromRemote r' key file)::IO (Either SomeException ())) + case (result) of + Left err -> do + liftIO $ hPutStrLn stderr (show err) + trycopy full rs + Right succ -> return True + +{- Tries to copy a file from a remote, exception on error. -} +copyFromRemote :: Git.Repo -> Key -> FilePath -> IO () +copyFromRemote r key file = do + putStrLn $ "copy from " ++ (Git.repoDescribe r ) ++ " " ++ file + + if (Git.repoIsLocal r) + then getlocal + else getremote + return () + where + getlocal = rawSystem "cp" ["-a", location, file] + getremote = error "get via network not yet implemented!" + location = annexLocation r backend key diff --git a/Backend/Url.hs b/Backend/Url.hs new file mode 100644 index 000000000..e4ba58e6d --- /dev/null +++ b/Backend/Url.hs @@ -0,0 +1,35 @@ +{- git-annex "url" backend + - -} + +module Backend.Url (backend) where + +import Control.Monad.State +import System.Cmd +import IO +import BackendTypes + +backend = Backend { + name = "url", + getKey = keyValue, + storeFileKey = dummyStore, + retrieveKeyFile = downloadUrl, + removeKey = dummyRemove +} + +-- cannot generate url from filename +keyValue :: FilePath -> Annex (Maybe Key) +keyValue file = return Nothing + +-- cannot change url contents +dummyStore :: FilePath -> Key -> Annex Bool +dummyStore file url = return False +dummyRemove :: Key -> Annex Bool +dummyRemove url = return False + +downloadUrl :: Key -> FilePath -> Annex Bool +downloadUrl url file = do + liftIO $ putStrLn $ "download: " ++ (show url) + result <- liftIO $ try $ rawSystem "curl" ["-#", "-o", file, (show url)] + case (result) of + Left _ -> return False + Right _ -> return True |