mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

webapp: Allow creating repositories on filesystems that lack support for symlinks.

Browse source
This commit is contained in:
Joey Hess 2013-02-18 12:54:41 -04:00
parent 422dd28f0b
commit 127463e577
2 changed files with 2 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

14
Assistant/WebApp/Configurators/Local.hs
View file

@ -82,7 +82,6 @@ checkRepositoryPath p = do
, (return $ path == home, "Sorry, using git-annex for your whole home directory is not currently supported.")
, (not <$> doesDirectoryExist parent, "Parent directory does not exist.")
, (not <$> canWrite path, "Cannot write a repository there.")
, (not <$> canMakeSymlink path, "That directory is on a filesystem that does not support symlinks. Try a different location.")
]
return $
case headMaybe problems of
@ -306,16 +305,3 @@ canWrite dir = do
tocheck <- ifM (doesDirectoryExist dir)
(return dir, return $ parentDir dir)
catchBoolIO $ fileAccess tocheck False True False
{- Checks if a directory is on a filesystem that supports symlinks. -}
canMakeSymlink :: FilePath -> IO Bool
canMakeSymlink dir = ifM (doesDirectoryExist dir)
( catchBoolIO $ test dir
, canMakeSymlink (parentDir dir)
)
where
test d = do
let link = d </> "delete.me"
createSymbolicLink link link
removeLink link
return True