diff --git a/Assistant/Install/Menu.hs b/Assistant/Install/Menu.hs index 076991c216..2faa4a655e 100644 --- a/Assistant/Install/Menu.hs +++ b/Assistant/Install/Menu.hs @@ -39,7 +39,7 @@ fdoDesktopMenu command = genDesktopEntry installIcon :: FilePath -> FilePath -> IO () installIcon src dest = do - createDirectoryIfMissing True (parentDir dest) + createDirectoryIfMissing True (fromRawFilePath (parentDir (toRawFilePath dest))) withBinaryFile src ReadMode $ \hin -> withBinaryFile dest WriteMode $ \hout -> hGetContents hin >>= hPutStr hout diff --git a/Build/DesktopFile.hs b/Build/DesktopFile.hs index 14efb24df8..a4c4944ade 100644 --- a/Build/DesktopFile.hs +++ b/Build/DesktopFile.hs @@ -16,6 +16,7 @@ import Utility.FreeDesktop import Utility.Path import Utility.Monad import Utility.Directory +import Utility.FileSystemEncoding import Config.Files import Utility.OSX import Assistant.Install.AutoStart @@ -77,7 +78,7 @@ install command = do ( return () , do programfile <- inDestDir =<< programFile - createDirectoryIfMissing True (parentDir programfile) + createDirectoryIfMissing True (fromRawFilePath (parentDir (toRawFilePath programfile))) writeFile programfile command ) diff --git a/Config/Files.hs b/Config/Files.hs index 17ebd6f857..089c851932 100644 --- a/Config/Files.hs +++ b/Config/Files.hs @@ -22,40 +22,6 @@ userConfigFile file = do autoStartFile :: IO FilePath autoStartFile = userConfigFile "autostart" -{- Returns anything listed in the autostart file (which may not exist). -} -readAutoStartFile :: IO [FilePath] -readAutoStartFile = do - f <- autoStartFile - filter valid . nub . map dropTrailingPathSeparator . lines - <$> catchDefaultIO "" (readFile f) - where - -- Ignore any relative paths; some old buggy versions added eg "." - valid = isAbsolute - -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 = do - path' <- absPath path - modifyAutoStartFile $ (:) path' - -{- Removes a directory from the autostart file. -} -removeAutoStartFile :: FilePath -> IO () -removeAutoStartFile path = do - path' <- absPath path - modifyAutoStartFile $ - filter (not . equalFilePath path') - {- The path to git-annex is written here; which is useful when something - has installed it to some awful non-PATH location. -} programFile :: IO FilePath diff --git a/Config/Files/AutoStart.hs b/Config/Files/AutoStart.hs new file mode 100644 index 0000000000..dfcf308358 --- /dev/null +++ b/Config/Files/AutoStart.hs @@ -0,0 +1,50 @@ +{- git-annex autostart file + - + - Copyright 2012-2019 Joey Hess + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +{-# OPTIONS_GHC -fno-warn-tabs #-} + +module Config.Files.AutoStart where + +import Common +import Config.Files +import Utility.Tmp +import Utility.FreeDesktop +import Utility.Directory.AbsRel + +{- Returns anything listed in the autostart file (which may not exist). -} +readAutoStartFile :: IO [FilePath] +readAutoStartFile = do + f <- autoStartFile + filter valid . nub . map dropTrailingPathSeparator . lines + <$> catchDefaultIO "" (readFile f) + where + -- Ignore any relative paths; some old buggy versions added eg "." + valid = isAbsolute + +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 = do + path' <- absPath path + modifyAutoStartFile $ (:) path' + +{- Removes a directory from the autostart file. -} +removeAutoStartFile :: FilePath -> IO () +removeAutoStartFile path = do + path' <- absPath path + modifyAutoStartFile $ + filter (not . equalFilePath path') diff --git a/Test.hs b/Test.hs index b9d4a7d130..677303bc59 100644 --- a/Test.hs +++ b/Test.hs @@ -188,8 +188,8 @@ properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck" $ , testProperty "prop_isomorphic_configEscape" Logs.Remote.prop_isomorphic_configEscape , testProperty "prop_parse_show_Config" Logs.Remote.prop_parse_show_Config , testProperty "prop_upFrom_basics" Utility.Path.prop_upFrom_basics - , testProperty "prop_relPathDirToFile_basics" Utility.Path.prop_relPathDirToFile_basics - , testProperty "prop_relPathDirToFile_regressionTest" Utility.Path.prop_relPathDirToFile_regressionTest + , testProperty "prop_relPathDirToFileAbs_basics" Utility.Path.prop_relPathDirToFileAbs_basics + , testProperty "prop_relPathDirToFileAbs_regressionTest" Utility.Path.prop_relPathDirToFileAbs_regressionTest , testProperty "prop_cost_sane" Config.Cost.prop_cost_sane , testProperty "prop_matcher_sane" Utility.Matcher.prop_matcher_sane , testProperty "prop_HmacSha1WithCipher_sane" Crypto.prop_HmacSha1WithCipher_sane diff --git a/Utility/Directory.hs b/Utility/Directory.hs index c8ce2a84a9..aef1aa2798 100644 --- a/Utility/Directory.hs +++ b/Utility/Directory.hs @@ -18,7 +18,6 @@ import Control.Monad import System.FilePath import System.PosixCompat.Files import Control.Applicative -import Control.Monad.IO.Class import Control.Monad.IfElse import System.IO.Unsafe (unsafeInterleaveIO) import System.IO.Error @@ -30,12 +29,10 @@ import Utility.SafeCommand #endif import Utility.SystemDirectory -import Utility.Path import Utility.Tmp import Utility.Exception import Utility.Monad import Utility.Applicative -import Utility.PartialPrelude dirCruft :: FilePath -> Bool dirCruft "." = True @@ -157,74 +154,3 @@ nukeFile file = void $ tryWhenExists go #else go = removeFile file #endif - -{- Like createDirectoryIfMissing True, but it will only create - - missing parent directories up to but not including the directory - - in the first parameter. - - - - For example, createDirectoryUnder "/tmp/foo" "/tmp/foo/bar/baz" - - will create /tmp/foo/bar if necessary, but if /tmp/foo does not exist, - - it will throw an exception. - - - - The exception thrown is the same that createDirectory throws if the - - parent directory does not exist. - - - - If the second FilePath is not under the first - - FilePath (or the same as it), it will fail with an exception - - even if the second FilePath's parent directory already exists. - - - - Either or both of the FilePaths can be relative, or absolute. - - They will be normalized as necessary. - - - - Note that, the second FilePath, if relative, is relative to the current - - working directory, not to the first FilePath. - -} -createDirectoryUnder :: FilePath -> FilePath -> IO () -createDirectoryUnder topdir dir = - createDirectoryUnder' topdir dir createDirectory - -createDirectoryUnder' - :: (MonadIO m, MonadCatch m) - => FilePath - -> FilePath - -> (FilePath -> m ()) - -> m () -createDirectoryUnder' topdir dir0 mkdir = do - p <- liftIO $ relPathDirToFile topdir dir0 - let dirs = splitDirectories p - -- Catch cases where the dir is not beneath the topdir. - -- If the relative path between them starts with "..", - -- it's not. And on Windows, if they are on different drives, - -- the path will not be relative. - if headMaybe dirs == Just ".." || isAbsolute p - then liftIO $ ioError $ customerror userErrorType - ("createDirectoryFrom: not located in " ++ topdir) - -- If dir0 is the same as the topdir, don't try to create - -- it, but make sure it does exist. - else if null dirs - then liftIO $ unlessM (doesDirectoryExist topdir) $ - ioError $ customerror doesNotExistErrorType - "createDirectoryFrom: does not exist" - else createdirs $ - map (topdir ) (reverse (scanl1 () dirs)) - where - customerror t s = mkIOError t s Nothing (Just dir0) - - createdirs [] = pure () - createdirs (dir:[]) = createdir dir (liftIO . ioError) - createdirs (dir:dirs) = createdir dir $ \_ -> do - createdirs dirs - createdir dir (liftIO . ioError) - - -- This is the same method used by createDirectoryIfMissing, - -- in particular the handling of errors that occur when the - -- directory already exists. See its source for explanation - -- of several subtleties. - createdir dir notexisthandler = tryIO (mkdir dir) >>= \case - Right () -> pure () - Left e - | isDoesNotExistError e -> notexisthandler e - | isAlreadyExistsError e || isPermissionError e -> - liftIO $ unlessM (doesDirectoryExist dir) $ - ioError e - | otherwise -> liftIO $ ioError e diff --git a/Utility/Directory/Create.hs b/Utility/Directory/Create.hs new file mode 100644 index 0000000000..ca61cfe179 --- /dev/null +++ b/Utility/Directory/Create.hs @@ -0,0 +1,102 @@ +{- directory creating + - + - Copyright 2011-2020 Joey Hess + - + - License: BSD-2-clause + -} + +{-# LANGUAGE LambdaCase #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} + +module Utility.Directory.Create ( + createDirectoryUnder, + createDirectoryUnder', +) where + +import Control.Monad +import System.FilePath +import Control.Applicative +import Control.Monad.IO.Class +import Control.Monad.IfElse +import System.IO.Error +import Data.Maybe +import Prelude + +import Utility.SystemDirectory +import Utility.Path.AbsRel +import Utility.Exception +import Utility.FileSystemEncoding +import Utility.PartialPrelude + +{- Like createDirectoryIfMissing True, but it will only create + - missing parent directories up to but not including the directory + - in the first parameter. + - + - For example, createDirectoryUnder "/tmp/foo" "/tmp/foo/bar/baz" + - will create /tmp/foo/bar if necessary, but if /tmp/foo does not exist, + - it will throw an exception. + - + - The exception thrown is the same that createDirectory throws if the + - parent directory does not exist. + - + - If the second FilePath is not under the first + - FilePath (or the same as it), it will fail with an exception + - even if the second FilePath's parent directory already exists. + - + - Either or both of the FilePaths can be relative, or absolute. + - They will be normalized as necessary. + - + - Note that, the second FilePath, if relative, is relative to the current + - working directory, not to the first FilePath. + -} +createDirectoryUnder :: FilePath -> FilePath -> IO () +createDirectoryUnder topdir dir = + createDirectoryUnder' topdir dir createDirectory + +createDirectoryUnder' + :: (MonadIO m, MonadCatch m) + => FilePath + -> FilePath + -> (FilePath -> m ()) + -> m () +createDirectoryUnder' topdir dir0 mkdir = do + p <- liftIO $ fromRawFilePath <$> relPathDirToFile + (toRawFilePath topdir) + (toRawFilePath dir0) + let dirs = splitDirectories p + -- Catch cases where the dir is not beneath the topdir. + -- If the relative path between them starts with "..", + -- it's not. And on Windows, if they are on different drives, + -- the path will not be relative. + if headMaybe dirs == Just ".." || isAbsolute p + then liftIO $ ioError $ customerror userErrorType + ("createDirectoryFrom: not located in " ++ topdir) + -- If dir0 is the same as the topdir, don't try to create + -- it, but make sure it does exist. + else if null dirs + then liftIO $ unlessM (doesDirectoryExist topdir) $ + ioError $ customerror doesNotExistErrorType + "createDirectoryFrom: does not exist" + else createdirs $ + map (topdir ) (reverse (scanl1 () dirs)) + where + customerror t s = mkIOError t s Nothing (Just dir0) + + createdirs [] = pure () + createdirs (dir:[]) = createdir dir (liftIO . ioError) + createdirs (dir:dirs) = createdir dir $ \_ -> do + createdirs dirs + createdir dir (liftIO . ioError) + + -- This is the same method used by createDirectoryIfMissing, + -- in particular the handling of errors that occur when the + -- directory already exists. See its source for explanation + -- of several subtleties. + createdir dir notexisthandler = tryIO (mkdir dir) >>= \case + Right () -> pure () + Left e + | isDoesNotExistError e -> notexisthandler e + | isAlreadyExistsError e || isPermissionError e -> + liftIO $ unlessM (doesDirectoryExist dir) $ + ioError e + | otherwise -> liftIO $ ioError e diff --git a/Utility/Path.hs b/Utility/Path.hs index 11e9ab00f3..e301c34660 100644 --- a/Utility/Path.hs +++ b/Utility/Path.hs @@ -11,27 +11,22 @@ module Utility.Path ( simplifyPath, - absPathFrom, parentDir, upFrom, dirContains, - absPath, - relPathCwdToFile, - relPathDirToFile, - relPathDirToFileAbs, segmentPaths, segmentPaths', runSegmentPaths, runSegmentPaths', - relHome, inPath, searchPath, dotfile, splitShortExtensions, + relPathDirToFileAbs, prop_upFrom_basics, - prop_relPathDirToFile_basics, - prop_relPathDirToFile_regressionTest, + prop_relPathDirToFileAbs_basics, + prop_relPathDirToFileAbs_regressionTest, ) where import System.FilePath.ByteString @@ -39,11 +34,6 @@ import qualified System.FilePath as P import qualified Data.ByteString as B import Data.List import Data.Maybe -#ifdef mingw32_HOST_OS -import Data.Char -#else -import System.Posix.Directory.ByteString (getWorkingDirectory) -#endif import Control.Applicative import Prelude @@ -80,19 +70,6 @@ simplifyPath path = dropTrailingPathSeparator $ where p' = dropTrailingPathSeparator p -{- Makes a path absolute. - - - - Also simplifies it using simplifyPath. - - - - The first parameter is a base directory (ie, the cwd) to use if the path - - is not already absolute, and should itsef be absolute. - - - - Does not attempt to deal with edge cases or ensure security with - - untrusted inputs. - -} -absPathFrom :: RawFilePath -> RawFilePath -> RawFilePath -absPathFrom dir path = simplifyPath (combine dir path) - {- takeDirectory "foo/bar/" is "foo/bar". This instead yields "foo" -} parentDir :: RawFilePath -> RawFilePath parentDir = takeDirectory . dropTrailingPathSeparator @@ -132,90 +109,6 @@ dirContains a b = a == b b' = norm b norm = normalise . simplifyPath -{- Converts a filename into an absolute path. - - - - Also simplifies it using simplifyPath. - - - - Unlike Directory.canonicalizePath, this does not require the path - - already exists. -} -absPath :: RawFilePath -> IO RawFilePath -absPath file - -- Avoid unncessarily getting the current directory when the path - -- is already absolute. absPathFrom uses simplifyPath - -- so also used here for consistency. - | isAbsolute file = return $ simplifyPath file - | otherwise = do -#ifdef mingw32_HOST_OS - cwd <- toRawFilePath <$> getCurrentDirectory -#else - cwd <- getWorkingDirectory -#endif - return $ absPathFrom cwd file - -{- Constructs a relative path from the CWD to a file. - - - - For example, assuming CWD is /tmp/foo/bar: - - relPathCwdToFile "/tmp/foo" == ".." - - relPathCwdToFile "/tmp/foo/bar" == "" - -} -relPathCwdToFile :: RawFilePath -> IO RawFilePath -relPathCwdToFile f = do -#ifdef mingw32_HOST_OS - c <- toRawFilePath <$> getCurrentDirectory -#else - c <- getWorkingDirectory -#endif - relPathDirToFile c f - -{- Constructs a relative path from a directory to a file. -} -relPathDirToFile :: RawFilePath -> RawFilePath -> IO RawFilePath -relPathDirToFile from to = relPathDirToFileAbs <$> absPath from <*> absPath to - -{- This requires the first path to be absolute, and the - - second path cannot contain ../ or ./ - - - - On Windows, if the paths are on different drives, - - a relative path is not possible and the path is simply - - returned as-is. - -} -relPathDirToFileAbs :: RawFilePath -> RawFilePath -> RawFilePath -relPathDirToFileAbs from to -#ifdef mingw32_HOST_OS - | normdrive from /= normdrive to = to -#endif - | otherwise = joinPath $ dotdots ++ uncommon - where - pfrom = sp from - pto = sp to - sp = map dropTrailingPathSeparator . splitPath . dropDrive - common = map fst $ takeWhile same $ zip pfrom pto - same (c,d) = c == d - uncommon = drop numcommon pto - dotdots = replicate (length pfrom - numcommon) ".." - numcommon = length common -#ifdef mingw32_HOST_OS - normdrive = map toLower . takeWhile (/= ':') . fromRawFilePath . takeDrive -#endif - -prop_relPathDirToFile_basics :: RawFilePath -> RawFilePath -> Bool -prop_relPathDirToFile_basics from to - | B.null from || B.null to = True - | from == to = B.null r - | otherwise = not (B.null r) - where - r = relPathDirToFileAbs from to - -prop_relPathDirToFile_regressionTest :: Bool -prop_relPathDirToFile_regressionTest = same_dir_shortcurcuits_at_difference - where - {- Two paths have the same directory component at the same - - location, but it's not really the same directory. - - Code used to get this wrong. -} - same_dir_shortcurcuits_at_difference = - relPathDirToFileAbs (joinPath [pathSeparator `B.cons` "tmp", "r", "lll", "xxx", "yyy", "18"]) - (joinPath [pathSeparator `B.cons` "tmp", "r", ".git", "annex", "objects", "18", "gk", "SHA256-foo", "SHA256-foo"]) - == joinPath ["..", "..", "..", "..", ".git", "annex", "objects", "18", "gk", "SHA256-foo", "SHA256-foo"] - {- Given an original list of paths, and an expanded list derived from it, - which may be arbitrarily reordered, generates a list of lists, where - each sublist corresponds to one of the original paths. @@ -253,15 +146,6 @@ runSegmentPaths c a paths = segmentPaths c paths <$> a paths runSegmentPaths' :: (Maybe RawFilePath -> a -> r) -> (a -> RawFilePath) -> ([RawFilePath] -> IO [a]) -> [RawFilePath] -> IO [[r]] runSegmentPaths' si c a paths = segmentPaths' si c paths <$> a paths -{- Converts paths in the home directory to use ~/ -} -relHome :: FilePath -> IO String -relHome path = do - let path' = toRawFilePath path - home <- toRawFilePath <$> myHomeDir - return $ if dirContains home path' - then fromRawFilePath ("~/" <> relPathDirToFileAbs home path') - else path - {- Checks if a command is available in PATH. - - The command may be fully-qualified, in which case, this succeeds as @@ -314,3 +198,48 @@ splitShortExtensions' maxextension = go [] where (base, ext) = splitExtension f len = B.length ext + +{- This requires the first path to be absolute, and the + - second path cannot contain ../ or ./ + - + - On Windows, if the paths are on different drives, + - a relative path is not possible and the path is simply + - returned as-is. + -} +relPathDirToFileAbs :: RawFilePath -> RawFilePath -> RawFilePath +relPathDirToFileAbs from to +#ifdef mingw32_HOST_OS + | normdrive from /= normdrive to = to +#endif + | otherwise = joinPath $ dotdots ++ uncommon + where + pfrom = sp from + pto = sp to + sp = map dropTrailingPathSeparator . splitPath . dropDrive + common = map fst $ takeWhile same $ zip pfrom pto + same (c,d) = c == d + uncommon = drop numcommon pto + dotdots = replicate (length pfrom - numcommon) ".." + numcommon = length common +#ifdef mingw32_HOST_OS + normdrive = map toLower . takeWhile (/= ':') . fromRawFilePath . takeDrive +#endif + +prop_relPathDirToFileAbs_basics :: RawFilePath -> RawFilePath -> Bool +prop_relPathDirToFileAbs_basics from to + | B.null from || B.null to = True + | from == to = B.null r + | otherwise = not (B.null r) + where + r = relPathDirToFileAbs from to + +prop_relPathDirToFileAbs_regressionTest :: Bool +prop_relPathDirToFileAbs_regressionTest = same_dir_shortcurcuits_at_difference + where + {- Two paths have the same directory component at the same + - location, but it's not really the same directory. + - Code used to get this wrong. -} + same_dir_shortcurcuits_at_difference = + relPathDirToFileAbs (joinPath [pathSeparator `B.cons` "tmp", "r", "lll", "xxx", "yyy", "18"]) + (joinPath [pathSeparator `B.cons` "tmp", "r", ".git", "annex", "objects", "18", "gk", "SHA256-foo", "SHA256-foo"]) + == joinPath ["..", "..", "..", "..", ".git", "annex", "objects", "18", "gk", "SHA256-foo", "SHA256-foo"] diff --git a/Utility/Path/AbsRel.hs b/Utility/Path/AbsRel.hs new file mode 100644 index 0000000000..0026bd6a19 --- /dev/null +++ b/Utility/Path/AbsRel.hs @@ -0,0 +1,93 @@ +{- absolute and relative path manipulation + - + - Copyright 2010-2020 Joey Hess + - + - License: BSD-2-clause + -} + +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-tabs #-} + +module Utility.Path.AbsRel ( + absPathFrom, + absPath, + relPathCwdToFile, + relPathDirToFile, + relPathDirToFileAbs, + relHome, +) where + +import System.FilePath.ByteString +#ifdef mingw32_HOST_OS +import System.Directory (getCurrentDirectory) +#else +import System.Posix.Directory.ByteString (getWorkingDirectory) +#endif +import Control.Applicative +import Prelude + +import Utility.Path +import Utility.UserInfo +import Utility.FileSystemEncoding + +{- Makes a path absolute. + - + - Also simplifies it using simplifyPath. + - + - The first parameter is a base directory (ie, the cwd) to use if the path + - is not already absolute, and should itsef be absolute. + - + - Does not attempt to deal with edge cases or ensure security with + - untrusted inputs. + -} +absPathFrom :: RawFilePath -> RawFilePath -> RawFilePath +absPathFrom dir path = simplifyPath (combine dir path) + +{- Converts a filename into an absolute path. + - + - Also simplifies it using simplifyPath. + - + - Unlike Directory.canonicalizePath, this does not require the path + - already exists. -} +absPath :: RawFilePath -> IO RawFilePath +absPath file + -- Avoid unncessarily getting the current directory when the path + -- is already absolute. absPathFrom uses simplifyPath + -- so also used here for consistency. + | isAbsolute file = return $ simplifyPath file + | otherwise = do +#ifdef mingw32_HOST_OS + cwd <- toRawFilePath <$> getCurrentDirectory +#else + cwd <- getWorkingDirectory +#endif + return $ absPathFrom cwd file + +{- Constructs a relative path from the CWD to a file. + - + - For example, assuming CWD is /tmp/foo/bar: + - relPathCwdToFile "/tmp/foo" == ".." + - relPathCwdToFile "/tmp/foo/bar" == "" + -} +relPathCwdToFile :: RawFilePath -> IO RawFilePath +relPathCwdToFile f = do +#ifdef mingw32_HOST_OS + c <- toRawFilePath <$> getCurrentDirectory +#else + c <- getWorkingDirectory +#endif + relPathDirToFile c f + +{- Constructs a relative path from a directory to a file. -} +relPathDirToFile :: RawFilePath -> RawFilePath -> IO RawFilePath +relPathDirToFile from to = relPathDirToFileAbs <$> absPath from <*> absPath to + +{- Converts paths in the home directory to use ~/ -} +relHome :: FilePath -> IO String +relHome path = do + let path' = toRawFilePath path + home <- toRawFilePath <$> myHomeDir + return $ if dirContains home path' + then fromRawFilePath ("~/" <> relPathDirToFileAbs home path') + else path diff --git a/git-annex.cabal b/git-annex.cabal index 605833f1fe..eefe30eb4c 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -817,6 +817,7 @@ Executable git-annex Config Config.Cost Config.Files + Config.Files.AutoStart Config.DynamicConfig Config.GitConfig Config.Smudge @@ -1055,6 +1056,7 @@ Executable git-annex Utility.DirWatcher Utility.DirWatcher.Types Utility.Directory + Utility.Directory.Create Utility.Directory.Stream Utility.DiskFree Utility.Dot @@ -1094,6 +1096,7 @@ Executable git-annex Utility.PID Utility.PartialPrelude Utility.Path + Utility.Path.AbsRel Utility.Path.Max Utility.Percentage Utility.Process