766c31c95c
Not yet wired up to restart the assistant on upgrade; that needs careful sanity checking to wait until the upgrade is done before restarting. Used the DirWatcher here, so it gets events for any changes to the directory containing the program file. (But not subdirs.) This is necessary in order to detect when the file is renamed as part of the upgrade, which an inotify on a single file would not detect. (Also, I have DirWatcher code, but not FileWatcher code.) Note that upgrades that remove or rename a whole directory tree containing the executable will *not* trigger this code. So eg, deleting and replacing the whole standalone tarball dir tree won't work -- but untarring it over top will. So should dpkg package upgrades. Added programPath, using a new GHC feature to find the full path to the executable. The fallback code for old GHC or unsupported OS is less good; its worst failure mode would be either failing to find the program, and so not checking for upgrades, or finding a git-annex that's in PATH, but is not the one running. This commit was sponsored by John Roepke.
92 lines
2.6 KiB
Haskell
92 lines
2.6 KiB
Haskell
{- git-annex extra config files
|
|
-
|
|
- Copyright 2012 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE CPP #-}
|
|
|
|
module Config.Files where
|
|
|
|
import Common
|
|
import Utility.Tmp
|
|
import Utility.FreeDesktop
|
|
import System.Environment
|
|
|
|
{- ~/.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"
|
|
|
|
{- A fully qualified path to the currently running git-annex program.
|
|
-
|
|
- getExecutablePath is available since ghc 7.4.2. On OSs it supports
|
|
- well, it returns the complete path to the program. But, on other OSs,
|
|
- it might return just the basename.
|
|
-}
|
|
programPath :: IO (Maybe FilePath)
|
|
programPath = do
|
|
#if MIN_VERSION_base(4,6,0)
|
|
exe <- getExecutablePath
|
|
p <- if isAbsolute exe
|
|
then return exe
|
|
else readProgramFile
|
|
#else
|
|
p <- readProgramFile
|
|
#endif
|
|
-- In case readProgramFile returned just the command name,
|
|
-- fall back to finding it in PATH.
|
|
searchPath p
|