diff options
| -rw-r--r-- | Assistant/DeleteRemote.hs | 13 | ||||
| -rw-r--r-- | Assistant/MakeRemote.hs | 2 | ||||
| -rw-r--r-- | Git/GCrypt.hs | 19 | ||||
| -rw-r--r-- | Git/Remote.hs | 19 | ||||
| -rw-r--r-- | Remote/GCrypt.hs | 20 |
5 files changed, 52 insertions, 21 deletions
diff --git a/Assistant/DeleteRemote.hs b/Assistant/DeleteRemote.hs index 2e06d52cd..6a77eedc6 100644 --- a/Assistant/DeleteRemote.hs +++ b/Assistant/DeleteRemote.hs @@ -17,8 +17,7 @@ import Logs.Location import Assistant.DaemonStatus import qualified Remote import Remote.List -import qualified Git.Command -import qualified Git.BuildVersion +import qualified Git.Remote import Logs.Trust import qualified Annex @@ -35,15 +34,7 @@ disableRemote uuid = do remote <- fromMaybe (error "unknown remote") <$> liftAnnex (Remote.remoteFromUUID uuid) liftAnnex $ do - inRepo $ Git.Command.run - [ Param "remote" - -- name of this subcommand changed - , Param $ - if Git.BuildVersion.older "1.8.0" - then "rm" - else "remove" - , Param (Remote.name remote) - ] + inRepo $ Git.Remote.remove (Remote.name remote) void $ remoteListRefresh updateSyncRemotes return remote diff --git a/Assistant/MakeRemote.hs b/Assistant/MakeRemote.hs index fa662babd..4b0a4c7d9 100644 --- a/Assistant/MakeRemote.hs +++ b/Assistant/MakeRemote.hs @@ -27,8 +27,6 @@ import Creds import qualified Data.Text as T import qualified Data.Map as M -type RemoteName = String - {- Sets up and begins syncing with a new ssh or rsync remote. -} makeSshRemote :: Bool -> SshData -> Maybe Cost -> Assistant Remote makeSshRemote forcersync sshdata mcost = do diff --git a/Git/GCrypt.hs b/Git/GCrypt.hs index 1260c2ced..c8c193c45 100644 --- a/Git/GCrypt.hs +++ b/Git/GCrypt.hs @@ -13,6 +13,7 @@ import Common import Git.Types import Git.Construct import qualified Git.Config as Config +import qualified Git.Command as Command import Utility.Gpg urlPrefix :: String @@ -44,12 +45,28 @@ encryptedRepo baserepo = go go _ = notencrypted notencrypted = error "not a gcrypt encrypted repository" +{- Checks if the git repo at a location is a gcrypt repo that + - we can decrypt. This works by trying to fetch from the repo + - at the location, into the baserepo. + - + - Returns false if the git repo is not using gcrypt, or if it is using + - gcrypt but cannot be decrypted. We do not try to detect gcrypt + - repos that cannot be decrypted, because gcrypt may change in the future + - to avoid easy fingerprinting of gcrypt repos. + -} +probeGCryptRepo :: FilePath -> Repo -> IO Bool +probeGCryptRepo dir baserepo = catchBoolIO $ Command.runBool + [ Param "fetch" + , Param $ urlPrefix ++ dir + ] baserepo + type RemoteName = String +type GCryptId = String {- gcrypt gives each encrypted repository a uique gcrypt-id, - which is stored in the repository (in encrypted form) - and cached in a per-remote gcrypt-id configuration setting. -} -remoteRepoId :: Repo -> Maybe RemoteName -> Maybe String +remoteRepoId :: Repo -> Maybe RemoteName -> Maybe GCryptId remoteRepoId = getRemoteConfig "gcrypt-id" getRemoteConfig :: String -> Repo -> Maybe RemoteName -> Maybe String diff --git a/Git/Remote.hs b/Git/Remote.hs index 5640e9ff2..e853e53cb 100644 --- a/Git/Remote.hs +++ b/Git/Remote.hs @@ -8,15 +8,21 @@ module Git.Remote where import Common +import Git +import qualified Git.Command +import qualified Git.BuildVersion + import Data.Char +type RemoteName = String + {- Construct a legal git remote name out of an arbitrary input string. - - There seems to be no formal definition of this in the git source, - just some ad-hoc checks, and some other things that fail with certian - types of names (like ones starting with '-'). -} -makeLegalName :: String -> String +makeLegalName :: String -> RemoteName makeLegalName s = case filter legal $ replace "/" "_" s of -- it can't be empty [] -> "unnamed" @@ -31,3 +37,14 @@ makeLegalName s = case filter legal $ replace "/" "_" s of legal '_' = True legal '.' = True legal c = isAlphaNum c + +remove :: RemoteName -> Repo -> IO () +remove remotename = Git.Command.run + [ Param "remote" + -- name of this subcommand changed + , Param $ + if Git.BuildVersion.older "1.8.0" + then "rm" + else "remove" + , Param remotename + ] diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs index 70f82f667..d5448ca64 100644 --- a/Remote/GCrypt.hs +++ b/Remote/GCrypt.hs @@ -5,7 +5,7 @@ - Licensed under the GNU GPL version 3 or higher. -} -module Remote.GCrypt (remote, gen) where +module Remote.GCrypt (remote, gen, getGCryptId) where import qualified Data.Map as M import qualified Data.ByteString.Lazy as L @@ -52,13 +52,10 @@ gen gcryptr u c gc = do -- get underlying git repo with real path, not gcrypt path r <- liftIO $ Git.GCrypt.encryptedRepo g gcryptr let r' = r { Git.remoteName = Git.remoteName gcryptr } - -- read config of underlying repo if it's local - r'' <- if Git.repoIsLocalUnknown r' - then liftIO $ catchDefaultIO r' $ Git.Config.read r' - else return r' + (mgcryptid, r'') <- liftIO $ getGCryptId r' -- doublecheck that local cache matches underlying repo's gcrypt-id -- (which might not be set) - case (Git.Config.getMaybe "core.gcrypt-id" r'', Git.GCrypt.remoteRepoId g (Git.remoteName gcryptr)) of + case (mgcryptid, Git.GCrypt.remoteRepoId g (Git.remoteName gcryptr)) of (Just gcryptid, Just cachedgcryptid) | gcryptid /= cachedgcryptid -> resetup gcryptid r'' _ -> gen' r'' u c gc @@ -81,6 +78,17 @@ gen gcryptr u c gc = do warning $ "not using unknown gcrypt repository pointed to by remote " ++ Git.repoDescribe r return Nothing +{- gcrypt repos set up by git-annex as special remotes have a + - core.gcrypt-id setting in their config, which can be mapped back to + - the remote's UUID. This only works for local repos. + - (Also returns a version of input repo with its config read.) -} +getGCryptId :: Git.Repo -> IO (Maybe Git.GCrypt.GCryptId, Git.Repo) +getGCryptId r + | Git.repoIsLocalUnknown r = do + r' <- catchDefaultIO r $ Git.Config.read r + return (Git.Config.getMaybe "core.gcrypt-id" r', r') + | otherwise = return (Nothing, r) + gen' :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote) gen' r u c gc = do cst <- remoteCost gc $ |