From 08236e780fd0047b1dbab2ef7c50d96be8709cab Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 23 Oct 2010 14:14:36 -0400 Subject: [PATCH] reorg --- Backend/File.hs | 29 ++++------------------------- Remotes.hs | 47 +++++++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 49 insertions(+), 27 deletions(-) diff --git a/Backend/File.hs b/Backend/File.hs index dbd0674286..14b4b9dae5 100644 --- a/Backend/File.hs +++ b/Backend/File.hs @@ -66,31 +66,10 @@ copyKeyFile key file = do 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 (not $ Git.repoIsUrl r) - then getlocal - else if (Git.repoIsSsh r) - then getssh - else error "copying from non-ssh repo not supported" - where - getlocal = boolSystem "cp" ["-a", location, file] - getssh = do - liftIO $ putStrLn "" -- make way for scp progress bar - boolSystem "scp" [sshlocation, file] - location = annexLocation r key - sshlocation = (Git.urlHost r) ++ ":" ++ location + copied <- Remotes.copyFromRemote r key file + if (copied) + then return True + else trycopy full rs {- 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 diff --git a/Remotes.hs b/Remotes.hs index 13f66aae23..a4b358c779 100644 --- a/Remotes.hs +++ b/Remotes.hs @@ -4,7 +4,9 @@ module Remotes ( list, keyPossibilities, tryGitConfigRead, - inAnnex + inAnnex, + commandLineRemote, + copyFromRemote ) where import Control.Exception @@ -20,10 +22,11 @@ import Types import qualified GitRepo as Git import qualified Annex import qualified Backend +import qualified Core import LocationLog import Locations import UUID -import qualified Core +import Utility {- Human visible list of remotes. -} list :: [Git.Repo] -> String @@ -134,6 +137,22 @@ repoNotIgnored r = do config g = Git.configGet g configkey "" configkey = "remote." ++ (Git.repoRemoteName r) ++ ".annex-ignore" +{- Returns the remote specified by --from or --to, may fail with error. -} +commandLineRemote :: Annex Git.Repo +commandLineRemote = do + fromName <- Annex.flagGet "fromrepository" + toName <- Annex.flagGet "torepository" + let name = if (not $ null fromName) then fromName else toName + if (null name) + then error "no remote specified" + else do + g <- Annex.gitRepo + let match = filter (\r -> name == Git.repoRemoteName r) $ + Git.remotes g + if (null match) + then error $ "there is no git remote named \"" ++ name ++ "\"" + else return $ match !! 0 + {- The git configs for the git repo's remotes is not read on startup - because reading it may be expensive. This function tries to read the - config for a specified remote, and updates state. If successful, it @@ -161,3 +180,27 @@ tryGitConfigRead r = do if ((Git.repoRemoteName old) == (Git.repoRemoteName new)) then new:(exchange ls new) else old:(exchange ls new) + +{- Tries to copy a file from a remote. -} +copyFromRemote :: Git.Repo -> Key -> FilePath -> Annex Bool +copyFromRemote r key file = do + -- annexLocation needs the git config to have been read for a remote, + -- so do that now if it hasn't been already + result <- tryGitConfigRead r + case (result) of + Left err -> return False + Right r' -> copy r' + where + copy r = do + Core.showNote $ "copying from " ++ (Git.repoDescribe r) ++ "..." + if (not $ Git.repoIsUrl r) + then getlocal + else if (Git.repoIsSsh r) + then getssh + else error "copying from non-ssh repo not supported" + getlocal = liftIO $ boolSystem "cp" ["-a", location, file] + getssh = do + liftIO $ putStrLn "" -- make way for scp progress bar + liftIO $ boolSystem "scp" [sshlocation, file] + location = annexLocation r key + sshlocation = (Git.urlHost r) ++ ":" ++ location