use getSymbolicLinkStatus not getFileStatus to avoid crash on broken symlink

Fix crash importing from a directory special remote that contains a broken
symlink.

The crash was in listImportableContentsM but some other places in
Remote.Directory also seemed like they could have the same problem.

Also audited for other places that have such a problem. Not all calls
to getFileStatus are bad, in some cases it's better to crash on something
unexpected. For example, `git-annex import path` when the path is a broken
symlink should crash, the same as when it does not exist. Many of the
getFileStatus calls are like that, particularly when they involve
.git/annex/objects which should never have a broken symlink in it.

Fixed a few other possible cases of the problem.

Sponsored-by: Lawrence Brogan on Patreon

CHANGELOG

@@ -3,6 +3,8 @@ git-annex (10.20220823) UNRELEASED; urgency=medium
   * Include the assistant and webapp when building with cabal 3.4.1.0.
   * Merged the webapp build flag into the assistant build flag.
   * Optimise linker in linux standalone tarballs.
+  * Fix crash importing from a directory special remote that contains
+    a broken symlink.
 
  -- Joey Hess <id@joeyh.name>  Mon, 29 Aug 2022 15:03:04 -0400
 

CmdLine/Seek.hs

@@ -109,6 +109,10 @@ withPathContents a params = do
 			a f
 		go matcher checktimelimit ps fs		
 	
