subdir
This commit is contained in:
parent
7117702fdd
commit
0f12bd16d8
4 changed files with 11 additions and 11 deletions
18
Backend/Checksum.hs
Normal file
18
Backend/Checksum.hs
Normal file
|
@ -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
|
72
Backend/File.hs
Normal file
72
Backend/File.hs
Normal file
|
@ -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
|
35
Backend/Url.hs
Normal file
35
Backend/Url.hs
Normal file
|
@ -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
|
Loading…
Add table
Add a link
Reference in a new issue