rationalize getConfig
getConfig got a remote-specific config, and this confusing name caused it to be used a couple of places that only were interested in global configs. Rename to getRemoteConfig and make getConfig only get global configs. There are no behavior changes here, but remote.<name>.annex-web-options never actually worked (and per-remote web options is a very unlikely to be useful case so I didn't make it work), so fix the documentation for it.
This commit is contained in:
parent
52b90e5d4c
commit
4eb5112681
11 changed files with 38 additions and 37 deletions
|
@ -313,8 +313,7 @@ saveState oneshot = do
|
||||||
{- Downloads content from any of a list of urls. -}
|
{- Downloads content from any of a list of urls. -}
|
||||||
downloadUrl :: [Url.URLString] -> FilePath -> Annex Bool
|
downloadUrl :: [Url.URLString] -> FilePath -> Annex Bool
|
||||||
downloadUrl urls file = do
|
downloadUrl urls file = do
|
||||||
g <- gitRepo
|
o <- map Param . words <$> getConfig "annex.web-options" ""
|
||||||
o <- map Param . words <$> getConfig g "web-options" ""
|
|
||||||
liftIO $ anyM (\u -> Url.download u o file) urls
|
liftIO $ anyM (\u -> Url.download u o file) urls
|
||||||
|
|
||||||
{- Copies a key's content, when present, to a temp file.
|
{- Copies a key's content, when present, to a temp file.
|
||||||
|
|
|
@ -172,14 +172,13 @@ bloom_info = stat "bloom filter size" $ json id $ do
|
||||||
return $ size ++ note
|
return $ size ++ note
|
||||||
|
|
||||||
disk_size :: Stat
|
disk_size :: Stat
|
||||||
disk_size = stat "available local disk space" $ json id $ lift go
|
disk_size = stat "available local disk space" $ json id $ lift $
|
||||||
where
|
if Build.SysConfig.statfs_sanity_checked == Just True
|
||||||
go
|
then calcfree
|
||||||
| Build.SysConfig.statfs_sanity_checked == Just True =
|
|
||||||
calcfree
|
|
||||||
<$> getDiskReserve False
|
<$> getDiskReserve False
|
||||||
<*> inRepo (getFileSystemStats . gitAnnexDir)
|
<*> inRepo (getFileSystemStats . gitAnnexDir)
|
||||||
| otherwise = return unknown
|
else return unknown
|
||||||
|
where
|
||||||
calcfree reserve (Just (FileSystemStats { fsStatBytesAvailable = have })) =
|
calcfree reserve (Just (FileSystemStats { fsStatBytesAvailable = have })) =
|
||||||
roughSize storageUnits True $ nonneg $ have - reserve
|
roughSize storageUnits True $ nonneg $ have - reserve
|
||||||
calcfree _ _ = unknown
|
calcfree _ _ = unknown
|
||||||
|
|
20
Config.hs
20
Config.hs
|
@ -25,11 +25,15 @@ setConfig k value = do
|
||||||
newg <- inRepo Git.Config.read
|
newg <- inRepo Git.Config.read
|
||||||
Annex.changeState $ \s -> s { Annex.repo = newg }
|
Annex.changeState $ \s -> s { Annex.repo = newg }
|
||||||
|
|
||||||
|
{- Looks up a git config setting in git config. -}
|
||||||
|
getConfig :: ConfigKey -> String -> Annex String
|
||||||
|
getConfig key def = fromRepo $ Git.Config.get key def
|
||||||
|
|
||||||
{- Looks up a per-remote config setting in git config.
|
{- Looks up a per-remote config setting in git config.
|
||||||
- Failing that, tries looking for a global config option. -}
|
- Failing that, tries looking for a global config option. -}
|
||||||
getConfig :: Git.Repo -> ConfigKey -> String -> Annex String
|
getRemoteConfig :: Git.Repo -> ConfigKey -> String -> Annex String
|
||||||
getConfig r key def = do
|
getRemoteConfig r key def = do
|
||||||
def' <- fromRepo $ Git.Config.get ("annex." ++ key) def
|
def' <- getConfig key def
|
||||||
fromRepo $ Git.Config.get (remoteConfig r key) def'
|
fromRepo $ Git.Config.get (remoteConfig r key) def'
|
||||||
|
|
||||||
{- A per-remote config setting in git config. -}
|
{- A per-remote config setting in git config. -}
|
||||||
|
@ -41,11 +45,11 @@ remoteConfig r key = "remote." ++ fromMaybe "" (Git.remoteName r) ++ ".annex-" +
|
||||||
- is set and prints a number, that is used. -}
|
- is set and prints a number, that is used. -}
|
||||||
remoteCost :: Git.Repo -> Int -> Annex Int
|
remoteCost :: Git.Repo -> Int -> Annex Int
|
||||||
remoteCost r def = do
|
remoteCost r def = do
|
||||||
cmd <- getConfig r "cost-command" ""
|
cmd <- getRemoteConfig r "cost-command" ""
|
||||||
(fromMaybe def . readish) <$>
|
(fromMaybe def . readish) <$>
|
||||||
if not $ null cmd
|
if not $ null cmd
|
||||||
then liftIO $ snd <$> pipeFrom "sh" ["-c", cmd]
|
then liftIO $ snd <$> pipeFrom "sh" ["-c", cmd]
|
||||||
else getConfig r "cost" ""
|
else getRemoteConfig r "cost" ""
|
||||||
|
|
||||||
cheapRemoteCost :: Int
|
cheapRemoteCost :: Int
|
||||||
cheapRemoteCost = 100
|
cheapRemoteCost = 100
|
||||||
|
@ -71,7 +75,8 @@ prop_cost_sane = False `notElem`
|
||||||
|
|
||||||
{- Checks if a repo should be ignored. -}
|
{- Checks if a repo should be ignored. -}
|
||||||
repoNotIgnored :: Git.Repo -> Annex Bool
|
repoNotIgnored :: Git.Repo -> Annex Bool
|
||||||
repoNotIgnored r = not . fromMaybe False . Git.configTrue <$> getConfig r "ignore" ""
|
repoNotIgnored r = not . fromMaybe False . Git.configTrue
|
||||||
|
<$> getRemoteConfig r "ignore" ""
|
||||||
|
|
||||||
{- If a value is specified, it is used; otherwise the default is looked up
|
{- If a value is specified, it is used; otherwise the default is looked up
|
||||||
- in git config. forcenumcopies overrides everything. -}
|
- in git config. forcenumcopies overrides everything. -}
|
||||||
|
@ -91,8 +96,7 @@ getTrustLevel r = fromRepo $ Git.Config.getMaybe $ remoteConfig r "trustlevel"
|
||||||
{- Gets annex.diskreserve setting. -}
|
{- Gets annex.diskreserve setting. -}
|
||||||
getDiskReserve :: Bool -> Annex Integer
|
getDiskReserve :: Bool -> Annex Integer
|
||||||
getDiskReserve sanitycheck = do
|
getDiskReserve sanitycheck = do
|
||||||
g <- gitRepo
|
r <- getConfig "diskreserve" ""
|
||||||
r <- getConfig g "diskreserve" ""
|
|
||||||
when sanitycheck $ check r
|
when sanitycheck $ check r
|
||||||
return $ fromMaybe megabyte $ readSize dataUnits r
|
return $ fromMaybe megabyte $ readSize dataUnits r
|
||||||
where
|
where
|
||||||
|
|
|
@ -35,7 +35,7 @@ remote = RemoteType {
|
||||||
|
|
||||||
gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote
|
gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote
|
||||||
gen r u c = do
|
gen r u c = do
|
||||||
buprepo <- getConfig r "buprepo" (error "missing buprepo")
|
buprepo <- getRemoteConfig r "buprepo" (error "missing buprepo")
|
||||||
cst <- remoteCost r (if bupLocal buprepo then semiCheapRemoteCost else expensiveRemoteCost)
|
cst <- remoteCost r (if bupLocal buprepo then semiCheapRemoteCost else expensiveRemoteCost)
|
||||||
bupr <- liftIO $ bup2GitRemote buprepo
|
bupr <- liftIO $ bup2GitRemote buprepo
|
||||||
(u', bupr') <- getBupUUID bupr u
|
(u', bupr') <- getBupUUID bupr u
|
||||||
|
@ -99,7 +99,7 @@ pipeBup params inh outh = do
|
||||||
|
|
||||||
bupSplitParams :: Git.Repo -> BupRepo -> Key -> CommandParam -> Annex [CommandParam]
|
bupSplitParams :: Git.Repo -> BupRepo -> Key -> CommandParam -> Annex [CommandParam]
|
||||||
bupSplitParams r buprepo k src = do
|
bupSplitParams r buprepo k src = do
|
||||||
o <- getConfig r "bup-split-options" ""
|
o <- getRemoteConfig r "bup-split-options" ""
|
||||||
let os = map Param $ words o
|
let os = map Param $ words o
|
||||||
showOutput -- make way for bup output
|
showOutput -- make way for bup output
|
||||||
return $ bupParams "split" buprepo
|
return $ bupParams "split" buprepo
|
||||||
|
|
|
@ -33,7 +33,7 @@ remote = RemoteType {
|
||||||
|
|
||||||
gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote
|
gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote
|
||||||
gen r u c = do
|
gen r u c = do
|
||||||
dir <- getConfig r "directory" (error "missing directory")
|
dir <- getRemoteConfig r "directory" (error "missing directory")
|
||||||
cst <- remoteCost r cheapRemoteCost
|
cst <- remoteCost r cheapRemoteCost
|
||||||
let chunksize = chunkSize c
|
let chunksize = chunkSize c
|
||||||
return $ encryptableRemote c
|
return $ encryptableRemote c
|
||||||
|
|
|
@ -300,7 +300,7 @@ rsyncParamsRemote r sending key file = do
|
||||||
|
|
||||||
rsyncParams :: Git.Repo -> Annex [CommandParam]
|
rsyncParams :: Git.Repo -> Annex [CommandParam]
|
||||||
rsyncParams r = do
|
rsyncParams r = do
|
||||||
o <- getConfig r "rsync-options" ""
|
o <- getRemoteConfig r "rsync-options" ""
|
||||||
return $ options ++ map Param (words o)
|
return $ options ++ map Param (words o)
|
||||||
where
|
where
|
||||||
-- --inplace to resume partial files
|
-- --inplace to resume partial files
|
||||||
|
|
|
@ -84,7 +84,7 @@ runHooks r starthook stophook a = do
|
||||||
liftIO $ closeFd fd
|
liftIO $ closeFd fd
|
||||||
|
|
||||||
lookupHook :: Remote -> String -> Annex (Maybe String)
|
lookupHook :: Remote -> String -> Annex (Maybe String)
|
||||||
lookupHook r n = go =<< getConfig (repo r) hookname ""
|
lookupHook r n = go =<< getRemoteConfig (repo r) hookname ""
|
||||||
where
|
where
|
||||||
go "" = return Nothing
|
go "" = return Nothing
|
||||||
go command = return $ Just command
|
go command = return $ Just command
|
||||||
|
|
|
@ -19,7 +19,7 @@ import Annex.Ssh
|
||||||
- passed command. -}
|
- passed command. -}
|
||||||
sshToRepo :: Git.Repo -> [CommandParam] -> Annex [CommandParam]
|
sshToRepo :: Git.Repo -> [CommandParam] -> Annex [CommandParam]
|
||||||
sshToRepo repo sshcmd = do
|
sshToRepo repo sshcmd = do
|
||||||
opts <- map Param . words <$> getConfig repo "ssh-options" ""
|
opts <- map Param . words <$> getRemoteConfig repo "ssh-options" ""
|
||||||
params <- sshParams (Git.Url.hostuser repo, Git.Url.port repo) opts
|
params <- sshParams (Git.Url.hostuser repo, Git.Url.port repo) opts
|
||||||
return $ params ++ sshcmd
|
return $ params ++ sshcmd
|
||||||
|
|
||||||
|
|
|
@ -30,7 +30,7 @@ remote = RemoteType {
|
||||||
|
|
||||||
gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote
|
gen :: Git.Repo -> UUID -> Maybe RemoteConfig -> Annex Remote
|
||||||
gen r u c = do
|
gen r u c = do
|
||||||
hooktype <- getConfig r "hooktype" (error "missing hooktype")
|
hooktype <- getRemoteConfig r "hooktype" (error "missing hooktype")
|
||||||
cst <- remoteCost r expensiveRemoteCost
|
cst <- remoteCost r expensiveRemoteCost
|
||||||
return $ encryptableRemote c
|
return $ encryptableRemote c
|
||||||
(storeEncrypted hooktype)
|
(storeEncrypted hooktype)
|
||||||
|
@ -74,15 +74,14 @@ hookEnv k f = Just $ fileenv f ++ keyenv
|
||||||
|
|
||||||
lookupHook :: String -> String -> Annex (Maybe String)
|
lookupHook :: String -> String -> Annex (Maybe String)
|
||||||
lookupHook hooktype hook =do
|
lookupHook hooktype hook =do
|
||||||
g <- gitRepo
|
command <- getConfig hookname ""
|
||||||
command <- getConfig g hookname ""
|
|
||||||
if null command
|
if null command
|
||||||
then do
|
then do
|
||||||
warning $ "missing configuration for " ++ hookname
|
warning $ "missing configuration for " ++ hookname
|
||||||
return Nothing
|
return Nothing
|
||||||
else return $ Just command
|
else return $ Just command
|
||||||
where
|
where
|
||||||
hookname = hooktype ++ "-" ++ hook ++ "-hook"
|
hookname = "annex." ++ hooktype ++ "-" ++ hook ++ "-hook"
|
||||||
|
|
||||||
runHook :: String -> String -> Key -> Maybe FilePath -> Annex Bool -> Annex Bool
|
runHook :: String -> String -> Key -> Maybe FilePath -> Annex Bool -> Annex Bool
|
||||||
runHook hooktype hook k f a = maybe (return False) run =<< lookupHook hooktype hook
|
runHook hooktype hook k f a = maybe (return False) run =<< lookupHook hooktype hook
|
||||||
|
|
|
@ -60,8 +60,8 @@ gen r u c = do
|
||||||
|
|
||||||
genRsyncOpts :: Git.Repo -> Annex RsyncOpts
|
genRsyncOpts :: Git.Repo -> Annex RsyncOpts
|
||||||
genRsyncOpts r = do
|
genRsyncOpts r = do
|
||||||
url <- getConfig r "rsyncurl" (error "missing rsyncurl")
|
url <- getRemoteConfig r "rsyncurl" (error "missing rsyncurl")
|
||||||
opts <- getConfig r "rsync-options" ""
|
opts <- getRemoteConfig r "rsync-options" ""
|
||||||
return $ RsyncOpts url $ map Param $ filter safe $ words opts
|
return $ RsyncOpts url $ map Param $ filter safe $ words opts
|
||||||
where
|
where
|
||||||
safe o
|
safe o
|
||||||
|
|
|
@ -696,26 +696,26 @@ Here are all the supported configuration settings.
|
||||||
to or from this remote. For example, to force ipv6, and limit
|
to or from this remote. For example, to force ipv6, and limit
|
||||||
the bandwidth to 100Kbyte/s, set it to "-6 --bwlimit 100"
|
the bandwidth to 100Kbyte/s, set it to "-6 --bwlimit 100"
|
||||||
|
|
||||||
* `remote.<name>.annex-web-options`
|
|
||||||
|
|
||||||
Options to use when using wget or curl to download a file from the web.
|
|
||||||
(wget is always used in preference to curl if available).
|
|
||||||
For example, to force ipv4 only, set it to "-4"
|
|
||||||
|
|
||||||
* `remote.<name>.annex-bup-split-options`
|
* `remote.<name>.annex-bup-split-options`
|
||||||
|
|
||||||
Options to pass to bup split when storing content in this remote.
|
Options to pass to bup split when storing content in this remote.
|
||||||
For example, to limit the bandwidth to 100Kbye/s, set it to "--bwlimit 100k"
|
For example, to limit the bandwidth to 100Kbye/s, set it to "--bwlimit 100k"
|
||||||
(There is no corresponding option for bup join.)
|
(There is no corresponding option for bup join.)
|
||||||
|
|
||||||
* `annex.ssh-options`, `annex.rsync-options`, `annex.web-options, `annex.bup-split-options`
|
* `annex.ssh-options`, `annex.rsync-options`, `annex.bup-split-options`
|
||||||
|
|
||||||
Default ssh, rsync, wget/curl, and bup options to use if a remote does not
|
Default ssh, rsync, wget/curl, and bup options to use if a remote does not
|
||||||
have specific options.
|
have specific options.
|
||||||
|
|
||||||
|
* `annex.web-options`
|
||||||
|
|
||||||
|
Options to use when using wget or curl to download a file from the web.
|
||||||
|
(wget is always used in preference to curl if available).
|
||||||
|
For example, to force ipv4 only, set it to "-4"
|
||||||
|
|
||||||
* `remote.<name>.rsyncurl`
|
* `remote.<name>.rsyncurl`
|
||||||
|
|
||||||
Used by rsunc special remotes, this configures
|
Used by rsync special remotes, this configures
|
||||||
the location of the rsync repository to use. Normally this is automaticaly
|
the location of the rsync repository to use. Normally this is automaticaly
|
||||||
set up by `git annex initremote`, but you can change it if needed.
|
set up by `git annex initremote`, but you can change it if needed.
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue