git-annex/Config.hs
Joey Hess e213ef310f git-annex (5.20140717) unstable; urgency=high
* Fix minor FD leak in journal code. Closes: #754608
  * direct: Fix handling of case where a work tree subdirectory cannot
    be written to due to permissions.
  * migrate: Avoid re-checksumming when migrating from hashE to hash backend.
  * uninit: Avoid failing final removal in some direct mode repositories
    due to file modes.
  * S3: Deal with AWS ACL configurations that do not allow creating or
    checking the location of a bucket, but only reading and writing content to
    it.
  * resolvemerge: New plumbing command that runs the automatic merge conflict
    resolver.
  * Deal with change in git 2.0 that made indirect mode merge conflict
    resolution leave behind old files.
  * sync: Fix git sync with local git remotes even when they don't have an
    annex.uuid set. (The assistant already did so.)
  * Set gcrypt-publish-participants when setting up a gcrypt repository,
    to avoid unncessary passphrase prompts.
    This is a security/usability tradeoff. To avoid exposing the gpg key
    ids who can decrypt the repository, users can unset
    gcrypt-publish-participants.
  * Install nautilus hooks even when ~/.local/share/nautilus/ does not yet
    exist, since it is not automatically created for Gnome 3 users.
  * Windows: Move .vbs files out of git\bin, to avoid that being in the
    PATH, which caused some weird breakage. (Thanks, divB)
  * Windows: Fix locking issue that prevented the webapp starting
    (since 5.20140707).

# imported from the archive
2014-07-17 11:27:25 -04:00

84 lines
2.8 KiB
Haskell

{- Git configuration
-
- Copyright 2011-2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Config where
import Common.Annex
import qualified Git
import qualified Git.Config
import qualified Git.Command
import qualified Annex
import Config.Cost
import Types.Availability
type UnqualifiedConfigKey = String
data ConfigKey = ConfigKey String
instance Show ConfigKey where
show (ConfigKey s) = s
{- Looks up a setting in git config. -}
getConfig :: ConfigKey -> String -> Annex String
getConfig (ConfigKey key) def = fromRepo $ Git.Config.get key def
getConfigMaybe :: ConfigKey -> Annex (Maybe String)
getConfigMaybe (ConfigKey key) = fromRepo $ Git.Config.getMaybe key
{- Changes a git config setting in both internal state and .git/config -}
setConfig :: ConfigKey -> String -> Annex ()
setConfig (ConfigKey key) value = do
inRepo $ Git.Command.run [Param "config", Param key, Param value]
reloadConfig
reloadConfig :: Annex ()
reloadConfig = Annex.changeGitRepo =<< inRepo Git.Config.reRead
{- Unsets a git config setting. (Leaves it in state currently.) -}
unsetConfig :: ConfigKey -> Annex ()
unsetConfig ck@(ConfigKey key) = ifM (isJust <$> getConfigMaybe ck)
( inRepo $ Git.Command.run
[Param "config", Param "--unset", Param key]
, noop -- avoid unsetting something not set; that would fail
)
{- A per-remote config setting in git config. -}
remoteConfig :: Git.Repo -> UnqualifiedConfigKey -> ConfigKey
remoteConfig r key = ConfigKey $
"remote." ++ fromMaybe "" (Git.remoteName r) ++ ".annex-" ++ key
{- A global annex setting in git config. -}
annexConfig :: UnqualifiedConfigKey -> ConfigKey
annexConfig key = ConfigKey $ "annex." ++ key
{- 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 :: RemoteGitConfig -> Cost -> Annex Cost
remoteCost c def = fromMaybe def <$> remoteCost' c
remoteCost' :: RemoteGitConfig -> Annex (Maybe Cost)
remoteCost' c = case remoteAnnexCostCommand c of
Just cmd | not (null cmd) -> liftIO $
readish <$> readProcess "sh" ["-c", cmd]
_ -> return $ remoteAnnexCost c
setRemoteCost :: Git.Repo -> Cost -> Annex ()
setRemoteCost r c = setConfig (remoteConfig r "cost") (show c)
setRemoteAvailability :: Git.Repo -> Availability -> Annex ()
setRemoteAvailability r c = setConfig (remoteConfig r "availability") (show c)
isDirect :: Annex Bool
isDirect = annexDirect <$> Annex.getGitConfig
crippledFileSystem :: Annex Bool
crippledFileSystem = annexCrippledFileSystem <$> Annex.getGitConfig
setCrippledFileSystem :: Bool -> Annex ()
setCrippledFileSystem b = do
setConfig (annexConfig "crippledfilesystem") (Git.Config.boolConfig b)
Annex.changeGitConfig $ \c -> c { annexCrippledFileSystem = b }