diff options
| author |  Joey Hess <joey@kitenet.net> | 2012-04-22 01:13:09 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2012-04-22 01:13:09 -0400 |
| commit | 84ac8c58db30637db4fb88566530b6293f12dab0 (patch) | |
| tree | 72b7d1bae98ee22b34d722554069b68eea47513f /Remote | |
| parent | 5fbe83f595bf5957376544ee83b3cc46cc2323ed (diff) | |
Add annex.httpheaders and annex.httpheader-command config settings
Allow custom headers to be sent with all HTTP requests.
(Requested by the Internet Archive)
Diffstat (limited to 'Remote')
| -rw-r--r-- | Remote/Git.hs | 14 | ||||
| -rw-r--r-- | Remote/Web.hs | 3 |
2 files changed, 10 insertions, 7 deletions
diff --git a/Remote/Git.hs b/Remote/Git.hs index d71872b27..35928b96c 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -94,7 +94,9 @@ tryGitConfigRead :: Git.Repo -> Annex Git.Repo tryGitConfigRead r | not $ M.null $ Git.config r = return r -- already read | Git.repoIsSsh r = store $ onRemote r (pipedconfig, r) "configlist" [] - | Git.repoIsHttp r = store $ safely geturlconfig + | Git.repoIsHttp r = do + headers <- getHttpHeaders + store $ safely $ geturlconfig headers | Git.repoIsUrl r = return r | otherwise = store $ safely $ onLocal r $ do ensureInitialized @@ -109,8 +111,8 @@ tryGitConfigRead r pOpen ReadFromPipe cmd (toCommand params) $ Git.Config.hRead r - geturlconfig = do - s <- Url.get (Git.repoLocation r ++ "/config") + geturlconfig headers = do + s <- Url.get (Git.repoLocation r ++ "/config") headers withTempFile "git-annex.tmp" $ \tmpfile h -> do hPutStr h s hClose h @@ -136,16 +138,16 @@ tryGitConfigRead r -} inAnnex :: Git.Repo -> Key -> Annex (Either String Bool) inAnnex r key - | Git.repoIsHttp r = checkhttp + | Git.repoIsHttp r = checkhttp =<< getHttpHeaders | Git.repoIsUrl r = checkremote | otherwise = checklocal where - checkhttp = liftIO $ go undefined $ keyUrls r key + checkhttp headers = liftIO $ go undefined $ keyUrls r key where go e [] = return $ Left e go _ (u:us) = do res <- catchMsgIO $ - Url.check u (keySize key) + Url.check u headers (keySize key) case res of Left e -> go e us v -> return v diff --git a/Remote/Web.hs b/Remote/Web.hs index 81e6ca321..5fc592326 100644 --- a/Remote/Web.hs +++ b/Remote/Web.hs @@ -83,4 +83,5 @@ checkKey key = do checkKey' :: Key -> [URLString] -> Annex Bool checkKey' key us = untilTrue us $ \u -> do showAction $ "checking " ++ u - liftIO $ Url.check u (keySize key) + headers <- getHttpHeaders + liftIO $ Url.check u headers (keySize key) |