cache credentials in memory when doing http basic auth to a git remote

When accessing a git remote over http needs a git credential prompt for a
password, cache it for the lifetime of the git-annex process, rather than
repeatedly prompting.

The git-lfs special remote already caches the credential when discovering
the endpoint. And presumably commands like git pull do as well, since they
may download multiple urls from a remote.

The TMVar CredentialCache is read, so two concurrent calls to
getBasicAuthFromCredential will both prompt for a credential.
There would already be two concurrent password prompts in such a case,
and existing uses of `prompt` probably avoid it. Anyway, it's no worse
than before.

diff --git a/Annex.hs b/Annex.hs
index f233712db285645ec198af4a8e51f9fe97dbdbb4..6e4ebb9b7087ef234246584c420ef5f3549403ca 100644 (file)
--- a/Annex.hs
+++ b/Annex.hs
@@ -81,6 +81,7 @@ import Utility.InodeCache
 import Utility.Url
 import Utility.ResourcePool
 import Utility.HumanTime
+import Git.Credential (CredentialCache(..))
 
 import "mtl" Control.Monad.Reader
 import Control.Concurrent
@@ -129,6 +130,7 @@ data AnnexRead = AnnexRead
        , forcebackend :: Maybe String
        , useragent :: Maybe String
        , desktopnotify :: DesktopNotify
+       , gitcredentialcache :: TMVar CredentialCache
        }
 
 newAnnexRead :: GitConfig -> IO AnnexRead
@@ -140,6 +142,7 @@ newAnnexRead c = do
        si <- newTVarIO M.empty
        tp <- newTransferrerPool
        cm <- newTMVarIO M.empty
+       cc <- newTMVarIO (CredentialCache M.empty)
        return $ AnnexRead
                { activekeys = emptyactivekeys
                , activeremotes = emptyactiveremotes
@@ -157,6 +160,7 @@ newAnnexRead c = do
                , forcemincopies = Nothing
                , useragent = Nothing
                , desktopnotify = mempty
+               , gitcredentialcache = cc
                }
 
 -- Values that can change while running an Annex action.

diff --git a/Annex/Url.hs b/Annex/Url.hs
index d4942389160b8562c51f0f86ad9d171d8c23ac2d..dd418c5d6626c61498cd912bfc5ce11bff9287eb 100644 (file)
--- a/Annex/Url.hs
+++ b/Annex/Url.hs
@@ -152,9 +152,10 @@ withUrlOptionsPromptingCreds a = do
        g <- Annex.gitRepo
        uo <- getUrlOptions
        prompter <- mkPrompter