+	-- Using getFileStatus not getSymbolicLinkStatus because it should
+	-- fail if the path that the user provided is a broken symlink,
+	-- the same as it fails if the path that the user provided does not
+	-- exist.
 	get p = ifM (isDirectory <$> getFileStatus p)
 		( map (\f -> 
 			let f' = toRawFilePath f

Git.hs

@@ -156,7 +156,7 @@ hookPath script repo = do
 #if mingw32_HOST_OS
 	isexecutable f = doesFileExist f
 #else
-	isexecutable f = isExecutable . fileMode <$> getFileStatus f
+	isexecutable f = isExecutable . fileMode <$> getSymbolicLinkStatus f
 #endif
 
 {- Makes the path to a local Repo be relative to the cwd. -}

Limit.hs

@@ -572,7 +572,7 @@ addAccessedWithin duration = do
   where
 	check now k = inAnnexCheck k $ \f ->
 		liftIO $ catchDefaultIO False $ do
-			s <- R.getFileStatus f
+			s <- R.getSymbolicLinkStatus f
 			let accessed = realToFrac (accessTime s)
 			let delta = now - accessed
 			return $ delta <= secs

Remote/Ddar.hs

@@ -184,7 +184,8 @@ remove ddarrepo key = do
 ddarDirectoryExists :: DdarRepo -> Annex (Either String Bool)
 ddarDirectoryExists ddarrepo
 	| ddarLocal ddarrepo = do
-		maybeStatus <- liftIO $ tryJust (guard . isDoesNotExistError) $ getFileStatus $ ddarRepoLocation ddarrepo
+		maybeStatus <- liftIO $ tryJust (guard . isDoesNotExistError) $
+			getSymbolicLinkStatus $ ddarRepoLocation ddarrepo
 		return $ case maybeStatus of
 			Left _ -> Right False
 			Right status -> Right $ isDirectory status

Remote/Directory.hs

@@ -218,8 +218,8 @@ checkDiskSpaceDirectory d k = do
 	annexdir <- fromRepo gitAnnexObjectDir
 	samefilesystem <- liftIO $ catchDefaultIO False $ 
 		(\a b -> deviceID a == deviceID b)
-			<$> R.getFileStatus d
-			<*> R.getFileStatus annexdir
+			<$> R.getSymbolicLinkStatus d
+			<*> R.getSymbolicLinkStatus annexdir
 	checkDiskSpace (Just d) k 0 samefilesystem
 
 {- Passed a temp directory that contains the files that should be placed
@@ -369,7 +369,7 @@ listImportableContentsM ii dir = liftIO $ do
 		ImportableContents (catMaybes l') []
   where
 	go f = do
-		st <- R.getFileStatus f
+		st <- R.getSymbolicLinkStatus f
 		mkContentIdentifier ii f st >>= \case
 			Nothing -> return Nothing
 			Just cid -> do
@@ -402,7 +402,7 @@ importKeyM ii dir loc cid sz p = do
 	let k = alterKey unsizedk $ \kd -> kd
 		{ keySize = keySize kd <|> Just sz }
 	currcid <- liftIO $ mkContentIdentifier ii absf
-		=<< R.getFileStatus absf
+		=<< R.getSymbolicLinkStatus absf
 	guardSameContentIdentifiers (return (Just k)) cid currcid
   where
 	f = fromExportLocation loc
@@ -462,7 +462,7 @@ retrieveExportWithContentIdentifierM ii dir cow loc cid dest gk p =
 	-- content.
 	precheck cont = guardSameContentIdentifiers cont cid
 		=<< liftIO . mkContentIdentifier ii f
-		=<< liftIO (R.getFileStatus f)
+		=<< liftIO (R.getSymbolicLinkStatus f)
 
 	-- Check after copy, in case the file was changed while it was
 	-- being copied.
@@ -486,7 +486,7 @@ retrieveExportWithContentIdentifierM ii dir cow loc cid dest gk p =
 #ifndef mingw32_HOST_OS
 			=<< getFdStatus fd
 #else
-			=<< R.getFileStatus f
+			=<< R.getSymbolicLinkStatus f
 #endif
 		guardSameContentIdentifiers cont cid currcid
 
@@ -497,7 +497,7 @@ retrieveExportWithContentIdentifierM ii dir cow loc cid dest gk p =
 	-- restored to the original content before this check.
 	postcheckcow cont = do
 		currcid <- liftIO $ mkContentIdentifier ii f
-			=<< R.getFileStatus f
+			=<< R.getSymbolicLinkStatus f
 		guardSameContentIdentifiers cont cid currcid
 
 storeExportWithContentIdentifierM :: IgnoreInodes -> RawFilePath -> CopyCoWTried -> FilePath -> Key -> ExportLocation -> [ContentIdentifier] -> MeterUpdate -> Annex ContentIdentifier
@@ -508,7 +508,7 @@ storeExportWithContentIdentifierM ii dir cow src _k loc overwritablecids p = do
 		void $ liftIO $ fileCopier cow src tmpf p Nothing
 		let tmpf' = toRawFilePath tmpf
 		resetAnnexFilePerm tmpf'
-		liftIO (getFileStatus tmpf) >>= liftIO . mkContentIdentifier ii tmpf' >>= \case
+		liftIO (getSymbolicLinkStatus tmpf) >>= liftIO . mkContentIdentifier ii tmpf' >>= \case
 			Nothing -> giveup "unable to generate content identifier"
 			Just newcid -> do
 				checkExportContent ii dir loc
@@ -553,7 +553,7 @@ data CheckResult = DoesNotExist | KnownContentIdentifier
 -- content is known, and immediately run the callback.
 checkExportContent :: IgnoreInodes -> RawFilePath -> ExportLocation -> [ContentIdentifier] -> Annex a -> (CheckResult -> Annex a) -> Annex a
 checkExportContent ii dir loc knowncids unsafe callback = 
-	tryWhenExists (liftIO $ R.getFileStatus dest) >>= \case
+	tryWhenExists (liftIO $ R.getSymbolicLinkStatus dest) >>= \case
 		Just destst
 			| not (isRegularFile destst) -> unsafe
 			| otherwise -> catchDefaultIO Nothing (liftIO $ mkContentIdentifier ii dest destst) >>= \case

Utility/InodeCache.hs

@@ -187,7 +187,7 @@ readInodeCache s = case words s of
 
 genInodeCache :: RawFilePath -> TSDelta -> IO (Maybe InodeCache)
 genInodeCache f delta = catchDefaultIO Nothing $
-	toInodeCache delta f =<< R.getFileStatus f
+	toInodeCache delta f =<< R.getSymbolicLinkStatus f
 
 toInodeCache :: TSDelta -> RawFilePath -> FileStatus -> IO (Maybe InodeCache)
 toInodeCache d f s = toInodeCache' d f s (fileID s)

Utility/MoveFile.hs

@@ -72,7 +72,7 @@ moveFile src dest = tryIO (R.rename src dest) >>= onrename
 
 #ifndef mingw32_HOST_OS	
 	isdir f = do
-		r <- tryIO $ R.getFileStatus f
+		r <- tryIO $ R.getSymbolicLinkStatus f
 		case r of
 			(Left _) -> return False
 			(Right s) -> return $ isDirectory s

Utility/Url.hs

@@ -313,7 +313,7 @@ getUrlInfo url uo = case parseURIRelaxed url of
 
 	existsfile u = do
 		let f = toRawFilePath (unEscapeString (uriPath u))
-		s <- catchMaybeIO $ R.getFileStatus f
+		s <- catchMaybeIO $ R.getSymbolicLinkStatus f
 		case s of
 			Just stat -> do
 				sz <- getFileSize' f stat

doc/bugs/Broken_symlinks_in_directory_remote_causes_crash.mdwn

@@ -31,3 +31,7 @@ I would like git-annex to either:
 ### Have you had any luck using git-annex before? (Sometimes we get tired of reading bug reports all day and a lil' positive end note does wonders)
 
 Loading in other parts of my photo collection as we speak!
+
+> [[fixed|done]], by ignoring the broken symlink. (There is a todo
+> about importing symlinks,
+>[[todo/import_symlinks_when_importing_from_directory]])--[[Joey]]