diff --git a/Annex/Hook.hs b/Annex/Hook.hs index 086665abce..366678490c 100644 --- a/Annex/Hook.hs +++ b/Annex/Hook.hs @@ -106,44 +106,55 @@ doesAnnexHookExist hook = do runAnnexHook :: Git.Hook -> (GitConfig -> Maybe String) -> Annex () runAnnexHook hook commandcfg = runAnnexHook' hook commandcfg >>= \case - Nothing -> noop - Just failedcommanddesc -> + HookSuccess -> noop + HookFailed failedcommanddesc -> warning $ UnquotedString $ failedcommanddesc ++ " failed" --- Returns Nothing if the hook or GitConfig command succeeded, or a --- description of what failed. -runAnnexHook' :: Git.Hook -> (GitConfig -> Maybe String) -> Annex (Maybe String) +data HookResult + = HookSuccess + | HookFailed String + -- ^ A description of the hook command that failed. + deriving (Eq, Show) + +runAnnexHook' :: Git.Hook -> (GitConfig -> Maybe String) -> Annex HookResult runAnnexHook' hook commandcfg = ifM (doesAnnexHookExist hook) ( runhook , runcommandcfg ) where runhook = ifM (inRepo $ Git.runHook boolSystem hook []) - ( return Nothing + ( return HookSuccess , do h <- fromRepo (Git.hookFile hook) - commandfailed (fromOsPath h) + return $ HookFailed $ fromOsPath h ) runcommandcfg = commandcfg <$> Annex.getGitConfig >>= \case - Nothing -> return Nothing + Nothing -> return HookSuccess Just command -> ifM (liftIO $ boolSystem "sh" [Param "-c", Param command]) - ( return Nothing - , commandfailed $ "git configured command '" ++ command ++ "'" + ( return HookSuccess + , return $ HookFailed $ "git configured command '" ++ command ++ "'" ) - commandfailed c = return $ Just c -runAnnexPathHook :: String -> Git.Hook -> (GitConfig -> Maybe String) -> OsPath -> Annex Bool +runAnnexPathHook :: String -> Git.Hook -> (GitConfig -> Maybe String) -> OsPath -> Annex HookResult runAnnexPathHook pathtoken hook commandcfg p = ifM (doesAnnexHookExist hook) ( runhook , runcommandcfg ) where - runhook = inRepo $ Git.runHook boolSystem hook [ File p' ] + runhook = ifM (inRepo $ Git.runHook boolSystem hook [ File p' ]) + ( return HookSuccess + , do + h <- fromRepo (Git.hookFile hook) + return $ HookFailed $ fromOsPath h + ) runcommandcfg = commandcfg <$> Annex.getGitConfig >>= \case - Nothing -> return True - Just basecmd -> liftIO $ - boolSystem "sh" [Param "-c", Param $ gencmd basecmd] + Nothing -> return HookSuccess + Just basecmd -> + ifM (liftIO $ boolSystem "sh" [Param "-c", Param (gencmd basecmd)]) + ( return HookSuccess + , return $ HookFailed $ "git configured command '" ++ basecmd ++ "'" + ) gencmd = massReplace [ (pathtoken, shellEscape p') ] p' = fromOsPath p diff --git a/Annex/Init.hs b/Annex/Init.hs index 81b07b54d1..64c924fd04 100644 --- a/Annex/Init.hs +++ b/Annex/Init.hs @@ -19,6 +19,7 @@ module Annex.Init ( uninitialize, probeCrippledFileSystem, probeCrippledFileSystem', + isCrippledFileSystem, ) where import Annex.Common @@ -75,10 +76,10 @@ data InitializeAllowed = InitializeAllowed checkInitializeAllowed :: (InitializeAllowed -> Annex a) -> Annex a checkInitializeAllowed a = guardSafeToUseRepo $ noAnnexFileContent' >>= \case Nothing -> runAnnexHook' preInitAnnexHook annexPreInitCommand >>= \case - Nothing -> do + HookSuccess -> do checkSqliteWorks a InitializeAllowed - Just failedcommanddesc -> do + HookFailed failedcommanddesc -> do initpreventedby failedcommanddesc notinitialized Just noannexmsg -> do @@ -94,8 +95,8 @@ checkInitializeAllowed a = guardSafeToUseRepo $ noAnnexFileContent' >>= \case initializeAllowed :: Annex Bool initializeAllowed = noAnnexFileContent' >>= \case Nothing -> runAnnexHook' preInitAnnexHook annexPreInitCommand >>= \case - Nothing -> return True - Just _ -> return False + HookSuccess -> return True + HookFailed _ -> return False Just _ -> return False noAnnexFileContent' :: Annex (Maybe String) @@ -288,73 +289,116 @@ isInitialized :: Annex Bool isInitialized = maybe Annex.Branch.hasSibling (const $ return True) =<< getVersion {- A crippled filesystem is one that does not allow making symlinks, - - or removing write access from files. -} -probeCrippledFileSystem :: Annex Bool -probeCrippledFileSystem = withEventuallyCleanedOtherTmp $ \tmp -> do - (r, warnings) <- probeCrippledFileSystem' tmp + - or removing write access from files. + - + - This displays messages about problems detected with the filesystem. + - + - If a freeze or thaw hook is configured, but exits nonzero, + - this returns Nothing after displaying a message to the user about the + - problem. Such a hook can in some cases make a filesystem + - that would otherwise be detected as crippled work ok, so this avoids + - a false positive. + -} +probeCrippledFileSystem :: Annex (Maybe Bool) +probeCrippledFileSystem = do + (r, warnings) <- isCrippledFileSystem' + mapM_ (warning . UnquotedString) warnings + return r + +isCrippledFileSystem :: Annex Bool +isCrippledFileSystem = do + (r, _warnings) <- isCrippledFileSystem' + return (fromMaybe True r) + +isCrippledFileSystem' :: Annex (Maybe Bool, [String]) +isCrippledFileSystem' = withEventuallyCleanedOtherTmp $ \tmp -> + probeCrippledFileSystem' tmp (Just (freezeContent' UnShared)) (Just (thawContent' UnShared)) =<< hasFreezeHook - mapM_ (warning . UnquotedString) warnings - return r probeCrippledFileSystem' :: (MonadIO m, MonadCatch m) => OsPath - -> Maybe (OsPath -> m ()) - -> Maybe (OsPath -> m ()) + -> Maybe (OsPath -> m HookResult) + -> Maybe (OsPath -> m HookResult) -> Bool - -> m (Bool, [String]) + -> m (Maybe Bool, [String]) #ifdef mingw32_HOST_OS -probeCrippledFileSystem' _ _ _ _ = return (True, []) +probeCrippledFileSystem' _ _ _ _ = return (Just True, []) #else probeCrippledFileSystem' tmp freezecontent thawcontent hasfreezehook = do let f = tmp literalOsPath "gaprobe" liftIO $ F.writeFile' f "" - r <- probe f - void $ tryNonAsync $ (fromMaybe (liftIO . allowWrite) thawcontent) f + r <- freezethaw f probe liftIO $ removeFile f return r where - probe f = catchDefaultIO (True, []) $ do + fallbackfreezecontent f = do + liftIO $ preventWrite f + return HookSuccess + + fallbackthawcontent f = do + liftIO $ allowWrite f + return HookSuccess + + freezethaw f cont = + (fromMaybe fallbackfreezecontent freezecontent) f >>= \case + HookFailed failedcommanddesc -> + return (Nothing, [hookfailed failedcommanddesc]) + HookSuccess -> do + r <- cont f + tryNonAsync ((fromMaybe fallbackthawcontent thawcontent) f) + >>= return . \case + Right (HookFailed failedcommanddesc) -> + let (_, warnings) = r + in (Nothing, hookfailed failedcommanddesc : warnings) + _ -> r + + hookfailed failedcommanddesc = "Failed to run " ++ failedcommanddesc + ++ ". Unable to initialize until this is fixed." + + probe f = catchDefaultIO (Just True, []) $ do let f2 = f <> literalOsPath "2" liftIO $ removeWhenExistsWith removeFile f2 liftIO $ R.createSymbolicLink (fromOsPath f) (fromOsPath f2) liftIO $ removeWhenExistsWith removeFile f2 - (fromMaybe (liftIO . preventWrite) freezecontent) f -- Should be unable to write to the file (unless -- running as root). But some crippled -- filesystems ignore write bit removals or ignore -- permissions entirely. ifM ((== Just False) <$> liftIO (checkContentWritePerm' UnShared f Nothing hasfreezehook)) - ( return (True, ["Filesystem does not allow removing write bit from files."]) + ( return (Just True, ["Filesystem does not allow removing write bit from files."]) , liftIO $ ifM ((== 0) <$> getRealUserID) - ( return (False, []) + ( return (Just False, []) , do r <- catchBoolIO $ do F.writeFile' f "2" return True if r - then return (True, ["Filesystem allows writing to files whose write bit is not set."]) - else return (False, []) + then return (Just True, ["Filesystem allows writing to files whose write bit is not set."]) + else return (Just False, []) ) ) #endif checkCrippledFileSystem :: Annex () -checkCrippledFileSystem = whenM probeCrippledFileSystem $ do - warning "Detected a crippled filesystem." - setCrippledFileSystem True +checkCrippledFileSystem = probeCrippledFileSystem >>= \case + Just True -> do + warning "Detected a crippled filesystem." + setCrippledFileSystem True - {- Normally git disables core.symlinks itself when the:w - - - - filesystem does not support them. But, even if symlinks are - - supported, we don't use them by default in a crippled - - filesystem. -} - whenM (coreSymlinks <$> Annex.getGitConfig) $ do - warning "Disabling core.symlinks." - setConfig "core.symlinks" - (Git.Config.boolConfig False) + {- Normally git disables core.symlinks itself when the + - + - filesystem does not support them. But, even if symlinks are + - supported, we don't use them by default in a crippled + - filesystem. -} + whenM (coreSymlinks <$> Annex.getGitConfig) $ do + warning "Disabling core.symlinks." + setConfig "core.symlinks" + (Git.Config.boolConfig False) + Just False -> noop + Nothing -> giveup "Not initialized." probeLockSupport :: Annex Bool #ifdef mingw32_HOST_OS diff --git a/Annex/Perms.hs b/Annex/Perms.hs index 9674873248..245c9a8011 100644 --- a/Annex/Perms.hs +++ b/Annex/Perms.hs @@ -161,13 +161,12 @@ createWorkTreeDirectory dir = do - that happens with write permissions. -} freezeContent :: OsPath -> Annex () -freezeContent file = - withShared $ \sr -> freezeContent' sr file +freezeContent file = withShared $ \sr -> void $ freezeContent' sr file -freezeContent' :: SharedRepository -> OsPath -> Annex () +freezeContent' :: SharedRepository -> OsPath -> Annex HookResult freezeContent' sr file = freezeContent'' sr file =<< getVersion -freezeContent'' :: SharedRepository -> OsPath -> Maybe RepoVersion -> Annex () +freezeContent'' :: SharedRepository -> OsPath -> Maybe RepoVersion -> Annex HookResult freezeContent'' sr file rv = do fastDebug "Annex.Perms" ("freezing content " ++ fromOsPath file) unlessM crippledFileSystem $ go sr @@ -255,9 +254,9 @@ checkContentWritePerm' sr file rv hasfreezehook {- Allows writing to an annexed file that freezeContent was called on - before. -} thawContent :: OsPath -> Annex () -thawContent file = withShared $ \sr -> thawContent' sr file +thawContent file = withShared $ \sr -> void $ thawContent' sr file -thawContent' :: SharedRepository -> OsPath -> Annex () +thawContent' :: SharedRepository -> OsPath -> Annex HookResult thawContent' sr file = do fastDebug "Annex.Perms" ("thawing content " ++ fromOsPath file) thawPerms (go sr) (thawHook file) @@ -272,10 +271,10 @@ thawContent' sr file = do - fail on a crippled filesystem. But, if file modes are supported on a - crippled filesystem, the file may be frozen, so try to thaw its - permissions. -} -thawPerms :: Annex () -> Annex () -> Annex () +thawPerms :: Annex () -> Annex HookResult -> Annex HookResult thawPerms a hook = ifM crippledFileSystem - ( hook >> void (tryNonAsync a) - , hook >> a + ( void (tryNonAsync a) `after` hook + , a `after` hook ) {- Blocks writing to the directory an annexed file is in, to prevent the @@ -287,7 +286,7 @@ freezeContentDir :: OsPath -> Annex () freezeContentDir file = do fastDebug "Annex.Perms" ("freezing content directory " ++ fromOsPath dir) unlessM crippledFileSystem $ withShared go - freezeHook dir + void $ freezeHook dir where dir = parentDir file go UnShared = liftIO $ preventWrite dir @@ -303,7 +302,7 @@ freezeContentDir file = do thawContentDir :: OsPath -> Annex () thawContentDir file = do fastDebug "Annex.Perms" ("thawing content directory " ++ fromOsPath dir) - thawPerms (withShared (liftIO . go)) (thawHook dir) + void $ thawPerms (withShared (liftIO . go)) (thawHook dir) where dir = parentDir file go UnShared = allowWrite dir @@ -318,7 +317,7 @@ createContentDir dest = do unlessM (liftIO $ doesDirectoryExist dir) $ createAnnexDirectory dir -- might have already existed with restricted perms - thawHook dir + void $ thawHook dir unlessM crippledFileSystem $ liftIO $ allowWrite dir where dir = parentDir dest @@ -354,12 +353,12 @@ hasThawHook = <||> (doesAnnexHookExist thawContentAnnexHook) -freezeHook :: OsPath -> Annex () -freezeHook = void . runAnnexPathHook "%path" +freezeHook :: OsPath -> Annex HookResult +freezeHook = runAnnexPathHook "%path" freezeContentAnnexHook annexFreezeContentCommand -thawHook :: OsPath -> Annex () -thawHook = void . runAnnexPathHook "%path" +thawHook :: OsPath -> Annex HookResult +thawHook = runAnnexPathHook "%path" thawContentAnnexHook annexThawContentCommand {- Calculate mode to use for a directory from the mode to use for a file. diff --git a/CHANGELOG b/CHANGELOG index 8f5771b5f7..789872e8c0 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -2,6 +2,10 @@ git-annex (10.20250521) UNRELEASED; urgency=medium * assistant: Avoid hanging at startup when a process has a *.lock file open in the .git directory. + * When annex.freezecontent-command or annex.thawcontent-command is + configured but fails, prevent initialization. This allows the user to + fix their configuration and avoid crippled filesystem detection + entering an adjusted branch. -- Joey Hess Thu, 22 May 2025 12:43:38 -0400 diff --git a/CmdLine/GitRemoteAnnex.hs b/CmdLine/GitRemoteAnnex.hs index d83be209ce..5714038387 100644 --- a/CmdLine/GitRemoteAnnex.hs +++ b/CmdLine/GitRemoteAnnex.hs @@ -1204,7 +1204,7 @@ cleanupInitialization sab alternatejournaldir = void $ tryNonAsync $ do _ -> noop void $ liftIO $ tryIO $ removeDirectory annexobjectdir - notcrippledfilesystem = not <$> probeCrippledFileSystem + notcrippledfilesystem = not <$> isCrippledFileSystem nonbuggygitversion = liftIO $ flip notElem buggygitversions <$> Git.Version.installed diff --git a/Test/Framework.hs b/Test/Framework.hs index 71191dffc6..35a29d6bee 100644 --- a/Test/Framework.hs +++ b/Test/Framework.hs @@ -804,9 +804,10 @@ parallelTestRunner' numjobs opts mkts go Nothing = summarizeresults $ withConcurrentOutput $ do ensuredir tmpdir - crippledfilesystem <- fst <$> Annex.Init.probeCrippledFileSystem' - (toOsPath tmpdir) - Nothing Nothing False + crippledfilesystem <- fromMaybe False . fst + <$> Annex.Init.probeCrippledFileSystem' + (toOsPath tmpdir) + Nothing Nothing False adjustedbranchok <- Annex.AdjustedBranch.isGitVersionSupported let ts = mkts numparts crippledfilesystem adjustedbranchok opts let warnings = fst (tastyParser ts) diff --git a/doc/bugs/git-annex_proceeds_forward_if_freeze_script_fails/comment_3_da76c4512c1a65caaf3f51f00bd3e7eb._comment b/doc/bugs/git-annex_proceeds_forward_if_freeze_script_fails/comment_3_da76c4512c1a65caaf3f51f00bd3e7eb._comment new file mode 100644 index 0000000000..67fe915f27 --- /dev/null +++ b/doc/bugs/git-annex_proceeds_forward_if_freeze_script_fails/comment_3_da76c4512c1a65caaf3f51f00bd3e7eb._comment @@ -0,0 +1,15 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 3""" + date="2025-05-27T16:16:38Z" + content=""" +I agreee it makes sense to detect freeze/thaw hook fail at init and error +out rather than switching to an adjusted branch, and rather than start +using a repisitory that is not configured as desired from the start. +I've implemented that now. + +I think that change is arguably enough to consider this done. It avoids +the user initializing a broken repository, or otherwise starting from an +unexpected state. Fixing problems that happen later is the +job of `git-annex fsck`. +"""]] diff --git a/doc/projects/datalad/bugs-done/add_config_var_preventing_adjusted_branch_mode/comment_6_6337ea6ce754b65f203f3b84551c9722._comment b/doc/projects/datalad/bugs-done/add_config_var_preventing_adjusted_branch_mode/comment_6_6337ea6ce754b65f203f3b84551c9722._comment new file mode 100644 index 0000000000..681fbc15f3 --- /dev/null +++ b/doc/projects/datalad/bugs-done/add_config_var_preventing_adjusted_branch_mode/comment_6_6337ea6ce754b65f203f3b84551c9722._comment @@ -0,0 +1,18 @@ +[[!comment format=mdwn + username="joey" + subject="""comment 6""" + date="2025-05-27T14:53:52Z" + content=""" +Note that this bug is closed, and it would need to be moved out of +this archive to be reopened. + +Anyway, I agree that if the freeze/thaw hook is configured, but fails, +it would make sense for crippled filesystem probing to tell the user to +fix their configuration, and abort initialization, rather than +unnecessarily entering an adjusted branch. I have implemented that now. + +As far as situations where the hook is configured at first but later +is not configured, `git-annex fsck` re-runs the hook to freeze content. +So that is not dissimilar from other situations where permissions prevent +proper freezing, which fsck also fixes. +"""]]