+       cc <- Annex.getRead Annex.gitcredentialcache
        a $ uo
                { U.getBasicAuth = \u -> prompter $
-                       getBasicAuthFromCredential g u
+                       getBasicAuthFromCredential g cc u
                -- Can't download with curl and handle basic auth,
                -- so make sure it uses conduit.
                , U.urlDownloader = case U.urlDownloader uo of

diff --git a/CHANGELOG b/CHANGELOG
index cb15c1238e211c05b6c890b70ebb814c39635d93..c410c9ec2af5aac6f3b8a82648067edbde587309 100644 (file)
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -5,6 +5,9 @@ git-annex (10.20220823) UNRELEASED; urgency=medium
   * Optimise linker in linux standalone tarballs.
   * Fix crash importing from a directory special remote that contains
     a broken symlink.
+  * When accessing a git remote over http needs a git credential
+    prompt for a password, cache it for the lifetime of the git-annex
+    process, rather than repeatedly prompting.
 
  -- Joey Hess <id@joeyh.name>  Mon, 29 Aug 2022 15:03:04 -0400
 

diff --git a/Git/Credential.hs b/Git/Credential.hs
index 2f926b032316ffeb7a0a279880992ec358a6195c..aee78a20a41a5460424f30df2d1098303f899263 100644 (file)
--- a/Git/Credential.hs
+++ b/Git/Credential.hs
@@ -1,18 +1,24 @@
 {- git credential interface
  -
- - Copyright 2019-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2019-2022 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Git.Credential where
 
 import Common
 import Git
+import Git.Types
 import Git.Command
+import qualified Git.Config as Config
 import Utility.Url
 
 import qualified Data.Map as M
+import Network.URI
+import Control.Concurrent.STM
 
 data Credential = Credential { fromCredential :: M.Map String String }
 
@@ -27,20 +33,33 @@ credentialBasicAuth cred = BasicAuth
        <$> credentialUsername cred
        <*> credentialPassword cred
 
-getBasicAuthFromCredential :: Repo -> GetBasicAuth
-getBasicAuthFromCredential r u = do
-       c <- getUrlCredential u r
-       case credentialBasicAuth c of
-               Just ba -> return $ Just (ba, signalsuccess c)
-               Nothing -> do
-                       signalsuccess c False
-                       return Nothing
+getBasicAuthFromCredential :: Repo -> TMVar CredentialCache -> GetBasicAuth
+getBasicAuthFromCredential r ccv u = do
+       (CredentialCache cc) <- atomically $ readTMVar ccv
+       case mkCredentialBaseURL r u of
+               Just bu -> case M.lookup bu cc of
+                       Just c -> go (const noop) c
+                       Nothing -> do
+                               let storeincache = \c -> atomically $ do
+                                       (CredentialCache cc') <- takeTMVar ccv
+                                       putTMVar ccv (CredentialCache (M.insert bu c cc'))
+                               go storeincache =<< getUrlCredential u r
+               Nothing -> go (const noop) =<< getUrlCredential u r
   where
-       signalsuccess c True = approveUrlCredential c r
-       signalsuccess c False = rejectUrlCredential c r
+       go storeincache c =
+               case credentialBasicAuth c of
+                       Just ba -> return $ Just (ba, signalsuccess)
+                       Nothing -> do
+                               signalsuccess False
+                               return Nothing
+         where
+               signalsuccess True = do
+                       () <- storeincache c
+                       approveUrlCredential c r
+               signalsuccess False = rejectUrlCredential c r
 
--- | This may prompt the user for login information, or get cached login
--- information.
+-- | This may prompt the user for the credential, or get a cached
+-- credential from git.
 getUrlCredential :: URLString -> Repo -> IO Credential
 getUrlCredential = runCredential "fill" . urlCredential
 
@@ -79,3 +98,28 @@ parseCredential = Credential . M.fromList . map go . lines
        go l = case break (== '=') l of
                (k, _:v) -> (k, v)
                (k, []) -> (k, "")
+
+-- This is not the cache used by git, but is an in-process cache, 
+-- allowing a process to avoid prompting repeatedly when accessing related
+-- urls even when git is not configured to cache credentials.
+data CredentialCache = CredentialCache (M.Map CredentialBaseURL Credential)
+
+-- An url with the uriPath empty when credential.useHttpPath is false.
+--
+-- When credential.useHttpPath is true, no caching is done, since each 
+-- distinct url would need a different credential to be cached, which
+-- could cause the CredentialCache to use a lot of memory. Presumably,
+-- when credential.useHttpPath is false, one Credential is cached
+-- for each git repo accessed, and there are a reasonably small number of
+-- those, so the cache will not grow too large.
+data CredentialBaseURL = CredentialBaseURL URI
+       deriving (Show, Eq, Ord)
+
+mkCredentialBaseURL :: Repo -> URLString -> Maybe CredentialBaseURL
+mkCredentialBaseURL r s = do
+       u <- parseURI s
+       let usehttppath = fromMaybe False $ Config.isTrueFalse' $
+               Config.get (ConfigKey "credential.useHttpPath") (ConfigValue "") r
+       if usehttppath
+               then Nothing
+               else Just $ CredentialBaseURL $ u { uriPath = "" }

diff --git a/doc/todo/not_ask_git_credentials_for_password_per_each_file/comment_3_39ccd0fe773200166d0727dc903c34e3._comment b/doc/todo/not_ask_git_credentials_for_password_per_each_file/comment_3_39ccd0fe773200166d0727dc903c34e3._comment
new file mode 100644 (file)
index 0000000..9dca597
--- /dev/null
+++ b/doc/todo/not_ask_git_credentials_for_password_per_each_file/comment_3_39ccd0fe773200166d0727dc903c34e3._comment
@@ -0,0 +1,30 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 3"""
+ date="2022-09-09T18:11:28Z"
+ content="""
+I've implemented this, and a get of multiple files will prompt once.
+
+However, there is one case where the password is prompted twice.
+In a freshly cloned repo, where you have not run `git-annex init` manually,
+`git-annex get foo` will prompt twice.
+
+That is because autoinit causes `git-annex init --autoenable` to be run,
+and that infortunately probes for the UUID of the http remote, 
+which needs the password. Since the cache is necessarily only for a single
+process, that subprocess adds an additional prompt.
+
+There might also be other cases where git-annex starts
+subprocesses, that legitimately each need to prompt once for the password.
+I expect that, when `git-annex transferrer` is used 
+(due to annex.stalldetection being configured), and -J is used,
+each transferrer process will end up prompting once for the password.
+
+I don't think it makes sense to convert this from a simple in-process cache
+to a cache that is shared amoung all subprocesses. That would reimplement
+what `git-credential-cache` already does. And if you need that,
+you can just enable it.
+
+But I would like to fix the autoinit case to not prompt twice, and am
+leaving this open for now to do that.
+"""]]