{- git-annex repository initialization
-
- - Copyright 2011-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2011-2021 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
#endif
import qualified Data.Map as M
+import Control.Monad.IO.Class (MonadIO)
#ifndef mingw32_HOST_OS
import Data.Either
import qualified System.FilePath.ByteString as P
- or removing write access from files. -}
probeCrippledFileSystem :: Annex Bool
probeCrippledFileSystem = withEventuallyCleanedOtherTmp $ \tmp -> do
- (r, warnings) <- liftIO $ probeCrippledFileSystem' tmp
+ (r, warnings) <- probeCrippledFileSystem' tmp
+ (Just freezeContent)
+ (Just thawContent)
mapM_ warning warnings
return r
-probeCrippledFileSystem' :: RawFilePath -> IO (Bool, [String])
+probeCrippledFileSystem'
+ :: (MonadIO m, MonadCatch m)
+ => RawFilePath
+ -> Maybe (RawFilePath -> m ())
+ -> Maybe (RawFilePath -> m ())
+ -> m (Bool, [String])
#ifdef mingw32_HOST_OS
-probeCrippledFileSystem' _ = return (True, [])
+probeCrippledFileSystem' _ _ = return (True, [])
#else
-probeCrippledFileSystem' tmp = do
- let f = fromRawFilePath (tmp P.</> "gaprobe")
- writeFile f ""
- r <- probe f
- void $ tryIO $ allowWrite (toRawFilePath f)
- removeFile f
+probeCrippledFileSystem' tmp freezecontent thawcontent = do
+ let f = tmp P.</> "gaprobe"
+ let f' = fromRawFilePath f
+ liftIO $ writeFile f' ""
+ r <- probe f'
+ void $ tryNonAsync $ (fromMaybe (liftIO . allowWrite) thawcontent) f
+ liftIO $ removeFile f'
return r
where
probe f = catchDefaultIO (True, []) $ do
let f2 = f ++ "2"
- removeWhenExistsWith R.removeLink (toRawFilePath f2)
- createSymbolicLink f f2
- removeWhenExistsWith R.removeLink (toRawFilePath f2)
- preventWrite (toRawFilePath f)
+ liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f2)
+ liftIO $ createSymbolicLink f f2
+ liftIO $ removeWhenExistsWith R.removeLink (toRawFilePath f2)
+ (fromMaybe (liftIO . preventWrite) freezecontent) (toRawFilePath f)
-- Should be unable to write to the file, unless
-- running as root, but some crippled
-- filesystems ignore write bit removals.
- ifM ((== 0) <$> getRealUserID)
+ liftIO $ ifM ((== 0) <$> getRealUserID)
( return (False, [])
, do
r <- catchBoolIO $ do
warning "Detected a crippled filesystem."
setCrippledFileSystem True
- {- Normally git disables core.symlinks itself when the
+ {- 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. -}
{- git-annex file permissions
-
- - Copyright 2012-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2012-2021 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
- owned by another user, so failure to set this mode is ignored.
-}
freezeContent :: RawFilePath -> Annex ()
-freezeContent file = unlessM crippledFileSystem $
+freezeContent file = unlessM crippledFileSystem $ do
withShared go
+ freezeHook file
where
go GroupShared = liftIO $ void $ tryIO $ modifyFileMode file $
addModes [ownerReadMode, groupReadMode, ownerWriteMode, groupWriteMode]
{- Allows writing to an annexed file that freezeContent was called on
- before. -}
thawContent :: RawFilePath -> Annex ()
-thawContent file = thawPerms $ withShared go
+thawContent file = thawPerms (withShared go) (thawHook file)
where
go GroupShared = liftIO $ void $ tryIO $ groupWriteRead file
go AllShared = liftIO $ void $ tryIO $ groupWriteRead file
{- Runs an action that thaws a file's permissions. This will probably
- fail on a crippled filesystem. But, if file modes are supported on a
- - crippled filesystem, the file may be frozen, so try to thaw it. -}
-thawPerms :: Annex () -> Annex ()
-thawPerms a = ifM crippledFileSystem
- ( void $ tryNonAsync a
- , a
+ - crippled filesystem, the file may be frozen, so try to thaw its
+ - permissions. -}
+thawPerms :: Annex () -> Annex () -> Annex ()
+thawPerms a hook = ifM crippledFileSystem
+ ( void (tryNonAsync a)
+ , hook >> a
)
{- Blocks writing to the directory an annexed file is in, to prevent the
- file.
-}
freezeContentDir :: RawFilePath -> Annex ()
-freezeContentDir file = unlessM crippledFileSystem $
+freezeContentDir file = unlessM crippledFileSystem $ do
withShared go
+ freezeHook dir
where
dir = parentDir file
go GroupShared = liftIO $ void $ tryIO $ groupWriteRead dir
go _ = liftIO $ preventWrite dir
thawContentDir :: RawFilePath -> Annex ()
-thawContentDir file =
- thawPerms $ liftIO $ allowWrite $ parentDir file
+thawContentDir file = thawPerms (liftIO $ allowWrite dir) (thawHook dir)
+ where
+ dir = parentDir file
{- Makes the directory tree to store an annexed file's content,
- with appropriate permissions on each level. -}
unlessM (liftIO $ R.doesPathExist dir) $
createAnnexDirectory dir
-- might have already existed with restricted perms
- unlessM crippledFileSystem $
+ unlessM crippledFileSystem $ do
+ thawHook dir
liftIO $ allowWrite dir
where
dir = parentDir dest
v <- tryNonAsync a
freezeContentDir f
either throwM return v
+
+freezeHook :: RawFilePath -> Annex ()
+freezeHook p = maybe noop go =<< annexFreezeContentCommand <$> Annex.getGitConfig
+ where
+ go basecmd = void $ liftIO $
+ boolSystem "sh" [Param "-c", Param $ gencmd basecmd]
+ gencmd = massReplace [ ("%path", shellEscape (fromRawFilePath p)) ]
+
+thawHook :: RawFilePath -> Annex ()
+thawHook p = maybe noop go =<< annexThawContentCommand <$> Annex.getGitConfig
+ where
+ go basecmd = void $ liftIO $
+ boolSystem "sh" [Param "-c", Param $ gencmd basecmd]
+ gencmd = massReplace [ ("%path", shellEscape (fromRawFilePath p)) ]
* sync: Partly work around github behavior that first branch to be pushed
to a new repository is assumed to be the head branch, by not pushing
synced/git-annex first.
+ * Added annex.freezecontent-command and annex.thawcontent-command
+ configs.
-- Joey Hess <id@joeyh.name> Mon, 21 Jun 2021 12:25:25 -0400
exitWith exitcode
runsubprocesstests (Just _) = isolateGitConfig $ do
ensuretmpdir
- crippledfilesystem <- fst <$> Annex.Init.probeCrippledFileSystem' (toRawFilePath tmpdir)
+ crippledfilesystem <- fst <$> Annex.Init.probeCrippledFileSystem'
+ (toRawFilePath tmpdir)
+ Nothing Nothing
adjustedbranchok <- Annex.AdjustedBranch.isGitVersionSupported
case tryIngredients ingredients (tastyOptionSet opts) (tests crippledfilesystem adjustedbranchok opts) of
Nothing -> error "No tests found!?"
, annexFsckNudge :: Bool
, annexAutoUpgrade :: AutoUpgrade
, annexExpireUnused :: Maybe (Maybe Duration)
+ , annexFreezeContentCommand :: Maybe String
+ , annexThawContentCommand :: Maybe String
, annexSecureEraseCommand :: Maybe String
, annexGenMetaData :: Bool
, annexListen :: Maybe String
getmaybe (annexConfig "autoupgrade")
, annexExpireUnused = either (const Nothing) Just . parseDuration
<$> getmaybe (annexConfig "expireunused")
+ , annexFreezeContentCommand = getmaybe (annexConfig "freezecontent-command")
+ , annexThawContentCommand = getmaybe (annexConfig "thawcontent-command")
, annexSecureEraseCommand = getmaybe (annexConfig "secure-erase-command")
, annexGenMetaData = getbool (annexConfig "genmetadata") False
, annexListen = getmaybe (annexConfig "listen")
For example, to use the wipe command, set it to `wipe -f %file`.
+* `annex.freezecontent-command`, `annex.thawcontent-command`
+
+ Usually the write permission bits are unset to protect annexed objects
+ from being modified or deleted. The freezecontent-command is run after
+ git-annex has removed the write bit. The thawcontent-command should undo
+ its effect, and is run before git-annex restores the write bit.
+
+ In the command line, %path is replaced with the file or directory to
+ operate on.
+
* `annex.tune.objecthash1`, `annex.tune.objecthashlower`, `annex.tune.branchhash1`
These can be passed to `git annex init` to tune the repository.
tree, this follows the symlink and allows writing to the file. It would be
better to make the files fully immutable. But most systems either don't
support immutable attributes, or only let root make files immutable.
+
+The git configs `annex.freezecontent-command` and `annex.thawcontent-command`
+can be used to run additional commands to further lock down and later thaw
+the annex object and directory.
Design:
-Configs: annex.lockdown-command, annex.unlockdown-command
+Configs: annex.freezecontent-command, annex.thawcontent-command
In these, "%path" is replaced with the file/directory to act on.
Locking down a directory only needs to do the equivilant of removing its
> hook could also support things like [[storing_xattrs|support_for_storing_xattrs]]
> --[[Joey]]
-[[!tag needsthought]]
[[!tag projects/datalad]]
+
+> [[done]].. `git-annex init` does run annex.freezecontent-command and if it
+> prevents writing to a file, it will avoid setting
+> annex.crippledfilesystem.
+>
+> I didn't make `git-annex test` use the global git config of the hooks
+> though, not sure if that really makes sense or is needed.
projects / git-annex.git / commitdiff