diff options
| -rw-r--r-- | Git/Config.hs | 9 | ||||
| -rw-r--r-- | GitAnnexShell.hs | 2 | ||||
| -rw-r--r-- | Remote/GCrypt.hs | 61 |
3 files changed, 50 insertions, 22 deletions
diff --git a/Git/Config.hs b/Git/Config.hs index 513c3e5a6..db795b7a7 100644 --- a/Git/Config.hs +++ b/Git/Config.hs @@ -168,3 +168,12 @@ fromPipe r cmd params = try $ where p = proc cmd $ toCommand params +{- Reads git config from a specified file and returns the repo populated + - with the configuration. -} +fromFile :: Repo -> FilePath -> IO (Either SomeException (Repo, String)) +fromFile r f = fromPipe r "git" + [ Param "config" + , Param "--file" + , File f + , Param "--list" + ] diff --git a/GitAnnexShell.hs b/GitAnnexShell.hs index 4133d6211..c34b3b307 100644 --- a/GitAnnexShell.hs +++ b/GitAnnexShell.hs @@ -61,7 +61,7 @@ options = Option.common ++ check u | u == toUUID expected = noop check NoUUID = checkGCryptUUID expected check u = unexpectedUUID expected u - checkGCryptUUID expected = inRepo getGCryptUUID >>= check + checkGCryptUUID expected = check =<< getGCryptUUID True =<< gitRepo where check (Just u) | u == toUUID expected = noop check Nothing = unexpected expected "uninitialized repository" diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs index fe0632943..5a66cbdeb 100644 --- a/Remote/GCrypt.hs +++ b/Remote/GCrypt.hs @@ -40,6 +40,7 @@ import Annex.UUID import Annex.Ssh import qualified Remote.Rsync import Utility.Rsync +import Utility.Tmp import Logs.Remote import Logs.Transfer import Utility.Gpg @@ -61,9 +62,9 @@ gen gcryptr u c gc = do -- get underlying git repo with real path, not gcrypt path r <- liftIO $ Git.GCrypt.encryptedRemote g gcryptr let r' = r { Git.remoteName = Git.remoteName gcryptr } - (mgcryptid, r'') <- liftIO $ getGCryptId r' - -- doublecheck that local cache matches underlying repo's gcrypt-id - -- (which might not be set) + -- doublecheck that cache matches underlying repo's gcrypt-id + -- (which might not be set), only for local repos + (mgcryptid, r'') <- getGCryptId True r' case (mgcryptid, Git.GCrypt.remoteRepoId g (Git.remoteName gcryptr)) of (Just gcryptid, Just cachedgcryptid) | gcryptid /= cachedgcryptid -> resetup gcryptid r'' @@ -87,24 +88,6 @@ gen gcryptr u c gc = do warning $ "not using unknown gcrypt repository pointed to by remote " ++ Git.repoDescribe r return Nothing -getGCryptUUID :: Git.Repo -> IO (Maybe UUID) -getGCryptUUID r = (genUUIDInNameSpace gCryptNameSpace <$>) . fst - <$> getGCryptId r - -coreGCryptId :: String -coreGCryptId = "core.gcrypt-id" - -{- 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.repoIsLocal r = do - r' <- catchDefaultIO r $ Git.Config.read r - return (Git.Config.getMaybe coreGCryptId r', r') - | otherwise = return (Nothing, r) - gen' :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex (Maybe Remote) gen' r u c gc = do cst <- remoteCost gc $ @@ -374,3 +357,39 @@ toAccessMethod :: String -> AccessMethod toAccessMethod "shell" = AccessShell toAccessMethod _ = AccessDirect +getGCryptUUID :: Bool -> Git.Repo -> Annex (Maybe UUID) +getGCryptUUID fast r = (genUUIDInNameSpace gCryptNameSpace <$>) . fst + <$> getGCryptId fast r + +coreGCryptId :: String +coreGCryptId = "core.gcrypt-id" + +{- 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. + - + - In fast mode, only checks local repos. To check a remote repo, + - tries git-annex-shell and direct rsync of the git config file. + - + - (Also returns a version of input repo with its config read.) -} +getGCryptId :: Bool -> Git.Repo -> Annex (Maybe Git.GCrypt.GCryptId, Git.Repo) +getGCryptId fast r + | Git.repoIsLocal r = extract + =<< liftIO (catchDefaultIO r $ Git.Config.read r) + | not fast = do + fromshell <- Ssh.onRemote r (Git.Config.fromPipe r, Left undefined) "configlist" [] [] + case fromshell of + Right (r', _) -> extract r' + Left _ -> do + (rsynctransport, rsyncurl, _) <- rsyncTransport r + fromrsync <- liftIO $ do + withTmpFile "tmpconfig" $ \tmpconfig _ -> do + void $ rsync $ rsynctransport ++ + [ Param $ rsyncurl ++ "/config" + , Param tmpconfig + ] + Git.Config.fromFile r tmpconfig + extract $ either (const r) fst fromrsync + | otherwise = return (Nothing, r) + where + extract r' = return (Git.Config.getMaybe coreGCryptId r', r') |