summaryrefslogtreecommitdiff
path: root/Remote
diff options
context:
space:
mode:
Diffstat (limited to 'Remote')
-rw-r--r--Remote/Bup.hs63
-rw-r--r--Remote/Directory.hs10
-rw-r--r--Remote/Git.hs124
-rw-r--r--Remote/Glacier.hs5
-rw-r--r--Remote/Helper/Hooks.hs14
-rw-r--r--Remote/Helper/Ssh.hs6
-rw-r--r--Remote/Hook.hs10
-rw-r--r--Remote/List.hs9
-rw-r--r--Remote/Rsync.hs26
-rw-r--r--Remote/S3.hs5
-rw-r--r--Remote/Web.hs5
-rw-r--r--Remote/WebDAV.hs5
12 files changed, 147 insertions, 135 deletions
diff --git a/Remote/Bup.hs b/Remote/Bup.hs
index e14185017..2f71e516d 100644
--- a/Remote/Bup.hs
+++ b/Remote/Bup.hs
@@ -38,35 +38,41 @@ remote = RemoteType {
setup = bupSetup
}
-gen :: Git.Repo -> UUID -> RemoteConfig -> Annex Remote
-gen r u c = do
- buprepo <- getRemoteConfig r "buprepo" (error "missing buprepo")
- cst <- remoteCost r (if bupLocal buprepo then semiCheapRemoteCost else expensiveRemoteCost)
+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen r u c gc = do
bupr <- liftIO $ bup2GitRemote buprepo
+ cst <- remoteCost gc $
+ if bupLocal buprepo
+ then semiCheapRemoteCost
+ else expensiveRemoteCost
(u', bupr') <- getBupUUID bupr u
+ let new = Remote
+ { uuid = u'
+ , cost = cst
+ , name = Git.repoDescribe r
+ , storeKey = store new buprepo
+ , retrieveKeyFile = retrieve buprepo
+ , retrieveKeyFileCheap = retrieveCheap buprepo
+ , removeKey = remove
+ , hasKey = checkPresent r bupr'
+ , hasKeyCheap = bupLocal buprepo
+ , whereisKey = Nothing
+ , config = c
+ , repo = r
+ , gitconfig = gc
+ , localpath = if bupLocal buprepo && not (null buprepo)
+ then Just buprepo
+ else Nothing
+ , remotetype = remote
+ , readonly = False
+ }
return $ encryptableRemote c
- (storeEncrypted r buprepo)
+ (storeEncrypted new buprepo)
(retrieveEncrypted buprepo)
- Remote
- { uuid = u'
- , cost = cst
- , name = Git.repoDescribe r
- , storeKey = store r buprepo
- , retrieveKeyFile = retrieve buprepo
- , retrieveKeyFileCheap = retrieveCheap buprepo
- , removeKey = remove
- , hasKey = checkPresent r bupr'
- , hasKeyCheap = bupLocal buprepo
- , whereisKey = Nothing
- , config = c
- , repo = r
- , localpath = if bupLocal buprepo && not (null buprepo)
- then Just buprepo
- else Nothing
- , remotetype = remote
- , readonly = False
- }
+ new
+ where
+ buprepo = fromMaybe (error "missing buprepo") $ remoteAnnexBupRepo gc
bupSetup :: UUID -> RemoteConfig -> Annex RemoteConfig
bupSetup u c = do
@@ -106,21 +112,20 @@ pipeBup params inh outh = do
ExitSuccess -> return True
_ -> return False
-bupSplitParams :: Git.Repo -> BupRepo -> Key -> [CommandParam] -> Annex [CommandParam]
+bupSplitParams :: Remote -> BupRepo -> Key -> [CommandParam] -> Annex [CommandParam]
bupSplitParams r buprepo k src = do
- o <- getRemoteConfig r "bup-split-options" ""
- let os = map Param $ words o
+ let os = map Param $ remoteAnnexBupSplitOptions $ gitconfig r
showOutput -- make way for bup output
return $ bupParams "split" buprepo
(os ++ [Param "-n", Param (bupRef k)] ++ src)
-store :: Git.Repo -> BupRepo -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
+store :: Remote -> BupRepo -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
store r buprepo k _f _p = do
src <- inRepo $ gitAnnexLocation k
params <- bupSplitParams r buprepo k [File src]
liftIO $ boolSystem "bup" params
-storeEncrypted :: Git.Repo -> BupRepo -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
+storeEncrypted :: Remote -> BupRepo -> (Cipher, Key) -> Key -> MeterUpdate -> Annex Bool
storeEncrypted r buprepo (cipher, enck) k _p = do
src <- inRepo $ gitAnnexLocation k
params <- bupSplitParams r buprepo enck []
diff --git a/Remote/Directory.hs b/Remote/Directory.hs
index 946df6111..12875770f 100644
--- a/Remote/Directory.hs
+++ b/Remote/Directory.hs
@@ -33,10 +33,9 @@ remote = RemoteType {
setup = directorySetup
}
-gen :: Git.Repo -> UUID -> RemoteConfig -> Annex Remote
-gen r u c = do
- dir <- getRemoteConfig r "directory" (error "missing directory")
- cst <- remoteCost r cheapRemoteCost
+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen r u c gc = do
+ cst <- remoteCost gc cheapRemoteCost
let chunksize = chunkSize c
return $ encryptableRemote c
(storeEncrypted dir chunksize)
@@ -54,10 +53,13 @@ gen r u c = do
whereisKey = Nothing,
config = M.empty,
repo = r,
+ gitconfig = gc,
localpath = Just dir,
readonly = False,
remotetype = remote
}
+ where
+ dir = fromMaybe (error "missing directory") $ remoteAnnexDirectory gc
directorySetup :: UUID -> RemoteConfig -> Annex RemoteConfig
directorySetup u c = do
diff --git a/Remote/Git.hs b/Remote/Git.hs
index db73247a1..9b0617652 100644
--- a/Remote/Git.hs
+++ b/Remote/Git.hs
@@ -19,6 +19,7 @@ import Utility.CopyFile
import Utility.Rsync
import Remote.Helper.Ssh
import Types.Remote
+import Types.GitConfig
import qualified Git
import qualified Git.Config
import qualified Git.Construct
@@ -73,10 +74,11 @@ list = do
- cached UUID value. -}
configRead :: Git.Repo -> Annex Git.Repo
configRead r = do
- notignored <- repoNotIgnored r
+ g <- fromRepo id
+ let c = extractRemoteGitConfig g (Git.repoDescribe r)
u <- getRepoUUID r
- case (repoCheap r, notignored, u) of
- (_, False, _) -> return r
+ case (repoCheap r, remoteAnnexIgnore c, u) of
+ (_, True, _) -> return r
(True, _, _) -> tryGitConfigRead r
(False, _, NoUUID) -> tryGitConfigRead r
_ -> return r
@@ -84,29 +86,32 @@ configRead r = do
repoCheap :: Git.Repo -> Bool
repoCheap = not . Git.repoIsUrl
-gen :: Git.Repo -> UUID -> RemoteConfig -> Annex Remote
-gen r u _ = new <$> remoteCost r defcst
+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen r u _ gc = go <$> remoteCost gc defcst
where
defcst = if repoCheap r then cheapRemoteCost else expensiveRemoteCost
- new cst = Remote
- { uuid = u
- , cost = cst
- , name = Git.repoDescribe r
- , storeKey = copyToRemote r
- , retrieveKeyFile = copyFromRemote r
- , retrieveKeyFileCheap = copyFromRemoteCheap r
- , removeKey = dropKey r
- , hasKey = inAnnex r
- , hasKeyCheap = repoCheap r
- , whereisKey = Nothing
- , config = M.empty
- , localpath = if Git.repoIsLocal r || Git.repoIsLocalUnknown r
- then Just $ Git.repoPath r
- else Nothing
- , repo = r
- , readonly = Git.repoIsHttp r
- , remotetype = remote
- }
+ go cst = new
+ where
+ new = Remote
+ { uuid = u
+ , cost = cst
+ , name = Git.repoDescribe r
+ , storeKey = copyToRemote new
+ , retrieveKeyFile = copyFromRemote new
+ , retrieveKeyFileCheap = copyFromRemoteCheap new
+ , removeKey = dropKey new
+ , hasKey = inAnnex r
+ , hasKeyCheap = repoCheap r
+ , whereisKey = Nothing
+ , config = M.empty
+ , localpath = if Git.repoIsLocal r || Git.repoIsLocalUnknown r
+ then Just $ Git.repoPath r
+ else Nothing
+ , repo = r
+ , gitconfig = gc
+ , readonly = Git.repoIsHttp r
+ , remotetype = remote
+ }
{- Checks relatively inexpensively if a repository is available for use. -}
repoAvail :: Git.Repo -> Annex Bool
@@ -236,10 +241,10 @@ keyUrls r key = map tourl (annexLocations key)
where
tourl l = Git.repoLocation r ++ "/" ++ l
-dropKey :: Git.Repo -> Key -> Annex Bool
+dropKey :: Remote -> Key -> Annex Bool
dropKey r key
- | not $ Git.repoIsUrl r =
- guardUsable r False $ commitOnCleanup r $ liftIO $ onLocal r $ do
+ | not $ Git.repoIsUrl (repo r) =
+ guardUsable (repo r) False $ commitOnCleanup r $ liftIO $ onLocal (repo r) $ do
ensureInitialized
whenM (Annex.Content.inAnnex key) $ do
Annex.Content.lockContent key $
@@ -247,29 +252,29 @@ dropKey r key
logStatus key InfoMissing
Annex.Content.saveState True
return True
- | Git.repoIsHttp r = error "dropping from http repo not supported"
- | otherwise = commitOnCleanup r $ onRemote r (boolSystem, False) "dropkey"
+ | Git.repoIsHttp (repo r) = error "dropping from http repo not supported"
+ | otherwise = commitOnCleanup r $ onRemote (repo r) (boolSystem, False) "dropkey"
[ Params "--quiet --force"
, Param $ key2file key
]
[]
{- Tries to copy a key's content from a remote's annex to a file. -}
-copyFromRemote :: Git.Repo -> Key -> AssociatedFile -> FilePath -> Annex Bool
+copyFromRemote :: Remote -> Key -> AssociatedFile -> FilePath -> Annex Bool
copyFromRemote r key file dest
- | not $ Git.repoIsUrl r = guardUsable r False $ do
- params <- rsyncParams r
+ | not $ Git.repoIsUrl (repo r) = guardUsable (repo r) False $ do
+ let params = rsyncParams r
u <- getUUID
-- run copy from perspective of remote
- liftIO $ onLocal r $ do
+ liftIO $ onLocal (repo r) $ do
ensureInitialized
Annex.Content.sendAnnex key $ \object ->
upload u key file noRetry $
rsyncOrCopyFile params object dest
- | Git.repoIsSsh r = feedprogressback $ \feeder ->
+ | Git.repoIsSsh (repo r) = feedprogressback $ \feeder ->
rsyncHelper (Just feeder)
=<< rsyncParamsRemote r True key dest file
- | Git.repoIsHttp r = Annex.Content.downloadUrl (keyUrls r key) dest
+ | Git.repoIsHttp (repo r) = Annex.Content.downloadUrl (keyUrls (repo r) key) dest
| otherwise = error "copying from non-ssh, non-http repo not supported"
where
{- Feed local rsync's progress info back to the remote,
@@ -289,7 +294,7 @@ copyFromRemote r key file dest
u <- getUUID
let fields = (Fields.remoteUUID, fromUUID u)
: maybe [] (\f -> [(Fields.associatedFile, f)]) file
- Just (cmd, params) <- git_annex_shell r "transferinfo"
+ Just (cmd, params) <- git_annex_shell (repo r) "transferinfo"
[Param $ key2file key] fields
v <- liftIO $ newEmptySV
tid <- liftIO $ forkIO $ void $ tryIO $ do
@@ -310,12 +315,12 @@ copyFromRemote r key file dest
let feeder = writeSV v
bracketIO noop (const $ tryIO $ killThread tid) (a feeder)
-copyFromRemoteCheap :: Git.Repo -> Key -> FilePath -> Annex Bool
+copyFromRemoteCheap :: Remote -> Key -> FilePath -> Annex Bool
copyFromRemoteCheap r key file
- | not $ Git.repoIsUrl r = guardUsable r False $ do
- loc <- liftIO $ gitAnnexLocation key r
+ | not $ Git.repoIsUrl (repo r) = guardUsable (repo r) False $ do
+ loc <- liftIO $ gitAnnexLocation key (repo r)
liftIO $ catchBoolIO $ createSymbolicLink loc file >> return True
- | Git.repoIsSsh r =
+ | Git.repoIsSsh (repo r) =
ifM (Annex.Content.preseedTmp key file)
( copyFromRemote r key Nothing file
, return False
@@ -323,18 +328,20 @@ copyFromRemoteCheap r key file
| otherwise = return False
{- Tries to copy a key's content to a remote's annex. -}
-copyToRemote :: Git.Repo -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
+copyToRemote :: Remote -> Key -> AssociatedFile -> MeterUpdate -> Annex Bool
copyToRemote r key file p
- | not $ Git.repoIsUrl r = guardUsable r False $ commitOnCleanup r $ copylocal
- | Git.repoIsSsh r = commitOnCleanup r $ Annex.Content.sendAnnex key $ \object ->
- rsyncHelper (Just p) =<< rsyncParamsRemote r False key object file
+ | not $ Git.repoIsUrl (repo r) =
+ guardUsable (repo r) False $ commitOnCleanup r $ copylocal
+ | Git.repoIsSsh (repo r) = commitOnCleanup r $
+ Annex.Content.sendAnnex key $ \object ->
+ rsyncHelper (Just p) =<< rsyncParamsRemote r False key object file
| otherwise = error "copying to non-ssh repo not supported"
where
copylocal = Annex.Content.sendAnnex key $ \object -> do
- params <- rsyncParams r
+ let params = rsyncParams r
u <- getUUID
-- run copy from perspective of remote
- liftIO $ onLocal r $ ifM (Annex.Content.inAnnex key)
+ liftIO $ onLocal (repo r) $ ifM (Annex.Content.inAnnex key)
( return False
, do
ensureInitialized
@@ -382,18 +389,18 @@ rsyncOrCopyFile rsyncparams src dest p =
{- Generates rsync parameters that ssh to the remote and asks it
- to either receive or send the key's content. -}
-rsyncParamsRemote :: Git.Repo -> Bool -> Key -> FilePath -> AssociatedFile -> Annex [CommandParam]
+rsyncParamsRemote :: Remote -> Bool -> Key -> FilePath -> AssociatedFile -> Annex [CommandParam]
rsyncParamsRemote r sending key file afile = do
u <- getUUID
let fields = (Fields.remoteUUID, fromUUID u)
: maybe [] (\f -> [(Fields.associatedFile, f)]) afile
- Just (shellcmd, shellparams) <- git_annex_shell r
+ Just (shellcmd, shellparams) <- git_annex_shell (repo r)
(if sending then "sendkey" else "recvkey")
[ Param $ key2file key ]
fields
-- Convert the ssh command into rsync command line.
let eparam = rsyncShell (Param shellcmd:shellparams)
- o <- rsyncParams r
+ let o = rsyncParams r
if sending
then return $ o ++ rsyncopts eparam dummy (File file)
else return $ o ++ rsyncopts eparam (File file) dummy
@@ -410,25 +417,22 @@ rsyncParamsRemote r sending key file afile = do
- even though this hostname will never be used. -}
dummy = Param "dummy:"
-rsyncParams :: Git.Repo -> Annex [CommandParam]
-rsyncParams r = do
- o <- getRemoteConfig r "rsync-options" ""
- return $ options ++ map Param (words o)
- where
- -- --inplace to resume partial files
- options = [Params "-p --progress --inplace"]
+-- --inplace to resume partial files
+rsyncParams :: Remote -> [CommandParam]
+rsyncParams r = [Params "-p --progress --inplace"] ++
+ map Param (remoteAnnexRsyncOptions $ gitconfig r)
-commitOnCleanup :: Git.Repo -> Annex a -> Annex a
+commitOnCleanup :: Remote -> Annex a -> Annex a
commitOnCleanup r a = go `after` a
where
- go = Annex.addCleanup (Git.repoLocation r) cleanup
+ go = Annex.addCleanup (Git.repoLocation $ repo r) cleanup
cleanup
- | not $ Git.repoIsUrl r = liftIO $ onLocal r $
+ | not $ Git.repoIsUrl (repo r) = liftIO $ onLocal (repo r) $
doQuietSideAction $
Annex.Branch.commit "update"
| otherwise = void $ do
Just (shellcmd, shellparams) <-
- git_annex_shell r "commit" [] []
+ git_annex_shell (repo r) "commit" [] []
-- Throw away stderr, since the remote may not
-- have a new enough git-annex shell to
diff --git a/Remote/Glacier.hs b/Remote/Glacier.hs
index 05cdf8978..04b70e2f1 100644
--- a/Remote/Glacier.hs
+++ b/Remote/Glacier.hs
@@ -37,8 +37,8 @@ remote = RemoteType {
setup = glacierSetup
}
-gen :: Git.Repo -> UUID -> RemoteConfig -> Annex Remote
-gen r u c = new <$> remoteCost r veryExpensiveRemoteCost
+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen r u c gc = new <$> remoteCost gc veryExpensiveRemoteCost
where
new cst = encryptableRemote c
(storeEncrypted this)
@@ -58,6 +58,7 @@ gen r u c = new <$> remoteCost r veryExpensiveRemoteCost
whereisKey = Nothing,
config = c,
repo = r,
+ gitconfig = gc,
localpath = Nothing,
readonly = False,
remotetype = remote
diff --git a/Remote/Helper/Hooks.hs b/Remote/Helper/Hooks.hs
index 91190d841..bdeb653eb 100644
--- a/Remote/Helper/Hooks.hs
+++ b/Remote/Helper/Hooks.hs
@@ -13,15 +13,16 @@ import Common.Annex
import Types.Remote
import qualified Annex
import Annex.LockPool
-import Config
import Annex.Perms
{- Modifies a remote's access functions to first run the
- annex-start-command hook, and trigger annex-stop-command on shutdown.
- This way, the hooks are only run when a remote is actively being used.
-}
-addHooks :: Remote -> Annex Remote
-addHooks r = addHooks' r <$> lookupHook r "start" <*> lookupHook r "stop"
+addHooks :: Remote -> Remote
+addHooks r = addHooks' r
+ (remoteAnnexStartCommand $ gitconfig r)
+ (remoteAnnexStopCommand $ gitconfig r)
addHooks' :: Remote -> Maybe String -> Maybe String -> Remote
addHooks' r Nothing Nothing = r
addHooks' r starthook stophook = r'
@@ -83,10 +84,3 @@ runHooks r starthook stophook a = do
Left _ -> noop
Right _ -> run stophook
liftIO $ closeFd fd
-
-lookupHook :: Remote -> String -> Annex (Maybe String)
-lookupHook r n = go =<< getRemoteConfig (repo r) hookname ""
- where
- go "" = return Nothing
- go command = return $ Just command
- hookname = n ++ "-command"
diff --git a/Remote/Helper/Ssh.hs b/Remote/Helper/Ssh.hs
index b6da80ec6..135b5c144 100644
--- a/Remote/Helper/Ssh.hs
+++ b/Remote/Helper/Ssh.hs
@@ -10,17 +10,19 @@ module Remote.Helper.Ssh where
import Common.Annex
import qualified Git
import qualified Git.Url
-import Config
import Annex.UUID
import Annex.Ssh
import Fields
+import Types.GitConfig
{- Generates parameters to ssh to a repository's host and run a command.
- Caller is responsible for doing any neccessary shellEscaping of the
- passed command. -}
sshToRepo :: Git.Repo -> [CommandParam] -> Annex [CommandParam]
sshToRepo repo sshcmd = do
- opts <- map Param . words <$> getRemoteConfig repo "ssh-options" ""
+ g <- fromRepo id
+ let c = extractRemoteGitConfig g (Git.repoDescribe repo)
+ let opts = map Param $ remoteAnnexSshOptions c
params <- sshParams (Git.Url.hostuser repo, Git.Url.port repo) opts
return $ params ++ sshcmd
diff --git a/Remote/Hook.hs b/Remote/Hook.hs
index 8f9aaafd6..c9edda133 100644
--- a/Remote/Hook.hs
+++ b/Remote/Hook.hs
@@ -29,10 +29,9 @@ remote = RemoteType {
setup = hookSetup
}
-gen :: Git.Repo -> UUID -> RemoteConfig -> Annex Remote
-gen r u c = do
- hooktype <- getRemoteConfig r "hooktype" (error "missing hooktype")
- cst <- remoteCost r expensiveRemoteCost
+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen r u c gc = do
+ cst <- remoteCost gc expensiveRemoteCost
return $ encryptableRemote c
(storeEncrypted hooktype)
(retrieveEncrypted hooktype)
@@ -50,9 +49,12 @@ gen r u c = do
config = M.empty,
localpath = Nothing,
repo = r,
+ gitconfig = gc,
readonly = False,
remotetype = remote
}
+ where
+ hooktype = fromMaybe (error "missing hooktype") $ remoteAnnexHookType gc
hookSetup :: UUID -> RemoteConfig -> Annex RemoteConfig
hookSetup u c = do
diff --git a/Remote/List.hs b/Remote/List.hs
index 4622f1e99..1cfbab872 100644
--- a/Remote/List.hs
+++ b/Remote/List.hs
@@ -15,8 +15,8 @@ import Common.Annex
import qualified Annex
import Logs.Remote
import Types.Remote
+import Types.GitConfig
import Annex.UUID
-import Config
import Remote.Helper.Hooks
import qualified Git
import qualified Git.Config
@@ -81,7 +81,10 @@ remoteListRefresh = do
remoteGen :: (M.Map UUID RemoteConfig) -> RemoteType -> Git.Repo -> Annex Remote
remoteGen m t r = do
u <- getRepoUUID r
- addHooks =<< generate t r u (fromMaybe M.empty $ M.lookup u m)
+ g <- fromRepo id
+ let gc = extractRemoteGitConfig g (Git.repoDescribe r)
+ let c = fromMaybe M.empty $ M.lookup u m
+ addHooks <$> generate t r u c gc
{- Updates a local git Remote, re-reading its git config. -}
updateRemote :: Remote -> Annex Remote
@@ -97,7 +100,7 @@ updateRemote remote = do
{- All remotes that are not ignored. -}
enabledRemoteList :: Annex [Remote]
-enabledRemoteList = filterM (repoNotIgnored . repo) =<< remoteList
+enabledRemoteList = filter (not . remoteAnnexIgnore . gitconfig) <$> remoteList
{- Checks if a remote is a special remote -}
specialRemote :: Remote -> Bool
diff --git a/Remote/Rsync.hs b/Remote/Rsync.hs
index 4c61d8e62..b05753830 100644
--- a/Remote/Rsync.hs
+++ b/Remote/Rsync.hs
@@ -38,10 +38,9 @@ remote = RemoteType {
setup = rsyncSetup
}
-gen :: Git.Repo -> UUID -> RemoteConfig -> Annex Remote
-gen r u c = do
- o <- genRsyncOpts r c
- cst <- remoteCost r expensiveRemoteCost
+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen r u c gc = do
+ cst <- remoteCost gc expensiveRemoteCost
return $ encryptableRemote c
(storeEncrypted o)
(retrieveEncrypted o)
@@ -58,27 +57,24 @@ gen r u c = do
, whereisKey = Nothing
, config = M.empty
, repo = r
+ , gitconfig = gc
, localpath = if rsyncUrlIsPath $ rsyncUrl o
then Just $ rsyncUrl o
else Nothing
, readonly = False
, remotetype = remote
}
-
-genRsyncOpts :: Git.Repo -> RemoteConfig -> Annex RsyncOpts
-genRsyncOpts r c = do
- url <- getRemoteConfig r "rsyncurl" (error "missing rsyncurl")
- opts <- map Param . filter safe . words
- <$> getRemoteConfig r "rsync-options" ""
- let escape = M.lookup "shellescape" c /= Just "no"
- return $ RsyncOpts url opts escape
where
- safe o
+ o = RsyncOpts url opts escape
+ url = fromMaybe (error "missing rsyncurl") $ remoteAnnexRsyncUrl gc
+ opts = map Param $ filter safe $ remoteAnnexRsyncOptions gc
+ escape = M.lookup "shellescape" c /= Just "no"
+ safe opt
-- Don't allow user to pass --delete to rsync;
-- that could cause it to delete other keys
-- in the same hash bucket as a key it sends.
- | o == "--delete" = False
- | o == "--delete-excluded" = False
+ | opt == "--delete" = False
+ | opt == "--delete-excluded" = False
| otherwise = True
rsyncSetup :: UUID -> RemoteConfig -> Annex RemoteConfig
diff --git a/Remote/S3.hs b/Remote/S3.hs
index 345d93872..0c0737841 100644
--- a/Remote/S3.hs
+++ b/Remote/S3.hs
@@ -37,8 +37,8 @@ remote = RemoteType {
setup = s3Setup
}
-gen :: Git.Repo -> UUID -> RemoteConfig -> Annex Remote
-gen r u c = new <$> remoteCost r expensiveRemoteCost
+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
where
new cst = encryptableRemote c
(storeEncrypted this)
@@ -58,6 +58,7 @@ gen r u c = new <$> remoteCost r expensiveRemoteCost
whereisKey = Nothing,
config = c,
repo = r,
+ gitconfig = gc,
localpath = Nothing,
readonly = False,
remotetype = remote
diff --git a/Remote/Web.hs b/Remote/Web.hs
index f1eee7feb..f984137a9 100644
--- a/Remote/Web.hs
+++ b/Remote/Web.hs
@@ -35,8 +35,8 @@ list = do
r <- liftIO $ Git.Construct.remoteNamed "web" Git.Construct.fromUnknown
return [r]
-gen :: Git.Repo -> UUID -> RemoteConfig -> Annex Remote
-gen r _ _ =
+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen r _ _ gc =
return Remote {
uuid = webUUID,
cost = expensiveRemoteCost,
@@ -49,6 +49,7 @@ gen r _ _ =
hasKeyCheap = False,
whereisKey = Just getUrls,
config = M.empty,
+ gitconfig = gc,
localpath = Nothing,
repo = r,
readonly = True,
diff --git a/Remote/WebDAV.hs b/Remote/WebDAV.hs
index 70faa7539..752e0d7ff 100644
--- a/Remote/WebDAV.hs
+++ b/Remote/WebDAV.hs
@@ -43,8 +43,8 @@ remote = RemoteType {
setup = webdavSetup
}
-gen :: Git.Repo -> UUID -> RemoteConfig -> Annex Remote
-gen r u c = new <$> remoteCost r expensiveRemoteCost
+gen :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> Annex Remote
+gen r u c gc = new <$> remoteCost gc expensiveRemoteCost
where
new cst = encryptableRemote c
(storeEncrypted this)
@@ -64,6 +64,7 @@ gen r u c = new <$> remoteCost r expensiveRemoteCost
whereisKey = Nothing,
config = c,
repo = r,
+ gitconfig = gc,
localpath = Nothing,
readonly = False,
remotetype = remote
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-29 00:43:05 +0000