diff options
author | Joey Hess <joey@kitenet.net> | 2010-10-31 18:04:34 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2010-10-31 18:04:34 -0400 |
commit | fd6611f9554e43f2bc365f7ef70f90877c9403d0 (patch) | |
tree | b4b91e6448ea839a419e8a94e9f8dc1c013c99c7 /Backend.hs | |
parent | b220e117f2e06133919ad31e9cc225470f501566 (diff) |
Fix crash on unknown symlinks.
Diffstat (limited to 'Backend.hs')
-rw-r--r-- | Backend.hs | 41 |
1 files changed, 28 insertions, 13 deletions
diff --git a/Backend.hs b/Backend.hs index d75c2a761..f1b4c2897 100644 --- a/Backend.hs +++ b/Backend.hs @@ -27,9 +27,10 @@ module Backend ( ) where import Control.Monad.State -import Control.Exception.Extensible +import IO (try) import System.FilePath import System.Posix.Files +import Core import Locations import qualified GitRepo as Git @@ -59,12 +60,17 @@ list = do then bs else map (lookupBackendName bs) $ words s -{- Looks up a backend in a list -} +{- Looks up a backend in a list. May fail if unknown. -} lookupBackendName :: [Backend] -> String -> Backend lookupBackendName bs s = + case maybeLookupBackendName bs s of + Just b -> b + Nothing -> error $ "unknown backend " ++ s +maybeLookupBackendName :: [Backend] -> String -> Maybe Backend +maybeLookupBackendName bs s = if ((length matches) /= 1) - then error $ "unknown backend " ++ s - else matches !! 0 + then Nothing + else Just $ matches !! 0 where matches = filter (\b -> s == Internals.name b) bs {- Attempts to store a file in one of the backends. -} @@ -109,15 +115,24 @@ hasKey key = do lookupFile :: FilePath -> Annex (Maybe (Key, Backend)) lookupFile file = do bs <- Annex.supportedBackends - result <- liftIO $ (try (find bs)::IO (Either SomeException (Maybe (Key, Backend)))) - case (result) of + tl <- liftIO $ try getsymlink + case tl of Left _ -> return Nothing - Right val -> return val - where - find bs = do + Right l -> makekey bs l + where + getsymlink = do l <- readSymbolicLink file - return $ Just $ pair bs $ takeFileName l - pair bs f = (k, b) + return $ takeFileName l + makekey bs l = do + case maybeLookupBackendName bs $ bname of + Nothing -> do + unless (null kname || null bname) $ + warning skip + return Nothing + Just backend -> return $ Just (k, backend) where - k = fileKey f - b = lookupBackendName bs $ backendName k + k = fileKey l + bname = backendName k + kname = keyName k + skip = "skipping " ++ file ++ + " (unknown backend " ++ bname ++ ")" |