summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Annex.hs26
-rw-r--r--Annex/Content.hs4
-rw-r--r--Annex/Queue.hs2
-rw-r--r--Annex/Ssh.hs2
-rw-r--r--Annex/Version.hs6
-rw-r--r--Assistant/DaemonStatus.hs3
-rw-r--r--Assistant/Threads/Committer.hs2
-rw-r--r--Backend.hs2
-rw-r--r--Command/Status.hs2
-rw-r--r--Command/Sync.hs4
-rw-r--r--Command/Unused.hs4
-rw-r--r--Config.hs55
-rw-r--r--GitAnnex.hs2
-rw-r--r--Logs/Trust.hs9
-rw-r--r--Remote.hs16
-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
-rw-r--r--Types.hs5
-rw-r--r--Types/Config.hs64
-rw-r--r--Types/GitConfig.hs122
-rw-r--r--Types/Remote.hs7
-rw-r--r--debian/changelog5
-rw-r--r--doc/assistant/release_notes.mdwn25
-rw-r--r--doc/design/assistant.mdwn2
-rw-r--r--doc/direct_mode.mdwn5
35 files changed, 362 insertions, 294 deletions
diff --git a/Annex.hs b/Annex.hs
index bb3548b00..f253c48f5 100644
--- a/Annex.hs
+++ b/Annex.hs
@@ -28,8 +28,8 @@ module Annex (
gitRepo,
inRepo,
fromRepo,
- getConfig,
- changeConfig,
+ getGitConfig,
+ changeGitConfig,
changeGitRepo,
) where
@@ -46,7 +46,7 @@ import Git.CheckAttr
import Git.SharedRepository
import qualified Git.Queue
import Types.Backend
-import Types.Config
+import Types.GitConfig
import qualified Types.Remote
import Types.Crypto
import Types.BranchState
@@ -92,7 +92,7 @@ type PreferredContentMap = M.Map UUID (Utility.Matcher.Matcher (S.Set UUID -> Fi
-- internal state storage
data AnnexState = AnnexState
{ repo :: Git.Repo
- , config :: Config
+ , gitconfig :: GitConfig
, backends :: [BackendA Annex]
, remotes :: [Types.Remote.RemoteA Annex]
, output :: MessageState
@@ -122,7 +122,7 @@ data AnnexState = AnnexState
newState :: Git.Repo -> AnnexState
newState gitrepo = AnnexState
{ repo = gitrepo
- , config = extractConfig gitrepo
+ , gitconfig = extractGitConfig gitrepo
, backends = []
, remotes = []
, output = defaultMessageState
@@ -202,17 +202,17 @@ inRepo a = liftIO . a =<< gitRepo
fromRepo :: (Git.Repo -> a) -> Annex a
fromRepo a = a <$> gitRepo
-{- Gets the Config settings. -}
-getConfig :: Annex Config
-getConfig = getState config
+{- Gets the GitConfig settings. -}
+getGitConfig :: Annex GitConfig
+getGitConfig = getState gitconfig
-{- Modifies a Config setting. -}
-changeConfig :: (Config -> Config) -> Annex ()
-changeConfig a = changeState $ \s -> s { config = a (config s) }
+{- Modifies a GitConfig setting. -}
+changeGitConfig :: (GitConfig -> GitConfig) -> Annex ()
+changeGitConfig a = changeState $ \s -> s { gitconfig = a (gitconfig s) }
-{- Changing the git Repo data also involves re-extracting its Config. -}
+{- Changing the git Repo data also involves re-extracting its GitConfig. -}
changeGitRepo :: Git.Repo -> Annex ()
changeGitRepo r = changeState $ \s -> s
{ repo = r
- , config = extractConfig r
+ , gitconfig = extractGitConfig r
}
diff --git a/Annex/Content.hs b/Annex/Content.hs
index 1f7516fe1..4c6802bf8 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -187,7 +187,7 @@ withTmp key action = do
- in a destination (or the annex) printing a warning if not. -}
checkDiskSpace :: Maybe FilePath -> Key -> Integer -> Annex Bool
checkDiskSpace destination key alreadythere = do
- reserve <- annexDiskReserve <$> Annex.getConfig
+ reserve <- annexDiskReserve <$> Annex.getGitConfig
free <- liftIO . getDiskFree =<< dir
force <- Annex.getState Annex.force
case (free, keySize key) of
@@ -395,7 +395,7 @@ saveState :: Bool -> Annex ()
saveState nocommit = doSideAction $ do
Annex.Queue.flush
unless nocommit $
- whenM (annexAlwaysCommit <$> Annex.getConfig) $
+ whenM (annexAlwaysCommit <$> Annex.getGitConfig) $
Annex.Branch.commit "update"
{- Downloads content from any of a list of urls. -}
diff --git a/Annex/Queue.hs b/Annex/Queue.hs
index 0f8c38ab9..a5ef60037 100644
--- a/Annex/Queue.hs
+++ b/Annex/Queue.hs
@@ -54,7 +54,7 @@ get = maybe new return =<< getState repoqueue
new :: Annex Git.Queue.Queue
new = do
- q <- Git.Queue.new . annexQueueSize <$> getConfig
+ q <- Git.Queue.new . annexQueueSize <$> getGitConfig
store q
return q
diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs
index d3622686c..b6811858f 100644
--- a/Annex/Ssh.hs
+++ b/Annex/Ssh.hs
@@ -59,7 +59,7 @@ sshInfo (host, port) = ifM caching
caching = return False
#else
caching = fromMaybe SysConfig.sshconnectioncaching
- . annexSshCaching <$> Annex.getConfig
+ . annexSshCaching <$> Annex.getGitConfig
#endif
cacheParams :: FilePath -> [CommandParam]
diff --git a/Annex/Version.hs b/Annex/Version.hs
index 30ad957c3..6149e6fb7 100644
--- a/Annex/Version.hs
+++ b/Annex/Version.hs
@@ -9,6 +9,7 @@ module Annex.Version where
import Common.Annex
import Config
+import qualified Annex
type Version = String
@@ -25,10 +26,7 @@ versionField :: ConfigKey
versionField = annexConfig "version"
getVersion :: Annex (Maybe Version)
-getVersion = handle <$> getConfig versionField ""
- where
- handle [] = Nothing
- handle v = Just v
+getVersion = annexVersion <$> Annex.getGitConfig
setVersion :: Annex ()
setVersion = setConfig versionField defaultVersion
diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs
index cb9133b2a..28383a4dd 100644
--- a/Assistant/DaemonStatus.hs
+++ b/Assistant/DaemonStatus.hs
@@ -17,7 +17,6 @@ import Logs.Trust
import qualified Remote
import qualified Types.Remote as Remote
import qualified Git
-import Config
import Control.Concurrent.STM
import System.Posix.Types
@@ -48,7 +47,7 @@ modifyDaemonStatus a = do
{- Returns a function that updates the lists of syncable remotes. -}
calcSyncRemotes :: Annex (DaemonStatus -> DaemonStatus)
calcSyncRemotes = do
- rs <- filterM (repoSyncable . Remote.repo) =<<
+ rs <- filter (remoteAnnexSync . Remote.gitconfig) .
concat . Remote.byCost <$> Remote.enabledRemoteList
alive <- trustExclude DeadTrusted (map Remote.uuid rs)
let good r = Remote.uuid r `elem` alive
diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs
index 7940b0836..6e5412e00 100644
--- a/Assistant/Threads/Committer.hs
+++ b/Assistant/Threads/Committer.hs
@@ -44,7 +44,7 @@ commitThread :: NamedThread
commitThread = NamedThread "Committer" $ do
delayadd <- liftAnnex $
maybe delayaddDefault (return . Just . Seconds)
- =<< annexDelayAdd <$> Annex.getConfig
+ =<< annexDelayAdd <$> Annex.getGitConfig
runEvery (Seconds 1) <~> do
-- We already waited one second as a simple rate limiter.
-- Next, wait until at least one change is available for
diff --git a/Backend.hs b/Backend.hs
index 4972288c3..9c08e1437 100644
--- a/Backend.hs
+++ b/Backend.hs
@@ -44,7 +44,7 @@ orderedList = do
Just name | not (null name) ->
return [lookupBackendName name]
_ -> do
- l' <- gen . annexBackends <$> Annex.getConfig
+ l' <- gen . annexBackends <$> Annex.getGitConfig
Annex.changeState $ \s -> s { Annex.backends = l' }
return l'
where
diff --git a/Command/Status.hs b/Command/Status.hs
index 9c5e3e70a..89ba55cfa 100644
--- a/Command/Status.hs
+++ b/Command/Status.hs
@@ -200,7 +200,7 @@ transfer_list = stat "transfers in progress" $ nojson $ lift $ do
disk_size :: Stat
disk_size = stat "available local disk space" $ json id $ lift $
calcfree
- <$> (annexDiskReserve <$> Annex.getConfig)
+ <$> (annexDiskReserve <$> Annex.getGitConfig)
<*> inRepo (getDiskFree . gitAnnexDir)
where
calcfree reserve (Just have) = unwords
diff --git a/Command/Sync.hs b/Command/Sync.hs
index f7241ce82..61ac3802a 100644
--- a/Command/Sync.hs
+++ b/Command/Sync.hs
@@ -72,8 +72,8 @@ syncRemotes rs = ifM (Annex.getState Annex.fast) ( nub <$> pickfast , wanted )
unwords (map Types.Remote.name s)
return l
available = filter (not . Remote.specialRemote)
- <$> (filterM (repoSyncable . Types.Remote.repo)
- =<< Remote.enabledRemoteList)
+ . filter (remoteAnnexSync . Types.Remote.gitconfig)
+ <$> Remote.enabledRemoteList
good = filterM $ Remote.Git.repoAvail . Types.Remote.repo
fastest = fromMaybe [] . headMaybe . Remote.byCost
diff --git a/Command/Unused.hs b/Command/Unused.hs
index 2823ccefd..5f8af2185 100644
--- a/Command/Unused.hs
+++ b/Command/Unused.hs
@@ -180,9 +180,9 @@ exclude smaller larger = S.toList $ remove larger $ S.fromList smaller
- so will easily fit on even my lowest memory systems.
-}
bloomCapacity :: Annex Int
-bloomCapacity = fromMaybe 500000 . annexBloomCapacity <$> Annex.getConfig
+bloomCapacity = fromMaybe 500000 . annexBloomCapacity <$> Annex.getGitConfig
bloomAccuracy :: Annex Int
-bloomAccuracy = fromMaybe 1000 . annexBloomAccuracy <$> Annex.getConfig
+bloomAccuracy = fromMaybe 1000 . annexBloomAccuracy <$> Annex.getGitConfig
bloomBitsHashes :: Annex (Int, Int)
bloomBitsHashes = do
capacity <- bloomCapacity
diff --git a/Config.hs b/Config.hs
index afda3e7cb..f2f12a266 100644
--- a/Config.hs
+++ b/Config.hs
@@ -16,6 +16,10 @@ import qualified Annex
type UnqualifiedConfigKey = String
data ConfigKey = ConfigKey String
+{- Looks up a setting in git config. -}
+getConfig :: ConfigKey -> String -> Annex String
+getConfig (ConfigKey key) def = fromRepo $ Git.Config.get key def
+
{- Changes a git config setting in both internal state and .git/config -}
setConfig :: ConfigKey -> String -> Annex ()
setConfig (ConfigKey key) value = do
@@ -27,16 +31,6 @@ unsetConfig :: ConfigKey -> Annex ()
unsetConfig (ConfigKey key) = inRepo $ Git.Command.run "config"
[Param "--unset", Param key]
-{- Looks up a setting in git config. -}
-getConfig :: ConfigKey -> String -> Annex String
-getConfig (ConfigKey key) def = fromRepo $ Git.Config.get key def
-
-{- Looks up a per-remote config setting in git config.
- - Failing that, tries looking for a global config option. -}
-getRemoteConfig :: Git.Repo -> UnqualifiedConfigKey -> String -> Annex String
-getRemoteConfig r key def =
- getConfig (remoteConfig r key) =<< getConfig (annexConfig key) def
-
{- A per-remote config setting in git config. -}
remoteConfig :: Git.Repo -> UnqualifiedConfigKey -> ConfigKey
remoteConfig r key = ConfigKey $
@@ -46,16 +40,15 @@ remoteConfig r key = ConfigKey $
annexConfig :: UnqualifiedConfigKey -> ConfigKey
annexConfig key = ConfigKey $ "annex." ++ key
-{- Calculates cost for a remote. Either the default, or as configured
+{- Calculates cost for a remote. Either the specific default, or as configured
- by remote.<name>.annex-cost, or if remote.<name>.annex-cost-command
- is set and prints a number, that is used. -}
-remoteCost :: Git.Repo -> Int -> Annex Int
-remoteCost r def = do
- cmd <- getRemoteConfig r "cost-command" ""
- (fromMaybe def . readish) <$>
- if not $ null cmd
- then liftIO $ readProcess "sh" ["-c", cmd]
- else getRemoteConfig r "cost" ""
+remoteCost :: RemoteGitConfig -> Int -> Annex Int
+remoteCost c def = case remoteAnnexCostCommand c of
+ Just cmd | not (null cmd) -> liftIO $
+ (fromMaybe def . readish) <$>
+ readProcess "sh" ["-c", cmd]
+ _ -> return $ fromMaybe def $ remoteAnnexCost c
cheapRemoteCost :: Int
cheapRemoteCost = 100
@@ -81,38 +74,22 @@ prop_cost_sane = False `notElem`
, semiCheapRemoteCost + encryptedRemoteCostAdj < expensiveRemoteCost
]
-{- Checks if a repo should be ignored. -}
-repoNotIgnored :: Git.Repo -> Annex Bool
-repoNotIgnored r = not . fromMaybe False . Git.Config.isTrue
- <$> getRemoteConfig r "ignore" ""
-
-{- Checks if a repo should be synced. -}
-repoSyncable :: Git.Repo -> Annex Bool
-repoSyncable r = fromMaybe True . Git.Config.isTrue
- <$> getRemoteConfig r "sync" ""
-
-{- Gets the trust level set for a remote in git config. -}
-getTrustLevel :: Git.Repo -> Annex (Maybe String)
-getTrustLevel r = fromRepo $ Git.Config.getMaybe key
- where
- (ConfigKey key) = remoteConfig r "trustlevel"
-
getNumCopies :: Maybe Int -> Annex Int
getNumCopies (Just v) = return v
-getNumCopies Nothing = annexNumCopies <$> Annex.getConfig
+getNumCopies Nothing = annexNumCopies <$> Annex.getGitConfig
isDirect :: Annex Bool
-isDirect = annexDirect <$> Annex.getConfig
+isDirect = annexDirect <$> Annex.getGitConfig
setDirect :: Bool -> Annex ()
setDirect b = do
setConfig (annexConfig "direct") $ if b then "true" else "false"
- Annex.changeConfig $ \c -> c { annexDirect = b }
+ Annex.changeGitConfig $ \c -> c { annexDirect = b }
{- Gets the http headers to use. -}
getHttpHeaders :: Annex [String]
getHttpHeaders = do
- v <- annexHttpHeadersCommand <$> Annex.getConfig
+ v <- annexHttpHeadersCommand <$> Annex.getGitConfig
case v of
Just cmd -> lines <$> liftIO (readProcess "sh" ["-c", cmd])
- Nothing -> annexHttpHeaders <$> Annex.getConfig
+ Nothing -> annexHttpHeaders <$> Annex.getGitConfig
diff --git a/GitAnnex.hs b/GitAnnex.hs
index c807326ad..8b8b4ad1b 100644
--- a/GitAnnex.hs
+++ b/GitAnnex.hs
@@ -171,7 +171,7 @@ options = Option.common ++
] ++ Option.matcher
where
setnumcopies v = maybe noop
- (\n -> Annex.changeConfig $ \c -> c { annexNumCopies = n })
+ (\n -> Annex.changeGitConfig $ \c -> c { annexNumCopies = n })
(readish v)
setgitconfig v = Annex.changeGitRepo =<< inRepo (Git.Config.store v)
diff --git a/Logs/Trust.hs b/Logs/Trust.hs
index 8f568eba7..058250740 100644
--- a/Logs/Trust.hs
+++ b/Logs/Trust.hs
@@ -28,7 +28,6 @@ import qualified Annex.Branch
import qualified Annex
import Logs.UUIDBased
import Remote.List
-import Config
import qualified Types.Remote
{- Filename of trust.log. -}
@@ -85,14 +84,14 @@ trustMapLoad = do
overrides <- Annex.getState Annex.forcetrust
logged <- trustMapRaw
configured <- M.fromList . catMaybes
- <$> (mapM configuredtrust =<< remoteList)
+ <$> (map configuredtrust <$> remoteList)
let m = M.union overrides $ M.union configured logged
Annex.changeState $ \s -> s { Annex.trustmap = Just m }
return m
where
- configuredtrust r = maybe Nothing (\l -> Just (Types.Remote.uuid r, l))
- <$> maybe Nothing readTrustLevel
- <$> getTrustLevel (Types.Remote.repo r)
+ configuredtrust r = (\l -> Just (Types.Remote.uuid r, l))
+ =<< readTrustLevel
+ =<< remoteAnnexTrustLevel (Types.Remote.gitconfig r)
{- Does not include forcetrust or git config values, just those from the
- log file. -}
diff --git a/Remote.hs b/Remote.hs
index c4291a997..8b1d7cd61 100644
--- a/Remote.hs
+++ b/Remote.hs
@@ -27,7 +27,7 @@ module Remote (
byCost,
prettyPrintUUIDs,
prettyListUUIDs,
- repoFromUUID,
+ remoteFromUUID,
remotesWithUUID,
remotesWithoutUUID,
keyLocations,
@@ -53,7 +53,6 @@ import Logs.UUID
import Logs.Trust
import Logs.Location hiding (logStatus)
import Remote.List
-import qualified Git
{- Map from UUIDs of Remotes to a calculated value. -}
remoteMap :: (Remote -> a) -> Annex (M.Map UUID a)
@@ -147,15 +146,12 @@ prettyListUUIDs uuids = do
where
n = finddescription m u
-{- Gets the git repo associated with a UUID.
+{- Gets the remote associated with a UUID.
- There's no associated remote when this is the UUID of the local repo. -}
-repoFromUUID :: UUID -> Annex (Git.Repo, Maybe Remote)
-repoFromUUID u = ifM ((==) u <$> getUUID)
- ( (,) <$> gitRepo <*> pure Nothing
- , do
- remote <- fromMaybe (error "Unknown UUID") . M.lookup u
- <$> remoteMap id
- return (repo remote, Just remote)
+remoteFromUUID :: UUID -> Annex (Maybe Remote)
+remoteFromUUID u = ifM ((==) u <$> getUUID)
+ ( return Nothing
+ , Just . fromMaybe (error "Unknown UUID") . M.lookup u <$> remoteMap id
)
{- Filters a list of remotes to ones that have the listed uuids. -}
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
diff --git a/Types.hs b/Types.hs
index 16f901b26..d19ac3de1 100644
--- a/Types.hs
+++ b/Types.hs
@@ -10,7 +10,8 @@ module Types (
Backend,
Key,
UUID(..),
- Config(..),
+ GitConfig(..),
+ RemoteGitConfig(..),
Remote,
RemoteType,
Option,
@@ -19,7 +20,7 @@ module Types (
import Annex
import Types.Backend
-import Types.Config
+import Types.GitConfig
import Types.Key
import Types.UUID
import Types.Remote
diff --git a/Types/Config.hs b/Types/Config.hs
deleted file mode 100644
index 898c153d5..000000000
--- a/Types/Config.hs
+++ /dev/null
@@ -1,64 +0,0 @@
-{- git-annex configuration
- -
- - Copyright 2012 Joey Hess <joey@kitenet.net>
- -
- - Licensed under the GNU GPL version 3 or higher.
- -}
-
-module Types.Config (
- Config(..),
- extractConfig,
-) where
-
-import Common
-import qualified Git
-import qualified Git.Config
-import Utility.DataUnits
-
-{- Main git-annex settings. Each setting corresponds to a git-config key
- - such as annex.foo -}
-data Config = Config
- { annexNumCopies :: Int
- , annexDiskReserve :: Integer
- , annexDirect :: Bool
- , annexBackends :: [String]
- , annexQueueSize :: Maybe Int
- , annexBloomCapacity :: Maybe Int
- , annexBloomAccuracy :: Maybe Int
- , annexSshCaching :: Maybe Bool
- , annexAlwaysCommit :: Bool
- , annexDelayAdd :: Maybe Int
- , annexHttpHeaders :: [String]
- , annexHttpHeadersCommand :: Maybe String
- }
-
-extractConfig :: Git.Repo -> Config
-extractConfig r = Config
- { annexNumCopies = get "numcopies" 1
- , annexDiskReserve = fromMaybe onemegabyte $
- readSize dataUnits =<< getmaybe "diskreserve"
- , annexDirect = getbool "direct" False
- , annexBackends = fromMaybe [] $
- words <$> getmaybe "backends"
- , annexQueueSize = getmayberead "queuesize"
- , annexBloomCapacity = getmayberead "bloomcapacity"
- , annexBloomAccuracy = getmayberead "bloomaccuracy"
- , annexSshCaching = getmaybebool "sshcaching"
- , annexAlwaysCommit = getbool "alwayscommit" True
- , annexDelayAdd = getmayberead "delayadd"
- , annexHttpHeaders = getlist "http-headers"
- , annexHttpHeadersCommand = getmaybe "http-headers-command"
- }
- where
- get k def = fromMaybe def $ getmayberead k
- getbool k def = fromMaybe def $ getmaybebool k
- getmaybebool k = Git.Config.isTrue =<< getmaybe k
- getmayberead k = readish =<< getmaybe k
- getmaybe k = Git.Config.getMaybe (key k) r
- getlist k = Git.Config.getList (key k) r
- key k = "annex." ++ k
-
- onemegabyte = 1000000
-
-{- Per-remote git-annex settings. Each setting corresponds to a git-config
- - key such as annex.<remote>.foo -}
diff --git a/Types/GitConfig.hs b/Types/GitConfig.hs
new file mode 100644
index 000000000..f93ef1529
--- /dev/null
+++ b/Types/GitConfig.hs
@@ -0,0 +1,122 @@
+{- git-annex configuration
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Types.GitConfig (
+ GitConfig(..),
+ extractGitConfig,
+ RemoteGitConfig(..),
+ extractRemoteGitConfig,
+) where
+
+import Common
+import qualified Git
+import qualified Git.Config
+import Utility.DataUnits
+
+{- Main git-annex settings. Each setting corresponds to a git-config key
+ - such as annex.foo -}
+data GitConfig = GitConfig
+ { annexVersion :: Maybe String
+ , annexNumCopies :: Int
+ , annexDiskReserve :: Integer
+ , annexDirect :: Bool
+ , annexBackends :: [String]
+ , annexQueueSize :: Maybe Int
+ , annexBloomCapacity :: Maybe Int
+ , annexBloomAccuracy :: Maybe Int
+ , annexSshCaching :: Maybe Bool
+ , annexAlwaysCommit :: Bool
+ , annexDelayAdd :: Maybe Int
+ , annexHttpHeaders :: [String]
+ , annexHttpHeadersCommand :: Maybe String
+ }
+
+extractGitConfig :: Git.Repo -> GitConfig
+extractGitConfig r = GitConfig
+ { annexVersion = notempty $ getmaybe "version"
+ , annexNumCopies = get "numcopies" 1
+ , annexDiskReserve = fromMaybe onemegabyte $
+ readSize dataUnits =<< getmaybe "diskreserve"
+ , annexDirect = getbool "direct" False
+ , annexBackends = fromMaybe [] $ words <$> getmaybe "backends"
+ , annexQueueSize = getmayberead "queuesize"
+ , annexBloomCapacity = getmayberead "bloomcapacity"
+ , annexBloomAccuracy = getmayberead "bloomaccuracy"
+ , annexSshCaching = getmaybebool "sshcaching"
+ , annexAlwaysCommit = getbool "alwayscommit" True
+ , annexDelayAdd = getmayberead "delayadd"
+ , annexHttpHeaders = getlist "http-headers"
+ , annexHttpHeadersCommand = getmaybe "http-headers-command"
+ }
+ where
+ get k def = fromMaybe def $ getmayberead k
+ getbool k def = fromMaybe def $ getmaybebool k
+ getmaybebool k = Git.Config.isTrue =<< getmaybe k
+ getmayberead k = readish =<< getmaybe k
+ getmaybe k = Git.Config.getMaybe (key k) r
+ getlist k = Git.Config.getList (key k) r
+
+ key k = "annex." ++ k
+
+ onemegabyte = 1000000
+
+{- Per-remote git-annex settings. Each setting corresponds to a git-config
+ - key such as <remote>.annex-foo, or if that is not set, a default from
+ - annex.foo -}
+data RemoteGitConfig = RemoteGitConfig
+ { remoteAnnexCost :: Maybe Int
+ , remoteAnnexCostCommand :: Maybe String
+ , remoteAnnexIgnore :: Bool
+ , remoteAnnexSync :: Bool
+ , remoteAnnexTrustLevel :: Maybe String
+ , remoteAnnexStartCommand :: Maybe String
+ , remoteAnnexStopCommand :: Maybe String
+
+ -- these settings are specific to particular types of remotes
+ , remoteAnnexSshOptions :: [String]
+ , remoteAnnexRsyncOptions :: [String]
+ , remoteAnnexRsyncUrl :: Maybe String
+ , remoteAnnexBupRepo :: Maybe String
+ , remoteAnnexBupSplitOptions :: [String]
+ , remoteAnnexDirectory :: Maybe FilePath
+ , remoteAnnexHookType :: Maybe String
+ }
+
+extractRemoteGitConfig :: Git.Repo -> String -> RemoteGitConfig
+extractRemoteGitConfig r remotename = RemoteGitConfig
+ { remoteAnnexCost = getmayberead "cost"
+ , remoteAnnexCostCommand = notempty $ getmaybe "cost-command"
+ , remoteAnnexIgnore = getbool "ignore" False
+ , remoteAnnexSync = getbool "sync" True
+ , remoteAnnexTrustLevel = notempty $ getmaybe "trustlevel"
+ , remoteAnnexStartCommand = notempty $ getmaybe "start-command"
+ , remoteAnnexStopCommand = notempty $ getmaybe "stop-command"
+
+ , remoteAnnexSshOptions = getoptions "ssh-options"
+ , remoteAnnexRsyncOptions = getoptions "rsync-options"
+ , remoteAnnexRsyncUrl = notempty $ getmaybe "rsyncurl"
+ , remoteAnnexBupRepo = getmaybe "buprepo"
+ , remoteAnnexBupSplitOptions = getoptions "bup-split-options"
+ , remoteAnnexDirectory = notempty $ getmaybe "directory"
+ , remoteAnnexHookType = notempty $ getmaybe "hooktype"
+ }
+ where
+ getbool k def = fromMaybe def $ getmaybebool k
+ getmaybebool k = Git.Config.isTrue =<< getmaybe k
+ getmayberead k = readish =<< getmaybe k
+ getmaybe k = maybe (Git.Config.getMaybe (key k) r) Just $
+ Git.Config.getMaybe (remotekey k) r
+ getoptions k = fromMaybe [] $ words <$> getmaybe k
+
+ key k = "annex." ++ k
+ remotekey k = "remote." ++ remotename ++ ".annex-" ++ k
+
+notempty :: Maybe String -> Maybe String
+notempty Nothing = Nothing
+notempty (Just "") = Nothing
+notempty (Just s) = Just s
+
diff --git a/Types/Remote.hs b/Types/Remote.hs
index f01ae01f6..05763e4d3 100644
--- a/Types/Remote.hs
+++ b/Types/Remote.hs
@@ -16,6 +16,7 @@ import qualified Git
import Types.Key
import Types.UUID
import Types.Meters
+import Types.GitConfig
type RemoteConfigKey = String
type RemoteConfig = M.Map RemoteConfigKey String
@@ -27,7 +28,7 @@ data RemoteTypeA a = RemoteType {
-- enumerates remotes of this type
enumerate :: a [Git.Repo],
-- generates a remote of this type
- generate :: Git.Repo -> UUID -> RemoteConfig -> a (RemoteA a),
+ generate :: Git.Repo -> UUID -> RemoteConfig -> RemoteGitConfig -> a (RemoteA a),
-- initializes or changes a remote
setup :: UUID -> RemoteConfig -> a RemoteConfig
}
@@ -64,8 +65,10 @@ data RemoteA a = Remote {
whereisKey :: Maybe (Key -> a [String]),
-- a Remote has a persistent configuration store
config :: RemoteConfig,
- -- git configuration for the remote
+ -- git repo for the Remote
repo :: Git.Repo,
+ -- a Remote's configuration from git
+ gitconfig :: RemoteGitConfig,
-- a Remote can be assocated with a specific local filesystem path
localpath :: Maybe FilePath,
-- a Remote can be known to be readonly
diff --git a/debian/changelog b/debian/changelog
index 793fa7404..86f475df6 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -5,14 +5,13 @@ git-annex (3.20121212) UNRELEASED; urgency=low
via symlinks. Note that direct mode is currently experimental. Many
git-annex commands do not work in direct mode. Some git commands can
cause data loss when used in direct mode repositories.
- * assistant: Support direct mode.
+ * assistant: Now uses direct mode by default when setting up a new
+ local repository.
* OSX assistant: Now uses the FSEvents API to detect file changes.
This avoids issues with running out of file descriptors on large trees,
as well as allowing detection of modification of files in direct mode.
BSD systems still use kqueue, and cannot detect modifications of existing
files in direct mode.
- * OSX assistant: Uses direct mode by default when setting up a new
- local repository.
* kqueue: Fix bug that made broken symlinks not be noticed.
* vicfg: Quote filename. Closes: #696193
* Bugfix: Fixed bug parsing transfer info files, where the newline after
diff --git a/doc/assistant/release_notes.mdwn b/doc/assistant/release_notes.mdwn
index 1b39c5086..df478304f 100644
--- a/doc/assistant/release_notes.mdwn
+++ b/doc/assistant/release_notes.mdwn
@@ -1,3 +1,28 @@
+## version 3.20130102
+
+This release makes several significant improvements to the git-annex
+assistant, which is still in beta.
+
+The main improvement is direct mode. This allows you to directly edit files
+in the repository, and the assistant will automatically commit and sync
+your changes. Direct mode is the default for new repositories created
+by the assistant. To convert your existing repository to use direct mode,
+manually run `git annex direct` inside the repository.
+
+The following are known limitations of this release of the git-annex
+assistant:
+
+* If a file in a direct mode repository is modified as it's being transferred,
+ the old version of the file can be lost, and fsck will later complain
+ about a corrupt object.
+* On BSD operating systems (but not on OS X), the assistant uses kqueue to
+ watch files. Kqueue has to open every directory it watches, so too many
+ directories will run it out of the max number of open files (typically
+ 1024), and fail. See [[this_bug|bugs/Issue_on_OSX_with_some_system_limits]]
+ for a workaround.
+* Also on systems with kqueue, modifications to existing files in direct
+ mode will not be noticed.
+
## version 3.20121211
This release of the git-annex assistant (which is still in beta)
diff --git a/doc/design/assistant.mdwn b/doc/design/assistant.mdwn
index 6e04ca1f7..4e2a222ca 100644
--- a/doc/design/assistant.mdwn
+++ b/doc/design/assistant.mdwn
@@ -10,10 +10,10 @@ and use cases to add. Feel free to chip in with comments! --[[Joey]]
* Month 3 "easy setup": [[!traillink configurators]] [[!traillink pairing]]
* Month 4 "cloud": [[!traillink cloud]] [[!traillink transfer_control]]
* Month 5 "cloud continued": [[!traillink xmpp]] [[!traillink more_cloud_providers]]
+* Month 6 "9k bonus round": [[!traillink desymlink]]
We are, approximately, here:
-* Month 6 "9k bonus round": [[!traillink desymlink]]
* Month 7: user-driven features and polishing;
[presentation at LCA2013](https://lca2013.linux.org.au/schedule/30059/view_talk)
* Month 8: [[!traillink Android]]
diff --git a/doc/direct_mode.mdwn b/doc/direct_mode.mdwn
index 862a843cf..997b547e4 100644
--- a/doc/direct_mode.mdwn
+++ b/doc/direct_mode.mdwn
@@ -1,13 +1,14 @@
Normally, git-annex repositories consist of symlinks that are checked into
git, and in turn point at the content of large files that is stored in
-`.git/annex/objects/`. Direct mode is an experimental mode that gets rid of
-the symlinks.
+`.git/annex/objects/`. Direct mode gets rid of the symlinks.
The advantage of direct mode is that you can access files directly,
including modifying them. The disadvantage is that most regular git
commands cannot safely be used, and only a subset of git-annex commands
can be used.
+Repositories created by the [[assistant]] use direct mode by default.
+
## enabling (and disabling) direct mode
Any repository can be converted to use direct mode at any time, and if you
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-09 16:26:17 +0000