e213ef310f
* 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
69 lines
2 KiB
Haskell
69 lines
2 KiB
Haskell
{- git-annex extra config files
|
|
-
|
|
- Copyright 2012 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Config.Files where
|
|
|
|
import Common
|
|
import Utility.Tmp
|
|
import Utility.FreeDesktop
|
|
|
|
{- ~/.config/git-annex/file -}
|
|
userConfigFile :: FilePath -> IO FilePath
|
|
userConfigFile file = do
|
|
dir <- userConfigDir
|
|
return $ dir </> "git-annex" </> file
|
|
|
|
autoStartFile :: IO FilePath
|
|
autoStartFile = userConfigFile "autostart"
|
|
|
|
{- Returns anything listed in the autostart file (which may not exist). -}
|
|
readAutoStartFile :: IO [FilePath]
|
|
readAutoStartFile = do
|
|
f <- autoStartFile
|
|
nub . map dropTrailingPathSeparator . lines
|
|
<$> catchDefaultIO "" (readFile f)
|
|
|
|
modifyAutoStartFile :: ([FilePath] -> [FilePath]) -> IO ()
|
|
modifyAutoStartFile func = do
|
|
dirs <- readAutoStartFile
|
|
let dirs' = nubBy equalFilePath $ func dirs
|
|
when (dirs' /= dirs) $ do
|
|
f <- autoStartFile
|
|
createDirectoryIfMissing True (parentDir f)
|
|
viaTmp writeFile f $ unlines dirs'
|
|
|
|
{- Adds a directory to the autostart file. If the directory is already
|
|
- present, it's moved to the top, so it will be used as the default
|
|
- when opening the webapp. -}
|
|
addAutoStartFile :: FilePath -> IO ()
|
|
addAutoStartFile path = modifyAutoStartFile $ (:) path
|
|
|
|
{- Removes a directory from the autostart file. -}
|
|
removeAutoStartFile :: FilePath -> IO ()
|
|
removeAutoStartFile path = modifyAutoStartFile $
|
|
filter (not . equalFilePath path)
|
|
|
|
{- The path to git-annex is written here; which is useful when cabal
|
|
- has installed it to some awful non-PATH location. -}
|
|
programFile :: IO FilePath
|
|
programFile = userConfigFile "program"
|
|
|
|
{- Returns a command to run for git-annex. -}
|
|
readProgramFile :: IO FilePath
|
|
readProgramFile = do
|
|
programfile <- programFile
|
|
p <- catchDefaultIO cmd $
|
|
fromMaybe cmd . headMaybe . lines <$> readFile programfile
|
|
ifM (inPath p)
|
|
( return p
|
|
, ifM (inPath cmd)
|
|
( return cmd
|
|
, error $ "cannot find git-annex program in PATH or in the location listed in " ++ programfile
|
|
)
|
|
)
|
|
where
|
|
cmd = "git-annex"
|